fileio.mod

一个Modula-2语言分析器

IMPLEMENTATION MODULE FileIO;
(* JPI TopSpeed version by Pat Terry.  [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.
   Revised Fri  07-09-99 to incorporate OpenRead;
   thanks to Hans Ellenberger for suggesting this *)

IMPORT FIO, Str, Lib, SYSTEM;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;

CONST
  MaxFiles = BitSetSize;
  NameLength = 256;
  BufSize  = 1024 + FIO.BufferOverhead;

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

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

PROCEDURE ErrWrite (ch: CHAR);
  BEGIN
    FIO.WrChar(err^.ref, ch)
  END ErrWrite;

PROCEDURE ConWrite (ch: CHAR);
  BEGIN
    ErrWrite(ch);
  END ConWrite;

PROCEDURE ConRead (VAR ch: CHAR);
  VAR
    R: SYSTEM.Registers;
  BEGIN
    R.AX := 0; Lib.Intr(R, 16H); ch := CHR(R.AL);
    IF ch = CR THEN ch := EOL END;
  END ConRead;

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 (File(f) = con) OR (File(f) = err)
      OR (File(f) = StdIn) & FromKeyboard
      OR (File(f) = StdOut) & ToScreen
  END NotFile;

PROCEDURE CheckRedirection;
  VAR
    R: SYSTEM.Registers;
  BEGIN
    FromKeyboard := FALSE; ToScreen := FALSE;
    R.AX := 4400H; R.BX := 0; Lib.Dos(R);
    IF ~ (0 IN R.Flags) THEN
      IF {7, 0} <= BITSET(R.DX) THEN FromKeyboard := TRUE END;
    END;
    R.AX := 4400H; R.BX := 1; Lib.Dos(R);
    IF ~ (0 IN R.Flags) THEN
      IF {7, 1} <= BITSET(R.DX) THEN ToScreen := TRUE END;
    END;
  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 <= Lib.ParamCount()
      THEN Lib.ParamStr(s, Param);
      ELSE s[0] := 0C
    END;
  END NextParameter;

PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
  VAR
    n:  CARDINAL;
    pi: ARRAY [0 .. 14] OF CHAR;
    es: ARRAY [0 .. 80] OF CHAR;
    pp: Lib.CommandType;
  BEGIN
    n := 0;
    LOOP
      pp := Lib.Environment(n);
      Str.Copy(es, pp^);
      IF es[0] = CHR(0) THEN s[0] := CHR(0); RETURN END;
      Str.ItemS(pi, es, " =", 0);
      IF Str.Match(pi, envVar) THEN Str.ItemS(s, es, " =", 1); RETURN END;
      INC(n);
    END;
  END GetEnv;

PROCEDURE OpenRead (fileName: ARRAY OF CHAR) : FIO.File;
(* This appears to be portable across JPI 1.17 and JPI 3.2
   Code from Hans Ellenberger *)
  VAR
    r : SYSTEM.Registers;
  BEGIN
    WITH r DO
      AX := 3D00H; CX := 0;           (* Open for readonly *)
      DS := SYSTEM.Seg(fileName); DX := SYSTEM.Ofs(fileName);
      Lib.Dos(r);
      IF (SYSTEM.CarryFlag IN r.Flags) THEN
        FIO.OK := FALSE; FIO.EOF := TRUE;
        RETURN MAX(CARDINAL);
      ELSE
        FIO.EOF := FIO.Size(AX) = 0; (* Set EOF if file is empty *)
        RETURN AX;
      END;
    END;
  END OpenRead;

PROCEDURE Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN);
  VAR
    i: CARDINAL;
    NoWrite: BOOLEAN;
    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));
      NoWrite := FALSE;
      IF newFile
        THEN f^.ref := FIO.Create(fileName)
        ELSE
          f^.ref := FIO.Open(fileName);
          IF FIO.IOresult() # 0 THEN (* JPI 3.2 won't easily open r/o files *)
            f^.ref := OpenRead(fileName); NoWrite := TRUE;
          END;
      END;
      Okay := FIO.IOresult() = 0;
      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 OR NoWrite;
          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;
          IF Okay THEN FIO.AssignBuffer(f^.ref, f^.buffer) END;
      END
    END
  END Open;

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

PROCEDURE Delete (VAR f: File);
  BEGIN
    IF NotFile(f) OR (File(f) = StdIn) OR (File(f) = StdOut)
      THEN Okay := FALSE
      ELSE
        EXCL(Handles, f^.handle);
        FIO.Erase(f^.name);
        Okay := FIO.IOresult() = 0;
        IF Okay THEN DEALLOCATE(f, SYSTEM.TSIZE(FileRec)) END;
        f := NIL
    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;
  VAR
    result: LONGCARD;
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE; RETURN Long0
      ELSE
        result := FIO.Size(f^.ref);
        Okay := FIO.IOresult() = 0;
        RETURN INT32(result)
    END
  END Length;

PROCEDURE GetPos (f: File): INT32;
  VAR
    pos: INT32;
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE; RETURN Long0
      ELSE
        pos := FIO.GetPos(f^.ref);
        Okay := FIO.IOresult() = 0;
        RETURN pos
    END
  END GetPos;

PROCEDURE SetPos (f: File; pos: INT32);
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE
      ELSE
        FIO.Seek(f^.ref, pos);
        Okay := FIO.IOresult() = 0; 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);
  VAR
    c: CHAR;
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE
      ELSE
        SetPos(f, 0);
        IF Okay THEN
          WriteBytes(f, c, 0);
          f^.haveCh := FALSE; f^.savedCh := 0C;
          f^.eof := FALSE; f^.eol := 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 (File(f) = con) OR (File(f) = StdIn) & FromKeyboard
          THEN
            ConRead(ch); Write(con, ch);
            IF ch = BS THEN ConWrite(" "); ConWrite(BS) END;
            Okay := ch # EOFChar;
          ELSE
            ch := FIO.RdChar(f^.ref);
            IF ch = CR THEN ch := FIO.RdChar(f^.ref); ch := EOL END;
            Okay := FIO.IOresult() = 0;
            IF ch = EOFChar THEN Okay := FALSE 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);