fileio.mod

一个Modula-2语言分析器

IMPLEMENTATION MODULE FileIO;
(* ISO (GPM) version by Pat Terry.  Sat  04-25-98  [e-mail] *)

(* 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 ProgArgs, StdDevice, (* GPM specific *) 
       SYSTEM, Strings, SysClock, ProgramArgs, TextIO, RawIO, WholeIO,
       IOChan, IOResult, RndFile, TermFile, StdChans, ChanConsts;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;

CONST
  MaxFiles = BitSetSize;
  NameLength = 256;

TYPE
  File = POINTER TO FileRec;
  FileRec = RECORD
              ref: IOChan.ChanId;
              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;
  res: ChanConsts.OpenResults;

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;
  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
    IF ProgramArgs.IsArgPresent()
      THEN
        TextIO.ReadToken(ProgramArgs.ArgChan(), s);
        ProgramArgs.NextArg()
      ELSE s[0] := 0C
    END
  END NextParameter;

PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
(* ++++ GPM specific routine used ++++ *)
  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));
      (* Flags below may have to be altered according to implementation *)
      IF newFile
        THEN RndFile.OpenClean(f^.ref, fileName,
             RndFile.old (* + RndFile.text *) + RndFile.raw, res)
        ELSE RndFile.OpenOld(f^.ref, fileName,
             RndFile.read (* + RnfDile.text *) +RndFile.raw, res)
      END;
      Okay := res = RndFile.opened;
      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 := FALSE;
          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
    Okay := TRUE;
    IF NotFile(f) OR (f = StdIn) OR (f = StdOut)
      THEN Okay := FALSE
      ELSE
        EXCL(Handles, f^.handle);
        RndFile.Close(f^.ref);
        IF Okay THEN DEALLOCATE(f, SYSTEM.TSIZE(FileRec)) END;
        f := NIL
    END;
(*
  EXCEPT (* For ISO compilers *)
    Okay := FALSE; f := NIL; RETURN
*)
  END Close;

PROCEDURE Delete (VAR f: File);
(* ++++ GPM specific routine used ++++ *)
  VAR
    fname : ARRAY [0 .. NameLength] OF CHAR;
  BEGIN
    IF NotFile(f) OR (f = StdIn) OR (f = StdOut)
      THEN Okay := FALSE
      ELSE
        Assign(f^.name, fname);
        Close(f);
        StdDevice.Delete(fname, Okay);  (* GPM specific *)
    END
  END Delete;

PROCEDURE SearchFile (VAR f: File; envVar, fileName: ARRAY OF CHAR;
                      newFile: BOOLEAN);
  VAR
    i, j: INTEGER;
    k: CARDINAL;
    c: CHAR;
    fname: ARRAY [0 .. NameLength] OF CHAR;
    path: ARRAY [0 .. NameLength] OF CHAR;
  BEGIN
    FOR k := 0 TO HIGH(envVar) DO envVar[k] := CAP(envVar[k]) END;
    GetEnv(envVar, path);
    i := 0;
    REPEAT
      j := 0;
      REPEAT
        c := path[i]; fname[j] := c; INC(i); INC(j)
      UNTIL (c = PathSep) OR (c = 0C);
      IF (j > 1) & (fname[j-2] = DirSep) THEN DEC(j) ELSE fname[j-1] := DirSep END;
      fname[j] := 0C; Concat(fname, fileName, fname);
      Open(f, fname, newFile);
    UNTIL (c = 0C) OR Okay
  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;
(* ++++ implementation specific coercion routine may have to be used ++++ *)
  VAR
    pos: RndFile.FilePos;
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE; RETURN Long0
      ELSE
        Okay := TRUE;
        pos := RndFile.EndPos(f^.ref);
        (* ++++ GPM specific routine used ++++ *)
        RETURN VAL(INT32, pos)
    END;
(*
  EXCEPT (* For ISO compilers *)
    Okay := FALSE; RETURN Long0
*)
  END Length;

PROCEDURE GetPos (f: File): INT32;
(* ++++ implementation specific coercion routine may have to be used ++++ *)
  VAR
    pos: RndFile.FilePos;
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE; RETURN Long0
      ELSE
        Okay := TRUE;
        pos := RndFile.CurrentPos(f^.ref);
        (* ++++ GPM specific casting used ++++ *)
        RETURN VAL(INT32, pos)
    END;
(*
  EXCEPT (* For ISO compilers *)
    Okay := FALSE; RETURN Long0
*)
  END GetPos;

PROCEDURE SetPos (f: File; pos: INT32);
(* ++++ implementation specific coercion routine may have to be used ++++ *)
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE
      ELSE
        Okay := TRUE; f^.haveCh := FALSE;
        (* ++++ GPM specific routine used ++++ *)
        RndFile.SetPos(f^.ref, VAL(CARDINAL, pos));
    END;
(*
  EXCEPT (* For ISO compilers *)
    Okay := FALSE; f^.haveCh := FALSE; RETURN
*)
  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
        RndFile.Close(f^.ref);
        (* Flags below may have to be altered according to implementation *)
        RndFile.OpenClean(f^.ref, f^.name,
                          RndFile.old + (* RndFile.text + *) RndFile.raw, res);
        Okay := res = RndFile.opened;
        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;
(*
  EXCEPT (* For ISO compilers *)
    Okay := FALSE; RETURN
*)
  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
        Okay := TRUE;
        IF ~ f^.textOK (* Work around as best one can *)
          THEN RawIO.Read(f^.ref, ch)
          ELSE TextIO.ReadChar(f^.ref, ch);
        END; 
        IF f^.textOK & (IOResult.ReadResult(f^.ref) = IOResult.endOfLine)
          THEN TextIO.SkipLine(f^.ref); ch := EOL
          ELSIF ch = LF (* Work around possible bug *) THEN ch := EOL
        END;
        IF IOResult.ReadResult(f^.ref) = IOResult.endOfInput THEN
          Okay := FALSE; ch := 0C;
        END;
        IF ch = EOFChar THEN Okay := FALSE; ch := 0C 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;
  BEGIN
    IF NotRead(f) THEN Okay := FALSE; RETURN END;
    WHILE ~ f^.eol DO Read(f, ch) END;