home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / perqa / stdio.pas < prev   
Pascal/Delphi Source File  |  2020-01-01  |  8KB  |  276 lines
  1. MODULE STDIO ;
  2. (* Standard text file I/O *)
  3. (* from Kernighan + Plauger *)
  4. (* 29-Nov-83  Allow eight bit file transfer [pgt001] *)
  5. (*            This forces us to make the end of (data) string value -1 *)
  6. (*            and end of file value -2 because byte values can be 0..255 *)
  7.  
  8.  
  9. EXPORTS
  10.  
  11. IMPORTS  KermitGlobals         FROM KermitGlobals ;
  12.  
  13. CONST
  14.    { standard file descriptors. subscripts in open, etc. }
  15.    STDIN = 1;              { these are not to be changed }
  16.    STDOUT = 2;
  17.    STDERR = 3;
  18.    lineout = 4;
  19.    linein = 5;
  20.    FirstUserFile = STDERR ; (* First index available for user's files -pt*)
  21.  
  22.    { other io-related stuff }
  23.    StdIOError = 0;    { status values for open files }
  24.    StdIOAvail = 1;
  25.    StdIORead = 2;
  26.    StdIOWrite = 3;
  27.    StdIO8Read = 4 ;  (* [pgt001] *)
  28.    StdIO8Write = 5 ;  (* [pgt001] *)
  29.    MAXOPEN = 15;   { maximum number of open files }
  30.  
  31.    { universal manifest constants }
  32.    ENDFILE = ENDSTR - 1;  (* [pgt001] *)
  33.  
  34. TYPE
  35.    filedesc = StdIOError..MAXOPEN;
  36.    ioblock = RECORD        { to keep track of open files }
  37.                 filevar : Text;
  38.                 mode : StdIOError..StdIO8Write;
  39.              END;
  40.  
  41. VAR
  42.    openlist : ARRAY [1..MAXOPEN] OF ioblock; { open files }
  43.  
  44. PROCEDURE StdIOInit;
  45. PROCEDURE putch (c : CharBytes);
  46. PROCEDURE putcf (c : CharBytes; fd : filedesc);
  47. PROCEDURE putstr (VAR s : istring; f : filedesc);
  48. FUNCTION getch (VAR c : CharBytes) : CharBytes;
  49. FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
  50. FUNCTION getline (VAR s : istring; fd : filedesc;
  51.                   maxsize : Integer) : Boolean;
  52.  
  53. FUNCTION Sopen (name : istring; mode :   Integer) : filedesc;
  54. PROCEDURE Sclose (fd : filedesc);
  55. FUNCTION Exists(s:istring): Boolean;
  56.  
  57. PRIVATE
  58.  
  59.  
  60. IMPORTS  Perq_string    FROM Perq_String ;
  61. IMPORTS  Stream         FROM Stream ;
  62. IMPORTS  FileSystem     FROM FileSystem ;
  63.  
  64.  
  65.    { StdIOInit  -- initialize open file list }
  66. PROCEDURE StdIOInit;
  67.    VAR
  68.       i :     filedesc;
  69.    BEGIN
  70.       openlist[STDIN].mode := StdIORead;
  71.       openlist[STDOUT].mode := StdIOWrite;
  72.       { initialize rest of files      }
  73.       FOR i := FirstUserFile TO MAXOPEN DO
  74.          openlist[i].mode := StdIOAvail;
  75.  
  76.    END;
  77.  
  78.  
  79.    { getc (UCB) -- get one character from standard input }
  80. FUNCTION getch (VAR c : CharBytes) : CharBytes;
  81.    VAR
  82.       ch : Char;
  83.    BEGIN
  84.       IF Eof THEN c := ENDFILE
  85.       ELSE
  86.          IF Eoln THEN
  87.             BEGIN
  88.                Readln;
  89.                c := LF
  90.             END
  91.          ELSE
  92.             BEGIN
  93.                Read(ch);
  94.                c := Ord(ch)
  95.             END;
  96.       getch := c
  97.    END;
  98.  
  99.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  100.    { getcf (UCB) -- get one character from file }
  101. FUNCTION getcf (VAR c: CharBytes; fd : filedesc) : CharBytes;
  102.    VAR
  103.       ch : Char;
  104.    BEGIN
  105.     WITH  openlist[fd]  DO   (* [pgt001] *)
  106.       IF (fd = STDIN) THEN getcf := getch(c)
  107.       ELSE
  108.          IF Eof(filevar) THEN  c := ENDFILE
  109.          ELSE
  110.            IF (mode = StdIO8Read) THEN (* [pgt001] *)
  111.               BEGIN
  112.                  c := Ord( filevar^ ) ;
  113.                  Get( filevar )
  114.               END                      (* [pgt001] *)
  115.            ELSE
  116.             IF Eoln(filevar) THEN
  117.                BEGIN
  118.                   Readln(filevar);
  119.                   c := LF
  120.                END
  121.             ELSE
  122.                BEGIN
  123.                   Read(filevar, ch);
  124.                   c := Ord(ch)
  125.                END;
  126.       getcf := c
  127.    END;
  128.  
  129.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  130.    { getline (UCB) -- get a line from file }
  131. FUNCTION getline (VAR s : istring; fd : filedesc;
  132.                   maxsize : Integer) : Boolean;
  133.    VAR
  134.       i : Integer;
  135.       c : CharBytes;
  136.    BEGIN
  137.       {$RANGE-}
  138.       i := 1;
  139.       REPEAT
  140.          s[i] := getcf(c, fd);
  141.          i := i + 1
  142.       UNTIL (c = ENDFILE) OR (c = LF) OR (i >= maxsize);
  143.       IF (c = ENDFILE) THEN i := i - 1 ;      { went one too far }
  144.       s[i] := ENDSTR;
  145.       getline := (c <> ENDFILE)
  146.       {$RANGE+}
  147.    END;
  148.  
  149.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  150.    { putch (UCB) -- put one character on standard output }
  151. PROCEDURE putch (c : CharBytes);
  152.    BEGIN
  153.       IF (c = LF) THEN Writeln
  154.       ELSE Write(Chr(c))
  155.    END;
  156.  
  157.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  158.    { putcf (UCB) -- put a single character on file fd }
  159. PROCEDURE putcf (c : CharBytes; fd : filedesc);
  160.    CONST
  161.       NUL = 0 ;
  162.    BEGIN
  163.     WITH  openlist[fd]  DO
  164.       IF (fd = STDOUT) THEN putch(c)
  165.       ELSE
  166.        IF (mode = StdIO8Write) THEN (* [pgt001] *)
  167.           BEGIN
  168.              filevar^ := Chr(c) ;
  169.              Put( filevar )
  170.           END
  171.        ELSE
  172.          BEGIN  (* Normal text file [pgt001]*)
  173.            c := Land(c, #177) ;
  174.            IF (c = LF) THEN   Writeln(filevar)
  175.            ELSE
  176.              IF (c = CR) OR (c = NUL) THEN (* ignore *)
  177.              ELSE
  178.               Write(filevar, Chr( c ))
  179.          END ;
  180.    END;
  181.  
  182.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  183.    { putstr (UCB) -- put out string on file }
  184. PROCEDURE putstr (VAR s : istring; f : filedesc);
  185.    VAR
  186.       i : Integer;
  187.    BEGIN
  188.       {$RANGE-}
  189.       i := 1;
  190.       WHILE (s[i] <> ENDSTR) DO
  191.          BEGIN
  192.             putcf(s[i], f);
  193.             i := i + 1
  194.          END
  195.       {$RANGE+}
  196.    END;
  197.  
  198.  
  199.    { MakeString -- Convert an istring into a Perq String variable -pt }
  200. PROCEDURE MakeString(src: istring; VAR dest: String) ;
  201.    VAR
  202.       i: Integer ;
  203.    BEGIN (*-MakeString-*)
  204.       i := 1 ;
  205.       {$RANGE- Checks off because Length(dest) undefined at the moment -pt}
  206.       WHILE (src[i] <> ENDSTR) AND (src[i] <> LF) DO
  207.          BEGIN
  208.             dest[i] := Chr(src[i]) ;
  209.             i := i + 1
  210.          END ;
  211.       {$RANGE+  Checks back on -pt}
  212.       Adjust(dest, i-1)   (* Set the dynamic length -pt*)
  213.    END ; (*-MakeString-*)
  214.  
  215.    { open  -- open a file for reading or writing.   Perq version -pt}
  216. FUNCTION Sopen (name : istring; mode :   Integer) : filedesc;
  217.    VAR
  218.       i :     Integer;
  219.       filename : String ;
  220.       found : Boolean;
  221.  
  222.       (* Reset and Rewrite error handlers. Both set "sopen" to IOERROR   -pt*)
  223.       (* This means we set inital value of "sopen" before reset/rewrite  -pt*)
  224.    HANDLER ResetError(filnam: PathName) ;
  225.       BEGIN
  226.          sopen := StdIOError
  227.       END ;
  228.    HANDLER RewriteError(filnam: PathName) ;
  229.       BEGIN
  230.          sopen := StdIOError
  231.       END ;
  232.  
  233.    BEGIN
  234.       MakeString(name, filename) ; (* Convert to Perq string -pt*)
  235.       { find a free slot in openlist }
  236.       Sopen := StdIOError;
  237.       found := False;
  238.       i := 1;
  239.       WHILE (i <= MAXOPEN) AND (NOT found) DO
  240.          BEGIN
  241.             IF (openlist[i].mode = StdIOAvail) THEN
  242.                BEGIN
  243.                   openlist[i].mode := mode ;
  244.                   Sopen := i;  (* Here so file handlers can reset value -pt*)
  245.                   IF (mode = StdIORead) OR (mode = StdIO8Read) THEN
  246.                      Reset(openlist[i].filevar, filename)  (* [pgt001] *)
  247.                   ELSE
  248.                      Rewrite(openlist[i].filevar, filename);
  249.                   found := True
  250.                END;
  251.             i := i + 1
  252.          END
  253.    END;
  254.  
  255. PROCEDURE Sclose (fd : filedesc);
  256.    BEGIN
  257.       IF (fd >= FirstUserFile) AND (fd <= MAXOPEN) THEN
  258.          BEGIN
  259.             openlist[fd].mode := StdIOAvail;
  260.             close(openlist[fd].filevar);
  261.          END
  262.    END;
  263.  
  264.  
  265. FUNCTION Exists(s:istring): Boolean;
  266.    (* returns true if file exists. Perq version -pt*)
  267.    VAR
  268.       name: String ;
  269.       file_id, blocks, bits: Integer ;
  270.    BEGIN        (*-Exists-*)
  271.       (* Be quick and use a look-up; better than open/close sequence  -pt*)
  272.       MakeString(s, name) ;        (* Get the file name as a Perq string *)
  273.       file_id := FSLookUp(name, blocks, bits) ; (* Do the look-up *)
  274.       Exists := (file_id <> 0)     (* Zero means it does not exist *)
  275.    END.         (*-Exists-*)
  276.