diff --git a/src/lib/system/linux/clang/Console.Mod b/src/lib/system/linux/clang/Console.Mod index 9b6b6611..e523ef7b 100644 --- a/src/lib/system/linux/clang/Console.Mod +++ b/src/lib/system/linux/clang/Console.Mod @@ -7,10 +7,6 @@ MODULE Console; (* J. Templ, 29-June-96 *) VAR line: ARRAY 128 OF CHAR; pos: INTEGER; - (* for read(), write() *) - PROCEDURE -includeUnistd() - "#include "; - PROCEDURE -Write(adr, n: LONGINT) "write(1/*stdout*/, adr, n)"; diff --git a/src/lib/system/linux/clang/Files.Mod b/src/lib/system/linux/clang/armv6j_hardfp/Files.Mod similarity index 100% rename from src/lib/system/linux/clang/Files.Mod rename to src/lib/system/linux/clang/armv6j_hardfp/Files.Mod diff --git a/src/lib/system/linux/clang/Files0.Mod b/src/lib/system/linux/clang/armv6j_hardfp/Files0.Mod similarity index 100% rename from src/lib/system/linux/clang/Files0.Mod rename to src/lib/system/linux/clang/armv6j_hardfp/Files0.Mod diff --git a/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.c0 b/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.c0 index a5599acc..580449aa 100644 --- a/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.c0 +++ b/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.c0 @@ -20,7 +20,7 @@ #include "varargs.h" #endif -extern void *malloc(unsigned int size); +extern void *malloc(long size); extern void exit(int status); void (*SYSTEM_Halt)(); diff --git a/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.h b/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.h index 0c7b19af..719a6d18 100644 --- a/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.h +++ b/src/lib/system/linux/clang/armv6j_hardfp/SYSTEM.h @@ -15,7 +15,7 @@ uses double # as concatenation operator //extern void *memcpy(void *dest, const void *src, long n); extern void *memcpy(void *dest, const void *src, size_t n); -extern void *malloc(unsigned int size); +extern void *malloc(long size); extern void exit(int status); #define export diff --git a/src/lib/system/linux/gcc/Files.Mod b/src/lib/system/linux/clang/powerpc/Files.Mod similarity index 100% rename from src/lib/system/linux/gcc/Files.Mod rename to src/lib/system/linux/clang/powerpc/Files.Mod diff --git a/src/lib/system/linux/gcc/Files0.Mod b/src/lib/system/linux/clang/powerpc/Files0.Mod similarity index 100% rename from src/lib/system/linux/gcc/Files0.Mod rename to src/lib/system/linux/clang/powerpc/Files0.Mod diff --git a/src/lib/system/linux/clang/powerpc/SYSTEM.c0 b/src/lib/system/linux/clang/powerpc/SYSTEM.c0 index a5599acc..580449aa 100644 --- a/src/lib/system/linux/clang/powerpc/SYSTEM.c0 +++ b/src/lib/system/linux/clang/powerpc/SYSTEM.c0 @@ -20,7 +20,7 @@ #include "varargs.h" #endif -extern void *malloc(unsigned int size); +extern void *malloc(long size); extern void exit(int status); void (*SYSTEM_Halt)(); diff --git a/src/lib/system/linux/clang/powerpc/SYSTEM.h b/src/lib/system/linux/clang/powerpc/SYSTEM.h index 0c7b19af..719a6d18 100644 --- a/src/lib/system/linux/clang/powerpc/SYSTEM.h +++ b/src/lib/system/linux/clang/powerpc/SYSTEM.h @@ -15,7 +15,7 @@ uses double # as concatenation operator //extern void *memcpy(void *dest, const void *src, long n); extern void *memcpy(void *dest, const void *src, size_t n); -extern void *malloc(unsigned int size); +extern void *malloc(long size); extern void exit(int status); #define export diff --git a/src/lib/system/linux/clang/x86/Files.Mod b/src/lib/system/linux/clang/x86/Files.Mod new file mode 100644 index 00000000..6307407d --- /dev/null +++ b/src/lib/system/linux/clang/x86/Files.Mod @@ -0,0 +1,663 @@ +MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) +(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *) + IMPORT SYSTEM, Unix, Kernel, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-, len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; +(* + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; +*) + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE + pos := 0; + COPY(name, path); (* -- noch *) + (*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + END ; + LOOP + fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, Unix.rdwr, {}); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + RETURN NIL + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + INC(buf.size); INC(buf.f.len) + END ; + r.offset := offset + 1; r.res := 0 + END Write; + + PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *) + BEGIN + Write(r, x); + END WriteByte; + + PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew, n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, Unix.rdonly, {}); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X + END ReadString; + + (* need to read line; -- noch *) + PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; b : BOOLEAN; + BEGIN i := 0; + b := FALSE; + REPEAT + Read(R, ch); + IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN + b := TRUE + ELSE + x[i] := ch; + INC(i); + END; + UNTIL b + END ReadLine; + + 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 GetName*(f: File; VAR name: ARRAY OF CHAR); + BEGIN + COPY (f.workName, name); + END GetName; + + PROCEDURE Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files. diff --git a/src/lib/system/linux/clang/x86/Files0.Mod b/src/lib/system/linux/clang/x86/Files0.Mod new file mode 100644 index 00000000..4f021ede --- /dev/null +++ b/src/lib/system/linux/clang/x86/Files0.Mod @@ -0,0 +1,635 @@ +MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) + +(* this module is not for use by developers and inteded to bootstrap voc *) +(* for general use import Files module *) + + IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-, len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files0_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; + + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; + + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir) + END ; + LOOP + fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, Unix.rdwr, {}); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files0.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE MakeFileName(dir, name, path); ScanPath(pos, dir) + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + 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 SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew, n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, Unix.rdonly, {}); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files0. diff --git a/src/lib/system/linux/clang/x86/SYSTEM.c0 b/src/lib/system/linux/clang/x86/SYSTEM.c0 index a5599acc..580449aa 100644 --- a/src/lib/system/linux/clang/x86/SYSTEM.c0 +++ b/src/lib/system/linux/clang/x86/SYSTEM.c0 @@ -20,7 +20,7 @@ #include "varargs.h" #endif -extern void *malloc(unsigned int size); +extern void *malloc(long size); extern void exit(int status); void (*SYSTEM_Halt)(); diff --git a/src/lib/system/linux/clang/x86/SYSTEM.h b/src/lib/system/linux/clang/x86/SYSTEM.h index 0c7b19af..719a6d18 100644 --- a/src/lib/system/linux/clang/x86/SYSTEM.h +++ b/src/lib/system/linux/clang/x86/SYSTEM.h @@ -15,7 +15,7 @@ uses double # as concatenation operator //extern void *memcpy(void *dest, const void *src, long n); extern void *memcpy(void *dest, const void *src, size_t n); -extern void *malloc(unsigned int size); +extern void *malloc(long size); extern void exit(int status); #define export diff --git a/src/lib/system/linux/clang/x86_64/Files.Mod b/src/lib/system/linux/clang/x86_64/Files.Mod new file mode 100644 index 00000000..c8f42ca5 --- /dev/null +++ b/src/lib/system/linux/clang/x86_64/Files.Mod @@ -0,0 +1,664 @@ +MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) +(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *) + IMPORT SYSTEM, Unix, Kernel, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-: INTEGER; + len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; +(* + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; +*) + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE + pos := 0; + COPY(name, path); (* -- noch *) + (*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + END ; + LOOP + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + RETURN NIL + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + INC(buf.size); INC(buf.f.len) + END ; + r.offset := offset + 1; r.res := 0 + END Write; + + PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *) + BEGIN + Write(r, x); + END WriteByte; + + PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X + END ReadString; + + (* need to read line; -- noch *) + PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; b : BOOLEAN; + BEGIN i := 0; + b := FALSE; + REPEAT + Read(R, ch); + IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN + b := TRUE + ELSE + x[i] := ch; + INC(i); + END; + UNTIL b + END ReadLine; + + 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 GetName*(f: File; VAR name: ARRAY OF CHAR); + BEGIN + COPY (f.workName, name); + END GetName; + + PROCEDURE Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files. diff --git a/src/lib/system/linux/clang/x86_64/Files0.Mod b/src/lib/system/linux/clang/x86_64/Files0.Mod new file mode 100644 index 00000000..1d9cd953 --- /dev/null +++ b/src/lib/system/linux/clang/x86_64/Files0.Mod @@ -0,0 +1,636 @@ +MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) + +(* this module is not for use by developers and inteded to bootstrap voc *) +(* for general use import Files module *) + + IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-: INTEGER; + len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files0_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) +f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, ({2, 4,5, 7,8})))); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; + + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; + + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir) + END ; + LOOP + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files0.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE MakeFileName(dir, name, path); ScanPath(pos, dir) + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + 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 SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files0. diff --git a/src/lib/system/linux/clang/x86_64/Unix.Mod b/src/lib/system/linux/clang/x86_64/Unix.Mod index 3e477d69..195bb41d 100644 --- a/src/lib/system/linux/clang/x86_64/Unix.Mod +++ b/src/lib/system/linux/clang/x86_64/Unix.Mod @@ -292,16 +292,18 @@ from man gettimeofday END ; Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; + family0*, family1*: SHORTINT; + pad0, pad1: SHORTINT; + pad2 : INTEGER; + (*port*: INTEGER; + internetAddr*: LONGINT;*) + pad*: ARRAY 14 OF CHAR; END ; HostEntry* = POINTER [1] TO Hostent; Hostent* = RECORD name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; + addrtype*, length*: INTEGER; addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) END; @@ -321,7 +323,7 @@ from man gettimeofday PROCEDURE -includeStdlib() "#include "; - (* for nanosleep() *) + (* for nanosleep() *) PROCEDURE -includeTime() "#include "; @@ -337,71 +339,71 @@ from man gettimeofday RETURN err() END errno; - PROCEDURE -Exit*(n: LONGINT) + PROCEDURE -Exit*(n: INTEGER) "exit(n)"; - PROCEDURE -Fork*(): LONGINT + PROCEDURE -Fork*(): INTEGER "fork()"; - PROCEDURE -Wait*(VAR status: LONGINT): LONGINT + PROCEDURE -Wait*(VAR status: INTEGER): INTEGER "wait(status)"; - PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT + PROCEDURE -Select*(width: INTEGER; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): INTEGER "select(width, readfds, writefds, exceptfds, timeout)"; - PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT + PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : INTEGER "gettimeofday(tv, tz)"; - PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT + PROCEDURE -Read* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT "read(fd, buf, nbyte)"; - PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT + PROCEDURE -ReadBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT "read(fd, buf, buf__len)"; - PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT + PROCEDURE -Write* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT "write(fd, buf, nbyte)"; - PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT + PROCEDURE -WriteBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT "write(fd, buf, buf__len)"; - PROCEDURE -Dup*(fd: LONGINT): LONGINT + PROCEDURE -Dup*(fd: INTEGER): INTEGER "dup(fd)"; - PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT + PROCEDURE -Dup2*(fd1, fd2: INTEGER): INTEGER "dup(fd1, fd2)"; - PROCEDURE -Pipe*(fds : LONGINT): LONGINT + PROCEDURE -Pipe*(fds : LONGINT): INTEGER "pipe(fds)"; - PROCEDURE -Getpid*(): LONGINT + PROCEDURE -Getpid*(): INTEGER "getpid()"; - PROCEDURE -Getuid*(): LONGINT + PROCEDURE -Getuid*(): INTEGER "getuid()"; - PROCEDURE -Geteuid*(): LONGINT + PROCEDURE -Geteuid*(): INTEGER "geteuid()"; - PROCEDURE -Getgid*(): LONGINT + PROCEDURE -Getgid*(): INTEGER "getgid()"; - PROCEDURE -Getegid*(): LONGINT + PROCEDURE -Getegid*(): INTEGER "getegid()"; - PROCEDURE -Unlink*(name: Name): LONGINT + PROCEDURE -Unlink*(name: Name): INTEGER "unlink(name)"; - PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT + PROCEDURE -Open*(name: Name; flag: INTEGER; mode: LONGINT): INTEGER "open(name, flag, mode)"; - PROCEDURE -Close*(fd: LONGINT): LONGINT + PROCEDURE -Close*(fd: INTEGER): INTEGER "close(fd)"; - PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT + PROCEDURE -stat(name: Name; VAR statbuf: Status): INTEGER "stat((const char*)name, (struct stat*)statbuf)"; - PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; + PROCEDURE Stat*(name: Name; VAR statbuf: Status): INTEGER; + VAR res: INTEGER; BEGIN res := stat(name, statbuf); (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) @@ -411,11 +413,11 @@ from man gettimeofday RETURN res; END Stat; - PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT + PROCEDURE -fstat(fd: INTEGER; VAR statbuf: Status): INTEGER "fstat(fd, (struct stat*)statbuf)"; - PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; + PROCEDURE Fstat*(fd: INTEGER; VAR statbuf: Status): INTEGER; + VAR res: INTEGER; BEGIN res := fstat(fd, statbuf); (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) @@ -424,47 +426,47 @@ from man gettimeofday RETURN res; END Fstat; - PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT + PROCEDURE -Fchmod*(fd, mode: INTEGER): INTEGER "fchmod(fd, mode)"; - PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT + PROCEDURE -Chmod*(path: Name; mode: INTEGER): INTEGER "chmod(path, mode)"; - PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT + PROCEDURE -Lseek*(fd: INTEGER; offset: LONGINT; origin: INTEGER): LONGINT "lseek(fd, offset, origin)"; - PROCEDURE -Fsync*(fd: LONGINT): LONGINT + PROCEDURE -Fsync*(fd: INTEGER): INTEGER "fsync(fd)"; - PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT + PROCEDURE -Fcntl*(fd: INTEGER; cmd: INTEGER; arg: LONGINT ): INTEGER "fcntl(fd, cmd, arg)"; - PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT + PROCEDURE -Flock*(fd, operation: INTEGER): INTEGER "flock(fd, operation)"; - PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT + PROCEDURE -Ftruncate*(fd: INTEGER; length: LONGINT): INTEGER "ftruncate(fd, length)"; - PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT + PROCEDURE -Readblk*(fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT "read(fd, buf, len)"; - PROCEDURE -Rename*(old, new: Name): LONGINT + PROCEDURE -Rename*(old, new: Name): INTEGER "rename(old, new)"; - PROCEDURE -Chdir*(path: Name): LONGINT + PROCEDURE -Chdir*(path: Name): INTEGER "chdir(path)"; - PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT + PROCEDURE -Ioctl*(fd: INTEGER; request, arg: LONGINT): INTEGER "ioctl(fd, request, arg)"; - PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT + PROCEDURE -Kill*(pid, sig: INTEGER): INTEGER "kill(pid, sig)"; - PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT + PROCEDURE -Sigsetmask*(mask: INTEGER): INTEGER "sigsetmask(mask)"; PROCEDURE -Sleep*(ms : INTEGER): INTEGER - "(INTEGER)sleep(ms)"; + "(INTEGER)sleep(ms)"; PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): INTEGER "(INTEGER)nanosleep(req, rem)"; @@ -474,31 +476,31 @@ from man gettimeofday PROCEDURE -Gethostbyname*(name: Name): HostEntry "(Unix_HostEntry)gethostbyname(name)"; - PROCEDURE -Gethostname*(VAR name: Name): LONGINT + PROCEDURE -Gethostname*(VAR name: Name): INTEGER "gethostname(name, name__len)"; - PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT + PROCEDURE -Socket*(af, type, protocol: INTEGER): INTEGER "socket(af, type, protocol)"; - PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT + PROCEDURE -Connect*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER "connect(socket, &(name), namelen)"; - PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT + PROCEDURE -Getsockname*(socket: INTEGER; VAR name: Sockaddr; VAR namelen: INTEGER): INTEGER "getsockname(socket, name, namelen)"; - PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT + PROCEDURE -Bind*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER "bind(socket, &(name), namelen)"; - PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT + PROCEDURE -Listen*(socket, backlog: INTEGER): INTEGER "listen(socket, backlog)"; - PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT + PROCEDURE -Accept*(socket: INTEGER; VAR addr: Sockaddr; VAR addrlen: INTEGER): LONGINT "accept(socket, addr, addrlen)"; - PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT + PROCEDURE -Recv*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT "recv(socket, bufadr, buflen, flags)"; - PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT + PROCEDURE -Send*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT "send(socket, bufadr, buflen, flags)"; PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *) diff --git a/src/lib/system/linux/gcc/armv6j_hardfp/Files.Mod b/src/lib/system/linux/gcc/armv6j_hardfp/Files.Mod new file mode 100644 index 00000000..6307407d --- /dev/null +++ b/src/lib/system/linux/gcc/armv6j_hardfp/Files.Mod @@ -0,0 +1,663 @@ +MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) +(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *) + IMPORT SYSTEM, Unix, Kernel, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-, len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; +(* + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; +*) + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE + pos := 0; + COPY(name, path); (* -- noch *) + (*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + END ; + LOOP + fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, Unix.rdwr, {}); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + RETURN NIL + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + INC(buf.size); INC(buf.f.len) + END ; + r.offset := offset + 1; r.res := 0 + END Write; + + PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *) + BEGIN + Write(r, x); + END WriteByte; + + PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew, n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, Unix.rdonly, {}); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X + END ReadString; + + (* need to read line; -- noch *) + PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; b : BOOLEAN; + BEGIN i := 0; + b := FALSE; + REPEAT + Read(R, ch); + IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN + b := TRUE + ELSE + x[i] := ch; + INC(i); + END; + UNTIL b + END ReadLine; + + 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 GetName*(f: File; VAR name: ARRAY OF CHAR); + BEGIN + COPY (f.workName, name); + END GetName; + + PROCEDURE Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files. diff --git a/src/lib/system/linux/gcc/armv6j_hardfp/Files0.Mod b/src/lib/system/linux/gcc/armv6j_hardfp/Files0.Mod new file mode 100644 index 00000000..4f021ede --- /dev/null +++ b/src/lib/system/linux/gcc/armv6j_hardfp/Files0.Mod @@ -0,0 +1,635 @@ +MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) + +(* this module is not for use by developers and inteded to bootstrap voc *) +(* for general use import Files module *) + + IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-, len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files0_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; + + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; + + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir) + END ; + LOOP + fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, Unix.rdwr, {}); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files0.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE MakeFileName(dir, name, path); ScanPath(pos, dir) + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + 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 SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew, n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, Unix.rdonly, {}); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files0. diff --git a/src/lib/system/linux/gcc/powerpc/Files.Mod b/src/lib/system/linux/gcc/powerpc/Files.Mod new file mode 100644 index 00000000..6307407d --- /dev/null +++ b/src/lib/system/linux/gcc/powerpc/Files.Mod @@ -0,0 +1,663 @@ +MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) +(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *) + IMPORT SYSTEM, Unix, Kernel, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-, len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; +(* + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; +*) + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE + pos := 0; + COPY(name, path); (* -- noch *) + (*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + END ; + LOOP + fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, Unix.rdwr, {}); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + RETURN NIL + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + INC(buf.size); INC(buf.f.len) + END ; + r.offset := offset + 1; r.res := 0 + END Write; + + PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *) + BEGIN + Write(r, x); + END WriteByte; + + PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew, n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, Unix.rdonly, {}); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X + END ReadString; + + (* need to read line; -- noch *) + PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; b : BOOLEAN; + BEGIN i := 0; + b := FALSE; + REPEAT + Read(R, ch); + IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN + b := TRUE + ELSE + x[i] := ch; + INC(i); + END; + UNTIL b + END ReadLine; + + 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 GetName*(f: File; VAR name: ARRAY OF CHAR); + BEGIN + COPY (f.workName, name); + END GetName; + + PROCEDURE Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files. diff --git a/src/lib/system/linux/gcc/powerpc/Files0.Mod b/src/lib/system/linux/gcc/powerpc/Files0.Mod new file mode 100644 index 00000000..4f021ede --- /dev/null +++ b/src/lib/system/linux/gcc/powerpc/Files0.Mod @@ -0,0 +1,635 @@ +MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) + +(* this module is not for use by developers and inteded to bootstrap voc *) +(* for general use import Files module *) + + IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-, len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files0_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; + + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; + + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir) + END ; + LOOP + fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, Unix.rdwr, {}); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files0.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE MakeFileName(dir, name, path); ScanPath(pos, dir) + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + 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 SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew, n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, Unix.rdonly, {}); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files0. diff --git a/src/lib/system/linux/gcc/x86/Files.Mod b/src/lib/system/linux/gcc/x86/Files.Mod new file mode 100644 index 00000000..6307407d --- /dev/null +++ b/src/lib/system/linux/gcc/x86/Files.Mod @@ -0,0 +1,663 @@ +MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) +(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *) + IMPORT SYSTEM, Unix, Kernel, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-, len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; +(* + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; +*) + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE + pos := 0; + COPY(name, path); (* -- noch *) + (*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + END ; + LOOP + fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, Unix.rdwr, {}); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + RETURN NIL + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + INC(buf.size); INC(buf.f.len) + END ; + r.offset := offset + 1; r.res := 0 + END Write; + + PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *) + BEGIN + Write(r, x); + END WriteByte; + + PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew, n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, Unix.rdonly, {}); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X + END ReadString; + + (* need to read line; -- noch *) + PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; b : BOOLEAN; + BEGIN i := 0; + b := FALSE; + REPEAT + Read(R, ch); + IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN + b := TRUE + ELSE + x[i] := ch; + INC(i); + END; + UNTIL b + END ReadLine; + + 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 GetName*(f: File; VAR name: ARRAY OF CHAR); + BEGIN + COPY (f.workName, name); + END GetName; + + PROCEDURE Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files. diff --git a/src/lib/system/linux/gcc/x86/Files0.Mod b/src/lib/system/linux/gcc/x86/Files0.Mod new file mode 100644 index 00000000..4f021ede --- /dev/null +++ b/src/lib/system/linux/gcc/x86/Files0.Mod @@ -0,0 +1,635 @@ +MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) + +(* this module is not for use by developers and inteded to bootstrap voc *) +(* for general use import Files module *) + + IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-, len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files0_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; + + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; + + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd, res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir) + END ; + LOOP + fd := Unix.Open(path, Unix.rdwr, {}); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, Unix.rdwr, {}); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, Unix.rdonly, {}); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files0.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE MakeFileName(dir, name, path); ScanPath(pos, dir) + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + 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 SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew, n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, Unix.rdonly, {}); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, Unix.rdwr + Unix.creat + Unix.trunc, {2, 4,5, 7,8}); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files0. diff --git a/src/lib/system/linux/gcc/x86_64/Files.Mod b/src/lib/system/linux/gcc/x86_64/Files.Mod new file mode 100644 index 00000000..c8f42ca5 --- /dev/null +++ b/src/lib/system/linux/gcc/x86_64/Files.Mod @@ -0,0 +1,664 @@ +MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) +(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *) + IMPORT SYSTEM, Unix, Kernel, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-: INTEGER; + len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) + f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; +(* + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; +*) + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE + pos := 0; + COPY(name, path); (* -- noch *) + (*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + END ; + LOOP + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*) + RETURN NIL + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + INC(buf.size); INC(buf.f.len) + END ; + r.offset := offset + 1; r.res := 0 + END Write; + + PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *) + BEGIN + Write(r, x); + END WriteByte; + + PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X + END ReadString; + + (* need to read line; -- noch *) + PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; b : BOOLEAN; + BEGIN i := 0; + b := FALSE; + REPEAT + Read(R, ch); + IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN + b := TRUE + ELSE + x[i] := ch; + INC(i); + END; + UNTIL b + END ReadLine; + + 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 GetName*(f: File; VAR name: ARRAY OF CHAR); + BEGIN + COPY (f.workName, name); + END GetName; + + PROCEDURE Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files. diff --git a/src/lib/system/linux/gcc/x86_64/Files0.Mod b/src/lib/system/linux/gcc/x86_64/Files0.Mod new file mode 100644 index 00000000..1d9cd953 --- /dev/null +++ b/src/lib/system/linux/gcc/x86_64/Files0.Mod @@ -0,0 +1,636 @@ +MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *) + +(* this module is not for use by developers and inteded to bootstrap voc *) +(* for general use import Files module *) + + IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console; + + (* standard data type I/O + + little endian, + Sint:1, Int:2, Lint:4 + ORD({0}) = 1, + false = 0, true =1 + IEEE real format, + null terminated strings, + compact numbers according to M.Odersky *) + + + CONST + nofbufs = 4; + bufsize = 4096; + fileTabSize = 64; + noDesc = -1; + notDone = -1; + + (* file states *) + open = 0; create = 1; close = 2; + + + TYPE + FileName = ARRAY 101 OF CHAR; + File* = POINTER TO Handle; + Buffer = POINTER TO BufDesc; + + Handle = RECORD + workName, registerName: FileName; + tempFile: BOOLEAN; + dev, ino, mtime: LONGINT; + fd-: INTEGER; + len, pos: LONGINT; + bufs: ARRAY nofbufs OF Buffer; + swapper, state: INTEGER + END ; + + BufDesc = RECORD + f: File; + chg: BOOLEAN; + org, size: LONGINT; + data: ARRAY bufsize OF SYSTEM.BYTE + END ; + + Rider* = RECORD + res*: LONGINT; + eof*: BOOLEAN; + buf: Buffer; + org, offset: LONGINT + END ; + + Time = POINTER TO TimeDesc; + TimeDesc = RECORD + sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT; +(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*) + END ; + + VAR + fileTab: ARRAY fileTabSize OF LONGINT (*=File*); + tempno: INTEGER; + +(* for localtime *) + PROCEDURE -includetime() + '#include "time.h"'; + + PROCEDURE -localtime(VAR clock: LONGINT): Time + "(Files0_Time) localtime(clock)"; + + PROCEDURE -getcwd(VAR cwd: Unix.Name) + "getcwd(cwd, cwd__len)"; + + PROCEDURE -IdxTrap "__HALT(-1)"; + + PROCEDURE^ Finalize(o: SYSTEM.PTR); + + PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT); + BEGIN + Console.Ln; Console.String("-- "); Console.String(s); Console.String(": "); + IF f # NIL THEN + IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END + END ; + IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ; + Console.Ln; + HALT(99) + END Err; + + PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + VAR i, j: INTEGER; + BEGIN i := 0; j := 0; + WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ; + IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ; + WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ; + dest[i] := 0X + END MakeFileName; + + PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR); + VAR n, i, j: LONGINT; + BEGIN + INC(tempno); n := tempno; i := 0; + IF finalName[0] # "/" THEN (* relative pathname *) + WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END; + IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END + END; + j := 0; + WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END; + DEC(i); + WHILE name[i] # "/" DO DEC(i) END; + name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := "."; INC(i); n := SHORT(Unix.Getpid()); + WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END; + name[i] := 0X + END GetTempName; + + PROCEDURE Create(f: File); + VAR stat: Unix.Status; done: BOOLEAN; + errno: LONGINT; err: ARRAY 32 OF CHAR; + BEGIN + IF f.fd = noDesc THEN + IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE + ELSIF f.state = close THEN + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END ; + errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*) +f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, ({2, 4,5, 7,8})))); + done := f.fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN + IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ; + Kernel.GC(TRUE); + f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + done := f.fd >= 0 + END ; + IF done THEN + IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0) + ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat); + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime + END + ELSE errno := Unix.errno(); + IF errno = Unix.ENOENT THEN err := "no such directory" + ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open" + ELSE err := "file not created" + END ; + Err(err, f, errno) + END + END + END Create; + + PROCEDURE Flush(buf: Buffer); + VAR res: LONGINT; f: File; stat: Unix.Status; + BEGIN + IF buf.chg THEN f := buf.f; Create(f); + IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ; + res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ; + f.pos := buf.org + buf.size; + buf.chg := FALSE; + res := Unix.Fstat(f.fd, stat); + f.mtime := stat.mtime + END + END Flush; + + PROCEDURE Close* (f: File); + VAR i, res: LONGINT; + BEGIN + IF (f.state # create) OR (f.registerName # "") THEN + Create(f); i := 0; + WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ; + res := Unix.Fsync(f.fd); + IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END + END + END Close; + + PROCEDURE Length* (f: File): LONGINT; + BEGIN RETURN f.len + END Length; + + PROCEDURE New* (name: ARRAY OF CHAR): File; + VAR f: File; + BEGIN + NEW(f); f.workName := ""; COPY(name, f.registerName); + f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + RETURN f + END New; + + PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *) + VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR; + BEGIN + i := 0; ch := Kernel.OBERON[pos]; + WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ; + IF ch = "~" THEN + INC(pos); ch := Kernel.OBERON[pos]; + home := ""; Args.GetEnv("HOME", home); + WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ; + IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN + WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END + END + END ; + WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ; + WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ; + dir[i] := 0X + END ScanPath; + + PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN; + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; ch := name[0]; + WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ; + RETURN ch = "/" + END HasDir; + + PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File; + VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < fileTabSize DO + f := SYSTEM.VAL(File, fileTab[i]); + IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN + IF mtime # f.mtime THEN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + f.swapper := -1; f.mtime := mtime; + res := Unix.Fstat(f.fd, stat); f.len := stat.size + END ; + RETURN f + END ; + INC(i) + END ; + RETURN NIL + END CacheEntry; + + PROCEDURE Old* (name: ARRAY OF CHAR): File; + VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN; + dir, path: ARRAY 256 OF CHAR; + stat: Unix.Status; + BEGIN + IF name # "" THEN + IF HasDir(name) THEN dir := ""; COPY(name, path) + ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir) + END ; + LOOP + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno(); + IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN + IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ; + Kernel.GC(TRUE); + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); + done := fd >= 0; errno := Unix.errno(); + IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END + END ; + IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN + (* errno EAGAIN observed on Solaris 2.4 *) + fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno() + END ; +IF (~done) & (errno # Unix.ENOENT) THEN + Console.String("warning Files0.Old "); Console.String(name); + Console.String(" errno = "); Console.Int(errno, 0); Console.Ln; +END ; + IF done THEN + res := Unix.Fstat(fd, stat); + f := CacheEntry(stat.dev, stat.ino, stat.mtime); + IF f # NIL THEN res := Unix.Close(fd); RETURN f + ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0) + ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize); + f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*) + COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE; + f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime; + RETURN f + END + ELSIF dir = "" THEN RETURN NIL + ELSE MakeFileName(dir, name, path); ScanPath(pos, dir) + END + END + ELSE RETURN NIL + END + END Old; + + PROCEDURE Purge* (f: File); + VAR i: INTEGER; stat: Unix.Status; res: LONGINT; + BEGIN i := 0; + WHILE i < nofbufs DO + IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ; + INC(i) + END ; + IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ; + f.pos := 0; f.len := 0; f.swapper := -1; + res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime + END Purge; + + PROCEDURE GetDate* (f: File; VAR t, d: LONGINT); + VAR stat: Unix.Status; clock, res: LONGINT; time: Time; + BEGIN + Create(f); res := Unix.Fstat(f.fd, stat); + time := localtime(stat.mtime); + t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12); + d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9) + END GetDate; + + PROCEDURE Pos* (VAR r: Rider): LONGINT; + BEGIN RETURN r.org + r.offset + END Pos; + + PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT); + VAR org, offset, i, n, res: LONGINT; buf: Buffer; + 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.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ; + IF i < nofbufs THEN + IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf + ELSE buf := f.bufs[i] + END + ELSE + f.swapper := (f.swapper + 1) MOD nofbufs; + buf := f.bufs[f.swapper]; + Flush(buf) + END ; + IF buf.org # org THEN + IF org = f.len THEN buf.size := 0 + ELSE Create(f); + IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ; + n := Unix.ReadBlk(f.fd, buf.data); + IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ; + f.pos := org + n; + buf.size := n + END ; + buf.org := org; buf.chg := 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 Read* (VAR r: Rider; VAR x: SYSTEM.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 + Set(r, r.buf.f, r.org + offset); + x := r.buf.data[0]; r.offset := 1 + ELSE + x := 0X; r.eof := TRUE + END + END Read; + + PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := buf.size - offset; + IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN + ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.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 ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE); + BEGIN + ReadBytes(r, x, 1); + END ReadByte; + + PROCEDURE Base* (VAR r: Rider): File; + BEGIN RETURN r.buf.f + END Base; + + PROCEDURE Write* (VAR r: Rider; x: SYSTEM.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.chg := TRUE; + IF offset = buf.size THEN + 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 SYSTEM.BYTE; n: LONGINT); + VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer; + BEGIN + IF n > LEN(x) THEN IdxTrap END ; + 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 := restInBuf ELSE min := n END ; + SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.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.chg := TRUE + END ; + r.res := 0 + END WriteBytes; + +(* another solution would be one that is similar to ReadBytes, WriteBytes. +No code duplication, more symmetric, only two ifs for +Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len +must be made consistent with offset (if offset > buf.size) in a lazy way. + +PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE); + VAR buf: Buffer; offset: LONGINT; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= bufsize) OR (r.org # buf.org) THEN + Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset; + END ; + buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE +END Write; + +PROCEDURE WriteBytes ... + +PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE); + VAR offset: LONGINT; buf: Buffer; +BEGIN + buf := r.buf; offset := r.offset; + IF (offset >= buf.size) OR (r.org # buf.org) THEN + IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN + ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset + END + END ; + x := buf.data[offset]; r.offset := offset + 1 +END Read; + +but this would also affect Set, Length, and Flush. +Especially Length would become fairly complex. +*) + + PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Unlink(name)); + res := SHORT(Unix.errno()) + END Delete; + + PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER); + VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT; + ostat, nstat: Unix.Status; + buf: ARRAY 4096 OF CHAR; + BEGIN + r := Unix.Stat(old, ostat); + IF r >= 0 THEN + r := Unix.Stat(new, nstat); + IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN + Delete(new, res); (* work around stale nfs handles *) + END ; + r := Unix.Rename(old, new); + IF r < 0 THEN res := SHORT(Unix.errno()); + IF res = Unix.EXDEV THEN (* cross device link, move the file *) + fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); + IF fdold < 0 THEN res := 2; RETURN END ; + fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8}))); + IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize); + WHILE n > 0 DO + r := Unix.Write(fdnew, SYSTEM.ADR(buf), n); + IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew); + Err("cannot move file", NIL, errno) + END ; + n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize) + END ; + errno := Unix.errno(); + r := Unix.Close(fdold); r := Unix.Close(fdnew); + IF n = 0 THEN r := Unix.Unlink(old); res := 0 + ELSE Err("cannot move file", NIL, errno) + END ; + ELSE RETURN (* res is Unix.Rename return code *) + END + END ; + res := 0 + ELSE res := 2 (* old file not found *) + END + END Rename; + + PROCEDURE Register* (f: File); + VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR; + BEGIN + IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ; + Close(f); + IF f.registerName # "" THEN + Rename(f.workName, f.registerName, errno); + IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ; + f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE + END + END Register; + + PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER); + BEGIN + res := SHORT(Unix.Chdir(path)); + getcwd(Kernel.CWD) + END ChangeDirectory; + + PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE); + VAR i, j: LONGINT; + BEGIN + IF ~Kernel.littleEndian THEN i := LEN(src); j := 0; + WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END + ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src)) + END + END FlipBytes; + + PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN); + BEGIN Read(R, SYSTEM.VAL(CHAR, x)) + END ReadBool; + + PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN ReadBytes(R, b, 2); + x := ORD(b[0]) + ORD(b[1])*256 + END ReadInt; + + PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H + END ReadLInt; + + PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); + x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H) + END ReadSet; + + PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN ReadBytes(R, b, 4); FlipBytes(b, x) + END ReadReal; + + PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN ReadBytes(R, b, 8); FlipBytes(b, x) + END ReadLReal; + + PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR); + VAR i: INTEGER; ch: CHAR; + BEGIN i := 0; + REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 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; + INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) ); + x := n + END ReadNum; + + PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN); + BEGIN Write(R, SYSTEM.VAL(CHAR, x)) + END WriteBool; + + PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER); + VAR b: ARRAY 2 OF CHAR; + BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256); + WriteBytes(R, b, 2); + END WriteInt; + + PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT); + VAR b: ARRAY 4 OF CHAR; + BEGIN + b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H); + WriteBytes(R, b, 4); + END WriteLInt; + + PROCEDURE WriteSet* (VAR R: Rider; x: SET); + VAR b: ARRAY 4 OF CHAR; i: LONGINT; + BEGIN i := SYSTEM.VAL(LONGINT, x); + b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H); + WriteBytes(R, b, 4); + END WriteSet; + + PROCEDURE WriteReal* (VAR R: Rider; x: REAL); + VAR b: ARRAY 4 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 4) + END WriteReal; + + PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL); + VAR b: ARRAY 8 OF CHAR; + BEGIN FlipBytes(x, b); WriteBytes(R, b, 8) + END WriteLReal; + + PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] 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 Finalize(o: SYSTEM.PTR); + VAR f: File; res: LONGINT; + BEGIN + f := SYSTEM.VAL(File, o); + IF f.fd >= 0 THEN + fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles); + IF f.tempFile THEN res := Unix.Unlink(f.workName) END + END + END Finalize; + + PROCEDURE Init; + VAR i: LONGINT; + BEGIN + i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ; + tempno := -1; Kernel.nofiles := 0 + END Init; + +BEGIN Init +END Files0. diff --git a/src/lib/system/linux/gcc/x86_64/Unix.Mod b/src/lib/system/linux/gcc/x86_64/Unix.Mod index 5bbea785..195bb41d 100644 --- a/src/lib/system/linux/gcc/x86_64/Unix.Mod +++ b/src/lib/system/linux/gcc/x86_64/Unix.Mod @@ -292,16 +292,18 @@ from man gettimeofday END ; Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; + family0*, family1*: SHORTINT; + pad0, pad1: SHORTINT; + pad2 : INTEGER; + (*port*: INTEGER; + internetAddr*: LONGINT;*) + pad*: ARRAY 14 OF CHAR; END ; HostEntry* = POINTER [1] TO Hostent; Hostent* = RECORD name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; + addrtype*, length*: INTEGER; addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) END; @@ -337,71 +339,71 @@ from man gettimeofday RETURN err() END errno; - PROCEDURE -Exit*(n: LONGINT) + PROCEDURE -Exit*(n: INTEGER) "exit(n)"; - PROCEDURE -Fork*(): LONGINT + PROCEDURE -Fork*(): INTEGER "fork()"; - PROCEDURE -Wait*(VAR status: LONGINT): LONGINT + PROCEDURE -Wait*(VAR status: INTEGER): INTEGER "wait(status)"; - PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT + PROCEDURE -Select*(width: INTEGER; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): INTEGER "select(width, readfds, writefds, exceptfds, timeout)"; - PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT + PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : INTEGER "gettimeofday(tv, tz)"; - PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT + PROCEDURE -Read* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT "read(fd, buf, nbyte)"; - PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT + PROCEDURE -ReadBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT "read(fd, buf, buf__len)"; - PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT + PROCEDURE -Write* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT "write(fd, buf, nbyte)"; - PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT + PROCEDURE -WriteBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT "write(fd, buf, buf__len)"; - PROCEDURE -Dup*(fd: LONGINT): LONGINT + PROCEDURE -Dup*(fd: INTEGER): INTEGER "dup(fd)"; - PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT + PROCEDURE -Dup2*(fd1, fd2: INTEGER): INTEGER "dup(fd1, fd2)"; - PROCEDURE -Pipe*(fds : LONGINT): LONGINT + PROCEDURE -Pipe*(fds : LONGINT): INTEGER "pipe(fds)"; - PROCEDURE -Getpid*(): LONGINT + PROCEDURE -Getpid*(): INTEGER "getpid()"; - PROCEDURE -Getuid*(): LONGINT + PROCEDURE -Getuid*(): INTEGER "getuid()"; - PROCEDURE -Geteuid*(): LONGINT + PROCEDURE -Geteuid*(): INTEGER "geteuid()"; - PROCEDURE -Getgid*(): LONGINT + PROCEDURE -Getgid*(): INTEGER "getgid()"; - PROCEDURE -Getegid*(): LONGINT + PROCEDURE -Getegid*(): INTEGER "getegid()"; - PROCEDURE -Unlink*(name: Name): LONGINT + PROCEDURE -Unlink*(name: Name): INTEGER "unlink(name)"; - PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT + PROCEDURE -Open*(name: Name; flag: INTEGER; mode: LONGINT): INTEGER "open(name, flag, mode)"; - PROCEDURE -Close*(fd: LONGINT): LONGINT + PROCEDURE -Close*(fd: INTEGER): INTEGER "close(fd)"; - PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT + PROCEDURE -stat(name: Name; VAR statbuf: Status): INTEGER "stat((const char*)name, (struct stat*)statbuf)"; - PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; + PROCEDURE Stat*(name: Name; VAR statbuf: Status): INTEGER; + VAR res: INTEGER; BEGIN res := stat(name, statbuf); (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) @@ -411,11 +413,11 @@ from man gettimeofday RETURN res; END Stat; - PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT + PROCEDURE -fstat(fd: INTEGER; VAR statbuf: Status): INTEGER "fstat(fd, (struct stat*)statbuf)"; - PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; + PROCEDURE Fstat*(fd: INTEGER; VAR statbuf: Status): INTEGER; + VAR res: INTEGER; BEGIN res := fstat(fd, statbuf); (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) @@ -424,81 +426,81 @@ from man gettimeofday RETURN res; END Fstat; - PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT + PROCEDURE -Fchmod*(fd, mode: INTEGER): INTEGER "fchmod(fd, mode)"; - PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT + PROCEDURE -Chmod*(path: Name; mode: INTEGER): INTEGER "chmod(path, mode)"; - PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT + PROCEDURE -Lseek*(fd: INTEGER; offset: LONGINT; origin: INTEGER): LONGINT "lseek(fd, offset, origin)"; - PROCEDURE -Fsync*(fd: LONGINT): LONGINT + PROCEDURE -Fsync*(fd: INTEGER): INTEGER "fsync(fd)"; - PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT + PROCEDURE -Fcntl*(fd: INTEGER; cmd: INTEGER; arg: LONGINT ): INTEGER "fcntl(fd, cmd, arg)"; - PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT + PROCEDURE -Flock*(fd, operation: INTEGER): INTEGER "flock(fd, operation)"; - PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT + PROCEDURE -Ftruncate*(fd: INTEGER; length: LONGINT): INTEGER "ftruncate(fd, length)"; - PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT + PROCEDURE -Readblk*(fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT "read(fd, buf, len)"; - PROCEDURE -Rename*(old, new: Name): LONGINT + PROCEDURE -Rename*(old, new: Name): INTEGER "rename(old, new)"; - PROCEDURE -Chdir*(path: Name): LONGINT + PROCEDURE -Chdir*(path: Name): INTEGER "chdir(path)"; - PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT + PROCEDURE -Ioctl*(fd: INTEGER; request, arg: LONGINT): INTEGER "ioctl(fd, request, arg)"; - PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT + PROCEDURE -Kill*(pid, sig: INTEGER): INTEGER "kill(pid, sig)"; - PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT + PROCEDURE -Sigsetmask*(mask: INTEGER): INTEGER "sigsetmask(mask)"; PROCEDURE -Sleep*(ms : INTEGER): INTEGER - "sleep(ms)"; + "(INTEGER)sleep(ms)"; PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): INTEGER - "nanosleep(req, rem)"; + "(INTEGER)nanosleep(req, rem)"; (* TCP/IP networking *) PROCEDURE -Gethostbyname*(name: Name): HostEntry "(Unix_HostEntry)gethostbyname(name)"; - PROCEDURE -Gethostname*(VAR name: Name): LONGINT + PROCEDURE -Gethostname*(VAR name: Name): INTEGER "gethostname(name, name__len)"; - PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT + PROCEDURE -Socket*(af, type, protocol: INTEGER): INTEGER "socket(af, type, protocol)"; - PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT + PROCEDURE -Connect*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER "connect(socket, &(name), namelen)"; - PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT + PROCEDURE -Getsockname*(socket: INTEGER; VAR name: Sockaddr; VAR namelen: INTEGER): INTEGER "getsockname(socket, name, namelen)"; - PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT + PROCEDURE -Bind*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER "bind(socket, &(name), namelen)"; - PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT + PROCEDURE -Listen*(socket, backlog: INTEGER): INTEGER "listen(socket, backlog)"; - PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT + PROCEDURE -Accept*(socket: INTEGER; VAR addr: Sockaddr; VAR addrlen: INTEGER): LONGINT "accept(socket, addr, addrlen)"; - PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT + PROCEDURE -Recv*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT "recv(socket, bufadr, buflen, flags)"; - PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT + PROCEDURE -Send*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT "send(socket, bufadr, buflen, flags)"; PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *) diff --git a/src/lib/ulm/armv6j/ulmSysConversions.Mod b/src/lib/ulm/armv6j/ulmSysConversions.Mod deleted file mode 100644 index f8ea3fbb..00000000 --- a/src/lib/ulm/armv6j/ulmSysConversions.Mod +++ /dev/null @@ -1,574 +0,0 @@ -(* Ulm's Oberon Library - Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany - ---------------------------------------------------------------------------- - Ulm's Oberon Library is free software; you can redistribute it - and/or modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either version - 2 of the License, or (at your option) any later version. - - Ulm's Oberon Library is distributed in the hope that it will be - useful, but WITHOUT ANY WARRANTY; without even the implied warranty - of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - ---------------------------------------------------------------------------- - E-mail contact: oberon@mathematik.uni-ulm.de - ---------------------------------------------------------------------------- - $Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $ - ---------------------------------------------------------------------------- - $Log: SysConversi.om,v $ - Revision 1.2 1997/07/30 09:38:16 borchert - bug in ReadConv fixed: cv.flags was used but not set for - counts > 1 - - Revision 1.1 1994/02/23 07:58:28 borchert - Initial revision - - ---------------------------------------------------------------------------- - AFB 8/90 - adapted to linux cae 02/01 - ---------------------------------------------------------------------------- -*) - -MODULE ulmSysConversions; - - (* convert Oberon records to/from C structures *) - - IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings, - SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts; - - TYPE - Address* = SysTypes.Address; - Size* = Address; - - (* format: - - Format = Conversion { "/" Conversion } . - Conversion = [ Factors ] ConvChars [ Comment ] . - Factors = Array | Factor | Array Factor | Factor Array . - Array = Integer ":" . - Factor = Integer "*" . - ConvChars = OberonType CType | Skip CType | OberonType Skip . - OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" . - CType = "a" | "c" | "s" | "i" | "l" . - Integer = Digit { Digit } . - Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" . - Skip = "-" . - Comment = "=" { AnyChar } . - AnyChar = (* all characters except "/" *) . - - Oberon data types: - - a: Address - b: SYS.BYTE - B: BOOLEAN - c: CHAR - s: SHORTINT - i: INTEGER - l: LONGINT - S: SET - - C data types: - - a: char * - c: /* signed */ char - C: unsigned char - s: short int - S: unsigned short int - i: int - I: unsigned int - u: unsigned int - l: long int - L: unsigned long int - - example: - - conversion from - - Rec = - RECORD - a, b: INTEGER; - c: CHAR; - s: SET; - f: ARRAY 3 OF INTEGER; - END; - - to - - struct rec { - short a, b; - char c; - int xx; /* to be skipped on conversion */ - int s; - int f[3]; - }; - - or vice versa: - - "2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f" - - The comments allow to give the field names. - *) - - CONST - (* conversion flags *) - unsigned = 0; (* suppress sign extension *) - boolean = 1; (* convert anything # 0 to 1 *) - TYPE - Flags = SET; - Event* = POINTER TO EventRec; - EventRec* = - RECORD - (Events.EventRec) - format*: Events.Message; - END; - ConvStream = POINTER TO ConvStreamRec; - ConvStreamRec = - RECORD - fmt: Texts.Text; - char: CHAR; - eof: BOOLEAN; - (* 1: Oberon type - 2: C type - *) - type1, type2: CHAR; length: INTEGER; left: INTEGER; - offset1, offset2: Address; - size1, size2: Address; elementsleft: INTEGER; flags: Flags; - END; - - Format* = POINTER TO FormatRec; - FormatRec* = - RECORD - (Objects.ObjectRec) - offset1, offset2: Address; - size1, size2: Address; - flags: Flags; - next: Format; - END; - VAR - badformat*: Events.EventType; - - PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR); - VAR - event: Event; - BEGIN - NEW(event); - event.type := badformat; - event.message := "SysConversions: "; - Strings.Concatenate(event.message, msg); - Strings.Read(event.format, cv.fmt); - Events.Raise(event); - cv.eof := TRUE; - cv.char := 0X; - cv.left := 0; - cv.elementsleft := 0; - END Error; - - PROCEDURE SizeError(msg, format: ARRAY OF CHAR); - VAR - event: Event; - BEGIN - NEW(event); - event.type := badformat; - event.message := "SysConversions: "; - Strings.Concatenate(event.message, msg); - COPY(format, event.format); - Events.Raise(event); - END SizeError; - - PROCEDURE NextCh(cv: ConvStream); - BEGIN - cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X); - IF cv.eof THEN - cv.char := 0X; - END; - END NextCh; - - PROCEDURE IsDigit(ch: CHAR) : BOOLEAN; - BEGIN - RETURN (ch >= "0") & (ch <= "9") - END IsDigit; - - PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER); - BEGIN - i := 0; - REPEAT - i := 10 * i + ORD(cv.char) - ORD("0"); - NextCh(cv); - UNTIL ~IsDigit(cv.char); - END ReadInt; - - PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR); - BEGIN - NEW(cv); - Texts.Open(SYS.VAL(Streams.Stream, cv.fmt)); - Strings.Write(cv.fmt, format); - cv.left := 0; cv.elementsleft := 0; - cv.offset1 := 0; cv.offset2 := 0; - cv.eof := FALSE; - NextCh(cv); - END Open; - - PROCEDURE Close(VAR cv: ConvStream); - BEGIN - IF ~Streams.Close(cv.fmt) THEN END; - END Close; - - PROCEDURE ScanConv(cv: ConvStream; - VAR type1, type2: CHAR; - VAR length: INTEGER) : BOOLEAN; - VAR - i: INTEGER; - factor: INTEGER; - BEGIN - IF cv.left > 0 THEN - type1 := cv.type1; - type2 := cv.type2; - length := cv.length; - DEC(cv.left); - RETURN TRUE - END; - IF cv.char = "/" THEN - NextCh(cv); - END; - IF cv.eof THEN - RETURN FALSE - END; - factor := 0; length := 0; - WHILE IsDigit(cv.char) DO - ReadInt(cv, i); - IF i <= 0 THEN - Error(cv, "integer must be positive"); RETURN FALSE - END; - IF cv.char = ":" THEN - IF length # 0 THEN - Error(cv, "multiple length specification"); RETURN FALSE - END; - length := i; - NextCh(cv); - ELSIF cv.char = "*" THEN - IF factor # 0 THEN - Error(cv, "multiple factor specification"); RETURN FALSE - END; - factor := i; cv.left := factor - 1; - NextCh(cv); - ELSE - Error(cv, "factor or length expected"); RETURN FALSE - END; - END; - type1 := cv.char; NextCh(cv); - type2 := cv.char; NextCh(cv); - IF cv.left > 0 THEN - cv.type1 := type1; cv.type2 := type2; cv.length := length; - END; - IF cv.char = "=" THEN (* comment *) - REPEAT - NextCh(cv); - UNTIL cv.eof OR (cv.char = "/"); - END; - RETURN TRUE - END ScanConv; - - PROCEDURE Align(VAR offset: Address; boundary: Address); - BEGIN - IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN - offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary)); - END; - END Align; - - PROCEDURE ReadConv(cv: ConvStream; - VAR offset1, offset2: Address; - VAR size1, size2: Address; - VAR flags: Flags) : BOOLEAN; - VAR - type1, type2: CHAR; - length: INTEGER; - align: BOOLEAN; - boundary: INTEGER; - BEGIN - IF cv.elementsleft > 0 THEN - DEC(cv.elementsleft); - - (* Oberon type *) - IF size1 > SIZE(SYS.BYTE) THEN - Align(cv.offset1, SIZE(INTEGER)); - END; - offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; - size1 := cv.size1; size2 := cv.size2; flags := cv.flags; - IF (size1 > 0) & (cv.elementsleft = 0) THEN - Align(cv.offset1, SIZE(INTEGER)); - END; - - (* C type *) - IF size2 > 1 THEN - Align(cv.offset2, 2); - END; - offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); - - RETURN TRUE - END; - IF ScanConv(cv, type1, type2, length) THEN - flags := {}; - (* Oberon type *) - CASE type1 OF - | "a": size1 := SIZE(Address); INCL(flags, unsigned); - | "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned); - | "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean); - | "c": size1 := SIZE(CHAR); INCL(flags, unsigned); - | "s": size1 := SIZE(SHORTINT); - | "i": size1 := SIZE(INTEGER); - | "l": size1 := SIZE(LONGINT); - | "S": size1 := SIZE(SET); INCL(flags, unsigned); - | "-": size1 := 0; - ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE - END; - IF size1 > 0 THEN - IF length > 0 THEN - Align(cv.offset1, SIZE(INTEGER)); - ELSIF size1 > SIZE(SYS.BYTE) THEN - Align(cv.offset1, SIZE(INTEGER)); - END; - END; - offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; - - (* C type *) - CASE type2 OF - | "a": size2 := 4; INCL(flags, unsigned); (* char* *) - | "c": size2 := 1; (* /* signed */ char *) - | "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *) - | "s": size2 := 2; (* short int *) - | "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *) - | "i": size2 := 4; (* int *) - | "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *) - | "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *) - | "l": size2 := 4; (* long int *) - | "L": size2 := 4; INCL(flags, unsigned); (* long int *) - | "-": size2 := 0; - ELSE Error(cv, "bad C type specifier"); RETURN FALSE - END; - IF size2 > 1 THEN - Align(cv.offset2, size2); - END; - offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); - - cv.size1 := size1; cv.size2 := size2; - IF length > 0 THEN - cv.elementsleft := length - 1; - cv.flags := flags; - END; - RETURN TRUE - ELSE - RETURN FALSE - END; - END ReadConv; - - PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags); - TYPE - Bytes = ARRAY 8 OF CHAR; - Pointer = POINTER TO Bytes; - VAR - dest, source: Pointer; - dindex, sindex: INTEGER; - nonzero: BOOLEAN; - fill : CHAR; - BEGIN - IF ssize > 0 THEN - dest := SYS.VAL(Pointer, to); - source := SYS.VAL(Pointer, from); - dindex := 0; sindex := 0; - IF boolean IN flags THEN - nonzero := FALSE; - WHILE ssize > 0 DO - nonzero := nonzero OR (source[sindex] # 0X); - INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1; - END; - IF dsize > 0 THEN - IF nonzero THEN - dest[dindex] := 1X; - ELSE - dest[dindex] := 0X; - END; - dsize := dsize - 1; INC (dindex); - END; - WHILE dsize > 0 DO - dest[dindex] := 0X; - dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); - END; - ELSE - WHILE (dsize > 0) & (ssize > 0) DO - dest[dindex] := source[sindex]; - ssize := SYS.VAL (INTEGER, ssize) - 1; - dsize := dsize - 1; - INC(dindex); INC(sindex); - END; - IF dsize > 0 THEN - (* sindex has been incremented at least once because - * ssize and dsize were greater than 0, i.e. sindex-1 - * is a valid inex. *) - fill := 0X; - IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN - fill := 0FFX; - END; - END; - WHILE dsize > 0 DO - dest[dindex] := fill; - dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); - END; - END; - END; - END Convert; - - PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR); - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - flags: Flags; - BEGIN - Open(cv, format); - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO - Convert(from + offset1, to + offset2, size1, size2, flags); - END; - Close(cv); - END ByAddrToC; - - PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR); - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - flags: Flags; - BEGIN - Open(cv, format); - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO - Convert(from + offset2, to + offset1, size2, size1, flags); - END; - Close(cv); - END ByAddrFromC; - - PROCEDURE CSize*(format: ARRAY OF CHAR) : Size; - (* returns the size of the C-structure described by `format' *) - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - size: Address; - flags: Flags; - BEGIN - Open(cv, format); - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; - Close(cv); - size := offset2 + size2; - Align(size, 2); - RETURN size - END CSize; - - PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size; - (* returns the size of the Oberon-structure described by `format' *) - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - size: Address; - flags: Flags; - BEGIN - Open(cv, format); - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; - Close(cv); - size := offset1 + size1; - Align(size, SIZE(INTEGER)); - RETURN size - END OberonSize; - - PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); - BEGIN - IF OberonSize(format) > LEN(from) THEN - SizeError("Oberon record is too small", format); RETURN - END; - IF CSize(format) > LEN(to) THEN - SizeError("C structure is too small", format); RETURN - END; - ByAddrToC(SYS.ADR(from), SYS.ADR(to), format); - END ToC; - - PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); - BEGIN - IF OberonSize(format) > LEN(to) THEN - SizeError("Oberon record is too small", format); RETURN - END; - IF CSize(format) > LEN(from) THEN - SizeError("C structure is too small", format); RETURN - END; - ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format); - END FromC; - - PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR); - (* translate format into an internal representation - which is later referenced by fmt; - ByFmtToC and ByFmtFromC are faster than ToC and FromC - *) - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - flags: Flags; - element: Format; - head, tail: Format; - BEGIN - Open(cv, format); - head := NIL; tail := NIL; - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO - NEW(element); - element.offset1 := offset1; - element.offset2 := offset2; - element.size1 := size1; - element.size2 := size2; - element.flags := flags; - element.next := NIL; - IF tail # NIL THEN - tail.next := element; - ELSE - head := element; - END; - tail := element; - END; - fmt := head; - Close(cv); - END Compile; - - PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format); - VAR - offset1, offset2, size1, size2: Address; - flags: Flags; - BEGIN - WHILE format # NIL DO - Convert(from + format.offset1, to + format.offset2, - format.size1, format.size2, format.flags); - format := format.next; - END; - END ByFmtAndAddrToC; - - PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format); - VAR - offset1, offset2, size1, size2: Address; - flags: Flags; - BEGIN - WHILE format # NIL DO - Convert(from + format.offset2, to + format.offset1, - format.size2, format.size1, format.flags); - format := format.next; - END; - END ByFmtAndAddrFromC; - - PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); - BEGIN - ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format); - END ByFmtToC; - - PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); - BEGIN - ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format); - END ByFmtFromC; - -BEGIN - Events.Define(badformat); - Events.SetPriority(badformat, Priorities.liberrors); -END ulmSysConversions. diff --git a/src/lib/ulm/armv6j/ulmSysStat.Mod b/src/lib/ulm/armv6j/ulmSysStat.Mod deleted file mode 100644 index c7f00f04..00000000 --- a/src/lib/ulm/armv6j/ulmSysStat.Mod +++ /dev/null @@ -1,201 +0,0 @@ -(* Ulm's Oberon Library - Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany - ---------------------------------------------------------------------------- - Ulm's Oberon Library is free software; you can redistribute it - and/or modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either version - 2 of the License, or (at your option) any later version. - - Ulm's Oberon Library is distributed in the hope that it will be - useful, but WITHOUT ANY WARRANTY; without even the implied warranty - of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - ---------------------------------------------------------------------------- - E-mail contact: oberon@mathematik.uni-ulm.de - ---------------------------------------------------------------------------- - $Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $ - ---------------------------------------------------------------------------- - $Log: SysStat.om,v $ - Revision 1.3 2000/11/12 13:02:09 borchert - door file type added - - Revision 1.2 2000/11/12 12:48:07 borchert - - conversion adapted to Solaris 2.x - - Lstat added - - Revision 1.1 1994/02/23 08:00:48 borchert - Initial revision - - ---------------------------------------------------------------------------- - AFB 9/89 - ---------------------------------------------------------------------------- -*) - -MODULE ulmSysStat; - - (* examine inode: stat(2) and fstat(2) *) - - IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors, - SysTypes := ulmSysTypes; - - CONST - (* file mode: - bit 0 = 1<<0 bit 31 = 1<<31 - - user group other - 3 1 1111 11 - 1 ... 6 5432 109 876 543 210 - +--------+------+-----+-----+-----+-----+ - | unused | type | sst | rwx | rwx | rwx | - +--------+------+-----+-----+-----+-----+ - *) - - type* = {12..15}; - prot* = {0..8}; - - (* file types; example: (stat.mode * type = dir) *) - reg* = {15}; (* regular *) - dir* = {14}; (* directory *) - chr* = {13}; (* character special *) - fifo* = {12}; (* fifo *) - blk* = {13..14}; (* block special *) - symlink* = {13, 15}; (* symbolic link *) - socket* = {14, 15}; (* socket *) - - (* special *) - setuid* = 11; (* set user id on execution *) - setgid* = 10; (* set group id on execution *) - savetext* = 9; (* save swapped text even after use *) - - (* protection *) - uread* = 8; (* read permission owner *) - uwrite* = 7; (* write permission owner *) - uexec* = 6; (* execute/search permission owner *) - gread* = 5; (* read permission group *) - gwrite* = 4; (* write permission group *) - gexec* = 3; (* execute/search permission group *) - oread* = 2; (* read permission other *) - owrite* = 1; (* write permission other *) - oexec* = 0; (* execute/search permission other *) - - (* example for "r-xr-x---": (read + exec) * (owner + group) *) - owner* = {uread, uwrite, uexec}; - group* = {gread, gwrite, gexec}; - other* = {oread, owrite, oexec}; - read* = {uread, gread, oread}; - write* = {uwrite, gwrite, owrite}; - exec* = {uexec, gexec, oexec}; - rwx* = prot; - - TYPE - StatRec* = (* result of stat(2) and fstat(2) *) - RECORD - device*: SysTypes.Device; (* ID of device containing - a directory entry for this file *) - inode*: SysTypes.Inode; (* inode number *) - mode*: SET; (* file mode; see mknod(2) *) - nlinks*: LONGINT; (* number of links *) - uid*: LONGINT; (* user id of the file's owner *) - gid*: LONGINT; (* group id of the file's group *) - rdev*: SysTypes.Device; (* ID of device - this entry is defined only for - character special or block - special files - *) - size*: SysTypes.Offset; (* file size in bytes *) - blksize*: LONGINT; (* preferred blocksize *) - blocks*: LONGINT; (* # of blocks allocated *) - atime*: SysTypes.Time; (* time of last access *) - mtime*: SysTypes.Time; (* time of last data modification *) - ctime*: SysTypes.Time; (* time of last file status change *) - END; - -(* Linux kernel struct stat (2.2.17) - struct stat { - unsigned short st_dev; - unsigned short __pad1; - unsigned long st_ino; - unsigned short st_mode; - unsigned short st_nlink; - unsigned short st_uid; - unsigned short st_gid; - unsigned short st_rdev; - unsigned short __pad2; - unsigned long st_size; - unsigned long st_blksize; - unsigned long st_blocks; - unsigned long st_atime; - unsigned long __unused1; - unsigned long st_mtime; - unsigned long __unused2; - unsigned long st_ctime; - unsigned long __unused3; - unsigned long __unused4; - unsigned long __unused5; - }; -*) - - CONST - statbufsize = 88(*64*); (* see *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *) - TYPE - UnixStatRec = ARRAY statbufsize OF SYS.BYTE; - CONST - statbufconv = - (*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*) - (*"ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";*) - "ll=dev/-l=devx/-s=pad1/ll=ino/Sl=mode/ll=nlink/ll=uid/ll=gid/ll=rdev/-l=rdevx/-s=pad2/ll=size/2*ll=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; - VAR - statbuffmt: SysConversions.Format; - - PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; - errors: RelatedEvents.Object) : BOOLEAN; - VAR - d0, d1, d2: LONGINT; - origbuf: UnixStatRec; - BEGIN - IF uSYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN - SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); - RETURN TRUE - ELSE - SysErrors.Raise(errors, d0, Sys.newstat, path); - RETURN FALSE - END; - END Stat; -(* - PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec; - errors: RelatedEvents.Object) : BOOLEAN; - VAR - d0, d1: INTEGER; - origbuf: UnixStatRec; - BEGIN - IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN - SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); - RETURN TRUE - ELSE - SysErrors.Raise(errors, d0, Sys.newlstat, path); - RETURN FALSE - END; - END Lstat; -*) - PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; - errors: RelatedEvents.Object) : BOOLEAN; - VAR - d0, d1, d2: LONGINT; - origbuf: UnixStatRec; - BEGIN - IF uSYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf), d2) THEN - SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); - RETURN TRUE - ELSE - SysErrors.Raise(errors, d0, Sys.newfstat, ""); - RETURN FALSE - END; - END Fstat; - -BEGIN - SysConversions.Compile(statbuffmt, statbufconv); -END ulmSysStat. diff --git a/src/lib/ulm/armv6j/ulmSysTypes.Mod b/src/lib/ulm/armv6j/ulmSysTypes.Mod deleted file mode 100644 index 174140e7..00000000 --- a/src/lib/ulm/armv6j/ulmSysTypes.Mod +++ /dev/null @@ -1,70 +0,0 @@ -(* Ulm's Oberon Library - Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany - ---------------------------------------------------------------------------- - Ulm's Oberon Library is free software; you can redistribute it - and/or modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either version - 2 of the License, or (at your option) any later version. - - Ulm's Oberon Library is distributed in the hope that it will be - useful, but WITHOUT ANY WARRANTY; without even the implied warranty - of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - ---------------------------------------------------------------------------- - E-mail contact: oberon@mathematik.uni-ulm.de - ---------------------------------------------------------------------------- - $Id: SysTypes.om,v 1.1 1994/02/23 08:01:38 borchert Exp $ - ---------------------------------------------------------------------------- - $Log: SysTypes.om,v $ - Revision 1.1 1994/02/23 08:01:38 borchert - Initial revision - - ---------------------------------------------------------------------------- - AFB 9/89 - ---------------------------------------------------------------------------- -*) - -MODULE ulmSysTypes; - - IMPORT Types := ulmTypes; - - TYPE - Address* = Types.Address; - UntracedAddress* = Types.UntracedAddress; - Count* = Types.Count; - Size* = Types.Size; - Byte* = Types.Byte; - - File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *) - Offset* = LONGINT; - Device* = LONGINT; - Inode* = LONGINT; - Time* = LONGINT; - - Word* = INTEGER; (* must have the size of C's int-type *) - - (* Note: linux supports wait4 but not waitid, i.e. these - * constants aren't needed. *) - (* - CONST - (* possible values of the idtype parameter (4 bytes), - see - *) - idPid = 0; (* a process identifier *) - idPpid = 1; (* a parent process identifier *) - idPgid = 2; (* a process group (job control group) identifier *) - idSid = 3; (* a session identifier *) - idCid = 4; (* a scheduling class identifier *) - idUid = 5; (* a user identifier *) - idGid = 6; (* a group identifier *) - idAll = 7; (* all processes *) - idLwpid = 8; (* an LWP identifier *) - TYPE - IdType = INTEGER; (* idPid .. idLwpid *) - *) - -END ulmSysTypes. diff --git a/src/lib/ulm/armv6j/ulmTypes.Mod b/src/lib/ulm/armv6j/ulmTypes.Mod deleted file mode 100644 index fe2d6eca..00000000 --- a/src/lib/ulm/armv6j/ulmTypes.Mod +++ /dev/null @@ -1,133 +0,0 @@ -(* Ulm's Oberon Library - Copyright (C) 1989-2000 by University of Ulm, SAI, D-89069 Ulm, Germany - ---------------------------------------------------------------------------- - Ulm's Oberon Library is free software; you can redistribute it - and/or modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either version - 2 of the License, or (at your option) any later version. - - Ulm's Oberon Library is distributed in the hope that it will be - useful, but WITHOUT ANY WARRANTY; without even the implied warranty - of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - ---------------------------------------------------------------------------- - E-mail contact: oberon@mathematik.uni-ulm.de - ---------------------------------------------------------------------------- - $Id: Types.om,v 1.5 2000/12/13 10:03:00 borchert Exp $ - ---------------------------------------------------------------------------- - $Log: Types.om,v $ - Revision 1.5 2000/12/13 10:03:00 borchert - SetInt type used in msb constant - - Revision 1.4 2000/12/13 09:51:57 borchert - constants and types for the relationship of INTEGER and SET added - - Revision 1.3 1998/09/25 15:23:09 borchert - Real32..Real128 added - - Revision 1.2 1994/07/01 11:08:04 borchert - IntAddress, Int8/16/32, ToInt8/16/32 and bit/little endian stuff added - - Revision 1.1 1994/02/22 20:12:14 borchert - Initial revision - - ---------------------------------------------------------------------------- - AFB 9/93 - ---------------------------------------------------------------------------- -*) - -MODULE ulmTypes; - - (* compiler-dependent type definitions; - this version works for Ulm's Oberon Compilers on - following architectures: m68k and sparc - *) - - IMPORT SYS := SYSTEM; - - TYPE - Address* = LONGINT (*SYS.ADDRESS*); - (* ulm compiler can accept - VAR p : SYSTEM.ADDRESS; // SYSTEM.PTR in ETH and V4 versions - ... - p := SYSTEM.ADR(something); - and this is how it is used in ulm oberon system library, - while SYSTEM.ADR returns LONGINT in ETH and V4 versions. - Thus I leave it as LONGINT for now, before coming up with better solution -- noch *) - UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*) - UntracedAddressDesc* = RECORD[1] END; - Count* = LONGINT; - Size* = Count; - Byte* = SYS.BYTE; - IntAddress* = LONGINT; - Int8* = SHORTINT; - Int16* = INTEGER; - Int32* = LONGINT; - Real32* = REAL; - Real64* = LONGREAL; - - CONST - bigEndian* = 0; (* SPARC, M68K etc *) - littleEndian* = 1; (* Intel 80x86, VAX etc *) - byteorder* = littleEndian; (* machine-dependent constant *) - TYPE - ByteOrder* = SHORTINT; (* bigEndian or littleEndian *) - - (* following constants and type definitions try to make - conversions from INTEGER to SET and vice versa more portable - to allow for bit operations on INTEGER values - *) - TYPE - SetInt* = LONGINT; (* INTEGER type that corresponds to SET *) - VAR msb* : SET; - msbIsMax*, msbIs0*: SHORTINT; - msbindex*, lsbindex*, nofbits*: LONGINT; - - PROCEDURE ToInt8*(int: LONGINT) : Int8; - BEGIN - RETURN SHORT(SHORT(int)) - END ToInt8; - - PROCEDURE ToInt16*(int: LONGINT) : Int16; - BEGIN - RETURN SYS.VAL(Int16, int) - END ToInt16; - - PROCEDURE ToInt32*(int: LONGINT) : Int32; - BEGIN - RETURN int - END ToInt32; - - PROCEDURE ToReal32*(real: LONGREAL) : Real32; - BEGIN - RETURN SHORT(real) - END ToReal32; - - PROCEDURE ToReal64*(real: LONGREAL) : Real64; - BEGIN - RETURN real - END ToReal64; - -BEGIN - msb := SYS.VAL(SET, MIN(SetInt)); - (* most significant bit, converted to a SET *) - (* we expect msbIsMax XOR msbIs0 to be 1; - this is checked for by an assertion - *) - msbIsMax := SYS.VAL(SHORTINT, (msb = {MAX(SET)})); - (* is 1, if msb equals {MAX(SET)} *) - msbIs0 := SYS.VAL(SHORTINT, (msb = {0})); - (* is 0, if msb equals {0} *) - msbindex := msbIsMax * MAX(SET); - (* set element that corresponds to the most-significant-bit *) - lsbindex := MAX(SET) - msbindex; - (* set element that corresponds to the lowest-significant-bit *) - nofbits := MAX(SET) + 1; - (* number of elements in SETs *) - - ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1)); -END ulmTypes. diff --git a/src/lib/ulm/ulmSYSTEM.Mod b/src/lib/ulm/armv6j_hardfp/ulmSYSTEM.Mod similarity index 100% rename from src/lib/ulm/ulmSYSTEM.Mod rename to src/lib/ulm/armv6j_hardfp/ulmSYSTEM.Mod diff --git a/src/lib/ulm/armv7a_hardfp/ulmSysConversions.Mod b/src/lib/ulm/armv7a_hardfp/ulmSysConversions.Mod deleted file mode 100644 index f8ea3fbb..00000000 --- a/src/lib/ulm/armv7a_hardfp/ulmSysConversions.Mod +++ /dev/null @@ -1,574 +0,0 @@ -(* Ulm's Oberon Library - Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany - ---------------------------------------------------------------------------- - Ulm's Oberon Library is free software; you can redistribute it - and/or modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either version - 2 of the License, or (at your option) any later version. - - Ulm's Oberon Library is distributed in the hope that it will be - useful, but WITHOUT ANY WARRANTY; without even the implied warranty - of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - ---------------------------------------------------------------------------- - E-mail contact: oberon@mathematik.uni-ulm.de - ---------------------------------------------------------------------------- - $Id: SysConversi.om,v 1.2 1997/07/30 09:38:16 borchert Exp $ - ---------------------------------------------------------------------------- - $Log: SysConversi.om,v $ - Revision 1.2 1997/07/30 09:38:16 borchert - bug in ReadConv fixed: cv.flags was used but not set for - counts > 1 - - Revision 1.1 1994/02/23 07:58:28 borchert - Initial revision - - ---------------------------------------------------------------------------- - AFB 8/90 - adapted to linux cae 02/01 - ---------------------------------------------------------------------------- -*) - -MODULE ulmSysConversions; - - (* convert Oberon records to/from C structures *) - - IMPORT Events := ulmEvents, Objects := ulmObjects, Priorities := ulmPriorities, Streams := ulmStreams, Strings := ulmStrings, - SYS := SYSTEM, SysTypes := ulmSysTypes, Texts := ulmTexts; - - TYPE - Address* = SysTypes.Address; - Size* = Address; - - (* format: - - Format = Conversion { "/" Conversion } . - Conversion = [ Factors ] ConvChars [ Comment ] . - Factors = Array | Factor | Array Factor | Factor Array . - Array = Integer ":" . - Factor = Integer "*" . - ConvChars = OberonType CType | Skip CType | OberonType Skip . - OberonType = "a" | "b" | "c" | "s" | "i" | "l" | "S" . - CType = "a" | "c" | "s" | "i" | "l" . - Integer = Digit { Digit } . - Digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9" . - Skip = "-" . - Comment = "=" { AnyChar } . - AnyChar = (* all characters except "/" *) . - - Oberon data types: - - a: Address - b: SYS.BYTE - B: BOOLEAN - c: CHAR - s: SHORTINT - i: INTEGER - l: LONGINT - S: SET - - C data types: - - a: char * - c: /* signed */ char - C: unsigned char - s: short int - S: unsigned short int - i: int - I: unsigned int - u: unsigned int - l: long int - L: unsigned long int - - example: - - conversion from - - Rec = - RECORD - a, b: INTEGER; - c: CHAR; - s: SET; - f: ARRAY 3 OF INTEGER; - END; - - to - - struct rec { - short a, b; - char c; - int xx; /* to be skipped on conversion */ - int s; - int f[3]; - }; - - or vice versa: - - "2*is=a,b/cc=c/-i=xx/Si=s/3:ii=f" - - The comments allow to give the field names. - *) - - CONST - (* conversion flags *) - unsigned = 0; (* suppress sign extension *) - boolean = 1; (* convert anything # 0 to 1 *) - TYPE - Flags = SET; - Event* = POINTER TO EventRec; - EventRec* = - RECORD - (Events.EventRec) - format*: Events.Message; - END; - ConvStream = POINTER TO ConvStreamRec; - ConvStreamRec = - RECORD - fmt: Texts.Text; - char: CHAR; - eof: BOOLEAN; - (* 1: Oberon type - 2: C type - *) - type1, type2: CHAR; length: INTEGER; left: INTEGER; - offset1, offset2: Address; - size1, size2: Address; elementsleft: INTEGER; flags: Flags; - END; - - Format* = POINTER TO FormatRec; - FormatRec* = - RECORD - (Objects.ObjectRec) - offset1, offset2: Address; - size1, size2: Address; - flags: Flags; - next: Format; - END; - VAR - badformat*: Events.EventType; - - PROCEDURE Error(cv: ConvStream; msg: ARRAY OF CHAR); - VAR - event: Event; - BEGIN - NEW(event); - event.type := badformat; - event.message := "SysConversions: "; - Strings.Concatenate(event.message, msg); - Strings.Read(event.format, cv.fmt); - Events.Raise(event); - cv.eof := TRUE; - cv.char := 0X; - cv.left := 0; - cv.elementsleft := 0; - END Error; - - PROCEDURE SizeError(msg, format: ARRAY OF CHAR); - VAR - event: Event; - BEGIN - NEW(event); - event.type := badformat; - event.message := "SysConversions: "; - Strings.Concatenate(event.message, msg); - COPY(format, event.format); - Events.Raise(event); - END SizeError; - - PROCEDURE NextCh(cv: ConvStream); - BEGIN - cv.eof := cv.eof OR ~Streams.ReadByte(cv.fmt, cv.char) OR (cv.char = 0X); - IF cv.eof THEN - cv.char := 0X; - END; - END NextCh; - - PROCEDURE IsDigit(ch: CHAR) : BOOLEAN; - BEGIN - RETURN (ch >= "0") & (ch <= "9") - END IsDigit; - - PROCEDURE ReadInt(cv: ConvStream; VAR i: INTEGER); - BEGIN - i := 0; - REPEAT - i := 10 * i + ORD(cv.char) - ORD("0"); - NextCh(cv); - UNTIL ~IsDigit(cv.char); - END ReadInt; - - PROCEDURE Open(VAR cv: ConvStream; format: ARRAY OF CHAR); - BEGIN - NEW(cv); - Texts.Open(SYS.VAL(Streams.Stream, cv.fmt)); - Strings.Write(cv.fmt, format); - cv.left := 0; cv.elementsleft := 0; - cv.offset1 := 0; cv.offset2 := 0; - cv.eof := FALSE; - NextCh(cv); - END Open; - - PROCEDURE Close(VAR cv: ConvStream); - BEGIN - IF ~Streams.Close(cv.fmt) THEN END; - END Close; - - PROCEDURE ScanConv(cv: ConvStream; - VAR type1, type2: CHAR; - VAR length: INTEGER) : BOOLEAN; - VAR - i: INTEGER; - factor: INTEGER; - BEGIN - IF cv.left > 0 THEN - type1 := cv.type1; - type2 := cv.type2; - length := cv.length; - DEC(cv.left); - RETURN TRUE - END; - IF cv.char = "/" THEN - NextCh(cv); - END; - IF cv.eof THEN - RETURN FALSE - END; - factor := 0; length := 0; - WHILE IsDigit(cv.char) DO - ReadInt(cv, i); - IF i <= 0 THEN - Error(cv, "integer must be positive"); RETURN FALSE - END; - IF cv.char = ":" THEN - IF length # 0 THEN - Error(cv, "multiple length specification"); RETURN FALSE - END; - length := i; - NextCh(cv); - ELSIF cv.char = "*" THEN - IF factor # 0 THEN - Error(cv, "multiple factor specification"); RETURN FALSE - END; - factor := i; cv.left := factor - 1; - NextCh(cv); - ELSE - Error(cv, "factor or length expected"); RETURN FALSE - END; - END; - type1 := cv.char; NextCh(cv); - type2 := cv.char; NextCh(cv); - IF cv.left > 0 THEN - cv.type1 := type1; cv.type2 := type2; cv.length := length; - END; - IF cv.char = "=" THEN (* comment *) - REPEAT - NextCh(cv); - UNTIL cv.eof OR (cv.char = "/"); - END; - RETURN TRUE - END ScanConv; - - PROCEDURE Align(VAR offset: Address; boundary: Address); - BEGIN - IF SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary) # 0 THEN - offset := SYS.VAL (INTEGER, offset) + (SYS.VAL (INTEGER, boundary) - SYS.VAL (INTEGER, offset) MOD SYS.VAL (INTEGER, boundary)); - END; - END Align; - - PROCEDURE ReadConv(cv: ConvStream; - VAR offset1, offset2: Address; - VAR size1, size2: Address; - VAR flags: Flags) : BOOLEAN; - VAR - type1, type2: CHAR; - length: INTEGER; - align: BOOLEAN; - boundary: INTEGER; - BEGIN - IF cv.elementsleft > 0 THEN - DEC(cv.elementsleft); - - (* Oberon type *) - IF size1 > SIZE(SYS.BYTE) THEN - Align(cv.offset1, SIZE(INTEGER)); - END; - offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; - size1 := cv.size1; size2 := cv.size2; flags := cv.flags; - IF (size1 > 0) & (cv.elementsleft = 0) THEN - Align(cv.offset1, SIZE(INTEGER)); - END; - - (* C type *) - IF size2 > 1 THEN - Align(cv.offset2, 2); - END; - offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); - - RETURN TRUE - END; - IF ScanConv(cv, type1, type2, length) THEN - flags := {}; - (* Oberon type *) - CASE type1 OF - | "a": size1 := SIZE(Address); INCL(flags, unsigned); - | "b": size1 := SIZE(SYS.BYTE); INCL(flags, unsigned); - | "B": size1 := SIZE(BOOLEAN); INCL(flags, boolean); - | "c": size1 := SIZE(CHAR); INCL(flags, unsigned); - | "s": size1 := SIZE(SHORTINT); - | "i": size1 := SIZE(INTEGER); - | "l": size1 := SIZE(LONGINT); - | "S": size1 := SIZE(SET); INCL(flags, unsigned); - | "-": size1 := 0; - ELSE Error(cv, "bad Oberon type specifier"); RETURN FALSE - END; - IF size1 > 0 THEN - IF length > 0 THEN - Align(cv.offset1, SIZE(INTEGER)); - ELSIF size1 > SIZE(SYS.BYTE) THEN - Align(cv.offset1, SIZE(INTEGER)); - END; - END; - offset1 := cv.offset1; cv.offset1 := SYS.VAL (INTEGER, cv.offset1) + size1; - - (* C type *) - CASE type2 OF - | "a": size2 := 4; INCL(flags, unsigned); (* char* *) - | "c": size2 := 1; (* /* signed */ char *) - | "C": size2 := 1; INCL(flags, unsigned); (* unsigned char *) - | "s": size2 := 2; (* short int *) - | "S": size2 := 2; INCL(flags, unsigned); (* unsigned short int *) - | "i": size2 := 4; (* int *) - | "I": size2 := 4; INCL(flags, unsigned); (* unsigned int *) - | "u": size2 := 4; INCL(flags, unsigned); (* unsigned int *) - | "l": size2 := 4; (* long int *) - | "L": size2 := 4; INCL(flags, unsigned); (* long int *) - | "-": size2 := 0; - ELSE Error(cv, "bad C type specifier"); RETURN FALSE - END; - IF size2 > 1 THEN - Align(cv.offset2, size2); - END; - offset2 := cv.offset2; cv.offset2 := SYS.VAL (INTEGER, cv.offset2) + SYS.VAL (INTEGER, size2); - - cv.size1 := size1; cv.size2 := size2; - IF length > 0 THEN - cv.elementsleft := length - 1; - cv.flags := flags; - END; - RETURN TRUE - ELSE - RETURN FALSE - END; - END ReadConv; - - PROCEDURE Convert(from, to: Address; ssize, dsize: Address; flags: Flags); - TYPE - Bytes = ARRAY 8 OF CHAR; - Pointer = POINTER TO Bytes; - VAR - dest, source: Pointer; - dindex, sindex: INTEGER; - nonzero: BOOLEAN; - fill : CHAR; - BEGIN - IF ssize > 0 THEN - dest := SYS.VAL(Pointer, to); - source := SYS.VAL(Pointer, from); - dindex := 0; sindex := 0; - IF boolean IN flags THEN - nonzero := FALSE; - WHILE ssize > 0 DO - nonzero := nonzero OR (source[sindex] # 0X); - INC(sindex); ssize := SYS.VAL (INTEGER, ssize) - 1; - END; - IF dsize > 0 THEN - IF nonzero THEN - dest[dindex] := 1X; - ELSE - dest[dindex] := 0X; - END; - dsize := dsize - 1; INC (dindex); - END; - WHILE dsize > 0 DO - dest[dindex] := 0X; - dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); - END; - ELSE - WHILE (dsize > 0) & (ssize > 0) DO - dest[dindex] := source[sindex]; - ssize := SYS.VAL (INTEGER, ssize) - 1; - dsize := dsize - 1; - INC(dindex); INC(sindex); - END; - IF dsize > 0 THEN - (* sindex has been incremented at least once because - * ssize and dsize were greater than 0, i.e. sindex-1 - * is a valid inex. *) - fill := 0X; - IF ~(unsigned IN flags) & (source[sindex-1] >= 080X) THEN - fill := 0FFX; - END; - END; - WHILE dsize > 0 DO - dest[dindex] := fill; - dsize := SYS.VAL (INTEGER, dsize) - 1; INC(dindex); - END; - END; - END; - END Convert; - - PROCEDURE ByAddrToC*(from, to: Address; format: ARRAY OF CHAR); - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - flags: Flags; - BEGIN - Open(cv, format); - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO - Convert(from + offset1, to + offset2, size1, size2, flags); - END; - Close(cv); - END ByAddrToC; - - PROCEDURE ByAddrFromC*(from, to: Address; format: ARRAY OF CHAR); - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - flags: Flags; - BEGIN - Open(cv, format); - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO - Convert(from + offset2, to + offset1, size2, size1, flags); - END; - Close(cv); - END ByAddrFromC; - - PROCEDURE CSize*(format: ARRAY OF CHAR) : Size; - (* returns the size of the C-structure described by `format' *) - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - size: Address; - flags: Flags; - BEGIN - Open(cv, format); - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; - Close(cv); - size := offset2 + size2; - Align(size, 2); - RETURN size - END CSize; - - PROCEDURE OberonSize*(format: ARRAY OF CHAR) : Size; - (* returns the size of the Oberon-structure described by `format' *) - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - size: Address; - flags: Flags; - BEGIN - Open(cv, format); - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO END; - Close(cv); - size := offset1 + size1; - Align(size, SIZE(INTEGER)); - RETURN size - END OberonSize; - - PROCEDURE ToC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); - BEGIN - IF OberonSize(format) > LEN(from) THEN - SizeError("Oberon record is too small", format); RETURN - END; - IF CSize(format) > LEN(to) THEN - SizeError("C structure is too small", format); RETURN - END; - ByAddrToC(SYS.ADR(from), SYS.ADR(to), format); - END ToC; - - PROCEDURE FromC*(VAR from, to: ARRAY OF SYS.BYTE; format: ARRAY OF CHAR); - BEGIN - IF OberonSize(format) > LEN(to) THEN - SizeError("Oberon record is too small", format); RETURN - END; - IF CSize(format) > LEN(from) THEN - SizeError("C structure is too small", format); RETURN - END; - ByAddrFromC(SYS.ADR(from), SYS.ADR(to), format); - END FromC; - - PROCEDURE Compile*(VAR fmt: Format; format: ARRAY OF CHAR); - (* translate format into an internal representation - which is later referenced by fmt; - ByFmtToC and ByFmtFromC are faster than ToC and FromC - *) - VAR - cv: ConvStream; - offset1, offset2, size1, size2: Address; - flags: Flags; - element: Format; - head, tail: Format; - BEGIN - Open(cv, format); - head := NIL; tail := NIL; - WHILE ReadConv(cv, offset1, offset2, size1, size2, flags) DO - NEW(element); - element.offset1 := offset1; - element.offset2 := offset2; - element.size1 := size1; - element.size2 := size2; - element.flags := flags; - element.next := NIL; - IF tail # NIL THEN - tail.next := element; - ELSE - head := element; - END; - tail := element; - END; - fmt := head; - Close(cv); - END Compile; - - PROCEDURE ByFmtAndAddrToC*(from, to: Address; format: Format); - VAR - offset1, offset2, size1, size2: Address; - flags: Flags; - BEGIN - WHILE format # NIL DO - Convert(from + format.offset1, to + format.offset2, - format.size1, format.size2, format.flags); - format := format.next; - END; - END ByFmtAndAddrToC; - - PROCEDURE ByFmtAndAddrFromC*(from, to: Address; format: Format); - VAR - offset1, offset2, size1, size2: Address; - flags: Flags; - BEGIN - WHILE format # NIL DO - Convert(from + format.offset2, to + format.offset1, - format.size2, format.size1, format.flags); - format := format.next; - END; - END ByFmtAndAddrFromC; - - PROCEDURE ByFmtToC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); - BEGIN - ByFmtAndAddrToC(SYS.ADR(from), SYS.ADR(to), format); - END ByFmtToC; - - PROCEDURE ByFmtFromC*(VAR from, to: ARRAY OF SYS.BYTE; format: Format); - BEGIN - ByFmtAndAddrFromC(SYS.ADR(from), SYS.ADR(to), format); - END ByFmtFromC; - -BEGIN - Events.Define(badformat); - Events.SetPriority(badformat, Priorities.liberrors); -END ulmSysConversions. diff --git a/src/lib/ulm/armv7a_hardfp/ulmSysStat.Mod b/src/lib/ulm/armv7a_hardfp/ulmSysStat.Mod deleted file mode 100644 index c7f00f04..00000000 --- a/src/lib/ulm/armv7a_hardfp/ulmSysStat.Mod +++ /dev/null @@ -1,201 +0,0 @@ -(* Ulm's Oberon Library - Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany - ---------------------------------------------------------------------------- - Ulm's Oberon Library is free software; you can redistribute it - and/or modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either version - 2 of the License, or (at your option) any later version. - - Ulm's Oberon Library is distributed in the hope that it will be - useful, but WITHOUT ANY WARRANTY; without even the implied warranty - of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - ---------------------------------------------------------------------------- - E-mail contact: oberon@mathematik.uni-ulm.de - ---------------------------------------------------------------------------- - $Id: SysStat.om,v 1.3 2000/11/12 13:02:09 borchert Exp $ - ---------------------------------------------------------------------------- - $Log: SysStat.om,v $ - Revision 1.3 2000/11/12 13:02:09 borchert - door file type added - - Revision 1.2 2000/11/12 12:48:07 borchert - - conversion adapted to Solaris 2.x - - Lstat added - - Revision 1.1 1994/02/23 08:00:48 borchert - Initial revision - - ---------------------------------------------------------------------------- - AFB 9/89 - ---------------------------------------------------------------------------- -*) - -MODULE ulmSysStat; - - (* examine inode: stat(2) and fstat(2) *) - - IMPORT RelatedEvents := ulmRelatedEvents, Sys := ulmSys, SYS := SYSTEM, uSYS := ulmSYSTEM, SysConversions := ulmSysConversions, SysErrors := ulmSysErrors, - SysTypes := ulmSysTypes; - - CONST - (* file mode: - bit 0 = 1<<0 bit 31 = 1<<31 - - user group other - 3 1 1111 11 - 1 ... 6 5432 109 876 543 210 - +--------+------+-----+-----+-----+-----+ - | unused | type | sst | rwx | rwx | rwx | - +--------+------+-----+-----+-----+-----+ - *) - - type* = {12..15}; - prot* = {0..8}; - - (* file types; example: (stat.mode * type = dir) *) - reg* = {15}; (* regular *) - dir* = {14}; (* directory *) - chr* = {13}; (* character special *) - fifo* = {12}; (* fifo *) - blk* = {13..14}; (* block special *) - symlink* = {13, 15}; (* symbolic link *) - socket* = {14, 15}; (* socket *) - - (* special *) - setuid* = 11; (* set user id on execution *) - setgid* = 10; (* set group id on execution *) - savetext* = 9; (* save swapped text even after use *) - - (* protection *) - uread* = 8; (* read permission owner *) - uwrite* = 7; (* write permission owner *) - uexec* = 6; (* execute/search permission owner *) - gread* = 5; (* read permission group *) - gwrite* = 4; (* write permission group *) - gexec* = 3; (* execute/search permission group *) - oread* = 2; (* read permission other *) - owrite* = 1; (* write permission other *) - oexec* = 0; (* execute/search permission other *) - - (* example for "r-xr-x---": (read + exec) * (owner + group) *) - owner* = {uread, uwrite, uexec}; - group* = {gread, gwrite, gexec}; - other* = {oread, owrite, oexec}; - read* = {uread, gread, oread}; - write* = {uwrite, gwrite, owrite}; - exec* = {uexec, gexec, oexec}; - rwx* = prot; - - TYPE - StatRec* = (* result of stat(2) and fstat(2) *) - RECORD - device*: SysTypes.Device; (* ID of device containing - a directory entry for this file *) - inode*: SysTypes.Inode; (* inode number *) - mode*: SET; (* file mode; see mknod(2) *) - nlinks*: LONGINT; (* number of links *) - uid*: LONGINT; (* user id of the file's owner *) - gid*: LONGINT; (* group id of the file's group *) - rdev*: SysTypes.Device; (* ID of device - this entry is defined only for - character special or block - special files - *) - size*: SysTypes.Offset; (* file size in bytes *) - blksize*: LONGINT; (* preferred blocksize *) - blocks*: LONGINT; (* # of blocks allocated *) - atime*: SysTypes.Time; (* time of last access *) - mtime*: SysTypes.Time; (* time of last data modification *) - ctime*: SysTypes.Time; (* time of last file status change *) - END; - -(* Linux kernel struct stat (2.2.17) - struct stat { - unsigned short st_dev; - unsigned short __pad1; - unsigned long st_ino; - unsigned short st_mode; - unsigned short st_nlink; - unsigned short st_uid; - unsigned short st_gid; - unsigned short st_rdev; - unsigned short __pad2; - unsigned long st_size; - unsigned long st_blksize; - unsigned long st_blocks; - unsigned long st_atime; - unsigned long __unused1; - unsigned long st_mtime; - unsigned long __unused2; - unsigned long st_ctime; - unsigned long __unused3; - unsigned long __unused4; - unsigned long __unused5; - }; -*) - - CONST - statbufsize = 88(*64*); (* see *) (* sizeof struct stat gives us 144 on x86_64 and 88 on x86 *) - TYPE - UnixStatRec = ARRAY statbufsize OF SYS.BYTE; - CONST - statbufconv = - (*"is=dev/-s=pad1/ll=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/ll=size/2*ll=blksize,blocks/il=atime/-l/il=mtime/-l/il=ctime/3*-l";*) - (*"ls=dev/-s=pad1/lL=ino/Ss=mode/4*is=nlink+uid+gid+rdev/-s=pad2/lL=size/2*lL=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l";*) - "ll=dev/-l=devx/-s=pad1/ll=ino/Sl=mode/ll=nlink/ll=uid/ll=gid/ll=rdev/-l=rdevx/-s=pad2/ll=size/2*ll=blksize,blocks/lL=atime/-l/lL=mtime/-l/lL=ctime/3*-l"; - VAR - statbuffmt: SysConversions.Format; - - PROCEDURE Stat*(path: ARRAY OF CHAR; VAR buf: StatRec; - errors: RelatedEvents.Object) : BOOLEAN; - VAR - d0, d1, d2: LONGINT; - origbuf: UnixStatRec; - BEGIN - IF uSYS.UNIXCALL(Sys.newstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf), d2) THEN - SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); - RETURN TRUE - ELSE - SysErrors.Raise(errors, d0, Sys.newstat, path); - RETURN FALSE - END; - END Stat; -(* - PROCEDURE Lstat*(path: ARRAY OF CHAR; VAR buf: StatRec; - errors: RelatedEvents.Object) : BOOLEAN; - VAR - d0, d1: INTEGER; - origbuf: UnixStatRec; - BEGIN - IF SYS.UNIXCALL(Sys.newlstat, d0, d1, SYS.ADR(path), SYS.ADR(origbuf)) THEN - SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); - RETURN TRUE - ELSE - SysErrors.Raise(errors, d0, Sys.newlstat, path); - RETURN FALSE - END; - END Lstat; -*) - PROCEDURE Fstat*(fd: SysTypes.File; VAR buf: StatRec; - errors: RelatedEvents.Object) : BOOLEAN; - VAR - d0, d1, d2: LONGINT; - origbuf: UnixStatRec; - BEGIN - IF uSYS.UNIXCALL(Sys.newfstat, d0, d1, fd, SYS.ADR(origbuf), d2) THEN - SysConversions.ByFmtFromC(origbuf, buf, statbuffmt); - RETURN TRUE - ELSE - SysErrors.Raise(errors, d0, Sys.newfstat, ""); - RETURN FALSE - END; - END Fstat; - -BEGIN - SysConversions.Compile(statbuffmt, statbufconv); -END ulmSysStat. diff --git a/src/lib/ulm/armv7a_hardfp/ulmSysTypes.Mod b/src/lib/ulm/armv7a_hardfp/ulmSysTypes.Mod deleted file mode 100644 index 174140e7..00000000 --- a/src/lib/ulm/armv7a_hardfp/ulmSysTypes.Mod +++ /dev/null @@ -1,70 +0,0 @@ -(* Ulm's Oberon Library - Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany - ---------------------------------------------------------------------------- - Ulm's Oberon Library is free software; you can redistribute it - and/or modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either version - 2 of the License, or (at your option) any later version. - - Ulm's Oberon Library is distributed in the hope that it will be - useful, but WITHOUT ANY WARRANTY; without even the implied warranty - of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - ---------------------------------------------------------------------------- - E-mail contact: oberon@mathematik.uni-ulm.de - ---------------------------------------------------------------------------- - $Id: SysTypes.om,v 1.1 1994/02/23 08:01:38 borchert Exp $ - ---------------------------------------------------------------------------- - $Log: SysTypes.om,v $ - Revision 1.1 1994/02/23 08:01:38 borchert - Initial revision - - ---------------------------------------------------------------------------- - AFB 9/89 - ---------------------------------------------------------------------------- -*) - -MODULE ulmSysTypes; - - IMPORT Types := ulmTypes; - - TYPE - Address* = Types.Address; - UntracedAddress* = Types.UntracedAddress; - Count* = Types.Count; - Size* = Types.Size; - Byte* = Types.Byte; - - File* = (*INTEGER*)LONGINT; (* in ulm's system both INTEGER and LONGINT are 4 bytes long *) - Offset* = LONGINT; - Device* = LONGINT; - Inode* = LONGINT; - Time* = LONGINT; - - Word* = INTEGER; (* must have the size of C's int-type *) - - (* Note: linux supports wait4 but not waitid, i.e. these - * constants aren't needed. *) - (* - CONST - (* possible values of the idtype parameter (4 bytes), - see - *) - idPid = 0; (* a process identifier *) - idPpid = 1; (* a parent process identifier *) - idPgid = 2; (* a process group (job control group) identifier *) - idSid = 3; (* a session identifier *) - idCid = 4; (* a scheduling class identifier *) - idUid = 5; (* a user identifier *) - idGid = 6; (* a group identifier *) - idAll = 7; (* all processes *) - idLwpid = 8; (* an LWP identifier *) - TYPE - IdType = INTEGER; (* idPid .. idLwpid *) - *) - -END ulmSysTypes. diff --git a/src/lib/ulm/armv7a_hardfp/ulmTypes.Mod b/src/lib/ulm/armv7a_hardfp/ulmTypes.Mod deleted file mode 100644 index fe2d6eca..00000000 --- a/src/lib/ulm/armv7a_hardfp/ulmTypes.Mod +++ /dev/null @@ -1,133 +0,0 @@ -(* Ulm's Oberon Library - Copyright (C) 1989-2000 by University of Ulm, SAI, D-89069 Ulm, Germany - ---------------------------------------------------------------------------- - Ulm's Oberon Library is free software; you can redistribute it - and/or modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either version - 2 of the License, or (at your option) any later version. - - Ulm's Oberon Library is distributed in the hope that it will be - useful, but WITHOUT ANY WARRANTY; without even the implied warranty - of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - ---------------------------------------------------------------------------- - E-mail contact: oberon@mathematik.uni-ulm.de - ---------------------------------------------------------------------------- - $Id: Types.om,v 1.5 2000/12/13 10:03:00 borchert Exp $ - ---------------------------------------------------------------------------- - $Log: Types.om,v $ - Revision 1.5 2000/12/13 10:03:00 borchert - SetInt type used in msb constant - - Revision 1.4 2000/12/13 09:51:57 borchert - constants and types for the relationship of INTEGER and SET added - - Revision 1.3 1998/09/25 15:23:09 borchert - Real32..Real128 added - - Revision 1.2 1994/07/01 11:08:04 borchert - IntAddress, Int8/16/32, ToInt8/16/32 and bit/little endian stuff added - - Revision 1.1 1994/02/22 20:12:14 borchert - Initial revision - - ---------------------------------------------------------------------------- - AFB 9/93 - ---------------------------------------------------------------------------- -*) - -MODULE ulmTypes; - - (* compiler-dependent type definitions; - this version works for Ulm's Oberon Compilers on - following architectures: m68k and sparc - *) - - IMPORT SYS := SYSTEM; - - TYPE - Address* = LONGINT (*SYS.ADDRESS*); - (* ulm compiler can accept - VAR p : SYSTEM.ADDRESS; // SYSTEM.PTR in ETH and V4 versions - ... - p := SYSTEM.ADR(something); - and this is how it is used in ulm oberon system library, - while SYSTEM.ADR returns LONGINT in ETH and V4 versions. - Thus I leave it as LONGINT for now, before coming up with better solution -- noch *) - UntracedAddress* = POINTER[1] TO UntracedAddressDesc; (*SYS.UNTRACEDADDRESS;*) - UntracedAddressDesc* = RECORD[1] END; - Count* = LONGINT; - Size* = Count; - Byte* = SYS.BYTE; - IntAddress* = LONGINT; - Int8* = SHORTINT; - Int16* = INTEGER; - Int32* = LONGINT; - Real32* = REAL; - Real64* = LONGREAL; - - CONST - bigEndian* = 0; (* SPARC, M68K etc *) - littleEndian* = 1; (* Intel 80x86, VAX etc *) - byteorder* = littleEndian; (* machine-dependent constant *) - TYPE - ByteOrder* = SHORTINT; (* bigEndian or littleEndian *) - - (* following constants and type definitions try to make - conversions from INTEGER to SET and vice versa more portable - to allow for bit operations on INTEGER values - *) - TYPE - SetInt* = LONGINT; (* INTEGER type that corresponds to SET *) - VAR msb* : SET; - msbIsMax*, msbIs0*: SHORTINT; - msbindex*, lsbindex*, nofbits*: LONGINT; - - PROCEDURE ToInt8*(int: LONGINT) : Int8; - BEGIN - RETURN SHORT(SHORT(int)) - END ToInt8; - - PROCEDURE ToInt16*(int: LONGINT) : Int16; - BEGIN - RETURN SYS.VAL(Int16, int) - END ToInt16; - - PROCEDURE ToInt32*(int: LONGINT) : Int32; - BEGIN - RETURN int - END ToInt32; - - PROCEDURE ToReal32*(real: LONGREAL) : Real32; - BEGIN - RETURN SHORT(real) - END ToReal32; - - PROCEDURE ToReal64*(real: LONGREAL) : Real64; - BEGIN - RETURN real - END ToReal64; - -BEGIN - msb := SYS.VAL(SET, MIN(SetInt)); - (* most significant bit, converted to a SET *) - (* we expect msbIsMax XOR msbIs0 to be 1; - this is checked for by an assertion - *) - msbIsMax := SYS.VAL(SHORTINT, (msb = {MAX(SET)})); - (* is 1, if msb equals {MAX(SET)} *) - msbIs0 := SYS.VAL(SHORTINT, (msb = {0})); - (* is 0, if msb equals {0} *) - msbindex := msbIsMax * MAX(SET); - (* set element that corresponds to the most-significant-bit *) - lsbindex := MAX(SET) - msbindex; - (* set element that corresponds to the lowest-significant-bit *) - nofbits := MAX(SET) + 1; - (* number of elements in SETs *) - - ASSERT((msbIs0 = 1) & (msbIsMax = 0) OR (msbIs0 = 0) & (msbIsMax = 1)); -END ulmTypes. diff --git a/src/lib/ulm/powerpc/ulmSYSTEM.Mod b/src/lib/ulm/powerpc/ulmSYSTEM.Mod new file mode 100644 index 00000000..814c0607 --- /dev/null +++ b/src/lib/ulm/powerpc/ulmSYSTEM.Mod @@ -0,0 +1,137 @@ +MODULE ulmSYSTEM; +IMPORT SYSTEM, Unix, Sys := ulmSys; + +TYPE pchar = POINTER TO ARRAY 1 OF CHAR; + pstring = POINTER TO ARRAY 1024 OF CHAR; + pstatus = POINTER TO Unix.Status; + + TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) + pbytearray* = POINTER TO bytearray; + TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) + plongrealarray* = POINTER TO bytearray; + + PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *) + VAR b : SYSTEM.BYTE; + p : pbytearray; + i : LONGINT; + BEGIN + p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l)); + FOR i := 0 TO SIZE(LONGINT) -1 DO + b := p^[i]; bar[i] := b; + END + END LongToByteArr; + + PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *) + VAR b : SYSTEM.BYTE; + p : plongrealarray; + i : LONGINT; + BEGIN + p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l)); + FOR i := 0 TO SIZE(LONGREAL) -1 DO + b := p^[i]; lar[i] := b; + END + END LRealToByteArr; + + +(* + PROCEDURE -Write(adr, n: LONGINT): LONGINT + "write(1/*stdout*/, adr, n)"; + + PROCEDURE -read(VAR ch: CHAR): LONGINT + "read(0/*stdin*/, ch, 1)"; +*) + + PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *) + VAR oldflag : BOOLEAN; + BEGIN + oldflag := flag; + flag := TRUE; + RETURN oldflag; + END TAS; + + PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *) + arg1, arg2, arg3: LONGINT) : BOOLEAN; + VAR + n : LONGINT; + ch : CHAR; + pch : pchar; + pstr : pstring; + pst : pstatus; + BEGIN + + IF syscall = Sys.read THEN + d0 := Unix.Read(arg1, arg2, arg3); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + (*NEW(pch); + pch := SYSTEM.VAL(pchar, arg2); + ch := pch^[0]; + n := read(ch); + IF n # 1 THEN + ch := 0X; + RETURN FALSE + ELSE + pch^[0] := ch; + RETURN TRUE + END; + *) + ELSIF syscall = Sys.write THEN + d0 := Unix.Write(arg1, arg2, arg3); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + (*NEW(pch); + pch := SYSTEM.VAL(pchar, arg2); + n := Write(SYSTEM.VAL(LONGINT, pch), 1); + IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END + *) + ELSIF syscall = Sys.open THEN + pstr := SYSTEM.VAL(pstring, arg1); + d0 := Unix.Open(pstr^, SYSTEM.VAL(SET, arg3), SYSTEM.VAL(SET, arg2)); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + ELSIF syscall = Sys.close THEN + d0 := Unix.Close(arg1); + IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END + ELSIF syscall = Sys.lseek THEN + d0 := Unix.Lseek(arg1, arg2, arg3); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + ELSIF syscall = Sys.ioctl THEN + d0 := Unix.Ioctl(arg1, arg2, arg3); + RETURN d0 >= 0; + ELSIF syscall = Sys.fcntl THEN + d0 := Unix.Fcntl (arg1, arg2, arg3); + RETURN d0 >= 0; + ELSIF syscall = Sys.dup THEN + d0 := Unix.Dup(arg1); + RETURN d0 > 0; + ELSIF syscall = Sys.pipe THEN + d0 := Unix.Pipe(arg1); + RETURN d0 >= 0; + ELSIF syscall = Sys.newstat THEN + pst := SYSTEM.VAL(pstatus, arg2); + pstr := SYSTEM.VAL(pstring, arg1); + d0 := Unix.Stat(pstr^, pst^); + RETURN d0 >= 0 + ELSIF syscall = Sys.newfstat THEN + pst := SYSTEM.VAL(pstatus, arg2); + d0 := Unix.Fstat(arg1, pst^); + RETURN d0 >= 0; + END + + END UNIXCALL; + + + PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN; + BEGIN + + END UNIXFORK; + + PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE; + VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN; + BEGIN + + END UNIXSIGNAL; + + PROCEDURE WMOVE*(from, to, n : LONGINT); + VAR l : LONGINT; + BEGIN + SYSTEM.MOVE(from, to, n); + END WMOVE; +END ulmSYSTEM. diff --git a/src/lib/ulm/x86/ulmSYSTEM.Mod b/src/lib/ulm/x86/ulmSYSTEM.Mod new file mode 100644 index 00000000..814c0607 --- /dev/null +++ b/src/lib/ulm/x86/ulmSYSTEM.Mod @@ -0,0 +1,137 @@ +MODULE ulmSYSTEM; +IMPORT SYSTEM, Unix, Sys := ulmSys; + +TYPE pchar = POINTER TO ARRAY 1 OF CHAR; + pstring = POINTER TO ARRAY 1024 OF CHAR; + pstatus = POINTER TO Unix.Status; + + TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) + pbytearray* = POINTER TO bytearray; + TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) + plongrealarray* = POINTER TO bytearray; + + PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *) + VAR b : SYSTEM.BYTE; + p : pbytearray; + i : LONGINT; + BEGIN + p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l)); + FOR i := 0 TO SIZE(LONGINT) -1 DO + b := p^[i]; bar[i] := b; + END + END LongToByteArr; + + PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *) + VAR b : SYSTEM.BYTE; + p : plongrealarray; + i : LONGINT; + BEGIN + p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l)); + FOR i := 0 TO SIZE(LONGREAL) -1 DO + b := p^[i]; lar[i] := b; + END + END LRealToByteArr; + + +(* + PROCEDURE -Write(adr, n: LONGINT): LONGINT + "write(1/*stdout*/, adr, n)"; + + PROCEDURE -read(VAR ch: CHAR): LONGINT + "read(0/*stdin*/, ch, 1)"; +*) + + PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *) + VAR oldflag : BOOLEAN; + BEGIN + oldflag := flag; + flag := TRUE; + RETURN oldflag; + END TAS; + + PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *) + arg1, arg2, arg3: LONGINT) : BOOLEAN; + VAR + n : LONGINT; + ch : CHAR; + pch : pchar; + pstr : pstring; + pst : pstatus; + BEGIN + + IF syscall = Sys.read THEN + d0 := Unix.Read(arg1, arg2, arg3); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + (*NEW(pch); + pch := SYSTEM.VAL(pchar, arg2); + ch := pch^[0]; + n := read(ch); + IF n # 1 THEN + ch := 0X; + RETURN FALSE + ELSE + pch^[0] := ch; + RETURN TRUE + END; + *) + ELSIF syscall = Sys.write THEN + d0 := Unix.Write(arg1, arg2, arg3); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + (*NEW(pch); + pch := SYSTEM.VAL(pchar, arg2); + n := Write(SYSTEM.VAL(LONGINT, pch), 1); + IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END + *) + ELSIF syscall = Sys.open THEN + pstr := SYSTEM.VAL(pstring, arg1); + d0 := Unix.Open(pstr^, SYSTEM.VAL(SET, arg3), SYSTEM.VAL(SET, arg2)); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + ELSIF syscall = Sys.close THEN + d0 := Unix.Close(arg1); + IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END + ELSIF syscall = Sys.lseek THEN + d0 := Unix.Lseek(arg1, arg2, arg3); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + ELSIF syscall = Sys.ioctl THEN + d0 := Unix.Ioctl(arg1, arg2, arg3); + RETURN d0 >= 0; + ELSIF syscall = Sys.fcntl THEN + d0 := Unix.Fcntl (arg1, arg2, arg3); + RETURN d0 >= 0; + ELSIF syscall = Sys.dup THEN + d0 := Unix.Dup(arg1); + RETURN d0 > 0; + ELSIF syscall = Sys.pipe THEN + d0 := Unix.Pipe(arg1); + RETURN d0 >= 0; + ELSIF syscall = Sys.newstat THEN + pst := SYSTEM.VAL(pstatus, arg2); + pstr := SYSTEM.VAL(pstring, arg1); + d0 := Unix.Stat(pstr^, pst^); + RETURN d0 >= 0 + ELSIF syscall = Sys.newfstat THEN + pst := SYSTEM.VAL(pstatus, arg2); + d0 := Unix.Fstat(arg1, pst^); + RETURN d0 >= 0; + END + + END UNIXCALL; + + + PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN; + BEGIN + + END UNIXFORK; + + PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE; + VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN; + BEGIN + + END UNIXSIGNAL; + + PROCEDURE WMOVE*(from, to, n : LONGINT); + VAR l : LONGINT; + BEGIN + SYSTEM.MOVE(from, to, n); + END WMOVE; +END ulmSYSTEM. diff --git a/src/lib/ulm/x86_64/ulmSYSTEM.Mod b/src/lib/ulm/x86_64/ulmSYSTEM.Mod new file mode 100644 index 00000000..fa6c66a6 --- /dev/null +++ b/src/lib/ulm/x86_64/ulmSYSTEM.Mod @@ -0,0 +1,137 @@ +MODULE ulmSYSTEM; +IMPORT SYSTEM, Unix, Sys := ulmSys; + +TYPE pchar = POINTER TO ARRAY 1 OF CHAR; + pstring = POINTER TO ARRAY 1024 OF CHAR; + pstatus = POINTER TO Unix.Status; + + TYPE bytearray* = ARRAY SIZE(LONGINT) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) + pbytearray* = POINTER TO bytearray; + TYPE longrealarray* = ARRAY SIZE(LONGREAL) OF SYSTEM.BYTE; (* need this because voc does not convert implicitly LONGINT to ARRAY OF BYTE; -- noch *) + plongrealarray* = POINTER TO bytearray; + + PROCEDURE LongToByteArr* ( l : LONGINT; VAR bar : bytearray); (* noch *) + VAR b : SYSTEM.BYTE; + p : pbytearray; + i : LONGINT; + BEGIN + p := SYSTEM.VAL(pbytearray, SYSTEM.ADR(l)); + FOR i := 0 TO SIZE(LONGINT) -1 DO + b := p^[i]; bar[i] := b; + END + END LongToByteArr; + + PROCEDURE LRealToByteArr* ( l : LONGREAL; VAR lar : longrealarray); (* noch *) + VAR b : SYSTEM.BYTE; + p : plongrealarray; + i : LONGINT; + BEGIN + p := SYSTEM.VAL(plongrealarray, SYSTEM.ADR(l)); + FOR i := 0 TO SIZE(LONGREAL) -1 DO + b := p^[i]; lar[i] := b; + END + END LRealToByteArr; + + +(* + PROCEDURE -Write(adr, n: LONGINT): LONGINT + "write(1/*stdout*/, adr, n)"; + + PROCEDURE -read(VAR ch: CHAR): LONGINT + "read(0/*stdin*/, ch, 1)"; +*) + + PROCEDURE TAS*(VAR flag:BOOLEAN): BOOLEAN; (* added for compatibility with ulmSYSTEM module; noch *) + VAR oldflag : BOOLEAN; + BEGIN + oldflag := flag; + flag := TRUE; + RETURN oldflag; + END TAS; + + PROCEDURE UNIXCALL*(syscall: LONGINT; VAR d0, d1: LONGINT; (* in ulm version both LONGINT and INTEGER are 4 byte size *) + arg1, arg2, arg3: LONGINT) : BOOLEAN; + VAR + n : LONGINT; + ch : CHAR; + pch : pchar; + pstr : pstring; + pst : pstatus; + BEGIN + + IF syscall = Sys.read THEN + d0 := Unix.Read(SHORT(arg1), arg2, arg3); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + (*NEW(pch); + pch := SYSTEM.VAL(pchar, arg2); + ch := pch^[0]; + n := read(ch); + IF n # 1 THEN + ch := 0X; + RETURN FALSE + ELSE + pch^[0] := ch; + RETURN TRUE + END; + *) + ELSIF syscall = Sys.write THEN + d0 := Unix.Write(SHORT(arg1), arg2, arg3); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + (*NEW(pch); + pch := SYSTEM.VAL(pchar, arg2); + n := Write(SYSTEM.VAL(LONGINT, pch), 1); + IF n # 1 THEN RETURN FALSE ELSE RETURN TRUE END + *) + ELSIF syscall = Sys.open THEN + pstr := SYSTEM.VAL(pstring, arg1); + d0 := Unix.Open(pstr^, SHORT(arg3), arg2); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + ELSIF syscall = Sys.close THEN + d0 := Unix.Close(SHORT(arg1)); + IF d0 = 0 THEN RETURN TRUE ELSE RETURN FALSE END + ELSIF syscall = Sys.lseek THEN + d0 := Unix.Lseek(SHORT(arg1), arg2, SHORT(arg3)); + IF d0 >= 0 THEN RETURN TRUE ELSE RETURN FALSE END + ELSIF syscall = Sys.ioctl THEN + d0 := Unix.Ioctl(SHORT(arg1), SHORT(arg2), arg3); + RETURN d0 >= 0; + ELSIF syscall = Sys.fcntl THEN + d0 := Unix.Fcntl (SHORT(arg1), SHORT(arg2), arg3); + RETURN d0 >= 0; + ELSIF syscall = Sys.dup THEN + d0 := Unix.Dup(SHORT(arg1)); + RETURN d0 > 0; + ELSIF syscall = Sys.pipe THEN + d0 := Unix.Pipe(arg1); + RETURN d0 >= 0; + ELSIF syscall = Sys.newstat THEN + pst := SYSTEM.VAL(pstatus, arg2); + pstr := SYSTEM.VAL(pstring, arg1); + d0 := Unix.Stat(pstr^, pst^); + RETURN d0 >= 0 + ELSIF syscall = Sys.newfstat THEN + pst := SYSTEM.VAL(pstatus, arg2); + d0 := Unix.Fstat(SHORT(arg1), pst^); + RETURN d0 >= 0; + END + + END UNIXCALL; + + + PROCEDURE UNIXFORK(VAR pid: LONGINT) : BOOLEAN; + BEGIN + + END UNIXFORK; + + PROCEDURE UNIXSIGNAL(signo: INTEGER; p: PROCEDURE; + VAR old: PROCEDURE; VAR error: INTEGER) : BOOLEAN; + BEGIN + + END UNIXSIGNAL; + + PROCEDURE WMOVE*(from, to, n : LONGINT); + VAR l : LONGINT; + BEGIN + SYSTEM.MOVE(from, to, n); + END WMOVE; +END ulmSYSTEM. diff --git a/src/test/files/testFiles.Mod b/src/test/files/testFiles.Mod index cc3b46ad..f6361b89 100644 --- a/src/test/files/testFiles.Mod +++ b/src/test/files/testFiles.Mod @@ -3,7 +3,7 @@ MODULE testFiles; IMPORT Files, Texts, Console; -CONST file="makefile"; +CONST file="testFiles.Mod"; VAR T : Texts.Text; @@ -22,7 +22,6 @@ IF F # NIL THEN WHILE ~R.eot DO Texts.Read (R, ch); Console.Char(ch); - END; ELSE diff --git a/voc.REMOVED.git-id b/voc.REMOVED.git-id index f28caf06..815dd8e2 100644 --- a/voc.REMOVED.git-id +++ b/voc.REMOVED.git-id @@ -1 +1 @@ -2d1dfe090159d8b5a764dbb1bc3053389429baea \ No newline at end of file +390483e096444c9abc5a2a3d5bef2ca31a078305 \ No newline at end of file diff --git a/vocstatic.linux.clang.x86_64.REMOVED.git-id b/vocstatic.linux.clang.x86_64.REMOVED.git-id index f28caf06..5c275c9b 100644 --- a/vocstatic.linux.clang.x86_64.REMOVED.git-id +++ b/vocstatic.linux.clang.x86_64.REMOVED.git-id @@ -1 +1 @@ -2d1dfe090159d8b5a764dbb1bc3053389429baea \ No newline at end of file +714ce157d432a595cefd29b425be8e3b32084a7f \ No newline at end of file diff --git a/vocstatic.linux.gcc.x86.REMOVED.git-id b/vocstatic.linux.gcc.x86.REMOVED.git-id index f9465f78..ffe4fb7a 100644 --- a/vocstatic.linux.gcc.x86.REMOVED.git-id +++ b/vocstatic.linux.gcc.x86.REMOVED.git-id @@ -1 +1 @@ -48e976f8cba73bc4391e004b135c881c8271f6e6 \ No newline at end of file +4bacfbffebb82fe3863b5e4a6460310b75d6c19c \ No newline at end of file diff --git a/vocstatic.linux.gcc.x86_64.REMOVED.git-id b/vocstatic.linux.gcc.x86_64.REMOVED.git-id index f28caf06..815dd8e2 100644 --- a/vocstatic.linux.gcc.x86_64.REMOVED.git-id +++ b/vocstatic.linux.gcc.x86_64.REMOVED.git-id @@ -1 +1 @@ -2d1dfe090159d8b5a764dbb1bc3053389429baea \ No newline at end of file +390483e096444c9abc5a2a3d5bef2ca31a078305 \ No newline at end of file