fileio.mod

一个Modula-2语言分析器

IMPLEMENTATION MODULE FileIO;
(* Logitech 3 version by 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. *)

IMPORT FileSystem, Strings, SYSTEM, RTSMain;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM RTSMain IMPORT Status;

CONST
  MaxFiles = BitSetSize;
  NameLength = 256;
  BufSize = 256;

TYPE
  Environ = POINTER TO ARRAY [0 .. 10000] OF CHAR;
  File = POINTER TO FileRec;
  FileRec = RECORD
              ref: FileSystem.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;
  InBuf, OutBuf: ARRAY [0 .. BufSize - 1] OF CHAR;
  InPos, InLen, OutPos: CARDINAL;
  Param: CARDINAL;
  EnvPtr: Environ;
  CmdLine: ARRAY [0 .. 127] OF CHAR;
  CmdIndx, CmdLength: CARDINAL;

PROCEDURE StdInRead (VAR ch: CHAR);
  VAR
    Adr: SYSTEM.ADDRESS;
    status: CARDINAL;
  BEGIN
    Okay := TRUE;
    IF InPos = InLen THEN
      Adr := SYSTEM.ADR(InBuf);
      SYSTEM.DOSCALL(3FH, 0, 256, Adr, InLen, status);
      Okay :=  ~ (0 IN BITSET(status)) & (InLen # 0);
      InPos := 0
    END;
    IF Okay THEN ch := InBuf[InPos]; INC(InPos) END
  END StdInRead;

PROCEDURE StdOutWrite (ch: CHAR);
(* Buffered write to redirected output *)
  VAR
    Adr: SYSTEM.ADDRESS;
    Result, status: CARDINAL;
  BEGIN
    Okay := TRUE;
    OutBuf[OutPos] := ch; INC(OutPos);
    IF OutPos = 256 THEN
      OutPos := 0;
      Adr := SYSTEM.ADR(OutBuf);
      SYSTEM.DOSCALL(40H, 1, 256, Adr, Result, status);
      Okay :=  ~ (0 IN BITSET(status)) & (Result = 256)
    END;
  END StdOutWrite;

PROCEDURE ErrWrite (ch: CHAR);
  VAR
    Adr: SYSTEM.ADDRESS;
    Result, status: CARDINAL;
  BEGIN
    Adr := SYSTEM.ADR(ch);
    SYSTEM.DOSCALL(40H, 2, 1, Adr, Result, status);
  END ErrWrite;

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

PROCEDURE ConRead (VAR ch: CHAR);
  BEGIN
    SYSTEM.SETREG(SYSTEM.AX, 0);
    SYSTEM.CODE(55H); SYSTEM.SWI(16H); SYSTEM.CODE(5DH);
    SYSTEM.GETREG(SYSTEM.AX, ch);
    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;
  VAR
    Res: BOOLEAN;
  BEGIN
    Res := (f = NIL) OR (f^.self # f) OR (File(f) = con) OR (File(f) = err);
    Res := Res OR (File(f) = StdIn) & FromKeyboard
               OR (File(f) = StdOut) & ToScreen;
    RETURN Res;
  END NotFile;

PROCEDURE CheckRedirection;
  VAR
    DX, FLAGS: BITSET;
  BEGIN
    FromKeyboard := FALSE; ToScreen := FALSE;
    SYSTEM.DOSCALL(44H, 0, 0, DX, FLAGS);
    IF ~ (0 IN FLAGS) THEN
      IF {7, 0} <= DX THEN FromKeyboard := TRUE END;
    END;
    SYSTEM.DOSCALL(44H, 0, 1, DX, FLAGS);
    IF ~ (0 IN FLAGS) THEN
      IF {7, 1} <= 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);
  VAR
    i: CARDINAL;
  BEGIN
    WHILE (CmdIndx < CmdLength) & (CmdLine[CmdIndx] = " ") DO
      INC(CmdIndx);
    END;
    i := 0;
    IF CmdIndx < CmdLength THEN
      REPEAT
        IF i <= HIGH(s) THEN
          s[i] := CmdLine[CmdIndx];
          INC(i);
        END;
        INC(CmdIndx);
      UNTIL (CmdIndx >= CmdLength) OR (CmdLine[CmdIndx] = " ");
    END;
    IF i <= HIGH(s) THEN s[i] := 0C END;
  END NextParameter;

PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
  VAR
    i, j: CARDINAL;
  BEGIN
    i := 0;
    LOOP
      IF EnvPtr^[i] = 0C THEN EXIT END;
      j := 0;
      WHILE (j <= HIGH(envVar)) & (envVar[j] # 0C) & (EnvPtr^[i] = envVar[j]) DO
        INC(i); INC(j);
      END;
      IF ((j > HIGH(envVar)) OR (envVar[j] = 0C)) & (EnvPtr^[i] = "=") THEN
        INC(i); j := 0;
        WHILE (EnvPtr^[i] # 0C) & (j <= HIGH(s)) DO
          s[j] := EnvPtr^[i]; INC(i); INC(j);
        END;
        IF j <= HIGH(s) THEN s[j] := 0C END;
        RETURN;
      ELSE
        WHILE EnvPtr^[i] # 0C DO INC(i) END;
        INC(i);
      END;
    END;
    s[0] := 0C;
  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 FileSystem.Delete(fileName, f^.ref) END;
      FileSystem.Lookup(f^.ref, fileName, newFile);
      Okay := f^.ref.res = FileSystem.done;
      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 (File(f) = StdIn) OR (File(f) = StdOut)
      THEN Okay := FALSE
      ELSE
        EXCL(Handles, f^.handle);
        FileSystem.Close(f^.ref);
        Okay := f^.ref.res = FileSystem.done;
        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);
        FileSystem.Delete(f^.name, f^.ref);
        Okay := f^.ref.res = FileSystem.done;
        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);
    WHILE path[0] = " " DO Strings.Delete(path, 0, 1) END;
    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
    high, low: CARDINAL;
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE; RETURN Long0
      ELSE
        FileSystem.Length(f^.ref, high, low);
        Okay := f^.ref.res = FileSystem.done;
        RETURN VAL(LONGINT, high) * VAL(LONGINT, 65536) + VAL(LONGINT, low)
    END
  END Length;

PROCEDURE GetPos (f: File): INT32;
  VAR
    high, low: CARDINAL;
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE; RETURN Long0
      ELSE
        FileSystem.GetPos(f^.ref, high, low);
        Okay := f^.ref.res = FileSystem.done;
        RETURN VAL(LONGINT, high) * VAL(LONGINT, 65536) + VAL(LONGINT, low)
    END
  END GetPos;

PROCEDURE SetPos (f: File; pos: INT32);
  VAR
    high, low: CARDINAL;
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE
      ELSE
        high := VAL(CARDINAL, pos DIV 65536);
        low := VAL(CARDINAL, pos MOD 65536);
        FileSystem.SetPos(f^.ref, high, low);
        Okay := f^.ref.res = FileSystem.done; f^.haveCh := FALSE
    END
  END SetPos;

PROCEDURE Reset (f: File);
  BEGIN
    IF NotFile(f)
      THEN
        Okay := FALSE
      ELSE
        FileSystem.Reset(f^.ref);
        Okay := f^.ref.res = FileSystem.done;
        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
        FileSystem.Delete(f^.name, f^.ref);
        FileSystem.Lookup(f^.ref, f^.name, TRUE);
        Okay := f^.ref.res = FileSystem.done;
        IF Okay THEN
          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;
        ELSIF (f = File(StdIn))
          THEN
            StdInRead(ch);
            IF ch = EOFChar THEN Okay := FALSE END;
            IF ch = CR THEN StdInRead(ch); ch := EOL END
          ELSE
            FileSystem.ReadChar(f^.ref, ch);
            Okay := f^.ref.res = FileSystem.done;