Streams.Mod 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029
  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. BufferOffset* = LONGINT; (* offset in the stream biffer *)
  17. TYPE
  18. Position* = LONGINT; (* position in the stream *)
  19. StreamSize* = LONGINT; (* size of hte stream *)
  20. (** Any stream output procedure or method. *)
  21. Sender* = PROCEDURE {DELEGATE} ( CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: WORD );
  22. (** Any stream input procedure or method. *)
  23. Receiver* = PROCEDURE {DELEGATE} ( VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len: LONGINT; VAR res: WORD );
  24. Connection* = OBJECT
  25. PROCEDURE Send*( CONST data: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: WORD );
  26. END Send;
  27. PROCEDURE Receive*( VAR data: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len: LONGINT; 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: LONGINT;
  37. buf: POINTER TO ARRAY OF CHAR;
  38. res*: WORD; (** result of last output operation. *)
  39. send: Sender;
  40. sent*: LONGINT; (** count of sent bytes *)
  41. (* buf[0..tail-1] contains data to write. *)
  42. PROCEDURE & InitWriter*( send: Sender; size: LONGINT );
  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: LONGINT );
  86. VAR n: LONGINT;
  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: LONGINT;
  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: LONGINT;
  198. BEGIN
  199. i := 0;
  200. WHILE (i<LEN(x)) & (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. (** Write "x" as a size. *)
  283. PROCEDURE Size* (x: SIZE);
  284. BEGIN
  285. Int(x, 0);
  286. END Size;
  287. PROCEDURE Pair( ch: CHAR; x: LONGINT );
  288. BEGIN
  289. IF ch # 0X THEN Char( ch ) END;
  290. Char( CHR( ORD( "0" ) + x DIV 10 MOD 10 ) ); Char( CHR( ORD( "0" ) + x MOD 10 ) )
  291. END Pair;
  292. (** 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.
  293. If all parameters are within range, the output string is exactly 19 characters wide. The t or d parameter can be -1, in which
  294. case the time or date respectively are left out. *)
  295. PROCEDURE Date*( t, d: LONGINT );
  296. VAR ch: CHAR;
  297. BEGIN
  298. IF d # -1 THEN
  299. Int( 1900 + d DIV 512, 4 ); (* year *)
  300. Pair( "-", d DIV 32 MOD 16 ); (* month *)
  301. Pair( "-", d MOD 32 ); (* day *)
  302. ch := " " (* space between date and time *)
  303. ELSE
  304. ch := 0X (* no space before time *)
  305. END;
  306. IF t # -1 THEN
  307. Pair( ch, t DIV 4096 MOD 32 ); (* hour *)
  308. Pair( ":", t DIV 64 MOD 64 ); (* min *)
  309. Pair( ":", t MOD 64 ) (* sec *)
  310. END
  311. END Date;
  312. (** Write the date and time in RFC 822/1123 format without the optional day of the week (dd mmm yyyy hh:mm:ss SZZZZ) .
  313. The t and d parameters are in Oberon time and date format. The tz parameter specifies the time zone offset in minutes
  314. (from -720 to 720 in steps of 30). If all parameters are within range, the output string is exactly 26 characters wide.
  315. The t, d or tz parameter can be -1, in which case the time, date or timezone respectively are left out. *)
  316. PROCEDURE Date822*( t, d, tz: LONGINT );
  317. VAR i, m: LONGINT; ch: CHAR;
  318. BEGIN
  319. IF d # -1 THEN
  320. Int( d MOD 32, 2 ); (* day *)
  321. m := (d DIV 32 MOD 16 - 1) * 4; (* month *)
  322. FOR i := m TO m + 3 DO Char( months[i] ) END;
  323. Int( 1900 + d DIV 512, 5 ); (* year *)
  324. ch := " " (* space *)
  325. ELSE
  326. ch := 0X (* no space *)
  327. END;
  328. IF t # -1 THEN
  329. Pair( ch, t DIV 4096 MOD 32 ); (* hour *)
  330. Pair( ":", t DIV 64 MOD 64 ); (* min *)
  331. Pair( ":", t MOD 64 ); (* sec *)
  332. ch := " " (* space *)
  333. ELSE
  334. (* leave ch as before *)
  335. END;
  336. IF tz # -1 THEN
  337. IF ch # 0X THEN Char( ch ) END;
  338. IF tz >= 0 THEN Pair( "+", tz DIV 60 ) ELSE Pair( "-", (-tz) DIV 60 ) END;
  339. Pair( 0X, ABS( tz ) MOD 60 )
  340. END
  341. END Date822;
  342. (** Write LONGREAL x using n character positions. *)
  343. PROCEDURE Float*( x: LONGREAL; n: WORD );
  344. VAR
  345. buf: ARRAY 32 OF CHAR;
  346. BEGIN
  347. RC.RealToString( x, n, buf );
  348. String( buf )
  349. END Float;
  350. (** 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). *)
  351. PROCEDURE FloatFix*( x: LONGREAL; n, f, D: WORD );
  352. VAR
  353. buf: ARRAY 64 OF CHAR;
  354. BEGIN
  355. RC.RealToStringFix( x, n, f, D, buf );
  356. String( buf )
  357. END FloatFix;
  358. END Writer;
  359. (** A special writer that buffers output to be fetched by GetString or GetRawString. *)
  360. StringWriter* = OBJECT (Writer)
  361. PROCEDURE & InitStringWriter*( size: LONGINT );
  362. BEGIN
  363. InitWriter( Send, size )
  364. END InitStringWriter;
  365. PROCEDURE Send( CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: WORD );
  366. BEGIN
  367. res := StringFull
  368. END Send;
  369. PROCEDURE CanSetPos*( ): BOOLEAN;
  370. BEGIN
  371. RETURN TRUE;
  372. END CanSetPos;
  373. (* Set the position for the writer *)
  374. PROCEDURE SetPos*( pos: Position );
  375. BEGIN
  376. IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
  377. tail := pos; sent := 0; res := Ok;
  378. END SetPos;
  379. PROCEDURE Update*;
  380. (* nothing to do *)
  381. END Update;
  382. (** Return the contents of the string writer (0X-terminated). *)
  383. PROCEDURE Get*( VAR s: ARRAY OF CHAR );
  384. VAR i, m: LONGINT;
  385. BEGIN
  386. m := LEN( s ) - 1; i := 0;
  387. WHILE (i # tail) & (i < m) DO s[i] := buf[i]; INC( i ) END;
  388. s[i] := 0X; tail := 0; res := Ok
  389. END Get;
  390. (** Return the contents of the string writer (not 0X-terminated). The len parameters returns the string length. *)
  391. PROCEDURE GetRaw*( VAR s: ARRAY OF CHAR; VAR len: LONGINT );
  392. VAR i, m: LONGINT;
  393. BEGIN
  394. m := LEN( s ); i := 0;
  395. WHILE (i # tail) & (i < m) DO s[i] := buf[i]; INC( i ) END;
  396. len := i; tail := 0; res := Ok
  397. END GetRaw;
  398. END StringWriter;
  399. TYPE
  400. (** A reader buffers input received from a Receiver. Must not be shared between processes. *)
  401. Reader* = OBJECT
  402. VAR
  403. head, tail: LONGINT;
  404. buf: POINTER TO ARRAY OF CHAR;
  405. res*: WORD; (** result of last input operation. *)
  406. receive: Receiver;
  407. received*: LONGINT; (** count of received bytes *)
  408. (* buf[buf.head..buf.tail-1] contains data to read. *)
  409. PROCEDURE & InitReader*( receive: Receiver; size: LONGINT );
  410. BEGIN
  411. ASSERT ( receive # NIL );
  412. IF (buf = NIL) OR (LEN(buf) # size) THEN
  413. NEW( buf, size );
  414. END;
  415. SELF.receive := receive; Reset
  416. END InitReader;
  417. (** reset the reader by dropping the bytes in the buffer, resetting the result code and setting received to 0.
  418. This is used by seekable extensions of the reader *)
  419. PROCEDURE Reset*;
  420. BEGIN
  421. head := 0; tail := 0; res := Ok; received := 0
  422. END Reset;
  423. PROCEDURE CanSetPos*( ): BOOLEAN;
  424. BEGIN
  425. RETURN FALSE
  426. END CanSetPos;
  427. PROCEDURE SetPos*( pos: Position );
  428. BEGIN
  429. HALT( 1234 )
  430. END SetPos;
  431. (** Return bytes currently available in input buffer. *)
  432. PROCEDURE Available*( ): LONGINT;
  433. VAR n: LONGINT;
  434. BEGIN
  435. IF (res = Ok) THEN
  436. IF (head = tail) THEN head := 0; receive( buf^, 0, LEN( buf ), 0, tail, res ); INC( received, tail );
  437. ELSIF (tail # LEN( buf )) THEN
  438. receive( buf^, tail, LEN( buf ) - tail, 0, n, res ); (* poll *)
  439. INC( tail, n ); INC( received, n )
  440. END;
  441. IF res = EOF THEN res := Ok END (* ignore EOF here *)
  442. END;
  443. RETURN tail - head
  444. END Available;
  445. (** Current read position. *)
  446. PROCEDURE Pos*( ): Position;
  447. BEGIN
  448. RETURN received - (tail - head)
  449. END Pos;
  450. (** -- Read raw binary data -- *)
  451. (** Read one byte. x=0X if no success (e.g. file ended) *)
  452. PROCEDURE Char*( VAR x: CHAR );
  453. BEGIN
  454. IF (head = tail) & (res = Ok) THEN head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail ) END;
  455. IF res = Ok THEN x := buf[head]; INC( head ) ELSE x := 0X END
  456. END Char;
  457. (** Like Read, but return result. Return 0X if no success (e.g. file ended) *)
  458. PROCEDURE Get*( ): CHAR;
  459. BEGIN
  460. IF (head = tail) & (res = Ok) THEN head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail ) END;
  461. IF res = Ok THEN INC( head ); RETURN buf[head - 1] ELSE RETURN 0X END
  462. END Get;
  463. (** Like Get, but leave the byte in the input buffer. *)
  464. PROCEDURE Peek*( ): CHAR;
  465. BEGIN
  466. IF (head = tail) & (res = Ok) THEN
  467. head := 0; receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail );
  468. IF res = EOF THEN (* ignore EOF here *)
  469. res := Ok; tail := 0; RETURN 0X (* Peek returns 0X at eof *)
  470. END
  471. END;
  472. IF res = Ok THEN RETURN buf[head] ELSE RETURN 0X END
  473. END Peek;
  474. (** Read size bytes into x, starting at ofs. The len parameter returns the number of bytes that were actually read. *)
  475. PROCEDURE Bytes*( VAR x: ARRAY OF CHAR; ofs, size: LONGINT; VAR len: LONGINT );
  476. VAR n: LONGINT;
  477. BEGIN
  478. ASSERT ( size >= 0 );
  479. len := 0;
  480. LOOP
  481. n := tail - head; (* bytes available *)
  482. IF n = 0 THEN (* no data available *)
  483. head := 0;
  484. IF res = Ok THEN (* fill buffer *)
  485. receive( buf^, 0, LEN( buf ), 1, tail, res ); INC( received, tail )
  486. END;
  487. IF res # Ok THEN (* should not be reading from erroneous rider *)
  488. WHILE size # 0 DO x[ofs] := 0X; INC( ofs ); DEC( size ) END; (* clear rest of buffer *)
  489. IF (res = EOF) & (len # 0) THEN res := Ok END; (* ignore EOF if some data being returned *)
  490. EXIT
  491. END;
  492. n := tail
  493. END;
  494. IF n > size THEN n := size END;
  495. ASSERT ( ofs + n <= LEN( x ) ); (* index check *)
  496. SYSTEM.MOVE( ADDRESSOF( buf[head] ), ADDRESSOF( x[ofs] ), n ); INC( head, n ); INC( len, n );
  497. IF size = n THEN EXIT END; (* done *)
  498. INC( ofs, n ); DEC( size, n )
  499. END
  500. END Bytes;
  501. (** Skip n bytes on the reader. *)
  502. PROCEDURE SkipBytes*( n: LONGINT );
  503. VAR ch: CHAR;
  504. BEGIN
  505. WHILE n > 0 DO ch := Get(); DEC( n ) END
  506. END SkipBytes;
  507. (** Read a SHORTINT. *)
  508. PROCEDURE RawSInt*( VAR x: SHORTINT );
  509. BEGIN
  510. x := SYSTEM.VAL( SHORTINT, Get() )
  511. END RawSInt;
  512. (** Read an INTEGER. *)
  513. PROCEDURE RawInt*( VAR x: INTEGER );
  514. VAR x0, x1: CHAR;
  515. BEGIN
  516. x0 := Get(); x1 := Get(); (* defined order *)
  517. x := ORD( x1 ) * 100H + ORD( x0 )
  518. END RawInt;
  519. (** Read a LONGINT. *)
  520. PROCEDURE RawLInt*( VAR x: LONGINT );
  521. VAR ignore: LONGINT;
  522. BEGIN
  523. Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
  524. END RawLInt;
  525. (** Read a HUGEINT. *)
  526. PROCEDURE RawHInt*( VAR x: HUGEINT );
  527. VAR ignore: LONGINT;
  528. BEGIN
  529. Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
  530. END RawHInt;
  531. (** Read a 64 bit value in network byte order (most significant byte first) *)
  532. PROCEDURE Net64*( ): HUGEINT;
  533. BEGIN
  534. RETURN Net32() * 100000000H + Net32()
  535. END Net64;
  536. (** Read a 32 bit value in network byte order (most significant byte first) *)
  537. PROCEDURE Net32*( ): LONGINT;
  538. BEGIN
  539. RETURN LONG( ORD( Get() ) ) * 1000000H + LONG( ORD( Get() ) ) * 10000H + LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
  540. END Net32;
  541. (** Read an unsigned 16bit value in network byte order (most significant byte first) *)
  542. PROCEDURE Net16*( ): LONGINT;
  543. BEGIN
  544. RETURN LONG( ORD( Get() ) ) * 100H + LONG( ORD( Get() ) )
  545. END Net16;
  546. (** Read an unsigned byte *)
  547. PROCEDURE Net8*( ): LONGINT;
  548. BEGIN
  549. RETURN LONG( ORD( Get() ) )
  550. END Net8;
  551. (** Read a SET. *)
  552. PROCEDURE RawSet*( VAR x: SET );
  553. VAR ignore: LONGINT;
  554. BEGIN
  555. Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
  556. END RawSet;
  557. (** Read a BOOLEAN. *)
  558. PROCEDURE RawBool*( VAR x: BOOLEAN );
  559. BEGIN
  560. x := (Get() # 0X)
  561. END RawBool;
  562. (** Read a REAL. *)
  563. PROCEDURE RawReal*( VAR x: REAL );
  564. VAR ignore: LONGINT;
  565. BEGIN
  566. Bytes( SYSTEM.VAL( Bytes4, x ), 0, 4, ignore )
  567. END RawReal;
  568. (** Read a LONGREAL. *)
  569. PROCEDURE RawLReal*( VAR x: LONGREAL );
  570. VAR ignore: LONGINT;
  571. BEGIN
  572. Bytes( SYSTEM.VAL( Bytes8, x ), 0, 8, ignore )
  573. END RawLReal;
  574. (** 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. *)
  575. PROCEDURE RawString*( VAR x: ARRAY OF CHAR );
  576. VAR i, m: LONGINT; ch: CHAR;
  577. BEGIN
  578. i := 0; m := LEN( x ) - 1;
  579. LOOP
  580. ch := Get(); (* also returns 0X on error *)
  581. IF ch = 0X THEN EXIT END;
  582. IF i < m THEN x[i] := ch; INC( i ) END
  583. END;
  584. x[i] := 0X
  585. END RawString;
  586. (** Read a number in a compressed format. *)
  587. PROCEDURE RawNum*( VAR x: LONGINT );
  588. VAR ch: CHAR; n, y: LONGINT;
  589. BEGIN
  590. n := 0; y := 0; ch := Get();
  591. WHILE ch >= 80X DO INC( y, LSH( LONGINT( ORD( ch ) ) - 128, n ) ); INC( n, 7 ); ch := Get() END;
  592. x := ASH( LSH( LONGINT( ORD( ch ) ), 25 ), n - 25 ) + y
  593. END RawNum;
  594. (** Read a size in a compressed format. *)
  595. PROCEDURE RawSize*( VAR x: SIZE );
  596. VAR ch: CHAR; n, y: SIZE;
  597. BEGIN
  598. n := 0; y := 0; ch := Get();
  599. WHILE ch >= 80X DO INC( y, LSH( SIZE( ORD( ch ) ) - 128, n ) ); INC( n, 7 ); ch := Get() END;
  600. x := ASH( LSH( SIZE( ORD( ch ) ), SIZE OF SIZE * 8 - 7 ), n - SIZE OF SIZE * 8 - 7 ) + y
  601. END RawSize;
  602. (** -- Read formatted data (uses Peek for one character lookahead) -- *)
  603. (** Read an integer value in decimal or hexadecimal. If hex = TRUE, recognize the "H" postfix for hexadecimal numbers. *)
  604. PROCEDURE Int*( VAR x: LONGINT; hex: BOOLEAN );
  605. VAR vd, vh, sgn, d: LONGINT; ch: CHAR; ok: BOOLEAN;
  606. BEGIN
  607. vd := 0; vh := 0; sgn := 1; ok := FALSE;
  608. IF Peek() = "-" THEN sgn := -1; ch := Get() END;
  609. LOOP
  610. ch := Peek();
  611. IF (ch >= "0") & (ch <= "9") THEN d := ORD( ch ) - ORD( "0" )
  612. ELSIF hex & (CAP( ch ) >= "A") & (CAP( ch ) <= "F") THEN d := ORD( CAP( ch ) ) - ORD( "A" ) + 10
  613. ELSE EXIT
  614. END;
  615. vd := 10 * vd + d; vh := 16 * vh + d; (* ignore overflow *)
  616. ch := Get(); ok := TRUE
  617. END;
  618. IF hex & (CAP( ch ) = "H") THEN (* optional "H" present *)
  619. vd := vh; (* use the hex value *)
  620. ch := Get()
  621. END;
  622. x := sgn * vd;
  623. IF (res = 0) & ~ok THEN res := FormatError END
  624. END Int;
  625. (** Read a size value in decimal or hexadecimal. If hex = TRUE, recognize the "H" postfix for hexadecimal numbers. *)
  626. PROCEDURE Size*( VAR x: SIZE; hex: BOOLEAN );
  627. VAR vd, vh: SIZE; d: WORD; ch: CHAR; ok: BOOLEAN;
  628. BEGIN
  629. vd := 0; vh := 0; ok := FALSE;
  630. LOOP
  631. ch := Peek();
  632. IF (ch >= "0") & (ch <= "9") THEN d := ORD( ch ) - ORD( "0" )
  633. ELSIF hex & (CAP( ch ) >= "A") & (CAP( ch ) <= "F") THEN d := ORD( CAP( ch ) ) - ORD( "A" ) + 10
  634. ELSE EXIT
  635. END;
  636. vd := 10 * vd + d; vh := 16 * vh + d; (* ignore overflow *)
  637. ch := Get(); ok := TRUE
  638. END;
  639. IF hex & (CAP( ch ) = "H") THEN (* optional "H" present *)
  640. vd := vh; (* use the hex value *)
  641. ch := Get()
  642. END;
  643. x := vd;
  644. IF (res = 0) & ~ok THEN res := FormatError END
  645. END Size;
  646. (** Return TRUE iff at the end of a line (or file). *)
  647. PROCEDURE EOLN*( ): BOOLEAN;
  648. VAR ch: CHAR;
  649. BEGIN
  650. ch := Peek(); RETURN (ch = CR) OR (ch = LF) OR (res # Ok)
  651. END EOLN;
  652. (** Read all characters until the end of the line (inclusive). If the input string is larger than x, read the full string and assign
  653. the truncated 0X-terminated value to x. *)
  654. PROCEDURE Ln*( VAR x: ARRAY OF CHAR );
  655. VAR i, m: LONGINT; ch: CHAR;
  656. BEGIN
  657. i := 0; m := LEN( x ) - 1;
  658. LOOP
  659. ch := Peek();
  660. IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
  661. IF i < m THEN x[i] := ch; INC( i ) END;
  662. ch := Get()
  663. END;
  664. x[i] := 0X;
  665. IF ch = CR THEN ch := Get() END;
  666. IF Peek() = LF THEN ch := Get() END
  667. END Ln;
  668. (** Read all characters until the end of the line (inclusive) or an <EOT> character.
  669. If the input string is larger than x, read the full string and assign the truncated 0X-terminated
  670. value to x. *)
  671. PROCEDURE LnEOT*( VAR x: ARRAY OF CHAR );
  672. VAR i, m: LONGINT; ch: CHAR;
  673. BEGIN
  674. i := 0; m := LEN( x ) - 1;
  675. LOOP
  676. ch := Peek();
  677. IF (ch = CR) OR (ch = LF) OR (ch = EOT) OR (res # Ok) THEN EXIT END;
  678. IF i < m THEN x[i] := ch; INC( i ) END;
  679. ch := Get()
  680. END;
  681. x[i] := 0X;
  682. IF ch = CR THEN ch := Get() END;
  683. IF Peek() = LF THEN ch := Get() END;
  684. IF ch = EOT THEN ch := Get() END
  685. END LnEOT;
  686. (** Skip over all characters until the end of the line (inclusive). *)
  687. PROCEDURE SkipLn*;
  688. VAR ch: CHAR;
  689. BEGIN
  690. LOOP
  691. ch := Peek();
  692. IF (ch = CR) OR (ch = LF) OR (res # Ok) THEN EXIT END;
  693. ch := Get()
  694. END;
  695. IF ch = CR THEN ch := Get() END;
  696. IF Peek() = LF THEN ch := Get() END
  697. END SkipLn;
  698. (** Skip over space and TAB characters. *)
  699. PROCEDURE SkipSpaces*;
  700. VAR ch: CHAR;
  701. BEGIN
  702. LOOP
  703. ch := Peek();
  704. IF (ch # TAB) & (ch # SP) THEN EXIT END;
  705. ch := Get()
  706. END
  707. END SkipSpaces;
  708. (** Skip over space, TAB and EOLN characters. *)
  709. PROCEDURE SkipWhitespace*;
  710. VAR ch: CHAR;
  711. BEGIN
  712. LOOP
  713. ch := Peek();
  714. IF (ch # SP) & (ch # CR) & (ch # LF) & (ch # TAB) THEN EXIT END;
  715. ch := Get()
  716. END
  717. END SkipWhitespace;
  718. (** Read a token, consisting of any string of characters terminated by space, TAB or EOLN. *)
  719. PROCEDURE Token*( VAR token: ARRAY OF CHAR );
  720. VAR j, max: LONGINT; ch: CHAR;
  721. BEGIN
  722. j := 0; max := LEN( token ) - 1;
  723. LOOP
  724. ch := Peek();
  725. IF (ch = SP) OR (ch = CR) OR (ch = LF) OR (ch = TAB) OR (res # Ok) THEN EXIT END;
  726. IF j < max THEN token[j] := ch; INC( j ) END;
  727. ch := Get()
  728. END;
  729. token[j] := 0X
  730. END Token;
  731. (** Read an optionally "" or '' enquoted string. Will not read past the end of a line. *)
  732. PROCEDURE String*( VAR string: ARRAY OF CHAR );
  733. VAR c, delimiter: CHAR; i, len: LONGINT;
  734. BEGIN
  735. c := Peek();
  736. IF (c # "'") & (c # '"') THEN Token( string )
  737. ELSE
  738. delimiter := Get(); c := Peek(); i := 0; len := LEN( string ) - 1;
  739. WHILE (i < len) & (c # delimiter) & (c # CR) & (c # LF) & (res = Ok) DO string[i] := Get(); INC( i ); c := Peek() END;
  740. IF (c = delimiter) THEN c := Get() END;
  741. string[i] := 0X
  742. END
  743. END String;
  744. (** First skip whitespace, then read string *)
  745. PROCEDURE GetString*(VAR string : ARRAY OF CHAR): BOOLEAN;
  746. VAR c: CHAR;
  747. BEGIN
  748. SkipWhitespace;
  749. c := Peek();
  750. String(string);
  751. RETURN (string[0] # 0X) OR (c = "'") OR (c = '"');
  752. END GetString;
  753. (** First skip whitespace, then read integer *)
  754. PROCEDURE GetInteger*(VAR integer : LONGINT; isHexadecimal : BOOLEAN): BOOLEAN;
  755. BEGIN
  756. SkipWhitespace;
  757. Int(integer, isHexadecimal);
  758. RETURN res = Ok;
  759. END GetInteger;
  760. (** First skip whitespace, then read size *)
  761. PROCEDURE GetSize*(VAR size : SIZE; isHexadecimal : BOOLEAN): BOOLEAN;
  762. BEGIN
  763. SkipWhitespace;
  764. Size(size, isHexadecimal);
  765. RETURN res = Ok;
  766. END GetSize;
  767. (** First skip whitespace, then read a real *)
  768. PROCEDURE GetReal*(VAR real: LONGREAL): BOOLEAN;
  769. BEGIN
  770. SkipWhitespace;
  771. real := RC.ScanReal(Get);
  772. RETURN res = Ok
  773. END GetReal;
  774. (** First skip whitespace, then read 1 byte character *)
  775. PROCEDURE GetChar*(VAR ch : CHAR): BOOLEAN;
  776. BEGIN
  777. SkipWhitespace;
  778. Char(ch);
  779. RETURN ch # 0X;
  780. END GetChar;
  781. END Reader;
  782. TYPE
  783. (** A special reader that buffers input set by SetString or SetRawString. *)
  784. StringReader* = OBJECT (Reader)
  785. PROCEDURE & InitStringReader*( size: LONGINT );
  786. BEGIN
  787. InitReader( Receive, size )
  788. END InitStringReader;
  789. PROCEDURE CanSetPos*( ): BOOLEAN;
  790. BEGIN
  791. RETURN TRUE
  792. END CanSetPos;
  793. (** Set the reader position *)
  794. PROCEDURE SetPos*( pos: Position );
  795. BEGIN
  796. IF pos > LEN( buf ) THEN pos := LEN( buf ) END;
  797. head := pos; tail := LEN( buf ); received := LEN( buf ); res := Ok;
  798. END SetPos;
  799. PROCEDURE Receive( VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len: LONGINT; VAR res: WORD );
  800. BEGIN
  801. IF min = 0 THEN res := Ok ELSE res := EOF END;
  802. len := 0;
  803. END Receive;
  804. (** Set the contents of the string buffer. The s parameter is a 0X-terminated string. *)
  805. PROCEDURE Set*(CONST s: ARRAY OF CHAR );
  806. VAR len: LONGINT;
  807. BEGIN
  808. len := 0;
  809. WHILE s[len] # 0X DO INC( len ) END;
  810. IF len > LEN( buf ) THEN len := LEN( buf ) END;
  811. head := 0; tail := len; received := len; res := Ok;
  812. IF len > 0 THEN
  813. SYSTEM.MOVE( ADDRESSOF( s[0] ), ADDRESSOF( buf[0] ), len )
  814. END;
  815. END Set;
  816. (** Set the contents of the string buffer. The len parameter specifies the size of the buffer s. *)
  817. PROCEDURE SetRaw*(CONST s: ARRAY OF CHAR; ofs, len: LONGINT );
  818. BEGIN
  819. IF len > LEN( buf ) THEN len := LEN( buf ) END;
  820. head := 0; tail := len; received := len; res := Ok;
  821. ASSERT ( (len >= 0) & (ofs + len <= LEN( s )) ); (* index check *)
  822. IF len > 0 THEN
  823. SYSTEM.MOVE( ADDRESSOF( s[ofs] ), ADDRESSOF( buf[0] ), len )
  824. END;
  825. END SetRaw;
  826. END StringReader;
  827. Bytes2 = ARRAY 2 OF CHAR;
  828. Bytes4 = ARRAY 4 OF CHAR;
  829. Bytes8 = ARRAY 8 OF CHAR;
  830. VAR
  831. months: ARRAY 12 * 4 + 1 OF CHAR;
  832. (** Open a writer to the specified stream sender. Update must be called after writing to ensure the buffer is written to the stream. *)
  833. PROCEDURE OpenWriter*( VAR b: Writer; send: Sender );
  834. BEGIN
  835. NEW( b, send, DefaultWriterSize )
  836. END OpenWriter;
  837. (** Open a reader from the specified stream receiver. *)
  838. PROCEDURE OpenReader*( VAR b: Reader; receive: Receiver );
  839. BEGIN
  840. NEW( b, receive, DefaultReaderSize )
  841. END OpenReader;
  842. (** Copy the contents of a reader to a writer *)
  843. PROCEDURE Copy* (r: Reader; w: Writer);
  844. VAR char: CHAR;
  845. BEGIN
  846. WHILE r.res = Ok DO
  847. r.Char (char);
  848. IF r.res = Ok THEN w.Char (char) END
  849. END;
  850. END Copy;
  851. BEGIN
  852. months := " Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec";
  853. END Streams.
  854. (**
  855. Notes:
  856. o Any single buffer instance must not be accessed by more than one process concurrently.
  857. o The interface is blocking (synchronous). If an output buffer is full, it is written with a synchronous write, which returns
  858. only when all the data has been written. If an input buffer is empty, it is read with a synchronous read, which only returns
  859. once some data has been read. The only exception is the Available() procedure, which "peeks" at the input stream
  860. and returns 0 if no data is currently available.
  861. o All procedures set res to the error code reported by the lower-level I/O operation (non-zero indicates error).
  862. E.g. closing an underlying TCP connection will result in the Read* procedures returning a non-zero error code.
  863. o res is sticky. Once it becomes non-zero, it remains non-zero.
  864. 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.
  865. o All output written to an erroneous buffer is ignored.
  866. o The value returned when reading from an erroneous buffer is undefined, except for the Read procedure, which returns 0X.
  867. 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.
  868. o Raw format is little-endian 2's complement integers, IEEE reals and 0X-terminated strings.
  869. o Syntax for ReadInt with hex = FALSE: num = ["-"] digit {digit}. digit = "0".."9".
  870. o Syntax for ReadInt with hex = TRUE: ["-"] hexdigit {hexdigit} ["H"|"h"]. hexdigit = digit | "A".."F" | "a".."f".
  871. o ReadInt with hex = TRUE allows "A".."F" as digits, and looks for a "H" character after the number.
  872. If present, the number is interpreted as hexadecimal. If hexadecimal digits are present, but no "H" flag,
  873. the resulting decimal value is undefined.
  874. o ReadInt ignores overflow.
  875. 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,
  876. or an error occurs.
  877. o A Receiver receives up to size bytes from input into buf at ofs and returns the number of bytes read in len.
  878. It returns res non-zero on error. It waits until at least min bytes (possibly zero) are available, or an error occurs.
  879. o EOLN and ReadLn recognize the following end-of-line characters: CR, LF and CR/LF.
  880. o To read an unstructured file token-by-token: WHILE (r.res = 0) DO SkipWhitespace; ReadToken END
  881. o To read a line structured file token-by-token: WHILE r.res = 0 DO SkipSpaces; WHILE ~EOLN DO ReadToken; SkipSpaces END END
  882. o A string writer is not flushed when it becomes full, but res is set to a non-zero value.
  883. o Update has no effect on a string writer.
  884. o GetString can be called on a string writer to return the buffer contents and reset it to empty.
  885. o GetString always appends a 0X character to the buffer, but returns the true length (excluding the added 0X) in the len parameter,
  886. so it can also be used for binary data that includes 0X characters.
  887. o Receive procedure should set res to EOF when attempting to read past the end of file.
  888. *)
  889. (*
  890. to do:
  891. o stream byte count
  892. o read formatted data
  893. o reads for all formatted writes
  894. o write reals
  895. o low-level version that can be used in kernel (below KernelLog)
  896. *)