1MODULE Files;  (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
2
3  IMPORT SYSTEM, Platform, Heap, Strings, Out;
4
5
6  CONST
7    NumBufs = 4;
8    BufSize = 4096;
9    NoDesc = -1;
10
11    (* No file states, used when FileDesc.fd = NoDesc *)
12    open   = 0;    (* OS File has been opened *)
13    create = 1;    (* OS file needs to be created *)
14    close  = 2;    (* Flag used by Files.Register to tell Create to create the
15                      file using it's registerName directly, rather than to
16                      create a temporary file: i.e. since we're closing and all
17                      data is still in buffers bypass writing to temp file and
18                      then renaming and just write directly to final register
19                      name *)
20
21  TYPE
22    FileName = ARRAY 256 OF CHAR;
23    File*    = POINTER TO FileDesc;
24    Buffer   = POINTER TO BufDesc;
25
26    FileDesc = RECORD
27      workName:     FileName;
28      registerName: FileName;
29      tempFile:     BOOLEAN;
30      identity:     Platform.FileIdentity;
31      fd:           Platform.FileHandle;
32      len, pos:     LONGINT;
33      bufs:         ARRAY NumBufs OF Buffer;
34      swapper:      INTEGER;
35      state:        INTEGER;
36      next:         POINTER [1] TO FileDesc;
37    END;
38
39    BufDesc = RECORD
40      f:    File;
41      chg:  BOOLEAN;
42      org:  LONGINT;
43      size: LONGINT;
44      data: ARRAY BufSize OF SYSTEM.BYTE
45    END;
46
47    Rider* =  RECORD
48      res*:   LONGINT;  (* Residue (byte count not read) at eof of ReadBytes *)
49      eof*:   BOOLEAN;
50      buf:    Buffer;
51      org:    LONGINT;  (* File offset of block containing current position *)
52      offset: LONGINT   (* Current position offset within block at org. *)
53    END;
54
55
56  VAR
57    MaxPathLength-: INTEGER;
58    MaxNameLength-: INTEGER;
59
60    files:      POINTER [1] TO FileDesc;   (* List of files backed by an OS file, whether open, registered or temporary. *)
61    tempno:     INTEGER;
62    HOME:       ARRAY 1024 OF CHAR;
63    SearchPath: POINTER TO ARRAY OF CHAR;
64
65
66  PROCEDURE -IdxTrap "__HALT(-1)";
67
68  PROCEDURE^ Finalize(o: SYSTEM.PTR);
69
70  PROCEDURE Assert(truth: BOOLEAN);
71  BEGIN
72    IF ~truth THEN Out.Ln; ASSERT(truth) END
73  END Assert;
74
75  PROCEDURE Err(s: ARRAY OF CHAR; f: File; errcode: Platform.ErrorCode);
76  BEGIN
77    Out.Ln; Out.String("-- "); Out.String(s); Out.String(": ");
78    IF f # NIL THEN
79      IF f.registerName # "" THEN Out.String(f.registerName) ELSE Out.String(f.workName) END;
80      IF f.fd # 0 THEN Out.String(", f.fd = "); Out.Int(f.fd,1) END
81    END;
82    IF errcode # 0 THEN Out.String(", errcode = "); Out.Int(errcode, 1) END;
83    Out.Ln;
84    HALT(99)
85  END Err;
86
87  PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
88  VAR i, j, ld, ln: INTEGER;
89  BEGIN ld := Strings.Length(dir);  ln := Strings.Length(name);
90    WHILE (ld > 0) & (dir[ld-1] = '/') DO DEC(ld) END;
91    IF ld + ln + 2 > LEN(dest) THEN Err("File name too long", NIL, 0) END;
92    i := 0;
93    WHILE i < ld DO dest[i] := dir[i]; INC(i) END;
94    IF i > 0 THEN dest[i] := '/'; INC(i) END;
95    j := 0;
96    WHILE j < ln DO dest[i] := name[j]; INC(i); INC(j) END;
97    dest[i] := 0X;
98  END MakeFileName;
99
100  PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
101  VAR i, n: INTEGER;
102  BEGIN
103    IF finalName[0]='/' THEN COPY(finalName, name) ELSE MakeFileName(Platform.CWD, finalName, name) END;
104    i := Strings.Length(name)-1;
105    WHILE (i > 0) & (name[i] # '/') DO DEC(i) END;
106    IF i+16 >= LEN(name) THEN Err("File name too long", NIL, 0) END;
107    INC(tempno); n := tempno;
108    name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
109    WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
110    name[i] := "."; INC(i); n := Platform.PID;
111    WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0"));  n := n DIV 10; INC(i) END;
112    name[i] := 0X
113  END GetTempName;
114
115  (* When registering a file, it may turn out that the name we want to use
116     is aready in use by another File. E.g. the compiler opens and reads
117     an existing symbol file if present before creating an updated one.
118     When this happens on Windows, creation of the new file will be blocked
119     by the presence of the old one because it is in a open state. Further,
120     on both Unix and Windows systems we want behaviour to match that of
121     a real Oberon system, where registering the new file has the effect of
122     unregistering the old file. To simulate this we need to change the old
123     Files.File back to a temp file. *)
124  PROCEDURE Deregister(name: ARRAY OF CHAR);
125  VAR
126    identity: Platform.FileIdentity;
127    osfile:   File;
128    error:    Platform.ErrorCode;
129  BEGIN
130    IF Platform.IdentifyByName(name, identity) = 0 THEN
131      (* The name we are registering is an already existing file. *)
132      osfile := files;
133      WHILE (osfile # NIL) & ~Platform.SameFile(osfile.identity, identity) DO osfile := osfile.next END;
134      IF osfile # NIL THEN
135        (* osfile is the FileDesc corresponding to the file name we are hoping
136           to register. Turn it into a temporary file. *)
137        ASSERT(~osfile.tempFile); ASSERT(osfile.fd >= 0);
138        osfile.registerName := osfile.workName;
139        GetTempName(osfile.registerName, osfile.workName);
140        osfile.tempFile := TRUE;
141        osfile.state := open;
142        error := Platform.Rename(osfile.registerName, osfile.workName);
143        IF error # 0 THEN
144          Err("Couldn't rename previous version of file being registered", osfile, error)
145        END
146      END
147    END
148  END Deregister;
149
150
151  PROCEDURE Create(f: File);
152  (* Makes sure there is an OS file backing this Oberon file.
153     Used when more data has been written to an unregistered new file than
154     buffers can hold, or when registering a new file whose data is all in
155     buffers. *)
156    VAR
157      done:     BOOLEAN;
158      error:    Platform.ErrorCode;
159      err:      ARRAY 32 OF CHAR;
160  BEGIN
161    IF f.fd = NoDesc THEN
162      IF f.state = create THEN
163        (* New file with enough data written to exceed buffers, so we need to
164           create a temporary file to back it. *)
165        GetTempName(f.registerName, f.workName); f.tempFile := TRUE
166      ELSE
167        ASSERT(f.state = close);
168        (* New file with all data in buffers being registered. No need for a
169           temp file, will just write the buffers to the registerName. *)
170        Deregister(f.registerName);
171        f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
172      END;
173      error := Platform.Unlink(f.workName);  (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
174      error := Platform.New(f.workName, f.fd);
175      done := error = 0;
176      IF done THEN
177        f.next := files;  files := f;  (* Link this file into the list of OS backed files. *)
178        INC(Heap.FileCount);
179        Heap.RegisterFinalizer(f, Finalize);
180        f.state := open;
181        f.pos   := 0;
182        error   := Platform.Identify(f.fd, f.identity);
183      ELSE
184        IF    Platform.NoSuchDirectory(error) THEN err := "no such directory"
185        ELSIF Platform.TooManyFiles(error)    THEN err := "too many files open"
186        ELSE  err := "file not created"
187        END;
188        Err(err, f, error)
189      END
190    END
191  END Create;
192
193  PROCEDURE Flush(buf: Buffer);
194    VAR
195      error:     Platform.ErrorCode;
196      f:         File;
197      (* identity:  Platform.FileIdentity; *)
198  BEGIN
199    IF buf.chg THEN f := buf.f; Create(f);
200      IF buf.org # f.pos THEN
201        error := Platform.Seek(f.fd, buf.org, Platform.SeekSet);
202      END;
203      error := Platform.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
204      IF error # 0 THEN Err("error writing file", f, error) END;
205      f.pos := buf.org + buf.size;
206      buf.chg := FALSE;
207      error := Platform.Identify(f.fd, f.identity); (* Update identity with new modification time. *)
208      IF error # 0 THEN Err("error identifying file", f, error) END;
209    END
210  END Flush;
211
212  PROCEDURE Close* (f: File);
213    VAR
214      i: LONGINT;  error: Platform.ErrorCode;
215  BEGIN
216    IF (f.state # create) OR (f.registerName # "") THEN
217      Create(f); i := 0;
218      WHILE (i < NumBufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END;
219    END
220  END Close;
221
222  PROCEDURE Length* (f: File): LONGINT;
223  BEGIN RETURN f.len END Length;
224
225  PROCEDURE New* (name: ARRAY OF CHAR): File;
226    VAR f: File;
227  BEGIN
228    NEW(f); f.workName := ""; COPY(name, f.registerName);
229    f.fd := NoDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
230    RETURN f
231  END New;
232
233  PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR);
234  (* Extract next individual directory from searchpath starting at pos,
235     updating pos and returning dir.
236     Supports ~, ~user and blanks inside path *)
237  VAR i: INTEGER; ch: CHAR;
238  BEGIN
239    i := 0;
240    IF SearchPath = NIL THEN
241      IF pos = 0 THEN
242        dir[0] := "."; i := 1; INC(pos) (* Default search path is just the current directory *)
243      END
244    ELSE
245      ch := SearchPath[pos];
246      WHILE (ch = " ") OR (ch = ";") DO INC(pos); ch := SearchPath[pos] END;
247      IF ch = "~" THEN
248        INC(pos); ch := SearchPath[pos];
249        WHILE HOME[i] # 0X DO dir[i] := HOME[i]; INC(i) END;
250        IF (ch # "/") & (ch # 0X) & (ch # ";") & (ch # " ") THEN
251          WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
252        END
253      END;
254      WHILE (ch # 0X) & (ch # ";") DO dir[i] := ch; INC(i); INC(pos); ch := SearchPath[pos] END;
255      WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END
256    END;
257    dir[i] := 0X
258  END ScanPath;
259
260  PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
261    VAR i: INTEGER; ch: CHAR;
262  BEGIN i := 0; ch := name[0];
263    WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END;
264    RETURN ch = "/"
265  END HasDir;
266
267  PROCEDURE CacheEntry(identity: Platform.FileIdentity): File;
268    VAR f: File;  i: INTEGER;  error: Platform.ErrorCode;
269  BEGIN f := files;
270    WHILE f # NIL DO
271      IF Platform.SameFile(identity, f.identity) THEN
272        IF ~Platform.SameFileTime(identity, f.identity) THEN i := 0;
273          WHILE i < NumBufs DO
274            IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END;
275            INC(i)
276          END;
277          f.swapper := -1; f.identity := identity;
278          error := Platform.Size(f.fd, f.len);
279        END;
280        RETURN f
281      END;
282      f := f.next
283    END;
284    RETURN NIL
285  END CacheEntry;
286
287  PROCEDURE Old*(name: ARRAY OF CHAR): File;
288    VAR
289      f:         File;
290      fd:        Platform.FileHandle;
291      pos:       INTEGER;
292      done:      BOOLEAN;
293      dir, path: ARRAY 256 OF CHAR;
294      error:     Platform.ErrorCode;
295      identity:  Platform.FileIdentity;
296  BEGIN
297    (* Out.String("Files.Old "); Out.String(name); Out.Ln; *)
298    IF name # "" THEN
299      IF HasDir(name) THEN dir := ""; COPY(name, path)
300      ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
301      END;
302      LOOP
303        error := Platform.OldRW(path, fd); done := error = 0;
304        IF ~done & Platform.TooManyFiles(error) THEN Err("too many files open", f, error) END;
305        IF ~done & Platform.Inaccessible(error) THEN
306          error := Platform.OldRO(path, fd); done := error = 0;
307        END;
308        IF ~done & ~Platform.Absent(error) THEN
309          Out.String("Warning: Files.Old "); Out.String(name);
310          Out.String(" error = "); Out.Int(error, 0); Out.Ln;
311        END;
312        IF done THEN
313          (* Out.String("  fd = "); Out.Int(fd,1); Out.Ln; *)
314          error := Platform.Identify(fd, identity);
315          f := CacheEntry(identity);
316          IF f # NIL THEN
317            error := Platform.Close(fd); (* fd not needed - we'll be using f.fd. *)
318            RETURN f
319          ELSE NEW(f); Heap.RegisterFinalizer(f, Finalize);
320            f.fd := fd; f.state := open; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
321            error := Platform.Size(fd, f.len);
322            COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
323            f.identity := identity;
324            f.next := files;  files := f; INC(Heap.FileCount);
325            RETURN f
326          END
327        ELSIF dir = "" THEN RETURN NIL
328        ELSE MakeFileName(dir, name, path); ScanPath(pos, dir)
329        END
330      END
331    ELSE RETURN NIL
332    END
333  END Old;
334
335  PROCEDURE Purge* (f: File);
336    VAR i: INTEGER;  identity: Platform.FileIdentity;  error: Platform.ErrorCode;
337  BEGIN i := 0;
338    WHILE i < NumBufs DO
339      IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END;
340      INC(i)
341    END;
342    IF f.fd # NoDesc THEN
343      error := Platform.Truncate(f.fd, 0);
344      error := Platform.Seek(f.fd, 0, Platform.SeekSet)
345    END;
346    f.pos := 0; f.len := 0; f.swapper := -1;
347    error := Platform.Identify(f.fd, identity); Platform.SetMTime(f.identity, identity)
348  END Purge;
349
350  PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
351    VAR
352      identity: Platform.FileIdentity;  error: Platform.ErrorCode;
353  BEGIN
354    Create(f); error := Platform.Identify(f.fd, identity);
355    Platform.MTimeAsClock(identity, t, d)
356  END GetDate;
357
358  PROCEDURE Pos* (VAR r: Rider): LONGINT;
359  BEGIN
360    Assert(r.offset <= BufSize);
361    RETURN r.org + r.offset
362  END Pos;
363
364  PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
365    VAR org, offset, i, n: LONGINT;  buf: Buffer;  error: Platform.ErrorCode;
366  BEGIN
367    IF f # NIL THEN
368      IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END;
369      offset := pos MOD BufSize; org := pos - offset; i := 0;
370      WHILE (i < NumBufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
371      IF i < NumBufs THEN
372        IF f.bufs[i] = NIL THEN
373          NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
374        ELSE buf := f.bufs[i]
375        END
376      ELSE
377        f.swapper := (f.swapper + 1) MOD NumBufs;
378        buf := f.bufs[f.swapper];
379        Flush(buf)
380      END;
381      IF buf.org # org THEN
382        IF org = f.len THEN buf.size := 0
383        ELSE Create(f);
384          IF f.pos # org THEN error := Platform.Seek(f.fd, org, Platform.SeekSet) END;
385          error := Platform.ReadBuf(f.fd, buf.data, n);
386          IF error # 0 THEN Err("read from file not done", f, error) END;
387          f.pos := org + n;
388          buf.size := n
389        END;
390        buf.org := org; buf.chg := FALSE
391      END
392    ELSE buf := NIL; org := 0; offset := 0
393    END;
394    Assert(offset <= BufSize);
395    r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
396  END Set;
397
398  PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
399    VAR offset: LONGINT; buf: Buffer;
400  BEGIN
401    buf := r.buf; offset := r.offset;
402    IF r.org # buf.org THEN
403      Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
404    END;
405    Assert(offset <= buf.size);
406    IF (offset < buf.size) THEN
407      x := buf.data[offset]; r.offset := offset + 1
408    ELSIF r.org + offset < buf.f.len THEN
409      Set(r, r.buf.f, r.org + offset);
410      x := r.buf.data[0]; r.offset := 1
411    ELSE
412      x := 0X; r.eof := TRUE
413    END
414  END Read;
415
416  PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
417    VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
418  BEGIN
419    IF n > LEN(x) THEN IdxTrap END;
420    xpos   := 0;
421    buf    := r.buf;
422    offset := r.offset;  (* Offset within buffer r.buf *)
423    WHILE n > 0 DO
424      IF (r.org # buf.org) OR (offset >= BufSize) THEN
425        Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
426      END;
427      restInBuf := buf.size - offset;
428      IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
429      ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END;
430      SYSTEM.MOVE(SYSTEM.ADR(buf.data[offset]), SYSTEM.ADR(x[xpos]), min);
431      INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min);
432      Assert(offset <= BufSize)
433    END;
434    r.res := 0; r.eof := FALSE
435  END ReadBytes;
436
437  PROCEDURE Base* (VAR r: Rider): File;
438  BEGIN RETURN r.buf.f
439  END Base;
440
441  PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
442    VAR buf: Buffer; offset: LONGINT;
443  BEGIN
444    buf := r.buf; offset := r.offset;
445    Assert(offset <= BufSize);
446    IF (r.org # buf.org) OR (offset >= BufSize) THEN
447      Set(r, buf.f, r.org + offset);
448      buf := r.buf; offset := r.offset
449    END;
450    Assert(offset < BufSize);
451    buf.data[offset] := x;
452    buf.chg := TRUE;
453    IF offset = buf.size THEN
454      INC(buf.size); INC(buf.f.len)
455    END;
456    r.offset := offset + 1; r.res := 0
457  END Write;
458
459  PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
460    VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
461  BEGIN
462    IF n > LEN(x) THEN IdxTrap END;
463    xpos := 0; buf := r.buf; offset := r.offset;
464    WHILE n > 0 DO
465      Assert(offset <= BufSize);
466      IF (r.org # buf.org) OR (offset >= BufSize) THEN
467        Set(r, buf.f, r.org + offset);
468        buf := r.buf; offset := r.offset
469      END;
470      Assert(offset <= BufSize);
471      restInBuf := BufSize - offset;
472      IF n > restInBuf THEN min := restInBuf ELSE min := n END;
473      SYSTEM.MOVE(SYSTEM.ADR(x[xpos]), SYSTEM.ADR(buf.data[offset]), min);
474      INC(offset, min); r.offset := offset;
475      Assert(offset <= BufSize);
476      IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END;
477      INC(xpos, min); DEC(n, min); buf.chg := TRUE
478    END;
479    r.res := 0
480  END WriteBytes;
481
482(* another solution would be one that is similar to ReadBytes, WriteBytes.
483No code duplication, more symmetric, only two ifs for
484Read and Write in buffer, buf.size replaced by BufSize in Write ops, buf.size and len
485must be made consistent with offset (if offset > buf.size) in a lazy way.
486
487PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
488  VAR buf: Buffer; offset: LONGINT;
489BEGIN
490  buf := r.buf; offset := r.offset;
491  IF (offset >= BufSize) OR (r.org # buf.org) THEN
492    Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
493  END;
494  buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
495END Write;
496
497PROCEDURE WriteBytes ...
498
499PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
500  VAR offset: LONGINT; buf: Buffer;
501BEGIN
502  buf := r.buf; offset := r.offset;
503  IF (offset >= buf.size) OR (r.org # buf.org) THEN
504    IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
505    ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
506    END
507  END;
508  x := buf.data[offset]; r.offset := offset + 1
509END Read;
510
511but this would also affect Set, Length, and Flush.
512Especially Length would become fairly complex.
513*)
514
515  PROCEDURE Delete*(name: ARRAY OF CHAR; VAR res: INTEGER);
516  BEGIN
517    Deregister(name);
518    res := Platform.Unlink(name)
519  END Delete;
520
521  PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
522    VAR
523      fdold, fdnew: Platform.FileHandle;
524      n: LONGINT;
525      error, ignore: Platform.ErrorCode;
526      oldidentity, newidentity: Platform.FileIdentity;
527      buf: ARRAY 4096 OF CHAR;
528  BEGIN
529    error := Platform.IdentifyByName(old, oldidentity);
530    IF error = 0 THEN
531      error := Platform.IdentifyByName(new, newidentity);
532      IF (error # 0) & ~Platform.SameFile(oldidentity, newidentity) THEN
533        Delete(new, error);  (* work around stale nfs handles *)
534      END;
535      error := Platform.Rename(old, new);
536      (* Out.String("Platform.Rename error code "); Out.Int(error,1); Out.Ln; *)
537      (* TODO, if we already have a FileDesc for old, it ought to be updated
538         with the new workname. *)
539      IF ~Platform.DifferentFilesystems(error) THEN
540        res := error; RETURN
541      ELSE
542        (* cross device link, move the file *)
543        error := Platform.OldRO(old, fdold);
544        IF error # 0 THEN res := 2; RETURN END;
545        error := Platform.New(new, fdnew);
546        IF error # 0 THEN error := Platform.Close(fdold); res := 3; RETURN END;
547        error := Platform.Read(fdold, SYSTEM.ADR(buf), BufSize, n);
548        WHILE n > 0 DO
549          error := Platform.Write(fdnew, SYSTEM.ADR(buf), n);
550          IF error # 0 THEN
551            ignore := Platform.Close(fdold);
552            ignore := Platform.Close(fdnew);
553            Err("cannot move file", NIL, error)
554          END;
555          error := Platform.Read(fdold, SYSTEM.ADR(buf), BufSize, n);
556        END;
557        ignore := Platform.Close(fdold);
558        ignore := Platform.Close(fdnew);
559        IF n = 0 THEN
560          error := Platform.Unlink(old); res := 0
561        ELSE
562          Err("cannot move file", NIL, error)
563        END;
564      END
565    ELSE
566      res := 2 (* old file not found *)
567    END
568  END Rename;
569
570  PROCEDURE Register* (f: File);
571    VAR idx, errcode: INTEGER; f1: File;
572  BEGIN
573    IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END;
574    Close(f);
575    IF f.registerName # "" THEN
576      Deregister(f.registerName);
577      Rename(f.workName, f.registerName, errcode);
578      IF errcode # 0 THEN Err("Couldn't rename temp name as register name", f, errcode) END;
579      f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
580    END
581  END Register;
582
583  PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
584  BEGIN
585    res := Platform.Chdir(path);
586  END ChangeDirectory;
587
588  PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
589    VAR i, j: LONGINT;
590  BEGIN
591    IF ~Platform.LittleEndian THEN i := LEN(src); j := 0;
592      WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
593    ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
594    END
595  END FlipBytes;
596
597  PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
598  BEGIN Read(R, SYSTEM.VAL(CHAR, x))
599  END ReadBool;
600
601  PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
602    VAR b: ARRAY 2 OF CHAR;
603  BEGIN ReadBytes(R, b, 2);
604    x := ORD(b[0]) + ORD(b[1])*256
605  END ReadInt;
606
607  PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
608    VAR b: ARRAY 4 OF CHAR;
609  BEGIN ReadBytes(R, b, 4);
610    x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
611  END ReadLInt;
612
613  PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
614  (* Reads 32 bits as a SET value (even on 64 bit systems. See Oakwood appendix 1.2.5.4 *)
615    VAR b: ARRAY 4 OF CHAR; l: LONGINT;
616  BEGIN ReadBytes(R, b, 4);
617    (* Need to read via a LONGINT to provide correct behaviour for 64 bit sets. *)
618    l := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H;
619    x := SYSTEM.VAL(SET, l)
620  END ReadSet;
621
622  PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
623    VAR b: ARRAY 4 OF CHAR;
624  BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
625  END ReadReal;
626
627  PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
628    VAR b: ARRAY 8 OF CHAR;
629  BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
630  END ReadLReal;
631
632  PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
633    VAR i: INTEGER; ch: CHAR;
634  BEGIN i := 0;
635    REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
636  END ReadString;
637
638  PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
639  VAR i: INTEGER;
640  BEGIN
641    i := 0; REPEAT Read(R, x[i]); INC(i) UNTIL (x[i-1] = 0X) OR (x[i-1] = 0AX);
642    IF x[i-1] = 0AX THEN DEC(i) END;             (* Omit trailing LF *)
643    IF (i > 0) & (x[i-1] = 0DX) THEN DEC(i) END; (* Also omit preceeding trailing CR if present. *)
644    x[i] := 0X;                                  (* Guarantee zero termination. *)
645  END ReadLine;
646
647  PROCEDURE ReadNum*(VAR R: Rider; VAR x: ARRAY OF SYSTEM.BYTE);
648    VAR s, b: SYSTEM.INT8; q: SYSTEM.INT64;
649  BEGIN s := 0; q := 0; Read(R, b);
650    WHILE b < 0 DO INC(q, ASH(b+128, s)); INC(s, 7); Read(R, b) END;
651    INC(q, ASH(b MOD 64 - b DIV 64 * 64, s));
652    Assert(LEN(x) <= 8);
653    SYSTEM.MOVE(SYSTEM.ADR(q), SYSTEM.ADR(x), LEN(x))  (* Assumes little endian representation of q and x. *)
654  END ReadNum;
655
656  PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
657  BEGIN Write(R, SYSTEM.VAL(CHAR, x))
658  END WriteBool;
659
660  PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
661    VAR b: ARRAY 2 OF CHAR;
662  BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
663    WriteBytes(R, b, 2);
664  END WriteInt;
665
666  PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
667    VAR b: ARRAY 4 OF CHAR;
668  BEGIN
669    b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
670    WriteBytes(R, b, 4);
671  END WriteLInt;
672
673  PROCEDURE WriteSet* (VAR R: Rider; x: SET);
674    VAR b: ARRAY 4 OF CHAR; i: LONGINT;
675  BEGIN i := SYSTEM.VAL(LONGINT, x);
676    b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
677    WriteBytes(R, b, 4);
678  END WriteSet;
679
680  PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
681    VAR b: ARRAY 4 OF CHAR;
682  BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
683  END WriteReal;
684
685  PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
686    VAR b: ARRAY 8 OF CHAR;
687  BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
688  END WriteLReal;
689
690  PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
691    VAR i: INTEGER;
692  BEGIN i := 0;
693    WHILE x[i] # 0X DO INC(i) END;
694    WriteBytes(R, x, i+1)
695  END WriteString;
696
697  PROCEDURE WriteNum* (VAR R: Rider; x: SYSTEM.INT64);
698  BEGIN
699    WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
700    Write(R, CHR(x MOD 128))
701  END WriteNum;
702
703  PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
704  BEGIN
705     COPY (f.workName, name);
706  END GetName;
707
708  PROCEDURE CloseOSFile(f: File);
709  (* Close the OS file handle and remove f from 'files' *)
710    VAR prev: File; error: Platform.ErrorCode;
711  BEGIN
712    IF files = f THEN files := f.next
713    ELSE
714      prev := files;
715      WHILE (prev # NIL) & (prev.next # f) DO prev := prev.next END;
716      IF prev.next # NIL THEN prev.next := f.next END
717    END;
718    error := Platform.Close(f.fd);
719    f.fd := NoDesc; f.state := create; DEC(Heap.FileCount);
720  END CloseOSFile;
721
722  PROCEDURE Finalize(o: SYSTEM.PTR);
723    VAR f: File; res: LONGINT;
724  BEGIN
725    f := SYSTEM.VAL(File, o);
726    IF f.fd >= 0 THEN
727      CloseOSFile(f);
728      IF f.tempFile THEN res := Platform.Unlink(f.workName) END
729    END
730  END Finalize;
731
732  PROCEDURE SetSearchPath*(path: ARRAY OF CHAR);
733  BEGIN
734    IF Strings.Length(path) # 0 THEN
735      NEW(SearchPath, Strings.Length(path)+1);
736      COPY(path, SearchPath^)
737    ELSE
738      SearchPath := NIL
739    END
740  END SetSearchPath;
741
742
743BEGIN
744  tempno := -1;
745  Heap.FileCount := 0;
746  HOME := "";  Platform.GetEnv("HOME", HOME);
747  MaxPathLength := Platform.MaxPathLength();
748  MaxNameLength := Platform.MaxNameLength();
749END Files.
750