d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

new version using the Streams module

Browse source
This commit is contained in:
ceriel 1988-02-19 13:05:03 +00:00
parent 17921c4b5a
commit 96fc577b15
2 changed files with 74 additions and 125 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
lang/m2/libm2/PascalIO.def
View file

@ -1,8 +1,14 @@
DEFINITION MODULE PascalIO; DEFINITION MODULE PascalIO;
(* This module provides for I/O that is essentially equivalent to the I/O (*
Module: Pascal-like Input/Output
Author: Ceriel J.H. Jacobs
Version: $Header$
This module provides for I/O that is essentially equivalent to the I/O
provided by Pascal with "text", or "file of char". provided by Pascal with "text", or "file of char".
However, the user must call a cleanup routine at the end of his program Output buffers are automaically flushed at program termination.
for the output buffers to be flushed. The CloseOutput routine is just there for compatibility with earlier
versions of this module.
*) *)
CONST Eos = 0C; (* End of string character *) CONST Eos = 0C; (* End of string character *)

187
lang/m2/libm2/PascalIO.mod
View file

@ -1,186 +1,150 @@
(*$R-*) (*$R-*)
IMPLEMENTATION MODULE PascalIO; IMPLEMENTATION MODULE PascalIO;
(*
Module: Pascal-like Input/Output
Author: Ceriel J.H. Jacobs
Version: $Header$
*)
IMPORT Unix;
IMPORT Conversions; IMPORT Conversions;
IMPORT Traps; IMPORT Traps;
IMPORT RealConversions; IMPORT RealConversions;
FROM TTY IMPORT isatty; FROM Streams IMPORT Stream, StreamKind, StreamMode, StreamResult,
InputStream, OutputStream, OpenStream, CloseStream,
EndOfStream, Read, Write, SetStreamBuffering,
StreamBuffering;
FROM Storage IMPORT ALLOCATE; FROM Storage IMPORT ALLOCATE;
FROM SYSTEM IMPORT ADR; FROM SYSTEM IMPORT ADR;
TYPE charset = SET OF CHAR; TYPE charset = SET OF CHAR;
btype = (reading, writing, free); btype = (reading, writing, free);
CONST BUFSIZ = 1024; (* Tunable *) CONST spaces = charset{11C, 12C, 13C, 14C, 15C, ' '};
spaces = charset{11C, 12C, 13C, 14C, 15C, ' '};
TYPE IOBuf = RECORD TYPE IOstream = RECORD
type: btype; type: btype;
eof: BOOLEAN; done, eof : BOOLEAN;
ch: CHAR;
next: Text; next: Text;
fildes: INTEGER; stream: Stream;
cnt: INTEGER;
maxcnt: INTEGER;
bufferedcount: INTEGER;
buf: ARRAY [1..BUFSIZ] OF CHAR;
END; END;
Text = POINTER TO IOBuf; Text = POINTER TO IOstream;
numbuf = ARRAY[0..255] OF CHAR; numbuf = ARRAY[0..255] OF CHAR;
VAR ibuf, obuf: IOBuf; VAR ibuf, obuf: IOstream;
head: Text; head: Text;
result: StreamResult;
PROCEDURE Reset(VAR InputText: Text; Filename: ARRAY OF CHAR); PROCEDURE Reset(VAR InputText: Text; Filename: ARRAY OF CHAR);
VAR i: CARDINAL;
BEGIN BEGIN
doclose(InputText); doclose(InputText);
getstruct(InputText); getstruct(InputText);
WITH InputText^ DO WITH InputText^ DO
eof := FALSE; OpenStream(stream, Filename, text, reading, result);
FOR i := 0 TO HIGH(Filename) DO IF result # succeeded THEN
buf[i+1] := Filename[i];
END;
buf[HIGH(Filename)+2] := 0C;
fildes := Unix.open(ADR(buf), 0);
IF fildes < 0 THEN
Traps.Message("could not open input file"); Traps.Message("could not open input file");
HALT; HALT;
END; END;
type := reading; type := reading;
cnt := 1; done := FALSE;
maxcnt := 0; eof := FALSE;
bufferedcount := BUFSIZ;
END; END;
END Reset; END Reset;
PROCEDURE Rewrite(VAR OutputText: Text; Filename: ARRAY OF CHAR); PROCEDURE Rewrite(VAR OutputText: Text; Filename: ARRAY OF CHAR);
VAR i: CARDINAL;
BEGIN BEGIN
doclose(OutputText); doclose(OutputText);
getstruct(OutputText); getstruct(OutputText);
WITH OutputText^ DO WITH OutputText^ DO
eof := FALSE; OpenStream(stream, Filename, text, writing, result);
FOR i := 0 TO HIGH(Filename) DO IF result # succeeded THEN
buf[i+1] := Filename[i];
END;
buf[HIGH(Filename)+2] := 0C;
fildes := Unix.creat(ADR(buf), 666B);
IF fildes < 0 THEN
Traps.Message("could not open output file"); Traps.Message("could not open output file");
HALT; HALT;
END; END;
type := writing; type := writing;
cnt := 0;
maxcnt := 0;
bufferedcount := BUFSIZ;
END; END;
END Rewrite; END Rewrite;
PROCEDURE CloseOutput(); PROCEDURE CloseOutput();
VAR text: Text; VAR p: Text;
BEGIN BEGIN
text := head; p := head;
WHILE text # NIL DO WHILE p # NIL DO
doclose(text); doclose(p);
text := text^.next; p := p^.next;
END; END;
END CloseOutput; END CloseOutput;
PROCEDURE doclose(text: Text); PROCEDURE doclose(Xtext: Text);
VAR dummy: INTEGER;
BEGIN BEGIN
IF text # Notext THEN IF Xtext # Notext THEN
WITH text^ DO WITH Xtext^ DO
IF type = writing THEN
Flush(text);
END;
IF type # free THEN IF type # free THEN
CloseStream(stream, result);
type := free; type := free;
dummy := Unix.close(fildes);
END; END;
END; END;
END; END;
END doclose; END doclose;
PROCEDURE getstruct(VAR text: Text); PROCEDURE getstruct(VAR Xtext: Text);
BEGIN BEGIN
text := head; Xtext := head;
WHILE (text # NIL) AND (text^.type # free) DO WHILE (Xtext # NIL) AND (Xtext^.type # free) DO
text := text^.next; Xtext := Xtext^.next;
END; END;
IF text = NIL THEN IF Xtext = NIL THEN
ALLOCATE(text,SIZE(IOBuf)); ALLOCATE(Xtext,SIZE(IOstream));
text^.next := head; Xtext^.next := head;
head := text; head := Xtext;
END; END;
END getstruct; END getstruct;
PROCEDURE chk(text: Text; tp: btype); PROCEDURE Error(tp: btype);
BEGIN BEGIN
IF text^.type # tp THEN IF tp = reading THEN
IF tp = reading THEN Traps.Message("input text expected");
Traps.Message("input text expected"); ELSE
ELSE Traps.Message("output text expected");
Traps.Message("output text expected");
END;
HALT;
END; END;
END chk; HALT;
END Error;
PROCEDURE ReadChar(InputText: Text; VAR ch : CHAR); PROCEDURE ReadChar(InputText: Text; VAR ch : CHAR);
BEGIN BEGIN
ch := NextChar(InputText); ch := NextChar(InputText);
Get(InputText); InputText^.done := FALSE;
END ReadChar; END ReadChar;
PROCEDURE NextChar(InputText: Text): CHAR; PROCEDURE NextChar(InputText: Text): CHAR;
VAR c: CHAR;
BEGIN BEGIN
chk(InputText, reading);
WITH InputText^ DO WITH InputText^ DO
IF cnt <= maxcnt THEN IF type # reading THEN Error(reading); END;
c := buf[cnt]; IF NOT done THEN
ELSE Get(InputText);
c := FillBuf(InputText);
END; END;
RETURN ch;
END; END;
RETURN c;
END NextChar; END NextChar;
PROCEDURE Get(InputText: Text); PROCEDURE Get(InputText: Text);
VAR dummy: CHAR;
BEGIN BEGIN
chk(InputText, reading);
WITH InputText^ DO WITH InputText^ DO
IF type # reading THEN Error(reading); END;
IF eof THEN IF eof THEN
Traps.Message("unexpected EOF"); Traps.Message("unexpected EOF");
HALT; HALT;
END; END;
IF cnt > maxcnt THEN IF EndOfStream(stream, result) THEN
dummy := FillBuf(InputText); eof := TRUE;
ch := 0C;
ELSE
Read(stream, ch, result);
END; END;
INC(cnt); done := TRUE;
END; END;
END Get; 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; PROCEDURE Eoln(InputText: Text): BOOLEAN;
BEGIN BEGIN
RETURN NextChar(InputText) = 12C; RETURN NextChar(InputText) = 12C;
@ -199,24 +163,11 @@ IMPLEMENTATION MODULE PascalIO;
UNTIL ch = 12C; UNTIL ch = 12C;
END ReadLn; END ReadLn;
PROCEDURE Flush(ob: Text); PROCEDURE WriteChar(OutputText: Text; char: CHAR);
VAR dummy: INTEGER;
BEGIN 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 WITH OutputText^ DO
INC(cnt); IF type # writing THEN Error(writing); END;
buf[cnt] := ch; Write(stream, char, result);
IF cnt >= bufferedcount THEN
Flush(OutputText);
END;
END; END;
END WriteChar; END WriteChar;
@ -451,23 +402,15 @@ IMPLEMENTATION MODULE PascalIO;
BEGIN (* PascalIO initialization *) BEGIN (* PascalIO initialization *)
WITH ibuf DO WITH ibuf DO
stream := InputStream;
eof := FALSE; eof := FALSE;
type := reading; type := reading;
fildes := 0; done := FALSE;
bufferedcount := BUFSIZ;
maxcnt := 0;
cnt := 1;
END; END;
WITH obuf DO WITH obuf DO
stream := OutputStream;
eof := FALSE; eof := FALSE;
type := writing; type := writing;
fildes := 1;
IF isatty(1) THEN
bufferedcount := 1;
ELSE
bufferedcount := BUFSIZ;
END;
cnt := 0;
END; END;
Notext := NIL; Notext := NIL;
Input := ADR(ibuf); Input := ADR(ibuf);