(*  (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:	$Header: /cvsup/minix/src/lib/ack/libm2/PascalIO.mod,v 1.1 2005/10/10 15:27:46 beng Exp $*)  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.