fileio.mod

一个Modula-2语言分析器

IMPLEMENTATION MODULE FileIO;
(* GPM-PC Modula version by Pat Terry.  [e-mail] 1995-09-15 *)

(* This version is still unsatisfactory,  Teading from "con" with
   redirected input does not work properly.  Input is then taken from the
   stdIn channel, CR/LF generates two EOL chars, and End of file cannot be
   detected unless the attached file has a CTRL-Z at the end.  However, it is
   about as close as we can get it to the same semantics as other
   implementations *)

(* This module attempts to provide several potentially non-portable
   facilities for Coco/R.

   (a)  A general file input/output module, with all routines required for
        Coco/R itself, as well as several other that would be useful in
        Coco-generated applications.
   (b)  Definition of the "LONGINT" type needed by Coco.
   (c)  Some conversion functions to handle this long type.
   (d)  Some "long" and other constant literals that may be problematic
        on some implementations.
   (e)  Some string handling primitives needed to interface to a variety
        of known implementations.

   The intention is that the rest of the code of Coco and its generated
   parsers should be as portable as possible.  Provided the definition
   module given, and the associated implementation, satisfy the
   specification given here, this should be almost 100% possible.

   FileIO is based on code by MB 1990/11/25; heavily modified and extended
   by PDT and others between 1992/1/6 and the present day. *)

IMPORT UxFiles, StdStrings, SYSTEM, StdFiles, GpFiles, SysClock,
       Terminal, StdError, ProgArgs;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;

CONST
  MaxFiles = BitSetSize;
  NameLength = 256;
  notImp = "Delete not implemented in this version";

TYPE
  File = POINTER TO FileRec;
  FileRec = RECORD
              ref: UxFiles.File;
              self: File;
              handle: CARDINAL;
              savedCh: CHAR;
              textOK, eof, eol, noOutput, noInput, haveCh: BOOLEAN;
              name: ARRAY [0 .. NameLength] OF CHAR;
            END;

VAR
  Handles: BITSET;
  Opened: ARRAY [0 .. MaxFiles-1] OF File;
  FromKeyboard, ToScreen: BOOLEAN;
  Param: CARDINAL;
  numPar: CARDINAL;

PROCEDURE ErrWrite (ch: CHAR);
  BEGIN
    StdError.Write(ch);
  END ErrWrite;

PROCEDURE ConWrite (ch: CHAR);
  BEGIN
    StdError.Write(ch);
  END ConWrite;

PROCEDURE ConRead (VAR ch: CHAR);
  BEGIN
    Terminal.GetKeyStroke(ch); (* raw, but maps CR to LF behind your back! *)
    IF ch = LF THEN ch := EOL END;
  END ConRead;

PROCEDURE StdInRead (VAR ch: CHAR);
  BEGIN
    Terminal.Read(ch); (* cooked, and maps CR or CR/LF to LF behind your back! *)
    IF ch = LF THEN ch := EOL END;
  END StdInRead;

PROCEDURE NotRead (f: File): BOOLEAN;
  BEGIN
    RETURN (f = NIL) OR (f^.self # f) OR (f^.noInput);
  END NotRead;

PROCEDURE NotWrite (f: File): BOOLEAN;
  BEGIN
    RETURN (f = NIL) OR (f^.self # f) OR (f^.noOutput);
  END NotWrite;

PROCEDURE NotFile (f: File): BOOLEAN;
  BEGIN
    RETURN (f = NIL) OR (f^.self # f) OR (f = con) OR (f = err)
      OR (f = StdIn) & FromKeyboard
      OR (f = StdOut) & ToScreen
  END NotFile;

PROCEDURE CheckRedirection;
(* Seems no way to do this properly in the GPM-PC version *)
  BEGIN
    FromKeyboard := TRUE; ToScreen := TRUE; (* ISO fail safe *)
    (* Ideally we would like
       FromKeyboard := NOT (StdIn has been redirected )
       ToScreen := NOT (StdOut has been redirected )
    *)
  END CheckRedirection;

PROCEDURE ASCIIZ (VAR s1, s2: ARRAY OF CHAR);
(* Convert s2 to a nul terminated string in s1 *)
  VAR
    i: CARDINAL;
  BEGIN
    i := 0;
    WHILE (i <= HIGH(s2)) & (s2[i] # 0C) DO
      s1[i] := s2[i]; INC(i)
    END;
    s1[i] := 0C
  END ASCIIZ;

PROCEDURE NextParameter (VAR s: ARRAY OF CHAR);
  BEGIN
    INC(Param);
    IF Param < numPar
      THEN ProgArgs.GetArg(Param,s);
      ELSE s[0] := 0C
    END
  END NextParameter;

PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
  BEGIN
    ProgArgs.EnvironString(envVar, s);
  END GetEnv;

PROCEDURE Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN);
  VAR
    i: CARDINAL;
    name: ARRAY [0 .. NameLength] OF CHAR;
  BEGIN
    ExtractFileName(fileName, name);
    FOR i := 0 TO NameLength - 1 DO name[i] := CAP(name[i]) END;
    IF (name[0] = 0C) OR (Compare(name, "CON") = 0) THEN
      (* con already opened, but reset it *)
      Okay := TRUE; f := con;
      f^.savedCh := 0C; f^.haveCh := FALSE;
      f^.eof := FALSE; f^.eol := FALSE; f^.name := "CON";
      RETURN
    ELSIF Compare(name, "ERR") = 0 THEN
      Okay := TRUE; f := err; RETURN
    ELSE
      ALLOCATE(f, SYSTEM.TSIZE(FileRec));
      IF newFile
        THEN GpFiles.GpCreateFile(fileName, "", f^.name, f^.ref);
        ELSE GpFiles.GpFindLocal(fileName, "", f^.name, f^.ref);
      END;
      Okay := f^.ref # NIL;
      IF ~ Okay
        THEN
          DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); f := NIL
        ELSE
      (* textOK below may have to be altered according to implementation *)
          f^.savedCh := 0C; f^.haveCh := FALSE; f^.textOK := TRUE;
          f^.eof := newFile; f^.eol := newFile; f^.self := f;
          f^.noInput := newFile; f^.noOutput := ~ newFile;
          ASCIIZ(f^.name, fileName);
          i := 0 (* find next available filehandle *);
          WHILE (i IN Handles) & (i < MaxFiles) DO INC(i) END;
          IF i < MaxFiles
            THEN f^.handle := i; INCL(Handles, i); Opened[i] := f
            ELSE WriteString(err, "Too many files"); Okay := FALSE
          END;
      END
    END
  END Open;

PROCEDURE Close (VAR f: File);
  BEGIN
    IF NotFile(f) OR (f = StdIn) OR (f = StdOut)
      THEN Okay := FALSE
      ELSE
        EXCL(Handles, f^.handle);
        UxFiles.Close(f^.ref, Okay);
        IF Okay THEN DEALLOCATE(f, SYSTEM.TSIZE(FileRec)) END;
        f := NIL
    END
  END Close;

PROCEDURE Delete (VAR f: File);
  BEGIN 
    ProgArgs.Assert(FALSE, notImp);
    (* UxFiles wants a filename! *)
(*
    IF NotFile(f) OR (f = StdIn) OR (f = StdOut)
      THEN Okay := FALSE
      ELSE WriteString(err, "FileIO.Delete not implemented")
    END;
    Okay := FALSE; f := NIL
*)
  END Delete;

(* The following utility procedure is not used by Coco, but may be useful.
   It is unique to the Gardens Point version, and is non portable *)

PROCEDURE GetUxFile (f: File): UxFiles.File;
  BEGIN
    IF (f = NIL) OR (f^.self # f) 
      THEN Okay := FALSE; RETURN NIL
      ELSE Okay := TRUE;  RETURN f^.ref
    END
  END GetUxFile;

PROCEDURE SearchFile (VAR f: File; envVar, fileName: ARRAY OF CHAR;
                      newFile: BOOLEAN);
  VAR
    fname: ARRAY [0 .. NameLength] OF CHAR;
    path: ARRAY [0 .. NameLength] OF CHAR;
    temp: UxFiles.File;
  BEGIN
    ProgArgs.EnvironString(envVar, path);
    GpFiles.GpFindOnPath(path, fileName, "", fname, temp);
    IF temp # NIL 
      THEN UxFiles.Close(temp, Okay); Open(f, fname, newFile);
      ELSE Okay := FALSE;
    END
  END SearchFile;

PROCEDURE ExtractDirectory (fullName: ARRAY OF CHAR;
                            VAR directory: ARRAY OF CHAR);
  VAR
    i, start: CARDINAL;
  BEGIN
    start := 0; i := 0;
    WHILE (i <= HIGH(fullName)) & (fullName[i] # 0C) DO
      IF i <= HIGH(directory) THEN
        directory[i] := fullName[i];
      END;
      IF (fullName[i] = ":") OR (fullName[i] = DirSep) THEN start := i + 1 END;
      INC(i)
    END;
    IF start <= HIGH(directory) THEN directory[start] := 0C END
  END ExtractDirectory;

PROCEDURE ExtractFileName (fullName: ARRAY OF CHAR;
                           VAR fileName: ARRAY OF CHAR);
  VAR
    i, l, start: CARDINAL;
  BEGIN
    start := 0; l := 0;
    WHILE (l <= HIGH(fullName)) & (fullName[l] # 0C) DO
      IF (fullName[l] = ":") OR (fullName[l] = DirSep) THEN start := l + 1 END;
      INC(l)
    END;
    i := 0;
    WHILE (start < l) & (i <= HIGH(fileName)) DO
      fileName[i] := fullName[start]; INC(start); INC(i)
    END;
    IF i <= HIGH(fileName) THEN fileName[i] := 0C END
  END ExtractFileName;

PROCEDURE AppendExtension (oldName, ext: ARRAY OF CHAR;
                           VAR newName: ARRAY OF CHAR);
  VAR
    i, j: CARDINAL;
    fn: ARRAY [0 .. NameLength] OF CHAR;
  BEGIN
    ExtractDirectory(oldName, newName);
    ExtractFileName(oldName, fn);
    i := 0; j := 0;
    WHILE (i <= NameLength) & (fn[i] # 0C) DO
      IF fn[i] = "." THEN j := i + 1 END;
      INC(i)
    END;
    IF (j # i) (* then name did not end with "." *) OR (i = 0) THEN
      IF j # 0 THEN i := j - 1 END;
      IF (ext[0] # ".") & (ext[0] # 0C) THEN
        IF i <= NameLength THEN fn[i] := "."; INC(i) END
      END;
      j := 0;
      WHILE (j <= HIGH(ext)) & (ext[j] # 0C) & (i <= NameLength) DO
        fn[i] := ext[j]; INC(i); INC(j)
      END
    END;
    IF i <= NameLength THEN fn[i] := 0C END;
    Concat(newName, fn, newName)
  END AppendExtension;

PROCEDURE ChangeExtension (oldName, ext: ARRAY OF CHAR;
                           VAR newName: ARRAY OF CHAR);
  VAR
    i, j: CARDINAL;
    fn: ARRAY [0 .. NameLength] OF CHAR;
  BEGIN
    ExtractDirectory(oldName, newName);
    ExtractFileName(oldName, fn);
    i := 0; j := 0;
    WHILE (i <= NameLength) & (fn[i] # 0C) DO
      IF fn[i] = "." THEN j := i + 1 END;
      INC(i)
    END;
    IF j # 0 THEN i := j - 1 END;
    IF (ext[0] # ".") & (ext[0] # 0C) THEN
      IF i <= NameLength THEN fn[i] := "."; INC(i) END
    END;
    j := 0;
    WHILE (j <= HIGH(ext)) & (ext[j] # 0C) & (i <= NameLength) DO
      fn[i] := ext[j]; INC(i); INC(j)
    END;
    IF i <= NameLength THEN fn[i] := 0C END;
    Concat(newName, fn, newName)
  END ChangeExtension;

PROCEDURE Length (f: File): INT32;
  VAR
    pos, len: INTEGER;
  BEGIN
    IF NotFile(f)
      THEN Okay := FALSE; RETURN Long0
      ELSE Okay := TRUE;  RETURN StdFiles.Length(f^.ref)
    END
  END Length;

PROCEDURE GetPos (f: File): INT32;
  VAR
    pos: CARDINAL;
  BEGIN
    IF NotFile(f)
      THEN Okay := FALSE; RETURN Long0
      ELSE UxFiles.GetPos(f^.ref, pos);
    END;
    RETURN VAL(INT32, pos);
  END GetPos;

PROCEDURE SetPos (f: File; pos: INT32);
  BEGIN
    IF NotFile(f)
      THEN Okay := FALSE
      ELSE UxFiles.SetPos(f^.ref, pos); f^.haveCh := FALSE
    END
  END SetPos;

PROCEDURE Reset (f: File);
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE
      ELSE
        SetPos(f, 0);
        IF Okay THEN
          f^.haveCh := FALSE; f^.eof := f^.noInput; f^.eol := f^.noInput
        END
    END
  END Reset;

PROCEDURE Rewrite (f: File);
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE
      ELSE
        UxFiles.Close(f^.ref, Okay);
        UxFiles.Open(f^.ref, f^.name, UxFiles.WriteOnly, Okay);  
        IF ~ Okay
          THEN
            DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); f := NIL
          ELSE
            f^.savedCh := 0C; f^.haveCh := FALSE;
            f^.eof := TRUE; f^.eol := TRUE; 
            f^.noInput := TRUE; f^.noOutput := FALSE;
        END
    END
  END Rewrite;

PROCEDURE EndOfLine (f: File): BOOLEAN;
  BEGIN
    IF NotRead(f)
      THEN Okay := FALSE; RETURN TRUE
      ELSE Okay := TRUE; RETURN f^.eol OR f^.eof
    END
  END EndOfLine;

PROCEDURE EndOfFile (f: File): BOOLEAN;
  BEGIN
    IF NotRead(f)
      THEN Okay := FALSE; RETURN TRUE
      ELSE Okay := TRUE; RETURN f^.eof
    END
  END EndOfFile;

PROCEDURE Read (f: File; VAR ch: CHAR);
  BEGIN
    IF NotRead(f) THEN Okay := FALSE; ch := 0C; RETURN END;
    IF f^.haveCh OR f^.eof
      THEN
        ch := f^.savedCh; Okay := ch # 0C;
      ELSE
        IF (f = con) (* OR (f = StdIn) & FromKeyboard *)
          THEN
            ConRead(ch); Write(con, ch);
            IF ch = BS THEN ConWrite(" "); ConWrite(BS) END;
            Okay := ch # EOFChar;
        ELSIF (f = StdIn) & FromKeyboard
          THEN
            StdInRead(ch); (* Write(con, ch);
            IF ch = BS THEN ConWrite(" "); ConWrite(BS) END; *)
            Okay := ch # EOFChar;
          ELSE
            UxFiles.ReadByte(f^.ref, ch);
            IF (ch = 377C) AND UxFiles.EndFile(f^.ref) THEN Okay := FALSE END;
            IF ch = CR THEN UxFiles.ReadByte(f^.ref, ch); ch := EOL END;
        END;
    END;
    IF ~ Okay THEN ch := 0C END;
    f^.savedCh := ch; f^.haveCh := ~ Okay;
    f^.eof := ch = 0C; f^.eol := f^.eof OR (ch = EOL);
  END Read;

PROCEDURE ReadAgain (f: File);
  BEGIN
    IF NotRead(f)
      THEN Okay := FALSE
      ELSE f^.haveCh := TRUE
    END
  END ReadAgain;

PROCEDURE ReadLn (f: File);
  VAR
    ch: CHAR;