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