PascalIO.mod 9.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437
  1. (*
  2. (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
  3. See the copyright notice in the ACK home directory, in the file "Copyright".
  4. *)
  5. (*$R-*)
  6. IMPLEMENTATION MODULE PascalIO;
  7. (*
  8. Module: Pascal-like Input/Output
  9. Author: Ceriel J.H. Jacobs
  10. Version: $Id$
  11. *)
  12. FROM Conversions IMPORT
  13. ConvertInteger, ConvertCardinal;
  14. FROM RealConversions IMPORT
  15. LongRealToString, StringToLongReal;
  16. FROM Traps IMPORT Message;
  17. FROM Streams IMPORT Stream, StreamKind, StreamMode, StreamResult,
  18. InputStream, OutputStream, OpenStream, CloseStream,
  19. EndOfStream, Read, Write, StreamBuffering;
  20. FROM Storage IMPORT Allocate;
  21. FROM SYSTEM IMPORT ADR;
  22. TYPE charset = SET OF CHAR;
  23. btype = (Preading, Pwriting, free);
  24. CONST spaces = charset{11C, 12C, 13C, 14C, 15C, ' '};
  25. TYPE IOstream = RECORD
  26. type: btype;
  27. done, eof : BOOLEAN;
  28. ch: CHAR;
  29. next: Text;
  30. stream: Stream;
  31. END;
  32. Text = POINTER TO IOstream;
  33. numbuf = ARRAY[0..255] OF CHAR;
  34. VAR ibuf, obuf: IOstream;
  35. head: Text;
  36. result: StreamResult;
  37. PROCEDURE Reset(VAR InputText: Text; Filename: ARRAY OF CHAR);
  38. BEGIN
  39. doclose(InputText);
  40. getstruct(InputText);
  41. WITH InputText^ DO
  42. OpenStream(stream, Filename, text, reading, result);
  43. IF result # succeeded THEN
  44. Message("could not open input file");
  45. HALT;
  46. END;
  47. type := Preading;
  48. done := FALSE;
  49. eof := FALSE;
  50. END;
  51. END Reset;
  52. PROCEDURE Rewrite(VAR OutputText: Text; Filename: ARRAY OF CHAR);
  53. BEGIN
  54. doclose(OutputText);
  55. getstruct(OutputText);
  56. WITH OutputText^ DO
  57. OpenStream(stream, Filename, text, writing, result);
  58. IF result # succeeded THEN
  59. Message("could not open output file");
  60. HALT;
  61. END;
  62. type := Pwriting;
  63. END;
  64. END Rewrite;
  65. PROCEDURE CloseOutput();
  66. VAR p: Text;
  67. BEGIN
  68. p := head;
  69. WHILE p # NIL DO
  70. doclose(p);
  71. p := p^.next;
  72. END;
  73. END CloseOutput;
  74. PROCEDURE doclose(Xtext: Text);
  75. BEGIN
  76. IF Xtext # Notext THEN
  77. WITH Xtext^ DO
  78. IF type # free THEN
  79. CloseStream(stream, result);
  80. type := free;
  81. END;
  82. END;
  83. END;
  84. END doclose;
  85. PROCEDURE getstruct(VAR Xtext: Text);
  86. BEGIN
  87. Xtext := head;
  88. WHILE (Xtext # NIL) AND (Xtext^.type # free) DO
  89. Xtext := Xtext^.next;
  90. END;
  91. IF Xtext = NIL THEN
  92. Allocate(Xtext,SIZE(IOstream));
  93. Xtext^.next := head;
  94. head := Xtext;
  95. END;
  96. END getstruct;
  97. PROCEDURE Error(tp: btype);
  98. BEGIN
  99. IF tp = Preading THEN
  100. Message("input text expected");
  101. ELSE
  102. Message("output text expected");
  103. END;
  104. HALT;
  105. END Error;
  106. PROCEDURE ReadChar(InputText: Text; VAR ch : CHAR);
  107. BEGIN
  108. ch := NextChar(InputText);
  109. IF InputText^.eof THEN
  110. Message("unexpected EOF");
  111. HALT;
  112. END;
  113. InputText^.done := FALSE;
  114. END ReadChar;
  115. PROCEDURE NextChar(InputText: Text): CHAR;
  116. BEGIN
  117. WITH InputText^ DO
  118. IF type # Preading THEN Error(Preading); END;
  119. IF NOT done THEN
  120. IF EndOfStream(stream, result) THEN
  121. eof := TRUE;
  122. ch := 0C;
  123. ELSE
  124. Read(stream, ch, result);
  125. done := TRUE;
  126. END;
  127. END;
  128. RETURN ch;
  129. END;
  130. END NextChar;
  131. PROCEDURE Get(InputText: Text);
  132. VAR dummy: CHAR;
  133. BEGIN
  134. ReadChar(InputText, dummy);
  135. END Get;
  136. PROCEDURE Eoln(InputText: Text): BOOLEAN;
  137. BEGIN
  138. RETURN NextChar(InputText) = 12C;
  139. END Eoln;
  140. PROCEDURE Eof(InputText: Text): BOOLEAN;
  141. BEGIN
  142. RETURN (NextChar(InputText) = 0C) AND InputText^.eof;
  143. END Eof;
  144. PROCEDURE ReadLn(InputText: Text);
  145. VAR ch: CHAR;
  146. BEGIN
  147. REPEAT
  148. ReadChar(InputText, ch)
  149. UNTIL ch = 12C;
  150. END ReadLn;
  151. PROCEDURE WriteChar(OutputText: Text; char: CHAR);
  152. BEGIN
  153. WITH OutputText^ DO
  154. IF type # Pwriting THEN Error(Pwriting); END;
  155. Write(stream, char, result);
  156. END;
  157. END WriteChar;
  158. PROCEDURE WriteLn(OutputText: Text);
  159. BEGIN
  160. WriteChar(OutputText, 12C);
  161. END WriteLn;
  162. PROCEDURE Page(OutputText: Text);
  163. BEGIN
  164. WriteChar(OutputText, 14C);
  165. END Page;
  166. PROCEDURE ReadInteger(InputText: Text; VAR int : INTEGER);
  167. CONST
  168. SAFELIMITDIV10 = MAX(INTEGER) DIV 10;
  169. SAFELIMITREM10 = MAX(INTEGER) MOD 10;
  170. VAR
  171. neg : BOOLEAN;
  172. safedigit: CARDINAL;
  173. ch: CHAR;
  174. chvalue: CARDINAL;
  175. BEGIN
  176. WHILE NextChar(InputText) IN spaces DO
  177. Get(InputText);
  178. END;
  179. ch := NextChar(InputText);
  180. IF ch = '-' THEN
  181. Get(InputText);
  182. ch := NextChar(InputText);
  183. neg := TRUE;
  184. ELSIF ch = '+' THEN
  185. Get(InputText);
  186. ch := NextChar(InputText);
  187. neg := FALSE;
  188. ELSE
  189. neg := FALSE
  190. END;
  191. safedigit := SAFELIMITREM10;
  192. IF neg THEN safedigit := safedigit + 1 END;
  193. int := 0;
  194. IF (ch >= '0') AND (ch <= '9') THEN
  195. WHILE (ch >= '0') & (ch <= '9') DO
  196. chvalue := ORD(ch) - ORD('0');
  197. IF (int < -SAFELIMITDIV10) OR
  198. ( (int = -SAFELIMITDIV10) AND
  199. (chvalue > safedigit)) THEN
  200. Message("integer too large");
  201. HALT;
  202. ELSE
  203. int := 10*int - VAL(INTEGER, chvalue);
  204. Get(InputText);
  205. ch := NextChar(InputText);
  206. END;
  207. END;
  208. IF NOT neg THEN
  209. int := -int
  210. END;
  211. ELSE
  212. Message("integer expected");
  213. HALT;
  214. END;
  215. END ReadInteger;
  216. PROCEDURE ReadCardinal(InputText: Text; VAR card : CARDINAL);
  217. CONST
  218. SAFELIMITDIV10 = MAX(CARDINAL) DIV 10;
  219. SAFELIMITREM10 = MAX(CARDINAL) MOD 10;
  220. VAR
  221. ch : CHAR;
  222. safedigit: CARDINAL;
  223. chvalue: CARDINAL;
  224. BEGIN
  225. WHILE NextChar(InputText) IN spaces DO
  226. Get(InputText);
  227. END;
  228. ch := NextChar(InputText);
  229. safedigit := SAFELIMITREM10;
  230. card := 0;
  231. IF (ch >= '0') AND (ch <= '9') THEN
  232. WHILE (ch >= '0') & (ch <= '9') DO
  233. chvalue := ORD(ch) - ORD('0');
  234. IF (card > SAFELIMITDIV10) OR
  235. ( (card = SAFELIMITDIV10) AND
  236. (chvalue > safedigit)) THEN
  237. Message("cardinal too large");
  238. HALT;
  239. ELSE
  240. card := 10*card + chvalue;
  241. Get(InputText);
  242. ch := NextChar(InputText);
  243. END;
  244. END;
  245. ELSE
  246. Message("cardinal expected");
  247. HALT;
  248. END;
  249. END ReadCardinal;
  250. PROCEDURE ReadReal(InputText: Text; VAR real: REAL);
  251. VAR x1: LONGREAL;
  252. BEGIN
  253. ReadLongReal(InputText, x1);
  254. real := x1
  255. END ReadReal;
  256. PROCEDURE ReadLongReal(InputText: Text; VAR real: LONGREAL);
  257. VAR
  258. buf: numbuf;
  259. ch: CHAR;
  260. ok: BOOLEAN;
  261. index: INTEGER;
  262. PROCEDURE inch(): CHAR;
  263. BEGIN
  264. buf[index] := ch;
  265. INC(index);
  266. Get(InputText);
  267. RETURN NextChar(InputText);
  268. END inch;
  269. BEGIN
  270. index := 0;
  271. ok := TRUE;
  272. WHILE NextChar(InputText) IN spaces DO
  273. Get(InputText);
  274. END;
  275. ch := NextChar(InputText);
  276. IF (ch ='+') OR (ch = '-') THEN
  277. ch := inch();
  278. END;
  279. IF (ch >= '0') AND (ch <= '9') THEN
  280. WHILE (ch >= '0') AND (ch <= '9') DO
  281. ch := inch();
  282. END;
  283. IF (ch = '.') THEN
  284. ch := inch();
  285. IF (ch >= '0') AND (ch <= '9') THEN
  286. WHILE (ch >= '0') AND (ch <= '9') DO
  287. ch := inch();
  288. END;
  289. ELSE
  290. ok := FALSE;
  291. END;
  292. END;
  293. IF ok AND (ch = 'E') THEN
  294. ch := inch();
  295. IF (ch ='+') OR (ch = '-') THEN
  296. ch := inch();
  297. END;
  298. IF (ch >= '0') AND (ch <= '9') THEN
  299. WHILE (ch >= '0') AND (ch <= '9') DO
  300. ch := inch();
  301. END;
  302. ELSE
  303. ok := FALSE;
  304. END;
  305. END;
  306. ELSE
  307. ok := FALSE;
  308. END;
  309. IF ok THEN
  310. buf[index] := 0C;
  311. StringToLongReal(buf, real, ok);
  312. END;
  313. IF NOT ok THEN
  314. Message("Illegal real");
  315. HALT;
  316. END;
  317. END ReadLongReal;
  318. PROCEDURE WriteCardinal(OutputText: Text; card: CARDINAL; width: CARDINAL);
  319. VAR
  320. buf : numbuf;
  321. BEGIN
  322. ConvertCardinal(card, 1, buf);
  323. WriteString(OutputText, buf, width);
  324. END WriteCardinal;
  325. PROCEDURE WriteInteger(OutputText: Text; int: INTEGER; width: CARDINAL);
  326. VAR
  327. buf : numbuf;
  328. BEGIN
  329. ConvertInteger(int, 1, buf);
  330. WriteString(OutputText, buf, width);
  331. END WriteInteger;
  332. PROCEDURE WriteBoolean(OutputText: Text; bool: BOOLEAN; width: CARDINAL);
  333. BEGIN
  334. IF bool THEN
  335. WriteString(OutputText, " TRUE", width);
  336. ELSE
  337. WriteString(OutputText, "FALSE", width);
  338. END;
  339. END WriteBoolean;
  340. PROCEDURE WriteReal(OutputText: Text; real: REAL; width, nfrac: CARDINAL);
  341. BEGIN
  342. WriteLongReal(OutputText, LONG(real), width, nfrac)
  343. END WriteReal;
  344. PROCEDURE WriteLongReal(OutputText: Text; real: LONGREAL; width, nfrac: CARDINAL);
  345. VAR
  346. buf: numbuf;
  347. ok: BOOLEAN;
  348. digits: INTEGER;
  349. BEGIN
  350. IF width > SIZE(buf) THEN
  351. width := SIZE(buf);
  352. END;
  353. IF nfrac > 0 THEN
  354. LongRealToString(real, width, nfrac, buf, ok);
  355. ELSE
  356. IF width < 9 THEN width := 9; END;
  357. IF real < 0.0D THEN
  358. digits := 7 - INTEGER(width);
  359. ELSE
  360. digits := 6 - INTEGER(width);
  361. END;
  362. LongRealToString(real, width, digits, buf, ok);
  363. END;
  364. WriteString(OutputText, buf, 0);
  365. END WriteLongReal;
  366. PROCEDURE WriteString(OutputText: Text; str: ARRAY OF CHAR; width: CARDINAL);
  367. VAR index: CARDINAL;
  368. BEGIN
  369. index := 0;
  370. WHILE (index <= HIGH(str)) AND (str[index] # Eos) DO
  371. INC(index);
  372. END;
  373. WHILE index < width DO
  374. WriteChar(OutputText, " ");
  375. INC(index);
  376. END;
  377. index := 0;
  378. WHILE (index <= HIGH(str)) AND (str[index] # Eos) DO
  379. WriteChar(OutputText, str[index]);
  380. INC(index);
  381. END;
  382. END WriteString;
  383. BEGIN (* PascalIO initialization *)
  384. WITH ibuf DO
  385. stream := InputStream;
  386. eof := FALSE;
  387. type := Preading;
  388. done := FALSE;
  389. END;
  390. WITH obuf DO
  391. stream := OutputStream;
  392. eof := FALSE;
  393. type := Pwriting;
  394. END;
  395. Notext := NIL;
  396. Input := ADR(ibuf);
  397. Output := ADR(obuf);
  398. Input^.next := Output;
  399. Output^.next := NIL;
  400. head := Input;
  401. END PascalIO.