Streams.Mod 30 KB

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