minix/lib/libm2/PascalIO.mod
2005-04-21 14:53:53 +00:00

437 lines
9 KiB
Modula-2
Executable file

(*
(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$
*)
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.