|
|
@@ -1,1101 +1,1147 @@
|
|
|
-(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
|
|
|
-
|
|
|
-MODULE Streams64; (** AUTHOR "pjm/be"; PURPOSE "I/O buffering and formatted writing and reading"; *)
|
|
|
-
|
|
|
-IMPORT SYSTEM;
|
|
|
-
|
|
|
-CONST
|
|
|
- Ok* = 0; (** zero result code means no error occurred *)
|
|
|
- EOF* = 4201; (** error returned when Receive reads past end of file or stream *)
|
|
|
-
|
|
|
- EOT* = 1AX; (** EOT character *)
|
|
|
-
|
|
|
- StringFull = 4202;
|
|
|
- FormatError* = 4203; (** error returned when ReadInt fails *)
|
|
|
-
|
|
|
- DefaultWriterSize* = 4096;
|
|
|
- DefaultReaderSize* = 4096;
|
|
|
-
|
|
|
-CONST
|
|
|
- CR = 0DX; LF = 0AX; TAB = 9X; SP = 20X;
|
|
|
-
|
|
|
-VAR
|
|
|
- H, L: INTEGER;
|
|
|
-TYPE
|
|
|
- BESTSIZE* = HUGEINT;
|
|
|
-
|
|
|
- (** Any stream output procedure or method. *)
|
|
|
- Sender* = PROCEDURE {DELEGATE} ( CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT );
|
|
|
-
|
|
|
- (** Any stream input procedure or method. *)
|
|
|
- Receiver* = PROCEDURE {DELEGATE} ( VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT );
|
|
|
-
|
|
|
- Connection* = OBJECT
|
|
|
-
|
|
|
- PROCEDURE Send*( CONST data: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT );
|
|
|
- END Send;
|
|
|
-
|
|
|
- PROCEDURE Receive*( VAR data: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT );
|
|
|
- END Receive;
|
|
|
-
|
|
|
- PROCEDURE Close*;
|
|
|
- END Close;
|
|
|
-
|
|
|
- END Connection;
|
|
|
-
|
|
|
- (** A writer buffers output before it is sent to a Sender. Must not be shared between processes. *)
|
|
|
-TYPE
|
|
|
- Writer* = OBJECT
|
|
|
- VAR
|
|
|
- tail: LONGINT;
|
|
|
- buf: POINTER TO ARRAY OF CHAR;
|
|
|
- res*: LONGINT; (** result of last output operation. *)
|
|
|
- send: Sender;
|
|
|
- sent*: BESTSIZE; (** count of sent bytes *)
|
|
|
- (* buf[0..tail-1] contains data to write. *)
|
|
|
-
|
|
|
- PROCEDURE & InitWriter*( send: Sender; size: LONGINT );
|
|
|
- BEGIN
|
|
|
- ASSERT ( send # NIL );
|
|
|
- NEW( buf, size ); SELF.send := send; Reset
|
|
|
- END InitWriter;
|
|
|
-
|
|
|
- PROCEDURE Reset*;
|
|
|
- BEGIN
|
|
|
- tail := 0; res := Ok; sent := 0
|
|
|
- END Reset;
|
|
|
-
|
|
|
- PROCEDURE CanSetPos*( ): BOOLEAN;
|
|
|
- BEGIN
|
|
|
- RETURN FALSE
|
|
|
- END CanSetPos;
|
|
|
-
|
|
|
- PROCEDURE SetPos*( pos: BESTSIZE );
|
|
|
- BEGIN
|
|
|
- HALT( 1234 )
|
|
|
- END SetPos;
|
|
|
-
|
|
|
- PROCEDURE Update*;
|
|
|
- BEGIN
|
|
|
- IF (res = Ok) THEN
|
|
|
- send( buf^, 0, tail, TRUE , res );
|
|
|
- IF res = Ok THEN INC( sent, tail ); tail := 0 END
|
|
|
- END
|
|
|
- END Update;
|
|
|
-
|
|
|
- (** Current write position. *)
|
|
|
- PROCEDURE Pos*( ): BESTSIZE;
|
|
|
- BEGIN
|
|
|
- RETURN sent + tail;
|
|
|
- END Pos;
|
|
|
-
|
|
|
- (** -- Write raw binary data -- *)
|
|
|
-
|
|
|
- (** Write one byte. *)
|
|
|
- PROCEDURE Char*( x: CHAR );
|
|
|
- BEGIN
|
|
|
- IF (tail = LEN( buf )) & (res = Ok) THEN
|
|
|
- send( buf^, 0, tail, FALSE , res );
|
|
|
- IF res = Ok THEN INC( sent, tail ); tail := 0 END
|
|
|
- END;
|
|
|
- IF res = Ok THEN buf[tail] := x; INC( tail ) END
|
|
|
- END Char;
|
|
|
-
|
|
|
- (** Write len bytes from x, starting at ofs. *)
|
|
|
- PROCEDURE Bytes*(CONST x: ARRAY OF CHAR; ofs, len: LONGINT );
|
|
|
- VAR n: LONGINT;
|
|
|
- BEGIN
|
|
|
- ASSERT ( len >= 0 );
|
|
|
- LOOP
|
|
|
- n := LEN( buf ) - tail; (* space available *)
|
|
|
- IF n = 0 THEN
|
|
|
- IF res = Ok THEN (* send current buffer *)
|
|
|
- send( buf^, 0, tail, FALSE , res );
|
|
|
- IF res = Ok THEN INC( sent, tail ); tail := 0 ELSE EXIT END
|
|
|
- ELSE
|
|
|
- EXIT (* should not be writing on an erroneous rider *)
|
|
|
- END;
|
|
|
- n := LEN( buf )
|
|
|
- END;
|
|
|
- IF n > len THEN n := len END;
|
|
|
- ASSERT ( tail + n <= LEN( buf ) ); (* index check *)
|
|
|
- SYSTEM.MOVE( ADDRESSOF( x[ofs] ), ADDRESSOF( buf[tail] ), n ); INC( tail, n );
|
|
|
- IF len = n THEN EXIT END; (* done *)
|
|
|
- INC( ofs, n ); DEC( len, n )
|
|
|
- END
|
|
|
- END Bytes;
|
|
|
-
|
|
|
- (** Write a SHORTINT. *)
|
|
|
- PROCEDURE RawSInt*( x: SHORTINT );
|
|
|
- BEGIN
|
|
|
- Char( SYSTEM.VAL( CHAR, x ) )
|
|
|
- END RawSInt;
|
|
|
-
|
|
|
- (** Write an INTEGER. *)
|
|
|
- PROCEDURE RawInt*( x: INTEGER );
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes2, x ), 0, 2 )
|
|
|
- END RawInt;
|
|
|
-
|
|
|
- (** Write a LONGINT. *)
|
|
|
- PROCEDURE RawLInt*( x: LONGINT );
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
|
|
|
- END RawLInt;
|
|
|
-
|
|
|
- (** Write a HUGEINT. *)
|
|
|
- PROCEDURE RawHInt*( x: HUGEINT );
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8 )
|
|
|
- END RawHInt;
|
|
|
-
|
|
|
- (** Write a 64 bit value in network byte order (most significant byte first) *)
|
|
|
- PROCEDURE Net64*( x: HUGEINT );
|
|
|
- BEGIN
|
|
|
- Net32(LONGINT( x DIV 100000000H MOD 100000000H ));
|
|
|
- Net32(LONGINT( x MOD 100000000H ));
|
|
|
- END Net64;
|
|
|
-
|
|
|
- (** Write a 32 bit value in network byte order (most significant byte first) *)
|
|
|
- PROCEDURE Net32*( x: LONGINT );
|
|
|
- BEGIN
|
|
|
- Char( CHR( x DIV 1000000H MOD 100H ) ); Char( CHR( x DIV 10000H MOD 100H ) ); Char( CHR( x DIV 100H MOD 100H ) );
|
|
|
- Char( CHR( x MOD 100H ) )
|
|
|
- END Net32;
|
|
|
-
|
|
|
- (** Write a 16 bit value in network byte order (most significant byte first) *)
|
|
|
- PROCEDURE Net16*( x: LONGINT );
|
|
|
- BEGIN
|
|
|
- Char( CHR( x DIV 100H MOD 100H ) ); Char( CHR( x MOD 100H ) )
|
|
|
- END Net16;
|
|
|
-
|
|
|
- (** write unsigned byte *)
|
|
|
- PROCEDURE Net8*( x: LONGINT );
|
|
|
- BEGIN
|
|
|
- Char( CHR( x MOD 100H ) )
|
|
|
- END Net8;
|
|
|
-
|
|
|
- (** Write a SET. *)
|
|
|
- PROCEDURE RawSet*( x: SET );
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
|
|
|
- END RawSet;
|
|
|
-
|
|
|
- (** Write a BOOLEAN. *)
|
|
|
- PROCEDURE RawBool*( x: BOOLEAN );
|
|
|
- BEGIN
|
|
|
- IF x THEN Char( 1X ) ELSE Char( 0X ) END
|
|
|
- END RawBool;
|
|
|
-
|
|
|
- (** Write a REAL. *)
|
|
|
- PROCEDURE RawReal*( x: REAL );
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
|
|
|
- END RawReal;
|
|
|
-
|
|
|
- (** Write a LONGREAL. *)
|
|
|
- PROCEDURE RawLReal*( x: LONGREAL );
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8 )
|
|
|
- END RawLReal;
|
|
|
-
|
|
|
- (** Write a 0X-terminated string, including the 0X terminator. *)
|
|
|
- PROCEDURE RawString*(CONST x: ARRAY OF CHAR );
|
|
|
- VAR i: LONGINT;
|
|
|
- BEGIN
|
|
|
- i := 0;
|
|
|
- WHILE x[i] # 0X DO Char( x[i] ); INC( i ) END;
|
|
|
- Char( 0X )
|
|
|
- END RawString;
|
|
|
-
|
|
|
- (** Write a number in a compressed format. *)
|
|
|
- PROCEDURE RawNum*( x: LONGINT );
|
|
|
- BEGIN
|
|
|
- WHILE (x < -64) OR (x > 63) DO Char( CHR( x MOD 128 + 128 ) ); x := x DIV 128 END;
|
|
|
- Char( CHR( x MOD 128 ) )
|
|
|
- END RawNum;
|
|
|
-
|
|
|
- (** -- Write formatted data -- *)
|
|
|
-
|
|
|
- (** Write an ASCII end-of-line (CR/LF). *)
|
|
|
- PROCEDURE Ln*;
|
|
|
- BEGIN
|
|
|
- Char( CR ); Char( LF )
|
|
|
- END Ln;
|
|
|
-
|
|
|
- (** Write a 0X-terminated string, excluding the 0X terminator. *)
|
|
|
- PROCEDURE String*(CONST x: ARRAY OF CHAR );
|
|
|
- VAR i: LONGINT;
|
|
|
- BEGIN
|
|
|
- i := 0;
|
|
|
- WHILE x[i] # 0X DO Char( x[i] ); INC( i ) END
|
|
|
- END String;
|
|
|
-
|
|
|
- (** Write an integer in decimal right-justified in a field of at least w characters. *)
|
|
|
- PROCEDURE Int*( x: HUGEINT; w: LONGINT );
|
|
|
- VAR i: SIZE; x0: HUGEINT;
|
|
|
- a: ARRAY 21 OF CHAR;
|
|
|
- BEGIN
|
|
|
- IF x < 0 THEN
|
|
|
- IF x = MIN( HUGEINT ) THEN
|
|
|
- DEC( w, 20 );
|
|
|
- WHILE w > 0 DO Char( " " ); DEC( w ) END;
|
|
|
- String( "-9223372036854775808" ); RETURN
|
|
|
- ELSE DEC( w ); x0 := -x
|
|
|
- END
|
|
|
- ELSE x0 := x
|
|
|
- END;
|
|
|
- i := 0;
|
|
|
- REPEAT a[i] := CHR( x0 MOD 10 + 30H ); x0 := x0 DIV 10; INC( i ) UNTIL x0 = 0;
|
|
|
- WHILE w > i DO Char( " " ); DEC( w ) END;
|
|
|
- IF x < 0 THEN Char( "-" ) END;
|
|
|
- REPEAT DEC( i ); Char( a[i] ) UNTIL i = 0
|
|
|
- END Int;
|
|
|
-
|
|
|
- (** Write a SET in Oberon notation. *)
|
|
|
- (* PROCEDURE Set*( s: SET ); (* from P. Saladin *)
|
|
|
- VAR i, last: LONGINT; dots: BOOLEAN;
|
|
|
- BEGIN
|
|
|
- Char( "{" ); last := MIN( LONGINT ); dots := FALSE;
|
|
|
- FOR i := MIN( SET ) TO MAX( SET ) DO
|
|
|
- IF i IN s THEN
|
|
|
- IF last = (i - 1) THEN
|
|
|
- IF dots THEN String( ".." ); dots := FALSE END;
|
|
|
- IF (i = MAX( SET )) OR ~((i + 1) IN s) THEN Int( i, 1 ) END
|
|
|
- ELSE
|
|
|
- IF last >= MIN( SET ) THEN String( ", " ) END;
|
|
|
- Int( i, 1 ); dots := TRUE
|
|
|
- END;
|
|
|
- last := i
|
|
|
- END
|
|
|
- END;
|
|
|
- Char( "}" )
|
|
|
- END Set; *)
|
|
|
-
|
|
|
- PROCEDURE Set*( s: SET ); (* from P. Saladin *)
|
|
|
- VAR i, last: LONGINT; dots: BOOLEAN;
|
|
|
- BEGIN
|
|
|
- Char( "{" ); last := MAX( LONGINT ); dots := FALSE;
|
|
|
- FOR i := MAX( SET ) TO 0 BY -1 DO
|
|
|
- IF i IN s THEN
|
|
|
- IF last = (i + 1) THEN
|
|
|
- IF dots THEN String( ".." ); dots := FALSE END;
|
|
|
- IF (i = 0) OR ~((i - 1) IN s) THEN Int( i, 1 ) END
|
|
|
- ELSE
|
|
|
- IF last <= MAX( SET ) THEN String( ", " ) END;
|
|
|
- Int( i, 1 ); dots := TRUE
|
|
|
- END;
|
|
|
- last := i
|
|
|
- END
|
|
|
- END;
|
|
|
- Char( "}" )
|
|
|
- END Set;
|
|
|
-
|
|
|
- (**
|
|
|
- Write an integer in hexadecimal right-justified in a field of at least ABS(w) characters.
|
|
|
- If w < 0 THEN w least significant hex digits of x are written (potentially including leading zeros)
|
|
|
- *)
|
|
|
- PROCEDURE Hex*(x: HUGEINT; w: LONGINT);
|
|
|
- VAR filler: CHAR; i,maxw: LONGINT; a: ARRAY 20 OF CHAR; y: HUGEINT;
|
|
|
- BEGIN
|
|
|
- IF w < 0 THEN filler := '0'; w := -w; maxw := w ELSE filler := ' '; maxw := 16 END;
|
|
|
- i := 0;
|
|
|
- REPEAT
|
|
|
- y := x MOD 10H;
|
|
|
- IF y < 10 THEN a[i] := CHR(y+ORD('0')) ELSE a[i] := CHR(y-10+ORD('A')) END;
|
|
|
- x := x DIV 10H;
|
|
|
- INC(i);
|
|
|
- UNTIL (x=0) OR (i=maxw);
|
|
|
- WHILE w > i DO Char(filler); DEC( w ) END;
|
|
|
- REPEAT DEC( i ); Char( a[i] ) UNTIL i = 0
|
|
|
- END Hex;
|
|
|
-
|
|
|
- (** Write "x" as a hexadecimal address. Do not use Hex because of arithmetic shift of the sign !*)
|
|
|
- PROCEDURE Address* (x: ADDRESS);
|
|
|
- BEGIN
|
|
|
- Hex(x,-2*SIZEOF(ADDRESS));
|
|
|
- END Address;
|
|
|
-
|
|
|
- PROCEDURE Pair( ch: CHAR; x: LONGINT );
|
|
|
- BEGIN
|
|
|
- IF ch # 0X THEN Char( ch ) END;
|
|
|
- Char( CHR( ORD( "0" ) + x DIV 10 MOD 10 ) ); Char( CHR( ORD( "0" ) + x MOD 10 ) )
|
|
|
- END Pair;
|
|
|
-
|
|
|
- (** Write the date and time in ISO format (yyyy-mm-dd hh:mm:ss). The t and d parameters are in Oberon time and date format.
|
|
|
- If all parameters are within range, the output string is exactly 19 characters wide. The t or d parameter can be -1, in which
|
|
|
- case the time or date respectively are left out. *)
|
|
|
- PROCEDURE Date*( t, d: LONGINT );
|
|
|
- VAR ch: CHAR;
|
|
|
- BEGIN
|
|
|
- IF d # -1 THEN
|
|
|
- Int( 1900 + d DIV 512, 4 ); (* year *)
|
|
|
- Pair( "-", d DIV 32 MOD 16 ); (* month *)
|
|
|
- Pair( "-", d MOD 32 ); (* day *)
|
|
|
- ch := " " (* space between date and time *)
|
|
|
- ELSE
|
|
|
- ch := 0X (* no space before time *)
|
|
|
- END;
|
|
|
- IF t # -1 THEN
|
|
|
- Pair( ch, t DIV 4096 MOD 32 ); (* hour *)
|
|
|
- Pair( ":", t DIV 64 MOD 64 ); (* min *)
|
|
|
- Pair( ":", t MOD 64 ) (* sec *)
|
|
|
- END
|
|
|
- END Date;
|
|
|
-
|
|
|
- (** Write the date and time in RFC 822/1123 format without the optional day of the week (dd mmm yyyy hh:mm:ss SZZZZ) .
|
|
|
- The t and d parameters are in Oberon time and date format. The tz parameter specifies the time zone offset in minutes
|
|
|
- (from -720 to 720 in steps of 30). If all parameters are within range, the output string is exactly 26 characters wide.
|
|
|
- The t, d or tz parameter can be -1, in which case the time, date or timezone respectively are left out. *)
|
|
|
- PROCEDURE Date822*( t, d, tz: LONGINT );
|
|
|
- VAR i, m: LONGINT; ch: CHAR;
|
|
|
- BEGIN
|
|
|
- IF d # -1 THEN
|
|
|
- Int( d MOD 32, 2 ); (* day *)
|
|
|
- m := (d DIV 32 MOD 16 - 1) * 4; (* month *)
|
|
|
- FOR i := m TO m + 3 DO Char( months[i] ) END;
|
|
|
- Int( 1900 + d DIV 512, 5 ); (* year *)
|
|
|
- ch := " " (* space *)
|
|
|
- ELSE
|
|
|
- ch := 0X (* no space *)
|
|
|
- END;
|
|
|
- IF t # -1 THEN
|
|
|
- Pair( ch, t DIV 4096 MOD 32 ); (* hour *)
|
|
|
- Pair( ":", t DIV 64 MOD 64 ); (* min *)
|
|
|
- Pair( ":", t MOD 64 ); (* sec *)
|
|
|
- ch := " " (* space *)
|
|
|
- ELSE
|
|
|
- (* leave ch as before *)
|
|
|
- END;
|
|
|
- IF tz # -1 THEN
|
|
|
- IF ch # 0X THEN Char( ch ) END;
|
|
|
- IF tz >= 0 THEN Pair( "+", tz DIV 60 ) ELSE Pair( "-", (-tz) DIV 60 ) END;
|
|
|
- Pair( 0X, ABS( tz ) MOD 60 )
|
|
|
- END
|
|
|
- END Date822;
|
|
|
-
|
|
|
-
|
|
|
- (** Write LONGREAL x using n character positions. *)
|
|
|
- PROCEDURE Float*( x: LONGREAL; n: LONGINT );
|
|
|
- (* BM 1993.4.22. Do not simplify rounding! *)
|
|
|
- VAR e, h, l, i: LONGINT; z: LONGREAL;
|
|
|
- d: ARRAY 16 OF CHAR;
|
|
|
- BEGIN
|
|
|
- e := ExpoL( x );
|
|
|
- IF e = 2047 THEN
|
|
|
- WHILE n > 5 DO Char( " " ); DEC( n ) END;
|
|
|
- NaNCodeL( x, h, l );
|
|
|
- IF (h # 0) OR (l # 0) THEN String( " NaN" )
|
|
|
- ELSIF x < 0 THEN String( " -INF" )
|
|
|
- ELSE String( " INF" )
|
|
|
- END
|
|
|
- ELSE
|
|
|
- IF n <= 9 THEN n := 1 ELSE DEC( n, 8 ) END;
|
|
|
- REPEAT Char( " " ); DEC( n ) UNTIL n <= 15; (* 0 <= n <= 15 fraction digits *)
|
|
|
- IF (e # 0) & (x < 0) THEN Char( "-" ); x := -x ELSE Char( " " ) END;
|
|
|
- IF e = 0 THEN
|
|
|
- h := 0; l := 0 (* no denormals *)
|
|
|
- ELSE
|
|
|
- e := (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) = 0.301029996 *)
|
|
|
- z := Ten( e + 1 );
|
|
|
- IF x >= z THEN x := x / z; INC( e ) ELSE x := x * Ten( -e ) END;
|
|
|
- IF x >= 10 THEN x := x * Ten( -1 ) + 0.5D0 / Ten( n ); INC( e )
|
|
|
- ELSE
|
|
|
- x := x + 0.5D0 / Ten( n );
|
|
|
- IF x >= 10 THEN x := x * Ten( -1 ); INC( e ) END
|
|
|
- END;
|
|
|
- x := x * Ten( 7 ); h := ENTIER( x ); x := (x - h) * Ten( 8 ); l := ENTIER( x )
|
|
|
- END;
|
|
|
- i := 15;
|
|
|
- WHILE i > 7 DO d[i] := CHR( l MOD 10 + ORD( "0" ) ); l := l DIV 10; DEC( i ) END;
|
|
|
- WHILE i >= 0 DO d[i] := CHR( h MOD 10 + ORD( "0" ) ); h := h DIV 10; DEC( i ) END;
|
|
|
- Char( d[0] ); Char( "." ); i := 1;
|
|
|
- WHILE i <= n DO Char( d[i] ); INC( i ) END;
|
|
|
- IF e < 0 THEN String( "E-" ); e := -e ELSE String( "E+" ) END;
|
|
|
- Char( CHR( e DIV 100 + ORD( "0" ) ) ); e := e MOD 100; Char( CHR( e DIV 10 + ORD( "0" ) ) ); Char( CHR( e MOD 10 + ORD( "0" ) ) )
|
|
|
- END
|
|
|
- END Float;
|
|
|
-
|
|
|
- (** Write LONGREAL x in a fixed point notation. n is the overall minimal length for the output field, f the number of fraction digits following the decimal point, D the fixed exponent (printed only when D # 0). *)
|
|
|
- PROCEDURE FloatFix*( x: LONGREAL; n, f, D: LONGINT );
|
|
|
- (* BM 1993.4.22. Do not simplify rounding! / JG formatting adjusted *)
|
|
|
- VAR e, h, l, i: LONGINT; r, z: LONGREAL;
|
|
|
- d: ARRAY 16 OF CHAR;
|
|
|
- s: CHAR; dot: BOOLEAN;
|
|
|
- BEGIN
|
|
|
- e := ExpoL( x );
|
|
|
- IF (e = 2047) OR (ABS( D ) > 308) THEN
|
|
|
- WHILE n > 5 DO Char( " " ); DEC( n ) END;
|
|
|
- NaNCodeL( x, h, l );
|
|
|
- IF (h # 0) OR (l # 0) THEN String( " NaN" )
|
|
|
- ELSIF x < 0 THEN String( " -INF" )
|
|
|
- ELSE String( " INF" )
|
|
|
- END
|
|
|
- ELSE
|
|
|
- IF D = 0 THEN IF (f=0) THEN dot := FALSE; DEC( n, 1 ) ELSE dot := TRUE; DEC(n,2); END; ELSE dot := TRUE; DEC( n, 7 ) END;
|
|
|
- IF n < 2 THEN n := 2 END;
|
|
|
- IF f < 0 THEN f := 0 END;
|
|
|
- IF n < f + 2 THEN n := f + 2 END;
|
|
|
- DEC( n, f );
|
|
|
- IF (e # 0) & (x < 0) THEN s := "-"; x := -x ELSE s := " " END;
|
|
|
- IF e = 0 THEN
|
|
|
- h := 0; l := 0; DEC( e, D - 1 ) (* no denormals *)
|
|
|
- ELSE
|
|
|
- e := (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) = 0.301029996 *)
|
|
|
- z := Ten( e + 1 );
|
|
|
- IF x >= z THEN x := x / z; INC( e ) ELSE x := x * Ten( -e ) END;
|
|
|
- DEC( e, D - 1 ); i := -(e + f);
|
|
|
- IF i <= 0 THEN r := 5 * Ten( i ) ELSE r := 0 END;
|
|
|
- IF x >= 10 THEN x := x * Ten( -1 ) + r; INC( e )
|
|
|
- ELSE
|
|
|
- x := x + r;
|
|
|
- IF x >= 10 THEN x := x * Ten( -1 ); INC( e ) END
|
|
|
- END;
|
|
|
- x := x * Ten( 7 ); h := ENTIER( x ); x := (x - h) * Ten( 8 ); l := ENTIER( x )
|
|
|
- END;
|
|
|
- i := 15;
|
|
|
- WHILE i > 7 DO d[i] := CHR( l MOD 10 + ORD( "0" ) ); l := l DIV 10; DEC( i ) END;
|
|
|
- WHILE i >= 0 DO d[i] := CHR( h MOD 10 + ORD( "0" ) ); h := h DIV 10; DEC( i ) END;
|
|
|
- IF n <= e THEN n := e + 1 END;
|
|
|
- IF e > 0 THEN
|
|
|
- WHILE n > e DO Char( " " ); DEC( n ) END;
|
|
|
- Char( s ); e := 0;
|
|
|
- WHILE n > 0 DO
|
|
|
- DEC( n );
|
|
|
- IF e < 16 THEN Char( d[e] ); INC( e ) ELSE Char( "0" ) END
|
|
|
- END;
|
|
|
- IF dot THEN
|
|
|
- Char( "." )
|
|
|
- END;
|
|
|
- ELSE
|
|
|
- WHILE n > 1 DO Char( " " ); DEC( n ) END;
|
|
|
- Char( s ); Char( "0" ); IF dot THEN Char( "." ); END;
|
|
|
- WHILE (0 < f) & (e < 0) DO Char( "0" ); DEC( f ); INC( e ) END
|
|
|
- END;
|
|
|
- WHILE f > 0 DO
|
|
|
- DEC( f );
|
|
|
- IF e < 16 THEN Char( d[e] ); INC( e ) ELSE Char( "0" ) END
|
|
|
- END;
|
|
|
- IF D # 0 THEN
|
|
|
- IF D < 0 THEN String( "E-" ); D := -D ELSE String( "E+" ) END;
|
|
|
- Char( CHR( D DIV 100 + ORD( "0" ) ) ); D := D MOD 100; Char( CHR( D DIV 10 + ORD( "0" ) ) ); Char( CHR( D MOD 10 + ORD( "0" ) ) )
|
|
|
- END
|
|
|
- END
|
|
|
- END FloatFix;
|
|
|
-
|
|
|
- END Writer;
|
|
|
-
|
|
|
- (** A special writer that buffers output to be fetched by GetString or GetRawString. *)
|
|
|
- StringWriter* = OBJECT (Writer)
|
|
|
-
|
|
|
- PROCEDURE & InitStringWriter*( size: LONGINT );
|
|
|
- BEGIN
|
|
|
- InitWriter( Send, size )
|
|
|
- END InitStringWriter;
|
|
|
-
|
|
|
- PROCEDURE Send( CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT );
|
|
|
- BEGIN
|
|
|
- res := StringFull
|
|
|
- END Send;
|
|
|
-
|
|
|
- PROCEDURE CanSetPos*( ): BOOLEAN;
|
|
|
- BEGIN
|
|
|
- RETURN TRUE;
|
|
|
- END CanSetPos;
|
|
|
-
|
|
|
- (* Set the position for the writer *)
|
|
|
- PROCEDURE SetPos*( pos: BESTSIZE );
|
|
|
- BEGIN
|
|
|
- IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
|
|
|
- tail := LONGINT( pos ); sent := 0; res := Ok;
|
|
|
- END SetPos;
|
|
|
-
|
|
|
- PROCEDURE Update;
|
|
|
- (* nothing to do *)
|
|
|
- END Update;
|
|
|
-
|
|
|
- (** Return the contents of the string writer (0X-terminated). *)
|
|
|
- PROCEDURE Get*( VAR s: ARRAY OF CHAR );
|
|
|
- VAR i, m: LONGINT;
|
|
|
- BEGIN
|
|
|
- m := LEN( s ) - 1; i := 0;
|
|
|
- WHILE (i # tail) & (i < m) DO s[i] := buf[i]; INC( i ) END;
|
|
|
- s[i] := 0X; tail := 0; res := Ok
|
|
|
- END Get;
|
|
|
-
|
|
|
- (** Return the contents of the string writer (not 0X-terminated). The len parameters returns the string length. *)
|
|
|
- PROCEDURE GetRaw*( VAR s: ARRAY OF CHAR; VAR len: LONGINT );
|
|
|
- VAR i, m: LONGINT;
|
|
|
- BEGIN
|
|
|
- m := LEN( s ); i := 0;
|
|
|
- WHILE (i # tail) & (i < m) DO s[i] := buf[i]; INC( i ) END;
|
|
|
- len := i; tail := 0; res := Ok
|
|
|
- END GetRaw;
|
|
|
-
|
|
|
- END StringWriter;
|
|
|
-
|
|
|
-TYPE
|
|
|
- (** A reader buffers input received from a Receiver. Must not be shared between processes. *)
|
|
|
- Reader* = OBJECT
|
|
|
- VAR
|
|
|
- head, tail: LONGINT;
|
|
|
- buf: POINTER TO ARRAY OF CHAR;
|
|
|
- res*: LONGINT; (** result of last input operation. *)
|
|
|
- receive: Receiver;
|
|
|
- received*: BESTSIZE; (** count of received bytes *)
|
|
|
- (* buf[buf.head..buf.tail-1] contains data to read. *)
|
|
|
-
|
|
|
- PROCEDURE & InitReader*( receive: Receiver; size: LONGINT );
|
|
|
- BEGIN
|
|
|
- ASSERT ( receive # NIL );
|
|
|
- IF (buf = NIL) OR (LEN(buf) # size) THEN
|
|
|
- NEW( buf, size );
|
|
|
- END;
|
|
|
- SELF.receive := receive; Reset
|
|
|
- END InitReader;
|
|
|
-
|
|
|
- (** reset the reader by dropping the bytes in the buffer, resetting the result code and setting received to 0.
|
|
|
- This is used by seekable extensions of the reader *)
|
|
|
- PROCEDURE Reset*;
|
|
|
- BEGIN
|
|
|
- head := 0; tail := 0; res := Ok; received := 0
|
|
|
- END Reset;
|
|
|
-
|
|
|
- PROCEDURE CanSetPos*( ): BOOLEAN;
|
|
|
- BEGIN
|
|
|
- RETURN FALSE
|
|
|
- END CanSetPos;
|
|
|
-
|
|
|
- PROCEDURE SetPos*( pos: BESTSIZE );
|
|
|
- BEGIN
|
|
|
- HALT( 1234 )
|
|
|
- END SetPos;
|
|
|
-
|
|
|
- (** Return bytes currently available in input buffer. *)
|
|
|
- PROCEDURE Available*( ): LONGINT;
|
|
|
- VAR n: LONGINT;
|
|
|
- BEGIN
|
|
|
- IF (res = Ok) THEN
|
|
|
- IF (head = tail) THEN head := 0; receive( buf^, 0, LEN( buf ), 0, tail, res ); INC( received, tail );
|
|
|
- ELSIF (tail # LEN( buf )) THEN
|
|
|
- receive( buf^, tail, LEN( buf ) - tail, 0, n, res ); (* poll *)
|
|
|
- INC( tail, n ); INC( received, n )
|
|
|
- END;
|
|
|
- IF res = EOF THEN res := Ok END (* ignore EOF here *)
|
|
|
- END;
|
|
|
- RETURN tail - head
|
|
|
- END Available;
|
|
|
-
|
|
|
- (** Current read position. *)
|
|
|
- PROCEDURE Pos*( ): BESTSIZE;
|
|
|
- BEGIN
|
|
|
- RETURN received - BESTSIZE(tail) - BESTSIZE(head)
|
|
|
- END Pos;
|
|
|
-
|
|
|
- (** -- Read raw binary data -- *)
|
|
|
-
|
|
|
- (** Read one byte. x=0X if no success (e.g. file ended) *)
|
|
|
- PROCEDURE Char*( VAR x: CHAR );
|
|
|
- BEGIN
|
|
|
- IF (head = tail) & (res = Ok) THEN head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail ) END;
|
|
|
- IF res = Ok THEN x := buf[head]; INC( head ) ELSE x := 0X END
|
|
|
- END Char;
|
|
|
-
|
|
|
- (** Like Read, but return result. Return 0X if no success (e.g. file ended) *)
|
|
|
- PROCEDURE Get*( ): CHAR;
|
|
|
- BEGIN
|
|
|
- IF (head = tail) & (res = Ok) THEN head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail ) END;
|
|
|
- IF res = Ok THEN INC( head ); RETURN buf[head - 1] ELSE RETURN 0X END
|
|
|
- END Get;
|
|
|
-
|
|
|
- (** Like Get, but leave the byte in the input buffer. *)
|
|
|
- PROCEDURE Peek*( ): CHAR;
|
|
|
- BEGIN
|
|
|
- IF (head = tail) & (res = Ok) THEN
|
|
|
- head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail );
|
|
|
- IF res = EOF THEN (* ignore EOF here *)
|
|
|
- res := Ok; tail := 0; RETURN 0X (* Peek returns 0X at eof *)
|
|
|
- END
|
|
|
- END;
|
|
|
- IF res = Ok THEN RETURN buf[head] ELSE RETURN 0X END
|
|
|
- END Peek;
|
|
|
-
|
|
|
- (** Read size bytes into x, starting at ofs. The len parameter returns the number of bytes that were actually read. *)
|
|
|
- PROCEDURE Bytes*( VAR x: ARRAY OF CHAR; ofs, size: LONGINT; VAR len: LONGINT );
|
|
|
- VAR n: LONGINT;
|
|
|
- BEGIN
|
|
|
- ASSERT ( size >= 0 );
|
|
|
- len := 0;
|
|
|
- LOOP
|
|
|
- n := tail - head; (* bytes available *)
|
|
|
- IF n = 0 THEN (* no data available *)
|
|
|
- head := 0;
|
|
|
- IF res = Ok THEN (* fill buffer *)
|
|
|
- receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail )
|
|
|
- END;
|
|
|
- IF res # Ok THEN (* should not be reading from erroneous rider *)
|
|
|
- WHILE size # 0 DO x[ofs] := 0X; INC( ofs ); DEC( size ) END; (* clear rest of buffer *)
|
|
|
- IF (res = EOF) & (len # 0) THEN res := Ok END; (* ignore EOF if some data being returned *)
|
|
|
- EXIT
|
|
|
- END;
|
|
|
- n := tail
|
|
|
- END;
|
|
|
- IF n > size THEN n := size END;
|
|
|
- ASSERT ( ofs + n <= LEN( x ) ); (* index check *)
|
|
|
- SYSTEM.MOVE( ADDRESSOF( buf[head] ), ADDRESSOF( x[ofs] ), n ); INC( head, n ); INC( len, n );
|
|
|
- IF size = n THEN EXIT END; (* done *)
|
|
|
- INC( ofs, n ); DEC( size, n )
|
|
|
- END
|
|
|
- END Bytes;
|
|
|
-
|
|
|
- (** Skip n bytes on the reader. *)
|
|
|
- PROCEDURE SkipBytes*( n: LONGINT );
|
|
|
- VAR ch: CHAR;
|
|
|
- BEGIN
|
|
|
- WHILE n > 0 DO ch := Get(); DEC( n ) END
|
|
|
- END SkipBytes;
|
|
|
-
|
|
|
- (** Read a SHORTINT. *)
|
|
|
- PROCEDURE RawSInt*( VAR x: SHORTINT );
|
|
|
- BEGIN
|
|
|
- x := SYSTEM.VAL( SHORTINT, Get() )
|
|
|
- END RawSInt;
|
|
|
-
|
|
|
- (** Read an INTEGER. *)
|
|
|
- PROCEDURE RawInt*( VAR x: INTEGER );
|
|
|
- VAR x0, x1: CHAR;
|
|
|
- BEGIN
|
|
|
- x0 := Get(); x1 := Get(); (* defined order *)
|
|
|
- x := ORD( x1 ) * 100H + ORD( x0 )
|
|
|
- END RawInt;
|
|
|
-
|
|
|
- (** Read a LONGINT. *)
|
|
|
- PROCEDURE RawLInt*( VAR x: LONGINT );
|
|
|
- VAR ignore: LONGINT;
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
|
|
|
- END RawLInt;
|
|
|
-
|
|
|
- (** Read a HUGEINT. *)
|
|
|
- PROCEDURE RawHInt*( VAR x: HUGEINT );
|
|
|
- VAR ignore: LONGINT;
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
|
|
|
- END RawHInt;
|
|
|
-
|
|
|
- (** Read a 64 bit value in network byte order (most significant byte first) *)
|
|
|
- PROCEDURE Net64*( ): HUGEINT;
|
|
|
- BEGIN
|
|
|
- RETURN Net32() * 100000000H + Net32()
|
|
|
- END Net64;
|
|
|
-
|
|
|
- (** Read a 32 bit value in network byte order (most significant byte first) *)
|
|
|
- PROCEDURE Net32*( ): LONGINT;
|
|
|
- BEGIN
|
|
|
- RETURN LONG( ORD( Get() ) ) * 1000000H + LONG( ORD( Get() ) ) * 10000H + LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
|
|
|
- END Net32;
|
|
|
-
|
|
|
- (** Read an unsigned 16bit value in network byte order (most significant byte first) *)
|
|
|
- PROCEDURE Net16*( ): LONGINT;
|
|
|
- BEGIN
|
|
|
- RETURN LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
|
|
|
- END Net16;
|
|
|
-
|
|
|
- (** Read an unsigned byte *)
|
|
|
- PROCEDURE Net8*( ): LONGINT;
|
|
|
- BEGIN
|
|
|
- RETURN LONG( ORD( Get() ) )
|
|
|
- END Net8;
|
|
|
-
|
|
|
- (** Read a SET. *)
|
|
|
- PROCEDURE RawSet*( VAR x: SET );
|
|
|
- VAR ignore: LONGINT;
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
|
|
|
- END RawSet;
|
|
|
-
|
|
|
- (** Read a BOOLEAN. *)
|
|
|
- PROCEDURE RawBool*( VAR x: BOOLEAN );
|
|
|
- BEGIN
|
|
|
- x := (Get() # 0X)
|
|
|
- END RawBool;
|
|
|
-
|
|
|
- (** Read a REAL. *)
|
|
|
- PROCEDURE RawReal*( VAR x: REAL );
|
|
|
- VAR ignore: LONGINT;
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
|
|
|
- END RawReal;
|
|
|
-
|
|
|
- (** Read a LONGREAL. *)
|
|
|
- PROCEDURE RawLReal*( VAR x: LONGREAL );
|
|
|
- VAR ignore: LONGINT;
|
|
|
- BEGIN
|
|
|
- Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
|
|
|
- END RawLReal;
|
|
|
-
|
|
|
- (** Read a 0X-terminated string. If the input string is larger than x, read the full string and assign the truncated 0X-terminated value to x. *)
|
|
|
- PROCEDURE RawString*( VAR x: ARRAY OF CHAR );
|
|
|
- VAR i, m: LONGINT; ch: CHAR;
|
|
|
- BEGIN
|
|
|
- i := 0; m := LEN( x ) - 1;
|
|
|
- LOOP
|
|
|
- ch := Get(); (* also returns 0X on error *)
|
|
|
- IF ch = 0X THEN EXIT END;
|
|
|
- IF i < m THEN x[i] := ch; INC( i ) END
|
|
|
- END;
|
|
|
- x[i] := 0X
|
|
|
- END RawString;
|
|
|
-
|
|
|
- (** Read a number in a compressed format. *)
|
|
|
- PROCEDURE RawNum*( VAR x: LONGINT );
|
|
|
- VAR ch: CHAR; n, y: LONGINT;
|
|
|
- BEGIN
|
|
|
- n := 0; y := 0; ch := Get();
|
|
|
- WHILE ch >= 80X DO INC( y, LSH( LONG( ORD( ch ) ) - 128, n ) ); INC( n, 7 ); ch := Get() END;
|
|
|
- x := ASH( LSH( LONG( ORD( ch ) ), 25 ), n - 25 ) + y
|
|
|
- END RawNum;
|
|
|
-
|
|
|
- (** -- Read formatted data (uses Peek for one character lookahead) -- *)
|
|
|
-
|
|
|
- (** Read an integer value in decimal or hexadecimal. If hex = TRUE, recognize the "H" postfix for hexadecimal numbers. *)
|
|
|
-
|
|
|
- PROCEDURE Int*( VAR x: LONGINT; hex: BOOLEAN );
|
|
|
- VAR vd, vh, sgn, d: LONGINT; ch: CHAR; ok: BOOLEAN;
|
|
|
- BEGIN
|
|
|
- vd := 0; vh := 0; sgn := 1; ok := FALSE;
|
|
|
- IF Peek() = "-" THEN sgn := -1; ch := Get() END;
|
|
|
- LOOP
|
|
|
- ch := Peek();
|
|
|
- IF (ch >= "0") & (ch <= "9") THEN d := ORD( ch ) - ORD( "0" )
|
|
|
- ELSIF hex & (CAP( ch ) >= "A") & (CAP( ch ) <= "F") THEN d := ORD( CAP( ch ) ) - ORD( "A" ) + 10
|
|
|
- ELSE EXIT
|
|
|
- END;
|
|
|
- vd := 10 * vd + d; vh := 16 * vh + d; (* ignore overflow *)
|
|
|
- ch := Get(); ok := TRUE
|
|
|
- END;
|
|
|
- IF hex & (CAP( ch ) = "H") THEN (* optional "H" present *)
|
|
|
- vd := vh; (* use the hex value *)
|
|
|
- ch := Get()
|
|
|
- END;
|
|
|
- x := sgn * vd;
|
|
|
- IF (res = 0) & ~ok THEN res := FormatError END
|
|
|
- END Int;
|
|
|
-
|
|
|
- (** Return TRUE iff at the end of a line (or file). *)
|
|
|
- PROCEDURE EOLN*( ): BOOLEAN;
|
|
|
- VAR ch: CHAR;
|
|
|
- BEGIN
|
|
|
- ch := Peek(); RETURN (ch = CR) OR (ch = LF) OR (res # Ok)
|
|
|
- END EOLN;
|
|
|
-
|
|
|
- (** Read all characters until the end of the line (inclusive). If the input string is larger than x, read the full string and assign
|
|
|
- the truncated 0X-terminated value to x. *)
|
|
|
- PROCEDURE Ln*( VAR x: ARRAY OF CHAR );
|
|
|
- VAR i, m: LONGINT; ch: CHAR;
|
|
|
- BEGIN
|
|
|
- i := 0; m := LEN( x ) - 1;
|
|
|
- LOOP
|
|
|
- ch := Peek();
|
|
|
- IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
|
|
|
- IF i < m THEN x[i] := ch; INC( i ) END;
|
|
|
- ch := Get()
|
|
|
- END;
|
|
|
- x[i] := 0X;
|
|
|
- IF ch = CR THEN ch := Get() END;
|
|
|
- IF Peek() = LF THEN ch := Get() END
|
|
|
- END Ln;
|
|
|
-
|
|
|
- (** Read all characters until the end of the line (inclusive) or an <EOT> character.
|
|
|
- If the input string is larger than x, read the full string and assign the truncated 0X-terminated
|
|
|
- value to x. *)
|
|
|
- PROCEDURE LnEOT*( VAR x: ARRAY OF CHAR );
|
|
|
- VAR i, m: LONGINT; ch: CHAR;
|
|
|
- BEGIN
|
|
|
- i := 0; m := LEN( x ) - 1;
|
|
|
- LOOP
|
|
|
- ch := Peek();
|
|
|
- IF (ch = CR) OR (ch = LF) OR (ch = EOT) OR (res # Ok) THEN EXIT END;
|
|
|
- IF i < m THEN x[i] := ch; INC( i ) END;
|
|
|
- ch := Get()
|
|
|
- END;
|
|
|
- x[i] := 0X;
|
|
|
- IF ch = CR THEN ch := Get() END;
|
|
|
- IF Peek() = LF THEN ch := Get() END;
|
|
|
- IF ch = EOT THEN ch := Get() END
|
|
|
- END LnEOT;
|
|
|
-
|
|
|
- (** Skip over all characters until the end of the line (inclusive). *)
|
|
|
- PROCEDURE SkipLn*;
|
|
|
- VAR ch: CHAR;
|
|
|
- BEGIN
|
|
|
- LOOP
|
|
|
- ch := Peek();
|
|
|
- IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
|
|
|
- ch := Get()
|
|
|
- END;
|
|
|
- IF ch = CR THEN ch := Get() END;
|
|
|
- IF Peek() = LF THEN ch := Get() END
|
|
|
- END SkipLn;
|
|
|
-
|
|
|
- (** Skip over space and TAB characters. *)
|
|
|
- PROCEDURE SkipSpaces*;
|
|
|
- VAR ch: CHAR;
|
|
|
- BEGIN
|
|
|
- LOOP
|
|
|
- ch := Peek();
|
|
|
- IF (ch # TAB) & (ch # SP) THEN EXIT END;
|
|
|
- ch := Get()
|
|
|
- END
|
|
|
- END SkipSpaces;
|
|
|
-
|
|
|
- (** Skip over space, TAB and EOLN characters. *)
|
|
|
- PROCEDURE SkipWhitespace*;
|
|
|
- VAR ch: CHAR;
|
|
|
- BEGIN
|
|
|
- LOOP
|
|
|
- ch := Peek();
|
|
|
- IF (ch # SP) & (ch # CR) & (ch # LF) & (ch # TAB) THEN EXIT END;
|
|
|
- ch := Get()
|
|
|
- END
|
|
|
- END SkipWhitespace;
|
|
|
-
|
|
|
- (** Read a token, consisting of any string of characters terminated by space, TAB or EOLN. *)
|
|
|
- PROCEDURE Token*( VAR token: ARRAY OF CHAR );
|
|
|
- VAR j, max: LONGINT; ch: CHAR;
|
|
|
- BEGIN
|
|
|
- j := 0; max := LEN( token ) - 1;
|
|
|
- LOOP
|
|
|
- ch := Peek();
|
|
|
- IF (ch = SP) OR (ch = CR) OR (ch = LF) OR (ch = TAB) OR (res # Ok) THEN EXIT END;
|
|
|
- IF j < max THEN token[j] := ch; INC( j ) END;
|
|
|
- ch := Get()
|
|
|
- END;
|
|
|
- token[j] := 0X
|
|
|
- END Token;
|
|
|
-
|
|
|
- (** Read an optionally "" or '' enquoted string. Will not read past the end of a line. *)
|
|
|
- PROCEDURE String*( VAR string: ARRAY OF CHAR );
|
|
|
- VAR c, delimiter: CHAR; i, len: LONGINT;
|
|
|
- BEGIN
|
|
|
- c := Peek();
|
|
|
- IF (c # "'") & (c # '"') THEN Token( string )
|
|
|
- ELSE
|
|
|
- delimiter := Get(); c := Peek(); i := 0; len := LEN( string ) - 1;
|
|
|
- WHILE (i < len) & (c # delimiter) & (c # CR) & (c # LF) & (res = Ok) DO string[i] := Get(); INC( i ); c := Peek() END;
|
|
|
- IF (c = delimiter) THEN c := Get() END;
|
|
|
- string[i] := 0X
|
|
|
- END
|
|
|
- END String;
|
|
|
-
|
|
|
- (** First skip whitespace, then read string *)
|
|
|
- PROCEDURE GetString*(VAR string : ARRAY OF CHAR): BOOLEAN;
|
|
|
- VAR c: CHAR;
|
|
|
- BEGIN
|
|
|
- SkipWhitespace;
|
|
|
- c := Peek();
|
|
|
- String(string);
|
|
|
- RETURN (string[0] # 0X) OR (c = "'") OR (c = '"');
|
|
|
- END GetString;
|
|
|
-
|
|
|
- (** First skip whitespace, then read integer *)
|
|
|
- PROCEDURE GetInteger*(VAR integer : LONGINT; isHexadecimal : BOOLEAN): BOOLEAN;
|
|
|
- BEGIN
|
|
|
- SkipWhitespace;
|
|
|
- Int(integer, isHexadecimal);
|
|
|
- RETURN res = Ok;
|
|
|
- END GetInteger;
|
|
|
-
|
|
|
- (** First skip whitespace, then read 1 byte character *)
|
|
|
- PROCEDURE GetChar*(VAR ch : CHAR): BOOLEAN;
|
|
|
- BEGIN
|
|
|
- SkipWhitespace;
|
|
|
- Char(ch);
|
|
|
- RETURN ch # 0X;
|
|
|
- END GetChar;
|
|
|
-
|
|
|
- END Reader;
|
|
|
-
|
|
|
-TYPE
|
|
|
- (** A special reader that buffers input set by SetString or SetRawString. *)
|
|
|
- StringReader* = OBJECT (Reader)
|
|
|
-
|
|
|
- PROCEDURE & InitStringReader*( size: LONGINT );
|
|
|
- BEGIN
|
|
|
- InitReader( Receive, size )
|
|
|
- END InitStringReader;
|
|
|
-
|
|
|
- PROCEDURE CanSetPos*( ): BOOLEAN;
|
|
|
- BEGIN
|
|
|
- RETURN TRUE
|
|
|
- END CanSetPos;
|
|
|
-
|
|
|
- (** Set the reader position *)
|
|
|
- PROCEDURE SetPos*( pos: BESTSIZE );
|
|
|
- BEGIN
|
|
|
- IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
|
|
|
- head := LONGINT( pos ); tail := LEN( buf ); received := LEN( buf ); res := Ok;
|
|
|
- END SetPos;
|
|
|
-
|
|
|
- PROCEDURE Receive( VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT );
|
|
|
- BEGIN
|
|
|
- IF min = 0 THEN res := Ok ELSE res := EOF END;
|
|
|
- len := 0;
|
|
|
- END Receive;
|
|
|
-
|
|
|
- (** Set the contents of the string buffer. The s parameter is a 0X-terminated string. *)
|
|
|
- PROCEDURE Set*(CONST s: ARRAY OF CHAR );
|
|
|
- VAR len: LONGINT;
|
|
|
- BEGIN
|
|
|
- len := 0;
|
|
|
- WHILE s[len] # 0X DO INC( len ) END;
|
|
|
- IF len > LEN( buf ) THEN len := LEN( buf ) END;
|
|
|
- head := 0; tail := len; received := len; res := Ok;
|
|
|
- IF len > 0 THEN
|
|
|
- SYSTEM.MOVE( ADDRESSOF( s[0] ), ADDRESSOF( buf[0] ), len )
|
|
|
- END;
|
|
|
- END Set;
|
|
|
-
|
|
|
- (** Set the contents of the string buffer. The len parameter specifies the size of the buffer s. *)
|
|
|
- PROCEDURE SetRaw*(CONST s: ARRAY OF CHAR; ofs, len: LONGINT );
|
|
|
- BEGIN
|
|
|
- IF len > LEN( buf ) THEN len := LEN( buf ) END;
|
|
|
- head := 0; tail := len; received := len; res := Ok;
|
|
|
- ASSERT ( (len >= 0) & (ofs + len <= LEN( s )) ); (* index check *)
|
|
|
- IF len > 0 THEN
|
|
|
- SYSTEM.MOVE( ADDRESSOF( s[ofs] ), ADDRESSOF( buf[0] ), len )
|
|
|
- END;
|
|
|
- END SetRaw;
|
|
|
-
|
|
|
- END StringReader;
|
|
|
-
|
|
|
- Bytes2 = ARRAY 2 OF CHAR;
|
|
|
- Bytes4 = ARRAY 4 OF CHAR;
|
|
|
- Bytes8 = ARRAY 8 OF CHAR;
|
|
|
-
|
|
|
-VAR
|
|
|
- months: ARRAY 12 * 4 + 1 OF CHAR;
|
|
|
-
|
|
|
-
|
|
|
- (** Open a writer to the specified stream sender. Update must be called after writing to ensure the buffer is written to the stream. *)
|
|
|
- PROCEDURE OpenWriter*( VAR b: Writer; send: Sender );
|
|
|
- BEGIN
|
|
|
- NEW( b, send, DefaultWriterSize )
|
|
|
- END OpenWriter;
|
|
|
-
|
|
|
-(** Open a reader from the specified stream receiver. *)
|
|
|
- PROCEDURE OpenReader*( VAR b: Reader; receive: Receiver );
|
|
|
- BEGIN
|
|
|
- NEW( b, receive, DefaultReaderSize )
|
|
|
- END OpenReader;
|
|
|
-
|
|
|
-(** Copy the contents of a reader to a writer *)
|
|
|
- PROCEDURE Copy* (r: Reader; w: Writer);
|
|
|
- VAR char: CHAR;
|
|
|
- BEGIN
|
|
|
- WHILE r.res = Ok DO
|
|
|
- r.Char (char);
|
|
|
- IF r.res = Ok THEN w.Char (char) END
|
|
|
- END;
|
|
|
- END Copy;
|
|
|
-
|
|
|
- (** from module Reals.Mod *)
|
|
|
-
|
|
|
-
|
|
|
-(*** the following procedures stem from Reals.Mod and are needed for Writer.Float and Writer.FloatFix *)
|
|
|
-
|
|
|
-(** Returns the NaN code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)) or (-1,-1) if not NaN/Infinite. *)
|
|
|
- PROCEDURE NaNCodeL( x: LONGREAL; VAR h, l: LONGINT );
|
|
|
- BEGIN
|
|
|
- SYSTEM.GET( ADDRESSOF( x ) + H, h ); SYSTEM.GET( ADDRESSOF( x ) + L, l );
|
|
|
- IF ASH( h, -20 ) MOD 2048 = 2047 THEN (* Infinite or NaN *)
|
|
|
- h := h MOD 100000H (* lowest 20 bits *)
|
|
|
- ELSE h := -1; l := -1
|
|
|
- END
|
|
|
- END NaNCodeL;
|
|
|
-
|
|
|
-(** Returns the shifted binary exponent (0 <= e < 2048). *)
|
|
|
- PROCEDURE ExpoL( x: LONGREAL ): LONGINT;
|
|
|
- VAR i: LONGINT;
|
|
|
- BEGIN
|
|
|
- SYSTEM.GET( ADDRESSOF( x ) + H, i ); RETURN ASH( i, -20 ) MOD 2048
|
|
|
- END ExpoL;
|
|
|
-
|
|
|
-(** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
|
|
|
- PROCEDURE RealL( h, l: LONGINT ): LONGREAL;
|
|
|
- VAR x: LONGREAL;
|
|
|
- BEGIN
|
|
|
- SYSTEM.PUT( ADDRESSOF( x ) + H, h ); SYSTEM.PUT( ADDRESSOF( x ) + L, l ); RETURN x
|
|
|
- END RealL;
|
|
|
-
|
|
|
-(** Returns 10^e (e <= 308, 308 < e delivers IEEE-code +INF). *)
|
|
|
- PROCEDURE Ten( e: LONGINT ): LONGREAL; (* naiive version *)
|
|
|
- VAR r: LONGREAL;
|
|
|
- BEGIN
|
|
|
- IF e < -307 THEN RETURN 0
|
|
|
- ELSIF 308 < e THEN RETURN RealL( 2146435072, 0 )
|
|
|
- END;
|
|
|
- r := 1;
|
|
|
- WHILE (e > 0) DO r := r * 10; DEC( e ); END;
|
|
|
- WHILE (e < 0) DO r := r / 10; INC( e ); END;
|
|
|
- RETURN r;
|
|
|
- END Ten;
|
|
|
-
|
|
|
- PROCEDURE InitHL;
|
|
|
- VAR i: ADDRESS; dmy: INTEGER; littleEndian: BOOLEAN;
|
|
|
- BEGIN
|
|
|
- dmy := 1; i := ADDRESSOF( dmy );
|
|
|
- SYSTEM.GET( i, littleEndian ); (* indirection via i avoids warning on SUN cc -O *)
|
|
|
- IF littleEndian THEN H := 4; L := 0 ELSE H := 0; L := 4 END
|
|
|
- END InitHL;
|
|
|
-
|
|
|
-
|
|
|
-BEGIN
|
|
|
- months := " Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"; InitHL;
|
|
|
-END Streams64.
|
|
|
-
|
|
|
-(**
|
|
|
-Notes:
|
|
|
-o Any single buffer instance must not be accessed by more than one process concurrently.
|
|
|
-o The interface is blocking (synchronous). If an output buffer is full, it is written with a synchronous write, which returns
|
|
|
- only when all the data has been written. If an input buffer is empty, it is read with a synchronous read, which only returns
|
|
|
- once some data has been read. The only exception is the Available() procedure, which "peeks" at the input stream
|
|
|
- and returns 0 if no data is currently available.
|
|
|
-o All procedures set res to the error code reported by the lower-level I/O operation (non-zero indicates error).
|
|
|
- E.g. closing an underlying TCP connection will result in the Read* procedures returning a non-zero error code.
|
|
|
-o res is sticky. Once it becomes non-zero, it remains non-zero.
|
|
|
-o The only way to detect end of file is to attempt to read past the end of file, which returns a non-zero error code.
|
|
|
-o All output written to an erroneous buffer is ignored.
|
|
|
-o The value returned when reading from an erroneous buffer is undefined, except for the Read procedure, which returns 0X.
|
|
|
-o ReadBytes sets the len parameter to the number of bytes that were actually read, e.g. if size = 10, and only 8 bytes are read, len is 8.
|
|
|
-o Raw format is little-endian 2's complement integers, IEEE reals and 0X-terminated strings.
|
|
|
-o Syntax for ReadInt with hex = FALSE: num = ["-"] digit {digit}. digit = "0".."9".
|
|
|
-o Syntax for ReadInt with hex = TRUE: ["-"] hexdigit {hexdigit} ["H"|"h"]. hexdigit = digit | "A".."F" | "a".."f".
|
|
|
-o ReadInt with hex = TRUE allows "A".."F" as digits, and looks for a "H" character after the number.
|
|
|
- If present, the number is interpreted as hexadecimal. If hexadecimal digits are present, but no "H" flag,
|
|
|
- the resulting decimal value is undefined.
|
|
|
-o ReadInt ignores overflow.
|
|
|
-o A Sender sends len bytes from buf at ofs to output and returns res non-zero on error. It waits until all the data is written,
|
|
|
- or an error occurs.
|
|
|
-o A Receiver receives up to size bytes from input into buf at ofs and returns the number of bytes read in len.
|
|
|
- It returns res non-zero on error. It waits until at least min bytes (possibly zero) are available, or an error occurs.
|
|
|
-o EOLN and ReadLn recognize the following end-of-line characters: CR, LF and CR/LF.
|
|
|
-o To read an unstructured file token-by-token: WHILE (r.res = 0) DO SkipWhitespace; ReadToken END
|
|
|
-o To read a line structured file token-by-token: WHILE r.res = 0 DO SkipSpaces; WHILE ~EOLN DO ReadToken; SkipSpaces END END
|
|
|
-o A string writer is not flushed when it becomes full, but res is set to a non-zero value.
|
|
|
-o Update has no effect on a string writer.
|
|
|
-o GetString can be called on a string writer to return the buffer contents and reset it to empty.
|
|
|
-o GetString always appends a 0X character to the buffer, but returns the true length (excluding the added 0X) in the len parameter,
|
|
|
- so it can also be used for binary data that includes 0X characters.
|
|
|
-o Receive procedure should set res to EOF when attempting to read past the end of file.
|
|
|
-*)
|
|
|
-
|
|
|
-
|
|
|
-(*
|
|
|
-to do:
|
|
|
-o stream byte count
|
|
|
-o read formatted data
|
|
|
-o reads for all formatted writes
|
|
|
-o write reals
|
|
|
-o low-level version that can be used in kernel (below KernelLog)
|
|
|
-*)
|
|
|
+(* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
|
|
|
+
|
|
|
+MODULE Streams64; (** AUTHOR "pjm/be"; PURPOSE "I/O buffering and formatted writing and reading"; *)
|
|
|
+
|
|
|
+IMPORT SYSTEM;
|
|
|
+
|
|
|
+CONST
|
|
|
+ Ok* = 0; (** zero result code means no error occurred *)
|
|
|
+ EOF* = 4201; (** error returned when Receive reads past end of file or stream *)
|
|
|
+
|
|
|
+ EOT* = 1AX; (** EOT character *)
|
|
|
+
|
|
|
+ StringFull = 4202;
|
|
|
+ FormatError* = 4203; (** error returned when ReadInt fails *)
|
|
|
+
|
|
|
+ DefaultWriterSize* = 4096;
|
|
|
+ DefaultReaderSize* = 4096;
|
|
|
+
|
|
|
+CONST
|
|
|
+ CR = 0DX; LF = 0AX; TAB = 9X; SP = 20X;
|
|
|
+
|
|
|
+VAR
|
|
|
+ H, L: INTEGER;
|
|
|
+TYPE
|
|
|
+ (** Any stream output procedure or method. *)
|
|
|
+ Sender* = PROCEDURE {DELEGATE} ( CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT );
|
|
|
+
|
|
|
+ (** Any stream input procedure or method. *)
|
|
|
+ Receiver* = PROCEDURE {DELEGATE} ( VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT );
|
|
|
+
|
|
|
+ Connection* = OBJECT
|
|
|
+
|
|
|
+ PROCEDURE Send*( CONST data: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT );
|
|
|
+ END Send;
|
|
|
+
|
|
|
+ PROCEDURE Receive*( VAR data: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT );
|
|
|
+ END Receive;
|
|
|
+
|
|
|
+ PROCEDURE Close*;
|
|
|
+ END Close;
|
|
|
+
|
|
|
+ END Connection;
|
|
|
+
|
|
|
+ (** A writer buffers output before it is sent to a Sender. Must not be shared between processes. *)
|
|
|
+TYPE
|
|
|
+ Writer* = OBJECT
|
|
|
+ VAR
|
|
|
+ tail: LONGINT;
|
|
|
+ buf: POINTER TO ARRAY OF CHAR;
|
|
|
+ res*: LONGINT; (** result of last output operation. *)
|
|
|
+ send: Sender;
|
|
|
+ sent*: HUGEINT; (** count of sent bytes *)
|
|
|
+ (* buf[0..tail-1] contains data to write. *)
|
|
|
+
|
|
|
+ PROCEDURE & InitWriter*( send: Sender; size: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ ASSERT ( send # NIL );
|
|
|
+ NEW( buf, size ); SELF.send := send; Reset
|
|
|
+ END InitWriter;
|
|
|
+
|
|
|
+ PROCEDURE Reset*;
|
|
|
+ BEGIN
|
|
|
+ tail := 0; res := Ok; sent := 0
|
|
|
+ END Reset;
|
|
|
+
|
|
|
+ PROCEDURE CanSetPos*( ): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ RETURN FALSE
|
|
|
+ END CanSetPos;
|
|
|
+
|
|
|
+ PROCEDURE SetPos*( pos: HUGEINT );
|
|
|
+ BEGIN
|
|
|
+ HALT( 1234 )
|
|
|
+ END SetPos;
|
|
|
+
|
|
|
+ PROCEDURE Update*;
|
|
|
+ BEGIN
|
|
|
+ IF (res = Ok) THEN
|
|
|
+ send( buf^, 0, tail, TRUE , res );
|
|
|
+ IF res = Ok THEN INC( sent, tail ); tail := 0 END
|
|
|
+ END
|
|
|
+ END Update;
|
|
|
+
|
|
|
+ (** Current write position. *)
|
|
|
+ PROCEDURE Pos*( ): HUGEINT;
|
|
|
+ BEGIN
|
|
|
+ RETURN sent + tail;
|
|
|
+ END Pos;
|
|
|
+
|
|
|
+ (** -- Write raw binary data -- *)
|
|
|
+
|
|
|
+ (** Write one byte. *)
|
|
|
+ PROCEDURE Char*( x: CHAR );
|
|
|
+ BEGIN
|
|
|
+ IF (tail = LEN( buf )) & (res = Ok) THEN
|
|
|
+ send( buf^, 0, tail, FALSE , res );
|
|
|
+ IF res = Ok THEN INC( sent, tail ); tail := 0 END
|
|
|
+ END;
|
|
|
+ IF res = Ok THEN buf[tail] := x; INC( tail ) END
|
|
|
+ END Char;
|
|
|
+
|
|
|
+ (** Write len bytes from x, starting at ofs. *)
|
|
|
+ PROCEDURE Bytes*(CONST x: ARRAY OF CHAR; ofs, len: LONGINT );
|
|
|
+ VAR n: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ ASSERT ( len >= 0 );
|
|
|
+ LOOP
|
|
|
+ n := LEN( buf ) - tail; (* space available *)
|
|
|
+ IF n = 0 THEN
|
|
|
+ IF res = Ok THEN (* send current buffer *)
|
|
|
+ send( buf^, 0, tail, FALSE , res );
|
|
|
+ IF res = Ok THEN INC( sent, tail ); tail := 0 ELSE EXIT END
|
|
|
+ ELSE
|
|
|
+ EXIT (* should not be writing on an erroneous rider *)
|
|
|
+ END;
|
|
|
+ n := LEN( buf )
|
|
|
+ END;
|
|
|
+ IF n > len THEN n := len END;
|
|
|
+ ASSERT ( tail + n <= LEN( buf ) ); (* index check *)
|
|
|
+ SYSTEM.MOVE( ADDRESSOF( x[ofs] ), ADDRESSOF( buf[tail] ), n ); INC( tail, n );
|
|
|
+ IF len = n THEN EXIT END; (* done *)
|
|
|
+ INC( ofs, n ); DEC( len, n )
|
|
|
+ END
|
|
|
+ END Bytes;
|
|
|
+
|
|
|
+ (** Write a SHORTINT. *)
|
|
|
+ PROCEDURE RawSInt*( x: SHORTINT );
|
|
|
+ BEGIN
|
|
|
+ Char( SYSTEM.VAL( CHAR, x ) )
|
|
|
+ END RawSInt;
|
|
|
+
|
|
|
+ (** Write an INTEGER. *)
|
|
|
+ PROCEDURE RawInt*( x: INTEGER );
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes2, x ), 0, 2 )
|
|
|
+ END RawInt;
|
|
|
+
|
|
|
+ (** Write a LONGINT. *)
|
|
|
+ PROCEDURE RawLInt*( x: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
|
|
|
+ END RawLInt;
|
|
|
+
|
|
|
+ (** Write a HUGEINT. *)
|
|
|
+ PROCEDURE RawHInt*( x: HUGEINT );
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8 )
|
|
|
+ END RawHInt;
|
|
|
+
|
|
|
+ (** Write a 64 bit value in network byte order (most significant byte first) *)
|
|
|
+ PROCEDURE Net64*( x: HUGEINT );
|
|
|
+ BEGIN
|
|
|
+ Net32(LONGINT( x DIV 100000000H MOD 100000000H ));
|
|
|
+ Net32(LONGINT( x MOD 100000000H ));
|
|
|
+ END Net64;
|
|
|
+
|
|
|
+ (** Write a 32 bit value in network byte order (most significant byte first) *)
|
|
|
+ PROCEDURE Net32*( x: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ Char( CHR( x DIV 1000000H MOD 100H ) ); Char( CHR( x DIV 10000H MOD 100H ) ); Char( CHR( x DIV 100H MOD 100H ) );
|
|
|
+ Char( CHR( x MOD 100H ) )
|
|
|
+ END Net32;
|
|
|
+
|
|
|
+ (** Write a 16 bit value in network byte order (most significant byte first) *)
|
|
|
+ PROCEDURE Net16*( x: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ Char( CHR( x DIV 100H MOD 100H ) ); Char( CHR( x MOD 100H ) )
|
|
|
+ END Net16;
|
|
|
+
|
|
|
+ (** write unsigned byte *)
|
|
|
+ PROCEDURE Net8*( x: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ Char( CHR( x MOD 100H ) )
|
|
|
+ END Net8;
|
|
|
+
|
|
|
+ (** Write a SET. *)
|
|
|
+ PROCEDURE RawSet*( x: SET );
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
|
|
|
+ END RawSet;
|
|
|
+
|
|
|
+ (** Write a BOOLEAN. *)
|
|
|
+ PROCEDURE RawBool*( x: BOOLEAN );
|
|
|
+ BEGIN
|
|
|
+ IF x THEN Char( 1X ) ELSE Char( 0X ) END
|
|
|
+ END RawBool;
|
|
|
+
|
|
|
+ (** Write a REAL. *)
|
|
|
+ PROCEDURE RawReal*( x: REAL );
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
|
|
|
+ END RawReal;
|
|
|
+
|
|
|
+ (** Write a LONGREAL. *)
|
|
|
+ PROCEDURE RawLReal*( x: LONGREAL );
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8 )
|
|
|
+ END RawLReal;
|
|
|
+
|
|
|
+ (** Write a 0X-terminated string, including the 0X terminator. *)
|
|
|
+ PROCEDURE RawString*(CONST x: ARRAY OF CHAR );
|
|
|
+ VAR i: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE x[i] # 0X DO Char( x[i] ); INC( i ) END;
|
|
|
+ Char( 0X )
|
|
|
+ END RawString;
|
|
|
+
|
|
|
+ (** Write a number in a compressed format. *)
|
|
|
+ PROCEDURE RawNum*( x: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ WHILE (x < -64) OR (x > 63) DO Char( CHR( x MOD 128 + 128 ) ); x := x DIV 128 END;
|
|
|
+ Char( CHR( x MOD 128 ) )
|
|
|
+ END RawNum;
|
|
|
+
|
|
|
+ (** -- Write formatted data -- *)
|
|
|
+
|
|
|
+ (** Write an ASCII end-of-line (CR/LF). *)
|
|
|
+ PROCEDURE Ln*;
|
|
|
+ BEGIN
|
|
|
+ Char( CR ); Char( LF )
|
|
|
+ END Ln;
|
|
|
+
|
|
|
+ (** Write a 0X-terminated string, excluding the 0X terminator. *)
|
|
|
+ PROCEDURE String*(CONST x: ARRAY OF CHAR );
|
|
|
+ VAR i: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE x[i] # 0X DO Char( x[i] ); INC( i ) END
|
|
|
+ END String;
|
|
|
+
|
|
|
+ (** Write an integer in decimal right-justified in a field of at least w characters. *)
|
|
|
+ PROCEDURE Int*( x: HUGEINT; w: SIZE );
|
|
|
+ VAR i: SIZE; x0: HUGEINT;
|
|
|
+ a: ARRAY 21 OF CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF x < 0 THEN
|
|
|
+ IF x = MIN( HUGEINT ) THEN
|
|
|
+ DEC( w, 20 );
|
|
|
+ WHILE w > 0 DO Char( " " ); DEC( w ) END;
|
|
|
+ String( "-9223372036854775808" ); RETURN
|
|
|
+ ELSE DEC( w ); x0 := -x
|
|
|
+ END
|
|
|
+ ELSE x0 := x
|
|
|
+ END;
|
|
|
+ i := 0;
|
|
|
+ REPEAT a[i] := CHR( x0 MOD 10 + 30H ); x0 := x0 DIV 10; INC( i ) UNTIL x0 = 0;
|
|
|
+ WHILE w > i DO Char( " " ); DEC( w ) END;
|
|
|
+ IF x < 0 THEN Char( "-" ) END;
|
|
|
+ REPEAT DEC( i ); Char( a[i] ) UNTIL i = 0
|
|
|
+ END Int;
|
|
|
+
|
|
|
+ (** Write a SET in Oberon notation. *)
|
|
|
+ (* PROCEDURE Set*( s: SET ); (* from P. Saladin *)
|
|
|
+ VAR i, last: LONGINT; dots: BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ Char( "{" ); last := MIN( LONGINT ); dots := FALSE;
|
|
|
+ FOR i := MIN( SET ) TO MAX( SET ) DO
|
|
|
+ IF i IN s THEN
|
|
|
+ IF last = (i - 1) THEN
|
|
|
+ IF dots THEN String( ".." ); dots := FALSE END;
|
|
|
+ IF (i = MAX( SET )) OR ~((i + 1) IN s) THEN Int( i, 1 ) END
|
|
|
+ ELSE
|
|
|
+ IF last >= MIN( SET ) THEN String( ", " ) END;
|
|
|
+ Int( i, 1 ); dots := TRUE
|
|
|
+ END;
|
|
|
+ last := i
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ Char( "}" )
|
|
|
+ END Set; *)
|
|
|
+
|
|
|
+ PROCEDURE Set*( s: SET ); (* from P. Saladin *)
|
|
|
+ VAR i, last: LONGINT; dots: BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ Char( "{" ); last := MAX( LONGINT ); dots := FALSE;
|
|
|
+ FOR i := MAX( SET ) TO 0 BY -1 DO
|
|
|
+ IF i IN s THEN
|
|
|
+ IF last = (i + 1) THEN
|
|
|
+ IF dots THEN String( ".." ); dots := FALSE END;
|
|
|
+ IF (i = 0) OR ~((i - 1) IN s) THEN Int( i, 1 ) END
|
|
|
+ ELSE
|
|
|
+ IF last <= MAX( SET ) THEN String( ", " ) END;
|
|
|
+ Int( i, 1 ); dots := TRUE
|
|
|
+ END;
|
|
|
+ last := i
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ Char( "}" )
|
|
|
+ END Set;
|
|
|
+
|
|
|
+ (**
|
|
|
+ Write an integer in hexadecimal right-justified in a field of at least ABS(w) characters.
|
|
|
+ If w < 0 THEN w least significant hex digits of x are written (potentially including leading zeros)
|
|
|
+ *)
|
|
|
+ PROCEDURE Hex*(x: HUGEINT; w: SIZE);
|
|
|
+ VAR filler: CHAR; i,maxw: SIZE; a: ARRAY 20 OF CHAR; y: HUGEINT;
|
|
|
+ BEGIN
|
|
|
+ IF w < 0 THEN filler := '0'; w := -w; maxw := w ELSE filler := ' '; maxw := 16 END;
|
|
|
+ i := 0;
|
|
|
+ REPEAT
|
|
|
+ y := x MOD 10H;
|
|
|
+ IF y < 10 THEN a[i] := CHR(y+ORD('0')) ELSE a[i] := CHR(y-10+ORD('A')) END;
|
|
|
+ x := x DIV 10H;
|
|
|
+ INC(i);
|
|
|
+ UNTIL (x=0) OR (i=maxw);
|
|
|
+ WHILE w > i DO Char(filler); DEC( w ) END;
|
|
|
+ REPEAT DEC( i ); Char( a[i] ) UNTIL i = 0
|
|
|
+ END Hex;
|
|
|
+
|
|
|
+ (** Write "x" as a hexadecimal address. Do not use Hex because of arithmetic shift of the sign !*)
|
|
|
+ PROCEDURE Address* (x: ADDRESS);
|
|
|
+ BEGIN
|
|
|
+ Hex(x,-2*SIZEOF(ADDRESS));
|
|
|
+ END Address;
|
|
|
+
|
|
|
+ PROCEDURE Pair( ch: CHAR; x: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ IF ch # 0X THEN Char( ch ) END;
|
|
|
+ Char( CHR( ORD( "0" ) + x DIV 10 MOD 10 ) ); Char( CHR( ORD( "0" ) + x MOD 10 ) )
|
|
|
+ END Pair;
|
|
|
+
|
|
|
+ (** Write the date and time in ISO format (yyyy-mm-dd hh:mm:ss). The t and d parameters are in Oberon time and date format.
|
|
|
+ If all parameters are within range, the output string is exactly 19 characters wide. The t or d parameter can be -1, in which
|
|
|
+ case the time or date respectively are left out. *)
|
|
|
+ PROCEDURE Date*( t, d: LONGINT );
|
|
|
+ VAR ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF d # -1 THEN
|
|
|
+ Int( 1900 + d DIV 512, 4 ); (* year *)
|
|
|
+ Pair( "-", d DIV 32 MOD 16 ); (* month *)
|
|
|
+ Pair( "-", d MOD 32 ); (* day *)
|
|
|
+ ch := " " (* space between date and time *)
|
|
|
+ ELSE
|
|
|
+ ch := 0X (* no space before time *)
|
|
|
+ END;
|
|
|
+ IF t # -1 THEN
|
|
|
+ Pair( ch, t DIV 4096 MOD 32 ); (* hour *)
|
|
|
+ Pair( ":", t DIV 64 MOD 64 ); (* min *)
|
|
|
+ Pair( ":", t MOD 64 ) (* sec *)
|
|
|
+ END
|
|
|
+ END Date;
|
|
|
+
|
|
|
+ (** Write the date and time in RFC 822/1123 format without the optional day of the week (dd mmm yyyy hh:mm:ss SZZZZ) .
|
|
|
+ The t and d parameters are in Oberon time and date format. The tz parameter specifies the time zone offset in minutes
|
|
|
+ (from -720 to 720 in steps of 30). If all parameters are within range, the output string is exactly 26 characters wide.
|
|
|
+ The t, d or tz parameter can be -1, in which case the time, date or timezone respectively are left out. *)
|
|
|
+ PROCEDURE Date822*( t, d, tz: LONGINT );
|
|
|
+ VAR i, m: LONGINT; ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF d # -1 THEN
|
|
|
+ Int( d MOD 32, 2 ); (* day *)
|
|
|
+ m := (d DIV 32 MOD 16 - 1) * 4; (* month *)
|
|
|
+ FOR i := m TO m + 3 DO Char( months[i] ) END;
|
|
|
+ Int( 1900 + d DIV 512, 5 ); (* year *)
|
|
|
+ ch := " " (* space *)
|
|
|
+ ELSE
|
|
|
+ ch := 0X (* no space *)
|
|
|
+ END;
|
|
|
+ IF t # -1 THEN
|
|
|
+ Pair( ch, t DIV 4096 MOD 32 ); (* hour *)
|
|
|
+ Pair( ":", t DIV 64 MOD 64 ); (* min *)
|
|
|
+ Pair( ":", t MOD 64 ); (* sec *)
|
|
|
+ ch := " " (* space *)
|
|
|
+ ELSE
|
|
|
+ (* leave ch as before *)
|
|
|
+ END;
|
|
|
+ IF tz # -1 THEN
|
|
|
+ IF ch # 0X THEN Char( ch ) END;
|
|
|
+ IF tz >= 0 THEN Pair( "+", tz DIV 60 ) ELSE Pair( "-", (-tz) DIV 60 ) END;
|
|
|
+ Pair( 0X, ABS( tz ) MOD 60 )
|
|
|
+ END
|
|
|
+ END Date822;
|
|
|
+
|
|
|
+
|
|
|
+ (** Write LONGREAL x using n character positions. *)
|
|
|
+ PROCEDURE Float*( x: LONGREAL; n: LONGINT );
|
|
|
+ (* BM 1993.4.22. Do not simplify rounding! *)
|
|
|
+ VAR e, h, l, i: LONGINT; z: LONGREAL;
|
|
|
+ d: ARRAY 16 OF CHAR;
|
|
|
+ BEGIN
|
|
|
+ e := ExpoL( x );
|
|
|
+ IF e = 2047 THEN
|
|
|
+ WHILE n > 5 DO Char( " " ); DEC( n ) END;
|
|
|
+ NaNCodeL( x, h, l );
|
|
|
+ IF (h # 0) OR (l # 0) THEN String( " NaN" )
|
|
|
+ ELSIF x < 0 THEN String( " -INF" )
|
|
|
+ ELSE String( " INF" )
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ IF n <= 9 THEN n := 1 ELSE DEC( n, 8 ) END;
|
|
|
+ REPEAT Char( " " ); DEC( n ) UNTIL n <= 15; (* 0 <= n <= 15 fraction digits *)
|
|
|
+ IF (e # 0) & (x < 0) THEN Char( "-" ); x := -x ELSE Char( " " ) END;
|
|
|
+ IF e = 0 THEN
|
|
|
+ h := 0; l := 0 (* no denormals *)
|
|
|
+ ELSE
|
|
|
+ e := (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) = 0.301029996 *)
|
|
|
+ z := Ten( e + 1 );
|
|
|
+ IF x >= z THEN x := x / z; INC( e ) ELSE x := x * Ten( -e ) END;
|
|
|
+ IF x >= 10 THEN x := x * Ten( -1 ) + 0.5D0 / Ten( n ); INC( e )
|
|
|
+ ELSE
|
|
|
+ x := x + 0.5D0 / Ten( n );
|
|
|
+ IF x >= 10 THEN x := x * Ten( -1 ); INC( e ) END
|
|
|
+ END;
|
|
|
+ x := x * Ten( 7 ); h := ENTIER( x ); x := (x - h) * Ten( 8 ); l := ENTIER( x )
|
|
|
+ END;
|
|
|
+ i := 15;
|
|
|
+ WHILE i > 7 DO d[i] := CHR( l MOD 10 + ORD( "0" ) ); l := l DIV 10; DEC( i ) END;
|
|
|
+ WHILE i >= 0 DO d[i] := CHR( h MOD 10 + ORD( "0" ) ); h := h DIV 10; DEC( i ) END;
|
|
|
+ Char( d[0] ); Char( "." ); i := 1;
|
|
|
+ WHILE i <= n DO Char( d[i] ); INC( i ) END;
|
|
|
+ IF e < 0 THEN String( "E-" ); e := -e ELSE String( "E+" ) END;
|
|
|
+ Char( CHR( e DIV 100 + ORD( "0" ) ) ); e := e MOD 100; Char( CHR( e DIV 10 + ORD( "0" ) ) ); Char( CHR( e MOD 10 + ORD( "0" ) ) )
|
|
|
+ END
|
|
|
+ END Float;
|
|
|
+
|
|
|
+ (** Write LONGREAL x in a fixed point notation. n is the overall minimal length for the output field, f the number of fraction digits following the decimal point, D the fixed exponent (printed only when D # 0). *)
|
|
|
+ PROCEDURE FloatFix*( x: LONGREAL; n, f, D: LONGINT );
|
|
|
+ (* BM 1993.4.22. Do not simplify rounding! / JG formatting adjusted *)
|
|
|
+ VAR e, h, l, i: LONGINT; r, z: LONGREAL;
|
|
|
+ d: ARRAY 16 OF CHAR;
|
|
|
+ s: CHAR; dot: BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ e := ExpoL( x );
|
|
|
+ IF (e = 2047) OR (ABS( D ) > 308) THEN
|
|
|
+ WHILE n > 5 DO Char( " " ); DEC( n ) END;
|
|
|
+ NaNCodeL( x, h, l );
|
|
|
+ IF (h # 0) OR (l # 0) THEN String( " NaN" )
|
|
|
+ ELSIF x < 0 THEN String( " -INF" )
|
|
|
+ ELSE String( " INF" )
|
|
|
+ END
|
|
|
+ ELSE
|
|
|
+ IF D = 0 THEN IF (f=0) THEN dot := FALSE; DEC( n, 1 ) ELSE dot := TRUE; DEC(n,2); END; ELSE dot := TRUE; DEC( n, 7 ) END;
|
|
|
+ IF n < 2 THEN n := 2 END;
|
|
|
+ IF f < 0 THEN f := 0 END;
|
|
|
+ IF n < f + 2 THEN n := f + 2 END;
|
|
|
+ DEC( n, f );
|
|
|
+ IF (e # 0) & (x < 0) THEN s := "-"; x := -x ELSE s := " " END;
|
|
|
+ IF e = 0 THEN
|
|
|
+ h := 0; l := 0; DEC( e, D - 1 ) (* no denormals *)
|
|
|
+ ELSE
|
|
|
+ e := (e - 1023) * 301029 DIV 1000000; (* ln(2)/ln(10) = 0.301029996 *)
|
|
|
+ z := Ten( e + 1 );
|
|
|
+ IF x >= z THEN x := x / z; INC( e ) ELSE x := x * Ten( -e ) END;
|
|
|
+ DEC( e, D - 1 ); i := -(e + f);
|
|
|
+ IF i <= 0 THEN r := 5 * Ten( i ) ELSE r := 0 END;
|
|
|
+ IF x >= 10 THEN x := x * Ten( -1 ) + r; INC( e )
|
|
|
+ ELSE
|
|
|
+ x := x + r;
|
|
|
+ IF x >= 10 THEN x := x * Ten( -1 ); INC( e ) END
|
|
|
+ END;
|
|
|
+ x := x * Ten( 7 ); h := ENTIER( x ); x := (x - h) * Ten( 8 ); l := ENTIER( x )
|
|
|
+ END;
|
|
|
+ i := 15;
|
|
|
+ WHILE i > 7 DO d[i] := CHR( l MOD 10 + ORD( "0" ) ); l := l DIV 10; DEC( i ) END;
|
|
|
+ WHILE i >= 0 DO d[i] := CHR( h MOD 10 + ORD( "0" ) ); h := h DIV 10; DEC( i ) END;
|
|
|
+ IF n <= e THEN n := e + 1 END;
|
|
|
+ IF e > 0 THEN
|
|
|
+ WHILE n > e DO Char( " " ); DEC( n ) END;
|
|
|
+ Char( s ); e := 0;
|
|
|
+ WHILE n > 0 DO
|
|
|
+ DEC( n );
|
|
|
+ IF e < 16 THEN Char( d[e] ); INC( e ) ELSE Char( "0" ) END
|
|
|
+ END;
|
|
|
+ IF dot THEN
|
|
|
+ Char( "." )
|
|
|
+ END;
|
|
|
+ ELSE
|
|
|
+ WHILE n > 1 DO Char( " " ); DEC( n ) END;
|
|
|
+ Char( s ); Char( "0" ); IF dot THEN Char( "." ); END;
|
|
|
+ WHILE (0 < f) & (e < 0) DO Char( "0" ); DEC( f ); INC( e ) END
|
|
|
+ END;
|
|
|
+ WHILE f > 0 DO
|
|
|
+ DEC( f );
|
|
|
+ IF e < 16 THEN Char( d[e] ); INC( e ) ELSE Char( "0" ) END
|
|
|
+ END;
|
|
|
+ IF D # 0 THEN
|
|
|
+ IF D < 0 THEN String( "E-" ); D := -D ELSE String( "E+" ) END;
|
|
|
+ Char( CHR( D DIV 100 + ORD( "0" ) ) ); D := D MOD 100; Char( CHR( D DIV 10 + ORD( "0" ) ) ); Char( CHR( D MOD 10 + ORD( "0" ) ) )
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END FloatFix;
|
|
|
+
|
|
|
+ END Writer;
|
|
|
+
|
|
|
+ (** A special writer that buffers output to be fetched by GetString or GetRawString. *)
|
|
|
+ StringWriter* = OBJECT (Writer)
|
|
|
+
|
|
|
+ PROCEDURE & InitStringWriter*( size: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ InitWriter( Send, size )
|
|
|
+ END InitStringWriter;
|
|
|
+
|
|
|
+ PROCEDURE Send( CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ res := StringFull
|
|
|
+ END Send;
|
|
|
+
|
|
|
+ PROCEDURE CanSetPos*( ): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ RETURN TRUE;
|
|
|
+ END CanSetPos;
|
|
|
+
|
|
|
+ (* Set the position for the writer *)
|
|
|
+ PROCEDURE SetPos*( pos: HUGEINT );
|
|
|
+ BEGIN
|
|
|
+ IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
|
|
|
+ tail := LONGINT( pos ); sent := 0; res := Ok;
|
|
|
+ END SetPos;
|
|
|
+
|
|
|
+ PROCEDURE Update;
|
|
|
+ (* nothing to do *)
|
|
|
+ END Update;
|
|
|
+
|
|
|
+ (** Return the contents of the string writer (0X-terminated). *)
|
|
|
+ PROCEDURE Get*( VAR s: ARRAY OF CHAR );
|
|
|
+ VAR i, m: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ m := LEN( s ) - 1; i := 0;
|
|
|
+ WHILE (i # tail) & (i < m) DO s[i] := buf[i]; INC( i ) END;
|
|
|
+ s[i] := 0X; tail := 0; res := Ok
|
|
|
+ END Get;
|
|
|
+
|
|
|
+ (** Return the contents of the string writer (not 0X-terminated). The len parameters returns the string length. *)
|
|
|
+ PROCEDURE GetRaw*( VAR s: ARRAY OF CHAR; VAR len: LONGINT );
|
|
|
+ VAR i, m: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ m := LEN( s ); i := 0;
|
|
|
+ WHILE (i # tail) & (i < m) DO s[i] := buf[i]; INC( i ) END;
|
|
|
+ len := i; tail := 0; res := Ok
|
|
|
+ END GetRaw;
|
|
|
+
|
|
|
+ END StringWriter;
|
|
|
+
|
|
|
+TYPE
|
|
|
+ (** A reader buffers input received from a Receiver. Must not be shared between processes. *)
|
|
|
+ Reader* = OBJECT
|
|
|
+ VAR
|
|
|
+ head, tail: LONGINT;
|
|
|
+ buf: POINTER TO ARRAY OF CHAR;
|
|
|
+ res*: LONGINT; (** result of last input operation. *)
|
|
|
+ receive: Receiver;
|
|
|
+ received*: HUGEINT; (** count of received bytes *)
|
|
|
+ (* buf[buf.head..buf.tail-1] contains data to read. *)
|
|
|
+
|
|
|
+ PROCEDURE & InitReader*( receive: Receiver; size: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ ASSERT ( receive # NIL );
|
|
|
+ IF (buf = NIL) OR (LEN(buf) # size) THEN
|
|
|
+ NEW( buf, size );
|
|
|
+ END;
|
|
|
+ SELF.receive := receive; Reset
|
|
|
+ END InitReader;
|
|
|
+
|
|
|
+ (** reset the reader by dropping the bytes in the buffer, resetting the result code and setting received to 0.
|
|
|
+ This is used by seekable extensions of the reader *)
|
|
|
+ PROCEDURE Reset*;
|
|
|
+ BEGIN
|
|
|
+ head := 0; tail := 0; res := Ok; received := 0
|
|
|
+ END Reset;
|
|
|
+
|
|
|
+ PROCEDURE CanSetPos*( ): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ RETURN FALSE
|
|
|
+ END CanSetPos;
|
|
|
+
|
|
|
+ PROCEDURE SetPos*( pos: HUGEINT );
|
|
|
+ BEGIN
|
|
|
+ HALT( 1234 )
|
|
|
+ END SetPos;
|
|
|
+
|
|
|
+ (** Return bytes currently available in input buffer. *)
|
|
|
+ PROCEDURE Available*( ): LONGINT;
|
|
|
+ VAR n: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ IF (res = Ok) THEN
|
|
|
+ IF (head = tail) THEN head := 0; receive( buf^, 0, LEN( buf ), 0, tail, res ); INC( received, tail );
|
|
|
+ ELSIF (tail # LEN( buf )) THEN
|
|
|
+ receive( buf^, tail, LEN( buf ) - tail, 0, n, res ); (* poll *)
|
|
|
+ INC( tail, n ); INC( received, n )
|
|
|
+ END;
|
|
|
+ IF res = EOF THEN res := Ok END (* ignore EOF here *)
|
|
|
+ END;
|
|
|
+ RETURN tail - head
|
|
|
+ END Available;
|
|
|
+
|
|
|
+ (** Current read position. *)
|
|
|
+ PROCEDURE Pos*( ): HUGEINT;
|
|
|
+ BEGIN
|
|
|
+ RETURN received - HUGEINT(tail) - HUGEINT(head)
|
|
|
+ END Pos;
|
|
|
+
|
|
|
+ (** -- Read raw binary data -- *)
|
|
|
+
|
|
|
+ (** Read one byte. x=0X if no success (e.g. file ended) *)
|
|
|
+ PROCEDURE Char*( VAR x: CHAR );
|
|
|
+ BEGIN
|
|
|
+ IF (head = tail) & (res = Ok) THEN head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail ) END;
|
|
|
+ IF res = Ok THEN x := buf[head]; INC( head ) ELSE x := 0X END
|
|
|
+ END Char;
|
|
|
+
|
|
|
+ (** Like Read, but return result. Return 0X if no success (e.g. file ended) *)
|
|
|
+ PROCEDURE Get*( ): CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF (head = tail) & (res = Ok) THEN head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail ) END;
|
|
|
+ IF res = Ok THEN INC( head ); RETURN buf[head - 1] ELSE RETURN 0X END
|
|
|
+ END Get;
|
|
|
+
|
|
|
+ (** Like Get, but leave the byte in the input buffer. *)
|
|
|
+ PROCEDURE Peek*( ): CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF (head = tail) & (res = Ok) THEN
|
|
|
+ head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail );
|
|
|
+ IF res = EOF THEN (* ignore EOF here *)
|
|
|
+ res := Ok; tail := 0; RETURN 0X (* Peek returns 0X at eof *)
|
|
|
+ END
|
|
|
+ END;
|
|
|
+ IF res = Ok THEN RETURN buf[head] ELSE RETURN 0X END
|
|
|
+ END Peek;
|
|
|
+
|
|
|
+ (** Read size bytes into x, starting at ofs. The len parameter returns the number of bytes that were actually read. *)
|
|
|
+ PROCEDURE Bytes*( VAR x: ARRAY OF CHAR; ofs, size: LONGINT; VAR len: LONGINT );
|
|
|
+ VAR n: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ ASSERT ( size >= 0 );
|
|
|
+ len := 0;
|
|
|
+ LOOP
|
|
|
+ n := tail - head; (* bytes available *)
|
|
|
+ IF n = 0 THEN (* no data available *)
|
|
|
+ head := 0;
|
|
|
+ IF res = Ok THEN (* fill buffer *)
|
|
|
+ receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail )
|
|
|
+ END;
|
|
|
+ IF res # Ok THEN (* should not be reading from erroneous rider *)
|
|
|
+ WHILE size # 0 DO x[ofs] := 0X; INC( ofs ); DEC( size ) END; (* clear rest of buffer *)
|
|
|
+ IF (res = EOF) & (len # 0) THEN res := Ok END; (* ignore EOF if some data being returned *)
|
|
|
+ EXIT
|
|
|
+ END;
|
|
|
+ n := tail
|
|
|
+ END;
|
|
|
+ IF n > size THEN n := size END;
|
|
|
+ ASSERT ( ofs + n <= LEN( x ) ); (* index check *)
|
|
|
+ SYSTEM.MOVE( ADDRESSOF( buf[head] ), ADDRESSOF( x[ofs] ), n ); INC( head, n ); INC( len, n );
|
|
|
+ IF size = n THEN EXIT END; (* done *)
|
|
|
+ INC( ofs, n ); DEC( size, n )
|
|
|
+ END
|
|
|
+ END Bytes;
|
|
|
+
|
|
|
+ (** Skip n bytes on the reader. *)
|
|
|
+ PROCEDURE SkipBytes*( n: LONGINT );
|
|
|
+ VAR ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ WHILE n > 0 DO ch := Get(); DEC( n ) END
|
|
|
+ END SkipBytes;
|
|
|
+
|
|
|
+ (** Read a SHORTINT. *)
|
|
|
+ PROCEDURE RawSInt*( VAR x: SHORTINT );
|
|
|
+ BEGIN
|
|
|
+ x := SYSTEM.VAL( SHORTINT, Get() )
|
|
|
+ END RawSInt;
|
|
|
+
|
|
|
+ (** Read an INTEGER. *)
|
|
|
+ PROCEDURE RawInt*( VAR x: INTEGER );
|
|
|
+ VAR x0, x1: CHAR;
|
|
|
+ BEGIN
|
|
|
+ x0 := Get(); x1 := Get(); (* defined order *)
|
|
|
+ x := ORD( x1 ) * 100H + ORD( x0 )
|
|
|
+ END RawInt;
|
|
|
+
|
|
|
+ (** Read a LONGINT. *)
|
|
|
+ PROCEDURE RawLInt*( VAR x: LONGINT );
|
|
|
+ VAR ignore: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
|
|
|
+ END RawLInt;
|
|
|
+
|
|
|
+ (** Read a HUGEINT. *)
|
|
|
+ PROCEDURE RawHInt*( VAR x: HUGEINT );
|
|
|
+ VAR ignore: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
|
|
|
+ END RawHInt;
|
|
|
+
|
|
|
+ (** Read a 64 bit value in network byte order (most significant byte first) *)
|
|
|
+ PROCEDURE Net64*( ): HUGEINT;
|
|
|
+ BEGIN
|
|
|
+ RETURN Net32() * 100000000H + Net32()
|
|
|
+ END Net64;
|
|
|
+
|
|
|
+ (** Read a 32 bit value in network byte order (most significant byte first) *)
|
|
|
+ PROCEDURE Net32*( ): LONGINT;
|
|
|
+ BEGIN
|
|
|
+ RETURN LONG( ORD( Get() ) ) * 1000000H + LONG( ORD( Get() ) ) * 10000H + LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
|
|
|
+ END Net32;
|
|
|
+
|
|
|
+ (** Read an unsigned 16bit value in network byte order (most significant byte first) *)
|
|
|
+ PROCEDURE Net16*( ): LONGINT;
|
|
|
+ BEGIN
|
|
|
+ RETURN LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
|
|
|
+ END Net16;
|
|
|
+
|
|
|
+ (** Read an unsigned byte *)
|
|
|
+ PROCEDURE Net8*( ): LONGINT;
|
|
|
+ BEGIN
|
|
|
+ RETURN LONG( ORD( Get() ) )
|
|
|
+ END Net8;
|
|
|
+
|
|
|
+ (** Read a SET. *)
|
|
|
+ PROCEDURE RawSet*( VAR x: SET );
|
|
|
+ VAR ignore: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
|
|
|
+ END RawSet;
|
|
|
+
|
|
|
+ (** Read a BOOLEAN. *)
|
|
|
+ PROCEDURE RawBool*( VAR x: BOOLEAN );
|
|
|
+ BEGIN
|
|
|
+ x := (Get() # 0X)
|
|
|
+ END RawBool;
|
|
|
+
|
|
|
+ (** Read a REAL. *)
|
|
|
+ PROCEDURE RawReal*( VAR x: REAL );
|
|
|
+ VAR ignore: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
|
|
|
+ END RawReal;
|
|
|
+
|
|
|
+ (** Read a LONGREAL. *)
|
|
|
+ PROCEDURE RawLReal*( VAR x: LONGREAL );
|
|
|
+ VAR ignore: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
|
|
|
+ END RawLReal;
|
|
|
+
|
|
|
+ (** Read a 0X-terminated string. If the input string is larger than x, read the full string and assign the truncated 0X-terminated value to x. *)
|
|
|
+ PROCEDURE RawString*( VAR x: ARRAY OF CHAR );
|
|
|
+ VAR i, m: LONGINT; ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ i := 0; m := LEN( x ) - 1;
|
|
|
+ LOOP
|
|
|
+ ch := Get(); (* also returns 0X on error *)
|
|
|
+ IF ch = 0X THEN EXIT END;
|
|
|
+ IF i < m THEN x[i] := ch; INC( i ) END
|
|
|
+ END;
|
|
|
+ x[i] := 0X
|
|
|
+ END RawString;
|
|
|
+
|
|
|
+ (** Read a number in a compressed format. *)
|
|
|
+ PROCEDURE RawNum*( VAR x: LONGINT );
|
|
|
+ VAR ch: CHAR; n, y: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ n := 0; y := 0; ch := Get();
|
|
|
+ WHILE ch >= 80X DO INC( y, LSH( LONGINT( ORD( ch ) ) - 128, n ) ); INC( n, 7 ); ch := Get() END;
|
|
|
+ x := ASH( LSH( LONGINT( ORD( ch ) ), 25 ), n - 25 ) + y
|
|
|
+ END RawNum;
|
|
|
+
|
|
|
+ (** -- Read formatted data (uses Peek for one character lookahead) -- *)
|
|
|
+
|
|
|
+ (** Read an integer value in decimal or hexadecimal. If hex = TRUE, recognize the "H" postfix for hexadecimal numbers. *)
|
|
|
+
|
|
|
+ PROCEDURE Int*( VAR x: LONGINT; hex: BOOLEAN );
|
|
|
+ VAR vd, vh, sgn, d: LONGINT; ch: CHAR; ok: BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ vd := 0; vh := 0; sgn := 1; ok := FALSE;
|
|
|
+ IF Peek() = "-" THEN sgn := -1; ch := Get() END;
|
|
|
+ LOOP
|
|
|
+ ch := Peek();
|
|
|
+ IF (ch >= "0") & (ch <= "9") THEN d := ORD( ch ) - ORD( "0" )
|
|
|
+ ELSIF hex & (CAP( ch ) >= "A") & (CAP( ch ) <= "F") THEN d := ORD( CAP( ch ) ) - ORD( "A" ) + 10
|
|
|
+ ELSE EXIT
|
|
|
+ END;
|
|
|
+ vd := 10 * vd + d; vh := 16 * vh + d; (* ignore overflow *)
|
|
|
+ ch := Get(); ok := TRUE
|
|
|
+ END;
|
|
|
+ IF hex & (CAP( ch ) = "H") THEN (* optional "H" present *)
|
|
|
+ vd := vh; (* use the hex value *)
|
|
|
+ ch := Get()
|
|
|
+ END;
|
|
|
+ x := sgn * vd;
|
|
|
+ IF (res = 0) & ~ok THEN res := FormatError END
|
|
|
+ END Int;
|
|
|
+
|
|
|
+ (** Read a floating-point number. EBNF: Real = Digit {Digit} '.' Digit {Digit} ['e'|'E' ['+'|'-'] Digit {Digit}]. *)
|
|
|
+ PROCEDURE Real* (VAR real: LONGREAL);
|
|
|
+ VAR e: INTEGER; y, g: LONGREAL; neg, negE: BOOLEAN; ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ ch := Get();
|
|
|
+ WHILE (ch = "0") DO ch := Get() END;
|
|
|
+ IF ch = "-" THEN neg := TRUE; ch := Get(); ELSE neg := FALSE END;
|
|
|
+ WHILE (ch = " ") OR (ch = "0") DO ch := Get(); END;
|
|
|
+ y := 0;
|
|
|
+ WHILE ("0" <= ch) & (ch <= "9") DO
|
|
|
+ y := y * 10 + (ORD(ch) - ORD("0"));
|
|
|
+ ch := Get();
|
|
|
+ END;
|
|
|
+ IF ch = "." THEN
|
|
|
+ ch := Get();
|
|
|
+ g := 1;
|
|
|
+ WHILE ("0" <= ch) & (ch <= "9") DO
|
|
|
+ g := g / 10; y := y + g * (ORD(ch) - ORD("0"));
|
|
|
+ ch := Get();
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ IF (ch = "d") OR (ch = "D") OR (ch = "e") OR (ch = "E") THEN
|
|
|
+ ch := Get(); e := 0;
|
|
|
+ IF ch = "-" THEN negE := TRUE; ch := Get()
|
|
|
+ ELSIF ch = "+" THEN negE := FALSE; ch := Get()
|
|
|
+ ELSE negE := FALSE
|
|
|
+ END;
|
|
|
+ WHILE (ch = "0") DO ch := Get() END;
|
|
|
+ WHILE ("0" <= ch) & (ch <= "9") DO
|
|
|
+ e := e * 10 + (ORD(ch) - ORD("0"));
|
|
|
+ ch := Get();
|
|
|
+ END;
|
|
|
+ IF negE THEN y := y / Ten(e)
|
|
|
+ ELSE y := y * Ten(e)
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ IF neg THEN y := -y END;
|
|
|
+ real := y
|
|
|
+ END Real;
|
|
|
+
|
|
|
+ (** Return TRUE iff at the end of a line (or file). *)
|
|
|
+ PROCEDURE EOLN*( ): BOOLEAN;
|
|
|
+ VAR ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ ch := Peek(); RETURN (ch = CR) OR (ch = LF) OR (res # Ok)
|
|
|
+ END EOLN;
|
|
|
+
|
|
|
+ (** Read all characters until the end of the line (inclusive). If the input string is larger than x, read the full string and assign
|
|
|
+ the truncated 0X-terminated value to x. *)
|
|
|
+ PROCEDURE Ln*( VAR x: ARRAY OF CHAR );
|
|
|
+ VAR i, m: LONGINT; ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ i := 0; m := LEN( x ) - 1;
|
|
|
+ LOOP
|
|
|
+ ch := Peek();
|
|
|
+ IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
|
|
|
+ IF i < m THEN x[i] := ch; INC( i ) END;
|
|
|
+ ch := Get()
|
|
|
+ END;
|
|
|
+ x[i] := 0X;
|
|
|
+ IF ch = CR THEN ch := Get() END;
|
|
|
+ IF Peek() = LF THEN ch := Get() END
|
|
|
+ END Ln;
|
|
|
+
|
|
|
+ (** Read all characters until the end of the line (inclusive) or an <EOT> character.
|
|
|
+ If the input string is larger than x, read the full string and assign the truncated 0X-terminated
|
|
|
+ value to x. *)
|
|
|
+ PROCEDURE LnEOT*( VAR x: ARRAY OF CHAR );
|
|
|
+ VAR i, m: LONGINT; ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ i := 0; m := LEN( x ) - 1;
|
|
|
+ LOOP
|
|
|
+ ch := Peek();
|
|
|
+ IF (ch = CR) OR (ch = LF) OR (ch = EOT) OR (res # Ok) THEN EXIT END;
|
|
|
+ IF i < m THEN x[i] := ch; INC( i ) END;
|
|
|
+ ch := Get()
|
|
|
+ END;
|
|
|
+ x[i] := 0X;
|
|
|
+ IF ch = CR THEN ch := Get() END;
|
|
|
+ IF Peek() = LF THEN ch := Get() END;
|
|
|
+ IF ch = EOT THEN ch := Get() END
|
|
|
+ END LnEOT;
|
|
|
+
|
|
|
+ (** Skip over all characters until the end of the line (inclusive). *)
|
|
|
+ PROCEDURE SkipLn*;
|
|
|
+ VAR ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ LOOP
|
|
|
+ ch := Peek();
|
|
|
+ IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
|
|
|
+ ch := Get()
|
|
|
+ END;
|
|
|
+ IF ch = CR THEN ch := Get() END;
|
|
|
+ IF Peek() = LF THEN ch := Get() END
|
|
|
+ END SkipLn;
|
|
|
+
|
|
|
+ (** Skip over space and TAB characters. *)
|
|
|
+ PROCEDURE SkipSpaces*;
|
|
|
+ VAR ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ LOOP
|
|
|
+ ch := Peek();
|
|
|
+ IF (ch # TAB) & (ch # SP) THEN EXIT END;
|
|
|
+ ch := Get()
|
|
|
+ END
|
|
|
+ END SkipSpaces;
|
|
|
+
|
|
|
+ (** Skip over space, TAB and EOLN characters. *)
|
|
|
+ PROCEDURE SkipWhitespace*;
|
|
|
+ VAR ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ LOOP
|
|
|
+ ch := Peek();
|
|
|
+ IF (ch # SP) & (ch # CR) & (ch # LF) & (ch # TAB) THEN EXIT END;
|
|
|
+ ch := Get()
|
|
|
+ END
|
|
|
+ END SkipWhitespace;
|
|
|
+
|
|
|
+ (** Read a token, consisting of any string of characters terminated by space, TAB or EOLN. *)
|
|
|
+ PROCEDURE Token*( VAR token: ARRAY OF CHAR );
|
|
|
+ VAR j, max: LONGINT; ch: CHAR;
|
|
|
+ BEGIN
|
|
|
+ j := 0; max := LEN( token ) - 1;
|
|
|
+ LOOP
|
|
|
+ ch := Peek();
|
|
|
+ IF (ch = SP) OR (ch = CR) OR (ch = LF) OR (ch = TAB) OR (res # Ok) THEN EXIT END;
|
|
|
+ IF j < max THEN token[j] := ch; INC( j ) END;
|
|
|
+ ch := Get()
|
|
|
+ END;
|
|
|
+ token[j] := 0X
|
|
|
+ END Token;
|
|
|
+
|
|
|
+ (** Read an optionally "" or '' enquoted string. Will not read past the end of a line. *)
|
|
|
+ PROCEDURE String*( VAR string: ARRAY OF CHAR );
|
|
|
+ VAR c, delimiter: CHAR; i, len: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ c := Peek();
|
|
|
+ IF (c # "'") & (c # '"') THEN Token( string )
|
|
|
+ ELSE
|
|
|
+ delimiter := Get(); c := Peek(); i := 0; len := LEN( string ) - 1;
|
|
|
+ WHILE (i < len) & (c # delimiter) & (c # CR) & (c # LF) & (res = Ok) DO string[i] := Get(); INC( i ); c := Peek() END;
|
|
|
+ IF (c = delimiter) THEN c := Get() END;
|
|
|
+ string[i] := 0X
|
|
|
+ END
|
|
|
+ END String;
|
|
|
+
|
|
|
+ (** First skip whitespace, then read string *)
|
|
|
+ PROCEDURE GetString*(VAR string : ARRAY OF CHAR): BOOLEAN;
|
|
|
+ VAR c: CHAR;
|
|
|
+ BEGIN
|
|
|
+ SkipWhitespace;
|
|
|
+ c := Peek();
|
|
|
+ String(string);
|
|
|
+ RETURN (string[0] # 0X) OR (c = "'") OR (c = '"');
|
|
|
+ END GetString;
|
|
|
+
|
|
|
+ (** First skip whitespace, then read integer *)
|
|
|
+ PROCEDURE GetInteger*(VAR integer : LONGINT; isHexadecimal : BOOLEAN): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ SkipWhitespace;
|
|
|
+ Int(integer, isHexadecimal);
|
|
|
+ RETURN res = Ok;
|
|
|
+ END GetInteger;
|
|
|
+
|
|
|
+ (** First skip whitespace, then read a real *)
|
|
|
+ PROCEDURE GetReal*(VAR real: LONGREAL): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ SkipWhitespace;
|
|
|
+ Real(real);
|
|
|
+ RETURN res = Ok
|
|
|
+ END GetReal;
|
|
|
+
|
|
|
+ (** First skip whitespace, then read 1 byte character *)
|
|
|
+ PROCEDURE GetChar*(VAR ch : CHAR): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ SkipWhitespace;
|
|
|
+ Char(ch);
|
|
|
+ RETURN ch # 0X;
|
|
|
+ END GetChar;
|
|
|
+
|
|
|
+ END Reader;
|
|
|
+
|
|
|
+TYPE
|
|
|
+ (** A special reader that buffers input set by SetString or SetRawString. *)
|
|
|
+ StringReader* = OBJECT (Reader)
|
|
|
+
|
|
|
+ PROCEDURE & InitStringReader*( size: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ InitReader( Receive, size )
|
|
|
+ END InitStringReader;
|
|
|
+
|
|
|
+ PROCEDURE CanSetPos*( ): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ RETURN TRUE
|
|
|
+ END CanSetPos;
|
|
|
+
|
|
|
+ (** Set the reader position *)
|
|
|
+ PROCEDURE SetPos*( pos: HUGEINT );
|
|
|
+ BEGIN
|
|
|
+ IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
|
|
|
+ head := LONGINT( pos ); tail := LEN( buf ); received := LEN( buf ); res := Ok;
|
|
|
+ END SetPos;
|
|
|
+
|
|
|
+ PROCEDURE Receive( VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ IF min = 0 THEN res := Ok ELSE res := EOF END;
|
|
|
+ len := 0;
|
|
|
+ END Receive;
|
|
|
+
|
|
|
+ (** Set the contents of the string buffer. The s parameter is a 0X-terminated string. *)
|
|
|
+ PROCEDURE Set*(CONST s: ARRAY OF CHAR );
|
|
|
+ VAR len: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ len := 0;
|
|
|
+ WHILE s[len] # 0X DO INC( len ) END;
|
|
|
+ IF len > LEN( buf ) THEN len := LEN( buf ) END;
|
|
|
+ head := 0; tail := len; received := len; res := Ok;
|
|
|
+ IF len > 0 THEN
|
|
|
+ SYSTEM.MOVE( ADDRESSOF( s[0] ), ADDRESSOF( buf[0] ), len )
|
|
|
+ END;
|
|
|
+ END Set;
|
|
|
+
|
|
|
+ (** Set the contents of the string buffer. The len parameter specifies the size of the buffer s. *)
|
|
|
+ PROCEDURE SetRaw*(CONST s: ARRAY OF CHAR; ofs, len: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ IF len > LEN( buf ) THEN len := LEN( buf ) END;
|
|
|
+ head := 0; tail := len; received := len; res := Ok;
|
|
|
+ ASSERT ( (len >= 0) & (ofs + len <= LEN( s )) ); (* index check *)
|
|
|
+ IF len > 0 THEN
|
|
|
+ SYSTEM.MOVE( ADDRESSOF( s[ofs] ), ADDRESSOF( buf[0] ), len )
|
|
|
+ END;
|
|
|
+ END SetRaw;
|
|
|
+
|
|
|
+ END StringReader;
|
|
|
+
|
|
|
+ Bytes2 = ARRAY 2 OF CHAR;
|
|
|
+ Bytes4 = ARRAY 4 OF CHAR;
|
|
|
+ Bytes8 = ARRAY 8 OF CHAR;
|
|
|
+
|
|
|
+VAR
|
|
|
+ months: ARRAY 12 * 4 + 1 OF CHAR;
|
|
|
+
|
|
|
+
|
|
|
+ (** Open a writer to the specified stream sender. Update must be called after writing to ensure the buffer is written to the stream. *)
|
|
|
+ PROCEDURE OpenWriter*( VAR b: Writer; send: Sender );
|
|
|
+ BEGIN
|
|
|
+ NEW( b, send, DefaultWriterSize )
|
|
|
+ END OpenWriter;
|
|
|
+
|
|
|
+(** Open a reader from the specified stream receiver. *)
|
|
|
+ PROCEDURE OpenReader*( VAR b: Reader; receive: Receiver );
|
|
|
+ BEGIN
|
|
|
+ NEW( b, receive, DefaultReaderSize )
|
|
|
+ END OpenReader;
|
|
|
+
|
|
|
+(** Copy the contents of a reader to a writer *)
|
|
|
+ PROCEDURE Copy* (r: Reader; w: Writer);
|
|
|
+ VAR char: CHAR;
|
|
|
+ BEGIN
|
|
|
+ WHILE r.res = Ok DO
|
|
|
+ r.Char (char);
|
|
|
+ IF r.res = Ok THEN w.Char (char) END
|
|
|
+ END;
|
|
|
+ END Copy;
|
|
|
+
|
|
|
+ (** from module Reals.Mod *)
|
|
|
+
|
|
|
+
|
|
|
+(*** the following procedures stem from Reals.Mod and are needed for Writer.Float and Writer.FloatFix *)
|
|
|
+
|
|
|
+(** Returns the NaN code (0 <= h < 1048576, MIN(LONGINT) <= l <= MAX(LONGINT)) or (-1,-1) if not NaN/Infinite. *)
|
|
|
+ PROCEDURE NaNCodeL( x: LONGREAL; VAR h, l: LONGINT );
|
|
|
+ BEGIN
|
|
|
+ SYSTEM.GET( ADDRESSOF( x ) + H, h ); SYSTEM.GET( ADDRESSOF( x ) + L, l );
|
|
|
+ IF ASH( h, -20 ) MOD 2048 = 2047 THEN (* Infinite or NaN *)
|
|
|
+ h := h MOD 100000H (* lowest 20 bits *)
|
|
|
+ ELSE h := -1; l := -1
|
|
|
+ END
|
|
|
+ END NaNCodeL;
|
|
|
+
|
|
|
+(** Returns the shifted binary exponent (0 <= e < 2048). *)
|
|
|
+ PROCEDURE ExpoL( x: LONGREAL ): LONGINT;
|
|
|
+ VAR i: LONGINT;
|
|
|
+ BEGIN
|
|
|
+ SYSTEM.GET( ADDRESSOF( x ) + H, i ); RETURN ASH( i, -20 ) MOD 2048
|
|
|
+ END ExpoL;
|
|
|
+
|
|
|
+(** Convert hexadecimal to LONGREAL. h and l are the high and low parts.*)
|
|
|
+ PROCEDURE RealL( h, l: LONGINT ): LONGREAL;
|
|
|
+ VAR x: LONGREAL;
|
|
|
+ BEGIN
|
|
|
+ SYSTEM.PUT( ADDRESSOF( x ) + H, h ); SYSTEM.PUT( ADDRESSOF( x ) + L, l ); RETURN x
|
|
|
+ END RealL;
|
|
|
+
|
|
|
+(** Returns 10^e (e <= 308, 308 < e delivers IEEE-code +INF). *)
|
|
|
+ PROCEDURE Ten( e: LONGINT ): LONGREAL; (* naiive version *)
|
|
|
+ VAR r: LONGREAL;
|
|
|
+ BEGIN
|
|
|
+ IF e < -307 THEN RETURN 0
|
|
|
+ ELSIF 308 < e THEN RETURN RealL( 2146435072, 0 )
|
|
|
+ END;
|
|
|
+ r := 1;
|
|
|
+ WHILE (e > 0) DO r := r * 10; DEC( e ); END;
|
|
|
+ WHILE (e < 0) DO r := r / 10; INC( e ); END;
|
|
|
+ RETURN r;
|
|
|
+ END Ten;
|
|
|
+
|
|
|
+ PROCEDURE InitHL;
|
|
|
+ VAR i: ADDRESS; dmy: INTEGER; littleEndian: BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ dmy := 1; i := ADDRESSOF( dmy );
|
|
|
+ SYSTEM.GET( i, littleEndian ); (* indirection via i avoids warning on SUN cc -O *)
|
|
|
+ IF littleEndian THEN H := 4; L := 0 ELSE H := 0; L := 4 END
|
|
|
+ END InitHL;
|
|
|
+
|
|
|
+
|
|
|
+BEGIN
|
|
|
+ months := " Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"; InitHL;
|
|
|
+END Streams64.
|
|
|
+
|
|
|
+(**
|
|
|
+Notes:
|
|
|
+o Any single buffer instance must not be accessed by more than one process concurrently.
|
|
|
+o The interface is blocking (synchronous). If an output buffer is full, it is written with a synchronous write, which returns
|
|
|
+ only when all the data has been written. If an input buffer is empty, it is read with a synchronous read, which only returns
|
|
|
+ once some data has been read. The only exception is the Available() procedure, which "peeks" at the input stream
|
|
|
+ and returns 0 if no data is currently available.
|
|
|
+o All procedures set res to the error code reported by the lower-level I/O operation (non-zero indicates error).
|
|
|
+ E.g. closing an underlying TCP connection will result in the Read* procedures returning a non-zero error code.
|
|
|
+o res is sticky. Once it becomes non-zero, it remains non-zero.
|
|
|
+o The only way to detect end of file is to attempt to read past the end of file, which returns a non-zero error code.
|
|
|
+o All output written to an erroneous buffer is ignored.
|
|
|
+o The value returned when reading from an erroneous buffer is undefined, except for the Read procedure, which returns 0X.
|
|
|
+o ReadBytes sets the len parameter to the number of bytes that were actually read, e.g. if size = 10, and only 8 bytes are read, len is 8.
|
|
|
+o Raw format is little-endian 2's complement integers, IEEE reals and 0X-terminated strings.
|
|
|
+o Syntax for ReadInt with hex = FALSE: num = ["-"] digit {digit}. digit = "0".."9".
|
|
|
+o Syntax for ReadInt with hex = TRUE: ["-"] hexdigit {hexdigit} ["H"|"h"]. hexdigit = digit | "A".."F" | "a".."f".
|
|
|
+o ReadInt with hex = TRUE allows "A".."F" as digits, and looks for a "H" character after the number.
|
|
|
+ If present, the number is interpreted as hexadecimal. If hexadecimal digits are present, but no "H" flag,
|
|
|
+ the resulting decimal value is undefined.
|
|
|
+o ReadInt ignores overflow.
|
|
|
+o A Sender sends len bytes from buf at ofs to output and returns res non-zero on error. It waits until all the data is written,
|
|
|
+ or an error occurs.
|
|
|
+o A Receiver receives up to size bytes from input into buf at ofs and returns the number of bytes read in len.
|
|
|
+ It returns res non-zero on error. It waits until at least min bytes (possibly zero) are available, or an error occurs.
|
|
|
+o EOLN and ReadLn recognize the following end-of-line characters: CR, LF and CR/LF.
|
|
|
+o To read an unstructured file token-by-token: WHILE (r.res = 0) DO SkipWhitespace; ReadToken END
|
|
|
+o To read a line structured file token-by-token: WHILE r.res = 0 DO SkipSpaces; WHILE ~EOLN DO ReadToken; SkipSpaces END END
|
|
|
+o A string writer is not flushed when it becomes full, but res is set to a non-zero value.
|
|
|
+o Update has no effect on a string writer.
|
|
|
+o GetString can be called on a string writer to return the buffer contents and reset it to empty.
|
|
|
+o GetString always appends a 0X character to the buffer, but returns the true length (excluding the added 0X) in the len parameter,
|
|
|
+ so it can also be used for binary data that includes 0X characters.
|
|
|
+o Receive procedure should set res to EOF when attempting to read past the end of file.
|
|
|
+*)
|
|
|
+
|
|
|
+
|
|
|
+(*
|
|
|
+to do:
|
|
|
+o stream byte count
|
|
|
+o read formatted data
|
|
|
+o reads for all formatted writes
|
|
|
+o write reals
|
|
|
+o low-level version that can be used in kernel (below KernelLog)
|
|
|
+*)
|
eth.metacore