ack/lang/m2/libm2/InOut.mod

360 lines
7.1 KiB
Modula-2
Raw Normal View History

1987-08-19 18:07:01 +00:00
(*$R-*)
1987-05-13 14:36:45 +00:00
IMPLEMENTATION MODULE InOut ;
1988-02-03 14:34:40 +00:00
IMPORT Streams;
1987-05-13 14:36:45 +00:00
IMPORT Conversions;
1987-06-26 15:59:52 +00:00
IMPORT Traps;
1987-05-13 14:36:45 +00:00
FROM TTY IMPORT isatty;
1988-02-03 14:34:40 +00:00
CONST TAB = 11C;
1987-05-13 14:36:45 +00:00
1988-02-03 14:34:40 +00:00
TYPE numbuf = ARRAY[0..255] OF CHAR;
1987-05-13 14:36:45 +00:00
1988-02-03 14:34:40 +00:00
VAR unread: BOOLEAN;
1987-05-13 14:36:45 +00:00
unreadch: CHAR;
1988-02-03 14:34:40 +00:00
CurrIn, CurrOut: Streams.Stream;
result: Streams.StreamResult;
1987-05-13 14:36:45 +00:00
PROCEDURE Read(VAR c : CHAR);
1988-02-03 14:34:40 +00:00
1987-05-13 14:36:45 +00:00
BEGIN
IF unread THEN
unread := FALSE;
c := unreadch;
Done := TRUE;
1987-05-13 14:36:45 +00:00
ELSE
1988-02-03 14:34:40 +00:00
Streams.Read(CurrIn, c, result);
Done := result = Streams.succeeded;
1987-05-13 14:36:45 +00:00
END;
END Read;
PROCEDURE UnRead(ch: CHAR);
BEGIN
unread := TRUE;
unreadch := ch;
END UnRead;
PROCEDURE Write(c: CHAR);
BEGIN
1988-02-03 14:34:40 +00:00
Streams.Write(CurrOut, c, result);
1987-05-13 14:36:45 +00:00
END Write;
PROCEDURE OpenInput(defext: ARRAY OF CHAR);
1988-02-03 14:34:40 +00:00
VAR namebuf : ARRAY [1..128] OF CHAR;
1987-05-13 14:36:45 +00:00
BEGIN
1988-02-03 14:34:40 +00:00
IF CurrIn # Streams.InputStream THEN
Streams.CloseStream(CurrIn, result);
1987-05-13 14:36:45 +00:00
END;
MakeFileName("Name of input file: ", defext, namebuf);
1987-06-23 17:12:42 +00:00
IF NOT Done THEN RETURN; END;
1988-02-03 14:34:40 +00:00
openinput(namebuf);
1987-05-13 14:36:45 +00:00
END OpenInput;
PROCEDURE OpenInputFile(filename: ARRAY OF CHAR);
BEGIN
1988-02-03 14:34:40 +00:00
IF CurrIn # Streams.InputStream THEN
Streams.CloseStream(CurrIn, result);
1987-05-13 14:36:45 +00:00
END;
1988-02-03 14:34:40 +00:00
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;
1987-05-13 14:36:45 +00:00
ELSE
1988-02-03 14:34:40 +00:00
Streams.OpenStream(CurrIn, namebuf, Streams.text,
Streams.reading, result);
Done := result = Streams.succeeded;
1987-05-13 14:36:45 +00:00
END;
1988-02-03 14:34:40 +00:00
END openinput;
1987-05-13 14:36:45 +00:00
PROCEDURE CloseInput;
BEGIN
1988-02-03 14:34:40 +00:00
IF CurrIn # Streams.InputStream THEN
Streams.CloseStream(CurrIn, result);
1987-05-13 14:36:45 +00:00
END;
1988-02-03 14:34:40 +00:00
CurrIn := Streams.InputStream;
1987-05-13 14:36:45 +00:00
END CloseInput;
PROCEDURE OpenOutput(defext: ARRAY OF CHAR);
1988-02-03 14:34:40 +00:00
VAR namebuf : ARRAY [1..128] OF CHAR;
1987-05-13 14:36:45 +00:00
BEGIN
1988-02-03 14:34:40 +00:00
IF CurrOut # Streams.OutputStream THEN
Streams.CloseStream(CurrOut, result);
1987-05-13 14:36:45 +00:00
END;
MakeFileName("Name of output file: ", defext, namebuf);
1987-06-23 17:12:42 +00:00
IF NOT Done THEN RETURN; END;
1988-02-03 14:34:40 +00:00
openoutput(namebuf);
1987-05-13 14:36:45 +00:00
END OpenOutput;
PROCEDURE OpenOutputFile(filename: ARRAY OF CHAR);
BEGIN
1988-02-03 14:34:40 +00:00
IF CurrOut # Streams.OutputStream THEN
Streams.CloseStream(CurrOut, result);
1987-05-13 14:36:45 +00:00
END;
1988-02-03 14:34:40 +00:00
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;
1987-05-13 14:36:45 +00:00
ELSE
1988-02-03 14:34:40 +00:00
Streams.OpenStream(CurrOut, namebuf, Streams.text,
Streams.writing, result);
Done := result = Streams.succeeded;
1987-05-13 14:36:45 +00:00
END;
1988-02-03 14:34:40 +00:00
END openoutput;
1987-05-13 14:36:45 +00:00
PROCEDURE CloseOutput;
BEGIN
1988-02-03 14:34:40 +00:00
IF CurrOut # Streams.OutputStream THEN
Streams.CloseStream(CurrOut, result);
1987-05-13 14:36:45 +00:00
END;
1988-02-03 14:34:40 +00:00
CurrOut := Streams.OutputStream;
1987-05-13 14:36:45 +00:00
END CloseOutput;
PROCEDURE MakeFileName(prompt, defext : ARRAY OF CHAR;
VAR buf : ARRAY OF CHAR);
1987-06-23 17:12:42 +00:00
VAR i : INTEGER;
1987-05-13 14:36:45 +00:00
j : CARDINAL;
BEGIN
1987-06-23 17:12:42 +00:00
Done := TRUE;
IF isatty(0) 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;
1987-05-13 14:36:45 +00:00
END;
1987-06-23 17:12:42 +00:00
RETURN;
1987-05-13 14:36:45 +00:00
END;
1987-06-23 17:12:42 +00:00
Done := FALSE;
1987-05-13 14:36:45 +00:00
END MakeFileName;
PROCEDURE ReadInt(VAR integ : INTEGER);
CONST
SAFELIMITDIV10 = MAX(INTEGER) DIV 10;
SAFELIMITREM10 = MAX(INTEGER) MOD 10;
1987-06-23 17:12:42 +00:00
TYPE
itype = [0..31];
ibuf = ARRAY itype OF CHAR;
1987-05-13 14:36:45 +00:00
VAR
int : INTEGER;
neg : BOOLEAN;
safedigit: [0 .. 9];
chvalue: CARDINAL;
1987-06-23 17:12:42 +00:00
buf : ibuf;
index : itype;
1987-05-13 14:36:45 +00:00
BEGIN
1987-06-23 17:12:42 +00:00
ReadString(buf);
IF NOT Done THEN
RETURN
END;
index := 0;
IF buf[index] = '-' THEN
1987-05-13 14:36:45 +00:00
neg := TRUE;
1987-06-23 17:12:42 +00:00
INC(index);
ELSIF buf[index] = '+' THEN
1987-05-13 14:36:45 +00:00
neg := FALSE;
1987-06-23 17:12:42 +00:00
INC(index);
1987-05-13 14:36:45 +00:00
ELSE
neg := FALSE
END;
safedigit := SAFELIMITREM10;
IF neg THEN safedigit := safedigit + 1 END;
int := 0;
1987-06-23 17:12:42 +00:00
WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
chvalue := ORD(buf[index]) - ORD('0');
IF (int > SAFELIMITDIV10) OR
( (int = SAFELIMITDIV10) AND
(chvalue > safedigit)) THEN
1987-06-26 15:59:52 +00:00
Traps.Message("integer too large");
HALT;
1987-06-23 17:12:42 +00:00
ELSE
int := 10*int + VAL(INTEGER, chvalue);
INC(index)
END;
END;
IF neg THEN
integ := -int
ELSE
integ := int
END;
IF buf[index] > " " THEN
1987-06-26 15:59:52 +00:00
Traps.Message("illegal integer");
HALT;
1987-06-23 17:12:42 +00:00
END;
Done := TRUE;
1987-05-13 14:36:45 +00:00
END ReadInt;
PROCEDURE ReadCard(VAR card : CARDINAL);
CONST
SAFELIMITDIV10 = MAX(CARDINAL) DIV 10;
SAFELIMITREM10 = MAX(CARDINAL) MOD 10;
1987-06-23 17:12:42 +00:00
TYPE
itype = [0..31];
ibuf = ARRAY itype OF CHAR;
1987-05-13 14:36:45 +00:00
VAR
int : CARDINAL;
1987-06-23 17:12:42 +00:00
index : itype;
buf : ibuf;
1987-05-13 14:36:45 +00:00
safedigit: [0 .. 9];
chvalue: CARDINAL;
BEGIN
1987-06-23 17:12:42 +00:00
ReadString(buf);
IF NOT Done THEN RETURN; END;
index := 0;
1987-05-13 14:36:45 +00:00
safedigit := SAFELIMITREM10;
int := 0;
1987-06-23 17:12:42 +00:00
WHILE (buf[index] >= '0') & (buf[index] <= '9') DO
chvalue := ORD(buf[index]) - ORD('0');
IF (int > SAFELIMITDIV10) OR
( (int = SAFELIMITDIV10) AND
(chvalue > safedigit)) THEN
1987-06-26 15:59:52 +00:00
Traps.Message("cardinal too large");
HALT;
1987-06-23 17:12:42 +00:00
ELSE
int := 10*int + chvalue;
INC(index);
END;
END;
IF buf[index] > " " THEN
1987-06-26 15:59:52 +00:00
Traps.Message("illegal cardinal");
HALT;
1987-06-23 17:12:42 +00:00
END;
card := int;
Done := TRUE;
1987-05-13 14:36:45 +00:00
END ReadCard;
PROCEDURE ReadString(VAR s : ARRAY OF CHAR);
1987-06-23 17:12:42 +00:00
TYPE charset = SET OF CHAR;
1987-05-13 14:36:45 +00:00
VAR i : CARDINAL;
ch : CHAR;
BEGIN
i := 0;
1987-06-11 13:07:27 +00:00
REPEAT
Read(ch);
1987-06-23 17:12:42 +00:00
UNTIL NOT (ch IN charset{' ', TAB, 12C, 15C});
1987-06-26 15:59:52 +00:00
IF NOT Done THEN
RETURN;
END;
UnRead(ch);
1987-06-19 09:25:08 +00:00
REPEAT
1987-05-13 14:36:45 +00:00
Read(ch);
termCH := ch;
1987-06-19 09:25:08 +00:00
IF i <= HIGH(s) THEN
s[i] := ch;
IF (NOT Done) OR (ch <= " ") THEN
s[i] := 0C;
END;
END;
1987-05-13 14:36:45 +00:00
INC(i);
1987-06-19 09:25:08 +00:00
UNTIL (NOT Done) OR (ch <= " ");
1987-06-26 15:59:52 +00:00
IF Done THEN UnRead(ch); END;
1987-05-13 14:36:45 +00:00
END ReadString;
PROCEDURE XReadString(VAR s : ARRAY OF CHAR);
1988-02-03 14:34:40 +00:00
VAR j : CARDINAL;
1987-05-13 14:36:45 +00:00
ch : CHAR;
BEGIN
j := 0;
LOOP
1988-02-03 14:34:40 +00:00
Streams.Read(Streams.InputStream, ch, result);
IF result # Streams.succeeded THEN
1987-06-23 17:12:42 +00:00
EXIT;
1987-05-13 14:36:45 +00:00
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
1988-02-03 14:34:40 +00:00
Streams.Write(Streams.OutputStream, s[i], result);
1987-05-13 14:36:45 +00:00
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 *)
1988-02-03 14:34:40 +00:00
CurrIn := Streams.InputStream;
CurrOut := Streams.OutputStream;
unread := FALSE;
1987-05-13 14:36:45 +00:00
END InOut.