home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
os2pm.tar.gz
/
os2pm.tar
/
files.mod
< prev
next >
Wrap
Text File
|
1990-08-27
|
4KB
|
141 lines
IMPLEMENTATION MODULE Files; (* File I/O for KXCom *)
FROM FileSystem IMPORT
File, Response, Lookup, Close, ReadNBytes, WriteNBytes;
FROM Conversions IMPORT
CardToString;
FROM SYSTEM IMPORT
ADR, SIZE;
CONST
NEARFULL = 400;
TYPE
buffer = ARRAY [1..512] OF CHAR;
VAR
inBuf, outBuf : buffer;
inP, outP : CARDINAL; (* buffer pointers *)
read, written : CARDINAL; (* number of bytes read or written *)
(* by ReadNBytes or WriteNBytes *)
PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
(* opens an existing file for reading, returns status *)
BEGIN
Lookup (f, name, FALSE);
IF f.res = done THEN
inP := 0; read := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END Open;
PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
(* creates a new file for writing, returns status *)
VAR
i : CARDINAL;
b : BOOLEAN;
ext : CARDINAL; (* new file extensions to avoid name conflict *)
BEGIN
ext := 0;
LOOP
Lookup (f, name, FALSE); (* check to see if file exists *)
IF f.res = done THEN (* Filename Clase: Change file name *)
Close (f);
IF ext > 99 THEN (* out of new names... *)
RETURN Error;
END;
i := 0;
WHILE (name[i] # 0C) AND (name[i] # '.') DO
INC (i); (* scan for end of filename *)
END;
name[i] := '.';
INC (i); name[i] := 'K';
INC (i); name[i] := 0C;
CardToString (ext, 1, name, i, b);
INC (ext);
ELSE
EXIT;
END;
END;
Lookup (f, name, TRUE);
IF f.res = done THEN
outP := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END Create;
PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
(* closes a file after reading or writing *)
BEGIN
written := outP;
IF (Which = Output) AND (outP > 0) THEN
WriteNBytes (f, ADR (outBuf), outP);
written := f.count;
END;
Close (f);
IF (written = outP) AND (f.res = done) THEN
RETURN Done;
ELSE
RETURN Error;
END;
END CloseFile;
PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
(* Reads one character from the file, returns status *)
BEGIN
IF inP = read THEN
ReadNBytes (f, ADR (inBuf), SIZE (inBuf));
read := f.count;
inP := 0;
END;
IF read = 0 THEN
RETURN EOF;
ELSE
INC (inP);
ch := inBuf[inP];
RETURN Done;
END;
END Get;
PROCEDURE Put (ch : CHAR);
(* Writes one character to the file buffer *)
BEGIN
INC (outP);
outBuf[outP] := ch;
END Put;
PROCEDURE DoWrite (VAR f : File) : Status;
(* Writes buffer to disk only if nearly full *)
BEGIN
IF outP < NEARFULL THEN (* still room in buffer *)
RETURN Done;
ELSE
WriteNBytes (f, ADR (outBuf), outP);
written := f.count;
IF (written = outP) AND (f.res = done) THEN
outP := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END;
END DoWrite;
BEGIN (* module initialization *)
END Files.