home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
perqa.tar.gz
/
perqa.tar
/
stdio.pas
< prev
Wrap
Pascal/Delphi Source File
|
1984-12-04
|
8KB
|
276 lines
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-*)