Category : Modula II Source Code
Archive   : PCKERM.ZIP
Filename : FILES.MOD

IMPLEMENTATION MODULE Files; (* File I/O for Kermit *)

FROM FileSystem IMPORT
File, Response, Delete, Lookup, Close, ReadNBytes, WriteNBytes;

FROM InOut IMPORT
Read, WriteString, WriteLn, Write;

FROM SYSTEM IMPORT
ADR, SIZE;


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
ch : CHAR;

BEGIN
Lookup (f, name, FALSE); (* check to see if file exists *)
IF f.res = done THEN
Close (f);
WriteString ("File exists! Overwrite? (Y/N): ");
Read (ch); Write (ch); WriteLn;
IF CAP (ch) = 'Y' THEN
Delete (name, f);
Close (f);
ELSE
RETURN Error;
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);
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);
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 < 400 THEN (* still room in buffer *)
RETURN Done;
ELSE
WriteNBytes (f, ADR (outBuf), outP, written);
IF (written = outP) AND (f.res = done) THEN
outP := 0;
RETURN Done;
ELSE
RETURN Error;
END;
END;
END DoWrite;

END Files.