CocoR/Docs/FileIO-1.mod

IMPLEMENTATION MODULE FileIO ;

(* 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 (with
   the exception of a few constants, avoid changing anything in this
   specification).

   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 is the generic WinTel version *)

FROM SYSTEM IMPORT TSIZE;
IMPORT FileSystem, Strings, InOut;
FROM OS2DEF IMPORT APIRET;
FROM OS2ARG IMPORT ArgCount, Arg, STRING, PSTRING,
         EnvCount, Env   ;
FROM DOSDATETIME IMPORT DATETIME, DosGetDateTime;

FROM Storage IMPORT ALLOCATE, DEALLOCATE;

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

TYPE Buftype = ARRAY [0..BufSize] OF CHAR;

VAR
  Handles: BITSET;
  Opened: ARRAY [0 .. MaxFiles-1] OF File;
  FromKeyboard, ToScreen: BOOLEAN;
  Param: LONGCARD;
  Continue: PROC;

TYPE CommandType = POINTER TO ARRAY [0..255] 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;



PROCEDURE NextParameter (VAR s: ARRAY OF CHAR);
VAR P : PSTRING;
BEGIN
  INC(Param);
  IF Param <= ArgCount()
  THEN P := Arg ( Param );
       IF P # NIL THEN Assign ( P^, s);END;
  ELSE s[0] := 0C
  END
END NextParameter;


PROCEDURE GetEnv ( envVar : ARRAY OF CHAR; VAR s : ARRAY OF CHAR );
VAR pos, index, idxmax : LONGCARD;
       match : BOOLEAN;
       ct : CommandType;
       i,j : LONGCARD;
       c : CHAR;
BEGIN
    match := FALSE;
    s [ 0 ] := CHR(0);
    j := Strings.Length (envVar);
    FOR i := 0 TO j DO envVar[i] := CAP(envVar[i]) END;
    idxmax := EnvCount();
    INC (idxmax);
    index := 0;
    WHILE (index < idxmax) AND (NOT match) DO
    ct := CommandType( Env (index));
    IF ct # NIL THEN
    pos := Strings.Pos ( envVar, ct^ );
    match := ( pos = 0)
    END; (* if ct # *)
    INC (index);
    END; (* While *)

    IF match THEN
     i:=0;
     REPEAT c := ct^[i]; INC (i) UNTIL c = '=';
     c := ct^[i];
    WHILE ct^[i] = ' ' DO  INC(i)  END;
     j := 0;
     REPEAT
      c := ct^[i];
      s[j] := c ;
      INC(i); INC(j);
     UNTIL ( c = CHR(0)) OR (j = HIGH(s)) ;
    END;
END GetEnv ;

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 Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN);
  VAR
    i: CARDINAL;
    NoWrite: BOOLEAN;
    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 (Strings.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 Strings.Compare(name, "ERR") = 0 THEN
      Okay := TRUE; f := err; RETURN
    ELSE
      ALLOCATE(f, SIZE(FileRec));
      NoWrite := FALSE;
      IF newFile
        THEN FileSystem.Create( f^.ref, fileName)
        ELSE
          FileSystem.Lookup(f^.ref, fileName, FALSE );
      END;
      Okay := f^.ref.res = 0;
      IF ~ Okay
        THEN
          DEALLOCATE(f, SIZE(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 OR NoWrite;
          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;
        (*  IF Okay THEN FIO.AssignBuffer(f^.ref, f^.buffer) END; *)
      END
    END
  END Open;


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
    IF (f = NIL) THEN RETURN TRUE END;
    IF (f^.self # f) OR (File(f) = con) OR (File(f) = err)
    THEN RETURN TRUE END;
    IF (File(f) = StdIn) & FromKeyboard
    THEN RETURN TRUE END;
    IF (File(f) = StdOut) & ToScreen
    THEN RETURN TRUE END;
    RETURN FALSE
  END NotFile;

PROCEDURE Close (VAR f: File);
  BEGIN
   (* IF f = NIL THEN RETURN END;*)
    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 = 0;
        IF Okay THEN DEALLOCATE(f, TSIZE(FileRec)) END;
        f := NIL
    END
  END Close;


PROCEDURE CloseAll;
  VAR
    handle: CARDINAL;
  BEGIN
    FOR handle := 0 TO MaxFiles - 1 DO
      IF handle IN Handles THEN Close(Opened[handle]) END
    END;
    IF ~ ToScreen THEN FileSystem.Close(StdOut^.ref) END;
    Continue;
  END CloseAll;


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.Close (f^.ref);
        FileSystem.Delete(f^.ref);
        Okay := f^.ref.res = 0;
        IF Okay THEN DEALLOCATE(f, TSIZE(FileRec)) END;
        f := NIL
    END
  END Delete;

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


PROCEDURE Concat (string1, string2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
BEGIN
  Strings.Concat( string1, string2,destination );
END Concat;

PROCEDURE Assign ( source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
BEGIN
  Strings.Assign ( source, destination )
END Assign;

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

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


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 CARDINAL ( 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 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 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 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;
  Strings.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;
  Strings.Concat(newName, fn, newName)
END ChangeExtension;


PROCEDURE Length (f: File): INT32;
VAR result: LONGCARD;
BEGIN
  IF NotFile(f)
  THEN Okay := FALSE; RETURN 0
  ELSE FileSystem.LongLength (f^.ref, result );
       Okay := f^.ref.res = 0;
       RETURN INT32(result)
  END
END Length;

PROCEDURE GetPos (f: File): INT32;
VAR pos: LONGCARD;
BEGIN
  IF NotFile(f)
  THEN Okay := FALSE; RETURN Long0
  ELSE FileSystem.GetLongPos(f^.ref,  pos );
       Okay :=  f^.ref.res = 0;
       RETURN pos
  END
END GetPos;

PROCEDURE SetPos (f: File; pos: INT32);
BEGIN
  IF NotFile(f)
  THEN Okay := FALSE
  ELSE FileSystem.SetLongPos(f^.ref, LONGCARD(pos) );
       Okay := f^.ref.res = 0; f^.haveCh := FALSE
  END
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);
VAR c: CHAR;
BEGIN
  IF NotFile(f)
  THEN Okay := FALSE
  ELSE SetPos(f, 0);
    IF Okay
    THEN WriteBytes(f, c, 0);
         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 ErrWrite (ch: CHAR);
CONST StdErr = DOSFILEMGR.STDERR;
VAR c : ARRAY [0..0] OF CHAR;
    res,n : LONGCARD;
BEGIN
  c[0] := ch;
  res := LONGCARD( DOSFILEMGR.DosWrite (StdErr,c,1,n))
END ErrWrite;

(* --------------A VERIFIER ------>>>> redirection *)

PROCEDURE ConRead (VAR ch: CHAR);
BEGIN
  InOut.Read ( ch )
END ConRead;

PROCEDURE ConWrite ( ch : CHAR );
BEGIN
  InOut.Write (ch );
END ConWrite;
(*------------------------------------------------*)

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;
     ELSE FileSystem.ReadChar(f^.ref, ch);
          IF ch = CR THEN FileSystem.ReadChar(f^.ref, ch); ch := EOL END;
             Okay := f^.ref.res = 0;
          IF ch = EOFChar THEN Okay := FALSE END;
     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
  ELSE f^.haveCh := TRUE
  END
END ReadAgain;

PROCEDURE ReadLn (f: File);
VAR ch: CHAR;
BEGIN
  IF NotRead(f) THEN Okay := FALSE; RETURN END;
  WHILE ~ f^.eol DO Read(f, ch) END;
  f^.haveCh := FALSE; f^.eol := FALSE;
END ReadLn;

PROCEDURE ReadString (f: File; VAR str: ARRAY OF CHAR);
VAR j: CARDINAL;
    ch: CHAR;
BEGIN
  str[0] := 0C; j := 0;
  IF NotRead(f) THEN Okay := FALSE; RETURN END;
  REPEAT Read(f, ch) UNTIL (ch # " ") OR ~ Okay;
  IF Okay THEN
  WHILE ch >= " " DO
    IF j <= HIGH(str) THEN str[j] := ch END; INC(j);
    Read(f, ch);
    WHILE (ch = BS) OR (ch = DEL) DO
      IF j > 0 THEN DEC(j) END; Read(f, ch) END
    END;
    IF j <= HIGH(str) THEN str[j] := 0C END;
    Okay := j > 0; f^.haveCh := TRUE; f^.savedCh := ch;
  END
END ReadString;

PROCEDURE ReadLine (f: File; VAR str: ARRAY OF CHAR);
VAR j: CARDINAL;
    ch: CHAR;
BEGIN
  str[0] := 0C; j := 0;
  IF NotRead(f) THEN Okay := FALSE; RETURN END;
  Read(f, ch);
  IF Okay
  THEN WHILE ch >= " " DO
         IF j <= HIGH(str) THEN str[j] := ch END; INC(j);
         Read(f, ch);
         WHILE (ch = BS) OR (ch = DEL) DO
           IF j > 0 THEN DEC(j) END; Read(f, ch)
         END
       END;
       IF j <= HIGH(str) THEN str[j] := 0C END;
       Okay := j > 0; f^.haveCh := TRUE; f^.savedCh := ch;
  END
END ReadLine;

PROCEDURE ReadToken (f: File; VAR str: ARRAY OF CHAR);
VAR j: CARDINAL;
    ch: CHAR;
BEGIN
  str[0] := 0C; j := 0;
  IF NotRead(f) THEN Okay := FALSE; RETURN END;
  REPEAT Read(f, ch) UNTIL (ch > " ") OR ~ Okay;
  IF Okay
  THEN WHILE ch > " " DO
         IF j <= HIGH(str) THEN str[j] := ch END; INC(j);
         Read(f, ch);
         WHILE (ch = BS) OR (ch = DEL) DO
           IF j > 0 THEN DEC(j) END; Read(f, ch)
         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 : LONGCARD;
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;
    f^.ref.res := LONGCARD ( DOSFILEMGR.DosRead( f^.ref.id, buf, HIGH(buf)+1, Wanted ));
    Okay := f^.ref.res = 0;
    IF len # Wanted THEN Okay := FALSE END;
  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 (File(f) = con) OR (File(f) = StdOut) & ToScreen
      THEN
        IF ch = EOL
          THEN ConWrite(CR); ConWrite(LF)
          ELSE ConWrite(ch)
        END;
        Okay := TRUE;
      ELSIF File(f) = err
        THEN
          IF ch = EOL
            THEN ErrWrite(CR); ErrWrite(LF)
            ELSE ErrWrite(ch)
          END;
          Okay := TRUE;
      ELSE
        IF ch = EOL
          THEN FileSystem.WriteLn(f^.ref)
          ELSE FileSystem.WriteChar(f^.ref, ch)
        END;
        Okay := f^.ref.res = 0;
    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,j, slen : LONGCARD;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    IF len > 0 THEN j := LONGCARD(len - 1) ELSE j := 0 END;
    slen := Strings.Length(text);
    FOR i := 0 TO j 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;
    len2 : LONGCARD;
  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 := CARDINAL ( HIGH(buf) + 1 ) END;
        len2 :=  LONGCARD (len);
        f^.ref.res := LONGCARD ( DOSFILEMGR.DosRead( f^.ref.id, buf, HIGH(buf)+1, len2 ));
        Okay := f^.ref.res = 0;
    END;
    IF TooMany THEN Okay := FALSE END;
  END WriteBytes;

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


PROCEDURE WriteDate (f: File);
  VAR
    dt : DATETIME;
    r : APIRET;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    r := DosGetDateTime (dt);
    WITH dt DO
    Write2(f, day); Write(f, "/"); Write2(f, month); Write(f, "/");
    WriteCard(f, year, 4)
    END;
  END WriteDate;

PROCEDURE WriteTime (f: File);
  VAR
    dt : DATETIME;
    r : APIRET;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    r := DosGetDateTime ( dt);
    WITH dt DO
    Write2(f, hours); Write(f, ":"); Write2(f, minutes); Write(f, ":");
    Write2(f, seconds)
    END;
  END WriteTime;

VAR
  Hrs0, Mins0, Secs0, Hsecs0: SHORTCARD;
  Hrs1, Mins1, Secs1, Hsecs1: SHORTCARD;

PROCEDURE GetInitTime();
VAR dt : DATETIME;
    r : APIRET;
BEGIN
  r := DosGetDateTime ( dt );
  WITH dt DO
  Hrs0 := hours; Mins0 := minutes;
  Secs0 := seconds; Hsecs0 :=   hundredths;
  END;
END GetInitTime;


PROCEDURE WriteElapsedTime (f: File);
  VAR dt : DATETIME;
      r : APIRET;
      s : CARDINAL;
      hs : SHORTCARD;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    r:= DosGetDateTime( dt );
    WriteString(f, "Elapsed time: ");
    WITH dt DO
    IF hours >= Hrs1
      THEN s := (hours - Hrs1) * 3600 + (minutes - Mins1) * 60 + seconds - Secs1
      ELSE s := (hours + 24 - Hrs1) * 3600 + (minutes - Mins1) * 60 + seconds - Secs1
    END;
    IF hundredths >= Hsecs1
      THEN hs := hundredths - Hsecs1
      ELSE hs := (hundredths + 100) - Hsecs1; DEC(s);
    END;
    WriteCard(f, s, 1); Write(f, ".");
    Write2(f, hs); WriteString(f, " s"); WriteLn(f);
    Hrs1 := hours; Mins1 := minutes; Secs1 := seconds; Hsecs1 := hundredths;
    END;
  END WriteElapsedTime;


PROCEDURE WriteExecutionTime (f: File);
 VAR dt : DATETIME;
      r : APIRET;
      s : CARDINAL;
      hs : SHORTCARD;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    r:= DosGetDateTime( dt );
    WriteString(f, "Execution time: ");
    WITH dt DO
    IF hours >= Hrs0
      THEN s := (hours - Hrs0) * 3600 + (minutes - Mins0) * 60 + seconds - Secs0
      ELSE s := (hours + 24 - Hrs0) * 3600 + (minutes - Mins0) * 60 + seconds - Secs0
    END;
    IF hundredths >= Hsecs0
      THEN hs := hundredths - Hsecs0
      ELSE hs := (hundredths + 100) - Hsecs0; DEC(s);
    END;
    WriteCard(f, s, 1); Write(f, ".");
    Write2(f, hs); WriteString(f, " s"); WriteLn(f);
    END;
  END WriteExecutionTime;


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 ORDL (n: INT32): CARDINAL;
BEGIN
  RETURN VAL(CARDINAL, n)
END ORDL;

PROCEDURE QuitExecution;
BEGIN
  HALT
END QuitExecution;

(* OS2 Std Channels *)
PROCEDURE InitStdChannels();
BEGIN
WITH StdOut^.ref DO
 id := DOSFILEMGR.STDOUT;
 eof := FALSE;
 tmp := FALSE;
 name := "SCREEN$";
END;
WITH StdIn^.ref DO
 id := DOSFILEMGR.STDIN;
 eof := FALSE;
 tmp := FALSE;
 name := "KBD$";
END;
END InitStdChannels;



BEGIN
  Handles := BITSET{};
  Okay := FALSE; EOFChar := 32C;
  Param := 0;
  GetInitTime();
  Hrs1 := Hrs0; Mins1 := Mins0; Secs1 := Secs0; Hsecs1 := Hsecs0;

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

  IF FromKeyboard
    THEN ALLOCATE(StdIn, SYSTEM.TSIZE(FileRec));
    ELSE ALLOCATE(StdIn, SYSTEM.TSIZE(FileRec));

  END;
  StdIn^.ref := InOut.in;
  StdIn^.savedCh := 0C; StdIn^.haveCh := FALSE; StdIn^.self := StdIn;
  StdIn^.noOutput := TRUE; StdIn^.noInput := FALSE; StdIn^.textOK := TRUE;
  StdIn^.eof := FALSE; StdIn^.eol := FALSE;

  IF ToScreen
    THEN ALLOCATE(StdOut, SYSTEM.TSIZE(FileRec));
    ELSE ALLOCATE(StdOut, SYSTEM.TSIZE(FileRec));

  END;
  StdOut^.ref := InOut.out;
  StdOut^.savedCh := 0C; StdOut^.haveCh := FALSE; StdOut^.self := StdOut;
  StdOut^.noOutput := FALSE; StdOut^.noInput := TRUE; StdOut^.textOK := TRUE;
  StdOut^.eof := TRUE; StdOut^.eol := TRUE;
  InitStdChannels();

END FileIO .