fileio.mi

一个Modula-2语言分析器

IMPLEMENTATION MODULE FileIO;
(* Linux Mocka version by Pat Terry.  [e-mail] 1995-09-15
   Partly based on code written by T. Maeno for Mocka-BSD version 1995-05-26 *)

(* 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 Storage, Arguments, SYSTEM, LIBC, SysLib, Strings1;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;

CONST
  MaxFiles = BitSetSize;
  NameLength = 256;

TYPE
  File = POINTER TO FileRec;
  FileRec = RECORD
              ref: INTEGER;
              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, BreakEnabled: BOOLEAN;
  Param: CARDINAL;
  numPar: SHORTCARD;
  argv: Arguments.ArgTable;
  Erase, EOFChar, Kill, Intr: CHAR;
  TermFD: INTEGER;
  termioOrig, termioNew, termioProbe: LIBC.TermIO;
  reply: INTEGER;

MODULE BuffIO;
(*  Adapted by Pat Terry from a module ByteIO that was supplied with Mocka *)

  IMPORT LIBC, Storage, SysLib, Strings1, SYSTEM, Okay;
  EXPORT QUALIFIED OpenInput, OpenOutput, Close, GetByte, GetBytes, PutByte,
                   PutBytes, GetPos, SetPos, FlushBuffer;

  CONST
    MAXFILE  = 50;
    BUFFSIZE = 1024;

  VAR
    IsOutput: ARRAY [0 .. MAXFILE] OF BOOLEAN;
    BFirst, BPos, BLast: ARRAY [0 .. MAXFILE] OF SYSTEM.ADDRESS;

    (* For Input:                 *)
    (* BFirst .... BPos ... BLast *)
    (* [processed] [unprocessed ] *)

    (* For Output:                *)
    (* BFirst  ... BPos ... BLast *)
    (* [filled   ] [free        ] *)

  PROCEDURE OpenInput (VAR file: INTEGER; VAR name: ARRAY OF CHAR);
    VAR
      s: ARRAY [0 .. 1023] OF CHAR;
    BEGIN
      IF name[0] = 0C
        THEN file := 0 (* StdIn is a special case *)
        ELSE
          Strings1.Assign(s, name);
          file := SysLib.open(SYSTEM.ADR(s), SysLib.oRDONLY);
      END;
      IF file < 0 THEN
        Okay := FALSE;
      ELSE
        Storage.ALLOCATE(BFirst[file], BUFFSIZE);
        BPos[file]  := BFirst[file] + 1;
        BLast[file] := BFirst[file];
        IsOutput[file] := FALSE;
        Okay := TRUE;
      END;
    END OpenInput;

  PROCEDURE OpenOutput (VAR file: INTEGER; VAR name: ARRAY OF CHAR);
    VAR
      s: ARRAY [0 .. 1023] OF CHAR;
    BEGIN
      IF name[0] = 0C
        THEN file := 1 (* StdOut is a special case *)
        ELSE
          Strings1.Assign(s, name);
          file := SysLib.creat(SYSTEM.ADR(s),
                               SysLib.pROWNER + SysLib.pWOWNER
                               + SysLib.pRGROUP + SysLib.pWGROUP
                               + SysLib.pROTHERS + SysLib.pWOTHERS);
      END;
      IF file < 0 THEN
        Okay := FALSE;
      ELSE
        Storage.ALLOCATE(BFirst[file], BUFFSIZE);
        BPos[file] := BFirst[file];
        BLast[file] := BFirst[file] + BUFFSIZE - 1;
        IsOutput[file] := TRUE;
        Okay := TRUE;
      END;
    END OpenOutput;

  PROCEDURE Close (file: INTEGER);
    BEGIN
      IF IsOutput[file] THEN PutBf(file) END; 
      IF file > 2
        THEN
          Storage.DEALLOCATE(BFirst[file], BUFFSIZE);
          Okay := SysLib.close(file) # -1;
        ELSE Okay := FALSE
      END
    END Close;

  VAR  (* all this junk seems needed to persuade atexit to work properly *)
    FD, i1, i2: INTEGER;
    NeedsFlushing: BOOLEAN;

  PROCEDURE FlushBuffer (ff: INTEGER);
    BEGIN
      FD := ff;
      i1 := INTEGER(BPos[FD]);
      i2 := INTEGER(BFirst[FD]);
      NeedsFlushing := i1 > i2;
      i1 := i1 - i2;
      IF IsOutput[FD] & NeedsFlushing THEN 
        Okay := SysLib.write(FD, BFirst[FD], i1) # -1
      END
   END FlushBuffer;

  PROCEDURE GetByte (file: INTEGER; VAR x: SYSTEM.BYTE);
    BEGIN
      IF BPos[file] > BLast[file] THEN
        FillBuffer(file);
        IF ~ Okay THEN x := SYSTEM.BYTE(0C); RETURN END;
      END;
      x := BPos[file]^;
      INC(BPos[file]);
      Okay := TRUE;
    END GetByte;

  PROCEDURE GetBytes (file: INTEGER; VAR x: ARRAY OF SYSTEM.BYTE;
                      VAR len: CARDINAL);
    VAR
      i: CARDINAL;
    BEGIN
      i := 0;
      WHILE i # len DO
        IF BPos[file] > BLast[file] THEN
          FillBuffer(file);
          IF ~ Okay THEN len := i; RETURN END;
        END;
        x[i] := BPos[file]^;
        INC(BPos[file]);
        INC(i);
      END;
      Okay := TRUE;
    END GetBytes;

  PROCEDURE PutByte (file: INTEGER; x: SYSTEM.BYTE);
    BEGIN
      IF BPos[file] > BLast[file] THEN
        EmitBuffer(file);
        IF ~ Okay THEN RETURN END;
      END;
      BPos[file]^ := x;
      INC(BPos[file]);
      Okay := TRUE;
    END PutByte;

  PROCEDURE PutBytes (file: INTEGER; VAR x: ARRAY OF SYSTEM.BYTE;
                      len: CARDINAL);
    VAR
      i: CARDINAL;
    BEGIN
      i := 0;
      WHILE i # len DO
        IF BPos[file] > BLast[file] THEN
          EmitBuffer(file);
          IF ~ Okay THEN RETURN END;
        END;
        BPos[file]^ := x[i];
        INC(BPos[file]);
        INC(i);
      END;
      Okay := TRUE;
    END PutBytes;

  PROCEDURE PutBf (file: INTEGER);
    BEGIN
      IF INTEGER(BPos[file] - BFirst[file]) > 0 THEN EmitBuffer(file) END;
    END PutBf;

  PROCEDURE EmitBuffer (file: INTEGER);
    BEGIN
      Okay := SysLib.write(file, BFirst[file], INTEGER(BPos[file] - BFirst[file])) # -1;
      BPos[file] := BFirst[file];
    END EmitBuffer;

  PROCEDURE FillBuffer (file: INTEGER);
    VAR
      n: INTEGER;
    BEGIN
      n := SysLib.read(file, BFirst[file], BUFFSIZE);
      IF n > 0 THEN
        BPos[file] := BFirst[file];
        BLast[file] := BFirst[file] + CARDINAL(n) - 1;
        Okay := TRUE;
      ELSE
        BPos[file] := BFirst[file];
        BLast[file] := BFirst[file] - 1;
        Okay := FALSE;
      END;
    END FillBuffer;

  PROCEDURE GetPos (file: INTEGER): INTEGER;
    VAR
      pos: INTEGER;
    BEGIN
      IF IsOutput[file]
        THEN
          PutBf(file); pos := LIBC.lseek(file, 0, LIBC.SEEK_CUR);
        ELSE
          pos := LIBC.lseek(file, 0, LIBC.SEEK_CUR)
                 + INTEGER(BPos[file] - BLast[file] - 1);
      END;
      Okay := pos >= 0;
      RETURN pos
    END GetPos;

  PROCEDURE SetPos (file: INTEGER; pos: INTEGER);
    BEGIN
      IF IsOutput[file]
        THEN PutBf(file);
        ELSE BPos[file] := BLast[file] + 1;
      END;
      pos := LIBC.lseek(file, pos, LIBC.SEEK_SET);
      Okay := pos >= 0
    END SetPos;

  END BuffIO;

PROCEDURE ConRead (VAR ch: CHAR);
  VAR
    result: INTEGER;
  BEGIN
    result := LIBC.tcsetattr(TermFD, 0, termioNew);
    result := SysLib.read(TermFD, SYSTEM.ADR(ch), 1);
    result := LIBC.tcsetattr(TermFD, 0, termioOrig);
    IF ch = CR THEN ch := EOL END;
    IF (ch = Intr) & BreakEnabled THEN HALT END;
  END ConRead;

PROCEDURE ConWrite (ch: CHAR);
  VAR
    result: INTEGER;
  BEGIN
    result := SysLib.write(TermFD, SYSTEM.ADR(ch), 1)
  END ConWrite;

PROCEDURE ErrWrite (ch: CHAR);
  VAR
    result: INTEGER;
  BEGIN
    result := SysLib.write(2, SYSTEM.ADR(ch), 1)
  END ErrWrite;

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 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 Strings1.Assign(s, argv^[Param]^)
      ELSE s[0] := 0C
    END
  END NextParameter;

PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
  TYPE
    str = ARRAY [0 .. 255] OF CHAR;
  VAR	
    vp: POINTER TO str;
  BEGIN 
    vp := LIBC.getenv(envVar);
    IF vp # NIL
      THEN Strings1.Assign(s, vp^)
      ELSE s[0] := 0C
    END
  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