ack/lang/m2/libm2/InOut.mod
1988-02-19 16:52:54 +00:00

369 lines
7.4 KiB
Modula-2

(*
(c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
See the copyright notice in the ACK home directory, in the file "Copyright".
*)
(*$R-*)
IMPLEMENTATION MODULE InOut ;
(*
Module: Wirth's Input/Output module
Author: Ceriel J.H. Jacobs
Version: $Header$
*)
IMPORT Streams;
IMPORT Conversions;
IMPORT Traps;
CONST TAB = 11C;
TYPE numbuf = ARRAY[0..255] OF CHAR;
VAR unread: BOOLEAN;
unreadch: CHAR;
CurrIn, CurrOut: Streams.Stream;
result: Streams.StreamResult;
PROCEDURE Read(VAR c : CHAR);
BEGIN
IF unread THEN
unread := FALSE;
c := unreadch;
Done := TRUE;
ELSE
Streams.Read(CurrIn, c, result);
Done := result = Streams.succeeded;
END;
END Read;
PROCEDURE UnRead(ch: CHAR);
BEGIN
unread := TRUE;
unreadch := ch;
END UnRead;
PROCEDURE Write(c: CHAR);
BEGIN
Streams.Write(CurrOut, c, result);
END Write;
PROCEDURE OpenInput(defext: ARRAY OF CHAR);
VAR namebuf : ARRAY [1..128] OF CHAR;
BEGIN
IF CurrIn # Streams.InputStream THEN
Streams.CloseStream(CurrIn, result);
END;
MakeFileName("Name of input file: ", defext, namebuf);
IF NOT Done THEN RETURN; END;
openinput(namebuf);
END OpenInput;
PROCEDURE OpenInputFile(filename: ARRAY OF CHAR);
BEGIN
IF CurrIn # Streams.InputStream THEN
Streams.CloseStream(CurrIn, result);
END;
openinput(filename);
END OpenInputFile;
PROCEDURE openinput(VAR namebuf: ARRAY OF CHAR);
BEGIN
IF (namebuf[0] = '-') AND (namebuf[1] = 0C) THEN
CurrIn := Streams.InputStream;
Done := TRUE;
ELSE
Streams.OpenStream(CurrIn, namebuf, Streams.text,
Streams.reading, result);
Done := result = Streams.succeeded;
END;
END openinput;
PROCEDURE CloseInput;
BEGIN
IF CurrIn # Streams.InputStream THEN
Streams.CloseStream(CurrIn, result);
END;
CurrIn := Streams.InputStream;
END CloseInput;
PROCEDURE OpenOutput(defext: ARRAY OF CHAR);
VAR namebuf : ARRAY [1..128] OF CHAR;
BEGIN
IF CurrOut # Streams.OutputStream THEN
Streams.CloseStream(CurrOut, result);
END;
MakeFileName("Name of output file: ", defext, namebuf);
IF NOT Done THEN RETURN; END;
openoutput(namebuf);
END OpenOutput;
PROCEDURE OpenOutputFile(filename: ARRAY OF CHAR);
BEGIN
IF CurrOut # Streams.OutputStream THEN
Streams.CloseStream(CurrOut, result);
END;
openoutput(filename);
END OpenOutputFile;
PROCEDURE openoutput(VAR namebuf: ARRAY OF CHAR);
BEGIN
IF (namebuf[1] = '-') AND (namebuf[2] = 0C) THEN
CurrOut := Streams.OutputStream;
Done := TRUE;
ELSE
Streams.OpenStream(CurrOut, namebuf, Streams.text,
Streams.writing, result);
Done := result = Streams.succeeded;
END;
END openoutput;
PROCEDURE CloseOutput;
BEGIN
IF CurrOut # Streams.OutputStream THEN
Streams.CloseStream(CurrOut, result);
END;
CurrOut := Streams.OutputStream;
END CloseOutput;
PROCEDURE MakeFileName(prompt, defext : ARRAY OF CHAR;
VAR buf : ARRAY OF CHAR);
VAR i : INTEGER;
j : CARDINAL;
BEGIN
Done := TRUE;
IF Streams.isatty(Streams.InputStream, result) THEN
XWriteString(prompt);
END;
XReadString(buf);
i := 0;
WHILE buf[i] # 0C DO i := i + 1 END;
IF i # 0 THEN
i := i - 1;
IF buf[i] = '.' THEN
FOR j := 0 TO HIGH(defext) DO
i := i + 1;
buf[i] := defext[j];
END;
buf[i+1] := 0C;
END;
RETURN;
END;
Done := FALSE;
END MakeFileName;
PROCEDURE ReadInt(VAR integ : INTEGER);
CONST
SAFELIMITDIV10 = MAX(INTEGER) DIV 10;
SAFELIMITREM10 = MAX(INTEGER) MOD 10;
TYPE
itype = [0..31];
ibuf = ARRAY itype OF CHAR;
VAR
int : INTEGER;
neg : BOOLEAN;
safedigit: [0 .. 9];
chvalue: CARDINAL;
buf : ibuf;
index : itype;
BEGIN
ReadString(buf);
IF NOT Done THEN
RETURN
END;
index := 0;
IF buf[index] = '-' THEN
neg := TRUE;
INC(index);
ELSIF buf[index] = '+' THEN
neg := FALSE;
INC(index);
ELSE
neg := FALSE
END;
safedigit := SAFELIMITREM10;
IF neg THEN safedigit := safedigit + 1 END;
int := 0;
WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
chvalue := ORD(buf[index]) - ORD('0');
IF (int > SAFELIMITDIV10) OR
( (int = SAFELIMITDIV10) AND
(chvalue > safedigit)) THEN
Traps.Message("integer too large");
HALT;
ELSE
int := 10*int + VAL(INTEGER, chvalue);
INC(index)
END;
END;
IF neg THEN
integ := -int
ELSE
integ := int
END;
IF buf[index] > " " THEN
Traps.Message("illegal integer");
HALT;
END;
Done := TRUE;
END ReadInt;
PROCEDURE ReadCard(VAR card : CARDINAL);
CONST
SAFELIMITDIV10 = MAX(CARDINAL) DIV 10;
SAFELIMITREM10 = MAX(CARDINAL) MOD 10;
TYPE
itype = [0..31];
ibuf = ARRAY itype OF CHAR;
VAR
int : CARDINAL;
index : itype;
buf : ibuf;
safedigit: [0 .. 9];
chvalue: CARDINAL;
BEGIN
ReadString(buf);
IF NOT Done THEN RETURN; END;
index := 0;
safedigit := SAFELIMITREM10;
int := 0;
WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
chvalue := ORD(buf[index]) - ORD('0');
IF (int > SAFELIMITDIV10) OR
( (int = SAFELIMITDIV10) AND
(chvalue > safedigit)) THEN
Traps.Message("cardinal too large");
HALT;
ELSE
int := 10*int + chvalue;
INC(index);
END;
END;
IF buf[index] > " " THEN
Traps.Message("illegal cardinal");
HALT;
END;
card := int;
Done := TRUE;
END ReadCard;
PROCEDURE ReadString(VAR s : ARRAY OF CHAR);
TYPE charset = SET OF CHAR;
VAR i : CARDINAL;
ch : CHAR;
BEGIN
i := 0;
REPEAT
Read(ch);
UNTIL NOT (ch IN charset{' ', TAB, 12C, 15C});
IF NOT Done THEN
RETURN;
END;
UnRead(ch);
REPEAT
Read(ch);
termCH := ch;
IF i <= HIGH(s) THEN
s[i] := ch;
IF (NOT Done) OR (ch <= " ") THEN
s[i] := 0C;
END;
END;
INC(i);
UNTIL (NOT Done) OR (ch <= " ");
IF Done THEN UnRead(ch); END;
END ReadString;
PROCEDURE XReadString(VAR s : ARRAY OF CHAR);
VAR j : CARDINAL;
ch : CHAR;
BEGIN
j := 0;
LOOP
Streams.Read(Streams.InputStream, ch, result);
IF result # Streams.succeeded THEN
EXIT;
END;
IF ch <= " " THEN
s[j] := 0C;
EXIT;
END;
IF j < HIGH(s) THEN
s[j] := ch;
INC(j);
END;
END;
END XReadString;
PROCEDURE XWriteString(s: ARRAY OF CHAR);
VAR i: CARDINAL;
BEGIN
i := 0;
LOOP
IF (i <= HIGH(s)) AND (s[i] # 0C) THEN
Streams.Write(Streams.OutputStream, s[i], result);
ELSE
EXIT;
END;
END;
END XWriteString;
PROCEDURE WriteCard(card, width : CARDINAL);
VAR
buf : numbuf;
BEGIN
Conversions.ConvertCardinal(card, width, buf);
WriteString(buf);
END WriteCard;
PROCEDURE WriteInt(int : INTEGER; width : CARDINAL);
VAR
buf : numbuf;
BEGIN
Conversions.ConvertInteger(int, width, buf);
WriteString(buf);
END WriteInt;
PROCEDURE WriteHex(card, width : CARDINAL);
VAR
buf : numbuf;
BEGIN
Conversions.ConvertHex(card, width, buf);
WriteString(buf);
END WriteHex;
PROCEDURE WriteLn;
BEGIN
Write(EOL)
END WriteLn;
PROCEDURE WriteOct(card, width : CARDINAL);
VAR
buf : numbuf;
BEGIN
Conversions.ConvertOctal(card, width, buf);
WriteString(buf);
END WriteOct;
PROCEDURE WriteString(str : ARRAY OF CHAR);
VAR
nbytes : CARDINAL;
BEGIN
nbytes := 0;
WHILE (nbytes <= HIGH(str)) AND (str[nbytes] # 0C) DO
Write(str[nbytes]);
INC(nbytes)
END;
END WriteString;
BEGIN (* InOut initialization *)
CurrIn := Streams.InputStream;
CurrOut := Streams.OutputStream;
unread := FALSE;
END InOut.