ack/lang/m2/libm2/Streams.mod

410 lines
8.5 KiB
Modula-2
Raw Normal View History

1988-01-29 11:35:45 +00:00
(*$R-*)
IMPLEMENTATION MODULE Streams;
FROM SYSTEM IMPORT BYTE, ADR;
IMPORT Unix, TTY, Storage, Epilogue;
CONST BUFSIZ = 1024; (* tunable *)
TYPE IOB = RECORD
kind: StreamKind;
mode: StreamMode;
eof: BOOLEAN;
buffering: StreamBuffering;
next : Stream;
fildes: INTEGER;
cnt, maxcnt: INTEGER;
bufferedcnt: INTEGER;
buf: ARRAY[1..BUFSIZ] OF BYTE;
END;
Stream = POINTER TO IOB;
VAR
ibuf, obuf, ebuf: IOB;
head: Stream;
PROCEDURE getstruct(VAR stream: Stream);
BEGIN
stream := head;
WHILE (stream # NIL) AND (stream^.kind # none) DO
stream := stream^.next;
END;
IF stream = NIL THEN
IF NOT Storage.Available(SIZE(IOB)) THEN
RETURN;
END;
Storage.ALLOCATE(stream,SIZE(IOB));
stream^.next := head;
head := stream;
END;
END getstruct;
PROCEDURE freestruct(stream: Stream);
BEGIN
stream^.kind := none;
END freestruct;
PROCEDURE OpenStream(VAR stream: Stream;
filename: ARRAY OF CHAR;
kind: StreamKind;
mode: StreamMode;
VAR result: StreamResult);
VAR fd: INTEGER;
i: CARDINAL;
BEGIN
IF kind = none THEN
result := illegaloperation;
RETURN;
END;
getstruct(stream);
IF stream = NIL THEN
result := nomemory;
RETURN;
END;
WITH stream^ DO
FOR i := 0 TO HIGH(filename) DO
buf[i+1] := BYTE(filename[i]);
END;
buf[HIGH(filename)+2] := BYTE(0C);
END;
IF (mode = reading) THEN
fd := Unix.open(ADR(stream^.buf), 0);
ELSE
fd := -1;
IF (mode = appending) THEN
fd := Unix.open(ADR(stream^.buf), 1);
IF fd >= 0 THEN
IF (Unix.lseek(fd, 0D , 2) < 0D) THEN ; END;
END;
END;
IF fd < 0 THEN
fd := Unix.creat(ADR(stream^.buf), 666B);
END;
END;
IF fd < 0 THEN
result := openfailed;
freestruct(stream);
stream := NIL;
RETURN;
END;
result := succeeded;
stream^.fildes := fd;
stream^.kind := kind;
stream^.mode := mode;
stream^.buffering := blockbuffered;
stream^.bufferedcnt := BUFSIZ;
stream^.maxcnt := 0;
stream^.eof := FALSE;
IF mode = reading THEN
stream^.cnt := 1;
ELSE
stream^.cnt := 0;
END;
END OpenStream;
PROCEDURE SetStreamBuffering( stream: Stream;
b: StreamBuffering;
VAR result: StreamResult);
BEGIN
result := succeeded;
IF (stream = NIL) OR (stream^.kind = none) THEN
result := nostream;
RETURN;
END;
IF (stream^.mode = reading) OR
((b = linebuffered) AND (stream^.kind = binary)) THEN
result := illegaloperation;
RETURN;
END;
FlushStream(stream, result);
IF b = unbuffered THEN
stream^.bufferedcnt := 1;
END;
stream^.buffering := b;
END SetStreamBuffering;
PROCEDURE FlushStream(stream: Stream; VAR result: StreamResult);
BEGIN
result := succeeded;
IF (stream = NIL) OR (stream^.kind = none) THEN
result := nostream;
RETURN;
END;
WITH stream^ DO
IF mode = reading THEN
result := illegaloperation;
RETURN;
END;
IF (cnt > 0) AND (Unix.write(fildes, ADR(buf), cnt) < 0) THEN
;
END;
cnt := 0;
END;
END FlushStream;
PROCEDURE CloseStream(VAR stream: Stream; VAR result: StreamResult);
BEGIN
IF (stream # NIL) AND (stream^.kind # none) THEN
result := succeeded;
IF stream^.mode # reading THEN
FlushStream(stream, result);
END;
IF Unix.close(stream^.fildes) < 0 THEN ; END;
freestruct(stream);
ELSE
result := nostream;
END;
stream := NIL;
END CloseStream;
PROCEDURE EndOfStream(stream: Stream; VAR result: StreamResult): BOOLEAN;
BEGIN
result := succeeded;
IF (stream = NIL) OR (stream^.kind = none) THEN
result := nostream;
RETURN FALSE;
END;
IF stream^.mode # reading THEN
result := illegaloperation;
RETURN FALSE;
END;
IF stream^.eof THEN RETURN TRUE; END;
RETURN (CHAR(NextByte(stream)) = 0C) AND stream^.eof;
END EndOfStream;
PROCEDURE FlushLineBuffers();
VAR s: Stream;
result: StreamResult;
BEGIN
s := head;
WHILE s # NIL DO
IF (s^.kind # none) AND (s^.buffering = linebuffered) THEN
FlushStream(s, result);
END;
s := s^.next;
END;
END FlushLineBuffers;
PROCEDURE NextByte(stream: Stream): BYTE;
VAR c: BYTE;
BEGIN
WITH stream^ DO
IF cnt <= maxcnt THEN
c := buf[cnt];
ELSE
IF eof THEN RETURN BYTE(0C); END;
IF stream = InputStream THEN
FlushLineBuffers();
END;
maxcnt := Unix.read(fildes, ADR(buf), bufferedcnt);
cnt := 1;
IF maxcnt <= 0 THEN
eof := TRUE;
c := BYTE(0C);
ELSE
c := buf[1];
END;
END;
END;
RETURN c;
END NextByte;
PROCEDURE Read(stream: Stream; VAR ch: CHAR; VAR result: StreamResult);
VAR EoF: BOOLEAN;
BEGIN
ch := 0C;
EoF := EndOfStream(stream, result);
IF result # succeeded THEN RETURN; END;
IF EoF THEN
result := endoffile;
RETURN;
END;
WITH stream^ DO
ch := CHAR(buf[cnt]);
INC(cnt);
END;
END Read;
PROCEDURE ReadByte(stream: Stream; VAR byte: BYTE; VAR result: StreamResult);
VAR EoF: BOOLEAN;
BEGIN
byte := BYTE(0C);
EoF := EndOfStream(stream, result);
IF result # succeeded THEN RETURN; END;
IF EoF THEN
result := endoffile;
RETURN;
END;
WITH stream^ DO
byte := buf[cnt];
INC(cnt);
END;
END ReadByte;
PROCEDURE ReadBytes(stream: Stream;
VAR bytes: ARRAY OF BYTE;
VAR result: StreamResult);
VAR i: CARDINAL;
BEGIN
FOR i := 0 TO HIGH(bytes) DO
ReadByte(stream, bytes[i], result);
END;
END ReadBytes;
PROCEDURE Write(stream: Stream; ch: CHAR; VAR result: StreamResult);
BEGIN
IF (stream = NIL) OR (stream^.kind = none) THEN
result := nostream;
RETURN;
END;
IF (stream^.kind # text) OR (stream^.mode = reading) THEN
result := illegaloperation;
RETURN;
END;
WITH stream^ DO
INC(cnt);
buf[cnt] := BYTE(ch);
IF (cnt >= bufferedcnt) OR
((ch = 12C) AND (buffering = linebuffered))
THEN
FlushStream(stream, result);
END;
END;
END Write;
PROCEDURE WriteByte(stream: Stream; byte: BYTE; VAR result: StreamResult);
BEGIN
IF (stream = NIL) OR (stream^.kind = none) THEN
result := nostream;
RETURN;
END;
IF (stream^.kind # binary) OR (stream^.mode = reading) THEN
result := illegaloperation;
RETURN;
END;
WITH stream^ DO
INC(cnt);
buf[cnt] := byte;
IF cnt >= bufferedcnt THEN
FlushStream(stream, result);
END;
END;
END WriteByte;
PROCEDURE WriteBytes(stream: Stream; VAR bytes: ARRAY OF BYTE; VAR result: StreamResult);
VAR i: CARDINAL;
BEGIN
FOR i := 0 TO HIGH(bytes) DO
WriteByte(stream, bytes[i], result);
END;
END WriteBytes;
PROCEDURE EndIt;
VAR h, h1 : Stream;
result: StreamResult;
BEGIN
h := head;
WHILE h # NIL DO
h1 := h;
CloseStream(h1, result);
h := h^.next;
END;
END EndIt;
PROCEDURE GetPosition(s: Stream; VAR position: LONGINT;
VAR result: StreamResult);
BEGIN
IF (s = NIL) OR (s^.kind = none) THEN
result := illegaloperation;
RETURN;
END;
IF (s^.mode # reading) THEN FlushStream(s, result); END;
position := Unix.lseek(s^.fildes, 0D, 1);
IF position < 0D THEN
result := illegaloperation;
RETURN;
END;
IF s^.mode = reading THEN
position := position + LONG(s^.maxcnt - s^.cnt + 1);
END;
END GetPosition;
PROCEDURE SetPosition(s: Stream; position: LONGINT; VAR result: StreamResult);
VAR currpos: LONGINT;
BEGIN
currpos := 0D;
IF (s = NIL) OR (s^.kind = none) THEN
result := illegaloperation;
RETURN;
END;
IF (s^.mode # reading) THEN
FlushStream(s, result);
ELSE
s^.maxcnt := 0;
s^.eof := FALSE;
END;
IF s^.mode = appending THEN
currpos := Unix.lseek(s^.fildes, 0D, 1);
IF currpos < 0D THEN
result := illegaloperation;
RETURN;
END;
END;
IF position < currpos THEN
result := illegaloperation;
RETURN;
END;
currpos := Unix.lseek(s^.fildes, position, 0);
IF currpos < 0D THEN
result := illegaloperation;
RETURN;
END;
result := succeeded;
END SetPosition;
BEGIN
InputStream := ADR(ibuf);
OutputStream := ADR(obuf);
ErrorStream := ADR(ebuf);
WITH ibuf DO
kind := text;
mode := reading;
eof := FALSE;
next := ADR(obuf);
fildes := 0;
maxcnt := 0;
cnt := 1;
bufferedcnt := BUFSIZ;
END;
WITH obuf DO
kind := text;
mode := writing;
eof := TRUE;
next := ADR(ebuf);
fildes := 1;
maxcnt := 0;
cnt := 0;
bufferedcnt := BUFSIZ;
IF TTY.isatty(1) THEN
buffering := linebuffered;
ELSE
buffering := blockbuffered;
END;
END;
WITH ebuf DO
kind := text;
mode := writing;
eof := TRUE;
next := NIL;
fildes := 2;
maxcnt := 0;
cnt := 0;
bufferedcnt := BUFSIZ;
IF TTY.isatty(2) THEN
buffering := linebuffered;
ELSE
buffering := blockbuffered;
END;
END;
head := InputStream;
IF Epilogue.CallAtEnd(EndIt) THEN ; END;
END Streams.