]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* FIO.mod provides a simple buffered file input/output library. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2001-2023 Free Software Foundation, Inc. |
1eee94d3 GM |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | Under Section 7 of GPL version 3, you are granted additional | |
19 | permissions described in the GCC Runtime Library Exception, version | |
20 | 3.1, as published by the Free Software Foundation. | |
21 | ||
22 | You should have received a copy of the GNU General Public License and | |
23 | a copy of the GCC Runtime Library Exception along with this program; | |
24 | see the files COPYING3 and COPYING.RUNTIME respectively. If not, see | |
25 | <http://www.gnu.org/licenses/>. *) | |
26 | ||
27 | IMPLEMENTATION MODULE FIO ; | |
28 | ||
29 | (* | |
30 | Title : FIO | |
31 | Author : Gaius Mulley | |
32 | System : UNIX (gm2) | |
33 | Date : Thu Sep 2 22:07:21 1999 | |
34 | Last edit : Thu Sep 2 22:07:21 1999 | |
35 | Description: a complete reimplememtation of FIO.mod | |
36 | provides a simple buffered file input/output library. | |
37 | *) | |
38 | ||
39 | FROM SYSTEM IMPORT ADR, TSIZE, SIZE, WORD ; | |
40 | FROM ASCII IMPORT nl, nul, tab ; | |
41 | FROM StrLib IMPORT StrLen, StrConCat, StrCopy ; | |
42 | FROM Storage IMPORT ALLOCATE, DEALLOCATE ; | |
43 | FROM NumberIO IMPORT CardToStr ; | |
44 | FROM libc IMPORT exit, open, creat, read, write, close, lseek, strncpy, memcpy ; | |
45 | FROM Indexing IMPORT Index, InitIndex, InBounds, HighIndice, PutIndice, GetIndice ; | |
46 | FROM M2RTS IMPORT InstallTerminationProcedure ; | |
47 | ||
48 | CONST | |
49 | SEEK_SET = 0 ; (* relative from beginning of the file *) | |
50 | SEEK_END = 2 ; (* relative to the end of the file *) | |
51 | UNIXREADONLY = 0 ; | |
52 | UNIXWRITEONLY = 1 ; | |
53 | CreatePermissions = 666B; | |
54 | MaxBufferLength = 1024*16 ; | |
55 | MaxErrorString = 1024* 8 ; | |
56 | ||
57 | TYPE | |
58 | FileUsage = (unused, openedforread, openedforwrite, openedforrandom) ; | |
59 | FileStatus = (successful, outofmemory, toomanyfilesopen, failed, connectionfailure, endofline, endoffile) ; | |
60 | ||
61 | NameInfo = RECORD | |
62 | address: ADDRESS ; | |
63 | size : CARDINAL ; | |
64 | END ; | |
65 | ||
66 | Buffer = POINTER TO buf ; | |
67 | buf = RECORD | |
68 | valid : BOOLEAN ; (* are the field valid? *) | |
69 | bufstart: LONGINT ; (* the position of buffer in file *) | |
70 | position: CARDINAL ; (* where are we through this buffer *) | |
71 | address : ADDRESS ; (* dynamic buffer address *) | |
72 | filled : CARDINAL ; (* length of the buffer filled *) | |
73 | size : CARDINAL ; (* maximum space in this buffer *) | |
74 | left : CARDINAL ; (* number of bytes left to read *) | |
75 | contents: POINTER TO ARRAY [0..MaxBufferLength] OF CHAR ; | |
76 | END ; | |
77 | ||
78 | FileDescriptor = POINTER TO fds ; | |
79 | fds = RECORD | |
80 | unixfd: INTEGER ; | |
81 | name : NameInfo ; | |
82 | state : FileStatus ; | |
83 | usage : FileUsage ; | |
84 | output: BOOLEAN ; (* is this file going to write data *) | |
85 | buffer: Buffer ; | |
86 | abspos: LONGINT ; (* absolute position into file. *) | |
87 | END ; (* reflects low level reads which *) | |
88 | (* means this value will normally *) | |
89 | (* be further through the file than *) | |
90 | (* bufstart above. *) | |
91 | PtrToChar = POINTER TO CHAR ; | |
92 | ||
93 | ||
94 | VAR | |
95 | FileInfo: Index ; | |
96 | Error : File ; (* not stderr, this is an unused file handle | |
97 | which only serves to hold status values | |
98 | when we cannot create a new file handle *) | |
99 | ||
100 | ||
101 | (* | |
102 | GetUnixFileDescriptor - returns the UNIX file descriptor of a file. | |
103 | *) | |
104 | ||
105 | PROCEDURE GetUnixFileDescriptor (f: File) : INTEGER ; | |
106 | VAR | |
107 | fd: FileDescriptor ; | |
108 | BEGIN | |
109 | IF f#Error | |
110 | THEN | |
111 | fd := GetIndice(FileInfo, f) ; | |
112 | IF fd#NIL | |
113 | THEN | |
114 | RETURN( fd^.unixfd ) | |
115 | END | |
116 | END ; | |
117 | FormatError1('file %d has not been opened or is out of range\n', f) ; | |
118 | RETURN( -1 ) | |
119 | END GetUnixFileDescriptor ; | |
120 | ||
121 | ||
122 | (* | |
123 | WriteString - writes a string to file, f. | |
124 | *) | |
125 | ||
126 | PROCEDURE WriteString (f: File; a: ARRAY OF CHAR) ; | |
127 | VAR | |
128 | l: CARDINAL ; | |
129 | BEGIN | |
130 | l := StrLen(a) ; | |
131 | IF WriteNBytes(f, l, ADR(a))#l | |
132 | THEN | |
133 | END | |
134 | END WriteString ; | |
135 | ||
136 | ||
137 | (* | |
138 | Max - returns the maximum of two values. | |
139 | *) | |
140 | ||
141 | PROCEDURE Max (a, b: CARDINAL) : CARDINAL ; | |
142 | BEGIN | |
143 | IF a>b | |
144 | THEN | |
145 | RETURN( a ) | |
146 | ELSE | |
147 | RETURN( b ) | |
148 | END | |
149 | END Max ; | |
150 | ||
151 | ||
152 | (* | |
153 | Min - returns the minimum of two values. | |
154 | *) | |
155 | ||
156 | PROCEDURE Min (a, b: CARDINAL) : CARDINAL ; | |
157 | BEGIN | |
158 | IF a<b | |
159 | THEN | |
160 | RETURN( a ) | |
161 | ELSE | |
162 | RETURN( b ) | |
163 | END | |
164 | END Min ; | |
165 | ||
166 | ||
167 | (* | |
168 | GetNextFreeDescriptor - returns the index to the FileInfo array indicating | |
169 | the next free slot. | |
170 | *) | |
171 | ||
172 | PROCEDURE GetNextFreeDescriptor () : File ; | |
173 | VAR | |
174 | f, h: File ; | |
175 | fd : FileDescriptor ; | |
176 | BEGIN | |
177 | f := Error+1 ; | |
178 | h := HighIndice(FileInfo) ; | |
179 | LOOP | |
180 | IF f<=h | |
181 | THEN | |
182 | fd := GetIndice(FileInfo, f) ; | |
183 | IF fd=NIL | |
184 | THEN | |
185 | RETURN( f ) | |
186 | END | |
187 | END ; | |
188 | INC(f) ; | |
189 | IF f>h | |
190 | THEN | |
191 | PutIndice(FileInfo, f, NIL) ; (* create new slot *) | |
192 | RETURN( f ) | |
193 | END | |
194 | END | |
195 | END GetNextFreeDescriptor ; | |
196 | ||
197 | ||
198 | (* | |
199 | IsNoError - returns a TRUE if no error has occured on file, f. | |
200 | *) | |
201 | ||
202 | PROCEDURE IsNoError (f: File) : BOOLEAN ; | |
203 | VAR | |
204 | fd: FileDescriptor ; | |
205 | BEGIN | |
206 | IF f=Error | |
207 | THEN | |
208 | RETURN( FALSE ) | |
209 | ELSE | |
210 | fd := GetIndice(FileInfo, f) ; | |
211 | RETURN( (fd#NIL) AND ((fd^.state=successful) OR (fd^.state=endoffile) OR (fd^.state=endofline)) ) | |
212 | END | |
213 | END IsNoError ; | |
214 | ||
215 | ||
216 | (* | |
217 | IsActive - returns TRUE if the file, f, is still active. | |
218 | *) | |
219 | ||
220 | PROCEDURE IsActive (f: File) : BOOLEAN ; | |
221 | BEGIN | |
222 | IF f=Error | |
223 | THEN | |
224 | RETURN( FALSE ) | |
225 | ELSE | |
226 | RETURN( GetIndice(FileInfo, f)#NIL ) | |
227 | END | |
228 | END IsActive ; | |
229 | ||
230 | ||
231 | (* | |
232 | openToRead - attempts to open a file, fname, for reading and | |
233 | it returns this file. | |
234 | The success of this operation can be checked by | |
235 | calling IsNoError. | |
236 | *) | |
237 | ||
238 | PROCEDURE openToRead (fname: ADDRESS; flength: CARDINAL) : File ; | |
239 | VAR | |
240 | f: File ; | |
241 | BEGIN | |
242 | f := GetNextFreeDescriptor() ; | |
243 | IF f=Error | |
244 | THEN | |
245 | SetState(f, toomanyfilesopen) | |
246 | ELSE | |
247 | f := InitializeFile(f, fname, flength, successful, openedforread, FALSE, MaxBufferLength) ; | |
248 | ConnectToUnix(f, FALSE, FALSE) | |
249 | END ; | |
250 | RETURN( f ) | |
251 | END openToRead ; | |
252 | ||
253 | ||
254 | (* | |
255 | openToWrite - attempts to open a file, fname, for write and | |
256 | it returns this file. | |
257 | The success of this operation can be checked by | |
258 | calling IsNoError. | |
259 | *) | |
260 | ||
261 | PROCEDURE openToWrite (fname: ADDRESS; flength: CARDINAL) : File ; | |
262 | VAR | |
263 | f: File ; | |
264 | BEGIN | |
265 | f := GetNextFreeDescriptor() ; | |
266 | IF f=Error | |
267 | THEN | |
268 | SetState(f, toomanyfilesopen) | |
269 | ELSE | |
270 | f := InitializeFile(f, fname, flength, successful, openedforwrite, TRUE, MaxBufferLength) ; | |
271 | ConnectToUnix(f, TRUE, TRUE) | |
272 | END ; | |
273 | RETURN( f ) | |
274 | END openToWrite ; | |
275 | ||
276 | ||
277 | (* | |
278 | openForRandom - attempts to open a file, fname, for random access | |
279 | read or write and it returns this file. | |
280 | The success of this operation can be checked by | |
281 | calling IsNoError. | |
282 | towrite, determines whether the file should be | |
283 | opened for writing or reading. | |
284 | *) | |
285 | ||
286 | PROCEDURE openForRandom (fname: ADDRESS; flength: CARDINAL; | |
287 | towrite, newfile: BOOLEAN) : File ; | |
288 | VAR | |
289 | f: File ; | |
290 | BEGIN | |
291 | f := GetNextFreeDescriptor() ; | |
292 | IF f=Error | |
293 | THEN | |
294 | SetState(f, toomanyfilesopen) | |
295 | ELSE | |
296 | f := InitializeFile(f, fname, flength, successful, openedforrandom, towrite, MaxBufferLength) ; | |
297 | ConnectToUnix(f, towrite, newfile) | |
298 | END ; | |
299 | RETURN( f ) | |
300 | END openForRandom ; | |
301 | ||
302 | ||
303 | (* | |
304 | exists - returns TRUE if a file named, fname exists for reading. | |
305 | *) | |
306 | ||
307 | PROCEDURE exists (fname: ADDRESS; flength: CARDINAL) : BOOLEAN ; | |
308 | VAR | |
309 | f: File ; | |
310 | BEGIN | |
311 | f := openToRead(fname, flength) ; | |
312 | IF IsNoError(f) | |
313 | THEN | |
314 | Close(f) ; | |
315 | RETURN( TRUE ) | |
316 | ELSE | |
317 | Close(f) ; | |
318 | RETURN( FALSE ) | |
319 | END | |
320 | END exists ; | |
321 | ||
322 | ||
323 | (* | |
324 | SetState - sets the field, state, of file, f, to, s. | |
325 | *) | |
326 | ||
327 | PROCEDURE SetState (f: File; s: FileStatus) ; | |
328 | VAR | |
329 | fd: FileDescriptor ; | |
330 | BEGIN | |
331 | fd := GetIndice(FileInfo, f) ; | |
332 | fd^.state := s | |
333 | END SetState ; | |
334 | ||
335 | ||
336 | (* | |
337 | InitializeFile - initialize a file descriptor | |
338 | *) | |
339 | ||
340 | PROCEDURE InitializeFile (f: File; fname: ADDRESS; | |
341 | flength: CARDINAL; fstate: FileStatus; | |
342 | use: FileUsage; | |
343 | towrite: BOOLEAN; buflength: CARDINAL) : File ; | |
344 | VAR | |
345 | p : PtrToChar ; | |
346 | fd: FileDescriptor ; | |
347 | BEGIN | |
348 | NEW(fd) ; | |
349 | IF fd=NIL | |
350 | THEN | |
351 | SetState(Error, outofmemory) ; | |
352 | RETURN( Error ) | |
353 | ELSE | |
354 | PutIndice(FileInfo, f, fd) ; | |
355 | WITH fd^ DO | |
356 | name.size := flength+1 ; (* need to guarantee the nul for C *) | |
357 | usage := use ; | |
358 | output := towrite ; | |
359 | ALLOCATE(name.address, name.size) ; | |
360 | IF name.address=NIL | |
361 | THEN | |
362 | state := outofmemory ; | |
363 | RETURN( f ) | |
364 | END ; | |
365 | name.address := strncpy(name.address, fname, flength) ; | |
366 | (* and assign nul to the last byte *) | |
367 | p := name.address ; | |
368 | INC(p, flength) ; | |
369 | p^ := nul ; | |
370 | abspos := 0 ; | |
371 | (* now for the buffer *) | |
372 | NEW(buffer) ; | |
373 | IF buffer=NIL | |
374 | THEN | |
375 | SetState(Error, outofmemory) ; | |
376 | RETURN( Error ) | |
377 | ELSE | |
378 | WITH buffer^ DO | |
379 | valid := FALSE ; | |
380 | bufstart := 0 ; | |
381 | size := buflength ; | |
382 | position := 0 ; | |
383 | filled := 0 ; | |
384 | IF size=0 | |
385 | THEN | |
386 | address := NIL | |
387 | ELSE | |
388 | ALLOCATE(address, size) ; | |
389 | IF address=NIL | |
390 | THEN | |
391 | state := outofmemory ; | |
392 | RETURN( f ) | |
393 | END | |
394 | END ; | |
395 | IF towrite | |
396 | THEN | |
397 | left := size | |
398 | ELSE | |
399 | left := 0 | |
400 | END ; | |
401 | contents := address ; (* provides easy access for reading characters *) | |
402 | END ; | |
403 | state := fstate | |
404 | END | |
405 | END | |
406 | END ; | |
407 | RETURN( f ) | |
408 | END InitializeFile ; | |
409 | ||
410 | ||
411 | (* | |
412 | ConnectToUnix - connects a FIO file to a UNIX file descriptor. | |
413 | *) | |
414 | ||
415 | PROCEDURE ConnectToUnix (f: File; towrite, newfile: BOOLEAN) ; | |
416 | VAR | |
417 | fd: FileDescriptor ; | |
418 | BEGIN | |
419 | IF f#Error | |
420 | THEN | |
421 | fd := GetIndice(FileInfo, f) ; | |
422 | IF fd#NIL | |
423 | THEN | |
424 | WITH fd^ DO | |
425 | IF towrite | |
426 | THEN | |
427 | IF newfile | |
428 | THEN | |
429 | unixfd := creat(name.address, CreatePermissions) | |
430 | ELSE | |
431 | unixfd := open(name.address, UNIXWRITEONLY, 0) | |
432 | END | |
433 | ELSE | |
434 | unixfd := open(name.address, UNIXREADONLY, 0) | |
435 | END ; | |
436 | IF unixfd<0 | |
437 | THEN | |
438 | state := connectionfailure | |
439 | END | |
440 | END | |
441 | END | |
442 | END | |
443 | END ConnectToUnix ; | |
444 | ||
445 | ||
446 | (* | |
447 | The following functions are wrappers for the above. | |
448 | *) | |
449 | ||
450 | PROCEDURE Exists (fname: ARRAY OF CHAR) : BOOLEAN ; | |
451 | BEGIN | |
452 | RETURN( exists(ADR(fname), StrLen(fname)) ) | |
453 | END Exists ; | |
454 | ||
455 | ||
456 | PROCEDURE OpenToRead (fname: ARRAY OF CHAR) : File ; | |
457 | BEGIN | |
458 | RETURN( openToRead(ADR(fname), StrLen(fname)) ) | |
459 | END OpenToRead ; | |
460 | ||
461 | ||
462 | PROCEDURE OpenToWrite (fname: ARRAY OF CHAR) : File ; | |
463 | BEGIN | |
464 | RETURN( openToWrite(ADR(fname), StrLen(fname)) ) | |
465 | END OpenToWrite ; | |
466 | ||
467 | ||
468 | PROCEDURE OpenForRandom (fname: ARRAY OF CHAR; | |
469 | towrite: BOOLEAN; newfile: BOOLEAN) : File ; | |
470 | BEGIN | |
471 | RETURN( openForRandom(ADR(fname), StrLen(fname), towrite, newfile) ) | |
472 | END OpenForRandom ; | |
473 | ||
474 | ||
475 | (* | |
476 | Close - close a file which has been previously opened using: | |
477 | OpenToRead, OpenToWrite, OpenForRandom. | |
478 | It is correct to close a file which has an error status. | |
479 | *) | |
480 | ||
481 | PROCEDURE Close (f: File) ; | |
482 | VAR | |
483 | fd: FileDescriptor ; | |
484 | BEGIN | |
485 | IF f#Error | |
486 | THEN | |
487 | fd := GetIndice(FileInfo, f) ; | |
488 | (* | |
489 | we allow users to close files which have an error status | |
490 | *) | |
491 | IF fd#NIL | |
492 | THEN | |
493 | FlushBuffer(f) ; | |
494 | WITH fd^ DO | |
495 | IF unixfd>=0 | |
496 | THEN | |
497 | IF close(unixfd)#0 | |
498 | THEN | |
499 | FormatError1('failed to close file (%s)\n', name.address) ; | |
500 | state := failed (* --fixme-- too late to notify user (unless we return a BOOLEAN) *) | |
501 | END | |
502 | END ; | |
503 | IF name.address#NIL | |
504 | THEN | |
505 | DEALLOCATE(name.address, name.size) | |
506 | END ; | |
507 | IF buffer#NIL | |
508 | THEN | |
509 | WITH buffer^ DO | |
510 | IF address#NIL | |
511 | THEN | |
512 | DEALLOCATE(address, size) | |
513 | END | |
514 | END ; | |
515 | DISPOSE(buffer) ; | |
516 | buffer := NIL | |
517 | END | |
518 | END ; | |
519 | DISPOSE(fd) ; | |
520 | PutIndice(FileInfo, f, NIL) | |
521 | END | |
522 | END | |
523 | END Close ; | |
524 | ||
525 | ||
526 | (* | |
527 | ReadFromBuffer - attempts to read, nBytes, from file, f. | |
528 | It firstly consumes the buffer and then performs | |
529 | direct unbuffered reads. This should only be used | |
530 | when wishing to read large files. | |
531 | ||
532 | The actual number of bytes read is returned. | |
533 | -1 is returned if EOF is reached. | |
534 | *) | |
535 | ||
536 | PROCEDURE ReadFromBuffer (f: File; a: ADDRESS; nBytes: CARDINAL) : INTEGER ; | |
537 | VAR | |
538 | t : ADDRESS ; | |
539 | result: INTEGER ; | |
540 | total, | |
541 | n : CARDINAL ; | |
542 | p : POINTER TO BYTE ; | |
543 | fd : FileDescriptor ; | |
544 | BEGIN | |
545 | IF f#Error | |
546 | THEN | |
547 | total := 0 ; (* how many bytes have we read *) | |
548 | fd := GetIndice(FileInfo, f) ; | |
549 | WITH fd^ DO | |
550 | (* extract from the buffer first *) | |
551 | IF (buffer#NIL) AND (buffer^.valid) | |
552 | THEN | |
553 | WITH buffer^ DO | |
554 | IF left>0 | |
555 | THEN | |
556 | IF nBytes=1 | |
557 | THEN | |
558 | (* too expensive to call memcpy for 1 character *) | |
559 | p := a ; | |
560 | p^ := contents^[position] ; | |
561 | DEC(left) ; (* remove consumed bytes *) | |
562 | INC(position) ; (* move onwards n bytes *) | |
563 | nBytes := 0 ; (* reduce the amount for future direct *) | |
564 | (* read *) | |
565 | RETURN( 1 ) | |
566 | ELSE | |
567 | n := Min(left, nBytes) ; | |
568 | t := address ; | |
569 | INC(t, position) ; | |
570 | p := memcpy(a, t, n) ; | |
571 | DEC(left, n) ; (* remove consumed bytes *) | |
572 | INC(position, n) ; (* move onwards n bytes *) | |
573 | (* move onwards ready for direct reads *) | |
574 | INC(a, n) ; | |
575 | DEC(nBytes, n) ; (* reduce the amount for future direct *) | |
576 | (* read *) | |
577 | INC(total, n) ; | |
578 | RETURN( total ) (* much cleaner to return now, *) | |
579 | END (* difficult to record an error if *) | |
580 | END (* the read below returns -1 *) | |
581 | END | |
582 | END ; | |
583 | IF nBytes>0 | |
584 | THEN | |
585 | (* still more to read *) | |
586 | result := read(unixfd, a, INTEGER(nBytes)) ; | |
587 | IF result>0 | |
588 | THEN | |
589 | INC(total, result) ; | |
590 | INC(abspos, result) ; | |
591 | (* now disable the buffer as we read directly into, a. *) | |
592 | IF buffer#NIL | |
593 | THEN | |
594 | buffer^.valid := FALSE | |
595 | END ; | |
596 | ELSE | |
597 | IF result=0 | |
598 | THEN | |
599 | (* eof reached *) | |
600 | state := endoffile | |
601 | ELSE | |
602 | state := failed | |
603 | END ; | |
604 | (* indicate buffer is empty *) | |
605 | IF buffer#NIL | |
606 | THEN | |
607 | WITH buffer^ DO | |
608 | valid := FALSE ; | |
609 | left := 0 ; | |
610 | position := 0 ; | |
611 | IF address#NIL | |
612 | THEN | |
613 | contents^[position] := nul | |
614 | END | |
615 | END | |
616 | END ; | |
617 | RETURN( -1 ) | |
618 | END | |
619 | END | |
620 | END ; | |
621 | RETURN( total ) | |
622 | ELSE | |
623 | RETURN( -1 ) | |
624 | END | |
625 | END ReadFromBuffer ; | |
626 | ||
627 | ||
628 | (* | |
629 | ReadNBytes - reads nBytes of a file into memory area, dest, returning | |
630 | the number of bytes actually read. | |
631 | This function will consume from the buffer and then | |
632 | perform direct libc reads. It is ideal for large reads. | |
633 | *) | |
634 | ||
635 | PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL; dest: ADDRESS) : CARDINAL ; | |
636 | VAR | |
637 | n: INTEGER ; | |
638 | p: POINTER TO CHAR ; | |
639 | BEGIN | |
640 | IF f # Error | |
641 | THEN | |
642 | CheckAccess (f, openedforread, FALSE) ; | |
643 | n := ReadFromBuffer (f, dest, nBytes) ; | |
644 | IF n <= 0 | |
645 | THEN | |
646 | RETURN 0 | |
647 | ELSE | |
648 | p := dest ; | |
649 | INC (p, n-1) ; | |
650 | SetEndOfLine (f, p^) ; | |
651 | RETURN n | |
652 | END | |
653 | ELSE | |
654 | RETURN 0 | |
655 | END | |
656 | END ReadNBytes ; | |
657 | ||
658 | ||
659 | (* | |
660 | BufferedRead - will read, nBytes, through the buffer. | |
661 | Similar to ReadFromBuffer, but this function will always | |
662 | read into the buffer before copying into memory. | |
663 | ||
664 | Useful when performing small reads. | |
665 | *) | |
666 | ||
667 | PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ; | |
668 | VAR | |
669 | t : ADDRESS ; | |
670 | result: INTEGER ; | |
671 | total, | |
672 | n : INTEGER ; | |
673 | p : POINTER TO BYTE ; | |
674 | fd : FileDescriptor ; | |
675 | BEGIN | |
676 | IF f#Error | |
677 | THEN | |
678 | fd := GetIndice(FileInfo, f) ; | |
679 | total := 0 ; (* how many bytes have we read *) | |
680 | IF fd#NIL | |
681 | THEN | |
682 | WITH fd^ DO | |
683 | (* extract from the buffer first *) | |
684 | IF buffer#NIL | |
685 | THEN | |
686 | WITH buffer^ DO | |
687 | WHILE nBytes>0 DO | |
688 | IF (left>0) AND valid | |
689 | THEN | |
690 | IF nBytes=1 | |
691 | THEN | |
692 | (* too expensive to call memcpy for 1 character *) | |
693 | p := a ; | |
694 | p^ := contents^[position] ; | |
695 | DEC(left) ; (* remove consumed byte *) | |
696 | INC(position) ; (* move onwards n byte *) | |
697 | INC(total) ; | |
698 | RETURN( total ) | |
699 | ELSE | |
700 | n := Min(left, nBytes) ; | |
701 | t := address ; | |
702 | INC(t, position) ; | |
703 | p := memcpy(a, t, n) ; | |
704 | DEC(left, n) ; (* remove consumed bytes *) | |
705 | INC(position, n) ; (* move onwards n bytes *) | |
706 | (* move onwards ready for direct reads *) | |
707 | INC(a, n) ; | |
708 | DEC(nBytes, n) ; (* reduce the amount for future direct *) | |
709 | (* read *) | |
710 | INC(total, n) | |
711 | END | |
712 | ELSE | |
713 | (* refill buffer *) | |
714 | n := read(unixfd, address, size) ; | |
715 | IF n>=0 | |
716 | THEN | |
717 | valid := TRUE ; | |
718 | position := 0 ; | |
719 | left := n ; | |
720 | filled := n ; | |
721 | bufstart := abspos ; | |
722 | INC(abspos, n) ; | |
723 | IF n=0 | |
724 | THEN | |
725 | (* eof reached *) | |
726 | state := endoffile ; | |
727 | RETURN( -1 ) | |
728 | END | |
729 | ELSE | |
730 | valid := FALSE ; | |
731 | position := 0 ; | |
732 | left := 0 ; | |
733 | filled := 0 ; | |
734 | state := failed ; | |
735 | RETURN( total ) | |
736 | END | |
737 | END | |
738 | END | |
739 | END ; | |
740 | RETURN( total ) | |
741 | ELSE | |
742 | RETURN( -1 ) | |
743 | END | |
744 | END | |
745 | END | |
746 | ELSE | |
747 | RETURN( -1 ) | |
748 | END | |
749 | END BufferedRead ; | |
750 | ||
751 | ||
752 | (* | |
753 | HandleEscape - translates \n and \t into their respective ascii codes. | |
754 | *) | |
755 | ||
756 | PROCEDURE HandleEscape (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR; | |
757 | VAR i, j: CARDINAL; HighSrc, HighDest: CARDINAL) ; | |
758 | BEGIN | |
759 | IF (i+1<HighSrc) AND (src[i]='\') AND (j<HighDest) | |
760 | THEN | |
761 | IF src[i+1]='n' | |
762 | THEN | |
763 | (* requires a newline *) | |
764 | dest[j] := nl ; | |
765 | INC(j) ; | |
766 | INC(i, 2) | |
767 | ELSIF src[i+1]='t' | |
768 | THEN | |
769 | (* requires a tab (yuck) tempted to fake this but I better not.. *) | |
770 | dest[j] := tab ; | |
771 | INC(j) ; | |
772 | INC(i, 2) | |
773 | ELSE | |
774 | (* copy escaped character *) | |
775 | INC(i) ; | |
776 | dest[j] := src[i] ; | |
777 | INC(j) ; | |
778 | INC(i) | |
779 | END | |
780 | END | |
781 | END HandleEscape ; | |
782 | ||
783 | ||
784 | (* | |
785 | Cast - casts a := b | |
786 | *) | |
787 | ||
788 | PROCEDURE Cast (VAR a: ARRAY OF BYTE; b: ARRAY OF BYTE) ; | |
789 | VAR | |
790 | i: CARDINAL ; | |
791 | BEGIN | |
792 | IF HIGH(a)=HIGH(b) | |
793 | THEN | |
794 | FOR i := 0 TO HIGH(a) DO | |
795 | a[i] := b[i] | |
796 | END | |
797 | ELSE | |
798 | FormatError('cast failed') | |
799 | END | |
800 | END Cast ; | |
801 | ||
802 | ||
803 | (* | |
804 | StringFormat1 - converts string, src, into, dest, together with encapsulated | |
805 | entity, w. It only formats the first %s or %d with n. | |
806 | *) | |
807 | ||
808 | PROCEDURE StringFormat1 (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR; | |
809 | w: ARRAY OF BYTE) ; | |
810 | VAR | |
811 | HighSrc, | |
812 | HighDest, | |
813 | c, i, j : CARDINAL ; | |
814 | str : ARRAY [0..MaxErrorString] OF CHAR ; | |
815 | p : POINTER TO CHAR ; | |
816 | BEGIN | |
817 | HighSrc := StrLen(src) ; | |
818 | HighDest := HIGH(dest) ; | |
819 | p := NIL ; | |
820 | c := 0 ; | |
821 | i := 0 ; | |
822 | j := 0 ; | |
823 | WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) AND (src[i]#'%') DO | |
824 | IF src[i]='\' | |
825 | THEN | |
826 | HandleEscape(dest, src, i, j, HighSrc, HighDest) | |
827 | ELSE | |
828 | dest[j] := src[i] ; | |
829 | INC(i) ; | |
830 | INC(j) | |
831 | END | |
832 | END ; | |
833 | ||
834 | IF (i+1<HighSrc) AND (src[i]='%') AND (j<HighDest) | |
835 | THEN | |
836 | IF src[i+1]='s' | |
837 | THEN | |
838 | Cast(p, w) ; | |
839 | WHILE (j<HighDest) AND (p^#nul) DO | |
840 | dest[j] := p^ ; | |
841 | INC(j) ; | |
842 | INC(p) | |
843 | END ; | |
844 | IF j<HighDest | |
845 | THEN | |
846 | dest[j] := nul | |
847 | END ; | |
848 | j := StrLen(dest) ; | |
849 | INC(i, 2) | |
850 | ELSIF src[i+1]='d' | |
851 | THEN | |
852 | dest[j] := nul ; | |
853 | Cast(c, w) ; | |
854 | CardToStr(c, 0, str) ; | |
855 | StrConCat(dest, str, dest) ; | |
856 | j := StrLen(dest) ; | |
857 | INC(i, 2) | |
858 | ELSE | |
859 | dest[j] := src[i] ; | |
860 | INC(i) ; | |
861 | INC(j) | |
862 | END | |
863 | END ; | |
864 | (* and finish off copying src into dest *) | |
865 | WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) DO | |
866 | IF src[i]='\' | |
867 | THEN | |
868 | HandleEscape(dest, src, i, j, HighSrc, HighDest) | |
869 | ELSE | |
870 | dest[j] := src[i] ; | |
871 | INC(i) ; | |
872 | INC(j) | |
873 | END | |
874 | END ; | |
875 | IF j<HighDest | |
876 | THEN | |
877 | dest[j] := nul | |
878 | END ; | |
879 | END StringFormat1 ; | |
880 | ||
881 | ||
882 | (* | |
883 | FormatError - provides a orthoganal counterpart to the procedure below. | |
884 | *) | |
885 | ||
886 | PROCEDURE FormatError (a: ARRAY OF CHAR) ; | |
887 | BEGIN | |
888 | WriteString (StdErr, a) | |
889 | END FormatError ; | |
890 | ||
891 | ||
892 | (* | |
893 | FormatError1 - generic error procedure taking standard format string | |
894 | and single parameter. | |
895 | *) | |
896 | ||
897 | PROCEDURE FormatError1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ; | |
898 | VAR | |
899 | s: ARRAY [0..MaxErrorString] OF CHAR ; | |
900 | BEGIN | |
901 | StringFormat1 (s, a, w) ; | |
902 | FormatError (s) | |
903 | END FormatError1 ; | |
904 | ||
905 | ||
906 | (* | |
907 | FormatError2 - generic error procedure taking standard format string | |
908 | and two parameters. | |
909 | *) | |
910 | ||
911 | PROCEDURE FormatError2 (a: ARRAY OF CHAR; | |
912 | w1, w2: ARRAY OF BYTE) ; | |
913 | VAR | |
914 | s: ARRAY [0..MaxErrorString] OF CHAR ; | |
915 | BEGIN | |
916 | StringFormat1 (s, a, w1) ; | |
917 | FormatError1 (s, w2) | |
918 | END FormatError2 ; | |
919 | ||
920 | ||
921 | (* | |
922 | CheckAccess - checks to see whether a file f has been | |
923 | opened for read/write. | |
924 | *) | |
925 | ||
926 | PROCEDURE CheckAccess (f: File; use: FileUsage; towrite: BOOLEAN) ; | |
927 | VAR | |
928 | fd: FileDescriptor ; | |
929 | BEGIN | |
930 | IF f#Error | |
931 | THEN | |
932 | fd := GetIndice (FileInfo, f) ; | |
933 | IF fd=NIL | |
934 | THEN | |
935 | IF f#StdErr | |
936 | THEN | |
937 | FormatError ('this file has probably been closed and not reopened successfully or alternatively never opened\n') | |
938 | END ; | |
939 | HALT | |
940 | ELSE | |
941 | WITH fd^ DO | |
942 | IF (use=openedforwrite) AND (usage=openedforread) | |
943 | THEN | |
944 | FormatError1 ('this file (%s) has been opened for reading but is now being written\n', | |
945 | name.address) ; | |
946 | HALT | |
947 | ELSIF (use=openedforread) AND (usage=openedforwrite) | |
948 | THEN | |
949 | FormatError1('this file (%s) has been opened for writing but is now being read\n', | |
950 | name.address) ; | |
951 | HALT | |
952 | ELSIF state=connectionfailure | |
953 | THEN | |
954 | FormatError1('this file (%s) was not successfully opened\n', | |
955 | name.address) ; | |
956 | HALT | |
957 | ELSIF towrite#output | |
958 | THEN | |
959 | IF output | |
960 | THEN | |
961 | FormatError1('this file (%s) was opened for writing but is now being read\n', | |
962 | name.address) ; | |
963 | HALT | |
964 | ELSE | |
965 | FormatError1('this file (%s) was opened for reading but is now being written\n', | |
966 | name.address) ; | |
967 | HALT | |
968 | END | |
969 | END | |
970 | END | |
971 | END | |
972 | ELSE | |
973 | FormatError('this file has not been opened successfully\n') ; | |
974 | HALT | |
975 | END | |
976 | END CheckAccess ; | |
977 | ||
978 | ||
979 | (* | |
980 | ReadChar - returns a character read from file f. | |
981 | Sensible to check with IsNoError or EOF after calling | |
982 | this function. | |
983 | *) | |
984 | ||
985 | PROCEDURE ReadChar (f: File) : CHAR ; | |
986 | VAR | |
987 | ch: CHAR ; | |
988 | BEGIN | |
989 | CheckAccess (f, openedforread, FALSE) ; | |
990 | IF BufferedRead (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch)) | |
991 | THEN | |
992 | SetEndOfLine (f, ch) ; | |
993 | RETURN ch | |
994 | ELSE | |
995 | RETURN nul | |
996 | END | |
997 | END ReadChar ; | |
998 | ||
999 | ||
1000 | (* | |
1001 | SetEndOfLine - | |
1002 | *) | |
1003 | ||
1004 | PROCEDURE SetEndOfLine (f: File; ch: CHAR) ; | |
1005 | VAR | |
1006 | fd: FileDescriptor ; | |
1007 | BEGIN | |
1008 | CheckAccess(f, openedforread, FALSE) ; | |
1009 | IF f#Error | |
1010 | THEN | |
1011 | fd := GetIndice(FileInfo, f) ; | |
1012 | WITH fd^ DO | |
1013 | IF ch=nl | |
1014 | THEN | |
1015 | state := endofline | |
1016 | ELSE | |
1017 | state := successful | |
1018 | END | |
1019 | END | |
1020 | END | |
1021 | END SetEndOfLine ; | |
1022 | ||
1023 | ||
1024 | (* | |
1025 | UnReadChar - replaces a character, ch, back into file f. | |
1026 | This character must have been read by ReadChar | |
1027 | and it does not allow successive calls. It may | |
1028 | only be called if the previous read was successful | |
1029 | or end of file was seen. | |
1030 | If the state was previously endoffile then it | |
1031 | is altered to successful. | |
1032 | Otherwise it is left alone. | |
1033 | *) | |
1034 | ||
1035 | PROCEDURE UnReadChar (f: File; ch: CHAR) ; | |
1036 | VAR | |
1037 | fd : FileDescriptor ; | |
1038 | n : CARDINAL ; | |
1039 | a, b: ADDRESS ; | |
1040 | BEGIN | |
1041 | CheckAccess(f, openedforread, FALSE) ; | |
1042 | IF f#Error | |
1043 | THEN | |
1044 | fd := GetIndice(FileInfo, f) ; | |
1045 | WITH fd^ DO | |
1046 | IF (state=successful) OR (state=endoffile) OR (state=endofline) | |
1047 | THEN | |
1048 | IF (buffer#NIL) AND (buffer^.valid) | |
1049 | THEN | |
1050 | WITH buffer^ DO | |
1051 | (* we assume that a ReadChar has occurred, we will check just in case. *) | |
1052 | IF state=endoffile | |
1053 | THEN | |
1054 | position := MaxBufferLength ; | |
1055 | left := 0 ; | |
1056 | filled := 0 ; | |
1057 | state := successful | |
1058 | END ; | |
1059 | IF position>0 | |
1060 | THEN | |
1061 | DEC(position) ; | |
1062 | INC(left) ; | |
1063 | contents^[position] := ch ; | |
1064 | ELSE | |
1065 | (* position=0 *) | |
1066 | (* if possible make room and store ch *) | |
1067 | IF filled=size | |
1068 | THEN | |
1069 | FormatError1('performing too many UnReadChar calls on file (%d)\n', f) | |
1070 | ELSE | |
1071 | n := filled-position ; | |
1072 | b := ADR(contents^[position]) ; | |
1073 | a := ADR(contents^[position+1]) ; | |
1074 | a := memcpy(a, b, n) ; | |
1075 | INC(filled) ; | |
1076 | contents^[position] := ch ; | |
1077 | END | |
1078 | END | |
1079 | END | |
1080 | END | |
1081 | ELSE | |
1082 | FormatError1('UnReadChar can only be called if the previous read was successful or end of file, error on file (%d)\n', f) | |
1083 | END | |
1084 | END | |
1085 | END | |
1086 | END UnReadChar ; | |
1087 | ||
1088 | ||
1089 | (* | |
1090 | ReadAny - reads HIGH(a) bytes into, a. All input | |
1091 | is fully buffered, unlike ReadNBytes and thus is more | |
1092 | suited to small reads. | |
1093 | *) | |
1094 | ||
1095 | PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ; | |
1096 | BEGIN | |
1097 | CheckAccess(f, openedforread, FALSE) ; | |
1098 | IF BufferedRead (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a)) | |
1099 | THEN | |
1100 | SetEndOfLine(f, a[HIGH(a)]) | |
1101 | END | |
1102 | END ReadAny ; | |
1103 | ||
1104 | ||
1105 | (* | |
1106 | EOF - tests to see whether a file, f, has reached end of file. | |
1107 | *) | |
1108 | ||
1109 | PROCEDURE EOF (f: File) : BOOLEAN ; | |
1110 | VAR | |
1111 | fd: FileDescriptor ; | |
1112 | BEGIN | |
1113 | CheckAccess(f, openedforread, FALSE) ; | |
1114 | IF f#Error | |
1115 | THEN | |
1116 | fd := GetIndice(FileInfo, f) ; | |
1117 | IF fd#NIL | |
1118 | THEN | |
1119 | RETURN( fd^.state=endoffile ) | |
1120 | END | |
1121 | END ; | |
1122 | RETURN( TRUE ) | |
1123 | END EOF ; | |
1124 | ||
1125 | ||
1126 | (* | |
1127 | EOLN - tests to see whether a file, f, is upon a newline. | |
1128 | It does NOT consume the newline. | |
1129 | *) | |
1130 | ||
1131 | PROCEDURE EOLN (f: File) : BOOLEAN ; | |
1132 | VAR | |
1133 | ch: CHAR ; | |
1134 | fd: FileDescriptor ; | |
1135 | BEGIN | |
1136 | CheckAccess(f, openedforread, FALSE) ; | |
1137 | (* | |
1138 | we will read a character and then push it back onto the input stream, | |
1139 | having noted the file status, we also reset the status. | |
1140 | *) | |
1141 | IF f#Error | |
1142 | THEN | |
1143 | fd := GetIndice(FileInfo, f) ; | |
1144 | IF fd#NIL | |
1145 | THEN | |
1146 | IF (fd^.state=successful) OR (fd^.state=endofline) | |
1147 | THEN | |
1148 | ch := ReadChar(f) ; | |
1149 | IF (fd^.state=successful) OR (fd^.state=endofline) | |
1150 | THEN | |
1151 | UnReadChar(f, ch) | |
1152 | END ; | |
1153 | RETURN( ch=nl ) | |
1154 | END | |
1155 | END | |
1156 | END ; | |
1157 | RETURN( FALSE ) | |
1158 | END EOLN ; | |
1159 | ||
1160 | ||
1161 | (* | |
1162 | WasEOLN - tests to see whether a file, f, has just seen a newline. | |
1163 | *) | |
1164 | ||
1165 | PROCEDURE WasEOLN (f: File) : BOOLEAN ; | |
1166 | VAR | |
1167 | fd: FileDescriptor ; | |
1168 | BEGIN | |
1169 | CheckAccess(f, openedforread, FALSE) ; | |
1170 | IF f=Error | |
1171 | THEN | |
1172 | RETURN FALSE | |
1173 | ELSE | |
1174 | fd := GetIndice(FileInfo, f) ; | |
1175 | RETURN( (fd#NIL) AND (fd^.state=endofline) ) | |
1176 | END | |
1177 | END WasEOLN ; | |
1178 | ||
1179 | ||
1180 | (* | |
1181 | WriteLine - writes out a linefeed to file, f. | |
1182 | *) | |
1183 | ||
1184 | PROCEDURE WriteLine (f: File) ; | |
1185 | BEGIN | |
1186 | WriteChar(f, nl) | |
1187 | END WriteLine ; | |
1188 | ||
1189 | ||
1190 | (* | |
1191 | WriteNBytes - writes nBytes from memory area src to a file | |
1192 | returning the number of bytes actually written. | |
1193 | This function will flush the buffer and then | |
1194 | write the nBytes using a direct write from libc. | |
1195 | It is ideal for large writes. | |
1196 | *) | |
1197 | ||
1198 | PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL; src: ADDRESS) : CARDINAL ; | |
1199 | VAR | |
1200 | total: INTEGER ; | |
1201 | fd : FileDescriptor ; | |
1202 | BEGIN | |
1203 | CheckAccess(f, openedforwrite, TRUE) ; | |
1204 | FlushBuffer(f) ; | |
1205 | IF f#Error | |
1206 | THEN | |
1207 | fd := GetIndice(FileInfo, f) ; | |
1208 | IF fd#NIL | |
1209 | THEN | |
1210 | WITH fd^ DO | |
1211 | total := write(unixfd, src, INTEGER(nBytes)) ; | |
1212 | IF total<0 | |
1213 | THEN | |
1214 | state := failed ; | |
1215 | RETURN( 0 ) | |
1216 | ELSE | |
1217 | INC(abspos, CARDINAL(total)) ; | |
1218 | IF buffer#NIL | |
1219 | THEN | |
1220 | buffer^.bufstart := abspos | |
1221 | END ; | |
1222 | RETURN( CARDINAL(total) ) | |
1223 | END | |
1224 | END | |
1225 | END | |
1226 | END ; | |
1227 | RETURN( 0 ) | |
1228 | END WriteNBytes ; | |
1229 | ||
1230 | ||
1231 | (* | |
1232 | BufferedWrite - will write, nBytes, through the buffer. | |
1233 | Similar to WriteNBytes, but this function will always | |
1234 | write into the buffer before copying into memory. | |
1235 | ||
1236 | Useful when performing small writes. | |
1237 | *) | |
1238 | ||
1239 | PROCEDURE BufferedWrite (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ; | |
1240 | VAR | |
1241 | t : ADDRESS ; | |
1242 | result: INTEGER ; | |
1243 | total, | |
1244 | n : INTEGER ; | |
1245 | p : POINTER TO BYTE ; | |
1246 | fd : FileDescriptor ; | |
1247 | BEGIN | |
1248 | IF f#Error | |
1249 | THEN | |
1250 | fd := GetIndice(FileInfo, f) ; | |
1251 | IF fd#NIL | |
1252 | THEN | |
1253 | total := 0 ; (* how many bytes have we read *) | |
1254 | WITH fd^ DO | |
1255 | IF buffer#NIL | |
1256 | THEN | |
1257 | WITH buffer^ DO | |
1258 | WHILE nBytes>0 DO | |
1259 | (* place into the buffer first *) | |
1260 | IF left>0 | |
1261 | THEN | |
1262 | IF nBytes=1 | |
1263 | THEN | |
1264 | (* too expensive to call memcpy for 1 character *) | |
1265 | p := a ; | |
1266 | contents^[position] := p^ ; | |
1267 | DEC(left) ; (* reduce space *) | |
1268 | INC(position) ; (* move onwards n byte *) | |
1269 | INC(total) ; | |
1270 | RETURN( total ) | |
1271 | ELSE | |
1272 | n := Min(left, nBytes) ; | |
1273 | t := address ; | |
1274 | INC(t, position) ; | |
1275 | p := memcpy(a, t, CARDINAL(n)) ; | |
1276 | DEC(left, n) ; (* remove consumed bytes *) | |
1277 | INC(position, n) ; (* move onwards n bytes *) | |
1278 | (* move ready for further writes *) | |
1279 | INC(a, n) ; | |
1280 | DEC(nBytes, n) ; (* reduce the amount for future writes *) | |
1281 | INC(total, n) | |
1282 | END | |
1283 | ELSE | |
1284 | FlushBuffer(f) ; | |
1285 | IF (state#successful) AND (state#endofline) | |
1286 | THEN | |
1287 | nBytes := 0 | |
1288 | END | |
1289 | END | |
1290 | END | |
1291 | END ; | |
1292 | RETURN( total ) | |
1293 | END | |
1294 | END | |
1295 | END | |
1296 | END ; | |
1297 | RETURN( -1 ) | |
1298 | END BufferedWrite ; | |
1299 | ||
1300 | ||
1301 | (* | |
1302 | FlushBuffer - flush contents of file, f. | |
1303 | *) | |
1304 | ||
1305 | PROCEDURE FlushBuffer (f: File) ; | |
1306 | VAR | |
1307 | fd: FileDescriptor ; | |
1308 | BEGIN | |
1309 | IF f#Error | |
1310 | THEN | |
1311 | fd := GetIndice(FileInfo, f) ; | |
1312 | IF fd#NIL | |
1313 | THEN | |
1314 | WITH fd^ DO | |
1315 | IF output AND (buffer#NIL) | |
1316 | THEN | |
1317 | WITH buffer^ DO | |
1318 | IF (position=0) OR (write(unixfd, address, position)=VAL(INTEGER, position)) | |
1319 | THEN | |
1320 | INC(abspos, position) ; | |
1321 | bufstart := abspos ; | |
1322 | position := 0 ; | |
1323 | filled := 0 ; | |
1324 | left := size | |
1325 | ELSE | |
1326 | state := failed | |
1327 | END | |
1328 | END | |
1329 | END | |
1330 | END | |
1331 | END | |
1332 | END | |
1333 | END FlushBuffer ; | |
1334 | ||
1335 | ||
1336 | (* | |
1337 | WriteAny - writes HIGH(a) bytes onto, file, f. All output | |
1338 | is fully buffered, unlike WriteNBytes and thus is more | |
1339 | suited to small writes. | |
1340 | *) | |
1341 | ||
1342 | PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ; | |
1343 | BEGIN | |
1344 | CheckAccess (f, openedforwrite, TRUE) ; | |
1345 | IF BufferedWrite (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a)) | |
1346 | THEN | |
1347 | END | |
1348 | END WriteAny ; | |
1349 | ||
1350 | ||
1351 | (* | |
1352 | WriteChar - writes a single character to file, f. | |
1353 | *) | |
1354 | ||
1355 | PROCEDURE WriteChar (f: File; ch: CHAR) ; | |
1356 | BEGIN | |
1357 | CheckAccess (f, openedforwrite, TRUE) ; | |
1358 | IF BufferedWrite (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch)) | |
1359 | THEN | |
1360 | END | |
1361 | END WriteChar ; | |
1362 | ||
1363 | ||
1364 | (* | |
1365 | WriteCardinal - writes a CARDINAL to file, f. | |
1366 | It writes the binary image of the cardinal | |
1367 | to file, f. | |
1368 | *) | |
1369 | ||
1370 | PROCEDURE WriteCardinal (f: File; c: CARDINAL) ; | |
1371 | BEGIN | |
1372 | WriteAny(f, c) | |
1373 | END WriteCardinal ; | |
1374 | ||
1375 | ||
1376 | (* | |
1377 | ReadCardinal - reads a CARDINAL from file, f. | |
1378 | It reads a binary image of a CARDINAL | |
1379 | from a file, f. | |
1380 | *) | |
1381 | ||
1382 | PROCEDURE ReadCardinal (f: File) : CARDINAL ; | |
1383 | VAR | |
1384 | c: CARDINAL ; | |
1385 | BEGIN | |
1386 | ReadAny(f, c) ; | |
1387 | RETURN( c ) | |
1388 | END ReadCardinal ; | |
1389 | ||
1390 | ||
1391 | (* | |
1392 | ReadString - reads a string from file, f, into string, a. | |
1393 | It terminates the string if HIGH is reached or | |
1394 | if a newline is seen or an error occurs. | |
1395 | *) | |
1396 | ||
1397 | PROCEDURE ReadString (f: File; VAR a: ARRAY OF CHAR) ; | |
1398 | VAR | |
1399 | high, | |
1400 | i : CARDINAL ; | |
1401 | ch : CHAR ; | |
1402 | BEGIN | |
1403 | CheckAccess(f, openedforread, FALSE) ; | |
1404 | high := HIGH(a) ; | |
1405 | i := 0 ; | |
1406 | REPEAT | |
1407 | ch := ReadChar(f) ; | |
1408 | IF i<=high | |
1409 | THEN | |
1410 | IF (ch=nl) OR (NOT IsNoError(f)) OR EOF(f) | |
1411 | THEN | |
1412 | a[i] := nul ; | |
1413 | INC(i) | |
1414 | ELSE | |
1415 | a[i] := ch ; | |
1416 | INC(i) | |
1417 | END | |
1418 | END | |
1419 | UNTIL (ch=nl) OR (i>high) OR (NOT IsNoError(f)) OR EOF(f) | |
1420 | END ReadString ; | |
1421 | ||
1422 | ||
1423 | (* | |
1424 | SetPositionFromBeginning - sets the position from the beginning of the file. | |
1425 | *) | |
1426 | ||
1427 | PROCEDURE SetPositionFromBeginning (f: File; pos: LONGINT) ; | |
1428 | VAR | |
1429 | offset: LONGINT ; | |
1430 | fd : FileDescriptor ; | |
1431 | BEGIN | |
1432 | IF f#Error | |
1433 | THEN | |
1434 | fd := GetIndice(FileInfo, f) ; | |
1435 | IF fd#NIL | |
1436 | THEN | |
1437 | WITH fd^ DO | |
1438 | (* always force the lseek, until we are confident that abspos is always correct, | |
1439 | basically it needs some hard testing before we should remove the OR TRUE. *) | |
1440 | IF (abspos#pos) OR TRUE | |
1441 | THEN | |
1442 | FlushBuffer(f) ; | |
1443 | IF buffer#NIL | |
1444 | THEN | |
1445 | WITH buffer^ DO | |
1446 | IF output | |
1447 | THEN | |
1448 | left := size | |
1449 | ELSE | |
1450 | left := 0 | |
1451 | END ; | |
1452 | position := 0 ; | |
1453 | filled := 0 | |
1454 | END | |
1455 | END ; | |
1456 | offset := lseek(unixfd, pos, SEEK_SET) ; | |
1457 | IF (offset>=0) AND (pos=offset) | |
1458 | THEN | |
1459 | abspos := pos | |
1460 | ELSE | |
1461 | state := failed ; | |
1462 | abspos := 0 | |
1463 | END ; | |
1464 | IF buffer#NIL | |
1465 | THEN | |
1466 | buffer^.valid := FALSE ; | |
1467 | buffer^.bufstart := abspos | |
1468 | END | |
1469 | END | |
1470 | END | |
1471 | END | |
1472 | END | |
1473 | END SetPositionFromBeginning ; | |
1474 | ||
1475 | ||
1476 | (* | |
1477 | SetPositionFromEnd - sets the position from the end of the file. | |
1478 | *) | |
1479 | ||
1480 | PROCEDURE SetPositionFromEnd (f: File; pos: LONGINT) ; | |
1481 | VAR | |
1482 | offset: LONGINT ; | |
1483 | fd : FileDescriptor ; | |
1484 | BEGIN | |
1485 | IF f#Error | |
1486 | THEN | |
1487 | fd := GetIndice(FileInfo, f) ; | |
1488 | IF fd#NIL | |
1489 | THEN | |
1490 | WITH fd^ DO | |
1491 | FlushBuffer(f) ; | |
1492 | IF buffer#NIL | |
1493 | THEN | |
1494 | WITH buffer^ DO | |
1495 | IF output | |
1496 | THEN | |
1497 | left := size | |
1498 | ELSE | |
1499 | left := 0 | |
1500 | END ; | |
1501 | position := 0 ; | |
1502 | filled := 0 | |
1503 | END | |
1504 | END ; | |
1505 | offset := lseek(unixfd, pos, SEEK_END) ; | |
1506 | IF offset>=0 | |
1507 | THEN | |
1508 | abspos := offset ; | |
1509 | ELSE | |
1510 | state := failed ; | |
1511 | abspos := 0 ; | |
1512 | offset := 0 | |
1513 | END ; | |
1514 | IF buffer#NIL | |
1515 | THEN | |
1516 | buffer^.valid := FALSE ; | |
1517 | buffer^.bufstart := offset | |
1518 | END | |
1519 | END | |
1520 | END | |
1521 | END | |
1522 | END SetPositionFromEnd ; | |
1523 | ||
1524 | ||
1525 | (* | |
1526 | FindPosition - returns the current absolute position in file, f. | |
1527 | *) | |
1528 | ||
1529 | PROCEDURE FindPosition (f: File) : LONGINT ; | |
1530 | VAR | |
1531 | fd: FileDescriptor ; | |
1532 | BEGIN | |
1533 | IF f#Error | |
1534 | THEN | |
1535 | fd := GetIndice(FileInfo, f) ; | |
1536 | IF fd#NIL | |
1537 | THEN | |
1538 | WITH fd^ DO | |
1539 | IF (buffer=NIL) OR (NOT buffer^.valid) | |
1540 | THEN | |
1541 | RETURN( abspos ) | |
1542 | ELSE | |
1543 | WITH buffer^ DO | |
1544 | RETURN( bufstart+VAL(LONGINT, position) ) | |
1545 | END | |
1546 | END | |
1547 | END | |
1548 | END | |
1549 | END ; | |
1550 | RETURN( 0 ) | |
1551 | END FindPosition ; | |
1552 | ||
1553 | ||
1554 | (* | |
1555 | GetFileName - assigns, a, with the filename associated with, f. | |
1556 | *) | |
1557 | ||
1558 | PROCEDURE GetFileName (f: File; VAR a: ARRAY OF CHAR) ; | |
1559 | VAR | |
1560 | i : CARDINAL ; | |
1561 | p : POINTER TO CHAR ; | |
1562 | fd: FileDescriptor ; | |
1563 | BEGIN | |
1564 | IF f#Error | |
1565 | THEN | |
1566 | fd := GetIndice(FileInfo, f) ; | |
1567 | IF fd=NIL | |
1568 | THEN | |
1569 | FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n') ; | |
1570 | HALT | |
1571 | ELSE | |
1572 | WITH fd^.name DO | |
1573 | IF address=NIL | |
1574 | THEN | |
1575 | StrCopy('', a) | |
1576 | ELSE | |
1577 | p := address ; | |
1578 | i := 0 ; | |
1579 | WHILE (p^#nul) AND (i<=HIGH(a)) DO | |
1580 | a[i] := p^ ; | |
1581 | INC(p) ; | |
1582 | INC(i) | |
1583 | END | |
1584 | END | |
1585 | END | |
1586 | END | |
1587 | END | |
1588 | END GetFileName ; | |
1589 | ||
1590 | ||
1591 | (* | |
1592 | getFileName - returns the address of the filename associated with, f. | |
1593 | *) | |
1594 | ||
1595 | PROCEDURE getFileName (f: File) : ADDRESS ; | |
1596 | VAR | |
1597 | fd: FileDescriptor ; | |
1598 | BEGIN | |
1599 | IF f#Error | |
1600 | THEN | |
1601 | fd := GetIndice(FileInfo, f) ; | |
1602 | IF fd=NIL | |
1603 | THEN | |
1604 | FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n') ; | |
1605 | HALT | |
1606 | ELSE | |
1607 | RETURN fd^.name.address | |
1608 | END | |
1609 | END | |
1610 | END getFileName ; | |
1611 | ||
1612 | ||
1613 | (* | |
1614 | getFileNameLength - returns the number of characters associated with filename, f. | |
1615 | *) | |
1616 | ||
1617 | PROCEDURE getFileNameLength (f: File) : CARDINAL ; | |
1618 | VAR | |
1619 | fd: FileDescriptor ; | |
1620 | BEGIN | |
1621 | IF f#Error | |
1622 | THEN | |
1623 | fd := GetIndice(FileInfo, f) ; | |
1624 | IF fd=NIL | |
1625 | THEN | |
1626 | FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n') ; | |
1627 | HALT | |
1628 | ELSE | |
1629 | RETURN fd^.name.size | |
1630 | END | |
1631 | END | |
1632 | END getFileNameLength ; | |
1633 | ||
1634 | ||
1635 | (* | |
1636 | PreInitialize - preinitialize the file descriptor. | |
1637 | *) | |
1638 | ||
1639 | PROCEDURE PreInitialize (f: File; fname: ARRAY OF CHAR; | |
1640 | state: FileStatus; use: FileUsage; | |
1641 | towrite: BOOLEAN; osfd: INTEGER; bufsize: CARDINAL) ; | |
1642 | VAR | |
1643 | fd, fe: FileDescriptor ; | |
1644 | BEGIN | |
1645 | IF InitializeFile(f, ADR(fname), StrLen(fname), state, use, towrite, bufsize)=f | |
1646 | THEN | |
1647 | fd := GetIndice(FileInfo, f) ; | |
1648 | IF f=Error | |
1649 | THEN | |
1650 | fe := GetIndice(FileInfo, StdErr) ; | |
1651 | IF fe=NIL | |
1652 | THEN | |
1653 | HALT | |
1654 | ELSE | |
1655 | fd^.unixfd := fe^.unixfd (* the error channel *) | |
1656 | END | |
1657 | ELSE | |
1658 | fd^.unixfd := osfd | |
1659 | END | |
1660 | ELSE | |
1661 | HALT | |
1662 | END | |
1663 | END PreInitialize ; | |
1664 | ||
1665 | ||
1666 | (* | |
1667 | FlushOutErr - flushes, StdOut, and, StdErr. | |
1668 | It is also called when the application calls M2RTS.Terminate. | |
1669 | (which is automatically placed in program modules by the GM2 | |
1670 | scaffold). | |
1671 | *) | |
1672 | ||
1673 | PROCEDURE FlushOutErr ; | |
1674 | BEGIN | |
1675 | IF IsNoError(StdOut) | |
1676 | THEN | |
1677 | FlushBuffer(StdOut) | |
1678 | END ; | |
1679 | IF IsNoError(StdErr) | |
1680 | THEN | |
1681 | FlushBuffer(StdErr) | |
1682 | END | |
1683 | END FlushOutErr ; | |
1684 | ||
1685 | ||
1686 | (* | |
1687 | Init - initialize the modules, global variables. | |
1688 | *) | |
1689 | ||
1690 | PROCEDURE Init ; | |
1691 | BEGIN | |
1692 | FileInfo := InitIndex(0) ; | |
1693 | Error := 0 ; | |
1694 | PreInitialize(Error , 'error' , toomanyfilesopen, unused , FALSE, -1, 0) ; | |
1695 | StdIn := 1 ; | |
1696 | PreInitialize(StdIn , '<stdin>' , successful , openedforread , FALSE, 0, MaxBufferLength) ; | |
1697 | StdOut := 2 ; | |
1698 | PreInitialize(StdOut , '<stdout>', successful , openedforwrite, TRUE, 1, MaxBufferLength) ; | |
1699 | StdErr := 3 ; | |
1700 | PreInitialize(StdErr , '<stderr>', successful , openedforwrite, TRUE, 2, MaxBufferLength) ; | |
1701 | IF NOT InstallTerminationProcedure(FlushOutErr) | |
1702 | THEN | |
1703 | HALT | |
1704 | END | |
1705 | END Init ; | |
1706 | ||
1707 | ||
1708 | BEGIN | |
1709 | Init | |
1710 | FINALLY | |
1711 | FlushOutErr | |
1712 | END FIO. |