MODULE IOExtra EXPORTS IO; (***************************************************************************) (* Copyright (C) Olivetti 1989 *) (* All Rights reserved *) (* *) (* Use and copy of this software and preparation of derivative works based *) (* upon this software are permitted to any person, provided this same *) (* copyright notice and the following Olivetti warranty disclaimer are *) (* included in any copy of the software or any modification thereof or *) (* derivative work therefrom made by any person. *) (* *) (* This software is made available AS IS and Olivetti disclaims all *) (* warranties with respect to this software, whether expressed or implied *) (* under any law, including all implied warranties of merchantibility and *) (* fitness for any purpose. In no event shall Olivetti be liable for any *) (* damages whatsoever resulting from loss of use, data or profits or *) (* otherwise arising out of or in connection with the use or performance *) (* of this software. *) (***************************************************************************) (* 'IOExtra' contains put and get routines which are built on top of the basic 'Put', 'PutN', 'Get', 'GetUntil' and 'Skip' routines *) IMPORT Text, TextF, Fmt; IMPORT CharType, CharsTo; PROCEDURE PutText(s: Stream; t: Text.T) RAISES {Error} = (* Knows about the representation of texts so it is just a veneer on 'PutN' *) BEGIN PutN(s, SUBARRAY(t^, 0, NUMBER(t^) - 1)); END PutText; PROCEDURE PutF( s: Stream; fmt: Text.T; t1, t2, t3, t4, t5: Text.T := NIL) RAISES {Error}= BEGIN PutText(s, Fmt.F(fmt, t1, t2, t3, t4, t5)); END PutF; PROCEDURE PutFN( s: Stream; fmt: Text.T; READONLY texts: (*Text.Array*)ARRAY OF TEXT) RAISES {Error}= BEGIN PutText(s, Fmt.FN(fmt, texts)); END PutFN; <*INLINE*> PROCEDURE SkipUntil( s: Stream; READONLY terminate := CharType.EndOfLine; unget := FALSE) : CHAR RAISES {Error, EndOfStream} = BEGIN RETURN Skip(s, CharType.All - terminate, unget); END SkipUntil; PROCEDURE GetChars( s: Stream; VAR chars: ARRAY OF CHAR; READONLY skip := CharType.None; READONLY terminate := CharType.WhiteSpace; unget := TRUE) : CARDINAL RAISES {Error, EndOfStream}= BEGIN EVAL Skip(s, skip); RETURN GetUntil(s, chars, terminate, unget); END GetChars; CONST BufferSize = 256; TYPE Buffer = ARRAY [0..BufferSize-1] OF CHAR; RefBuffer = REF RECORD buffer: Buffer; next: RefBuffer; END; Buffers = RECORD first: Buffer; rest: RefBuffer; pos: CARDINAL; END; PROCEDURE GetBuffers( s: Stream; READONLY skip, terminate: SET OF CHAR; unget: BOOLEAN; VAR buffers: Buffers) RAISES {Error, EndOfStream}= BEGIN EVAL Skip(s, skip); buffers.rest := NIL; buffers.pos := GetUntil(s, buffers.first, terminate, unget); IF buffers.pos <= BufferSize THEN RETURN; ELSE VAR new := NEW(RefBuffer); last: RefBuffer := NIL; BEGIN LOOP new.next := NIL; IF buffers.rest = NIL THEN buffers.rest := new; ELSE last.next := new; END; last := new; WITH got = GetUntil(s, last.buffer, terminate, unget) DO INC(buffers.pos, got - 1); IF got <= BufferSize THEN RETURN END; END; END; END; END; END GetBuffers; PROCEDURE BuffersToText(buffers: Buffers): Text.T RAISES {}= BEGIN IF buffers.pos = 0 THEN RETURN ""; ELSIF buffers.pos <= BufferSize THEN RETURN Text.FromChars(SUBARRAY(buffers.first, 0, buffers.pos)); ELSE VAR result := NEW(Text.T, buffers.pos + 1); b := buffers.rest; offset := BufferSize; remainder := buffers.pos - offset; BEGIN result^[buffers.pos] := '\000'; SUBARRAY(result^, 0, BufferSize) := buffers.first; WHILE remainder > BufferSize DO SUBARRAY(result^, offset, BufferSize) := b.buffer; b := b.next; INC(offset, BufferSize); DEC(remainder, BufferSize); END; SUBARRAY(result^, offset, remainder) := SUBARRAY(b.buffer, 0, remainder); RETURN result; END; END; END BuffersToText; PROCEDURE GetText( s: Stream; READONLY skip := CharType.None; READONLY terminate := CharType.WhiteSpace; unget := TRUE) : Text.T RAISES {Error, EndOfStream}= VAR buffers: Buffers; BEGIN GetBuffers(s, skip, terminate, unget, buffers); RETURN BuffersToText(buffers); END GetText; <*INLINE*> PROCEDURE CheckedGetBuffers( s: Stream; READONLY skip, terminate: SET OF CHAR; unget: BOOLEAN; VAR buffers: Buffers) RAISES {Error, EndOfStream, Invalid}= BEGIN GetBuffers(s, skip, terminate, unget, buffers); IF buffers.pos = 0 OR buffers.pos > BufferSize THEN RAISE Invalid(BuffersToText(buffers)); END; END CheckedGetBuffers; PROCEDURE GetCard( s: Stream; base: Fmt.Base := (*Fmt.*)Decimal; READONLY skip, terminate := CharType.WhiteSpace; unget := TRUE) : CARDINAL RAISES {Error, EndOfStream, Invalid}= VAR buffers: Buffers; card: CARDINAL; BEGIN CheckedGetBuffers(s, skip, terminate, unget, buffers); IF CharsTo.Card(SUBARRAY(buffers.first, 0, buffers.pos), card, base) THEN RETURN card; ELSE RAISE Invalid(BuffersToText(buffers)); END; END GetCard; PROCEDURE GetBasedCard( s: Stream; READONLY skip, terminate := CharType.WhiteSpace; unget := TRUE) : CARDINAL RAISES {Error, EndOfStream, Invalid}= VAR buffers: Buffers; card: CARDINAL; BEGIN CheckedGetBuffers(s, skip, terminate, unget, buffers); IF CharsTo.BasedCard(SUBARRAY(buffers.first, 0, buffers.pos), card) THEN RETURN card; ELSE RAISE Invalid(BuffersToText(buffers)); END; END GetBasedCard; PROCEDURE GetInt( s: Stream; base: Fmt.Base := (*Fmt.*)Decimal; READONLY skip, terminate := CharType.WhiteSpace; unget := TRUE) : INTEGER RAISES {Error, EndOfStream, Invalid}= VAR buffers: Buffers; int: INTEGER; BEGIN CheckedGetBuffers(s, skip, terminate, unget, buffers); IF CharsTo.Int(SUBARRAY(buffers.first, 0, buffers.pos), int, base) THEN RETURN int; ELSE RAISE Invalid(BuffersToText(buffers)); END; END GetInt; PROCEDURE GetBasedInt( s: Stream; READONLY skip, terminate := CharType.WhiteSpace; unget := TRUE) : INTEGER RAISES {Error, EndOfStream, Invalid}= VAR buffers: Buffers; int: INTEGER; BEGIN CheckedGetBuffers(s, skip, terminate, unget, buffers); IF CharsTo.BasedInt(SUBARRAY(buffers.first, 0, buffers.pos), int) THEN RETURN int; ELSE RAISE Invalid(BuffersToText(buffers)); END; END GetBasedInt; PROCEDURE GetBool( s: Stream; READONLY skip, terminate := CharType.WhiteSpace; unget := TRUE) : BOOLEAN RAISES {Error, EndOfStream, Invalid}= VAR buffers: Buffers; bool: BOOLEAN; BEGIN CheckedGetBuffers(s, skip, terminate, unget, buffers); IF CharsTo.Bool(SUBARRAY(buffers.first, 0, buffers.pos), bool) THEN RETURN bool; ELSE RAISE Invalid(BuffersToText(buffers)); END; END GetBool; PROCEDURE GetReal( s: Stream; READONLY skip, terminate := CharType.WhiteSpace; unget := TRUE) : REAL RAISES {Error, EndOfStream, Invalid}= VAR buffers: Buffers; real: REAL; BEGIN CheckedGetBuffers(s, skip, terminate, unget, buffers); IF CharsTo.Real(SUBARRAY(buffers.first, 0, buffers.pos), real) THEN RETURN real; ELSE RAISE Invalid(BuffersToText(buffers)); END; END GetReal; PROCEDURE GetLongReal( s: Stream; READONLY skip, terminate := CharType.WhiteSpace; unget := TRUE) : LONGREAL RAISES {Error, EndOfStream, Invalid}= VAR buffers: Buffers; longReal: LONGREAL; BEGIN CheckedGetBuffers(s, skip, terminate, unget, buffers); IF CharsTo.LongReal(SUBARRAY(buffers.first, 0, buffers.pos), longReal) THEN RETURN longReal; ELSE RAISE Invalid(BuffersToText(buffers)); END; END GetLongReal; BEGIN END IOExtra.