Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/549b.lha/M2P_v1.0_sources/source.lzh/FIO.mpp

Modula Implementation | 1991-08-10 | 21.2 KB | 717 lines

(*======================================================================*)
(*                   Amiga Modula-2 support routines                    *)
(*======================================================================*)

IMPLEMENTATION MODULE FIO;

(*----------------------------------------------------------------------*
 * Imports *** SOME IMPLEMENTATION DEPENDENT ***                        *
 *----------------------------------------------------------------------*)

IMPORT SYSTEM;
IMPORT FStorage;
IMPORT ASCII;
IMPORT Strings;

@IF    M2S THEN
   @DEFINE TRAPC
   IMPORT CtrlC;
   IMPORT RunTime;
   IMPORT DOS;
   FROM DOSProcess IMPORT ProcessPtr;
@ELSIF TDI THEN
   IMPORT AMIGAX;
   IMPORT DOSFiles;
   IMPORT Libraries,DOSLibrary;
   FROM DOSExtensions IMPORT ProcessPtr;
@END

@INCLUDE "MACROS"

(*----------------------------------------------------------------------*
 * Constants for configuring to personal preferences                    *
 *----------------------------------------------------------------------*)

CONST BufferSize    = 4096;
      MaxFileName   = 256;
      MaxPrompt     = 80;

(*----------------------------------------------------------------------*)
(* The IMPLEMENTATION DEPENDENT 'real' file type.                       *)
(*----------------------------------------------------------------------*)

TYPE  RealFileType = @IF    M2S THEN DOS.FileHandle;
                     @ELSIF TDI THEN DOSFiles.FileHandle;
                     @ELSE
                           (* insert implementation specific type here *)
                     @END

(*----------------------------------------------------------------------*)
(* The buffered FILE structure                                          *)
(*----------------------------------------------------------------------*)

TYPE  Access = (Closed,Read,Write);

      AccessSet = SET OF Access;

      FILE = POINTER TO FHBlock;
      FHBlock = RECORD
                   Next:          FILE;
                   Handle:        RealFileType;
                   Mode:          Access;
                   CharsRead:     CARDINAL;
                   Count:         CARDINAL;
                   Prompt:        ARRAY [0..MaxPrompt] OF CHAR;
                   Info:          ARRAY [0..BufferSize] OF CHAR;
                END;

(*----------------------------------------------------------------------*)

TYPE  Chars = [00C..37C];
      Terms = SET OF Chars;

CONST Space         = ' ';
      Terminators   = Terms{ASCII.NUL,ASCII.EOL,ASCII.EOF};
      WhiteSpace    = Terms{ASCII.EOL,ASCII.HT};

(*----------------------------------------------------------------------*)

VAR Files:  FILE;                       (* the tracking list      *)

VAR InpBLK: FHBlock;                    (* predefined structures  *)
    OutBLK: FHBlock;                    (* for INPUT and OUTPUT   *)

VAR WB:     BOOLEAN;                    (* started from workbench?*)
    process:ProcessPtr;

(*----------------------------------------------------------------------*)

@IF FORWARD THEN
   PROCEDURE OSOpen(VAR F: RealFileType;
                    FileName: ARRAY OF CHAR):BOOLEAN;           FORWARD;
   PROCEDURE OSAppend(VAR F: RealFileType;
                      FileName: ARRAY OF CHAR):BOOLEAN;         FORWARD;
   PROCEDURE OSCreate(VAR F: RealFileType;
                      FileName: ARRAY OF CHAR):BOOLEAN;         FORWARD;
   PROCEDURE OSClose(VAR F: RealFileType);                      FORWARD;
   PROCEDURE Flush(Output: FILE);                               FORWARD;
   PROCEDURE ReadInfo(Input: FILE);                             FORWARD;
@END

(*----------------------------------------------------------------------*)
(* Adds a file to the file list with the given permissions.  If it      *)
(* could not allocate storage, it closes the file and exits.  Otherwise *)
(* it returns a pointer to the file structure.                          *)
(*----------------------------------------------------------------------*)

@NoLongAddressing

PROCEDURE AddFile(VAR F: RealFileType; Permission: Access):FILE;

VAR file:  FILE;

BEGIN
   FStorage.ALLOCATE(file,SYSTEM.TSIZE(FHBlock));
   IF file # NIL THEN
      WITH file^ DO
         Mode:=Permission;                (* init. file struc *)
         Handle:=F;
         Count:=0;                        (* buffer empty *)
         CharsRead:=BufferSize+999;       (* forces read  *)
         Prompt[0]:=ASCII.NUL;
         Next:=Files;
      END;
      Files:=file;
   ELSE
      OSClose(F);
   END;
   RETURN file;
END AddFile;

(*----------------------------------------------------------------------*)
(* Opens a read-only file.                                              *)
(*----------------------------------------------------------------------*)

@NoCopyStrings
@LongAddressing

PROCEDURE Open(FileName: ARRAY OF CHAR):FILE;

VAR handle:  RealFileType;

BEGIN
   IF OSOpen(handle,FileName) THEN
      RETURN AddFile(handle,Read);
   ELSE
      RETURN NIL;
   END;
END Open;

(*----------------------------------------------------------------------*)
(* Opens a write-only file which writing is to begin after the last     *)
(* position of the file.                                                *)
(*----------------------------------------------------------------------*)

@NoCopyStrings

PROCEDURE Append(FileName: ARRAY OF CHAR):FILE;

VAR handle:  RealFileType;

BEGIN
   IF OSAppend(handle,FileName) THEN
      RETURN AddFile(handle,Write);
   ELSE
      RETURN NIL;
   END;
END Append;

(*----------------------------------------------------------------------*)
(* Creates or overwrites a file.                                        *)
(*----------------------------------------------------------------------*)

@NoCopyStrings

PROCEDURE Create(FileName: ARRAY OF CHAR):FILE;

VAR handle:  RealFileType;

BEGIN
   IF OSCreate(handle,FileName) THEN
      RETURN AddFile(handle,Write);
   ELSE
      RETURN NIL;
   END;
END Create;

(*----------------------------------------------------------------------*
 * Flushes a file's output buffer if it had Write access, OSCloses the  *
 * file, deallocates file header block, and removes file from File list *
 * If the file is not on list, it will do nothing.                      *
 *----------------------------------------------------------------------*)

@NoLongAddressing

PROCEDURE Close(VAR F: FILE);

VAR lead:   FILE;
    follow: FILE;

BEGIN
   lead:=Files;                         (* get head of tracking list    *)
   follow:=lead;
   WHILE (lead # NIL) AND (lead # F) DO;
      follow:=lead;
      lead:=lead^.Next;                 (* postcondition:               *)
   END;                                 (*    lead=NIL or lead=F        *)

   IF (lead # NIL) AND GoodFILE(F) THEN (* only close it if the FILE    *)
      WITH lead^ DO                     (* is on the list and active    *)
         IF lead=Files THEN
            Files:=Next;
         ELSE
            follow^.Next:=Next;
         END;
         IF Mode = Write THEN
            Flush(lead);
         END;
         Mode:=Closed;
         OSClose(Handle);
      END;
      FStorage.DEALLOCATE(lead,SYSTEM.TSIZE(FHBlock));
   END;
END Close;

(*----------------------------------------------------------------------*
 * Determines whether a FILE is a valid pointer or not.                 *
 *----------------------------------------------------------------------*)

@LongAddressing

PROCEDURE GoodFILE(F: FILE):BOOLEAN;

BEGIN
   @MACRO GoodFILE(F)
          ((@F#NIL) AND
           (@F^.Mode IN AccessSet{Read,Write}))
   @ENDM
   RETURN @GoodFILE(F);
END GoodFILE;

(*----------------------------------------------------------------------*
 * Set the prompt string for input FILEs.                               *
 *----------------------------------------------------------------------*)

@NoCopyStrings

PROCEDURE SetPrompt(F: FILE; prompt: ARRAY OF CHAR);
BEGIN
   IF @GoodFILE(F) THEN
      Strings.Assign(prompt,F^.Prompt);
   END
END SetPrompt;

(************************************************************************)
(* Input Procedures                                                     *)
(************************************************************************)

(*----------------------------------------------------------------------*
 * ReadChar reads the next charactor from the input buffer.  ReadChar   *
 * calls ReadInfo to fill the buffer when the contents OF the buffer    *
 * have been depleted.  It returns the next character IN the buffer     *
 * which has not been read.                                             *                                               *
 *----------------------------------------------------------------------*)

PROCEDURE ReadChar(Input: FILE):CHAR;

BEGIN
   @IF TRAPC THEN
      CtrlC.Check;
   @END
   IF @GoodFILE(Input) THEN
      WITH Input^ DO
         IF Mode = Read THEN
            IF CharsRead >= Count THEN
               CharsRead:=0;
               ReadInfo(Input);
            END;
            IF CharsRead < Count THEN
               INC(CharsRead);
               RETURN Info[CharsRead-1];
            END;
         ELSE
            RETURN ASCII.NUL;
         END;
      END;
   ELSE
      RETURN ASCII.NUL;
   END;
END ReadChar;

(*----------------------------------------------------------------------*
 * ReadString reads a string into the array given.  It reads characters *
 * into the array until either the array is full, or the EOL charactor  *
 * is reached.  It will not read past the end of line.                  *
 *----------------------------------------------------------------------*)

PROCEDURE ReadString(Input: FILE; VAR str:ARRAY OF CHAR);

VAR
  index,size : CARDINAL;
  ch         : CHAR;

BEGIN
   index:=0;
   size:=HIGH(str);
   LOOP
      IF index > size THEN
         IF NextChar(Input) IN Terminators THEN
             ch:=ReadChar(Input);
         END;
         EXIT;
      END;
      ch := ReadChar(Input);
      IF ch IN Terminators THEN
         str[index] := ASCII.NUL;
         EXIT;
      ELSE
         str[index] := ch;
         INC(index);
      END;
   END;
END ReadString;

(*----------------------------------------------------------------------*
 * ReadLn reads all the characters on the current line.  ReadLn calls   *
 * ReadChar and simply discards everything until it sees a EOL char.    *
 *----------------------------------------------------------------------*)

PROCEDURE ReadLn(Input: FILE);

BEGIN
   WHILE NOT(ReadChar(Input) IN Terminators) DO END;
END ReadLn;

(*----------------------------------------------------------------------*
 * NextChar returns the next of any pending characters, If there are no *
 * pending characters, it will call ReadInfo to get some.  CAVEAT       *
 * EMPTOR!!!  A poorly controlled NextChar, could cause a user to be    *
 * prompted for input.                                                  *
 *----------------------------------------------------------------------*)

PROCEDURE NextChar(Input: FILE):CHAR;

BEGIN
   IF @GoodFILE(Input) THEN
      WITH Input^ DO
         IF Mode = Read THEN
            IF CharsRead >= Count THEN
               CharsRead:=0;
               ReadInfo(Input);
            END;
            IF CharsRead < Count THEN
               RETURN Info[CharsRead];
            END;
         ELSE
            RETURN ASCII.NUL;
         END;
      END;
   ELSE
      RETURN ASCII.NUL;
   END;
END NextChar;

(************************************************************************)
(* Output Procedures                                                    *)
(************************************************************************)

(*----------------------------------------------------------------------*
 * WriteChar writes charactors TO the standard output channel.          *
 *----------------------------------------------------------------------*)

PROCEDURE WriteChar(Output: FILE; ch:CHAR);

BEGIN
   @IF TRAPC THEN
      CtrlC.Check;
   @END
   IF @GoodFILE(Output) THEN
      WITH Output^ DO
         IF Mode = Write THEN
            Info[Count]:=ch;
            INC(Count);
            IF (Count > BufferSize) THEN
               Flush(Output);
            END;
         END;
      END;
   END;
END WriteChar;

(*----------------------------------------------------------------------*
 * WriteLn writes a line feed to the standard output channel.  It       *
 * relies on the error checking performed by WriteChar.                 *
 *----------------------------------------------------------------------*)

PROCEDURE WriteLn(Output: FILE);

BEGIN
   WriteChar(Output,ASCII.EOL);
   IF Output = OUTPUT THEN
      Flush(Output);
   END;
END WriteLn;

(*----------------------------------------------------------------------*
 * WriteString writes strings to the standard output channel.  The      *
 * amount which it writes is determined by whether it finds a string    *
 * terminator (NUL) or the actual length of the string.                 *
 *----------------------------------------------------------------------*)

@NoCopyStrings

PROCEDURE WriteString(Output: FILE; str: ARRAY OF CHAR);

VAR len,I: CARDINAL;

BEGIN
   len:=Strings.Length(str);
   I:=0;
   WHILE I < len DO
       WriteChar(Output,str[I]);
       INC(I);
   END;
END WriteString;

(*----------------------------------------------------------------------*)
(* Writes an unsigned integer recursively, neat no?                     *)
(*----------------------------------------------------------------------*)

PROCEDURE WriteCard(Output: FILE; c:CARDINAL);

BEGIN
   IF c>9 THEN WriteCard(Output,c DIV 10); END;
   WriteChar(Output,CHR(ORD('0')+(c MOD 10)));
END WriteCard;

(*----------------------------------------------------------------------*)
(* Termination PROCEDURE -- Closes out all open files                   *)
(*----------------------------------------------------------------------*)

@NoLongAddressing

PROCEDURE CloseAllFiles;

BEGIN
   WHILE Files # NIL DO
      Close(Files);
   END;
   Flush(OUTPUT);
   IF WB THEN OSClose(OUTPUT^.Handle) END;
   @IF TDI THEN
      Libraries.CloseLibrary(DOSLibrary.DOSBase);
   @END
END CloseAllFiles;


(************************************************************************)
(* Implementation dependent procedures                                  *)
(************************************************************************)

@LongAddressing

@MACRO OSGoodFile(F)
   @IF    M2S THEN (@F#NIL)
   @ELSIF TDI THEN (@F#0)
   @ELSE
         (* insert implementation dependent stuff here *)
   @END
@ENDM

(*----------------------------------------------------------------------*)
(* Opens a file for read access.  If unsuccessful, it returns false and *)
(* F is left undefined                                                  *)
(*----------------------------------------------------------------------*)

@NoCopyStrings

PROCEDURE OSOpen(VAR F: RealFileType; FileName: ARRAY OF CHAR):BOOLEAN;

VAR @IF M2S THEN
       name:  SYSTEM.ADDRESS;
       FN:    ARRAY [0..MaxFileName] OF CHAR;
    @END

BEGIN
   @IF M2S THEN
      name:=SYSTEM.ADR(FN);
      Strings.Assign(FileName,FN);
   @END

   @IF    M2S THEN
      F:=DOS.Open(name,DOS.ModeOldFile);
   @ELSIF TDI THEN
      F:=DOSFiles.Open(FileName,DOSFiles.ModeOldFile);
   @ELSE
      (* insert machine dependent stuff here *)
   @END

   RETURN @OSGoodFile(F);
END OSOpen;

(*----------------------------------------------------------------------*)
(* Opens a file for writing and seeks to the end of that file.          *)
(*----------------------------------------------------------------------*)

PROCEDURE OSAppend(VAR F: RealFileType; FileName: ARRAY OF CHAR):BOOLEAN;

VAR @IF M2S THEN
       name:  SYSTEM.ADDRESS;
       FN:    ARRAY [0..MaxFileName] OF CHAR;
    @END
VAR stat: LONGINT;

BEGIN
   @IF M2S THEN
      name:=SYSTEM.ADR(FN);
      Strings.Assign(FileName,FN);
   @END

   @IF    M2S THEN
      F:=DOS.Open(name,DOS.ModeReadWrite);
   @ELSIF TDI THEN
      F:=DOSFiles.Open(FileName,DOSFiles.ModeReadWrite);
   @ELSE
      (* insert machine dependent stuff here *)
   @END

   IF @OSGoodFile(F) THEN
      @IF    M2S THEN
         stat:=DOS.Seek(F,LONGINT(0),DOS.OffsetEnd);
      @ELSIF TDI THEN
         stat:=DOSFiles.Seek(F,LONGINT(0),DOSFiles.OffsetEnd);
      @ELSE
         (* insert implementation dependent stuff here *)
      @END
   END;
   RETURN @OSGoodFile(F);
END OSAppend;

(*----------------------------------------------------------------------*)
(* Opens a file for writing.  If unsuccessful, it returns false and     *)
(* F is left undefined                                                  *)
(*----------------------------------------------------------------------*)

@NoCopyStrings

PROCEDURE OSCreate(VAR F: RealFileType; FileName: ARRAY OF CHAR):BOOLEAN;

VAR @IF M2S THEN
       name:  SYSTEM.ADDRESS;
       FN:    ARRAY [0..MaxFileName] OF CHAR;
    @END

BEGIN
   @IF M2S THEN
      name:=SYSTEM.ADR(FN);
      Strings.Assign(FileName,FN);
   @END

   @IF    M2S THEN
      F:=DOS.Open(name,DOS.ModeNewFile);
   @ELSIF TDI THEN
      F:=DOSFiles.Open(FileName,DOSFiles.ModeNewFile);
   @ELSE
      (* insert machine dependent stuff here *)
   @END

   RETURN @OSGoodFile(F);
END OSCreate;

(*----------------------------------------------------------------------*)
(* Closes a FILE                                                        *)
(*----------------------------------------------------------------------*)

PROCEDURE OSClose(VAR F: RealFileType);

BEGIN
   @IF    M2S THEN
      DOS.Close(F);
      F:=NIL;
   @ELSIF TDI THEN
      DOSFiles.Close(F);
      F:=0;
   @ELSE
      (* insert implementation defined close here *)
   @END
END OSClose;

(*----------------------------------------------------------------------*
 * Flush pending writes out from output buffer.                         *
 *                                                                      *
 * *** IMPLEMENTATION DEPENDENT ***                                     *
 *----------------------------------------------------------------------*)

PROCEDURE Flush(Output: FILE);

VAR len: LONGINT;

BEGIN
  WITH Output^ DO
    IF Count <> 0 THEN
      @IF    M2S THEN
         len:= DOS.Write(Handle,SYSTEM.ADR(Info),Count);
      @ELSIF TDI THEN
         len:= DOSFiles.Write(Handle,SYSTEM.ADR(Info),LONGINT(Count));
      @ELSE
         (* here's where you add stuff for other platforms *)
      @END
      Count:=0;
    END;
  END;
END Flush;

(*----------------------------------------------------------------------*
 * ReadInfo *** IMPLEMENTATION DEPENDENT ***                            *
 *                                                                      *
 * ReadInfo reads info from the standard input, AND stores it in the    *
 * input buffer.  It is local to this module and will require changing  *
 * for different implementations.  This implementation utilizes the     *
 * standard AmigaDOS library read routine to fill the buffer.  When it  *
 * hits EOF, it will tack the EOF charactor onto the end of the buffer. *
 * This way it will be detected by other procedures properly.           *
 *----------------------------------------------------------------------*)

PROCEDURE ReadInfo(Input: FILE);

BEGIN
   WITH Input^ DO
      IF Input=INPUT THEN
         WriteString(OUTPUT,Prompt);
         Flush(OUTPUT);
      END;
      @IF    M2S THEN
         Count := DOS.Read(Handle,SYSTEM.ADR(Info),BufferSize);
      @ELSIF TDI THEN
         Count := CARDINAL(DOSFiles.Read(Handle,SYSTEM.ADR(Info),BufferSize));
      @ELSE
        (* here's where you add other platforms *)
      @END
      IF Count = 0 THEN
         Info[0]:=ASCII.EOF;
         INC(Count);
      END;
   END;
END ReadInfo;


(************************************************************************)
(* Initialization for IO                                                *)
(************************************************************************)

BEGIN
   @IF TDI THEN
      DOSLibrary.DOSBase:=Libraries.OpenLibrary(DOSLibrary.DOSName,0);
   @END

   Window := 'CON:40/50/600/150/FIO';

   Files:=NIL;

   @IF AMIGA & (M2S|TDI) THEN
      @IF    M2S THEN
         process:=RunTime.CurrentProcess;
      @ELSIF TDI THEN
         process:=AMIGAX.ProcessPtr;
      @ELSE
           (* insert compiler dependent stuff here *)
      @END
      WB:=SYSTEM.ADDRESS(process^.prCLI)=NIL;
   @END

   INPUT :=SYSTEM.ADR(InpBLK);
   WITH INPUT^ DO;
      IF WB THEN
         @IF    M2S THEN
            Handle:=DOS.Open(SYSTEM.ADR(Window),DOS.ModeReadWrite);
         @ELSIF TDI THEN
            Handle:=DOSFiles.Open(Window,DOSFiles.ModeReadWrite);
         @ELSE
            (* insert machine dependent stuff here *)
         @END
      ELSE
         @IF    M2S THEN                   (* IMPLEMENTATION DEPENDENT *)
            Handle:=DOS.Input();
         @ELSIF TDI THEN
            Handle:=DOSFiles.Input();
         @ELSE
            (* for other platforms *)
         @END
      END;
      Next:=NIL;
      Mode:=Read;
      Count:=0;
      CharsRead:=BufferSize+999;
      Prompt:='> ';
   END;

   OUTPUT:=SYSTEM.ADR(OutBLK);
   WITH OUTPUT^ DO;
      IF WB THEN
         Handle:=INPUT^.Handle;
      ELSE
         @IF    M2S THEN                   (* IMPLEMENTATION DEPENDENT *)
            Handle:=DOS.Output();
         @ELSIF TDI THEN
            Handle:=DOSFiles.Output();
         @ELSE
            (* for other platforms *)
         @END
      END;
      Next:=NIL;
      Mode:=Write;
      Count:=0;
      CharsRead:=BufferSize+999;
   END;
END FIO.