fileio.mi

一个Modula-2语言分析器

        END
      END;
      IF j <= HIGH(str) THEN str[j] := 0C END;
      Okay := j > 0; f^.haveCh := TRUE; f^.savedCh := ch;
    END
  END ReadToken;

PROCEDURE ReadInt (f: File; VAR i: INTEGER);
  VAR
    Digit: INTEGER;
    j: CARDINAL;
    Negative: BOOLEAN;
    s: ARRAY [0 .. 80] OF CHAR;
  BEGIN
    i := 0; j := 0;
    IF NotRead(f) THEN Okay := FALSE; RETURN END;
    ReadToken(f, s);
    IF s[0] = "-" (* deal with sign *)
      THEN Negative := TRUE; INC(j)
      ELSE Negative := FALSE; IF s[0] = "+" THEN INC(j) END
    END;
    IF (s[j] < "0") OR (s[j] > "9") THEN Okay := FALSE END;
    WHILE (j <= 80) & (s[j] >= "0") & (s[j] <= "9") DO
      Digit := VAL(INTEGER, ORD(s[j]) - ORD("0"));
      IF i <= (MAX(INTEGER) - Digit) DIV 10
        THEN i := 10 * i + Digit
        ELSE Okay := FALSE
      END;
      INC(j)
    END;
    IF Negative THEN i := -i END;
    IF (j > 80) OR (s[j] # 0C) THEN Okay := FALSE END;
    IF ~ Okay THEN i := 0 END;
  END ReadInt;

PROCEDURE ReadCard (f: File; VAR i: CARDINAL);
  VAR
    Digit: CARDINAL;
    j: CARDINAL;
    s: ARRAY [0 .. 80] OF CHAR;
  BEGIN
    i := 0; j := 0;
    IF NotRead(f) THEN Okay := FALSE; RETURN END;
    ReadToken(f, s);
    WHILE (j <= 80) & (s[j] >= "0") & (s[j] <= "9") DO
      Digit := ORD(s[j]) - ORD("0");
      IF i <= (MAX(CARDINAL) - Digit) DIV 10
        THEN i := 10 * i + Digit
        ELSE Okay := FALSE
      END;
      INC(j)
    END;
    IF (j > 80) OR (s[j] # 0C) THEN Okay := FALSE END;
    IF ~ Okay THEN i := 0 END;
  END ReadCard;

PROCEDURE ReadBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; VAR len: CARDINAL);
  VAR
    TooMany: BOOLEAN;
    Wanted: CARDINAL;
  BEGIN
    IF NotRead(f) OR (File(f) = con)
      THEN Okay := FALSE; len := 0;
      ELSE
        IF len = 0 THEN Okay := TRUE; RETURN END;
        TooMany := len - 1 > HIGH(buf);
        IF TooMany THEN Wanted := HIGH(buf) + 1 ELSE Wanted := len END;
        BuffIO.GetBytes(f^.ref, buf, Wanted);
        Okay := Wanted # 0;
        IF len # Wanted THEN Okay := FALSE END;
        len := Wanted;
    END;
    IF ~ Okay THEN f^.eof := TRUE END;
    IF TooMany THEN Okay := FALSE END;
  END ReadBytes;

PROCEDURE Write (f: File; ch: CHAR);
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    IF ch = EOL THEN ch := LF END;
    IF (File(f) = con) OR (File(f) = StdOut) & ToScreen 
      THEN  ConWrite(ch); Okay := TRUE;
      ELSIF File(f) = err THEN ErrWrite(ch); Okay := TRUE;
      ELSE  BuffIO.PutByte(f^.ref, ch);
    END;
  END Write;

PROCEDURE WriteLn (f: File);
  BEGIN
    IF NotWrite(f)
      THEN Okay := FALSE;
      ELSE Write(f, EOL)
    END
  END WriteLn;

PROCEDURE WriteString (f: File; str: ARRAY OF CHAR);
  VAR
    pos: CARDINAL;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    pos := 0;
    WHILE (pos <= HIGH(str)) & (str[pos] # 0C) DO
      Write(f, str[pos]); INC(pos)
    END
  END WriteString;

PROCEDURE WriteText (f: File; text: ARRAY OF CHAR; len: INTEGER);
  VAR
    i, slen: INTEGER;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    slen := Strings1.Length(text);
    FOR i := 0 TO len - 1 DO
      IF i < slen THEN Write(f, text[i]) ELSE Write(f, " ") END;
    END
  END WriteText;

PROCEDURE WriteInt (f: File; n: INTEGER; wid: CARDINAL);
  VAR
    l, d: CARDINAL;
    x: INTEGER;
    t: ARRAY [1 .. 25] OF CHAR;
    sign: CHAR;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    IF n < 0
      THEN sign := "-"; x := - n;
      ELSE sign := " "; x := n;
    END;
    l := 0;
    REPEAT
      d := x MOD 10; x := x DIV 10;
      INC(l); t[l] := CHR(ORD("0") + d);
    UNTIL x = 0;
    IF wid = 0 THEN Write(f, " ") END;
    WHILE wid > l + 1 DO Write(f, " "); DEC(wid); END;
    IF (sign = "-") OR (wid > l) THEN Write(f, sign); END;
    WHILE l > 0 DO Write(f, t[l]); DEC(l); END;
  END WriteInt;

PROCEDURE WriteCard (f: File; n, wid: CARDINAL);
  VAR
    l, d: CARDINAL;
    t: ARRAY [1 .. 25] OF CHAR;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    l := 0;
    REPEAT
      d := n MOD 10; n := n DIV 10;
      INC(l); t[l] := CHR(ORD("0") + d);
    UNTIL n = 0;
    IF wid = 0 THEN Write(f, " ") END;
    WHILE wid > l DO Write(f, " "); DEC(wid); END;
    WHILE l > 0 DO Write(f, t[l]); DEC(l); END;
  END WriteCard;

PROCEDURE WriteBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; len: CARDINAL);
  VAR
    TooMany: BOOLEAN;
  BEGIN
    TooMany := (len > 0) & (len - 1 > HIGH(buf));
    IF NotWrite(f) OR (File(f) = con) OR (File(f) = err)
      THEN
        Okay := FALSE
      ELSE
        IF TooMany THEN len := HIGH(buf) + 1 END;
        BuffIO.PutBytes(f^.ref, buf, len);
    END;
    IF TooMany THEN Okay := FALSE END;
  END WriteBytes;

PROCEDURE Write2 (f: File; i: CARDINAL);
  BEGIN
    Write(f, CHR(i DIV 10 + ORD("0")));
    Write(f, CHR(i MOD 10 + ORD("0")));
  END Write2;

PROCEDURE WriteDate (f: File);
  VAR 
    t: LIBC.TIME;
    TimeNow: INTEGER;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    SysLib.time(TimeNow);
    t := LIBC.localtime(TimeNow);
    Write2(f, t^.Day); Write(f, "/"); Write2(f, t^.Month+1); Write(f, "/");
    WriteCard(f, t^.Year + 1900, 1)
  END WriteDate;

PROCEDURE WriteTime (f: File);
  VAR 
    t: LIBC.TIME;
    TimeNow: INTEGER;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    SysLib.time(TimeNow);
    t := LIBC.localtime(TimeNow);
    Write2(f, t^.Hours); Write(f, ":"); Write2(f, t^.Mins); Write(f, ":");
    Write2(f, t^.Secs)
  END WriteTime;

VAR
  Time0, Time1: INTEGER;

PROCEDURE WriteElapsedTime (f: File);
  VAR
    TimeNow, Diff, Secs: INTEGER;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    TimeNow := LIBC.clock();
    WriteString(f, "Elapsed time: ");
    Diff := TimeNow - Time1;
    Secs := Diff DIV LIBC.CLOCKSPERSEC; 
    WriteInt(f,  Secs, 1);
    Write(f, '.');
    Write2(f, Diff - Secs * LIBC.CLOCKSPERSEC); 
    WriteString(f, " s"); WriteLn(f);
    Time1 := TimeNow;
  END WriteElapsedTime;

PROCEDURE WriteExecutionTime (f: File);
  VAR
    TimeNow, Diff, Secs: INTEGER;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    TimeNow := LIBC.clock();
    WriteString(f, "Execution time: ");
    Diff := TimeNow - Time0;
    Secs := Diff DIV LIBC.CLOCKSPERSEC; 
    WriteInt(f,  Secs, 1);
    Write(f, '.');
    Write2(f, Diff - Secs * LIBC.CLOCKSPERSEC); 
    WriteString(f, " s"); WriteLn(f);
  END WriteExecutionTime;

(* The code for the next four procedures below may be commented out if your
   compiler supports ISO PROCEDURE constant declarations and these declarations
   are made in the DEFINITION MODULE *)

PROCEDURE SLENGTH (stringVal: ARRAY OF CHAR): CARDINAL;
  BEGIN
    RETURN Strings1.Length(stringVal)
  END SLENGTH;

PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
  BEGIN
  (* Be careful - some libraries have the parameters reversed! *)
    Strings1.Assign(destination, source)
  END Assign;

PROCEDURE Extract (source: ARRAY OF CHAR; startIndex: CARDINAL;
                   numberToExtract: CARDINAL; VAR destination: ARRAY OF CHAR);
  BEGIN
    Strings1.Copy(source, startIndex, numberToExtract, destination);
  END Extract;

PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
  BEGIN
    Strings1.Concat(source1, source2, destination);
  END Concat;

(* The code for the four procedures above may be commented out if your
   compiler supports ISO PROCEDURE constant declarations and these declarations
   are made in the DEFINITION MODULE *)

PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): INTEGER;
  BEGIN
    RETURN Strings1.compare(stringVal1, stringVal2);
  END Compare;

PROCEDURE ORDL (n: INT32): CARDINAL;
   BEGIN RETURN VAL(CARDINAL, n) END ORDL;

PROCEDURE INTL (n: INT32): INTEGER;
   BEGIN RETURN VAL(INTEGER, n) END INTL;

PROCEDURE INT (n: CARDINAL): INT32;
   BEGIN RETURN VAL(INT32, n) END INT;

PROCEDURE InitTTY;
  VAR
    termName: ARRAY [0 .. 30] OF CHAR;
  BEGIN
    Strings1.Assign(termName, "/dev/tty");
    TermFD := SysLib.open(SYSTEM.ADR(termName), SysLib.oRDWR);
    reply := LIBC.tcgetattr(TermFD, termioOrig); (* terminal characteristics *)
    Erase := termioOrig.CC[LIBC.ERASE];
    Kill := termioOrig.CC[LIBC.KILL];
    EOFChar := termioOrig.CC[LIBC.EOF];
    Intr := termioOrig.CC[LIBC.INTR];
    BreakEnabled := LIBC.ISIG IN termioOrig.LFlag;
    termioNew := termioOrig;            (* retain so can reset later *)
    EXCL(termioNew.LFlag, LIBC.ISIG);
    EXCL(termioNew.LFlag, LIBC.ICANON);
    EXCL(termioNew.LFlag, LIBC.ECHO); (* stty -isig -echo -canon *)
  END InitTTY;

PROCEDURE CloseAll;
  VAR
    handle: CARDINAL;
  BEGIN
    FOR handle := 0 TO MaxFiles - 1 DO
      IF handle IN Handles THEN BuffIO.FlushBuffer(Opened[handle]^.ref) END
    END;
    IF ~ ToScreen THEN BuffIO.FlushBuffer(1) END;
    reply := LIBC.tcsetattr(TermFD, 0, termioOrig);
  END CloseAll;

PROCEDURE QuitExecution;
  BEGIN
    HALT
  END QuitExecution;

BEGIN
  InitTTY;
  Time0 := LIBC.clock(); Time1 := Time0;
  Handles := BITSET{};
  Okay := FALSE;
  Param := 0;

  ALLOCATE(con, SYSTEM.TSIZE(FileRec));
  con^.ref := TermFD;
  con^.savedCh := 0C; con^.haveCh := FALSE; con^.self := con;
  con^.noOutput := FALSE; con^.noInput := FALSE; con^.textOK := TRUE;
  con^.eof := FALSE; con^.eol := FALSE;

  ALLOCATE(StdIn, SYSTEM.TSIZE(FileRec));
  BuffIO.OpenInput(StdIn^.ref, ""); (* allocate a buffer - special name *)
  StdIn^.savedCh := 0C; StdIn^.haveCh := FALSE; StdIn^.self := StdIn;
  StdIn^.noOutput := TRUE; StdIn^.noInput := FALSE; StdIn^.textOK := TRUE;
  StdIn^.eof := FALSE; StdIn^.eol := FALSE;
  FromKeyboard := LIBC.tcgetattr(StdIn^.ref, termioNew) = 0; (* probe redirection *);

  ALLOCATE(StdOut, SYSTEM.TSIZE(FileRec));
  BuffIO.OpenOutput(StdOut^.ref, ""); (* allocate a buffer - special name *)
  StdOut^.savedCh := 0C; StdOut^.haveCh := FALSE; StdOut^.self := StdOut;
  StdOut^.noOutput := FALSE; StdOut^.noInput := TRUE; StdOut^.textOK := TRUE;
  StdOut^.eof := TRUE; StdOut^.eol := TRUE;
  ToScreen := LIBC.tcgetattr(StdOut^.ref, termioNew) = 0; (* probe redirection *);

  ALLOCATE(err, SYSTEM.TSIZE(FileRec));
  err^.ref := 2;
  err^.savedCh := 0C; err^.haveCh := FALSE; err^.self := err;
  err^.noOutput := FALSE; err^.noInput := TRUE; err^.textOK := TRUE;
  err^.eof := TRUE; err^.eol := TRUE;
  Arguments.GetArgs(numPar, argv);
  reply := LIBC.atexit(CloseAll);
END FileIO.