M2compiler-V3/stdlib/inout.mod

IMPLEMENTATION MODULE InOut;
(* Layered on the file shim (SysShim), so OpenInput/OpenOutput can
   redirect the current input/output streams. *)

FROM SYSTEM IMPORT ADDRESS;
IMPORT SysShim;

VAR
  inH, outH : ADDRESS;
  opened    : BOOLEAN;   (* a redirected file is open *)

PROCEDURE SetDone (b : BOOLEAN);
BEGIN
  Done := b
END SetDone;

PROCEDURE TrimName (VAR s : ARRAY OF CHAR; defext : ARRAY OF CHAR);
(* Drop a trailing newline and, if the name ends in '.', append
   defext (the classic InOut convention). *)
  VAR i, j, k : CARDINAL;
BEGIN
  i := 0;
  WHILE (i <= HIGH(s)) AND (s[i] # CHR(0)) DO INC(i) END;
  IF (i > 0) AND (s[i-1] = CHR(10)) THEN DEC(i); s[i] := CHR(0) END;
  IF (i > 0) AND (s[i-1] = CHR(13)) THEN DEC(i); s[i] := CHR(0) END;
  IF (i > 0) AND (s[i-1] = ".") THEN
    j := i;
    k := 0;
    WHILE (k <= HIGH(defext)) AND (defext[k] # CHR(0)) AND (j <= HIGH(s)) DO
      s[j] := defext[k]; INC(j); INC(k)
    END;
    IF j <= HIGH(s) THEN s[j] := CHR(0) END
  END
END TrimName;

PROCEDURE OpenInput (defext : ARRAY OF CHAR);
  VAR name : ARRAY [0 .. 1023] OF CHAR;
    h : ADDRESS;
    n : CARDINAL;
BEGIN
  name[0] := CHR(0);
  n := SysShim.freadline(SysShim.stdin(), name, HIGH(name) + 1);
  TrimName(name, defext);
  h := SysShim.fopenread(name);
  IF h = NIL THEN Done := FALSE
  ELSE inH := h; Done := TRUE
  END
END OpenInput;

PROCEDURE CloseInput;
BEGIN
  IF inH # SysShim.stdin() THEN SysShim.fclose(inH) END;
  inH := SysShim.stdin(); Done := TRUE
END CloseInput;

PROCEDURE OpenOutput (defext : ARRAY OF CHAR);
  VAR name : ARRAY [0 .. 1023] OF CHAR;
    h : ADDRESS;
    n : CARDINAL;
BEGIN
  name[0] := CHR(0);
  n := SysShim.freadline(SysShim.stdin(), name, HIGH(name) + 1);
  TrimName(name, defext);
  h := SysShim.fopenwrite(name);
  IF h = NIL THEN Done := FALSE
  ELSE outH := h; Done := TRUE
  END
END OpenOutput;

PROCEDURE CloseOutput;
BEGIN
  IF outH # SysShim.stdout() THEN SysShim.fclose(outH) END;
  outH := SysShim.stdout(); Done := TRUE
END CloseOutput;

PROCEDURE Read (VAR ch : CHAR);
BEGIN
  ch := SysShim.fgetc(inH);
  termCH := ch;
  Done := (ch # CHR(0))
END Read;

PROCEDURE ReadString (VAR s : ARRAY OF CHAR);
  VAR n : CARDINAL;
BEGIN
  n := SysShim.freadline(inH, s, HIGH(s) + 1);
  Done := TRUE
END ReadString;

PROCEDURE ReadInt (VAR x : INTEGER);
BEGIN
  x := SysShim.freadint(inH);
  Done := TRUE
END ReadInt;

PROCEDURE ReadCard (VAR x : CARDINAL);
BEGIN
  x := VAL(CARDINAL, SysShim.freadint(inH));
  Done := TRUE
END ReadCard;

PROCEDURE Write (ch : CHAR);
BEGIN
  SysShim.fputc(outH, ch)
END Write;

PROCEDURE WriteLn;
BEGIN
  SysShim.fwriteln(outH)
END WriteLn;

PROCEDURE WriteString (s : ARRAY OF CHAR);
BEGIN
  SysShim.fputs(outH, s)
END WriteString;

PROCEDURE WriteInt (x : INTEGER; n : CARDINAL);
BEGIN
  SysShim.fwriteintw(outH, x, n)
END WriteInt;

PROCEDURE WriteCard (x : CARDINAL; n : CARDINAL);
BEGIN
  SysShim.fwriteintw(outH, x, n)
END WriteCard;

PROCEDURE WriteRadix (x : CARDINAL; n : CARDINAL; base : CARDINAL);
  VAR tmp : ARRAY [0 .. 31] OF CHAR;
    i, k : CARDINAL;
    v : CARDINAL;
    digit : CARDINAL;

  PROCEDURE EmitChar (c : CHAR);
  BEGIN
    SysShim.fputc(outH, c)
  END EmitChar;

BEGIN
  v := x; i := 0;
  IF v = 0 THEN tmp[0] := "0"; i := 1
  ELSE
    WHILE (v > 0) AND (i <= HIGH(tmp)) DO
      digit := v MOD base;
      IF digit < 10 THEN tmp[i] := CHR(ORD("0") + digit)
      ELSE tmp[i] := CHR(ORD("A") + digit - 10)
      END;
      v := v DIV base;
      INC(i)
    END
  END;
  (* pad with spaces to width n *)
  k := i;
  WHILE k < n DO EmitChar(" "); INC(k) END;
  WHILE i > 0 DO DEC(i); EmitChar(tmp[i]) END
END WriteRadix;

PROCEDURE WriteOct (x : CARDINAL; n : CARDINAL);
BEGIN
  WriteRadix(x, n, 8)
END WriteOct;

PROCEDURE WriteHex (x : CARDINAL; n : CARDINAL);
BEGIN
  WriteRadix(x, n, 16)
END WriteHex;

BEGIN
  inH := SysShim.stdin();
  outH := SysShim.stdout();
  Done := TRUE;
  termCH := CHR(0)
END InOut.