@ Syntax10.Scn.Fnt Syntax10i.Scn.FntA+"9; o.Syntax10b.Scn.Fnt1(yS8FoldElemsNewo,8C0%'EMarkElemsAlloch*9 %FV;SW;.e'88 9w- )Kσ288 O(  l8'8 b]8B8 ?8p8 @8\8 6e8G/ /g8 {KRN~C%\%l,  rDQ /{ .Z @sMB>N4 /(b 6 b b^Y` e `  a!\" W# ^$ c% &Y;y_MODULE Files; (* MH Feb 93 / 5.5.94, CS Okt 95, CS Win95-Version, Sept 96 *) IMPORT S := SYSTEM, Kernel, Directories, C := Console, ShowError; CONST bufSize = 1024 + 12; (* 12 bytes would remain unused in BufDesc allocated on heap *) nofbufs = 4; (* buffers per file *) fileTabSize = 64; (* max number of open files *) InvalidHandle = -1; (* invalid Win32 file handle *) none = -1; NULL = 0; registered = 1; immutable = 2; (* file flags *) ShareRead = 1; ShareWrite = 2; TooManyOpenFiles = 4; noErr = Directories.noErr; TYPE LPSZ = LONGINT; (* Win32: pointer to zero terminated string *) Win32Handle = LONGINT; File* = POINTER TO Handle; Buffer = POINTER TO BufDesc; Handle = RECORD dir: Directories.Directory; name, regName: ARRAY 32 OF CHAR; flags: SET; (* e.g., registered, immutable *) fd: Win32Handle; (* Win32 file descriptor *) ix: INTEGER; (* index in fileTab, or none *) buf: ARRAY nofbufs OF Buffer; len: LONGINT; (* length of file w/o header *) pos: LONGINT; (* cached file pointer position of fd *) swapper: INTEGER; (* next buffer to be swapped *) END ; BufDesc = RECORD f: File; changed: BOOLEAN; org, size: LONGINT; data: ARRAY bufSize OF S.BYTE END ; Rider* = RECORD eof*: BOOLEAN; res*: LONGINT; buf: Buffer; org, offset: LONGINT (* w/o header *) END ; Array2 = ARRAY 2 OF CHAR; Array4 = ARRAY 4 OF CHAR; Array8 = ARRAY 8 OF CHAR; FileTime = RECORD low, high: LONGINT END ; SystemTime = RECORD year, month, weekday, day: INTEGER; hour, min, sec, millisec: INTEGER END ; Win32FindData = RECORD (* WIN32_FIND_DATA *) attrib: SET; (* file attributes *) creation, lastAcc, lastWrite: FileTime; sizeH, sizeL: LONGINT; res0, res1: LONGINT; name: ARRAY 260 (* = MAX_PATH *) OF CHAR; altName: ARRAY 14 OF CHAR END ; CONST FileAttrNormal = 80H; (* file attributes *) CreateNew = 1; CreateAlways = 2; OpenExisting = 3; OpenAlways = 4; (* file creation options *) GenReadWrite = 0C0000000H; GenRead = 80000000H; (* file access modes *) VAR (* Win32 API calls *) MoveFile: PROCEDURE (oldName, newName: LONGINT): BOOLEAN; CreateFile: PROCEDURE (name: LPSZ; accessMode: LONGINT; shareMode: LONGINT; securityAttr: LONGINT; createOpts: LONGINT; attrAndFlags: LONGINT; template: Win32Handle): Win32Handle; CloseHandle: PROCEDURE (h: Win32Handle): BOOLEAN; ReadFile: PROCEDURE (f: Win32Handle; data: LONGINT; count: LONGINT; VAR read: LONGINT; ovrlp: LONGINT): BOOLEAN; WriteFile: PROCEDURE (f: Win32Handle; data, count: LONGINT; VAR written: LONGINT; ovrlp: LONGINT): BOOLEAN; SetFilePointer: PROCEDURE (fd: Win32Handle; dist: LONGINT; distHigh: LONGINT; meth: LONGINT): LONGINT; GetFileSize: PROCEDURE (f: Win32Handle; fileSizeHigh: LONGINT): LONGINT; SetEndOfFile: PROCEDURE (fd: Win32Handle): BOOLEAN; SetHandleCount: PROCEDURE (nofHandles: LONGINT): LONGINT; GetFileTime: PROCEDURE (fd: LONGINT; creation, lastAccess, lastWrite: LONGINT): BOOLEAN; FileTimeToSystemTime: PROCEDURE (ft: LONGINT; st: LONGINT): BOOLEAN; GetLastError: PROCEDURE (): LONGINT; GetTickCount: PROCEDURE (): LONGINT; DelFile: PROCEDURE (name: LONGINT): BOOLEAN; FindFirstFile: PROCEDURE (filename: LONGINT; data: LONGINT): LONGINT; FindClose: PROCEDURE (hFindFile: LONGINT); fileTab: ARRAY fileTabSize OF (*File*) LONGINT; (* table of opened, physical files *) filename: ARRAY 32 OF CHAR; f: File; (* global variables used for callback function initiated by Old *) tempno: LONGINT; PROCEDURE SplitName (VAR (*in*) name: ARRAY OF CHAR; VAR path, filename: ARRAY OF CHAR); VAR i, j, pos: INTEGER; (* pos = position of first filename character *) absName: ARRAY 140 OF CHAR; startupDir: Directories.Directory; BEGIN IF name[0] = "$" THEN startupDir := Directories.Startup(); COPY(startupDir.path, absName); i := 0; WHILE absName[i] # 0X DO INC(i) END ; IF name[1] # Directories.delimiter THEN absName[i] := Directories.delimiter; INC(i) END ; j := 1; WHILE name[j] # 0X DO absName[i] := name[j]; INC(i); INC(j) END ; absName[i] := 0X ELSE COPY(name, absName) END ; pos := 0; i := 0; WHILE absName[i] # 0X DO IF absName[i] = Directories.delimiter THEN pos := i END ; INC(i) END ; COPY(absName, path); IF pos = 0 THEN IF (path[1] = ":") & (path[2] # Directories.delimiter) THEN i := 0; j := 2; WHILE path[j] # 0X DO filename[i] := path[j]; INC(i); INC(j) END ; filename[i] := 0X; path[2] := 0X ELSE (* no path *) path[0] := 0X; COPY(absName, filename) END ELSE (* cut last \ *) IF path[pos - 1] = ":" THEN (* keep "\", e.g. "d:\" *) path[pos + 1] := 0X ELSE path[pos] := 0X END ; i := 0; INC(pos); WHILE absName[pos] # 0X DO filename[i] := absName[pos]; INC(pos); INC(i) END ; filename[i] := 0X END END SplitName; PROCEDURE FullPathName (VAR (*in*) path: ARRAY OF CHAR; VAR (*in*) name: ARRAY OF CHAR; VAR fullName: ARRAY OF CHAR); (* path and name in URL format, fullName in local format *) VAR i, j, max: LONGINT; BEGIN COPY(path, fullName); i := 0; j := 0; max := LEN(fullName) - 1; WHILE fullName[i] # 0X DO INC(i) END ; IF (i > 0) & (fullName[i - 1] # Directories.delimiter) THEN fullName[i] := Directories.delimiter; INC(i) END ; WHILE (i < max) & (name[j] # 0X) DO fullName[i] := name[j]; INC(i); INC(j) END ; fullName[i] := 0X; Directories.URLToLocal(fullName) END FullPathName; PROCEDURE Exists (dir: Directories.Directory; VAR (*in*) name: ARRAY OF CHAR): BOOLEAN; VAR fullName: ARRAY 256 OF CHAR; sh: LONGINT; b: Win32FindData; BEGIN FullPathName(dir.path, name, fullName); sh := FindFirstFile(S.ADR(fullName), S.ADR(b)); IF sh # InvalidHandle THEN FindClose(sh); RETURN TRUE ELSE RETURN FALSE END END Exists; PROCEDURE Dir (VAR (*in*) path: ARRAY OF CHAR): Directories.Directory; BEGIN IF path = "" THEN RETURN Directories.Current() ELSE RETURN Directories.This(path) END END Dir; PROCEDURE SetFilePos (f: File; pos: LONGINT); CONST FileBegin = 0; VAR res: LONGINT; BEGIN res := SetFilePointer(f.fd, pos, NULL, FileBegin); f.pos := pos; IF res = 0FFFFFFFFH THEN ShowError.Do("SetFilePointer"); HALT(99) END END SetFilePos; PROCEDURE GetTempName (VAR name: ARRAY OF CHAR);  VAR n, i: LONGINT; BEGIN INC(tempno); n := tempno; COPY("Oberon.Tmp.0000000000", name); i := 20; WHILE n # 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; DEC(i) END END GetTempName;  PROCEDURE GetIndex (VAR i: INTEGER); (* returns index of empty file entry in fileTab, or else none *) VAR firstTry: BOOLEAN; BEGIN firstTry := TRUE; LOOP i := 0; WHILE i < fileTabSize DO IF fileTab[i] = NULL THEN RETURN END ; INC(i) END ; IF ~firstTry THEN EXIT END ; (* no empty handle, close unused files *) Kernel.GC; firstTry := FALSE END ; i := none END GetIndex; PROCEDURE Match (VAR (*in*) s1, s2: ARRAY OF CHAR): BOOLEAN; VAR i: INTEGER; BEGIN i := 0; WHILE (s1[i] # 0X) & (s2[i] # 0X) & (CAP(s1[i]) = CAP(s2[i])) DO INC(i) END ; RETURN (s1[i] = 0X) & (s2[i] = 0X) END Match;  PROCEDURE ThisFile (dir: Directories.Directory; VAR (*in*) name: ARRAY OF CHAR): File; (* search for open file with oberon name name in directory dir (case insensitive) *) VAR i: INTEGER; f: File; BEGIN i := 0; WHILE i < fileTabSize DO f := S.VAL(File, fileTab[i]); IF (f # NIL) & Match(f.name, name) & Match(f.dir.path, dir.path) THEN RETURN f END ; INC(i) END ; RETURN NIL END ThisFile; PROCEDURE^ DeleteFile (dir: Directories.Directory; VAR (*in*) name: ARRAY OF CHAR; VAR done: BOOLEAN); PROCEDURE RenameFile (fromDir, toDir: Directories.Directory; VAR (*in*) from, to: ARRAY OF CHAR; VAR done: BOOLEAN);  VAR fullFrom, fullTo: ARRAY 256 OF CHAR; inUse: BOOLEAN; f: File; BEGIN (* C.Ln; C.Str("RenameFile: "); *) IF ~Match(fromDir.path, toDir.path) OR ~Match(from, to) THEN DeleteFile(toDir, to, done) END ; FullPathName(fromDir.path, from, fullFrom); FullPathName(toDir.path, to, fullTo); f := ThisFile(fromDir, from); inUse := f # NIL; IF inUse THEN done := CloseHandle(f.fd); ASSERT(done) END ; (* C.Ln; C.Str(" Renaming "); C.Str(fullFrom); C.Ln; C.Str(" to "); C.Str(fullTo); *) done := MoveFile(S.ADR(fullFrom), S.ADR(fullTo)); IF inUse THEN IF ~done THEN ShowError.Do("MoveFile"); fullTo := fullFrom END ; f.fd := CreateFile(S.ADR(fullTo), GenReadWrite, ShareRead + ShareWrite, NULL, OpenExisting, FileAttrNormal, NULL); ASSERT(f.fd # InvalidHandle); f.pos := -1 END END RenameFile;  PROCEDURE DeleteFile (dir: Directories.Directory; VAR (*in*) name: ARRAY OF CHAR; VAR done: BOOLEAN);  (* if specified file is in fileTab then unregister it else delete it *) VAR f: File; fullName: ARRAY 256 OF CHAR; temp: ARRAY 32 OF CHAR; BEGIN IF Exists(dir, name) THEN FullPathName(dir.path, name, fullName); f := ThisFile(dir, name); IF f = NIL THEN (* C.Ln; C.Str("Deleting "); C.Str(fullName); *) done := DelFile(S.ADR(fullName)); IF ~done THEN ShowError.Do("DelFile"); ShowError.CallStack(FALSE) END; ELSE GetTempName(temp); RenameFile(dir, dir, f.name, temp, done); IF done THEN EXCL(f.flags, registered); COPY(temp, f.name) END END END END DeleteFile;  PROCEDURE Win32Create (f: File; createFlags: LONGINT; VAR err: LONGINT);  VAR fd: LONGINT; fullName: ARRAY 256 OF CHAR; BEGIN err := noErr; EXCL(f.flags, immutable); FullPathName(f.dir.path, f.name, fullName); fd := CreateFile(S.ADR(fullName), GenReadWrite, ShareRead + ShareWrite, NULL, createFlags, FileAttrNormal, NULL); IF fd = InvalidHandle THEN fd := CreateFile(S.ADR(fullName), GenRead, ShareRead + ShareWrite, NULL, createFlags, FileAttrNormal, NULL); INCL(f.flags, immutable); END ; IF fd = InvalidHandle THEN err := GetLastError(); IF err # 2 (* fnfErr *) THEN C.Str("fullName="); C.Str(fullName); C.Ln; ShowError.Do("Win32Create") END END ; f.fd := fd END Win32Create;  PROCEDURE OpenPhysical (f: File; createFlags: LONGINT; VAR err: LONGINT);  VAR i: INTEGER; BEGIN GetIndex(i); IF i < 0 THEN C.Str("Too many open Oberon file handles"); C.Ln; HALT(22) END ; Win32Create(f, createFlags, err); IF err = TooManyOpenFiles THEN (* too many open DOS files *) C.Str("Too many open DOS files. Trying to close some."); C.Ln; Kernel.GC; Win32Create(f, createFlags, err); IF err = TooManyOpenFiles THEN C.Str("Still too many open DOS files: fatal error"); C.Ln; HALT(22) END END ; IF f.fd # InvalidHandle THEN fileTab[i] := S.VAL(LONGINT, f); f.ix := i; SetFilePos(f, 0) END END OpenPhysical;  PROCEDURE Create (f: File);  (* called for temporary files if one of their buffers gets read or written *) VAR done: BOOLEAN; res: LONGINT; BEGIN (* f.ix = none *) GetTempName(f.name); (* use f.dir and f.regName for later registration *) DeleteFile(f.dir, f.name, done); OpenPhysical(f, CreateNew, res); ASSERT(res = noErr) END Create;  PROCEDURE Flush (buf: Buffer); VAR nofWritten: LONGINT; done: BOOLEAN; f: File; BEGIN IF buf.changed THEN f := buf.f; IF f.ix = none THEN Create(f) END ; ASSERT(~(immutable IN f.flags)); IF buf.org # f.pos THEN SetFilePos(f, buf.org) END ; done := WriteFile(f.fd, S.ADR(buf.data), buf.size, nofWritten, NULL) & (nofWritten = buf.size); IF ~done THEN ShowError.Do("WriteFile"); HALT(99) END ; INC(f.pos, buf.size); buf.changed := FALSE END END Flush; PROCEDURE Finalize (f: S.PTR); VAR fullName: ARRAY 256 OF CHAR; done: BOOLEAN; BEGIN WITH f: File DO IF f.fd = InvalidHandle THEN (* not physically open *) RETURN END ; done := CloseHandle(f.fd); ASSERT(done); fileTab[f.ix] := NULL; f.fd := InvalidHandle; f.ix := none; IF ~(registered IN f.flags) & (f.name[0] # 0X) THEN FullPathName(f.dir.path, f.name, fullName); done := DelFile(S.ADR(fullName)); IF ~done THEN ShowError.Do("DelFile") END END END END Finalize; PROCEDURE old0 (VAR filename: ARRAY OF CHAR; dir: Directories.Directory): File; VAR f: File; res: LONGINT; BEGIN f := ThisFile(dir, filename); IF f = NIL THEN (* not in filetab *) NEW(f); f.fd := InvalidHandle; f.len := 0; f.pos := -1; f.swapper := -1; (* all f.buf[i] = NIL *) f.dir := dir; COPY(filename, f.name); f.flags := {registered}; OpenPhysical(f, OpenExisting, res); IF f.fd = InvalidHandle THEN f := NIL ELSE f.len := GetFileSize(f.fd, NULL); IF f.len = 0FFFFFFFFH THEN ShowError.Do("GetFileSize") END ; Kernel.RegisterObject(f, Finalize) END END ; RETURN f END old0; PROCEDURE OldCB (path: ARRAY OF CHAR; VAR continue: BOOLEAN); VAR d: Directories.Directory; BEGIN d := Directories.This(path); f := old0(filename, d); continue := f = NIL END OldCB; PROCEDURE Old* (name: ARRAY OF CHAR): File; VAR dir: Directories.Directory; path: ARRAY 128 OF CHAR; file: File; BEGIN IF name = "" THEN RETURN NIL END ; SplitName(name, path, filename); file := NIL; f := NIL; IF path # "" THEN (* search only in directory given by path *) dir := Directories.This(path); IF dir # NIL THEN file := old0(filename, dir) END ELSE (* search for file in search path *) file := old0(filename, Directories.Current()); IF file = NIL THEN Directories.EnumeratePaths(OldCB); (* using global variables filename and f *) file := f; f := NIL; IF file = NIL THEN file := old0(filename, Directories.Startup()) END END END ; RETURN file END Old; PROCEDURE New* (name: ARRAY OF CHAR): File; VAR f: File; path: ARRAY 128 OF CHAR; fileName: ARRAY 32 OF CHAR; dir: Directories.Directory; BEGIN SplitName(name, path, fileName); dir := Dir(path); IF dir = NIL THEN RETURN NIL END ; NEW(f); Kernel.RegisterObject(f, Finalize); f.dir := dir; COPY(fileName, f.name); COPY(fileName, f.regName); f.ix := none; f.len := 0; f.fd := InvalidHandle; f.pos := -1; f.swapper := -1; f.flags := {}; (* all f.buf[i] = NIL *) RETURN f END New; PROCEDURE Close* (f: File); VAR i: INTEGER; res: LONGINT; BEGIN IF f.ix = none THEN Create(f) END ; i := 0; WHILE (i < nofbufs) & (f.buf[i] # NIL) DO Flush(f.buf[i]); INC(i) END END Close; PROCEDURE Register* (f: File); VAR done: BOOLEAN; res: LONGINT; BEGIN (* C.Ln; C.Str("Files.Register"); *) IF f.ix = none THEN (* opened with New but not yet created; f.spec already specifies f.name *) DeleteFile(f.dir, f.regName, done); OpenPhysical(f, CreateNew, res); ELSIF ~(registered IN f.flags) THEN RenameFile(f.dir, f.dir, f.name, f.regName, done); IF done THEN f.name := f.regName END END ; INCL(f.flags, registered); Close(f); Directories.notify(Directories.insert, f.dir.path, f.name) END Register; PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); (* res = 0: file deleted; res = 2: old name is not in directory; res = 3: name is not well formed; res = 4: name is too long *) VAR path: ARRAY 128 OF CHAR; filename: ARRAY 32 OF CHAR; dir: Directories.Directory; done: BOOLEAN; BEGIN dir := Directories.This(name); IF dir # NIL THEN Directories.Delete(name); res := Directories.res; RETURN END ; SplitName(name, path, filename); dir := Dir(path); IF Exists(dir, filename) THEN DeleteFile(dir, filename, done); IF done THEN res := 0; Directories.notify(Directories.delete, dir.path, filename) ELSE res := 5 END ELSE res := 2 END END Delete; PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); (** return codes: res = 0: file renamed; res = 1: new name already exists and is now associated with the new file; res = 2: old name is not in directory; res = 3: name is not well formed; res = 5: other error *) VAR oldPath, newPath: ARRAY 256 OF CHAR; oldName, newName: ARRAY 32 OF CHAR; newDir, oldDir: Directories.Directory; done: BOOLEAN; BEGIN oldDir := Directories.This(old); IF oldDir # NIL THEN Directories.Rename(old, new); CASE Directories.res OF Directories.noErr: res := 0 | Directories.badName: res := 3 ELSE res := 5 END ; RETURN END ; res := 0; SplitName(new, newPath, newName); newDir := Dir(newPath); SplitName(old, oldPath, oldName); oldDir := Dir(oldPath); IF ~Exists(oldDir, oldName) THEN res := 2; RETURN END ; IF Exists(newDir, newName) THEN res := 1 END ; RenameFile(oldDir, newDir, oldName, newName, done); IF done THEN f := ThisFile(oldDir, oldName); IF f # NIL THEN f.dir := newDir; COPY(newName, f.name) END ; IF res # 1 THEN res := 0 END ELSE ShowError.Do("Files.Rename"); res := 5 END ; IF res <= 1 THEN Directories.notify(Directories.delete, oldDir.path, oldName); Directories.notify(Directories.insert, newDir.path, newName) END END Rename; PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); VAR done: BOOLEAN; ft: FileTime; st: SystemTime; BEGIN done := GetFileTime(f.fd, NULL, NULL, S.ADR(ft)); IF ~done THEN ShowError.Do("GetFileTime") END ; done := FileTimeToSystemTime(S.ADR(ft), S.ADR(st)); IF ~done THEN ShowError.Do("FileTimeToSystemTime") END ; d := LONG(st.year - 1900) * 200H + st.month * 20H + st.day; t := LONG(st.hour) * 1000H + st.min * 40H + st.sec END GetDate; PROCEDURE Purge* (f: File); VAR i: INTEGER; done: BOOLEAN; BEGIN FOR i := 0 TO nofbufs-1 DO IF f.buf[i] # NIL THEN f.buf[i].org := -1; f.buf[i] := NIL END END; IF f.ix # none THEN SetFilePos(f, 0); done := SetEndOfFile(f.fd) END ; f.len := 0; f.swapper := -1 END Purge; PROCEDURE Length* (f: File): LONGINT; BEGIN RETURN f.len END Length; PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); VAR i, nofRead, offset, org: LONGINT; buf: Buffer; done: BOOLEAN; BEGIN IF f # NIL THEN IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ; offset := pos MOD bufSize; org := pos - offset; i := 0; WHILE (i < nofbufs) & (f.buf[i] # NIL) & (org # f.buf[i].org) DO INC(i) END ; IF i < nofbufs THEN IF f.buf[i] = NIL THEN NEW(buf); buf.changed := FALSE; buf.org := -1; buf.f := f; f.buf[i] := buf ELSE buf := f.buf[i]; END ELSE f.swapper := (f.swapper + 1) MOD nofbufs; buf := f.buf[f.swapper]; Flush(buf) END ; IF buf.org # org THEN IF org = f.len THEN buf.size := 0 ELSE IF f.ix = none THEN Create(f) END ; IF f.pos # org THEN SetFilePos(f, org) END ; done := ReadFile(f.fd, S.ADR(buf.data), bufSize, nofRead, NULL); IF ~done THEN ShowError.Do("ReadFile"); HALT(99) END ; INC(f.pos, nofRead); buf.size := nofRead END ; buf.org := org; buf.changed := FALSE END ELSE buf := NIL; org := 0; offset := 0 END ; r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0 END Set; PROCEDURE Pos* (VAR r: Rider): LONGINT; BEGIN RETURN r.org + r.offset END Pos; PROCEDURE Base* (VAR r: Rider): File; BEGIN RETURN r.buf.f END Base; PROCEDURE Read* (VAR r: Rider; VAR x: S.BYTE); VAR offset: LONGINT; buf: Buffer; BEGIN buf := r.buf; offset := r.offset; IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ; IF offset < buf.size THEN x := buf.data[offset]; r.offset := offset + 1 ELSIF r.org + offset < buf.f.len THEN (* beyond buffer *) Set(r, r.buf.f, r.org + offset); x := r.buf.data[0]; r.offset := 1 ELSE (* end of file *) x := 0X; r.eof := TRUE END END Read; PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF S.BYTE; n: LONGINT); VAR xpos, min, remaining, offset: LONGINT; buf: Buffer; BEGIN xpos := 0; buf := r.buf; offset := r.offset; WHILE n > 0 DO IF (r.org # buf.org) OR (offset >= bufSize) THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ; remaining := buf.size - offset; IF remaining = 0 THEN r.res := n; r.eof := TRUE; RETURN ELSE (* min := MIN(remaining, n) *) IF n > remaining THEN min := remaining ELSE min := n END ; END ; S.MOVE(S.ADR(buf.data) + offset, S.ADR(x) + xpos, min); INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min); END ; r.res := 0; r.eof := FALSE; END ReadBytes; PROCEDURE Write* (VAR r: Rider; x: S.BYTE); VAR buf: Buffer; offset: LONGINT; BEGIN buf := r.buf; offset := r.offset; IF (r.org # buf.org) OR (offset >= bufSize) THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ; buf.data[offset] := x; buf.changed := TRUE; IF offset = buf.size THEN (* a byte was appended at end of file *) INC(buf.size); INC(buf.f.len) END ; r.offset := offset + 1; r.res := 0 END Write; PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF S.BYTE; n: LONGINT); VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; BEGIN xpos := 0; buf := r.buf; offset := r.offset; WHILE n > 0 DO IF (r.org # buf.org) OR (offset >= bufSize) THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ; restInBuf := bufSize - offset; IF n < restInBuf THEN min := n ELSE min := restInBuf END ; S.MOVE(S.ADR(x) + xpos, S.ADR(buf.data) + offset, min); INC(offset, min); r.offset := offset; IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ; INC(xpos, min); DEC(n, min); buf.changed := TRUE END ; r.res := 0 END WriteBytes; (* ------------ portable formatted I/O ------------ *) (* Data in files is stored in little endian format: the least significant byte gets the least address in the file. Ordering of the bits in a set: On the 68k and x86 the bit 0 is the rightmost bit. *) PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); BEGIN ReadBytes(R, S.VAL(Array2, x), 2) END ReadInt; PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); BEGIN ReadBytes(R, S.VAL(Array4, x), 4) END ReadLInt; PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); BEGIN ReadBytes(R, S.VAL(Array4, x), 4) END ReadSet; PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); BEGIN Read(R, S.VAL(CHAR, x)) END ReadBool; PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); BEGIN ReadBytes(R, S.VAL(Array4, x), 4) END ReadReal; PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); BEGIN ReadBytes(R, S.VAL(Array8, x), 8) END ReadLReal; PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); VAR i: INTEGER; ch: CHAR; len: LONGINT; BEGIN i := 0; len := LEN(x); REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL (ch = 0X) OR (i >= len); x[i - 1] := 0X END ReadString; PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT); VAR s: SHORTINT; ch: CHAR; n: LONGINT; BEGIN s := 0; n := 0; Read(R, ch); WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END ; x := n + ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) END ReadNum; PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); BEGIN WriteBytes(R, S.VAL(Array2, x), 2) END WriteInt; PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); BEGIN WriteBytes(R, S.VAL(Array4, x), 4) END WriteLInt; PROCEDURE WriteSet* (VAR R: Rider; x: SET); BEGIN WriteBytes(R, S.VAL(Array4, x), 4) END WriteSet; PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); BEGIN Write(R, S.VAL(CHAR, x)) END WriteBool; PROCEDURE WriteReal* (VAR R: Rider; x: REAL); BEGIN WriteBytes(R, S.VAL(Array4, x), 4) END WriteReal; PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); BEGIN WriteBytes(R, S.VAL(Array8, x), 8) END WriteLReal; PROCEDURE WriteString* (VAR R: Rider; x: ARRAY OF CHAR); VAR i: INTEGER; BEGIN i := 0; WHILE x[i] # 0X DO INC(i) END ; WriteBytes(R, x, i+1) END WriteString; PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT); BEGIN WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END ; Write(R, CHR(x MOD 128)) END WriteNum; PROCEDURE Init; VAR mod: LONGINT; BEGIN mod := Kernel.LoadLibrary("Kernel32"); Kernel.GetAdr(mod, "MoveFileA", S.VAL(LONGINT, MoveFile)); Kernel.GetAdr(mod, "CreateFileA", S.VAL(LONGINT, CreateFile)); Kernel.GetAdr(mod, "DeleteFileA", S.VAL(LONGINT, DelFile)); Kernel.GetAdr(mod, "CloseHandle", S.VAL(LONGINT, CloseHandle)); Kernel.GetAdr(mod, "SetFilePointer", S.VAL(LONGINT, SetFilePointer)); Kernel.GetAdr(mod, "GetFileSize", S.VAL(LONGINT, GetFileSize)); Kernel.GetAdr(mod, "SetEndOfFile", S.VAL(LONGINT, SetEndOfFile)); Kernel.GetAdr(mod, "ReadFile", S.VAL(LONGINT, ReadFile)); Kernel.GetAdr(mod, "WriteFile", S.VAL(LONGINT, WriteFile)); Kernel.GetAdr(mod, "GetFileTime", S.VAL(LONGINT, GetFileTime)); Kernel.GetAdr(mod, "FileTimeToSystemTime", S.VAL(LONGINT, FileTimeToSystemTime)); Kernel.GetAdr(mod, "GetLastError", S.VAL(LONGINT, GetLastError)); Kernel.GetAdr(mod, "SetHandleCount", S.VAL(LONGINT, SetHandleCount)); Kernel.GetAdr(mod, "GetTickCount", S.VAL(LONGINT, GetTickCount)); Kernel.GetAdr(mod, "FindFirstFileA", S.VAL(LONGINT, FindFirstFile)); Kernel.GetAdr(mod, "FindClose", S.VAL(LONGINT, FindClose)); tempno := GetTickCount(); mod := SetHandleCount(255) END Init; BEGIN Init END Files.