CocoR/Docs/FileIO-2.mod

IMPLEMENTATION MODULE FileIO;

IMPORT FIO, Strings, SYSTEM, Environment, FileSystem, ProgramArgs;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;

CONST
  MaxFiles = BitSetSize;
  NameLength = 256;
  BufSize  = 2048; (*1024 + FIO.BufferOverhead;*)
  (*EOF = 0C;            (* FileIO.Read returns EOF when eof is reached. *)
  EOL = 36C;           (* FileIO.Read maps line marks onto EOL
                          FileIO.Write maps EOL onto cr, lf, or cr/lf
                          as appropriate for filing system. *)
  ESC = 33C;           (* Standard ASCII escape. *)
  CR  = 15C;           (* Standard ASCII carriage return. *)
  LF  = 12C;           (* Standard ASCII line feed. *)
  BS  = 10C;           (* Standard ASCII backspace. *)
  DEL = 177C;          (* Standard ASCII DEL (rub-out). *)*)

TYPE
  Buftype = ARRAY [1 .. BufSize] OF CHAR;
  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;
              buffer: Buftype;
            END;


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

PROCEDURE ErrWrite (ch: CHAR);
  BEGIN
    FIO.WriteChar(err^.ref, ch)
  END ErrWrite;

PROCEDURE ConWrite (ch: CHAR);
  BEGIN
    ErrWrite(ch);
  END ConWrite;

(*PROCEDURE ConRead (VAR ch: CHAR);
  VAR
    R: SYSTEM.Registers;
  BEGIN
    R.AX := 0; Lib.Intr(R, 16H); ch := CHR(R.AL);
    IF ch = CR THEN ch := EOL END;
  END ConRead;*)

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 CheckRedirection;
  VAR
    R: SYSTEM.Registers;
  BEGIN
    FromKeyboard := FALSE; ToScreen := FALSE;
    R.AX := 4400H; R.BX := 0; Lib.Dos(R);
    IF ~ (0 IN R.Flags) THEN
      IF {7, 0} <= BITSET(R.DX) THEN FromKeyboard := TRUE END;
    END;
    R.AX := 4400H; R.BX := 1; Lib.Dos(R);
    IF ~ (0 IN R.Flags) THEN
      IF {7, 1} <= BITSET(R.DX) THEN ToScreen := TRUE END;
    END;
  END CheckRedirection;*)

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 NextParameter (VAR s: ARRAY OF CHAR);
  BEGIN
    
  END NextParameter;

PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
  
(*
GetEnvironment - gets the environment variable Env and places
a copy of its value into string, dest.
It returns TRUE if the string Env was found in
the processes environment.

PROCEDURE GetEnvironment (Env: ARRAY OF CHAR;
VAR dest: ARRAY OF CHAR) : BOOLEAN ;
*)
  
VAR 
  result : BOOLEAN;
  
  BEGIN
    result := Environment.GetEnvironment(envVar, s);
  END GetEnv;

PROCEDURE OpenRead (fileName: ARRAY OF CHAR) : FIO.File;

  BEGIN
   RETURN FIO.OpenToRead(fileName);
  END OpenRead;

PROCEDURE Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN);
 
  BEGIN
    ExtractFileName(fileName, name);
    FOR i := 0 TO NameLength - 1 DO 
      name[i] := CAP(name[i]) 
    END;
    IF (name[0] = 0C) OR (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 Compare(name, "ERR") = 0 THEN
      Okay := TRUE; 
      f := err; 
      RETURN
    ELSE
      ALLOCATE(f, SYSTEM.TSIZE(FileRec));
      NoWrite := FALSE;
      IF newFile THEN 
        f^.ref := FIO.OpenToWrite(fileName)
      ELSE
        f^.ref := FIO.OpenToRead(fileName);
        IF FIO.IsNoError(f^.ref)  THEN 
          f^.ref := OpenToRead(fileName); 
          NoWrite := TRUE;
        END;
      END;
      Okay := FIO.IsNoError(f^.ref);
      IF ~ Okay
        THEN
          DEALLOCATE(f, SYSTEM.TSIZE(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 Close (VAR f: File);
  BEGIN
    FIO.Close(f)
  END Close;

PROCEDURE Delete (VAR f: File);
  BEGIN
    Fio.Delete(f);
  END Delete;

PROCEDURE SearchFile (VAR f: File; envVar, fileName: ARRAY OF CHAR;
                      newFile: BOOLEAN);

(*
Lookup - looks for a file, filename. If the file is found
then, f, is opened. If it is not found and, newFile,
is TRUE then a new file is created and attached to, f.
If, newFile, is FALSE and no file was found then f.res
is set to notdone.

PROCEDURE Lookup (VAR f: File; filename: ARRAY OF CHAR; newFile: BOOLEAN) ;
*)

  BEGIN
   FileSystem.Lookup(f,filename,newFile);
  END SearchFile;

PROCEDURE ExtractDirectory (fullName: ARRAY OF CHAR;
                            VAR directory: ARRAY OF CHAR);
 
  BEGIN
    
  END ExtractDirectory;

PROCEDURE ExtractFileName (fullName: ARRAY OF CHAR;
                           VAR fileName: ARRAY OF CHAR);
  
  BEGIN
   
  END ExtractFileName;

PROCEDURE AppendExtension (oldName, ext: ARRAY OF CHAR;
                           VAR newName: ARRAY OF CHAR);
 
  BEGIN
   
  END AppendExtension;

PROCEDURE ChangeExtension (oldName, ext: ARRAY OF CHAR;
                           VAR newName: ARRAY OF CHAR);
 
  BEGIN
   
  END ChangeExtension;

PROCEDURE Length (f: File): INT32;
 
  BEGIN
   
  END Length;

PROCEDURE GetPos (f: File): INT32;
 
  BEGIN
    
  END GetPos;

PROCEDURE SetPos (f: File; pos: INT32);
  BEGIN
   
  END SetPos;

PROCEDURE Reset (f: File);
  BEGIN
   
  END Reset;

PROCEDURE Rewrite (f: File);
 
  BEGIN
   
  END Rewrite;

PROCEDURE EndOfLine (f: File): BOOLEAN;
  BEGIN
   
  END EndOfLine;

PROCEDURE EndOfFile (f: File): BOOLEAN;
  BEGIN
  
  END EndOfFile;

PROCEDURE Read (f: File; VAR ch: CHAR);
  BEGIN
   
  END Read;

PROCEDURE ReadAgain (f: File);
  BEGIN
   
  END ReadAgain;

PROCEDURE ReadLn (f: File);
 
  BEGIN
   
  END ReadLn;

PROCEDURE ReadString (f: File; VAR str: ARRAY OF CHAR);
 
  BEGIN
   
  END ReadString;

PROCEDURE ReadLine (f: File; VAR str: ARRAY OF CHAR);
 
  BEGIN
   
  END ReadLine;

PROCEDURE ReadToken (f: File; VAR str: ARRAY OF CHAR);
 
  BEGIN
    
  END ReadToken;

PROCEDURE ReadInt (f: File; VAR i: INTEGER);
 
  BEGIN
   
  END ReadInt;

PROCEDURE ReadCard (f: File; VAR i: CARDINAL);
 
  BEGIN
   
  END ReadCard;

PROCEDURE ReadBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; VAR len: CARDINAL);
 
  BEGIN
   
  END ReadBytes;

PROCEDURE Write (f: File; ch: CHAR);
  BEGIN
   
  END Write;

PROCEDURE WriteLn (f: File);
  BEGIN
   
  END WriteLn;

PROCEDURE WriteString (f: File; str: ARRAY OF CHAR);
  
  BEGIN
   
  END WriteString;

PROCEDURE WriteText (f: File; text: ARRAY OF CHAR; len: INTEGER);
 
  BEGIN
   
  END WriteText;

PROCEDURE WriteInt (f: File; n: INTEGER; wid: CARDINAL);
 
  BEGIN
   
  END WriteInt;

PROCEDURE WriteCard (f: File; n, wid: CARDINAL);
 
  BEGIN
   
  END WriteCard;

PROCEDURE WriteBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; len: CARDINAL);
 
  BEGIN
  
  END WriteBytes;

PROCEDURE GetDate (VAR Year, Month, Day: CARDINAL);
 
  BEGIN
   
  END GetDate;

PROCEDURE GetTime (VAR Hrs, Mins, Secs, Hsecs: CARDINAL);
  
  BEGIN
  
  END GetTime;

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);
  VAR
    Year, Month, Day: CARDINAL;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    GetDate(Year, Month, Day);
    Write2(f, Day); Write(f, "/"); Write2(f, Month); Write(f, "/");
    WriteCard(f, Year, 1)
  END WriteDate;

PROCEDURE WriteTime (f: File);
  VAR
    Hrs, Mins, Secs, Hsecs: CARDINAL;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    GetTime(Hrs, Mins, Secs, Hsecs);
    Write2(f, Hrs); Write(f, ":"); Write2(f, Mins); Write(f, ":");
    Write2(f, Secs)
  END WriteTime;

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

PROCEDURE WriteElapsedTime (f: File);
  VAR
    Hrs, Mins, Secs, Hsecs, s, hs: CARDINAL;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    GetTime(Hrs, Mins, Secs, Hsecs);
    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;
    WriteCard(f, s, 1); Write(f, ".");
    Write2(f, hs); WriteString(f, " s"); WriteLn(f);
    Hrs1 := Hrs; Mins1 := Mins; Secs1 := Secs; Hsecs1 := Hsecs;
  END WriteElapsedTime;

PROCEDURE WriteExecutionTime (f: File);
  VAR
    Hrs, Mins, Secs, Hsecs, s, hs: CARDINAL;
  BEGIN
    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
    GetTime(Hrs, Mins, Secs, Hsecs);
    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;

(* The code for the next four procedures below may be commented out if your
   compiler supports ISO PROCEDURE constant declarations and these declarations
   are made in the DEFINITION MODULE *)

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

PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
  BEGIN
  (* Be careful - some libraries have the parameters reversed! *)
    Str.Copy(destination, source)
  END Assign;

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

PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
  BEGIN
    Str.Concat(destination, source1, source2);
  END Concat;

(* The code for the four procedures above may be commented out if your
   compiler supports ISO PROCEDURE constant declarations and these declarations
   are made in the DEFINITION MODULE *)

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

PROCEDURE ORDL (n: INT32): CARDINAL;
   BEGIN RETURN VAL(CARDINAL, n) END ORDL;

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 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 FIO.Close(StdOut^.ref) END;
    Continue;
  END CloseAll;

PROCEDURE QuitExecution;
  BEGIN
    HALT
  END QuitExecution;

BEGIN
  (*CheckRedirection; (* Not apparently available on many systems *)*)
  GetTime(Hrs0, Mins0, Secs0, Hsecs0);
  Hrs1 := Hrs0; 
  Mins1 := Mins0; 
  Secs1 := Secs0; 
  Hsecs1 := Hsecs0;
  Handles := BITSET{};
  Okay := FALSE; 
  EOFChar := 32C;
  Param := 0;
  (*FIO.Separators := Str.CHARSET{CHR(0) .. " "}; *)
  FIO.IOcheck := FALSE;

  ALLOCATE(con, SYSTEM.TSIZE(FileRec)-SYSTEM.TSIZE(Buftype));
  con^.ref := FIO.StdOut;
  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)-SYSTEM.TSIZE(Buftype));
    ELSE ALLOCATE(StdIn, SYSTEM.TSIZE(FileRec));
         FIO.AssignBuffer(FIO.StdIn, StdIn^.buffer)
  END;
  StdIn^.ref := FIO.StdIn;
  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)-SYSTEM.TSIZE(Buftype));
    ELSE ALLOCATE(StdOut, SYSTEM.TSIZE(FileRec));
         FIO.AssignBuffer(FIO.StdOut, StdOut^.buffer)
  END;
  StdOut^.ref := FIO.StdOut;
  StdOut^.savedCh := 0C; StdOut^.haveCh := FALSE; StdOut^.self := StdOut;
  StdOut^.noOutput := FALSE; StdOut^.noInput := TRUE; StdOut^.textOK := TRUE;
  StdOut^.eof := TRUE; StdOut^.eol := TRUE;

  ALLOCATE(err, SYSTEM.TSIZE(FileRec)-SYSTEM.TSIZE(Buftype));
  err^.ref := FIO.StdErr;
  err^.savedCh := 0C; err^.haveCh := FALSE; err^.self := err;
  err^.noOutput := FALSE; err^.noInput := TRUE; err^.textOK := TRUE;
  err^.eof := TRUE; err^.eol := TRUE;

  Lib.Terminate(CloseAll, Continue);
END FileIO.