Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/549a.lha/M2P_v1.0/mods.lzh/FIO.mod

Text File | 1991-08-10 | 16KB | 743 lines

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

IMPLEMENTATION MODULE FIO;

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

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
















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

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

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

TYPE
    RealFileType =


 (* insert implementation specific type here *)


(*----------------------------------------------------------------------*)
(* 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;

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













(*----------------------------------------------------------------------*)
(* 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.                          *)
(*----------------------------------------------------------------------*)



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.                                              *)
(*----------------------------------------------------------------------*)




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.                                                *)
(*----------------------------------------------------------------------*)



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.                                        *)
(*----------------------------------------------------------------------*)



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.                      *
 *----------------------------------------------------------------------*)



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.                 *
 *----------------------------------------------------------------------*)



PROCEDURE GoodFILE(F: FILE):BOOLEAN;

BEGIN




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

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



PROCEDURE SetPrompt(F: FILE; prompt: ARRAY OF CHAR);
BEGIN
    IF ((F#NIL) AND (F^.Mode IN AccessSet{Read,Write}))  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 ((Input#NIL) AND (Input^.Mode IN AccessSet{Read,Write}))  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 ((Input#NIL) AND (Input^.Mode IN AccessSet{Read,Write}))  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 ((Output#NIL) AND (Output^.Mode IN AccessSet{Read,Write}))  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.                 *
 *----------------------------------------------------------------------*)



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                   *)
(*----------------------------------------------------------------------*)



PROCEDURE CloseAllFiles;

BEGIN
    WHILE Files # NIL DO
        Close(Files);
    END;
    Flush(OUTPUT);
    IF WB THEN
        OSClose(OUTPUT^.Handle) END;



END CloseAllFiles;


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











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



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

VAR




    BEGIN










 (* insert machine dependent stuff here *)


    RETURN   ;
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



    VAR stat: LONGINT;

BEGIN










 (* insert machine dependent stuff here *)


    IF    THEN





 (* insert implementation dependent stuff here *)

    END;
    RETURN   ;
END OSAppend;

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



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

VAR




    BEGIN










 (* insert machine dependent stuff here *)


    RETURN   ;
END OSCreate;

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

PROCEDURE OSClose(VAR F: RealFileType);

BEGIN







 (* insert implementation defined close here *)

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





 (* here's where you add stuff for other platforms *)

            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;





 (* here's where you add other platforms *)

        IF Count = 0 THEN
            Info[0]:=ASCII.EOF;
            INC(Count);
        END;
    END;
END ReadInfo;


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

BEGIN




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

    Files:=NIL;







(* insert compiler dependent stuff here *)




    INPUT :=SYSTEM.ADR(InpBLK);
    WITH INPUT^ DO;
        IF WB THEN





 (* insert machine dependent stuff here *)

        ELSE
 (* IMPLEMENTATION DEPENDENT *)




 (* for other platforms *)

        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
 (* IMPLEMENTATION DEPENDENT *)




 (* for other platforms *)

        END;
        Next:=NIL;
        Mode:=Write;
        Count:=0;
        CharsRead:=BufferSize+999;
    END;
END FIO.