fileio.mod

来自「一个Modula-2语言分析器」· MOD 代码 · 共 902 行 · 第 1/2 页

IMPLEMENTATION MODULE FileIO;
(* ISO (p1) version by Woodrow Yeung/Pat Terry.  Sat  04-25-98
   [e-mail] and [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.

   This version based on a heavily modified Gardens Point Modula version
   by John Gough, December 1993
   Modified by Woodrow Yeung for p1 Modula-2, February 1994
   p1 V5.3b1 4/24/95 -wy
   CocoR V1.39 10/4/95 -wy
   p1 V6.0b1 8/12/97 -wy
*)

IMPORT MPWRunTime, Files, Errors, Types, (* p1 specific *)
       SYSTEM, Strings, SysClock, ProgramArgs, TextIO, RawIO, WholeIO,
       IOChan, IOResult, RndFile, StreamFile, 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;
              fileSpec: Files.FSSpec; (* p1 specific *)
            END;

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

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);
  VAR
    i: CARDINAL;
  BEGIN
    INC(Param);
    s[0] := "";
    IF ~MPWRunTime.M2_StandingAlone() THEN
      IF ProgramArgs.IsArgPresent() THEN
        TextIO.ReadToken(ProgramArgs.ArgChan(), s);
        ProgramArgs.NextArg()
      END
    END
  END NextParameter;

PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
(* ++++ p1 specific routine used ++++ *) 
  VAR
    env: ARRAY [0 .. NameLength] OF CHAR;
  BEGIN
    s[0] := 0C;
    IF ~ MPWRunTime.M2_StandingAlone() THEN
      ASCIIZ(env, envVar);
      IF MPWRunTime.M2_GetEnv(env, s) THEN END (* toss function result *)
    END
  END GetEnv;

PROCEDURE Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN);
  VAR
    i: CARDINAL;
    name: ARRAY [0 .. NameLength] OF CHAR;
    anErr: Types.OSErr;
  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)); (* exception is raised if can't allocate *)
      anErr := Files.FSMakeFSSpec(0, 0, SYSTEM.TOSTR255(fileName), f^.fileSpec);
      IF (anErr = Types.noErr) OR (anErr = Errors.fnfErr)
        THEN
        (* 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 + RndFile.text + RndFile.raw, res)
          END;
          Okay := res = RndFile.opened;
        ELSE
          Okay := FALSE
      END;
      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;
  EXCEPT (* For ISO compilers *)
    f := NIL; Okay := FALSE
  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);
        DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); f := NIL
    END;
  EXCEPT (* For ISO compilers *)
    DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); f := NIL;
    Okay := FALSE; RETURN
  END Close;

PROCEDURE Delete (VAR f: File);
(* ++++ p1 specific routine used ++++ *)
  VAR
    anErr: Types.OSErr;
  BEGIN
    IF NotFile(f) OR (f = StdIn) OR (f = StdOut)
      THEN Okay := FALSE
      ELSE
        EXCL(Handles, f^.handle);
        RndFile.Close(f^.ref);
        anErr := Files.FSpDelete(f^.fileSpec);
        Okay := anErr = Types.noErr;
        DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); 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] = 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] = 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);
        (* ++++ p1 specific routine used ++++ *)
        RETURN SYSTEM.CAST(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);
        (* ++++ p1 specific casting used ++++ *)
        RETURN SYSTEM.CAST(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;
        (* ++++ p1 specific routine used ++++ *)
        RndFile.SetPos(f^.ref, SYSTEM.CAST(RndFile.FilePos, 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 = CR (* 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