CocoR/FileIO.mod

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.