(* This implementation of facilities used by Coco/R
Generic WinTel version
is for use with Canterbery MOD32 on OS2
JP Dezaire - 2006
- Changed NextArgument to avoid trailing space chars 21/09/2006
- Changed NotFile ... 14/10/2006
did not return TRUE if f=NIL -> split conditions
- Implemented Time /date procs 11/01/2007 *)
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, DOSFILEMGR;
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 .
|