MODULE STDIO ;
(* Standard text file I/O *)
(* from Kernighan + Plauger *)
(* 29-Nov-83  Allow eight bit file transfer [pgt001] *)
(*            This forces us to make the end of (data) string value -1 *)
(*            and end of file value -2 because byte values can be 0..255 *)


EXPORTS

IMPORTS  KermitGlobals         FROM KermitGlobals ;

CONST
   { standard file descriptors. subscripts in open, etc. }
   STDIN = 1;              { these are not to be changed }
   STDOUT = 2;
   STDERR = 3;
   lineout = 4;
   linein = 5;
   FirstUserFile = STDERR ; (* First index available for user's files -pt*)
 
   { other io-related stuff }
   StdIOError = 0;    { status values for open files }
   StdIOAvail = 1;
   StdIORead = 2;
   StdIOWrite = 3;
   StdIO8Read = 4 ;  (* [pgt001] *)
   StdIO8Write = 5 ;  (* [pgt001] *)
   MAXOPEN = 15;   { maximum number of open files }
 
   { universal manifest constants }
   ENDFILE = ENDSTR - 1;  (* [pgt001] *)
 
TYPE
   filedesc = StdIOError..MAXOPEN;
   ioblock = RECORD        { to keep track of open files }
                filevar : Text;
                mode : StdIOError..StdIO8Write;
             END;
 
VAR
   openlist : ARRAY [1..MAXOPEN] OF ioblock; { open files }
 
PROCEDURE StdIOInit;
PROCEDURE putch (c : CharBytes);
PROCEDURE putcf (c : CharBytes; fd : filedesc);
PROCEDURE putstr (VAR s : istring; f : filedesc);
FUNCTION getch (VAR c : CharBytes) : CharBytes;
FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
FUNCTION getline (VAR s : istring; fd : filedesc;
                  maxsize : Integer) : Boolean;
 
FUNCTION Sopen (name : istring; mode :   Integer) : filedesc;
PROCEDURE Sclose (fd : filedesc);
FUNCTION Exists(s:istring): Boolean;

PRIVATE
 
 
IMPORTS  Perq_string    FROM Perq_String ;
IMPORTS  Stream         FROM Stream ;
IMPORTS  FileSystem     FROM FileSystem ;
 
 
   { StdIOInit  -- initialize open file list }
PROCEDURE StdIOInit;
   VAR
      i :     filedesc;
   BEGIN
      openlist[STDIN].mode := StdIORead;
      openlist[STDOUT].mode := StdIOWrite;
      { initialize rest of files      }
      FOR i := FirstUserFile TO MAXOPEN DO
         openlist[i].mode := StdIOAvail;
 
   END;
 
 
   { getc (UCB) -- get one character from standard input }
FUNCTION getch (VAR c : CharBytes) : CharBytes;
   VAR
      ch : Char;
   BEGIN
      IF Eof THEN c := ENDFILE
      ELSE
         IF Eoln THEN
            BEGIN
               Readln;
               c := LF
            END
         ELSE
            BEGIN
               Read(ch);
               c := Ord(ch)
            END;
      getch := c
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { getcf (UCB) -- get one character from file }
FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
   VAR
      ch : Char;
   BEGIN
    WITH  openlist[fd]  DO   (* [pgt001] *)
      IF (fd = STDIN) THEN getcf := getch(c)
      ELSE
         IF Eof(filevar) THEN  c := ENDFILE
         ELSE
           IF (mode = StdIO8Read) THEN (* [pgt001] *)
              BEGIN
                 c := Ord( filevar^ ) ;
                 Get( filevar )
              END                      (* [pgt001] *)
           ELSE
            IF Eoln(filevar) THEN
               BEGIN
                  Readln(filevar);
                  c := LF
               END
            ELSE
               BEGIN
                  Read(filevar, ch);
                  c := Ord(ch)
               END;
      getcf := c
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { getline (UCB) -- get a line from file }
FUNCTION getline (VAR s : istring; fd : filedesc;
                  maxsize : Integer) : Boolean;
   VAR
      i : Integer;
      c : CharBytes;
   BEGIN
      {$RANGE-}
      i := 1;
      REPEAT
         s[i] := getcf(c, fd);
         i := i + 1
      UNTIL (c = ENDFILE) OR (c = LF) OR (i >= maxsize);
      IF (c = ENDFILE) THEN i := i - 1 ;      { went one too far }
      s[i] := ENDSTR;
      getline := (c <> ENDFILE)
      {$RANGE+}
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { putch (UCB) -- put one character on standard output }
PROCEDURE putch (c : CharBytes);
   BEGIN
      IF (c = LF) THEN Writeln
      ELSE Write(Chr(c))
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { putcf (UCB) -- put a single character on file fd }
PROCEDURE putcf (c : CharBytes; fd : filedesc);
   CONST
      NUL = 0 ;
   BEGIN
    WITH  openlist[fd]  DO
      IF (fd = STDOUT) THEN putch(c)
      ELSE
       IF (mode = StdIO8Write) THEN (* [pgt001] *)
          BEGIN
             filevar^ := Chr(c) ;
             Put( filevar )
          END
       ELSE
         BEGIN  (* Normal text file [pgt001]*)
           c := Land(c, #177) ;
           IF (c = LF) THEN   Writeln(filevar)
           ELSE
             IF (c = CR) OR (c = NUL) THEN (* ignore *)
             ELSE
              Write(filevar, Chr( c ))
         END ;
   END;
 
   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { putstr (UCB) -- put out string on file }
PROCEDURE putstr (VAR s : istring; f : filedesc);
   VAR
      i : Integer;
   BEGIN
      {$RANGE-}
      i := 1;
      WHILE (s[i] <> ENDSTR) DO
         BEGIN
            putcf(s[i], f);
            i := i + 1
         END
      {$RANGE+}
   END;
 
 
   { MakeString -- Convert an istring into a Perq String variable -pt }
PROCEDURE MakeString(src: istring; VAR dest: String) ;
   VAR
      i: Integer ;
   BEGIN (*-MakeString-*)
      i := 1 ;
      {$RANGE- Checks off because Length(dest) undefined at the moment -pt}
      WHILE (src[i] <> ENDSTR) AND (src[i] <> LF) DO
         BEGIN
            dest[i] := Chr(src[i]) ;
            i := i + 1
         END ;
      {$RANGE+  Checks back on -pt}
      Adjust(dest, i-1)   (* Set the dynamic length -pt*)
   END ; (*-MakeString-*)
 
   { open  -- open a file for reading or writing.   Perq version -pt}
FUNCTION Sopen (name : istring; mode :   Integer) : filedesc;
   VAR
      i :     Integer;
      filename : String ;
      found : Boolean;
 
      (* Reset and Rewrite error handlers. Both set "sopen" to IOERROR   -pt*)
      (* This means we set inital value of "sopen" before reset/rewrite  -pt*)
   HANDLER ResetError(filnam: PathName) ;
      BEGIN
         sopen := StdIOError
      END ;
   HANDLER RewriteError(filnam: PathName) ;
      BEGIN
         sopen := StdIOError
      END ;
 
   BEGIN
      MakeString(name, filename) ; (* Convert to Perq string -pt*)
      { find a free slot in openlist }
      Sopen := StdIOError;
      found := False;
      i := 1;
      WHILE (i <= MAXOPEN) AND (NOT found) DO
         BEGIN
            IF (openlist[i].mode = StdIOAvail) THEN
               BEGIN
                  openlist[i].mode := mode ;
                  Sopen := i;  (* Here so file handlers can reset value -pt*)
                  IF (mode = StdIORead) OR (mode = StdIO8Read) THEN
                     Reset(openlist[i].filevar, filename)  (* [pgt001] *)
                  ELSE
                     Rewrite(openlist[i].filevar, filename);
                  found := True
               END;
            i := i + 1
         END
   END;
 
PROCEDURE Sclose (fd : filedesc);
   BEGIN
      IF (fd >= FirstUserFile) AND (fd <= MAXOPEN) THEN
         BEGIN
            openlist[fd].mode := StdIOAvail;
            close(openlist[fd].filevar);
         END
   END;
 
 
FUNCTION Exists(s:istring): Boolean;
   (* returns true if file exists. Perq version -pt*)
   VAR
      name: String ;
      file_id, blocks, bits: Integer ;
   BEGIN        (*-Exists-*)
      (* Be quick and use a look-up; better than open/close sequence  -pt*)
      MakeString(s, name) ;        (* Get the file name as a Perq string *)
      file_id := FSLookUp(name, blocks, bits) ; (* Do the look-up *)
      Exists := (file_id <> 0)     (* Zero means it does not exist *)
   END.         (*-Exists-*)