123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437 |
- (*
- (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 PascalIO;
- (*
- Module: Pascal-like Input/Output
- Author: Ceriel J.H. Jacobs
- Version: $Id$
- *)
- FROM Conversions IMPORT
- ConvertInteger, ConvertCardinal;
- FROM RealConversions IMPORT
- LongRealToString, StringToLongReal;
- FROM Traps IMPORT Message;
- FROM Streams IMPORT Stream, StreamKind, StreamMode, StreamResult,
- InputStream, OutputStream, OpenStream, CloseStream,
- EndOfStream, Read, Write, StreamBuffering;
- FROM Storage IMPORT Allocate;
- FROM SYSTEM IMPORT ADR;
- TYPE charset = SET OF CHAR;
- btype = (Preading, Pwriting, free);
- CONST spaces = charset{11C, 12C, 13C, 14C, 15C, ' '};
- TYPE IOstream = RECORD
- type: btype;
- done, eof : BOOLEAN;
- ch: CHAR;
- next: Text;
- stream: Stream;
- END;
- Text = POINTER TO IOstream;
- numbuf = ARRAY[0..255] OF CHAR;
- VAR ibuf, obuf: IOstream;
- head: Text;
- result: StreamResult;
- PROCEDURE Reset(VAR InputText: Text; Filename: ARRAY OF CHAR);
- BEGIN
- doclose(InputText);
- getstruct(InputText);
- WITH InputText^ DO
- OpenStream(stream, Filename, text, reading, result);
- IF result # succeeded THEN
- Message("could not open input file");
- HALT;
- END;
- type := Preading;
- done := FALSE;
- eof := FALSE;
- END;
- END Reset;
- PROCEDURE Rewrite(VAR OutputText: Text; Filename: ARRAY OF CHAR);
- BEGIN
- doclose(OutputText);
- getstruct(OutputText);
- WITH OutputText^ DO
- OpenStream(stream, Filename, text, writing, result);
- IF result # succeeded THEN
- Message("could not open output file");
- HALT;
- END;
- type := Pwriting;
- END;
- END Rewrite;
- PROCEDURE CloseOutput();
- VAR p: Text;
- BEGIN
- p := head;
- WHILE p # NIL DO
- doclose(p);
- p := p^.next;
- END;
- END CloseOutput;
- PROCEDURE doclose(Xtext: Text);
- BEGIN
- IF Xtext # Notext THEN
- WITH Xtext^ DO
- IF type # free THEN
- CloseStream(stream, result);
- type := free;
- END;
- END;
- END;
- END doclose;
- PROCEDURE getstruct(VAR Xtext: Text);
- BEGIN
- Xtext := head;
- WHILE (Xtext # NIL) AND (Xtext^.type # free) DO
- Xtext := Xtext^.next;
- END;
- IF Xtext = NIL THEN
- Allocate(Xtext,SIZE(IOstream));
- Xtext^.next := head;
- head := Xtext;
- END;
- END getstruct;
- PROCEDURE Error(tp: btype);
- BEGIN
- IF tp = Preading THEN
- Message("input text expected");
- ELSE
- Message("output text expected");
- END;
- HALT;
- END Error;
- PROCEDURE ReadChar(InputText: Text; VAR ch : CHAR);
- BEGIN
- ch := NextChar(InputText);
- IF InputText^.eof THEN
- Message("unexpected EOF");
- HALT;
- END;
- InputText^.done := FALSE;
- END ReadChar;
- PROCEDURE NextChar(InputText: Text): CHAR;
- BEGIN
- WITH InputText^ DO
- IF type # Preading THEN Error(Preading); END;
- IF NOT done THEN
- IF EndOfStream(stream, result) THEN
- eof := TRUE;
- ch := 0C;
- ELSE
- Read(stream, ch, result);
- done := TRUE;
- END;
- END;
- RETURN ch;
- END;
- END NextChar;
- PROCEDURE Get(InputText: Text);
- VAR dummy: CHAR;
- BEGIN
- ReadChar(InputText, dummy);
- END Get;
- 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 WriteChar(OutputText: Text; char: CHAR);
- BEGIN
- WITH OutputText^ DO
- IF type # Pwriting THEN Error(Pwriting); END;
- Write(stream, char, result);
- 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
- 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
- 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
- Message("cardinal too large");
- HALT;
- ELSE
- card := 10*card + chvalue;
- Get(InputText);
- ch := NextChar(InputText);
- END;
- END;
- ELSE
- Message("cardinal expected");
- HALT;
- END;
- END ReadCardinal;
- PROCEDURE ReadReal(InputText: Text; VAR real: REAL);
- VAR x1: LONGREAL;
- BEGIN
- ReadLongReal(InputText, x1);
- real := x1
- END ReadReal;
- PROCEDURE ReadLongReal(InputText: Text; VAR real: LONGREAL);
- 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;
- StringToLongReal(buf, real, ok);
- END;
- IF NOT ok THEN
- Message("Illegal real");
- HALT;
- END;
- END ReadLongReal;
- PROCEDURE WriteCardinal(OutputText: Text; card: CARDINAL; width: CARDINAL);
- VAR
- buf : numbuf;
- BEGIN
- ConvertCardinal(card, 1, buf);
- WriteString(OutputText, buf, width);
- END WriteCardinal;
- PROCEDURE WriteInteger(OutputText: Text; int: INTEGER; width: CARDINAL);
- VAR
- buf : numbuf;
- BEGIN
- 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);
- BEGIN
- WriteLongReal(OutputText, LONG(real), width, nfrac)
- END WriteReal;
- PROCEDURE WriteLongReal(OutputText: Text; real: LONGREAL; width, nfrac: CARDINAL);
- VAR
- buf: numbuf;
- ok: BOOLEAN;
- digits: INTEGER;
- BEGIN
- IF width > SIZE(buf) THEN
- width := SIZE(buf);
- END;
- IF nfrac > 0 THEN
- LongRealToString(real, width, nfrac, buf, ok);
- ELSE
- IF width < 9 THEN width := 9; END;
- IF real < 0.0D THEN
- digits := 7 - INTEGER(width);
- ELSE
- digits := 6 - INTEGER(width);
- END;
- LongRealToString(real, width, digits, buf, ok);
- END;
- WriteString(OutputText, buf, 0);
- END WriteLongReal;
- 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
- stream := InputStream;
- eof := FALSE;
- type := Preading;
- done := FALSE;
- END;
- WITH obuf DO
- stream := OutputStream;
- eof := FALSE;
- type := Pwriting;
- END;
- Notext := NIL;
- Input := ADR(ibuf);
- Output := ADR(obuf);
- Input^.next := Output;
- Output^.next := NIL;
- head := Input;
- END PascalIO.
|