source: trunk/minix/lib/ack/libm2/PascalIO.mod@ 12

Last change on this file since 12 was 9, checked in by Mattia Monga, 14 years ago

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