IMPLEMENTATION MODULE FileIO; IMPORT Strings,FIO,SysClock, NumberIO, InOut, Storage,FileName; CONST MaxFiles = BitSetSize; NameLength = 256; TYPE File = POINTER TO FileRec; FileRec = RECORD ref: FIO.File; self: File; handle: CARDINAL; savedCh: CHAR; textOK, eof, eol, noOutput, noInput, haveCh: BOOLEAN; name: ARRAY [0 .. NameLength] OF CHAR; END; VAR theTime : SysClock.DateTime; FromKeyboard, ToScreen: BOOLEAN; (***********************************************) 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 NextParameter (VAR s: ARRAY OF CHAR); (* Extracts next parameter from command line. Returns empty string (s[0] = 0C) if no further parameter can be found. *) BEGIN END NextParameter; PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR); (* Returns s as the value of environment variable envVar, or empty string if that variable is not defined. *) (* The following routines provide a minimal set of file opening routines and closing routines. *) BEGIN END GetEnv; PROCEDURE Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN); (* Opens file f whose full name is specified by fileName. Opening mode is specified by newFile: TRUE: the specified file is opened for output only. Any existing file with the same name is deleted. FALSE: the specified file is opened for input only. FileIO.Okay indicates whether the file f has been opened successfully. *) BEGIN END Open; PROCEDURE SearchFile (VAR f: File; envVar, fileName: ARRAY OF CHAR; newFile: BOOLEAN); (* As for Open, but tries to open file of given fileName by searching each directory specified by the environment variable named by envVar. *) BEGIN END SearchFile; PROCEDURE Close (VAR f: File); (* Closes file f. f becomes NIL. If possible, Close should be called automatically for all files that remain open when the application terminates. This will be possible on implementations that provide some sort of termination or at-exit facility. *) BEGIN END Close; PROCEDURE CloseAll; (* Closes all files opened by Open or SearchFile. On systems that allow this, CloseAll should be automatically installed as the termination (at-exit) procedure *) (* The following utility procedure is not used by Coco, but may be useful. However, some operating systems may not allow for its implementation. *) BEGIN END CloseAll; PROCEDURE Delete (VAR f: File); (* Deletes file f. f becomes NIL. *) (* The following routines provide a minimal set of file name manipulation routines. These are modelled after MS-DOS conventions, where a file specifier is of a form exemplified by D:\DIR\SUBDIR\PRIMARY.EXT Other conventions may be introduced; these routines are used by Coco to derive names for the generated modules from the grammar name and the directory in which the grammar specification is located. *) BEGIN END Delete; (**********************************************************) PROCEDURE ExtractDirectory (fullName: ARRAY OF CHAR; VAR directory: ARRAY OF CHAR); (* Extracts /home/eric/Projects/ from /home/eric/Projects/essai.txt *) BEGIN FileName.GetDir(fullName,directory) END ExtractDirectory; PROCEDURE ExtractFileName (fullName: ARRAY OF CHAR; VAR fileName: ARRAY OF CHAR); (* Extracts PRIMARY.EXT portion of fullName. *) VAR a,b,c : ARRAY[0..256] OF CHAR; BEGIN FileName.Get(fullName,a,b,c); Strings.Concat(b,c,fileName) END ExtractFileName; PROCEDURE AppendExtension (oldName, ext: ARRAY OF CHAR; VAR newName: ARRAY OF CHAR); (* Constructs newName as complete file name by appending ext to oldName if it doesn't end with "." Examples: (assume ext = "EXT") old.any ==> OLD.EXT old. ==> OLD. old ==> OLD.EXT This is not a file renaming facility, merely a string manipulation routine. *) VAR dIr,nAme,eXt : ARRAY[0..256] OF CHAR; L : CARDINAL; save : CARDINAL; extPos, extLen, namePos, nameLen, dirPos, dirLen : CARDINAL; BEGIN L := LENGTH(oldName); save := L; (* separating the dir part from the filename+ext part *) REPEAT DEC(save); IF oldName[save] = "." THEN extPos := save + 1; extLen := L - extPos ; END; UNTIL oldName[save] = "/"; dirPos := 0; dirLen := save; END AppendExtension; PROCEDURE ChangeExtension (oldName, ext: ARRAY OF CHAR; VAR newName: ARRAY OF CHAR); (* Constructs newName as a complete file name by changing extension of oldName to ext. Examples: (assume ext = "EXT") old.any ==> OLD.EXT old. ==> OLD.EXT old ==> OLD.EXT This is not a file renaming facility, merely a string manipulation routine. *) (* The following routines provide a minimal set of file positioning routines. Others may be introduced, but at least these should be implemented. Success of each operation is recorded in FileIO.Okay. *) BEGIN END ChangeExtension; (*********************************************) PROCEDURE Length (f: File): INT32; (* Returns length of file f. *) BEGIN IF NotFile(f) THEN Okay := FALSE; RETURN Long0 ELSE Okay := TRUE; FIO.SetPositionFromEnd(f^.ref,0); RETURN VAL(INT32,FIO.FindPosition(f^.ref)) END; END Length; PROCEDURE GetPos (f: File): INT32; (* Returns the current read/write position in f. *) BEGIN IF NotFile(f) THEN Okay := FALSE; RETURN Long0 ELSE Okay := TRUE; RETURN VAL(INT32,FIO.FindPosition(f^.ref)) END; END GetPos; PROCEDURE SetPos (f: File; pos: INT32); (* Sets the current position for f to pos. *) (* The following routines provide a minimal set of file rewinding routines. These two are not currently used by Coco itself. Success of each operation is recorded in FileIO.Okay *) BEGIN IF NotFile(f) THEN Okay := FALSE ELSE Okay := TRUE; f^.haveCh := FALSE; FIO.SetPositionFromBeginning(f^.ref,VAL(LONGINT,pos)); END; END SetPos; PROCEDURE Reset (f: File); (* Sets the read/write position to the start of the file *) BEGIN IF NotFile(f) THEN Okay := FALSE ELSE FIO.SetPositionFromBeginning(f^.ref,0); 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); (* Truncates the file, leaving open for writing *) (* The following routines provide a minimal set of input routines. Others may be introduced, but at least these should be implemented. Success of each operation is recorded in FileIO.Okay. *) BEGIN IF NotFile(f) THEN Okay := FALSE ELSE FIO.Close(f^.ref); f^.ref := FIO.OpenToWrite(f^.name); Okay := FIO.IsNoError(f^.ref); IF ~ Okay THEN Storage.DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); f := NIL ELSE f^.savedCh := 0C; f^.haveCh := FALSE; f^.eof := TRUE; f^.eol := TRUE; f^.noInput := TRUE; f^.noOutput := FALSE; END END; END Rewrite; PROCEDURE EndOfLine (f: File): BOOLEAN; (* TRUE if f is currently at the end of a line, or at end of file. *) 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; (* TRUE if f is currently at the end of file. *) BEGIN IF NotRead(f)THEN Okay := FALSE; RETURN TRUE ELSE Okay := TRUE; RETURN f^.eof END END EndOfFile; (****************************************************) PROCEDURE Read (f: File; VAR ch: CHAR); (* Reads a character ch from file f. Maps filing system line mark sequence to FileIO.EOL. *) BEGIN END Read; PROCEDURE ReadAgain (f: File); (* Prepares to re-read the last character read from f. There is no buffer, so at most one character can be re-read. *) BEGIN END ReadAgain; PROCEDURE ReadLn (f: File); (* Reads to start of next line on file f, or to end of file if no next line. Skips to, and consumes next line mark. *) BEGIN END ReadLn; PROCEDURE ReadString (f: File; VAR str: ARRAY OF CHAR); (* Reads a string of characters from file f. Leading blanks are skipped, and str is delimited by line mark. Line mark is not consumed. *) BEGIN END ReadString; PROCEDURE ReadLine (f: File; VAR str: ARRAY OF CHAR); (* Reads a string of characters from file f. Leading blanks are not skipped, and str is terminated by line mark or control character, which is not consumed. *) BEGIN END ReadLine; PROCEDURE ReadToken (f: File; VAR str: ARRAY OF CHAR); (* Reads a string of characters from file f. Leading blanks and line feeds are skipped, and token is terminated by a character <= ' ', which is not consumed. *) BEGIN END ReadToken; PROCEDURE ReadInt (f: File; VAR i: INTEGER); (* Reads an integer value from file f. *) BEGIN END ReadInt; PROCEDURE ReadCard (f: File; VAR i: CARDINAL); (* Reads a cardinal value from file f. *) BEGIN END ReadCard; PROCEDURE ReadBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; VAR len: CARDINAL); (* Attempts to read len bytes from the current file position into buf. After the call, len contains the number of bytes actually read. *) (* The following routines provide a minimal set of output routines. Others may be introduced, but at least these should be implemented. *) BEGIN END ReadBytes; (*****************************************************) PROCEDURE Write (f: File; ch: CHAR); (* Writes a character ch to file f. If ch = FileIO.EOL, writes line mark appropriate to filing system. *) BEGIN IF NotWrite(f) THEN Okay := FALSE; RETURN END; Okay := TRUE; FIO.WriteChar(f^.ref, ch) END Write; PROCEDURE WriteLn (f: File); (* Skips to the start of the next line on file f. Writes line mark appropriate to filing system. *) BEGIN IF NotWrite(f) THEN Okay := FALSE; ELSE Write(f, EOL) END END WriteLn; PROCEDURE WriteString (f: File; str: ARRAY OF CHAR); (* Writes entire string str to file f. *) BEGIN IF NotWrite(f) THEN Okay := FALSE; RETURN END; FIO.WriteString(f^.ref, str) END WriteString; PROCEDURE WriteText (f: File; text: ARRAY OF CHAR; len: INTEGER); (* Writes text to file f. At most len characters are written. Trailing spaces are introduced if necessary (thus providing left justification). *) VAR i, slen: INTEGER; BEGIN IF NotWrite(f) THEN Okay := FALSE; RETURN END; slen := Strings.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); (* Writes an INTEGER int into a field of wid characters width. If the number does not fit into wid characters, wid is expanded. If wid = 0, exactly one leading space is introduced. *) 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); (* Writes a CARDINAL card into a field of wid characters width. If the number does not fit into wid characters, wid is expanded. If wid = 0, exactly one leading space is introduced. *) 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); (* Writes len bytes from buf to f at the current file position. *) (* The following procedures are not currently used by Coco, and may be safely omitted, or implemented as null procedures. They might be useful in measuring performance. *) (*PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL; src: ADDRESS) : CARDINAL ;*) VAR TooMany: BOOLEAN; number : CARDINAL; 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; number := FIO.WriteNBytes(f^.ref, len, SYSTEM.ADR(buf)); Okay := FIO.IsNoError(f^.ref) = TRUE; Okay := number = 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); (* Write current date DD/MM/YYYY to file f. *) VAR Year, Month, Day: CARDINAL; BEGIN IF NotWrite(f) THEN Okay := FALSE; RETURN END; SysClock.GetClock(theTime); WITH theTime DO Write2(f, day); Write(f, "/"); Write2(f, month); Write(f, "/"); WriteCard(f, year, 1) END; END WriteDate; PROCEDURE WriteTime (f: File); (* Write time HH:MM:SS to file f. *) (* PROCEDURE GetClock(VAR userData: DateTime); (* Assigns local date and time of the day to userData *) *) VAR theTimeString : ARRAY[0..40] OF CHAR; yearStr, monthStr, dayStr : ARRAY[0..12] OF CHAR; BEGIN IF NotWrite(f) THEN Okay := FALSE; RETURN END; SysClock.GetClock(theTime); WITH theTime DO Write2(f, hour); Write(f, ":"); Write2(f, minute); Write(f, ":"); Write2(f, second) END; END WriteTime; (***************************************************) VAR Hrs0, Mins0, Secs0, Hsecs0: CARDINAL; Hrs1, Mins1, Secs1, Hsecs1: CARDINAL; PROCEDURE WriteElapsedTime (f: File); (* Write elapsed time in seconds since last call of this procedure. *) VAR theTimeNow : SysClock.DateTime; Hrs, Mins, Secs, Hsecs, s, hs: CARDINAL; BEGIN IF NotWrite(f) THEN Okay := FALSE; RETURN END; SysClock.GetClock(theTimeNow); WITH theTimeNow DO Hrs := hour; Mins := minute; Secs := second; Hsecs := fractions; END; WriteString(f, "Elapsed time: "); IF Hrs >= Hrs1 THEN s := (Hrs - Hrs1) * 3600 + (Mins - Mins1) * 60 + Secs - Secs1 ELSE s := (Hrs + 24 - Hrs1) * 3600 + (Mins - Mins1) * 60 + Secs - Secs1 END; IF Hsecs >= Hsecs1 THEN hs := Hsecs - Hsecs1 ELSE hs := (Hsecs + 100) - Hsecs1; DEC(s); END; (** Updating**) WriteCard(f, s, 1); Write(f, "."); Write2(f, hs); WriteString(f, " s"); WriteLn(f); (** Writing to file**) Hrs1 := Hrs; Mins1 := Mins; Secs1 := Secs; Hsecs1 := Hsecs; END WriteElapsedTime; PROCEDURE WriteExecutionTime (f: File); (* Write total execution time in seconds thus far to file f. *) VAR theTimeNow : SysClock.DateTime; Hrs, Mins, Secs, Hsecs, s, hs: CARDINAL; BEGIN IF NotWrite(f) THEN Okay := FALSE; RETURN END; SysClock.GetClock(theTimeNow); WITH theTimeNow DO Hrs := hour; Mins := minute; Secs := second; Hsecs := fractions; END; WriteString(f, "Execution time: "); IF Hrs >= Hrs0 THEN s := (Hrs - Hrs0) * 3600 + (Mins - Mins0) * 60 + Secs - Secs0 ELSE s := (Hrs + 24 - Hrs0) * 3600 + (Mins - Mins0) * 60 + Secs - Secs0 END; IF Hsecs >= Hsecs0 THEN hs := Hsecs - Hsecs0 ELSE hs := (Hsecs + 100) - Hsecs0; DEC(s); END; WriteCard(f, s, 1); Write(f, "."); Write2(f, hs); WriteString(f, " s"); WriteLn(f); END WriteExecutionTime; (***************************************************) PROCEDURE SLENGTH (stringVal: ARRAY OF CHAR): CARDINAL; (* Returns number of characters in stringVal, not including nul *) BEGIN RETURN LENGTH(stringVal) END SLENGTH; PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR); (* Copies as much of source to destination as possible, truncating if too long, and nul terminating if shorter. Be careful - some libraries have the parameters reversed! *) (* PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR); (* Copies source to destination *) *) BEGIN Strings.Assign(source, destination) END Assign; PROCEDURE Extract (source: ARRAY OF CHAR; startIndex, numberToExtract: CARDINAL; VAR destination: ARRAY OF CHAR); BEGIN Strings.Extract(source, startIndex, numberToExtract, destination) END Extract; PROCEDURE Concat (stringVal1, stringVal2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR); (* Concatenates stringVal1 and stringVal2 to form destination. Nul terminated if concatenation is short enough, truncated if it is too long *) (*PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR); (* Concatenates source2 onto source1 and copies the result into destination. *) *) BEGIN Strings.Concat(stringVal1,stringVal2,destination) END Concat; PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): INTEGER; (* Returns -1, 0, 1 depending whether stringVal1 < = > stringVal2. This is not directly ISO compatible *) (* TYPE CompareResults = (less, equal, greater); PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): CompareResults; (* Returns less, equal, or greater, according as stringVal1 is lexically less than, equal to, or greater than stringVal2. *) *) BEGIN CASE Strings.Compare( stringVal1, stringVal2 ) OF Strings.less : RETURN -1; | Strings.equal : RETURN 0; | Strings.greater : RETURN 1; | END; END Compare; (***************************************************) (* The following routines are for conversions to and from the INT32 type. Their names are modelled after the ISO pervasive routines that would achieve the same end. Where possible, replacing calls to these routines by the pervasives would improve performance markedly. As used in Coco, these routines should not give range problems. *) PROCEDURE ORDL (n: INT32): CARDINAL; (* Convert long integer n to corresponding (short) cardinal value. Potentially FileIO.ORDL(n) = VAL(CARDINAL, n) *) BEGIN RETURN VAL(CARDINAL, n) END ORDL; PROCEDURE INTL (n: INT32): INTEGER; (* Convert long integer n to corresponding short integer value. Potentially FileIO.INTL(n) = VAL(INTEGER, n) *) BEGIN RETURN VAL(INTEGER, n) END INTL; PROCEDURE INT (n: CARDINAL): INT32; BEGIN RETURN VAL(INT32, n) END INT; PROCEDURE QuitExecution; BEGIN HALT; END QuitExecution; BEGIN SysClock.GetClock(theTime); WITH theTime DO Hrs0 := hour; Mins0 := minute; Secs0 := second; Hsecs0 := fractions; Hrs1 := Hrs0; Mins1 := Mins0; Secs1 := Secs0; Hsecs1 := Hsecs0; END; END FileIO.