Streams64.Mod 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992
  1. (* Aos, Copyright 2001, Pieter Muller, ETH Zurich *)
  2. MODULE Streams64; (** AUTHOR "pjm/be"; PURPOSE "I/O buffering and formatted writing and reading"; *)
  3. IMPORT SYSTEM, RC := RealConversions;
  4. CONST
  5. Ok* = 0; (** zero result code means no error occurred *)
  6. EOF* = 4201; (** error returned when Receive reads past end of file or stream *)
  7. EOT* = 1AX; (** EOT character *)
  8. StringFull = 4202;
  9. FormatError* = 4203; (** error returned when ReadInt fails *)
  10. DefaultWriterSize* = 4096;
  11. DefaultReaderSize* = 4096;
  12. Invalid* = -1; (** invalid stream position *)
  13. CONST
  14. CR = 0DX; LF = 0AX; TAB = 9X; SP = 20X;
  15. TYPE
  16. BufferOffset* = LONGWORD; (* offset in the stream biffer *)
  17. TYPE
  18. Position* = HUGEINT; (* position in the stream *)
  19. StreamSize* = HUGEINT; (* size of the stream *)
  20. (** Any stream output procedure or method. *)
  21. Sender* = PROCEDURE {DELEGATE} ( CONST buf: ARRAY OF CHAR; ofs, len: BufferOffset; propagate: BOOLEAN; VAR res: WORD );
  22. (** Any stream input procedure or method. *)
  23. Receiver* = PROCEDURE {DELEGATE} ( VAR buf: ARRAY OF CHAR; ofs, size, min: BufferOffset; VAR len: BufferOffset; VAR res: WORD );
  24. Connection* = OBJECT
  25. PROCEDURE Send*( CONST data: ARRAY OF CHAR; ofs, len: BufferOffset; propagate: BOOLEAN; VAR res: WORD );
  26. END Send;
  27. PROCEDURE Receive*( VAR data: ARRAY OF CHAR; ofs, size, min: BufferOffset; VAR len: BufferOffset; VAR res: WORD );
  28. END Receive;
  29. PROCEDURE Close*;
  30. END Close;
  31. END Connection;
  32. TYPE
  33. (** A writer buffers output before it is sent to a Sender. Must not be shared between processes. *)
  34. Writer* = OBJECT
  35. VAR
  36. tail: BufferOffset;
  37. buf: POINTER TO ARRAY OF CHAR;
  38. res*: WORD; (** result of last output operation. *)
  39. send: Sender;
  40. sent*: Position; (** count of sent bytes *)
  41. (* buf[0..tail-1] contains data to write. *)
  42. PROCEDURE & InitWriter*( send: Sender; size: BufferOffset );
  43. BEGIN
  44. ASSERT ( send # NIL );
  45. IF (buf = NIL) OR (LEN(buf) # size) THEN
  46. NEW( buf, size );
  47. END;
  48. SELF.send := send; Reset
  49. END InitWriter;
  50. PROCEDURE Reset*;
  51. BEGIN
  52. tail := 0; res := Ok; sent := 0
  53. END Reset;
  54. PROCEDURE CanSetPos*( ): BOOLEAN;
  55. BEGIN
  56. RETURN FALSE
  57. END CanSetPos;
  58. PROCEDURE SetPos*( pos: Position );
  59. BEGIN
  60. HALT( 1234 )
  61. END SetPos;
  62. PROCEDURE Update*;
  63. BEGIN
  64. IF (res = Ok) THEN
  65. send( buf^, 0, tail, TRUE , res );
  66. IF res = Ok THEN INC( sent, tail ); tail := 0 END
  67. END
  68. END Update;
  69. (** Current write position. *)
  70. PROCEDURE Pos*( ): Position;
  71. BEGIN
  72. RETURN sent + tail;
  73. END Pos;
  74. (** -- Write raw binary data -- *)
  75. (** Write one byte. *)
  76. PROCEDURE Char*( x: CHAR );
  77. BEGIN
  78. IF (tail = LEN( buf )) & (res = Ok) THEN
  79. send( buf^, 0, tail, FALSE , res );
  80. IF res = Ok THEN INC( sent, tail ); tail := 0 END
  81. END;
  82. IF res = Ok THEN buf[tail] := x; INC( tail ) END
  83. END Char;
  84. (** Write len bytes from x, starting at ofs. *)
  85. PROCEDURE Bytes*(CONST x: ARRAY OF CHAR; ofs, len: BufferOffset );
  86. VAR n: BufferOffset;
  87. BEGIN
  88. ASSERT ( len >= 0 );
  89. LOOP
  90. n := LEN( buf ) - tail; (* space available *)
  91. IF n = 0 THEN
  92. IF res = Ok THEN (* send current buffer *)
  93. send( buf^, 0, tail, FALSE , res );
  94. IF res = Ok THEN INC( sent, tail ); tail := 0 ELSE EXIT END
  95. ELSE
  96. EXIT (* should not be writing on an erroneous rider *)
  97. END;
  98. n := LEN( buf )
  99. END;
  100. IF n > len THEN n := len END;
  101. ASSERT ( tail + n <= LEN( buf ) ); (* index check *)
  102. SYSTEM.MOVE( ADDRESSOF( x[ofs] ), ADDRESSOF( buf[tail] ), n ); INC( tail, n );
  103. IF len = n THEN EXIT END; (* done *)
  104. INC( ofs, n ); DEC( len, n )
  105. END
  106. END Bytes;
  107. (** Write a SHORTINT. *)
  108. PROCEDURE RawSInt*( x: SHORTINT );
  109. BEGIN
  110. Char( SYSTEM.VAL( CHAR, x ) )
  111. END RawSInt;
  112. (** Write an INTEGER. *)
  113. PROCEDURE RawInt*( x: INTEGER );
  114. BEGIN
  115. Bytes( SYSTEM.VAL( Bytes2, x ), 0, 2 )
  116. END RawInt;
  117. (** Write a LONGINT. *)
  118. PROCEDURE RawLInt*( x: LONGINT );
  119. BEGIN
  120. Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
  121. END RawLInt;
  122. (** Write a HUGEINT. *)
  123. PROCEDURE RawHInt*( x: HUGEINT );
  124. BEGIN
  125. Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8 )
  126. END RawHInt;
  127. (** Write a 64 bit value in network byte order (most significant byte first) *)
  128. PROCEDURE Net64*( x: HUGEINT );
  129. BEGIN
  130. Net32(LONGINT( x DIV 100000000H MOD 100000000H ));
  131. Net32(LONGINT( x MOD 100000000H ));
  132. END Net64;
  133. (** Write a 32 bit value in network byte order (most significant byte first) *)
  134. PROCEDURE Net32*( x: LONGINT );
  135. BEGIN
  136. Char( CHR( x DIV 1000000H MOD 100H ) ); Char( CHR( x DIV 10000H MOD 100H ) ); Char( CHR( x DIV 100H MOD 100H ) );
  137. Char( CHR( x MOD 100H ) )
  138. END Net32;
  139. (** Write a 16 bit value in network byte order (most significant byte first) *)
  140. PROCEDURE Net16*( x: LONGINT );
  141. BEGIN
  142. Char( CHR( x DIV 100H MOD 100H ) ); Char( CHR( x MOD 100H ) )
  143. END Net16;
  144. (** write unsigned byte *)
  145. PROCEDURE Net8*( x: LONGINT );
  146. BEGIN
  147. Char( CHR( x MOD 100H ) )
  148. END Net8;
  149. (** Write a SET. *)
  150. PROCEDURE RawSet*( x: SET );
  151. BEGIN
  152. Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
  153. END RawSet;
  154. (** Write a BOOLEAN. *)
  155. PROCEDURE RawBool*( x: BOOLEAN );
  156. BEGIN
  157. IF x THEN Char( 1X ) ELSE Char( 0X ) END
  158. END RawBool;
  159. (** Write a REAL. *)
  160. PROCEDURE RawReal*( x: REAL );
  161. BEGIN
  162. Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4 )
  163. END RawReal;
  164. (** Write a LONGREAL. *)
  165. PROCEDURE RawLReal*( x: LONGREAL );
  166. BEGIN
  167. Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8 )
  168. END RawLReal;
  169. (** Write a 0X-terminated string, including the 0X terminator. *)
  170. PROCEDURE RawString*(CONST x: ARRAY OF CHAR );
  171. VAR i: SIZE;
  172. BEGIN
  173. i := 0;
  174. WHILE x[i] # 0X DO Char( x[i] ); INC( i ) END;
  175. Char( 0X )
  176. END RawString;
  177. (** Write a number in a compressed format. *)
  178. PROCEDURE RawNum*( x: LONGINT );
  179. BEGIN
  180. WHILE (x < -64) OR (x > 63) DO Char( CHR( x MOD 128 + 128 ) ); x := x DIV 128 END;
  181. Char( CHR( x MOD 128 ) )
  182. END RawNum;
  183. (** Write a size in a compressed format. *)
  184. PROCEDURE RawSize*( x: SIZE );
  185. BEGIN
  186. WHILE (x < -64) OR (x > 63) DO Char( CHR( x MOD 128 + 128 ) ); x := x DIV 128 END;
  187. Char( CHR( x MOD 128 ) )
  188. END RawSize;
  189. (** -- Write formatted data -- *)
  190. (** Write an ASCII end-of-line (CR/LF). *)
  191. PROCEDURE Ln*;
  192. BEGIN
  193. Char( CR ); Char( LF )
  194. END Ln;
  195. (** Write a 0X-terminated string, excluding the 0X terminator. *)
  196. PROCEDURE String*(CONST x: ARRAY OF CHAR );
  197. VAR i: SIZE;
  198. BEGIN
  199. i := 0;
  200. WHILE x[i] # 0X DO Char( x[i] ); INC( i ) END
  201. END String;
  202. (** Write an integer in decimal right-justified in a field of at least w characters. *)
  203. PROCEDURE Int*( x: HUGEINT; w: SIZE );
  204. VAR i: SIZE; x0: HUGEINT;
  205. a: ARRAY 21 OF CHAR;
  206. BEGIN
  207. IF x < 0 THEN
  208. IF x = MIN( HUGEINT ) THEN
  209. DEC( w, 20 );
  210. WHILE w > 0 DO Char( " " ); DEC( w ) END;
  211. String( "-9223372036854775808" ); RETURN
  212. ELSE DEC( w ); x0 := -x
  213. END
  214. ELSE x0 := x
  215. END;
  216. i := 0;
  217. REPEAT a[i] := CHR( x0 MOD 10 + 30H ); x0 := x0 DIV 10; INC( i ) UNTIL x0 = 0;
  218. WHILE w > i DO Char( " " ); DEC( w ) END;
  219. IF x < 0 THEN Char( "-" ) END;
  220. REPEAT DEC( i ); Char( a[i] ) UNTIL i = 0
  221. END Int;
  222. (** Write a SET in Oberon notation. *)
  223. (* PROCEDURE Set*( s: SET ); (* from P. Saladin *)
  224. VAR i, last: LONGINT; dots: BOOLEAN;
  225. BEGIN
  226. Char( "{" ); last := MIN( LONGINT ); dots := FALSE;
  227. FOR i := MIN( SET ) TO MAX( SET ) DO
  228. IF i IN s THEN
  229. IF last = (i - 1) THEN
  230. IF dots THEN String( ".." ); dots := FALSE END;
  231. IF (i = MAX( SET )) OR ~((i + 1) IN s) THEN Int( i, 1 ) END
  232. ELSE
  233. IF last >= MIN( SET ) THEN String( ", " ) END;
  234. Int( i, 1 ); dots := TRUE
  235. END;
  236. last := i
  237. END
  238. END;
  239. Char( "}" )
  240. END Set; *)
  241. PROCEDURE Set*( s: SET ); (* from P. Saladin *)
  242. VAR i, last: LONGINT; dots: BOOLEAN;
  243. BEGIN
  244. Char( "{" ); last := MAX( LONGINT ); dots := FALSE;
  245. FOR i := MAX( SET ) TO 0 BY -1 DO
  246. IF i IN s THEN
  247. IF last = (i + 1) THEN
  248. IF dots THEN String( ".." ); dots := FALSE END;
  249. IF (i = 0) OR ~((i - 1) IN s) THEN Int( i, 1 ) END
  250. ELSE
  251. IF last <= MAX( SET ) THEN String( ", " ) END;
  252. Int( i, 1 ); dots := TRUE
  253. END;
  254. last := i
  255. END
  256. END;
  257. Char( "}" )
  258. END Set;
  259. (**
  260. Write an integer in hexadecimal right-justified in a field of at least ABS(w) characters.
  261. If w < 0 THEN w least significant hex digits of x are written (potentially including leading zeros)
  262. *)
  263. PROCEDURE Hex*(x: HUGEINT; w: SIZE);
  264. VAR filler: CHAR; i,maxw: SIZE; a: ARRAY 20 OF CHAR; y: HUGEINT;
  265. BEGIN
  266. IF w < 0 THEN filler := '0'; w := -w; maxw := w ELSE filler := ' '; maxw := 16 END;
  267. i := 0;
  268. REPEAT
  269. y := x MOD 10H;
  270. IF y < 10 THEN a[i] := CHR(y+ORD('0')) ELSE a[i] := CHR(y-10+ORD('A')) END;
  271. x := x DIV 10H;
  272. INC(i);
  273. UNTIL (x=0) OR (i=maxw);
  274. WHILE w > i DO Char(filler); DEC( w ) END;
  275. REPEAT DEC( i ); Char( a[i] ) UNTIL i = 0
  276. END Hex;
  277. (** Write "x" as a hexadecimal address. Do not use Hex because of arithmetic shift of the sign !*)
  278. PROCEDURE Address* (x: ADDRESS);
  279. BEGIN
  280. Hex(x,-2*SIZEOF(ADDRESS));
  281. END Address;
  282. PROCEDURE Pair( ch: CHAR; x: LONGINT );
  283. BEGIN
  284. IF ch # 0X THEN Char( ch ) END;
  285. Char( CHR( ORD( "0" ) + x DIV 10 MOD 10 ) ); Char( CHR( ORD( "0" ) + x MOD 10 ) )
  286. END Pair;
  287. (** 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.
  288. If all parameters are within range, the output string is exactly 19 characters wide. The t or d parameter can be -1, in which
  289. case the time or date respectively are left out. *)
  290. PROCEDURE Date*( t, d: LONGINT );
  291. VAR ch: CHAR;
  292. BEGIN
  293. IF d # -1 THEN
  294. Int( 1900 + d DIV 512, 4 ); (* year *)
  295. Pair( "-", d DIV 32 MOD 16 ); (* month *)
  296. Pair( "-", d MOD 32 ); (* day *)
  297. ch := " " (* space between date and time *)
  298. ELSE
  299. ch := 0X (* no space before time *)
  300. END;
  301. IF t # -1 THEN
  302. Pair( ch, t DIV 4096 MOD 32 ); (* hour *)
  303. Pair( ":", t DIV 64 MOD 64 ); (* min *)
  304. Pair( ":", t MOD 64 ) (* sec *)
  305. END
  306. END Date;
  307. (** Write the date and time in RFC 822/1123 format without the optional day of the week (dd mmm yyyy hh:mm:ss SZZZZ) .
  308. The t and d parameters are in Oberon time and date format. The tz parameter specifies the time zone offset in minutes
  309. (from -720 to 720 in steps of 30). If all parameters are within range, the output string is exactly 26 characters wide.
  310. The t, d or tz parameter can be -1, in which case the time, date or timezone respectively are left out. *)
  311. PROCEDURE Date822*( t, d, tz: LONGINT );
  312. VAR i, m: LONGINT; ch: CHAR;
  313. BEGIN
  314. IF d # -1 THEN
  315. Int( d MOD 32, 2 ); (* day *)
  316. m := (d DIV 32 MOD 16 - 1) * 4; (* month *)
  317. FOR i := m TO m + 3 DO Char( months[i] ) END;
  318. Int( 1900 + d DIV 512, 5 ); (* year *)
  319. ch := " " (* space *)
  320. ELSE
  321. ch := 0X (* no space *)
  322. END;
  323. IF t # -1 THEN
  324. Pair( ch, t DIV 4096 MOD 32 ); (* hour *)
  325. Pair( ":", t DIV 64 MOD 64 ); (* min *)
  326. Pair( ":", t MOD 64 ); (* sec *)
  327. ch := " " (* space *)
  328. ELSE
  329. (* leave ch as before *)
  330. END;
  331. IF tz # -1 THEN
  332. IF ch # 0X THEN Char( ch ) END;
  333. IF tz >= 0 THEN Pair( "+", tz DIV 60 ) ELSE Pair( "-", (-tz) DIV 60 ) END;
  334. Pair( 0X, ABS( tz ) MOD 60 )
  335. END
  336. END Date822;
  337. (** Write LONGREAL x using n character positions. *)
  338. PROCEDURE Float*( x: LONGREAL; n: WORD );
  339. VAR
  340. buf: ARRAY 32 OF CHAR;
  341. BEGIN
  342. RC.RealToString( x, n, buf );
  343. String( buf )
  344. END Float;
  345. (** 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). *)
  346. PROCEDURE FloatFix*( x: LONGREAL; n, f, D: WORD );
  347. VAR
  348. buf: ARRAY 64 OF CHAR;
  349. BEGIN
  350. RC.RealToStringFix( x, n, f, D, buf );
  351. String( buf )
  352. END FloatFix;
  353. END Writer;
  354. (** A special writer that buffers output to be fetched by GetString or GetRawString. *)
  355. StringWriter* = OBJECT (Writer)
  356. PROCEDURE & InitStringWriter*( size: BufferOffset );
  357. BEGIN
  358. InitWriter( Send, size )
  359. END InitStringWriter;
  360. PROCEDURE Send( CONST buf: ARRAY OF CHAR; ofs, len: BufferOffset; propagate: BOOLEAN; VAR res: WORD );
  361. BEGIN
  362. res := StringFull
  363. END Send;
  364. PROCEDURE CanSetPos*( ): BOOLEAN;
  365. BEGIN
  366. RETURN TRUE;
  367. END CanSetPos;
  368. (* Set the position for the writer *)
  369. PROCEDURE SetPos*( pos: Position );
  370. BEGIN
  371. IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
  372. tail := BufferOffset( pos ); sent := 0; res := Ok;
  373. END SetPos;
  374. PROCEDURE Update*;
  375. (* nothing to do *)
  376. END Update;
  377. (** Return the contents of the string writer (0X-terminated). *)
  378. PROCEDURE Get*( VAR s: ARRAY OF CHAR );
  379. VAR i, m: BufferOffset;
  380. BEGIN
  381. m := LEN( s ) - 1; i := 0;
  382. WHILE (i # tail) & (i < m) DO s[i] := buf[i]; INC( i ) END;
  383. s[i] := 0X; tail := 0; res := Ok
  384. END Get;
  385. (** Return the contents of the string writer (not 0X-terminated). The len parameters returns the string length. *)
  386. PROCEDURE GetRaw*( VAR s: ARRAY OF CHAR; VAR len: BufferOffset );
  387. VAR i, m: BufferOffset;
  388. BEGIN
  389. m := LEN( s ); i := 0;
  390. WHILE (i # tail) & (i < m) DO s[i] := buf[i]; INC( i ) END;
  391. len := i; tail := 0; res := Ok
  392. END GetRaw;
  393. END StringWriter;
  394. TYPE
  395. (** A reader buffers input received from a Receiver. Must not be shared between processes. *)
  396. Reader* = OBJECT
  397. VAR
  398. head, tail: BufferOffset;
  399. buf: POINTER TO ARRAY OF CHAR;
  400. res*: WORD; (** result of last input operation. *)
  401. receive: Receiver;
  402. received*: Position; (** count of received bytes *)
  403. (* buf[buf.head..buf.tail-1] contains data to read. *)
  404. PROCEDURE & InitReader*( receive: Receiver; size: BufferOffset );
  405. BEGIN
  406. ASSERT ( receive # NIL );
  407. IF (buf = NIL) OR (LEN(buf) # size) THEN
  408. NEW( buf, size );
  409. END;
  410. SELF.receive := receive; Reset
  411. END InitReader;
  412. (** reset the reader by dropping the bytes in the buffer, resetting the result code and setting received to 0.
  413. This is used by seekable extensions of the reader *)
  414. PROCEDURE Reset*;
  415. BEGIN
  416. head := 0; tail := 0; res := Ok; received := 0
  417. END Reset;
  418. PROCEDURE CanSetPos*( ): BOOLEAN;
  419. BEGIN
  420. RETURN FALSE
  421. END CanSetPos;
  422. PROCEDURE SetPos*( pos: Position );
  423. BEGIN
  424. HALT( 1234 )
  425. END SetPos;
  426. (** Return bytes currently available in input buffer. *)
  427. PROCEDURE Available*( ): BufferOffset;
  428. VAR n: BufferOffset;
  429. BEGIN
  430. IF (res = Ok) THEN
  431. IF (head = tail) THEN head := 0; receive( buf^, 0, LEN( buf ), 0, tail, res ); INC( received, tail );
  432. ELSIF (tail # LEN( buf )) THEN
  433. receive( buf^, tail, LEN( buf ) - tail, 0, n, res ); (* poll *)
  434. INC( tail, n ); INC( received, n )
  435. END;
  436. IF res = EOF THEN res := Ok END (* ignore EOF here *)
  437. END;
  438. RETURN tail - head
  439. END Available;
  440. (** Current read position. *)
  441. PROCEDURE Pos*( ): Position;
  442. BEGIN
  443. RETURN received - (tail - head)
  444. END Pos;
  445. (** -- Read raw binary data -- *)
  446. (** Read one byte. x=0X if no success (e.g. file ended) *)
  447. PROCEDURE Char*( VAR x: CHAR );
  448. BEGIN
  449. IF (head = tail) & (res = Ok) THEN head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail ) END;
  450. IF res = Ok THEN x := buf[head]; INC( head ) ELSE x := 0X END
  451. END Char;
  452. (** Like Read, but return result. Return 0X if no success (e.g. file ended) *)
  453. PROCEDURE Get*( ): CHAR;
  454. BEGIN
  455. IF (head = tail) & (res = Ok) THEN head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail ) END;
  456. IF res = Ok THEN INC( head ); RETURN buf[head - 1] ELSE RETURN 0X END
  457. END Get;
  458. (** Like Get, but leave the byte in the input buffer. *)
  459. PROCEDURE Peek*( ): CHAR;
  460. BEGIN
  461. IF (head = tail) & (res = Ok) THEN
  462. head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail );
  463. IF res = EOF THEN (* ignore EOF here *)
  464. res := Ok; tail := 0; RETURN 0X (* Peek returns 0X at eof *)
  465. END
  466. END;
  467. IF res = Ok THEN RETURN buf[head] ELSE RETURN 0X END
  468. END Peek;
  469. (** Read size bytes into x, starting at ofs. The len parameter returns the number of bytes that were actually read. *)
  470. PROCEDURE Bytes*( VAR x: ARRAY OF CHAR; ofs, size: BufferOffset; VAR len: BufferOffset );
  471. VAR n: BufferOffset;
  472. BEGIN
  473. ASSERT ( size >= 0 );
  474. len := 0;
  475. LOOP
  476. n := tail - head; (* bytes available *)
  477. IF n = 0 THEN (* no data available *)
  478. head := 0;
  479. IF res = Ok THEN (* fill buffer *)
  480. receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail )
  481. END;
  482. IF res # Ok THEN (* should not be reading from erroneous rider *)
  483. WHILE size # 0 DO x[ofs] := 0X; INC( ofs ); DEC( size ) END; (* clear rest of buffer *)
  484. IF (res = EOF) & (len # 0) THEN res := Ok END; (* ignore EOF if some data being returned *)
  485. EXIT
  486. END;
  487. n := tail
  488. END;
  489. IF n > size THEN n := size END;
  490. ASSERT ( ofs + n <= LEN( x ) ); (* index check *)
  491. SYSTEM.MOVE( ADDRESSOF( buf[head] ), ADDRESSOF( x[ofs] ), n ); INC( head, n ); INC( len, n );
  492. IF size = n THEN EXIT END; (* done *)
  493. INC( ofs, n ); DEC( size, n )
  494. END
  495. END Bytes;
  496. (** Skip n bytes on the reader. *)
  497. PROCEDURE SkipBytes*( n: Position );
  498. VAR ch: CHAR;
  499. BEGIN
  500. WHILE n > 0 DO ch := Get(); DEC( n ) END
  501. END SkipBytes;
  502. (** Read a SHORTINT. *)
  503. PROCEDURE RawSInt*( VAR x: SHORTINT );
  504. BEGIN
  505. x := SYSTEM.VAL( SHORTINT, Get() )
  506. END RawSInt;
  507. (** Read an INTEGER. *)
  508. PROCEDURE RawInt*( VAR x: INTEGER );
  509. VAR x0, x1: CHAR;
  510. BEGIN
  511. x0 := Get(); x1 := Get(); (* defined order *)
  512. x := ORD( x1 ) * 100H + ORD( x0 )
  513. END RawInt;
  514. (** Read a LONGINT. *)
  515. PROCEDURE RawLInt*( VAR x: LONGINT );
  516. VAR ignore: BufferOffset;
  517. BEGIN
  518. Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
  519. END RawLInt;
  520. (** Read a HUGEINT. *)
  521. PROCEDURE RawHInt*( VAR x: HUGEINT );
  522. VAR ignore: BufferOffset;
  523. BEGIN
  524. Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
  525. END RawHInt;
  526. (** Read a 64 bit value in network byte order (most significant byte first) *)
  527. PROCEDURE Net64*( ): HUGEINT;
  528. BEGIN
  529. RETURN Net32() * 100000000H + Net32()
  530. END Net64;
  531. (** Read a 32 bit value in network byte order (most significant byte first) *)
  532. PROCEDURE Net32*( ): LONGINT;
  533. BEGIN
  534. RETURN LONG( ORD( Get() ) ) * 1000000H + LONG( ORD( Get() ) ) * 10000H + LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
  535. END Net32;
  536. (** Read an unsigned 16bit value in network byte order (most significant byte first) *)
  537. PROCEDURE Net16*( ): LONGINT;
  538. BEGIN
  539. RETURN LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
  540. END Net16;
  541. (** Read an unsigned byte *)
  542. PROCEDURE Net8*( ): LONGINT;
  543. BEGIN
  544. RETURN LONG( ORD( Get() ) )
  545. END Net8;
  546. (** Read a SET. *)
  547. PROCEDURE RawSet*( VAR x: SET );
  548. VAR ignore: BufferOffset;
  549. BEGIN
  550. Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
  551. END RawSet;
  552. (** Read a BOOLEAN. *)
  553. PROCEDURE RawBool*( VAR x: BOOLEAN );
  554. BEGIN
  555. x := (Get() # 0X)
  556. END RawBool;
  557. (** Read a REAL. *)
  558. PROCEDURE RawReal*( VAR x: REAL );
  559. VAR ignore: BufferOffset;
  560. BEGIN
  561. Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
  562. END RawReal;
  563. (** Read a LONGREAL. *)
  564. PROCEDURE RawLReal*( VAR x: LONGREAL );
  565. VAR ignore: BufferOffset;
  566. BEGIN
  567. Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
  568. END RawLReal;
  569. (** 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. *)
  570. PROCEDURE RawString*( VAR x: ARRAY OF CHAR );
  571. VAR i, m: BufferOffset; ch: CHAR;
  572. BEGIN
  573. i := 0; m := LEN( x ) - 1;
  574. LOOP
  575. ch := Get(); (* also returns 0X on error *)
  576. IF ch = 0X THEN EXIT END;
  577. IF i < m THEN x[i] := ch; INC( i ) END
  578. END;
  579. x[i] := 0X
  580. END RawString;
  581. (** Read a number in a compressed format. *)
  582. PROCEDURE RawNum*( VAR x: LONGINT );
  583. VAR ch: CHAR; n, y: LONGINT;
  584. BEGIN
  585. n := 0; y := 0; ch := Get();
  586. WHILE ch >= 80X DO INC( y, LSH( LONGINT( ORD( ch ) ) - 128, n ) ); INC( n, 7 ); ch := Get() END;
  587. x := ASH( LSH( LONGINT( ORD( ch ) ), 25 ), n - 25 ) + y
  588. END RawNum;
  589. (** Read a size in a compressed format. *)
  590. PROCEDURE RawSize*( VAR x: SIZE );
  591. VAR ch: CHAR; n, y: SIZE;
  592. BEGIN
  593. n := 0; y := 0; ch := Get();
  594. WHILE ch >= 80X DO INC( y, LSH( SIZE( ORD( ch ) ) - 128, n ) ); INC( n, 7 ); ch := Get() END;
  595. x := ASH( LSH( SIZE( ORD( ch ) ), SIZE OF SIZE * 8 - 7 ), n - SIZE OF SIZE * 8 - 7 ) + y
  596. END RawSize;
  597. (** -- Read formatted data (uses Peek for one character lookahead) -- *)
  598. (** Read an integer value in decimal or hexadecimal. If hex = TRUE, recognize the "H" postfix for hexadecimal numbers. *)
  599. PROCEDURE Int*( VAR x: LONGINT; hex: BOOLEAN );
  600. VAR vd, vh, sgn, d: LONGINT; ch: CHAR; ok: BOOLEAN;
  601. BEGIN
  602. vd := 0; vh := 0; sgn := 1; ok := FALSE;
  603. IF Peek() = "-" THEN sgn := -1; ch := Get() END;
  604. LOOP
  605. ch := Peek();
  606. IF (ch >= "0") & (ch <= "9") THEN d := ORD( ch ) - ORD( "0" )
  607. ELSIF hex & (CAP( ch ) >= "A") & (CAP( ch ) <= "F") THEN d := ORD( CAP( ch ) ) - ORD( "A" ) + 10
  608. ELSE EXIT
  609. END;
  610. vd := 10 * vd + d; vh := 16 * vh + d; (* ignore overflow *)
  611. ch := Get(); ok := TRUE
  612. END;
  613. IF hex & (CAP( ch ) = "H") THEN (* optional "H" present *)
  614. vd := vh; (* use the hex value *)
  615. ch := Get()
  616. END;
  617. x := sgn * vd;
  618. IF (res = 0) & ~ok THEN res := FormatError END
  619. END Int;
  620. (** Return TRUE iff at the end of a line (or file). *)
  621. PROCEDURE EOLN*( ): BOOLEAN;
  622. VAR ch: CHAR;
  623. BEGIN
  624. ch := Peek(); RETURN (ch = CR) OR (ch = LF) OR (res # Ok)
  625. END EOLN;
  626. (** Read all characters until the end of the line (inclusive). If the input string is larger than x, read the full string and assign
  627. the truncated 0X-terminated value to x. *)
  628. PROCEDURE Ln*( VAR x: ARRAY OF CHAR );
  629. VAR i, m: BufferOffset; ch: CHAR;
  630. BEGIN
  631. i := 0; m := LEN( x ) - 1;
  632. LOOP
  633. ch := Peek();
  634. IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
  635. IF i < m THEN x[i] := ch; INC( i ) END;
  636. ch := Get()
  637. END;
  638. x[i] := 0X;
  639. IF ch = CR THEN ch := Get() END;
  640. IF Peek() = LF THEN ch := Get() END
  641. END Ln;
  642. (** Read all characters until the end of the line (inclusive) or an <EOT> character.
  643. If the input string is larger than x, read the full string and assign the truncated 0X-terminated
  644. value to x. *)
  645. PROCEDURE LnEOT*( VAR x: ARRAY OF CHAR );
  646. VAR i, m: BufferOffset; ch: CHAR;
  647. BEGIN
  648. i := 0; m := LEN( x ) - 1;
  649. LOOP
  650. ch := Peek();
  651. IF (ch = CR) OR (ch = LF) OR (ch = EOT) OR (res # Ok) THEN EXIT END;
  652. IF i < m THEN x[i] := ch; INC( i ) END;
  653. ch := Get()
  654. END;
  655. x[i] := 0X;
  656. IF ch = CR THEN ch := Get() END;
  657. IF Peek() = LF THEN ch := Get() END;
  658. IF ch = EOT THEN ch := Get() END
  659. END LnEOT;
  660. (** Skip over all characters until the end of the line (inclusive). *)
  661. PROCEDURE SkipLn*;
  662. VAR ch: CHAR;
  663. BEGIN
  664. LOOP
  665. ch := Peek();
  666. IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
  667. ch := Get()
  668. END;
  669. IF ch = CR THEN ch := Get() END;
  670. IF Peek() = LF THEN ch := Get() END
  671. END SkipLn;
  672. (** Skip over space and TAB characters. *)
  673. PROCEDURE SkipSpaces*;
  674. VAR ch: CHAR;
  675. BEGIN
  676. LOOP
  677. ch := Peek();
  678. IF (ch # TAB) & (ch # SP) THEN EXIT END;
  679. ch := Get()
  680. END
  681. END SkipSpaces;
  682. (** Skip over space, TAB and EOLN characters. *)
  683. PROCEDURE SkipWhitespace*;
  684. VAR ch: CHAR;
  685. BEGIN
  686. LOOP
  687. ch := Peek();
  688. IF (ch # SP) & (ch # CR) & (ch # LF) & (ch # TAB) THEN EXIT END;
  689. ch := Get()
  690. END
  691. END SkipWhitespace;
  692. (** Read a token, consisting of any string of characters terminated by space, TAB or EOLN. *)
  693. PROCEDURE Token*( VAR token: ARRAY OF CHAR );
  694. VAR j, max: SIZE; ch: CHAR;
  695. BEGIN
  696. j := 0; max := LEN( token ) - 1;
  697. LOOP
  698. ch := Peek();
  699. IF (ch = SP) OR (ch = CR) OR (ch = LF) OR (ch = TAB) OR (res # Ok) THEN EXIT END;
  700. IF j < max THEN token[j] := ch; INC( j ) END;
  701. ch := Get()
  702. END;
  703. token[j] := 0X
  704. END Token;
  705. (** Read an optionally "" or '' enquoted string. Will not read past the end of a line. *)
  706. PROCEDURE String*( VAR string: ARRAY OF CHAR );
  707. VAR c, delimiter: CHAR; i, len: SIZE;
  708. BEGIN
  709. c := Peek();
  710. IF (c # "'") & (c # '"') THEN Token( string )
  711. ELSE
  712. delimiter := Get(); c := Peek(); i := 0; len := LEN( string ) - 1;
  713. WHILE (i < len) & (c # delimiter) & (c # CR) & (c # LF) & (res = Ok) DO string[i] := Get(); INC( i ); c := Peek() END;
  714. IF (c = delimiter) THEN c := Get() END;
  715. string[i] := 0X
  716. END
  717. END String;
  718. (** First skip whitespace, then read string *)
  719. PROCEDURE GetString*(VAR string : ARRAY OF CHAR): BOOLEAN;
  720. VAR c: CHAR;
  721. BEGIN
  722. SkipWhitespace;
  723. c := Peek();
  724. String(string);
  725. RETURN (string[0] # 0X) OR (c = "'") OR (c = '"');
  726. END GetString;
  727. (** First skip whitespace, then read integer *)
  728. PROCEDURE GetInteger*(VAR integer : LONGINT; isHexadecimal : BOOLEAN): BOOLEAN;
  729. BEGIN
  730. SkipWhitespace;
  731. Int(integer, isHexadecimal);
  732. RETURN res = Ok;
  733. END GetInteger;
  734. (** First skip whitespace, then read a real *)
  735. PROCEDURE GetReal*(VAR real: LONGREAL): BOOLEAN;
  736. BEGIN
  737. SkipWhitespace;
  738. real := RC.ScanReal(Get);
  739. RETURN res = Ok
  740. END GetReal;
  741. (** First skip whitespace, then read 1 byte character *)
  742. PROCEDURE GetChar*(VAR ch : CHAR): BOOLEAN;
  743. BEGIN
  744. SkipWhitespace;
  745. Char(ch);
  746. RETURN ch # 0X;
  747. END GetChar;
  748. END Reader;
  749. TYPE
  750. (** A special reader that buffers input set by SetString or SetRawString. *)
  751. StringReader* = OBJECT (Reader)
  752. PROCEDURE & InitStringReader*( size: BufferOffset );
  753. BEGIN
  754. InitReader( Receive, size )
  755. END InitStringReader;
  756. PROCEDURE CanSetPos*( ): BOOLEAN;
  757. BEGIN
  758. RETURN TRUE
  759. END CanSetPos;
  760. (** Set the reader position *)
  761. PROCEDURE SetPos*( pos: Position );
  762. BEGIN
  763. IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
  764. head := BufferOffset( pos ); tail := LEN( buf ); received := LEN( buf ); res := Ok;
  765. END SetPos;
  766. PROCEDURE Receive( VAR buf: ARRAY OF CHAR; ofs, size, min: BufferOffset; VAR len: BufferOffset; VAR res: WORD );
  767. BEGIN
  768. IF min = 0 THEN res := Ok ELSE res := EOF END;
  769. len := 0;
  770. END Receive;
  771. (** Set the contents of the string buffer. The s parameter is a 0X-terminated string. *)
  772. PROCEDURE Set*(CONST s: ARRAY OF CHAR );
  773. VAR len: BufferOffset;
  774. BEGIN
  775. len := 0;
  776. WHILE s[len] # 0X DO INC( len ) END;
  777. IF len > LEN( buf ) THEN len := LEN( buf ) END;
  778. head := 0; tail := len; received := len; res := Ok;
  779. IF len > 0 THEN
  780. SYSTEM.MOVE( ADDRESSOF( s[0] ), ADDRESSOF( buf[0] ), len )
  781. END;
  782. END Set;
  783. (** Set the contents of the string buffer. The len parameter specifies the size of the buffer s. *)
  784. PROCEDURE SetRaw*(CONST s: ARRAY OF CHAR; ofs, len: BufferOffset );
  785. BEGIN
  786. IF len > LEN( buf ) THEN len := LEN( buf ) END;
  787. head := 0; tail := len; received := len; res := Ok;
  788. ASSERT ( (len >= 0) & (ofs + len <= LEN( s )) ); (* index check *)
  789. IF len > 0 THEN
  790. SYSTEM.MOVE( ADDRESSOF( s[ofs] ), ADDRESSOF( buf[0] ), len )
  791. END;
  792. END SetRaw;
  793. END StringReader;
  794. Bytes2 = ARRAY 2 OF CHAR;
  795. Bytes4 = ARRAY 4 OF CHAR;
  796. Bytes8 = ARRAY 8 OF CHAR;
  797. VAR
  798. months: ARRAY 12 * 4 + 1 OF CHAR;
  799. (** Open a writer to the specified stream sender. Update must be called after writing to ensure the buffer is written to the stream. *)
  800. PROCEDURE OpenWriter*( VAR b: Writer; send: Sender );
  801. BEGIN
  802. NEW( b, send, DefaultWriterSize )
  803. END OpenWriter;
  804. (** Open a reader from the specified stream receiver. *)
  805. PROCEDURE OpenReader*( VAR b: Reader; receive: Receiver );
  806. BEGIN
  807. NEW( b, receive, DefaultReaderSize )
  808. END OpenReader;
  809. (** Copy the contents of a reader to a writer *)
  810. PROCEDURE Copy* (r: Reader; w: Writer);
  811. VAR char: CHAR;
  812. BEGIN
  813. WHILE r.res = Ok DO
  814. r.Char (char);
  815. IF r.res = Ok THEN w.Char (char) END
  816. END;
  817. END Copy;
  818. BEGIN
  819. months := " Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec";
  820. END Streams64.
  821. (**
  822. Notes:
  823. o Any single buffer instance must not be accessed by more than one process concurrently.
  824. o The interface is blocking (synchronous). If an output buffer is full, it is written with a synchronous write, which returns
  825. only when all the data has been written. If an input buffer is empty, it is read with a synchronous read, which only returns
  826. once some data has been read. The only exception is the Available() procedure, which "peeks" at the input stream
  827. and returns 0 if no data is currently available.
  828. o All procedures set res to the error code reported by the lower-level I/O operation (non-zero indicates error).
  829. E.g. closing an underlying TCP connection will result in the Read* procedures returning a non-zero error code.
  830. o res is sticky. Once it becomes non-zero, it remains non-zero.
  831. 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.
  832. o All output written to an erroneous buffer is ignored.
  833. o The value returned when reading from an erroneous buffer is undefined, except for the Read procedure, which returns 0X.
  834. 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.
  835. o Raw format is little-endian 2's complement integers, IEEE reals and 0X-terminated strings.
  836. o Syntax for ReadInt with hex = FALSE: num = ["-"] digit {digit}. digit = "0".."9".
  837. o Syntax for ReadInt with hex = TRUE: ["-"] hexdigit {hexdigit} ["H"|"h"]. hexdigit = digit | "A".."F" | "a".."f".
  838. o ReadInt with hex = TRUE allows "A".."F" as digits, and looks for a "H" character after the number.
  839. If present, the number is interpreted as hexadecimal. If hexadecimal digits are present, but no "H" flag,
  840. the resulting decimal value is undefined.
  841. o ReadInt ignores overflow.
  842. 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,
  843. or an error occurs.
  844. o A Receiver receives up to size bytes from input into buf at ofs and returns the number of bytes read in len.
  845. It returns res non-zero on error. It waits until at least min bytes (possibly zero) are available, or an error occurs.
  846. o EOLN and ReadLn recognize the following end-of-line characters: CR, LF and CR/LF.
  847. o To read an unstructured file token-by-token: WHILE (r.res = 0) DO SkipWhitespace; ReadToken END
  848. o To read a line structured file token-by-token: WHILE r.res = 0 DO SkipSpaces; WHILE ~EOLN DO ReadToken; SkipSpaces END END
  849. o A string writer is not flushed when it becomes full, but res is set to a non-zero value.
  850. o Update has no effect on a string writer.
  851. o GetString can be called on a string writer to return the buffer contents and reset it to empty.
  852. o GetString always appends a 0X character to the buffer, but returns the true length (excluding the added 0X) in the len parameter,
  853. so it can also be used for binary data that includes 0X characters.
  854. o Receive procedure should set res to EOF when attempting to read past the end of file.
  855. *)
  856. (*
  857. to do:
  858. o stream byte count
  859. o read formatted data
  860. o reads for all formatted writes
  861. o write reals
  862. o low-level version that can be used in kernel (below KernelLog)
  863. *)