468 lines
9.1 KiB
Modula-2
468 lines
9.1 KiB
Modula-2
IMPLEMENTATION MODULE PascalIo;
|
|
|
|
IMPORT Unix;
|
|
IMPORT Conversions;
|
|
IMPORT Traps;
|
|
IMPORT RealConversions;
|
|
FROM TTY IMPORT isatty;
|
|
FROM Storage IMPORT ALLOCATE;
|
|
FROM SYSTEM IMPORT ADR;
|
|
|
|
TYPE charset = SET OF CHAR;
|
|
btype = (reading, writing, free);
|
|
|
|
CONST BUFSIZ = 1024; (* Tunable *)
|
|
spaces = charset{11C, 12C, 13C, 14C, 15C, ' '};
|
|
|
|
TYPE IOBuf = RECORD
|
|
type: btype;
|
|
eof: BOOLEAN;
|
|
next: Text;
|
|
fildes: INTEGER;
|
|
cnt: INTEGER;
|
|
maxcnt: INTEGER;
|
|
bufferedcount: INTEGER;
|
|
buf: ARRAY [1..BUFSIZ] OF CHAR;
|
|
END;
|
|
Text = POINTER TO IOBuf;
|
|
numbuf = ARRAY[0..255] OF CHAR;
|
|
|
|
VAR ibuf, obuf: IOBuf;
|
|
head: Text;
|
|
|
|
PROCEDURE Reset(filename: ARRAY OF CHAR; VAR inputtext: Text);
|
|
BEGIN
|
|
doclose(inputtext);
|
|
getstruct(inputtext);
|
|
WITH inputtext^ DO
|
|
eof := FALSE;
|
|
fildes := Unix.open(ADR(filename), 0);
|
|
IF fildes < 0 THEN
|
|
Traps.Message("could not open input file");
|
|
HALT;
|
|
END;
|
|
type := reading;
|
|
cnt := 1;
|
|
maxcnt := 0;
|
|
bufferedcount := BUFSIZ;
|
|
END;
|
|
END Reset;
|
|
|
|
PROCEDURE Rewrite(filename: ARRAY OF CHAR; VAR outputtext: Text);
|
|
BEGIN
|
|
doclose(outputtext);
|
|
getstruct(outputtext);
|
|
WITH outputtext^ DO
|
|
eof := FALSE;
|
|
fildes := Unix.creat(ADR(filename), 666B);
|
|
IF fildes < 0 THEN
|
|
Traps.Message("could not open output file");
|
|
HALT;
|
|
END;
|
|
type := writing;
|
|
cnt := 0;
|
|
maxcnt := 0;
|
|
bufferedcount := BUFSIZ;
|
|
END;
|
|
END Rewrite;
|
|
|
|
PROCEDURE PascalIoCleanup();
|
|
VAR text: Text;
|
|
BEGIN
|
|
text := head;
|
|
WHILE text # NIL DO
|
|
doclose(text);
|
|
text := text^.next;
|
|
END;
|
|
END PascalIoCleanup;
|
|
|
|
PROCEDURE doclose(text: Text);
|
|
VAR dummy: INTEGER;
|
|
BEGIN
|
|
IF text # notext THEN
|
|
WITH text^ DO
|
|
IF type = writing THEN
|
|
Flush(text);
|
|
END;
|
|
IF type # free THEN
|
|
type := free;
|
|
dummy := Unix.close(fildes);
|
|
END;
|
|
END;
|
|
END;
|
|
END doclose;
|
|
|
|
PROCEDURE getstruct(VAR text: Text);
|
|
BEGIN
|
|
text := head;
|
|
WHILE (text # NIL) AND (text^.type # free) DO
|
|
text := text^.next;
|
|
END;
|
|
IF text = NIL THEN
|
|
NEW(text);
|
|
text^.next := head;
|
|
head := text;
|
|
END;
|
|
END getstruct;
|
|
|
|
PROCEDURE chk(text: Text; tp: btype);
|
|
BEGIN
|
|
IF text^.type # tp THEN
|
|
IF tp = reading THEN
|
|
Traps.Message("input text expected");
|
|
ELSE
|
|
Traps.Message("output text expected");
|
|
END;
|
|
HALT;
|
|
END;
|
|
END chk;
|
|
|
|
PROCEDURE ReadCHAR(inputtext: Text; VAR ch : CHAR);
|
|
BEGIN
|
|
ch := NextCHAR(inputtext);
|
|
Get(inputtext);
|
|
END ReadCHAR;
|
|
|
|
PROCEDURE NextCHAR(inputtext: Text): CHAR;
|
|
VAR c: CHAR;
|
|
BEGIN
|
|
chk(inputtext, reading);
|
|
WITH inputtext^ DO
|
|
IF cnt <= maxcnt THEN
|
|
c := buf[cnt];
|
|
ELSE
|
|
c := FillBuf(inputtext);
|
|
END;
|
|
END;
|
|
RETURN c;
|
|
END NextCHAR;
|
|
|
|
PROCEDURE Get(inputtext: Text);
|
|
VAR dummy: CHAR;
|
|
BEGIN
|
|
chk(inputtext, reading);
|
|
WITH inputtext^ DO
|
|
IF eof THEN
|
|
Traps.Message("unexpected EOF");
|
|
HALT;
|
|
END;
|
|
IF cnt > maxcnt THEN
|
|
dummy := FillBuf(inputtext);
|
|
END;
|
|
INC(cnt);
|
|
END;
|
|
END Get;
|
|
|
|
PROCEDURE FillBuf(ib: Text) : CHAR;
|
|
VAR c : CHAR;
|
|
BEGIN
|
|
WITH ib^ DO
|
|
IF eof THEN RETURN 0C; END;
|
|
maxcnt := Unix.read(fildes, ADR(buf), bufferedcount);
|
|
cnt := 1;
|
|
IF maxcnt <= 0 THEN
|
|
c := 0C;
|
|
eof := TRUE;
|
|
ELSE
|
|
c := buf[1];
|
|
END;
|
|
END;
|
|
RETURN c;
|
|
END FillBuf;
|
|
|
|
PROCEDURE Eoln(inputtext: Text): BOOLEAN;
|
|
BEGIN
|
|
RETURN NextCHAR(inputtext) = 12C;
|
|
END Eoln;
|
|
|
|
PROCEDURE Eof(inputtext: Text): BOOLEAN;
|
|
BEGIN
|
|
RETURN (NextCHAR(inputtext) = 0C) AND inputtext^.eof;
|
|
END Eof;
|
|
|
|
PROCEDURE ReadLn(inputtext: Text);
|
|
VAR ch: CHAR;
|
|
BEGIN
|
|
REPEAT
|
|
ReadCHAR(inputtext, ch)
|
|
UNTIL ch = 12C;
|
|
END ReadLn;
|
|
|
|
PROCEDURE Flush(ob: Text);
|
|
VAR dummy: INTEGER;
|
|
BEGIN
|
|
WITH ob^ DO
|
|
dummy := Unix.write(fildes, ADR(buf), cnt);
|
|
cnt := 0;
|
|
END;
|
|
END Flush;
|
|
|
|
PROCEDURE WriteCHAR(outputtext: Text; ch: CHAR);
|
|
BEGIN
|
|
chk(outputtext, writing);
|
|
WITH outputtext^ DO
|
|
INC(cnt);
|
|
buf[cnt] := ch;
|
|
IF cnt >= bufferedcount THEN
|
|
Flush(outputtext);
|
|
END;
|
|
END;
|
|
END WriteCHAR;
|
|
|
|
PROCEDURE WriteLn(outputtext: Text);
|
|
BEGIN
|
|
WriteCHAR(outputtext, 12C);
|
|
END WriteLn;
|
|
|
|
PROCEDURE Page(outputtext: Text);
|
|
BEGIN
|
|
WriteCHAR(outputtext, 14C);
|
|
END Page;
|
|
|
|
PROCEDURE ReadINTEGER(inputtext: Text; VAR int : INTEGER);
|
|
CONST
|
|
SAFELIMITDIV10 = MAX(INTEGER) DIV 10;
|
|
SAFELIMITREM10 = MAX(INTEGER) MOD 10;
|
|
VAR
|
|
neg : BOOLEAN;
|
|
safedigit: CARDINAL;
|
|
ch: CHAR;
|
|
chvalue: CARDINAL;
|
|
BEGIN
|
|
WHILE NextCHAR(inputtext) IN spaces DO
|
|
Get(inputtext);
|
|
END;
|
|
ch := NextCHAR(inputtext);
|
|
IF ch = '-' THEN
|
|
Get(inputtext);
|
|
ch := NextCHAR(inputtext);
|
|
neg := TRUE;
|
|
ELSIF ch = '+' THEN
|
|
Get(inputtext);
|
|
ch := NextCHAR(inputtext);
|
|
neg := FALSE;
|
|
ELSE
|
|
neg := FALSE
|
|
END;
|
|
|
|
safedigit := SAFELIMITREM10;
|
|
IF neg THEN safedigit := safedigit + 1 END;
|
|
int := 0;
|
|
IF (ch >= '0') AND (ch <= '9') THEN
|
|
WHILE (ch >= '0') & (ch <= '9') DO
|
|
chvalue := ORD(ch) - 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);
|
|
Get(inputtext);
|
|
ch := NextCHAR(inputtext);
|
|
END;
|
|
END;
|
|
IF NOT neg THEN
|
|
int := -int
|
|
END;
|
|
ELSE
|
|
Traps.Message("integer expected");
|
|
HALT;
|
|
END;
|
|
END ReadINTEGER;
|
|
|
|
PROCEDURE ReadCARDINAL(inputtext: Text; VAR card : CARDINAL);
|
|
CONST
|
|
SAFELIMITDIV10 = MAX(CARDINAL) DIV 10;
|
|
SAFELIMITREM10 = MAX(CARDINAL) MOD 10;
|
|
|
|
VAR
|
|
ch : CHAR;
|
|
safedigit: CARDINAL;
|
|
chvalue: CARDINAL;
|
|
BEGIN
|
|
WHILE NextCHAR(inputtext) IN spaces DO
|
|
Get(inputtext);
|
|
END;
|
|
ch := NextCHAR(inputtext);
|
|
safedigit := SAFELIMITREM10;
|
|
card := 0;
|
|
IF (ch >= '0') AND (ch <= '9') THEN
|
|
WHILE (ch >= '0') & (ch <= '9') DO
|
|
chvalue := ORD(ch) - ORD('0');
|
|
IF (card > SAFELIMITDIV10) OR
|
|
( (card = SAFELIMITDIV10) AND
|
|
(chvalue > safedigit)) THEN
|
|
Traps.Message("cardinal too large");
|
|
HALT;
|
|
ELSE
|
|
card := 10*card + chvalue;
|
|
Get(inputtext);
|
|
ch := NextCHAR(inputtext);
|
|
END;
|
|
END;
|
|
ELSE
|
|
Traps.Message("cardinal expected");
|
|
HALT;
|
|
END;
|
|
END ReadCARDINAL;
|
|
|
|
PROCEDURE ReadREAL(inputtext: Text; VAR real: REAL);
|
|
VAR
|
|
buf: numbuf;
|
|
ch: CHAR;
|
|
ok: BOOLEAN;
|
|
index: INTEGER;
|
|
|
|
PROCEDURE inch(): CHAR;
|
|
BEGIN
|
|
buf[index] := ch;
|
|
INC(index);
|
|
Get(inputtext);
|
|
RETURN NextCHAR(inputtext);
|
|
END inch;
|
|
|
|
BEGIN
|
|
index := 0;
|
|
ok := TRUE;
|
|
WHILE NextCHAR(inputtext) IN spaces DO
|
|
Get(inputtext);
|
|
END;
|
|
ch := NextCHAR(inputtext);
|
|
IF (ch ='+') OR (ch = '-') THEN
|
|
ch := inch();
|
|
END;
|
|
IF (ch >= '0') AND (ch <= '9') THEN
|
|
WHILE (ch >= '0') AND (ch <= '9') DO
|
|
ch := inch();
|
|
END;
|
|
IF (ch = '.') THEN
|
|
ch := inch();
|
|
IF (ch >= '0') AND (ch <= '9') THEN
|
|
WHILE (ch >= '0') AND (ch <= '9') DO
|
|
ch := inch();
|
|
END;
|
|
ELSE
|
|
ok := FALSE;
|
|
END;
|
|
END;
|
|
IF ok AND (ch = 'E') THEN
|
|
ch := inch();
|
|
IF (ch ='+') OR (ch = '-') THEN
|
|
ch := inch();
|
|
END;
|
|
IF (ch >= '0') AND (ch <= '9') THEN
|
|
WHILE (ch >= '0') AND (ch <= '9') DO
|
|
ch := inch();
|
|
END;
|
|
ELSE
|
|
ok := FALSE;
|
|
END;
|
|
END;
|
|
ELSE
|
|
ok := FALSE;
|
|
END;
|
|
IF ok THEN
|
|
buf[index] := 0C;
|
|
RealConversions.StringToReal(buf, real, ok);
|
|
END;
|
|
IF NOT ok THEN
|
|
Traps.Message("Illegal real");
|
|
HALT;
|
|
END;
|
|
END ReadREAL;
|
|
|
|
PROCEDURE WriteCARDINAL(outputtext: Text; card: CARDINAL; width: CARDINAL);
|
|
VAR
|
|
buf : numbuf;
|
|
BEGIN
|
|
Conversions.ConvertCardinal(card, 1, buf);
|
|
WriteSTRING(outputtext, buf, width);
|
|
END WriteCARDINAL;
|
|
|
|
PROCEDURE WriteINTEGER(outputtext: Text; int: INTEGER; width: CARDINAL);
|
|
VAR
|
|
buf : numbuf;
|
|
BEGIN
|
|
Conversions.ConvertInteger(int, 1, buf);
|
|
WriteSTRING(outputtext, buf, width);
|
|
END WriteINTEGER;
|
|
|
|
PROCEDURE WriteBOOLEAN(outputtext: Text; bool: BOOLEAN; width: CARDINAL);
|
|
BEGIN
|
|
IF bool THEN
|
|
WriteSTRING(outputtext, " TRUE", width);
|
|
ELSE
|
|
WriteSTRING(outputtext, "FALSE", width);
|
|
END;
|
|
END WriteBOOLEAN;
|
|
|
|
PROCEDURE WriteREAL(outputtext: Text; real: REAL; width, nfrac: CARDINAL);
|
|
VAR
|
|
buf: numbuf;
|
|
ok: BOOLEAN;
|
|
digits: INTEGER;
|
|
BEGIN
|
|
IF width > SIZE(buf) THEN
|
|
width := SIZE(buf);
|
|
END;
|
|
IF nfrac > 0 THEN
|
|
RealConversions.RealToString(real, width, nfrac, buf, ok);
|
|
ELSE
|
|
IF width < 9 THEN width := 9; END;
|
|
IF real < 0.0 THEN
|
|
digits := 7 - INTEGER(width);
|
|
ELSE
|
|
digits := 6 - INTEGER(width);
|
|
END;
|
|
RealConversions.RealToString(real, width, digits, buf, ok);
|
|
END;
|
|
WriteSTRING(outputtext, buf, 0);
|
|
END WriteREAL;
|
|
|
|
PROCEDURE WriteSTRING(outputtext: Text; str: ARRAY OF CHAR; width: CARDINAL);
|
|
VAR index: CARDINAL;
|
|
BEGIN
|
|
index := 0;
|
|
WHILE (index <= HIGH(str)) AND (str[index] # EOS) DO
|
|
INC(index);
|
|
END;
|
|
WHILE index < width DO
|
|
WriteCHAR(outputtext, " ");
|
|
INC(index);
|
|
END;
|
|
index := 0;
|
|
WHILE (index <= HIGH(str)) AND (str[index] # EOS) DO
|
|
WriteCHAR(outputtext, str[index]);
|
|
INC(index);
|
|
END;
|
|
END WriteSTRING;
|
|
|
|
BEGIN (* PascalIo initialization *)
|
|
WITH ibuf DO
|
|
eof := FALSE;
|
|
type := reading;
|
|
fildes := 0;
|
|
bufferedcount := BUFSIZ;
|
|
maxcnt := 0;
|
|
cnt := 1;
|
|
END;
|
|
WITH obuf DO
|
|
eof := FALSE;
|
|
type := writing;
|
|
fildes := 1;
|
|
IF isatty(1) THEN
|
|
bufferedcount := 1;
|
|
ELSE
|
|
bufferedcount := BUFSIZ;
|
|
END;
|
|
cnt := 0;
|
|
END;
|
|
notext := NIL;
|
|
input := ADR(ibuf);
|
|
output := ADR(obuf);
|
|
input^.next := output;
|
|
output^.next := NIL;
|
|
head := input;
|
|
END PascalIo.
|