From 5b3062f475f18551984c4f177be8572019b56360 Mon Sep 17 00:00:00 2001 From: David Brown Date: Thu, 16 Jun 2016 12:29:25 +0100 Subject: [PATCH] Consolidate files in system directory. --- src/system/{darwin/clang/x86_64 => }/Args.Mod | 0 src/system/{linux/clang => }/Console.Mod | 0 src/system/{darwin/clang => }/Files.Mod | 0 src/system/{darwin/clang => }/Files0.Mod | 0 src/system/{freebsd/clang => }/Kernel.Mod | 0 src/system/{freebsd/clang => }/Kernel0.Mod | 0 src/system/{darwin/clang => }/SYSTEM.Mod | 0 src/system/{linux/clang/x86_64 => }/SYSTEM.c0 | 0 src/system/{linux/clang/x86_64 => }/SYSTEM.h | 0 src/system/{linux/gcc/x86_64 => }/Unix.Mod | 0 src/system/darwin/clang/Console.Mod | 89 --- src/system/darwin/clang/Kernel.Mod | 188 ----- src/system/darwin/clang/Kernel0.Mod | 200 ----- src/system/darwin/clang/x86_64/SYSTEM.c0 | 205 ------ src/system/darwin/clang/x86_64/SYSTEM.h | 239 ------ src/system/darwin/clang/x86_64/Unix.Mod | 518 ------------- src/system/freebsd/clang/Console.Mod | 89 --- src/system/freebsd/clang/SYSTEM.Mod | 520 ------------- src/system/freebsd/clang/x86_64/Args.Mod | 65 -- src/system/freebsd/clang/x86_64/Files.Mod | 664 ----------------- src/system/freebsd/clang/x86_64/Files0.Mod | 636 ---------------- src/system/freebsd/clang/x86_64/SYSTEM.c0 | 205 ------ src/system/freebsd/clang/x86_64/SYSTEM.h | 242 ------- src/system/freebsd/clang/x86_64/Unix.Mod | 557 -------------- src/system/linux/clang/Kernel.Mod | 188 ----- src/system/linux/clang/Kernel0.Mod | 200 ----- src/system/linux/clang/SYSTEM.Mod | 520 ------------- src/system/linux/clang/armv6j_hardfp/Args.Mod | 65 -- .../linux/clang/armv6j_hardfp/Files.Mod | 663 ----------------- .../linux/clang/armv6j_hardfp/Files0.Mod | 635 ---------------- .../linux/clang/armv6j_hardfp/SYSTEM.c0 | 205 ------ src/system/linux/clang/armv6j_hardfp/SYSTEM.h | 220 ------ src/system/linux/clang/armv6j_hardfp/Unix.Mod | 482 ------------- src/system/linux/clang/powerpc/Args.Mod | 65 -- src/system/linux/clang/powerpc/Files.Mod | 663 ----------------- src/system/linux/clang/powerpc/Files0.Mod | 635 ---------------- src/system/linux/clang/powerpc/SYSTEM.c0 | 205 ------ src/system/linux/clang/powerpc/SYSTEM.h | 220 ------ src/system/linux/clang/powerpc/Unix.Mod | 465 ------------ src/system/linux/clang/x86/Args.Mod | 65 -- src/system/linux/clang/x86/Files.Mod | 663 ----------------- src/system/linux/clang/x86/Files0.Mod | 635 ---------------- src/system/linux/clang/x86/SYSTEM.c0 | 205 ------ src/system/linux/clang/x86/SYSTEM.h | 220 ------ src/system/linux/clang/x86/Unix.Mod | 465 ------------ src/system/linux/clang/x86_64/Args.Mod | 65 -- src/system/linux/clang/x86_64/Files.Mod | 664 ----------------- src/system/linux/clang/x86_64/Files0.Mod | 636 ---------------- src/system/linux/clang/x86_64/Unix.Mod | 519 ------------- src/system/linux/gcc/Console.Mod | 86 --- src/system/linux/gcc/Kernel.Mod | 188 ----- src/system/linux/gcc/Kernel0.Mod | 200 ----- src/system/linux/gcc/SYSTEM.Mod | 520 ------------- src/system/linux/gcc/armv6j_hardfp/Args.Mod | 65 -- src/system/linux/gcc/armv6j_hardfp/Files.Mod | 663 ----------------- src/system/linux/gcc/armv6j_hardfp/Files0.Mod | 635 ---------------- src/system/linux/gcc/armv6j_hardfp/SYSTEM.c0 | 205 ------ src/system/linux/gcc/armv6j_hardfp/SYSTEM.h | 220 ------ src/system/linux/gcc/armv6j_hardfp/Unix.Mod | 482 ------------- src/system/linux/gcc/powerpc/Args.Mod | 65 -- src/system/linux/gcc/powerpc/Files.Mod | 663 ----------------- src/system/linux/gcc/powerpc/Files0.Mod | 635 ---------------- src/system/linux/gcc/powerpc/SYSTEM.c0 | 205 ------ src/system/linux/gcc/powerpc/SYSTEM.h | 220 ------ src/system/linux/gcc/powerpc/Unix.Mod | 465 ------------ src/system/linux/gcc/x86/Args.Mod | 65 -- src/system/linux/gcc/x86/Files.Mod | 663 ----------------- src/system/linux/gcc/x86/Files0.Mod | 635 ---------------- src/system/linux/gcc/x86/SYSTEM.c0 | 205 ------ src/system/linux/gcc/x86/SYSTEM.h | 220 ------ src/system/linux/gcc/x86/Unix.Mod | 465 ------------ src/system/linux/gcc/x86_64/Args.Mod | 65 -- src/system/linux/gcc/x86_64/Files.Mod | 664 ----------------- src/system/linux/gcc/x86_64/Files0.Mod | 636 ---------------- src/system/linux/gcc/x86_64/SYSTEM.c0 | 205 ------ src/system/linux/gcc/x86_64/SYSTEM.h | 238 ------ src/system/openbsd/gcc/Console.Mod | 86 --- src/system/openbsd/gcc/Kernel.Mod | 206 ------ src/system/openbsd/gcc/Kernel0.Mod | 217 ------ src/system/openbsd/gcc/SYSTEM.Mod | 520 ------------- src/system/openbsd/gcc/x86_64/Args.Mod | 65 -- src/system/openbsd/gcc/x86_64/Files.Mod | 681 ------------------ src/system/openbsd/gcc/x86_64/Files0.Mod | 653 ----------------- src/system/openbsd/gcc/x86_64/SYSTEM.c0 | 205 ------ src/system/openbsd/gcc/x86_64/SYSTEM.h | 239 ------ src/system/openbsd/gcc/x86_64/Unix.Mod | 595 --------------- 86 files changed, 27030 deletions(-) rename src/system/{darwin/clang/x86_64 => }/Args.Mod (100%) rename src/system/{linux/clang => }/Console.Mod (100%) rename src/system/{darwin/clang => }/Files.Mod (100%) rename src/system/{darwin/clang => }/Files0.Mod (100%) rename src/system/{freebsd/clang => }/Kernel.Mod (100%) rename src/system/{freebsd/clang => }/Kernel0.Mod (100%) rename src/system/{darwin/clang => }/SYSTEM.Mod (100%) rename src/system/{linux/clang/x86_64 => }/SYSTEM.c0 (100%) rename src/system/{linux/clang/x86_64 => }/SYSTEM.h (100%) rename src/system/{linux/gcc/x86_64 => }/Unix.Mod (100%) delete mode 100644 src/system/darwin/clang/Console.Mod delete mode 100644 src/system/darwin/clang/Kernel.Mod delete mode 100644 src/system/darwin/clang/Kernel0.Mod delete mode 100644 src/system/darwin/clang/x86_64/SYSTEM.c0 delete mode 100644 src/system/darwin/clang/x86_64/SYSTEM.h delete mode 100644 src/system/darwin/clang/x86_64/Unix.Mod delete mode 100644 src/system/freebsd/clang/Console.Mod delete mode 100644 src/system/freebsd/clang/SYSTEM.Mod delete mode 100644 src/system/freebsd/clang/x86_64/Args.Mod delete mode 100644 src/system/freebsd/clang/x86_64/Files.Mod delete mode 100644 src/system/freebsd/clang/x86_64/Files0.Mod delete mode 100644 src/system/freebsd/clang/x86_64/SYSTEM.c0 delete mode 100644 src/system/freebsd/clang/x86_64/SYSTEM.h delete mode 100644 src/system/freebsd/clang/x86_64/Unix.Mod delete mode 100644 src/system/linux/clang/Kernel.Mod delete mode 100644 src/system/linux/clang/Kernel0.Mod delete mode 100644 src/system/linux/clang/SYSTEM.Mod delete mode 100644 src/system/linux/clang/armv6j_hardfp/Args.Mod delete mode 100644 src/system/linux/clang/armv6j_hardfp/Files.Mod delete mode 100644 src/system/linux/clang/armv6j_hardfp/Files0.Mod delete mode 100644 src/system/linux/clang/armv6j_hardfp/SYSTEM.c0 delete mode 100644 src/system/linux/clang/armv6j_hardfp/SYSTEM.h delete mode 100644 src/system/linux/clang/armv6j_hardfp/Unix.Mod delete mode 100644 src/system/linux/clang/powerpc/Args.Mod delete mode 100644 src/system/linux/clang/powerpc/Files.Mod delete mode 100644 src/system/linux/clang/powerpc/Files0.Mod delete mode 100644 src/system/linux/clang/powerpc/SYSTEM.c0 delete mode 100644 src/system/linux/clang/powerpc/SYSTEM.h delete mode 100644 src/system/linux/clang/powerpc/Unix.Mod delete mode 100644 src/system/linux/clang/x86/Args.Mod delete mode 100644 src/system/linux/clang/x86/Files.Mod delete mode 100644 src/system/linux/clang/x86/Files0.Mod delete mode 100644 src/system/linux/clang/x86/SYSTEM.c0 delete mode 100644 src/system/linux/clang/x86/SYSTEM.h delete mode 100644 src/system/linux/clang/x86/Unix.Mod delete mode 100644 src/system/linux/clang/x86_64/Args.Mod delete mode 100644 src/system/linux/clang/x86_64/Files.Mod delete mode 100644 src/system/linux/clang/x86_64/Files0.Mod delete mode 100644 src/system/linux/clang/x86_64/Unix.Mod delete mode 100644 src/system/linux/gcc/Console.Mod delete mode 100644 src/system/linux/gcc/Kernel.Mod delete mode 100644 src/system/linux/gcc/Kernel0.Mod delete mode 100644 src/system/linux/gcc/SYSTEM.Mod delete mode 100644 src/system/linux/gcc/armv6j_hardfp/Args.Mod delete mode 100644 src/system/linux/gcc/armv6j_hardfp/Files.Mod delete mode 100644 src/system/linux/gcc/armv6j_hardfp/Files0.Mod delete mode 100644 src/system/linux/gcc/armv6j_hardfp/SYSTEM.c0 delete mode 100644 src/system/linux/gcc/armv6j_hardfp/SYSTEM.h delete mode 100644 src/system/linux/gcc/armv6j_hardfp/Unix.Mod delete mode 100644 src/system/linux/gcc/powerpc/Args.Mod delete mode 100644 src/system/linux/gcc/powerpc/Files.Mod delete mode 100644 src/system/linux/gcc/powerpc/Files0.Mod delete mode 100644 src/system/linux/gcc/powerpc/SYSTEM.c0 delete mode 100644 src/system/linux/gcc/powerpc/SYSTEM.h delete mode 100644 src/system/linux/gcc/powerpc/Unix.Mod delete mode 100644 src/system/linux/gcc/x86/Args.Mod delete mode 100644 src/system/linux/gcc/x86/Files.Mod delete mode 100644 src/system/linux/gcc/x86/Files0.Mod delete mode 100644 src/system/linux/gcc/x86/SYSTEM.c0 delete mode 100644 src/system/linux/gcc/x86/SYSTEM.h delete mode 100644 src/system/linux/gcc/x86/Unix.Mod delete mode 100644 src/system/linux/gcc/x86_64/Args.Mod delete mode 100644 src/system/linux/gcc/x86_64/Files.Mod delete mode 100644 src/system/linux/gcc/x86_64/Files0.Mod delete mode 100644 src/system/linux/gcc/x86_64/SYSTEM.c0 delete mode 100644 src/system/linux/gcc/x86_64/SYSTEM.h delete mode 100644 src/system/openbsd/gcc/Console.Mod delete mode 100644 src/system/openbsd/gcc/Kernel.Mod delete mode 100644 src/system/openbsd/gcc/Kernel0.Mod delete mode 100644 src/system/openbsd/gcc/SYSTEM.Mod delete mode 100644 src/system/openbsd/gcc/x86_64/Args.Mod delete mode 100644 src/system/openbsd/gcc/x86_64/Files.Mod delete mode 100644 src/system/openbsd/gcc/x86_64/Files0.Mod delete mode 100644 src/system/openbsd/gcc/x86_64/SYSTEM.c0 delete mode 100644 src/system/openbsd/gcc/x86_64/SYSTEM.h delete mode 100644 src/system/openbsd/gcc/x86_64/Unix.Mod diff --git a/src/system/darwin/clang/x86_64/Args.Mod b/src/system/Args.Mod similarity index 100% rename from src/system/darwin/clang/x86_64/Args.Mod rename to src/system/Args.Mod diff --git a/src/system/linux/clang/Console.Mod b/src/system/Console.Mod similarity index 100% rename from src/system/linux/clang/Console.Mod rename to src/system/Console.Mod diff --git a/src/system/darwin/clang/Files.Mod b/src/system/Files.Mod similarity index 100% rename from src/system/darwin/clang/Files.Mod rename to src/system/Files.Mod diff --git a/src/system/darwin/clang/Files0.Mod b/src/system/Files0.Mod similarity index 100% rename from src/system/darwin/clang/Files0.Mod rename to src/system/Files0.Mod diff --git a/src/system/freebsd/clang/Kernel.Mod b/src/system/Kernel.Mod similarity index 100% rename from src/system/freebsd/clang/Kernel.Mod rename to src/system/Kernel.Mod diff --git a/src/system/freebsd/clang/Kernel0.Mod b/src/system/Kernel0.Mod similarity index 100% rename from src/system/freebsd/clang/Kernel0.Mod rename to src/system/Kernel0.Mod diff --git a/src/system/darwin/clang/SYSTEM.Mod b/src/system/SYSTEM.Mod similarity index 100% rename from src/system/darwin/clang/SYSTEM.Mod rename to src/system/SYSTEM.Mod diff --git a/src/system/linux/clang/x86_64/SYSTEM.c0 b/src/system/SYSTEM.c0 similarity index 100% rename from src/system/linux/clang/x86_64/SYSTEM.c0 rename to src/system/SYSTEM.c0 diff --git a/src/system/linux/clang/x86_64/SYSTEM.h b/src/system/SYSTEM.h similarity index 100% rename from src/system/linux/clang/x86_64/SYSTEM.h rename to src/system/SYSTEM.h diff --git a/src/system/linux/gcc/x86_64/Unix.Mod b/src/system/Unix.Mod similarity index 100% rename from src/system/linux/gcc/x86_64/Unix.Mod rename to src/system/Unix.Mod diff --git a/src/system/darwin/clang/Console.Mod b/src/system/darwin/clang/Console.Mod deleted file mode 100644 index 93be9373..00000000 --- a/src/system/darwin/clang/Console.Mod +++ /dev/null @@ -1,89 +0,0 @@ -MODULE Console; (* J. Templ, 29-June-96 *) - - (* output to Unix standard output device based Write system call *) - - IMPORT SYSTEM; - - VAR line: ARRAY 128 OF CHAR; - pos: INTEGER; - - PROCEDURE -includeUnistd() - "#include "; - - PROCEDURE -Write(adr, n: LONGINT) - "write(1/*stdout*/, adr, n)"; - - PROCEDURE -read(VAR ch: CHAR): LONGINT - "read(0/*stdin*/, ch, 1)"; - - PROCEDURE Flush*(); - BEGIN - Write(SYSTEM.ADR(line), pos); pos := 0; - END Flush; - - PROCEDURE Char*(ch: CHAR); - BEGIN - IF pos = LEN(line) THEN Flush() END ; - line[pos] := ch; INC(pos); - IF ch = 0AX THEN Flush() END - END Char; - - PROCEDURE String*(s: ARRAY OF CHAR); - VAR i: INTEGER; - BEGIN i := 0; - WHILE s[i] # 0X DO Char(s[i]); INC(i) END - END String; - - PROCEDURE Int*(i, n: LONGINT); - VAR s: ARRAY 32 OF CHAR; i1, k: LONGINT; - BEGIN - IF i = SYSTEM.LSH(LONG(LONG(1)), SIZE(LONGINT)*8 - 1) THEN - IF SIZE(LONGINT) = 8 THEN s := "8085774586302733229"; k := 19 - ELSE s := "8463847412"; k := 10 - END - ELSE - i1 := ABS(i); - s[0] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; k := 1; - WHILE i1 > 0 DO s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k) END - END ; - IF i < 0 THEN s[k] := "-"; INC(k) END ; - WHILE n > k DO Char(" "); DEC(n) END ; - WHILE k > 0 DO DEC(k); Char(s[k]) END - END Int; - - PROCEDURE Ln*; - BEGIN Char(0AX); (* Unix end-of-line *) - END Ln; - - PROCEDURE Bool*(b: BOOLEAN); - BEGIN IF b THEN String("TRUE") ELSE String("FALSE") END - END Bool; - - PROCEDURE Hex*(i: LONGINT); - VAR k, n: LONGINT; - BEGIN - k := -28; - WHILE k <= 0 DO - n := ASH(i, k) MOD 16; - IF n <= 9 THEN Char(CHR(ORD("0") + n)) ELSE Char(CHR(ORD("A") - 10 + n)) END ; - INC(k, 4) - END - END Hex; - - PROCEDURE Read*(VAR ch: CHAR); - VAR n: LONGINT; - BEGIN Flush(); - n := read(ch); - IF n # 1 THEN ch := 0X END - END Read; - - PROCEDURE ReadLine*(VAR line: ARRAY OF CHAR); - VAR i: LONGINT; ch: CHAR; - BEGIN Flush(); - i := 0; Read(ch); - WHILE (i < LEN(line) - 1) & (ch # 0AX) & (ch # 0X) DO line[i] := ch; INC(i); Read(ch) END ; - line[i] := 0X - END ReadLine; - -BEGIN pos := 0; -END Console. diff --git a/src/system/darwin/clang/Kernel.Mod b/src/system/darwin/clang/Kernel.Mod deleted file mode 100644 index f49d9b0c..00000000 --- a/src/system/darwin/clang/Kernel.Mod +++ /dev/null @@ -1,188 +0,0 @@ -MODULE Kernel; -(* - J. Templ, 16.4.95 - communication with C-runtime and storage management -*) - - IMPORT SYSTEM, Unix, Args; - - TYPE - RealTime = POINTER TO TimeDesc; - TimeDesc = RECORD - sec, min, hour, mday, mon, year, wday, isdst, zone, gmtoff: LONGINT - END ; - - KeyCmd* = PROCEDURE; - - ObjFinalizer* = PROCEDURE(obj: SYSTEM.PTR); - - - VAR - (* trap handling *) - trapEnv*: Unix.JmpBuf; (* saved stack environment for trap handling *) - - (* oberon heap management *) - nofiles*: LONGINT; - - (* input event handling *) - readSet*, readySet*: Unix.FdSet; - - FKey*: ARRAY 16 OF KeyCmd; - - littleEndian*: BOOLEAN; - - TimeUnit*: LONGINT; (* 1 sec *) - - LIB*, CWD*: ARRAY 256 OF CHAR; - OBERON*: ARRAY 1024 OF CHAR; - - - timeStart: LONGINT; (* milliseconds *) - - PROCEDURE -includesetjmp() - '#include "setjmp.h"'; -(* for localtime *) - PROCEDURE -includetime() - '#include "time.h"'; - - PROCEDURE -Lock*() - "SYSTEM_lock++"; - - PROCEDURE -Unlock*() - "SYSTEM_lock--; if (SYSTEM_interrupted && SYSTEM_lock == 0) __HALT(-9)"; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -sigsetjmp*(VAR env: Unix.JmpBuf; savemask: LONGINT): LONGINT - "__sigsetjmp(env, savemask)"; - - PROCEDURE -siglongjmp*(VAR env:Unix.JmpBuf; val: LONGINT) - "siglongjmp(env, val)"; - - PROCEDURE -heapsize*(): LONGINT - "SYSTEM_heapsize"; - - PROCEDURE -allocated*(): LONGINT - "SYSTEM_allocated"; - - PROCEDURE -localtime(VAR clock: LONGINT): RealTime - "(Kernel_RealTime)localtime(clock)"; - - PROCEDURE -malloc*(size: LONGINT): LONGINT - "(LONGINT)malloc(size)"; - - PROCEDURE -free*(adr: LONGINT) - "(void)free(adr)"; - - PROCEDURE -getcwd(VAR cwd: Unix.Name) - "getcwd(cwd, cwd__len)"; - - - PROCEDURE GetClock* (VAR t, d: LONGINT); - VAR tv: Unix.Timeval; tz: Unix.Timezone; time: RealTime; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(tv, tz); - time := localtime(tv.sec); - 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 GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - VAR err: ARRAY 25 OF CHAR; - BEGIN err := "not yet implemented"; HALT(99) - END SetClock; - - PROCEDURE Time*(): LONGINT; - VAR timeval: Unix.Timeval; timezone: Unix.Timezone; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(timeval, timezone); - RETURN (timeval.usec DIV 1000 + timeval.sec * 1000 - timeStart) MOD 7FFFFFFFH - END Time; - -(* - PROCEDURE UserTime*(): LONGINT; - VAR rusage: Unix.Rusage; - BEGIN - Unix.Getrusage(0, S.ADR(rusage)); - RETURN rusage.utime.sec*1000 + rusage.utime.usec DIV 1000 - (* + rusage.stime.sec*1000 + rusage.stime.usec DIV 1000*) - END UserTime; -*) - - PROCEDURE Select*(delay: LONGINT); - VAR rs, ws, xs: Unix.FdSet; n: LONGINT; tv: Unix.Timeval; - BEGIN - rs := readSet; - FOR n := 0 TO 7 DO ws[n] := {}; xs[n] := {}; readySet[n] := {} END; - IF delay < 0 THEN delay := 0 END ; - tv.sec := delay DIV 1000; tv.usec := SHORT(delay MOD 1000 * 1000); - n := Unix.Select(256, rs, ws, xs, tv); - IF n >= 0 THEN readySet := rs END - END Select; - - PROCEDURE -GC*(markStack: BOOLEAN) - "SYSTEM_GC(markStack)"; - - PROCEDURE -RegisterObject*(obj: SYSTEM.PTR; finalize: ObjFinalizer) - "SYSTEM_REGFIN(obj, finalize)"; - - PROCEDURE -SetHalt*(p: PROCEDURE(n: LONGINT)) - "SYSTEM_Halt = p"; - - PROCEDURE InstallTermHandler*(p: PROCEDURE); - (* not yet supported; no Modules.Free *) - END InstallTermHandler; - - PROCEDURE LargestAvailable*(): LONGINT; - BEGIN - (* dummy proc for System 3 compatibility - no meaningful value except may be the remaining swap space can be returned - in the context of an extensible heap *) - RETURN MAX(LONGINT) - END LargestAvailable; - - PROCEDURE Halt(n: LONGINT); - VAR res: LONGINT; - BEGIN res := Unix.Kill(Unix.Getpid(), 4); - END Halt; - - PROCEDURE EndianTest; - VAR i: LONGINT; dmy: INTEGER; - BEGIN - dmy := 1; i := SYSTEM.ADR(dmy); - SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *) - END EndianTest; - - PROCEDURE -SizeofUnixJmpBuf(): INTEGER - "sizeof(Unix_JmpBuf)"; - - PROCEDURE -SizeofSigJmpBuf(): INTEGER - "sizeof(sigjmp_buf)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE JmpBufCheck; (* check for inconsistent usage of sigjmp_buf *) - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixJmpBuf(); - y := SizeofSigJmpBuf(); - IF x < y THEN - Error("Kernel.JmpBufCheck: inconsistent usage of sigjmp_buf", 52); - Exit(1); - END - END JmpBufCheck; - -BEGIN - EndianTest(); - SetHalt(Halt); - CWD := ""; OBERON := "."; LIB := ""; - getcwd(CWD); - Args.GetEnv("OBERON", OBERON); - Args.GetEnv("OBERON_LIB", LIB); - TimeUnit := 1000; timeStart := 0; timeStart := Time(); - JmpBufCheck() -END Kernel. diff --git a/src/system/darwin/clang/Kernel0.Mod b/src/system/darwin/clang/Kernel0.Mod deleted file mode 100644 index 70fe38f1..00000000 --- a/src/system/darwin/clang/Kernel0.Mod +++ /dev/null @@ -1,200 +0,0 @@ -MODULE Kernel0; -(* - J. Templ, 16.4.95 - communication with C-runtime and storage management -*) -(* version for bootstrapping voc *) - - IMPORT SYSTEM, Unix, Args, Strings, version; - - TYPE - RealTime = 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 ; - - KeyCmd* = PROCEDURE; - - ObjFinalizer* = PROCEDURE(obj: SYSTEM.PTR); - - - VAR - (* trap handling *) - trapEnv*: Unix.JmpBuf; (* saved stack environment for trap handling *) - - (* oberon heap management *) - nofiles*: LONGINT; - - (* input event handling *) - readSet*, readySet*: Unix.FdSet; - - FKey*: ARRAY 16 OF KeyCmd; - - littleEndian*: BOOLEAN; - - TimeUnit*: LONGINT; (* 1 sec *) - - LIB*, CWD*: ARRAY 256 OF CHAR; - OBERON*: ARRAY 1024 OF CHAR; - MODULES-: ARRAY 1024 OF CHAR; - - prefix*, fullprefix* : ARRAY 256 OF CHAR; - timeStart: LONGINT; (* milliseconds *) - - - PROCEDURE -includesetjmp() - '#include "setjmp.h"'; -(* for localtime *) - PROCEDURE -includetime() - '#include "time.h"'; - - PROCEDURE -Lock*() - "SYSTEM_lock++"; - - PROCEDURE -Unlock*() - "SYSTEM_lock--; if (SYSTEM_interrupted && SYSTEM_lock == 0) __HALT(-9)"; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -sigsetjmp*(VAR env: Unix.JmpBuf; savemask: LONGINT): LONGINT - "__sigsetjmp(env, savemask)"; - - PROCEDURE -siglongjmp*(VAR env:Unix.JmpBuf; val: LONGINT) - "siglongjmp(env, val)"; - - PROCEDURE -heapsize*(): LONGINT - "SYSTEM_heapsize"; - - PROCEDURE -allocated*(): LONGINT - "SYSTEM_allocated"; - - PROCEDURE -localtime(VAR clock: LONGINT): RealTime - "(Kernel0_RealTime)localtime(clock)"; - - PROCEDURE -malloc*(size: LONGINT): LONGINT - "(LONGINT)malloc(size)"; - - PROCEDURE -free*(adr: LONGINT) - "(void)free(adr)"; - - PROCEDURE -getcwd(VAR cwd: Unix.Name) - "getcwd(cwd, cwd__len)"; - - - PROCEDURE GetClock* (VAR t, d: LONGINT); - VAR tv: Unix.Timeval; tz: Unix.Timezone; time: RealTime; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(tv, tz); - time := localtime(tv.sec); - 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 GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - VAR err: ARRAY 25 OF CHAR; - BEGIN err := "not yet implemented"; HALT(99) - END SetClock; - - PROCEDURE Time*(): LONGINT; - VAR timeval: Unix.Timeval; timezone: Unix.Timezone; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(timeval, timezone); - RETURN (timeval.usec DIV 1000 + timeval.sec * 1000 - timeStart) MOD 7FFFFFFFH - END Time; - -(* - PROCEDURE UserTime*(): LONGINT; - VAR rusage: Unix.Rusage; - BEGIN - Unix.Getrusage(0, S.ADR(rusage)); - RETURN rusage.utime.sec*1000 + rusage.utime.usec DIV 1000 - (* + rusage.stime.sec*1000 + rusage.stime.usec DIV 1000*) - END UserTime; -*) - - PROCEDURE Select*(delay: LONGINT); - VAR rs, ws, xs: Unix.FdSet; n: LONGINT; tv: Unix.Timeval; - BEGIN - rs := readSet; - FOR n := 0 TO 7 DO ws[n] := {}; xs[n] := {}; readySet[n] := {} END; - IF delay < 0 THEN delay := 0 END ; - tv.sec := delay DIV 1000; tv.usec := SHORT(delay MOD 1000 * 1000); - n := Unix.Select(256, rs, ws, xs, tv); - IF n >= 0 THEN readySet := rs END - END Select; - - PROCEDURE -GC*(markStack: BOOLEAN) - "SYSTEM_GC(markStack)"; - - PROCEDURE -RegisterObject*(obj: SYSTEM.PTR; finalize: ObjFinalizer) - "SYSTEM_REGFIN(obj, finalize)"; - - PROCEDURE -SetHalt*(p: PROCEDURE(n: LONGINT)) - "SYSTEM_Halt = p"; - - PROCEDURE InstallTermHandler*(p: PROCEDURE); - (* not yet supported; no Modules.Free *) - END InstallTermHandler; - - PROCEDURE LargestAvailable*(): LONGINT; - BEGIN - (* dummy proc for System 3 compatibility - no meaningful value except may be the remaining swap space can be returned - in the context of an extensible heap *) - RETURN MAX(LONGINT) - END LargestAvailable; - - PROCEDURE Halt(n: LONGINT); - VAR res: LONGINT; - BEGIN res := Unix.Kill(Unix.Getpid(), 4); - END Halt; - - PROCEDURE EndianTest; - VAR i: LONGINT; dmy: INTEGER; - BEGIN - dmy := 1; i := SYSTEM.ADR(dmy); - SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *) - END EndianTest; - - PROCEDURE -SizeofUnixJmpBuf(): INTEGER - "sizeof(Unix_JmpBuf)"; - - PROCEDURE -SizeofSigJmpBuf(): INTEGER - "sizeof(sigjmp_buf)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE JmpBufCheck; (* check for inconsistent usage of sigjmp_buf *) - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixJmpBuf(); - y := SizeofSigJmpBuf(); - IF x < y THEN - Error("Kernel.JmpBufCheck: inconsistent usage of sigjmp_buf", 52); - Exit(1); - END - END JmpBufCheck; - -BEGIN - EndianTest(); - SetHalt(Halt); - CWD := ""; OBERON := "."; LIB := ""; - MODULES := ""; (* additional modules path which can be specified on commandline and will be added to the OBERON variable; noch *) - getcwd(CWD); - Args.GetEnv ("MODULES", MODULES); - Args.GetEnv("OBERON", OBERON); - (* always have current directory in module search path, noch *) - Strings.Append(":.:", OBERON); - Strings.Append(MODULES, OBERON); - Strings.Append(":", OBERON); - Strings.Append(version.prefix, OBERON); - Strings.Append("/lib/voc/sym:", OBERON); - Args.GetEnv("OBERON_LIB", LIB); - TimeUnit := 1000; timeStart := 0; timeStart := Time(); - JmpBufCheck() -END Kernel0. diff --git a/src/system/darwin/clang/x86_64/SYSTEM.c0 b/src/system/darwin/clang/x86_64/SYSTEM.c0 deleted file mode 100644 index 17801802..00000000 --- a/src/system/darwin/clang/x86_64/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the voc(jet backend) runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(size_t size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/darwin/clang/x86_64/SYSTEM.h b/src/system/darwin/clang/x86_64/SYSTEM.h deleted file mode 100644 index 71ec724f..00000000 --- a/src/system/darwin/clang/x86_64/SYSTEM.h +++ /dev/null @@ -1,239 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -voc (jet backend) runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -clang for Darwin version -uses double # as concatenation operator - -*/ - -#include -#include /* for type sizes -- noch */ -//#include - -extern void *memcpy(void *dest, const void *src, unsigned long n); -extern void *malloc(size_t size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -//typedef char BOOLEAN; -#define BOOLEAN char -//typedef unsigned char CHAR; -#define CHAR unsigned char -//exactly two bytes -#define LONGCHAR unsigned short int -//typedef signed char SHORTINT; -#define SHORTINT signed char -//for x86 GNU/Linux -//typedef short int INTEGER; -//for x86_64 GNU/Linux -//typedef int INTEGER; -#define INTEGER int -//typedef long LONGINT; -#define LONGINT long -//typedef float REAL; -#define REAL float -//typedef double LONGREAL; -#define LONGREAL double -//typedef unsigned long SET; -#define SET unsigned long -typedef void *SYSTEM_PTR; -//#define *SYSTEM_PTR void -//typedef unsigned char SYSTEM_BYTE; -#define SYSTEM_BYTE unsigned char -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned t)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) -#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/darwin/clang/x86_64/Unix.Mod b/src/system/darwin/clang/x86_64/Unix.Mod deleted file mode 100644 index 012042a0..00000000 --- a/src/system/darwin/clang/x86_64/Unix.Mod +++ /dev/null @@ -1,518 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* ported to gnu x86_64 and added system function, noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM; - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - -CONST sigsetarrlength = 1024 / 8 * SIZE(LONGINT); - - -TYPE - - JmpBuf* = RECORD - (* macosx darwin 64bit, cpp /usr/include/setjmp.h - typedef int jmp_buf[((9 * 2) + 3 + 16)]; - typedef int sigjmp_buf[((9 * 2) + 3 + 16) + 1]; - *) - - jmpbuf: ARRAY 38 OF INTEGER; - END ; - - Status* = RECORD (* struct stat *) - dev* : INTEGER; (* dev_t 4 *) - mode*: SHORTINT; mode1*: SHORTINT; (* mode_t 2 *) - nlink* : SHORTINT; nlink1*: SHORTINT; (* nlink_t 2 *) - ino* : LONGINT; (* __darwin_ino64_t 8 *) - uid*, gid*: INTEGER; (* uid_t, gid_t 4 *) - rdev*: INTEGER; (* dev_t 4 *) - atime* : LONGINT; atimences* : LONGINT; (* struct timespec 16 *) - mtime* : LONGINT; mtimences* : LONGINT; (* struct timespec 16 *) - ctime* : LONGINT; ctimences* : LONGINT; (* struct timespec 16 *) - birthtime* : LONGINT; birthtimences* : LONGINT; (* struct timespec 16 *) - size*: LONGINT; (* off_t 8 *) - blocks* : LONGINT; - blksize* : INTEGER; - flags* : INTEGER; - gen* : INTEGER; - lspare* : INTEGER; - qspare*, qspare1*: LONGINT; - END ; - -(* from /usr/include/bits/time.h - -struct timeval - { - __time_t tv_sec; /* Seconds. */ //__time_t 8 - __suseconds_t tv_usec; /* Microseconds. */ __suseconds_t 8 - }; - - -*) - - Timeval* = RECORD - sec*: LONGINT; - usec*: INTEGER - END ; - - -(* -from man gettimeofday - - struct timezone { - int tz_minuteswest; /* minutes west of Greenwich */ int 4 - int tz_dsttime; /* type of DST correction */ int 4 - }; -*) - - - Timezone* = RECORD - (*minuteswest*, dsttime*: LONGINT*) - minuteswest*, dsttime*: INTEGER - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 8 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - - Dirent* = RECORD - ino, off: LONGINT; - reclen: INTEGER; - name: ARRAY 256 OF CHAR; - END ; - - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - - Iovec* = RECORD - base*, len*: LONGINT - END ; - - SocketPair* = ARRAY 2 OF LONGINT; - - Pollfd* = RECORD - fd*: LONGINT; - events*, revents*: INTEGER - END ; - - Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; - END ; - - HostEntry* = POINTER [1] TO Hostent; - Hostent* = RECORD - name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - (* for kill() *) - PROCEDURE -includeSignal() - "#include "; - - (* for read() also *) - PROCEDURE -includeTypes() - "#include "; - - PROCEDURE -includeUio() - "#include "; - - (* for getpid(), lseek(), close(), fsync(), ftruncate(), read(), sleep() *) - PROCEDURE -includeUnistd() - "#include "; - - - (* for rename() *) - PROCEDURE -includeStdio() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for open() *) - PROCEDURE -includeFcntl() - "#include "; - - PROCEDURE -err(): INTEGER - "errno"; - - PROCEDURE errno*(): INTEGER; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: INTEGER) - "exit(n)"; - - PROCEDURE -Fork*(): INTEGER - "fork()"; - - PROCEDURE -Wait*(VAR status: INTEGER): INTEGER - "wait(status)"; - - 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) : INTEGER - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: INTEGER): INTEGER - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: INTEGER): INTEGER - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): INTEGER - "pipe(fds)"; - - PROCEDURE -Getpid*(): INTEGER - "getpid()"; - - PROCEDURE -Getuid*(): INTEGER - "getuid()"; - - PROCEDURE -Geteuid*(): INTEGER - "geteuid()"; - - PROCEDURE -Getgid*(): INTEGER - "getgid()"; - - PROCEDURE -Getegid*(): INTEGER - "getegid()"; - - PROCEDURE -Unlink*(name: Name): INTEGER - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag: INTEGER; mode: LONGINT): INTEGER - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: INTEGER): INTEGER - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): INTEGER - "stat((const char*)name, (struct stat*)statbuf)"; - - 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!) *) - (* don't understand this - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); *) - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: INTEGER; VAR statbuf: Status): INTEGER - "fstat(fd, (struct stat*)statbuf)"; - - 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!) *) - (*INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); *) - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: INTEGER): INTEGER - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: INTEGER): INTEGER - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd: INTEGER; offset: LONGINT; origin: INTEGER): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: INTEGER): INTEGER - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd: INTEGER; cmd: INTEGER; arg: LONGINT ): INTEGER - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: INTEGER): INTEGER - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd: INTEGER; length: LONGINT): INTEGER - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): INTEGER - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): INTEGER - "chdir(path)"; - - PROCEDURE -Ioctl*(fd: INTEGER; request, arg: LONGINT): LONGINT - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: INTEGER): INTEGER - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: INTEGER): INTEGER - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : INTEGER): INTEGER - "sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): INTEGER - "nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): INTEGER - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: INTEGER): INTEGER - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: INTEGER; VAR name: Sockaddr; VAR namelen: INTEGER): INTEGER - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: INTEGER): INTEGER - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: INTEGER; VAR addr: Sockaddr; VAR addrlen: INTEGER): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - 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 *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; - -BEGIN - - StatCheck(); - -END Unix. diff --git a/src/system/freebsd/clang/Console.Mod b/src/system/freebsd/clang/Console.Mod deleted file mode 100644 index 93be9373..00000000 --- a/src/system/freebsd/clang/Console.Mod +++ /dev/null @@ -1,89 +0,0 @@ -MODULE Console; (* J. Templ, 29-June-96 *) - - (* output to Unix standard output device based Write system call *) - - IMPORT SYSTEM; - - VAR line: ARRAY 128 OF CHAR; - pos: INTEGER; - - PROCEDURE -includeUnistd() - "#include "; - - PROCEDURE -Write(adr, n: LONGINT) - "write(1/*stdout*/, adr, n)"; - - PROCEDURE -read(VAR ch: CHAR): LONGINT - "read(0/*stdin*/, ch, 1)"; - - PROCEDURE Flush*(); - BEGIN - Write(SYSTEM.ADR(line), pos); pos := 0; - END Flush; - - PROCEDURE Char*(ch: CHAR); - BEGIN - IF pos = LEN(line) THEN Flush() END ; - line[pos] := ch; INC(pos); - IF ch = 0AX THEN Flush() END - END Char; - - PROCEDURE String*(s: ARRAY OF CHAR); - VAR i: INTEGER; - BEGIN i := 0; - WHILE s[i] # 0X DO Char(s[i]); INC(i) END - END String; - - PROCEDURE Int*(i, n: LONGINT); - VAR s: ARRAY 32 OF CHAR; i1, k: LONGINT; - BEGIN - IF i = SYSTEM.LSH(LONG(LONG(1)), SIZE(LONGINT)*8 - 1) THEN - IF SIZE(LONGINT) = 8 THEN s := "8085774586302733229"; k := 19 - ELSE s := "8463847412"; k := 10 - END - ELSE - i1 := ABS(i); - s[0] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; k := 1; - WHILE i1 > 0 DO s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k) END - END ; - IF i < 0 THEN s[k] := "-"; INC(k) END ; - WHILE n > k DO Char(" "); DEC(n) END ; - WHILE k > 0 DO DEC(k); Char(s[k]) END - END Int; - - PROCEDURE Ln*; - BEGIN Char(0AX); (* Unix end-of-line *) - END Ln; - - PROCEDURE Bool*(b: BOOLEAN); - BEGIN IF b THEN String("TRUE") ELSE String("FALSE") END - END Bool; - - PROCEDURE Hex*(i: LONGINT); - VAR k, n: LONGINT; - BEGIN - k := -28; - WHILE k <= 0 DO - n := ASH(i, k) MOD 16; - IF n <= 9 THEN Char(CHR(ORD("0") + n)) ELSE Char(CHR(ORD("A") - 10 + n)) END ; - INC(k, 4) - END - END Hex; - - PROCEDURE Read*(VAR ch: CHAR); - VAR n: LONGINT; - BEGIN Flush(); - n := read(ch); - IF n # 1 THEN ch := 0X END - END Read; - - PROCEDURE ReadLine*(VAR line: ARRAY OF CHAR); - VAR i: LONGINT; ch: CHAR; - BEGIN Flush(); - i := 0; Read(ch); - WHILE (i < LEN(line) - 1) & (ch # 0AX) & (ch # 0X) DO line[i] := ch; INC(i); Read(ch) END ; - line[i] := 0X - END ReadLine; - -BEGIN pos := 0; -END Console. diff --git a/src/system/freebsd/clang/SYSTEM.Mod b/src/system/freebsd/clang/SYSTEM.Mod deleted file mode 100644 index 6fc08dcf..00000000 --- a/src/system/freebsd/clang/SYSTEM.Mod +++ /dev/null @@ -1,520 +0,0 @@ -(* -* voc (jet backend) runtime system, Version 1.1 -* -* Copyright (c) Software Templ, 1994, 1995, 1996 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -*) - -MODULE SYSTEM; (* J. Templ, 31.5.95 *) - - IMPORT SYSTEM; (*must not import other modules*) - - CONST - ModNameLen = 20; - CmdNameLen = 24; - SZL = SIZE(LONGINT); - Unit = 4*SZL; (* smallest possible heap block *) - nofLists = 9; (* number of free_lists *) - heapSize0 = 8000*Unit; (* startup heap size *) - - (* all blocks look the same: - free blocks describe themselves: size = Unit - tag = &tag++ - ->blksize - sentinel = -SZL - next - *) - - (* heap chunks *) - nextChnkOff = 0; (* next heap chunk, sorted ascendingly! *) - endOff = SZL; (* end of heap chunk *) - blkOff = 3*SZL; (* first block in a chunk *) - - (* heap blocks *) - tagOff = 0; (* block starts with tag *) - sizeOff = SZL; (* block size in free block relative to block start *) - sntlOff = 2*SZL; (* pointer offset table sentinel in free block relative to block start *) - nextOff = 3*SZL; (* next pointer in free block relative to block start *) - NoPtrSntl = LONG(LONG(-SZL)); - - - TYPE - ModuleName = ARRAY ModNameLen OF CHAR; - CmdName = ARRAY CmdNameLen OF CHAR; - - Module = POINTER TO ModuleDesc; - Cmd = POINTER TO CmdDesc; - EnumProc = PROCEDURE(P: PROCEDURE(p: SYSTEM.PTR)); - ModuleDesc = RECORD - next: Module; - name: ModuleName; - refcnt: LONGINT; - cmds: Cmd; - types: LONGINT; - enumPtrs: EnumProc; - reserved1, reserved2: LONGINT - END ; - - Command = PROCEDURE; - - CmdDesc = RECORD - next: Cmd; - name: CmdName; - cmd: Command - END ; - - Finalizer = PROCEDURE(obj: SYSTEM.PTR); - - FinNode = POINTER TO FinDesc; - FinDesc = RECORD - next: FinNode; - obj: LONGINT; (* weak pointer *) - marked: BOOLEAN; - finalize: Finalizer; - END ; - - VAR - (* the list of loaded (=initialization started) modules *) - modules*: SYSTEM.PTR; - - freeList: ARRAY nofLists + 1 OF LONGINT; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *) - bigBlocks, allocated*: LONGINT; - firstTry: BOOLEAN; - - (* extensible heap *) - heap, (* the sorted list of heap chunks *) - heapend, (* max possible pointer value (used for stack collection) *) - heapsize*: LONGINT; (* the sum of all heap chunk sizes *) - - (* finalization candidates *) - fin: FinNode; - - (* garbage collector locking *) - gclock*: SHORTINT; - - - PROCEDURE -malloc(size: LONGINT): LONGINT "(LONGINT)malloc(size)"; - PROCEDURE -Lock() "Lock"; - PROCEDURE -Unlock() "Unlock"; - PROCEDURE -Mainfrm(): LONGINT "SYSTEM_mainfrm"; -(* - 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 REGMOD*(VAR name: ModuleName; enumPtrs: EnumProc): SYSTEM.PTR; - VAR m: Module; - BEGIN - IF name = "SYSTEM" THEN (* cannot use NEW *) - SYSTEM.NEW(m, SIZE(ModuleDesc)); m.cmds := NIL - ELSE NEW(m) - END ; - COPY(name, m.name); m.refcnt := 0; m.enumPtrs := enumPtrs; m.next := SYSTEM.VAL(Module, modules); - modules := m; - RETURN m - END REGMOD; - - PROCEDURE REGCMD*(m: Module; VAR name: CmdName; cmd: Command); - VAR c: Cmd; - BEGIN NEW(c); - COPY(name, c.name); c.cmd := cmd; c.next := m.cmds; m.cmds := c - END REGCMD; - - PROCEDURE REGTYP*(m: Module; typ: LONGINT); - BEGIN SYSTEM.PUT(typ, m.types); m.types := typ - END REGTYP; - - PROCEDURE INCREF*(m: Module); - BEGIN INC(m.refcnt) - END INCREF; - - PROCEDURE NewChunk(blksz: LONGINT): LONGINT; - VAR chnk: LONGINT; - BEGIN - chnk := malloc(blksz + blkOff); - IF chnk # 0 THEN - SYSTEM.PUT(chnk + endOff, chnk + (blkOff + blksz)); - SYSTEM.PUT(chnk + blkOff, chnk + (blkOff + sizeOff)); - SYSTEM.PUT(chnk + (blkOff + sizeOff), blksz); - SYSTEM.PUT(chnk + (blkOff + sntlOff), NoPtrSntl); - SYSTEM.PUT(chnk + (blkOff + nextOff), bigBlocks); - bigBlocks := chnk + blkOff; - INC(heapsize, blksz) - END ; - RETURN chnk - END NewChunk; - - PROCEDURE ExtendHeap(blksz: LONGINT); - VAR size, chnk, j, next: LONGINT; - BEGIN - IF blksz > 10000*Unit THEN size := blksz - ELSE size := 10000*Unit (* additional heuristics *) - END ; - chnk := NewChunk(size); - IF chnk # 0 THEN - (*sorted insertion*) - IF chnk < heap THEN - SYSTEM.PUT(chnk, heap); heap := chnk - ELSE - j := heap; SYSTEM.GET(j, next); - WHILE (next # 0) & (chnk > next) DO j := next; SYSTEM.GET(j, next) END ; - SYSTEM.PUT(chnk, next); SYSTEM.PUT(j, chnk) - END ; - IF next = 0 THEN SYSTEM.GET(chnk + endOff, heapend) END - END - END ExtendHeap; - - PROCEDURE ^GC*(markStack: BOOLEAN); - - PROCEDURE NEWREC*(tag: LONGINT): SYSTEM.PTR; - VAR i, i0, di, blksz, restsize, t, adr, end, next, prev: LONGINT; new: SYSTEM.PTR; - BEGIN - Lock(); - SYSTEM.GET(tag, blksz); - ASSERT(blksz MOD Unit = 0); - i0 := blksz DIV Unit; i := i0; - IF i < nofLists THEN adr := freeList[i]; - WHILE adr = 0 DO INC(i); adr := freeList[i] END - END ; - IF i < nofLists THEN (* unlink *) - SYSTEM.GET(adr + nextOff, next); - freeList[i] := next; - IF i # i0 THEN (* split *) - di := i - i0; restsize := di * Unit; end := adr + restsize; - SYSTEM.PUT(end + sizeOff, blksz); - SYSTEM.PUT(end + sntlOff, NoPtrSntl); - SYSTEM.PUT(end, end + sizeOff); - SYSTEM.PUT(adr + sizeOff, restsize); - SYSTEM.PUT(adr + nextOff, freeList[di]); - freeList[di] := adr; - INC(adr, restsize) - END - ELSE - adr := bigBlocks; prev := 0; - LOOP - IF adr = 0 THEN - IF firstTry THEN - GC(TRUE); INC(blksz, Unit); - IF (heapsize - allocated - blksz) * 4 < heapsize THEN - (* heap is still almost full; expand to avoid thrashing *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize) - END ; - firstTry := FALSE; new := NEWREC(tag); firstTry := TRUE; - IF new = NIL THEN - (* depending on the fragmentation, the heap may not have been extended by - the anti-thrashing heuristics above *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize); - new := NEWREC(tag); (* will find a free block if heap has been expanded properly *) - END ; - Unlock(); RETURN new - ELSE - Unlock(); RETURN NIL - END - END ; - SYSTEM.GET(adr+sizeOff, t); - IF t >= blksz THEN EXIT END ; - prev := adr; SYSTEM.GET(adr + nextOff, adr) - END ; - restsize := t - blksz; end := adr + restsize; - SYSTEM.PUT(end + sizeOff, blksz); - SYSTEM.PUT(end + sntlOff, NoPtrSntl); - SYSTEM.PUT(end, end + sizeOff); - IF restsize > nofLists * Unit THEN (*resize*) - SYSTEM.PUT(adr + sizeOff, restsize) - ELSE (*unlink*) - SYSTEM.GET(adr + nextOff, next); - IF prev = 0 THEN bigBlocks := next - ELSE SYSTEM.PUT(prev + nextOff, next); - END ; - IF restsize > 0 THEN (*move*) - di := restsize DIV Unit; - SYSTEM.PUT(adr + sizeOff, restsize); - SYSTEM.PUT(adr + nextOff, freeList[di]); - freeList[di] := adr - END - END ; - INC(adr, restsize) - END ; - i := adr + 4*SZL; end := adr + blksz; - WHILE i < end DO (*deliberately unrolled*) - SYSTEM.PUT(i, LONG(LONG(0))); - SYSTEM.PUT(i + SZL, LONG(LONG(0))); - SYSTEM.PUT(i + 2*SZL, LONG(LONG(0))); - SYSTEM.PUT(i + 3*SZL, LONG(LONG(0))); - INC(i, 4*SZL) - END ; - SYSTEM.PUT(adr + nextOff, LONG(LONG(0))); - SYSTEM.PUT(adr, tag); - SYSTEM.PUT(adr + sizeOff, LONG(LONG(0))); - SYSTEM.PUT(adr + sntlOff, LONG(LONG(0))); - INC(allocated, blksz); - Unlock(); - RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZL) - END NEWREC; - - PROCEDURE NEWBLK*(size: LONGINT): SYSTEM.PTR; - VAR blksz, tag: LONGINT; new: SYSTEM.PTR; - BEGIN - Lock(); - blksz := (size + (4*SZL + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*) - new := NEWREC(SYSTEM.ADR(blksz)); - tag := SYSTEM.VAL(LONGINT, new) + blksz - 3*SZL; - SYSTEM.PUT(tag - SZL, LONG(LONG(0))); (*reserved for meta info*) - SYSTEM.PUT(tag, blksz); - SYSTEM.PUT(tag + SZL, NoPtrSntl); - SYSTEM.PUT(SYSTEM.VAL(LONGINT, new) - SZL, tag); - Unlock(); - RETURN new - END NEWBLK; - - PROCEDURE Mark(q: LONGINT); - VAR p, tag, fld, n, offset, tagbits: LONGINT; - BEGIN - IF q # 0 THEN SYSTEM.GET(q - SZL, tagbits); - IF ~ODD(tagbits) THEN - SYSTEM.PUT(q - SZL, tagbits + 1); - p := 0; tag := tagbits + SZL; - LOOP - SYSTEM.GET(tag, offset); - IF offset < 0 THEN - SYSTEM.PUT(q - SZL, tag + offset + 1); - IF p = 0 THEN EXIT END ; - n := q; q := p; - SYSTEM.GET(q - SZL, tag); DEC(tag, 1); - SYSTEM.GET(tag, offset); fld := q + offset; - SYSTEM.GET(fld, p); SYSTEM.PUT(fld, n) - ELSE - fld := q + offset; - SYSTEM.GET(fld, n); - IF n # 0 THEN - SYSTEM.GET(n - SZL, tagbits); - IF ~ODD(tagbits) THEN - SYSTEM.PUT(n - SZL, tagbits + 1); - SYSTEM.PUT(q - SZL, tag + 1); - SYSTEM.PUT(fld, p); p := q; q := n; - tag := tagbits - END - END - END ; - INC(tag, SZL) - END - END - END - END Mark; - - PROCEDURE MarkP(p: SYSTEM.PTR); (* for compatibility with EnumPtrs in ANSI mode *) - BEGIN - Mark(SYSTEM.VAL(LONGINT, p)) - END MarkP; - - PROCEDURE Scan; - VAR chnk, adr, end, start, tag, i, size, freesize: LONGINT; - BEGIN bigBlocks := 0; i := 1; - WHILE i < nofLists DO freeList[i] := 0; INC(i) END ; - freesize := 0; allocated := 0; chnk := heap; - WHILE chnk # 0 DO - adr := chnk + blkOff; SYSTEM.GET(chnk + endOff, end); - WHILE adr < end DO - SYSTEM.GET(adr, tag); - IF ODD(tag) THEN (*marked*) - IF freesize > 0 THEN - start := adr - freesize; - SYSTEM.PUT(start, start+SZL); - SYSTEM.PUT(start+sizeOff, freesize); - SYSTEM.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; - IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start - ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start - END - END ; - DEC(tag, 1); - SYSTEM.PUT(adr, tag); - SYSTEM.GET(tag, size); - INC(allocated, size); - INC(adr, size) - ELSE (*unmarked*) - SYSTEM.GET(tag, size); - INC(freesize, size); - INC(adr, size) - END - END ; - IF freesize > 0 THEN (*collect last block*) - start := adr - freesize; - SYSTEM.PUT(start, start+SZL); - SYSTEM.PUT(start+sizeOff, freesize); - SYSTEM.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; - IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start - ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start - END - END ; - SYSTEM.GET(chnk, chnk) - END - END Scan; - - PROCEDURE Sift (l, r: LONGINT; VAR a: ARRAY OF LONGINT); - VAR i, j, x: LONGINT; - BEGIN j := l; x := a[j]; - LOOP i := j; j := 2*j + 1; - IF (j < r) & (a[j] < a[j+1]) THEN INC(j) END; - IF (j > r) OR (a[j] <= x) THEN EXIT END; - a[i] := a[j] - END; - a[i] := x - END Sift; - - PROCEDURE HeapSort (n: LONGINT; VAR a: ARRAY OF LONGINT); - VAR l, r, x: LONGINT; - BEGIN l := n DIV 2; r := n - 1; - WHILE l > 0 DO DEC(l); Sift(l, r, a) END; - WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END - END HeapSort; - - PROCEDURE MarkCandidates(n: LONGINT; VAR cand: ARRAY OF LONGINT); - VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: LONGINT; - BEGIN - chnk := heap; i := 0; lim := cand[n-1]; - WHILE (chnk # 0 ) & (chnk < lim) DO - adr := chnk + blkOff; - SYSTEM.GET(chnk + endOff, lim1); - IF lim < lim1 THEN lim1 := lim END ; - WHILE adr < lim1 DO - SYSTEM.GET(adr, tag); - IF ODD(tag) THEN (*already marked*) - SYSTEM.GET(tag-1, size); INC(adr, size) - ELSE - SYSTEM.GET(tag, size); - ptr := adr + SZL; - WHILE cand[i] < ptr DO INC(i) END ; - IF i = n THEN RETURN END ; - next := adr + size; - IF cand[i] < next THEN Mark(ptr) END ; - adr := next - END - END ; - SYSTEM.GET(chnk, chnk) - END - END MarkCandidates; - - PROCEDURE CheckFin; - VAR n: FinNode; tag: LONGINT; - BEGIN n := fin; - WHILE n # NIL DO - SYSTEM.GET(n.obj - SZL, tag); - IF ~ODD(tag) THEN n.marked := FALSE; Mark(n.obj) - ELSE n.marked := TRUE - END ; - n := n.next - END - END CheckFin; - - PROCEDURE Finalize; - VAR n, prev: FinNode; - BEGIN n := fin; prev := NIL; - WHILE n # NIL DO - IF ~n.marked THEN - IF n = fin THEN fin := fin.next ELSE prev.next := n.next END ; - n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj)); - (* new nodes may have been pushed in n.finalize, therefore: *) - IF prev = NIL THEN n := fin ELSE n := n.next END - ELSE prev := n; n := n.next - END - END - END Finalize; - - PROCEDURE FINALL*; - VAR n: FinNode; - BEGIN - WHILE fin # NIL DO - n := fin; fin := fin.next; - n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj)) - END - END FINALL; - - PROCEDURE MarkStack(n: LONGINT; VAR cand: ARRAY OF LONGINT); - VAR - frame: SYSTEM.PTR; - inc, nofcand: LONGINT; - sp, p, stack0, ptr: LONGINT; - align: RECORD ch: CHAR; p: SYSTEM.PTR END ; - BEGIN - IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *) - IF n > 100 THEN RETURN END (* prevent tail recursion optimization *) - END ; - IF n = 0 THEN - nofcand := 0; sp := SYSTEM.ADR(frame); - stack0 := Mainfrm(); - (* check for minimum alignment of pointers *) - inc := SYSTEM.ADR(align.p) - SYSTEM.ADR(align); - IF sp > stack0 THEN inc := -inc END ; - WHILE sp # stack0 DO - SYSTEM.GET(sp, p); - IF (p > heap) & (p < heapend) THEN - IF nofcand = LEN(cand) THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand); nofcand := 0 END ; - cand[nofcand] := p; INC(nofcand) - END ; - INC(sp, inc) - END ; - IF nofcand > 0 THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand) END - END - END MarkStack; - - PROCEDURE GC*(markStack: BOOLEAN); - VAR - m: Module; - i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: LONGINT; - cand: ARRAY 10000 OF LONGINT; - BEGIN - IF (gclock = 0) OR (gclock = 1) & ~markStack THEN - Lock(); - m := SYSTEM.VAL(Module, modules); - WHILE m # NIL DO - IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END ; - m := m^.next - END ; - IF markStack THEN - (* generate register pressure to force callee saved registers to memory; - may be simplified by inlining OS calls or processor specific instructions - *) - i0 := -100; i1 := -101; i2 := -102; i3 := -103; i4 := -104; i5 := -105; i6 := -106; i7 := -107; - i8 := 1; i9 := 2; i10 := 3; i11 := 4; i12 := 5; i13 := 6; i14 := 7; i15 := 8; - i16 := 9; i17 := 10; i18 := 11; i19 := 12; i20 := 13; i21 := 14; i22 := 15; i23 := 16; - LOOP INC(i0, 1); INC(i1, 2); INC(i2, 3); INC(i3, 4); INC(i4, 5); INC(i5, 6); INC(i6, 7); INC(i7, 8); - INC(i8, 9); INC(i9, 10); INC(i10, 11); INC(i11, 12); INC(i12, 13); INC(i13, 14); INC(i14, 15); INC(i15, 16); - INC(i16, 17); INC(i17, 18); INC(i18, 19); INC(i19, 20); INC(i20, 21); INC(i21, 22); INC(i22, 23); INC(i23, 24); - IF (i0 = -99) & (i15 = 24) THEN MarkStack(32, cand); EXIT END - END ; - IF i0 + i1 + i2 + i3 + i4 + i5 + i6 + i7 + i8 + i9 + i10 + i11 + i12 + i13 + i14 + i15 - + i16 + i17 + i18 + i19 + i20 + i21 + i22 + i23 > 10000 THEN RETURN (* use all variables *) - END ; - END; - CheckFin; - Scan; - Finalize; - Unlock() - END - END GC; - - PROCEDURE REGFIN*(obj: SYSTEM.PTR; finalize: Finalizer); - VAR f: FinNode; - BEGIN NEW(f); - f.obj := SYSTEM.VAL(LONGINT, obj); f.finalize := finalize; f.marked := TRUE; f.next := fin; fin := f - END REGFIN; - - PROCEDURE InitHeap; (* initialized before body to enable NEW, SYSTEM.NEW *) - BEGIN - heap := NewChunk(heapSize0); - SYSTEM.GET(heap + endOff, heapend); - SYSTEM.PUT(heap, LONG(LONG(0))); - allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; gclock := 0 - END InitHeap; - -END SYSTEM. diff --git a/src/system/freebsd/clang/x86_64/Args.Mod b/src/system/freebsd/clang/x86_64/Args.Mod deleted file mode 100644 index 2c0d25b5..00000000 --- a/src/system/freebsd/clang/x86_64/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-: INTEGER; argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/freebsd/clang/x86_64/Files.Mod b/src/system/freebsd/clang/x86_64/Files.Mod deleted file mode 100644 index c8f42ca5..00000000 --- a/src/system/freebsd/clang/x86_64/Files.Mod +++ /dev/null @@ -1,664 +0,0 @@ -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/system/freebsd/clang/x86_64/Files0.Mod b/src/system/freebsd/clang/x86_64/Files0.Mod deleted file mode 100644 index 1d9cd953..00000000 --- a/src/system/freebsd/clang/x86_64/Files0.Mod +++ /dev/null @@ -1,636 +0,0 @@ -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/system/freebsd/clang/x86_64/SYSTEM.c0 b/src/system/freebsd/clang/x86_64/SYSTEM.c0 deleted file mode 100644 index 17801802..00000000 --- a/src/system/freebsd/clang/x86_64/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the voc(jet backend) runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(size_t size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/freebsd/clang/x86_64/SYSTEM.h b/src/system/freebsd/clang/x86_64/SYSTEM.h deleted file mode 100644 index 90bdadd4..00000000 --- a/src/system/freebsd/clang/x86_64/SYSTEM.h +++ /dev/null @@ -1,242 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -voc (jet backend) runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -clang for Darwin version -uses double # as concatenation operator - -*/ -#include -//#include -#include /* for type sizes -- noch */ -//#include - -extern void *memcpy(void *dest, const void *src, unsigned long n); -extern void *malloc(size_t size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -//typedef char BOOLEAN; -#define BOOLEAN char -//typedef unsigned char CHAR; -#define CHAR unsigned char -//exactly two bytes -#define LONGCHAR unsigned short int -//typedef signed char SHORTINT; -#define SHORTINT signed char -//for x86 GNU/Linux -//typedef short int INTEGER; -//for x86_64 GNU/Linux -//typedef int INTEGER; -#define INTEGER int -//typedef long LONGINT; -#define LONGINT long -//typedef float REAL; -#define REAL float -//typedef double LONGREAL; -#define LONGREAL double -//typedef unsigned long SET; -#define SET unsigned long -typedef void *SYSTEM_PTR; -//#define *SYSTEM_PTR void -//typedef unsigned char SYSTEM_BYTE; -#define SYSTEM_BYTE unsigned char -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned t)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) -#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -// commented out to use malloc -- noch -//#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUP(x, l, t) x=(void*)memcpy(malloc(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -//#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __DEL(x) free(x) -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/freebsd/clang/x86_64/Unix.Mod b/src/system/freebsd/clang/x86_64/Unix.Mod deleted file mode 100644 index 9d144b41..00000000 --- a/src/system/freebsd/clang/x86_64/Unix.Mod +++ /dev/null @@ -1,557 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* ported to gnu x86_64 and added system function, noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM; - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - -CONST sigsetarrlength = 1024 / 8 * SIZE(LONGINT); - - -TYPE - - JmpBuf* = RECORD - jmpbuf: ARRAY 12 OF LONGINT; - END ; -(* -from output of cpp /usr/include/sys/stat.h - -struct stat { - __dev_t st_dev; - ino_t st_ino; - mode_t st_mode; - nlink_t st_nlink; - uid_t st_uid; - gid_t st_gid; - __dev_t st_rdev; - struct timespec st_atim; - struct timespec st_mtim; - struct timespec st_ctim; - off_t st_size; - blkcnt_t st_blocks; - blksize_t st_blksize; - fflags_t st_flags; - __uint32_t st_gen; - __int32_t st_lspare; - struct timespec st_birthtim; -# 148 "/usr/include/sys/stat.h" - unsigned int :(8 / 2) * (16 - (int)sizeof(struct timespec)); - unsigned int :(8 / 2) * (16 - (int)sizeof(struct timespec)); -}; - -sizes on freebsd 64 bit -short int 2 -int 4 -long 8 -long int 8 -size_t 8 -dev_t 4 -ino_t 4 -mode_t 2 -nlink_t 2 -uid_t 4 -gid_t 4 -off_t 8 -blksize_t 4 -blkcnt_t 8 -time_t 8 -fflags_t 4 -__uint32_t 4 -__int32_t 4 -*) - Status* = RECORD (* struct stat *) - dev* : INTEGER; (* dev_t 4 *) - ino* : INTEGER; (* ino_t 4 *) - mode*: SHORTINT; mode1*: SHORTINT; (* mode_t 2 *) - nlink* : SHORTINT; nlink1*: SHORTINT; (* nlink_t 2 *) - uid*, gid*: INTEGER; (* uid_t, gid_t 4 *) - rdev*: INTEGER; (* dev_t 4 *) - atime* : LONGINT; atimences* : LONGINT; (* struct timespec 16 *) - mtime* : LONGINT; mtimences* : LONGINT; (* struct timespec 16 *) - ctime* : LONGINT; ctimences* : LONGINT; (* struct timespec 16 *) - size*: LONGINT; (* off_t 8 *) - blocks* : LONGINT; - blksize* : INTEGER; - flags* : INTEGER; - gen* : INTEGER; - lspare* : INTEGER; - birthtime* : LONGINT; birthtimences* : LONGINT; (* struct timespec 16 *) - END ; - - -(* from /usr/include/bits/time.h - -struct timeval - { - __time_t tv_sec; /* Seconds. */ //__time_t 8 - __suseconds_t tv_usec; /* Microseconds. */ __suseconds_t 8 - }; - - -*) - - Timeval* = RECORD - sec*, usec*: LONGINT - END ; - - -(* -from man gettimeofday - - struct timezone { - int tz_minuteswest; /* minutes west of Greenwich */ int 4 - int tz_dsttime; /* type of DST correction */ int 4 - }; -*) - - - Timezone* = RECORD - (*minuteswest*, dsttime*: LONGINT*) - minuteswest*, dsttime*: INTEGER - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 8 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - - Dirent* = RECORD - ino, off: LONGINT; - reclen: INTEGER; - name: ARRAY 256 OF CHAR; - END ; - - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - - Iovec* = RECORD - base*, len*: LONGINT - END ; - - SocketPair* = ARRAY 2 OF LONGINT; - - Pollfd* = RECORD - fd*: LONGINT; - events*, revents*: INTEGER - END ; - - Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; - END ; - - HostEntry* = POINTER [1] TO Hostent; - Hostent* = RECORD - name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - (* for kill() *) - PROCEDURE -includeSignal() - "#include "; - - (* for read() also *) - PROCEDURE -includeTypes() - "#include "; - - PROCEDURE -includeUio() - "#include "; - - (* for getpid(), lseek(), close(), fsync(), ftruncate(), read(), sleep() *) - PROCEDURE -includeUnistd() - "#include "; - - - (* for rename() *) - PROCEDURE -includeStdio() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for open() *) - PROCEDURE -includeFcntl() - "#include "; - - PROCEDURE -err(): INTEGER - "errno"; - - PROCEDURE errno*(): INTEGER; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: INTEGER) - "exit(n)"; - - PROCEDURE -Fork*(): INTEGER - "fork()"; - - PROCEDURE -Wait*(VAR status: INTEGER): INTEGER - "wait(status)"; - - 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) : INTEGER - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: INTEGER): INTEGER - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: INTEGER): INTEGER - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): INTEGER - "pipe(fds)"; - - PROCEDURE -Getpid*(): INTEGER - "getpid()"; - - PROCEDURE -Getuid*(): INTEGER - "getuid()"; - - PROCEDURE -Geteuid*(): INTEGER - "geteuid()"; - - PROCEDURE -Getgid*(): INTEGER - "getgid()"; - - PROCEDURE -Getegid*(): INTEGER - "getegid()"; - - PROCEDURE -Unlink*(name: Name): INTEGER - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag: INTEGER; mode: LONGINT): INTEGER - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: INTEGER): INTEGER - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): INTEGER - "stat((const char*)name, (struct stat*)statbuf)"; - - 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!) *) - (* don't understand this - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); *) - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: INTEGER; VAR statbuf: Status): INTEGER - "fstat(fd, (struct stat*)statbuf)"; - - 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!) *) - (*INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); *) - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: INTEGER): INTEGER - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: INTEGER): INTEGER - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd: INTEGER; offset: LONGINT; origin: INTEGER): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: INTEGER): INTEGER - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd: INTEGER; cmd: INTEGER; arg: LONGINT ): INTEGER - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: INTEGER): INTEGER - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd: INTEGER; length: LONGINT): INTEGER - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): INTEGER - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): INTEGER - "chdir(path)"; - - PROCEDURE -Ioctl*(fd: INTEGER; request, arg: LONGINT): LONGINT - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: INTEGER): INTEGER - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: INTEGER): INTEGER - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : INTEGER): INTEGER - "sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): INTEGER - "nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): INTEGER - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: INTEGER): INTEGER - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: INTEGER; VAR name: Sockaddr; VAR namelen: INTEGER): INTEGER - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: INTEGER): INTEGER - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: INTEGER; VAR addr: Sockaddr; VAR addrlen: INTEGER): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - 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 *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; - -BEGIN - - StatCheck(); - -END Unix. diff --git a/src/system/linux/clang/Kernel.Mod b/src/system/linux/clang/Kernel.Mod deleted file mode 100644 index 4fa025ab..00000000 --- a/src/system/linux/clang/Kernel.Mod +++ /dev/null @@ -1,188 +0,0 @@ -MODULE Kernel; -(* - J. Templ, 16.4.95 - communication with C-runtime and storage management -*) - - IMPORT SYSTEM, Unix, Args; - - TYPE - RealTime = POINTER TO TimeDesc; - TimeDesc = RECORD - sec, min, hour, mday, mon, year, wday, isdst, zone, gmtoff: LONGINT - END ; - - KeyCmd* = PROCEDURE; - - ObjFinalizer* = PROCEDURE(obj: SYSTEM.PTR); - - - VAR - (* trap handling *) - trapEnv*: Unix.JmpBuf; (* saved stack environment for trap handling *) - - (* oberon heap management *) - nofiles*: LONGINT; - - (* input event handling *) - readSet*, readySet*: Unix.FdSet; - - FKey*: ARRAY 16 OF KeyCmd; - - littleEndian*: BOOLEAN; - - TimeUnit*: LONGINT; (* 1 sec *) - - LIB*, CWD*: ARRAY 256 OF CHAR; - OBERON*: ARRAY 1024 OF CHAR; - - - timeStart: LONGINT; (* milliseconds *) - - PROCEDURE -includesetjmp() - '#include "setjmp.h"'; -(* for localtime *) - PROCEDURE -includetime() - '#include "time.h"'; - - PROCEDURE -Lock*() - "SYSTEM_lock++"; - - PROCEDURE -Unlock*() - "SYSTEM_lock--; if (SYSTEM_interrupted && SYSTEM_lock == 0) __HALT(-9)"; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -sigsetjmp*(VAR env: Unix.JmpBuf; savemask: LONGINT): LONGINT - "__sigsetjmp(env, savemask)"; - - PROCEDURE -siglongjmp*(VAR env:Unix.JmpBuf; val: LONGINT) - "siglongjmp(env, val)"; - - PROCEDURE -heapsize*(): LONGINT - "SYSTEM_heapsize"; - - PROCEDURE -allocated*(): LONGINT - "SYSTEM_allocated"; - - PROCEDURE -localtime(VAR clock: LONGINT): RealTime - "(Kernel_RealTime)localtime(clock)"; - - PROCEDURE -malloc*(size: LONGINT): LONGINT - "(LONGINT)malloc(size)"; - - PROCEDURE -free*(adr: LONGINT) - "(void)free(adr)"; - - PROCEDURE -getcwd(VAR cwd: Unix.Name) - "getcwd(cwd, cwd__len)"; - - - PROCEDURE GetClock* (VAR t, d: LONGINT); - VAR tv: Unix.Timeval; tz: Unix.Timezone; time: RealTime; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(tv, tz); - time := localtime(tv.sec); - 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 GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - VAR err: ARRAY 25 OF CHAR; - BEGIN err := "not yet implemented"; HALT(99) - END SetClock; - - PROCEDURE Time*(): LONGINT; - VAR timeval: Unix.Timeval; timezone: Unix.Timezone; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(timeval, timezone); - RETURN (timeval.usec DIV 1000 + timeval.sec * 1000 - timeStart) MOD 7FFFFFFFH - END Time; - -(* - PROCEDURE UserTime*(): LONGINT; - VAR rusage: Unix.Rusage; - BEGIN - Unix.Getrusage(0, S.ADR(rusage)); - RETURN rusage.utime.sec*1000 + rusage.utime.usec DIV 1000 - (* + rusage.stime.sec*1000 + rusage.stime.usec DIV 1000*) - END UserTime; -*) - - PROCEDURE Select*(delay: LONGINT); - VAR rs, ws, xs: Unix.FdSet; n: LONGINT; tv: Unix.Timeval; - BEGIN - rs := readSet; - FOR n := 0 TO 7 DO ws[n] := {}; xs[n] := {}; readySet[n] := {} END; - IF delay < 0 THEN delay := 0 END ; - tv.sec := delay DIV 1000; tv.usec := delay MOD 1000 * 1000; - n := Unix.Select(256, rs, ws, xs, tv); - IF n >= 0 THEN readySet := rs END - END Select; - - PROCEDURE -GC*(markStack: BOOLEAN) - "SYSTEM_GC(markStack)"; - - PROCEDURE -RegisterObject*(obj: SYSTEM.PTR; finalize: ObjFinalizer) - "SYSTEM_REGFIN(obj, finalize)"; - - PROCEDURE -SetHalt*(p: PROCEDURE(n: LONGINT)) - "SYSTEM_Halt = p"; - - PROCEDURE InstallTermHandler*(p: PROCEDURE); - (* not yet supported; no Modules.Free *) - END InstallTermHandler; - - PROCEDURE LargestAvailable*(): LONGINT; - BEGIN - (* dummy proc for System 3 compatibility - no meaningful value except may be the remaining swap space can be returned - in the context of an extensible heap *) - RETURN MAX(LONGINT) - END LargestAvailable; - - PROCEDURE Halt(n: LONGINT); - VAR res: LONGINT; - BEGIN res := Unix.Kill(Unix.Getpid(), 4); - END Halt; - - PROCEDURE EndianTest; - VAR i: LONGINT; dmy: INTEGER; - BEGIN - dmy := 1; i := SYSTEM.ADR(dmy); - SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *) - END EndianTest; - - PROCEDURE -SizeofUnixJmpBuf(): INTEGER - "sizeof(Unix_JmpBuf)"; - - PROCEDURE -SizeofSigJmpBuf(): INTEGER - "sizeof(sigjmp_buf)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE JmpBufCheck; (* check for inconsistent usage of sigjmp_buf *) - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixJmpBuf(); - y := SizeofSigJmpBuf(); - IF x < y THEN - Error("Kernel.JmpBufCheck: inconsistent usage of sigjmp_buf", 52); - Exit(1); - END - END JmpBufCheck; - -BEGIN - EndianTest(); - SetHalt(Halt); - CWD := ""; OBERON := "."; LIB := ""; - getcwd(CWD); - Args.GetEnv("OBERON", OBERON); - Args.GetEnv("OBERON_LIB", LIB); - TimeUnit := 1000; timeStart := 0; timeStart := Time(); - JmpBufCheck() -END Kernel. diff --git a/src/system/linux/clang/Kernel0.Mod b/src/system/linux/clang/Kernel0.Mod deleted file mode 100644 index 6a58650f..00000000 --- a/src/system/linux/clang/Kernel0.Mod +++ /dev/null @@ -1,200 +0,0 @@ -MODULE Kernel0; -(* - J. Templ, 16.4.95 - communication with C-runtime and storage management -*) -(* version for bootstrapping voc *) - - IMPORT SYSTEM, Unix, Args, Strings, version; - - TYPE - RealTime = 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 ; - - KeyCmd* = PROCEDURE; - - ObjFinalizer* = PROCEDURE(obj: SYSTEM.PTR); - - - VAR - (* trap handling *) - trapEnv*: Unix.JmpBuf; (* saved stack environment for trap handling *) - - (* oberon heap management *) - nofiles*: LONGINT; - - (* input event handling *) - readSet*, readySet*: Unix.FdSet; - - FKey*: ARRAY 16 OF KeyCmd; - - littleEndian*: BOOLEAN; - - TimeUnit*: LONGINT; (* 1 sec *) - - LIB*, CWD*: ARRAY 256 OF CHAR; - OBERON*: ARRAY 1024 OF CHAR; - MODULES-: ARRAY 1024 OF CHAR; - - prefix*, fullprefix* : ARRAY 256 OF CHAR; - timeStart: LONGINT; (* milliseconds *) - - - PROCEDURE -includesetjmp() - '#include "setjmp.h"'; -(* for localtime *) - PROCEDURE -includetime() - '#include "time.h"'; - - PROCEDURE -Lock*() - "SYSTEM_lock++"; - - PROCEDURE -Unlock*() - "SYSTEM_lock--; if (SYSTEM_interrupted && SYSTEM_lock == 0) __HALT(-9)"; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -sigsetjmp*(VAR env: Unix.JmpBuf; savemask: LONGINT): LONGINT - "__sigsetjmp(env, savemask)"; - - PROCEDURE -siglongjmp*(VAR env:Unix.JmpBuf; val: LONGINT) - "siglongjmp(env, val)"; - - PROCEDURE -heapsize*(): LONGINT - "SYSTEM_heapsize"; - - PROCEDURE -allocated*(): LONGINT - "SYSTEM_allocated"; - - PROCEDURE -localtime(VAR clock: LONGINT): RealTime - "(Kernel0_RealTime)localtime(clock)"; - - PROCEDURE -malloc*(size: LONGINT): LONGINT - "(LONGINT)malloc(size)"; - - PROCEDURE -free*(adr: LONGINT) - "(void)free(adr)"; - - PROCEDURE -getcwd(VAR cwd: Unix.Name) - "getcwd(cwd, cwd__len)"; - - - PROCEDURE GetClock* (VAR t, d: LONGINT); - VAR tv: Unix.Timeval; tz: Unix.Timezone; time: RealTime; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(tv, tz); - time := localtime(tv.sec); - 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 GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - VAR err: ARRAY 25 OF CHAR; - BEGIN err := "not yet implemented"; HALT(99) - END SetClock; - - PROCEDURE Time*(): LONGINT; - VAR timeval: Unix.Timeval; timezone: Unix.Timezone; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(timeval, timezone); - RETURN (timeval.usec DIV 1000 + timeval.sec * 1000 - timeStart) MOD 7FFFFFFFH - END Time; - -(* - PROCEDURE UserTime*(): LONGINT; - VAR rusage: Unix.Rusage; - BEGIN - Unix.Getrusage(0, S.ADR(rusage)); - RETURN rusage.utime.sec*1000 + rusage.utime.usec DIV 1000 - (* + rusage.stime.sec*1000 + rusage.stime.usec DIV 1000*) - END UserTime; -*) - - PROCEDURE Select*(delay: LONGINT); - VAR rs, ws, xs: Unix.FdSet; n: LONGINT; tv: Unix.Timeval; - BEGIN - rs := readSet; - FOR n := 0 TO 7 DO ws[n] := {}; xs[n] := {}; readySet[n] := {} END; - IF delay < 0 THEN delay := 0 END ; - tv.sec := delay DIV 1000; tv.usec := delay MOD 1000 * 1000; - n := Unix.Select(256, rs, ws, xs, tv); - IF n >= 0 THEN readySet := rs END - END Select; - - PROCEDURE -GC*(markStack: BOOLEAN) - "SYSTEM_GC(markStack)"; - - PROCEDURE -RegisterObject*(obj: SYSTEM.PTR; finalize: ObjFinalizer) - "SYSTEM_REGFIN(obj, finalize)"; - - PROCEDURE -SetHalt*(p: PROCEDURE(n: LONGINT)) - "SYSTEM_Halt = p"; - - PROCEDURE InstallTermHandler*(p: PROCEDURE); - (* not yet supported; no Modules.Free *) - END InstallTermHandler; - - PROCEDURE LargestAvailable*(): LONGINT; - BEGIN - (* dummy proc for System 3 compatibility - no meaningful value except may be the remaining swap space can be returned - in the context of an extensible heap *) - RETURN MAX(LONGINT) - END LargestAvailable; - - PROCEDURE Halt(n: LONGINT); - VAR res: LONGINT; - BEGIN res := Unix.Kill(Unix.Getpid(), 4); - END Halt; - - PROCEDURE EndianTest; - VAR i: LONGINT; dmy: INTEGER; - BEGIN - dmy := 1; i := SYSTEM.ADR(dmy); - SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *) - END EndianTest; - - PROCEDURE -SizeofUnixJmpBuf(): INTEGER - "sizeof(Unix_JmpBuf)"; - - PROCEDURE -SizeofSigJmpBuf(): INTEGER - "sizeof(sigjmp_buf)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE JmpBufCheck; (* check for inconsistent usage of sigjmp_buf *) - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixJmpBuf(); - y := SizeofSigJmpBuf(); - IF x < y THEN - Error("Kernel.JmpBufCheck: inconsistent usage of sigjmp_buf", 52); - Exit(1); - END - END JmpBufCheck; - -BEGIN - EndianTest(); - SetHalt(Halt); - CWD := ""; OBERON := "."; LIB := ""; - MODULES := ""; (* additional modules path which can be specified on commandline and will be added to the OBERON variable; noch *) - getcwd(CWD); - Args.GetEnv ("MODULES", MODULES); - Args.GetEnv("OBERON", OBERON); - (* always have current directory in module search path, noch *) - Strings.Append(":.:", OBERON); - Strings.Append(MODULES, OBERON); - Strings.Append(":", OBERON); - Strings.Append(version.prefix, OBERON); - Strings.Append("/lib/voc/sym:", OBERON); - Args.GetEnv("OBERON_LIB", LIB); - TimeUnit := 1000; timeStart := 0; timeStart := Time(); - JmpBufCheck() -END Kernel0. diff --git a/src/system/linux/clang/SYSTEM.Mod b/src/system/linux/clang/SYSTEM.Mod deleted file mode 100644 index 6fc08dcf..00000000 --- a/src/system/linux/clang/SYSTEM.Mod +++ /dev/null @@ -1,520 +0,0 @@ -(* -* voc (jet backend) runtime system, Version 1.1 -* -* Copyright (c) Software Templ, 1994, 1995, 1996 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -*) - -MODULE SYSTEM; (* J. Templ, 31.5.95 *) - - IMPORT SYSTEM; (*must not import other modules*) - - CONST - ModNameLen = 20; - CmdNameLen = 24; - SZL = SIZE(LONGINT); - Unit = 4*SZL; (* smallest possible heap block *) - nofLists = 9; (* number of free_lists *) - heapSize0 = 8000*Unit; (* startup heap size *) - - (* all blocks look the same: - free blocks describe themselves: size = Unit - tag = &tag++ - ->blksize - sentinel = -SZL - next - *) - - (* heap chunks *) - nextChnkOff = 0; (* next heap chunk, sorted ascendingly! *) - endOff = SZL; (* end of heap chunk *) - blkOff = 3*SZL; (* first block in a chunk *) - - (* heap blocks *) - tagOff = 0; (* block starts with tag *) - sizeOff = SZL; (* block size in free block relative to block start *) - sntlOff = 2*SZL; (* pointer offset table sentinel in free block relative to block start *) - nextOff = 3*SZL; (* next pointer in free block relative to block start *) - NoPtrSntl = LONG(LONG(-SZL)); - - - TYPE - ModuleName = ARRAY ModNameLen OF CHAR; - CmdName = ARRAY CmdNameLen OF CHAR; - - Module = POINTER TO ModuleDesc; - Cmd = POINTER TO CmdDesc; - EnumProc = PROCEDURE(P: PROCEDURE(p: SYSTEM.PTR)); - ModuleDesc = RECORD - next: Module; - name: ModuleName; - refcnt: LONGINT; - cmds: Cmd; - types: LONGINT; - enumPtrs: EnumProc; - reserved1, reserved2: LONGINT - END ; - - Command = PROCEDURE; - - CmdDesc = RECORD - next: Cmd; - name: CmdName; - cmd: Command - END ; - - Finalizer = PROCEDURE(obj: SYSTEM.PTR); - - FinNode = POINTER TO FinDesc; - FinDesc = RECORD - next: FinNode; - obj: LONGINT; (* weak pointer *) - marked: BOOLEAN; - finalize: Finalizer; - END ; - - VAR - (* the list of loaded (=initialization started) modules *) - modules*: SYSTEM.PTR; - - freeList: ARRAY nofLists + 1 OF LONGINT; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *) - bigBlocks, allocated*: LONGINT; - firstTry: BOOLEAN; - - (* extensible heap *) - heap, (* the sorted list of heap chunks *) - heapend, (* max possible pointer value (used for stack collection) *) - heapsize*: LONGINT; (* the sum of all heap chunk sizes *) - - (* finalization candidates *) - fin: FinNode; - - (* garbage collector locking *) - gclock*: SHORTINT; - - - PROCEDURE -malloc(size: LONGINT): LONGINT "(LONGINT)malloc(size)"; - PROCEDURE -Lock() "Lock"; - PROCEDURE -Unlock() "Unlock"; - PROCEDURE -Mainfrm(): LONGINT "SYSTEM_mainfrm"; -(* - 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 REGMOD*(VAR name: ModuleName; enumPtrs: EnumProc): SYSTEM.PTR; - VAR m: Module; - BEGIN - IF name = "SYSTEM" THEN (* cannot use NEW *) - SYSTEM.NEW(m, SIZE(ModuleDesc)); m.cmds := NIL - ELSE NEW(m) - END ; - COPY(name, m.name); m.refcnt := 0; m.enumPtrs := enumPtrs; m.next := SYSTEM.VAL(Module, modules); - modules := m; - RETURN m - END REGMOD; - - PROCEDURE REGCMD*(m: Module; VAR name: CmdName; cmd: Command); - VAR c: Cmd; - BEGIN NEW(c); - COPY(name, c.name); c.cmd := cmd; c.next := m.cmds; m.cmds := c - END REGCMD; - - PROCEDURE REGTYP*(m: Module; typ: LONGINT); - BEGIN SYSTEM.PUT(typ, m.types); m.types := typ - END REGTYP; - - PROCEDURE INCREF*(m: Module); - BEGIN INC(m.refcnt) - END INCREF; - - PROCEDURE NewChunk(blksz: LONGINT): LONGINT; - VAR chnk: LONGINT; - BEGIN - chnk := malloc(blksz + blkOff); - IF chnk # 0 THEN - SYSTEM.PUT(chnk + endOff, chnk + (blkOff + blksz)); - SYSTEM.PUT(chnk + blkOff, chnk + (blkOff + sizeOff)); - SYSTEM.PUT(chnk + (blkOff + sizeOff), blksz); - SYSTEM.PUT(chnk + (blkOff + sntlOff), NoPtrSntl); - SYSTEM.PUT(chnk + (blkOff + nextOff), bigBlocks); - bigBlocks := chnk + blkOff; - INC(heapsize, blksz) - END ; - RETURN chnk - END NewChunk; - - PROCEDURE ExtendHeap(blksz: LONGINT); - VAR size, chnk, j, next: LONGINT; - BEGIN - IF blksz > 10000*Unit THEN size := blksz - ELSE size := 10000*Unit (* additional heuristics *) - END ; - chnk := NewChunk(size); - IF chnk # 0 THEN - (*sorted insertion*) - IF chnk < heap THEN - SYSTEM.PUT(chnk, heap); heap := chnk - ELSE - j := heap; SYSTEM.GET(j, next); - WHILE (next # 0) & (chnk > next) DO j := next; SYSTEM.GET(j, next) END ; - SYSTEM.PUT(chnk, next); SYSTEM.PUT(j, chnk) - END ; - IF next = 0 THEN SYSTEM.GET(chnk + endOff, heapend) END - END - END ExtendHeap; - - PROCEDURE ^GC*(markStack: BOOLEAN); - - PROCEDURE NEWREC*(tag: LONGINT): SYSTEM.PTR; - VAR i, i0, di, blksz, restsize, t, adr, end, next, prev: LONGINT; new: SYSTEM.PTR; - BEGIN - Lock(); - SYSTEM.GET(tag, blksz); - ASSERT(blksz MOD Unit = 0); - i0 := blksz DIV Unit; i := i0; - IF i < nofLists THEN adr := freeList[i]; - WHILE adr = 0 DO INC(i); adr := freeList[i] END - END ; - IF i < nofLists THEN (* unlink *) - SYSTEM.GET(adr + nextOff, next); - freeList[i] := next; - IF i # i0 THEN (* split *) - di := i - i0; restsize := di * Unit; end := adr + restsize; - SYSTEM.PUT(end + sizeOff, blksz); - SYSTEM.PUT(end + sntlOff, NoPtrSntl); - SYSTEM.PUT(end, end + sizeOff); - SYSTEM.PUT(adr + sizeOff, restsize); - SYSTEM.PUT(adr + nextOff, freeList[di]); - freeList[di] := adr; - INC(adr, restsize) - END - ELSE - adr := bigBlocks; prev := 0; - LOOP - IF adr = 0 THEN - IF firstTry THEN - GC(TRUE); INC(blksz, Unit); - IF (heapsize - allocated - blksz) * 4 < heapsize THEN - (* heap is still almost full; expand to avoid thrashing *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize) - END ; - firstTry := FALSE; new := NEWREC(tag); firstTry := TRUE; - IF new = NIL THEN - (* depending on the fragmentation, the heap may not have been extended by - the anti-thrashing heuristics above *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize); - new := NEWREC(tag); (* will find a free block if heap has been expanded properly *) - END ; - Unlock(); RETURN new - ELSE - Unlock(); RETURN NIL - END - END ; - SYSTEM.GET(adr+sizeOff, t); - IF t >= blksz THEN EXIT END ; - prev := adr; SYSTEM.GET(adr + nextOff, adr) - END ; - restsize := t - blksz; end := adr + restsize; - SYSTEM.PUT(end + sizeOff, blksz); - SYSTEM.PUT(end + sntlOff, NoPtrSntl); - SYSTEM.PUT(end, end + sizeOff); - IF restsize > nofLists * Unit THEN (*resize*) - SYSTEM.PUT(adr + sizeOff, restsize) - ELSE (*unlink*) - SYSTEM.GET(adr + nextOff, next); - IF prev = 0 THEN bigBlocks := next - ELSE SYSTEM.PUT(prev + nextOff, next); - END ; - IF restsize > 0 THEN (*move*) - di := restsize DIV Unit; - SYSTEM.PUT(adr + sizeOff, restsize); - SYSTEM.PUT(adr + nextOff, freeList[di]); - freeList[di] := adr - END - END ; - INC(adr, restsize) - END ; - i := adr + 4*SZL; end := adr + blksz; - WHILE i < end DO (*deliberately unrolled*) - SYSTEM.PUT(i, LONG(LONG(0))); - SYSTEM.PUT(i + SZL, LONG(LONG(0))); - SYSTEM.PUT(i + 2*SZL, LONG(LONG(0))); - SYSTEM.PUT(i + 3*SZL, LONG(LONG(0))); - INC(i, 4*SZL) - END ; - SYSTEM.PUT(adr + nextOff, LONG(LONG(0))); - SYSTEM.PUT(adr, tag); - SYSTEM.PUT(adr + sizeOff, LONG(LONG(0))); - SYSTEM.PUT(adr + sntlOff, LONG(LONG(0))); - INC(allocated, blksz); - Unlock(); - RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZL) - END NEWREC; - - PROCEDURE NEWBLK*(size: LONGINT): SYSTEM.PTR; - VAR blksz, tag: LONGINT; new: SYSTEM.PTR; - BEGIN - Lock(); - blksz := (size + (4*SZL + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*) - new := NEWREC(SYSTEM.ADR(blksz)); - tag := SYSTEM.VAL(LONGINT, new) + blksz - 3*SZL; - SYSTEM.PUT(tag - SZL, LONG(LONG(0))); (*reserved for meta info*) - SYSTEM.PUT(tag, blksz); - SYSTEM.PUT(tag + SZL, NoPtrSntl); - SYSTEM.PUT(SYSTEM.VAL(LONGINT, new) - SZL, tag); - Unlock(); - RETURN new - END NEWBLK; - - PROCEDURE Mark(q: LONGINT); - VAR p, tag, fld, n, offset, tagbits: LONGINT; - BEGIN - IF q # 0 THEN SYSTEM.GET(q - SZL, tagbits); - IF ~ODD(tagbits) THEN - SYSTEM.PUT(q - SZL, tagbits + 1); - p := 0; tag := tagbits + SZL; - LOOP - SYSTEM.GET(tag, offset); - IF offset < 0 THEN - SYSTEM.PUT(q - SZL, tag + offset + 1); - IF p = 0 THEN EXIT END ; - n := q; q := p; - SYSTEM.GET(q - SZL, tag); DEC(tag, 1); - SYSTEM.GET(tag, offset); fld := q + offset; - SYSTEM.GET(fld, p); SYSTEM.PUT(fld, n) - ELSE - fld := q + offset; - SYSTEM.GET(fld, n); - IF n # 0 THEN - SYSTEM.GET(n - SZL, tagbits); - IF ~ODD(tagbits) THEN - SYSTEM.PUT(n - SZL, tagbits + 1); - SYSTEM.PUT(q - SZL, tag + 1); - SYSTEM.PUT(fld, p); p := q; q := n; - tag := tagbits - END - END - END ; - INC(tag, SZL) - END - END - END - END Mark; - - PROCEDURE MarkP(p: SYSTEM.PTR); (* for compatibility with EnumPtrs in ANSI mode *) - BEGIN - Mark(SYSTEM.VAL(LONGINT, p)) - END MarkP; - - PROCEDURE Scan; - VAR chnk, adr, end, start, tag, i, size, freesize: LONGINT; - BEGIN bigBlocks := 0; i := 1; - WHILE i < nofLists DO freeList[i] := 0; INC(i) END ; - freesize := 0; allocated := 0; chnk := heap; - WHILE chnk # 0 DO - adr := chnk + blkOff; SYSTEM.GET(chnk + endOff, end); - WHILE adr < end DO - SYSTEM.GET(adr, tag); - IF ODD(tag) THEN (*marked*) - IF freesize > 0 THEN - start := adr - freesize; - SYSTEM.PUT(start, start+SZL); - SYSTEM.PUT(start+sizeOff, freesize); - SYSTEM.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; - IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start - ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start - END - END ; - DEC(tag, 1); - SYSTEM.PUT(adr, tag); - SYSTEM.GET(tag, size); - INC(allocated, size); - INC(adr, size) - ELSE (*unmarked*) - SYSTEM.GET(tag, size); - INC(freesize, size); - INC(adr, size) - END - END ; - IF freesize > 0 THEN (*collect last block*) - start := adr - freesize; - SYSTEM.PUT(start, start+SZL); - SYSTEM.PUT(start+sizeOff, freesize); - SYSTEM.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; - IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start - ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start - END - END ; - SYSTEM.GET(chnk, chnk) - END - END Scan; - - PROCEDURE Sift (l, r: LONGINT; VAR a: ARRAY OF LONGINT); - VAR i, j, x: LONGINT; - BEGIN j := l; x := a[j]; - LOOP i := j; j := 2*j + 1; - IF (j < r) & (a[j] < a[j+1]) THEN INC(j) END; - IF (j > r) OR (a[j] <= x) THEN EXIT END; - a[i] := a[j] - END; - a[i] := x - END Sift; - - PROCEDURE HeapSort (n: LONGINT; VAR a: ARRAY OF LONGINT); - VAR l, r, x: LONGINT; - BEGIN l := n DIV 2; r := n - 1; - WHILE l > 0 DO DEC(l); Sift(l, r, a) END; - WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END - END HeapSort; - - PROCEDURE MarkCandidates(n: LONGINT; VAR cand: ARRAY OF LONGINT); - VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: LONGINT; - BEGIN - chnk := heap; i := 0; lim := cand[n-1]; - WHILE (chnk # 0 ) & (chnk < lim) DO - adr := chnk + blkOff; - SYSTEM.GET(chnk + endOff, lim1); - IF lim < lim1 THEN lim1 := lim END ; - WHILE adr < lim1 DO - SYSTEM.GET(adr, tag); - IF ODD(tag) THEN (*already marked*) - SYSTEM.GET(tag-1, size); INC(adr, size) - ELSE - SYSTEM.GET(tag, size); - ptr := adr + SZL; - WHILE cand[i] < ptr DO INC(i) END ; - IF i = n THEN RETURN END ; - next := adr + size; - IF cand[i] < next THEN Mark(ptr) END ; - adr := next - END - END ; - SYSTEM.GET(chnk, chnk) - END - END MarkCandidates; - - PROCEDURE CheckFin; - VAR n: FinNode; tag: LONGINT; - BEGIN n := fin; - WHILE n # NIL DO - SYSTEM.GET(n.obj - SZL, tag); - IF ~ODD(tag) THEN n.marked := FALSE; Mark(n.obj) - ELSE n.marked := TRUE - END ; - n := n.next - END - END CheckFin; - - PROCEDURE Finalize; - VAR n, prev: FinNode; - BEGIN n := fin; prev := NIL; - WHILE n # NIL DO - IF ~n.marked THEN - IF n = fin THEN fin := fin.next ELSE prev.next := n.next END ; - n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj)); - (* new nodes may have been pushed in n.finalize, therefore: *) - IF prev = NIL THEN n := fin ELSE n := n.next END - ELSE prev := n; n := n.next - END - END - END Finalize; - - PROCEDURE FINALL*; - VAR n: FinNode; - BEGIN - WHILE fin # NIL DO - n := fin; fin := fin.next; - n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj)) - END - END FINALL; - - PROCEDURE MarkStack(n: LONGINT; VAR cand: ARRAY OF LONGINT); - VAR - frame: SYSTEM.PTR; - inc, nofcand: LONGINT; - sp, p, stack0, ptr: LONGINT; - align: RECORD ch: CHAR; p: SYSTEM.PTR END ; - BEGIN - IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *) - IF n > 100 THEN RETURN END (* prevent tail recursion optimization *) - END ; - IF n = 0 THEN - nofcand := 0; sp := SYSTEM.ADR(frame); - stack0 := Mainfrm(); - (* check for minimum alignment of pointers *) - inc := SYSTEM.ADR(align.p) - SYSTEM.ADR(align); - IF sp > stack0 THEN inc := -inc END ; - WHILE sp # stack0 DO - SYSTEM.GET(sp, p); - IF (p > heap) & (p < heapend) THEN - IF nofcand = LEN(cand) THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand); nofcand := 0 END ; - cand[nofcand] := p; INC(nofcand) - END ; - INC(sp, inc) - END ; - IF nofcand > 0 THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand) END - END - END MarkStack; - - PROCEDURE GC*(markStack: BOOLEAN); - VAR - m: Module; - i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: LONGINT; - cand: ARRAY 10000 OF LONGINT; - BEGIN - IF (gclock = 0) OR (gclock = 1) & ~markStack THEN - Lock(); - m := SYSTEM.VAL(Module, modules); - WHILE m # NIL DO - IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END ; - m := m^.next - END ; - IF markStack THEN - (* generate register pressure to force callee saved registers to memory; - may be simplified by inlining OS calls or processor specific instructions - *) - i0 := -100; i1 := -101; i2 := -102; i3 := -103; i4 := -104; i5 := -105; i6 := -106; i7 := -107; - i8 := 1; i9 := 2; i10 := 3; i11 := 4; i12 := 5; i13 := 6; i14 := 7; i15 := 8; - i16 := 9; i17 := 10; i18 := 11; i19 := 12; i20 := 13; i21 := 14; i22 := 15; i23 := 16; - LOOP INC(i0, 1); INC(i1, 2); INC(i2, 3); INC(i3, 4); INC(i4, 5); INC(i5, 6); INC(i6, 7); INC(i7, 8); - INC(i8, 9); INC(i9, 10); INC(i10, 11); INC(i11, 12); INC(i12, 13); INC(i13, 14); INC(i14, 15); INC(i15, 16); - INC(i16, 17); INC(i17, 18); INC(i18, 19); INC(i19, 20); INC(i20, 21); INC(i21, 22); INC(i22, 23); INC(i23, 24); - IF (i0 = -99) & (i15 = 24) THEN MarkStack(32, cand); EXIT END - END ; - IF i0 + i1 + i2 + i3 + i4 + i5 + i6 + i7 + i8 + i9 + i10 + i11 + i12 + i13 + i14 + i15 - + i16 + i17 + i18 + i19 + i20 + i21 + i22 + i23 > 10000 THEN RETURN (* use all variables *) - END ; - END; - CheckFin; - Scan; - Finalize; - Unlock() - END - END GC; - - PROCEDURE REGFIN*(obj: SYSTEM.PTR; finalize: Finalizer); - VAR f: FinNode; - BEGIN NEW(f); - f.obj := SYSTEM.VAL(LONGINT, obj); f.finalize := finalize; f.marked := TRUE; f.next := fin; fin := f - END REGFIN; - - PROCEDURE InitHeap; (* initialized before body to enable NEW, SYSTEM.NEW *) - BEGIN - heap := NewChunk(heapSize0); - SYSTEM.GET(heap + endOff, heapend); - SYSTEM.PUT(heap, LONG(LONG(0))); - allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; gclock := 0 - END InitHeap; - -END SYSTEM. diff --git a/src/system/linux/clang/armv6j_hardfp/Args.Mod b/src/system/linux/clang/armv6j_hardfp/Args.Mod deleted file mode 100644 index c6b7b56e..00000000 --- a/src/system/linux/clang/armv6j_hardfp/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-, argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/linux/clang/armv6j_hardfp/Files.Mod b/src/system/linux/clang/armv6j_hardfp/Files.Mod deleted file mode 100644 index 6307407d..00000000 --- a/src/system/linux/clang/armv6j_hardfp/Files.Mod +++ /dev/null @@ -1,663 +0,0 @@ -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/system/linux/clang/armv6j_hardfp/Files0.Mod b/src/system/linux/clang/armv6j_hardfp/Files0.Mod deleted file mode 100644 index 4f021ede..00000000 --- a/src/system/linux/clang/armv6j_hardfp/Files0.Mod +++ /dev/null @@ -1,635 +0,0 @@ -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/system/linux/clang/armv6j_hardfp/SYSTEM.c0 b/src/system/linux/clang/armv6j_hardfp/SYSTEM.c0 deleted file mode 100644 index 580449aa..00000000 --- a/src/system/linux/clang/armv6j_hardfp/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the Ofront runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(long size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/linux/clang/armv6j_hardfp/SYSTEM.h b/src/system/linux/clang/armv6j_hardfp/SYSTEM.h deleted file mode 100644 index ea9ae5d6..00000000 --- a/src/system/linux/clang/armv6j_hardfp/SYSTEM.h +++ /dev/null @@ -1,220 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -the Ofront runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -gcc for Linux version (same as SPARC/Solaris2) -uses double # as concatenation operator - -*/ - -#include -#include /* for type sizes -- noch */ - -//extern void *memcpy(void *dest, const void *src, long n); -extern void *memcpy(void *dest, const void *src, size_t n); -extern void *malloc(long size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -typedef char BOOLEAN; -typedef unsigned char CHAR; -typedef signed char SHORTINT; -typedef short int INTEGER; -typedef long LONGINT; -typedef float REAL; -typedef double LONGREAL; -typedef unsigned long SET; -typedef void *SYSTEM_PTR; -typedef unsigned char SYSTEM_BYTE; -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned)(x)<<(n)|(unsigned)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned)(x)>>(n)|(unsigned)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/linux/clang/armv6j_hardfp/Unix.Mod b/src/system/linux/clang/armv6j_hardfp/Unix.Mod deleted file mode 100644 index a882720a..00000000 --- a/src/system/linux/clang/armv6j_hardfp/Unix.Mod +++ /dev/null @@ -1,482 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* system procedure added by noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM; - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - - -TYPE - (* cpp /usr/include/setjmp.h - struct __jmp_buf_tag - { - __jmp_buf __jmpbuf; - int __mask_was_saved; - __sigset_t __saved_mask; - }; - - typedef struct __jmp_buf_tag jmp_buf[1]; - - __sigset_t is 128 byte long in glibc on arm, x86, x86_64 - __jmp_buf is 24 bytes long in glibc on x86 - 256 bytes long in glibc on armv6 - 64 bytes long in glibc on x86_64 - - *) - JmpBuf* = RECORD - jmpbuf: ARRAY 64 OF LONGINT; (* 256 / 4 = 64 *) - maskWasSaved*: LONGINT; - savedMask*: ARRAY 32 OF LONGINT; (* 32 * 4 = 128 *) - unknown*: LONGINT; (* jmp_buf seems to have unknown 4 bytes field at the end (see http://hastebin.com/conujujeyu.pl) which is not defined in header file *) - END ; - - Status* = RECORD (* struct stat *) - dev*, devX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad1: INTEGER; - ino*, mode*, nlink*, uid*, gid*: LONGINT; - rdev*, rdevX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad2: INTEGER; - size*, blksize*, blocks*, atime*, unused1*, mtime*, unused2*, ctime*, - unused3*, unused4*, unused5*: LONGINT; - END ; - - Timeval* = RECORD - sec*, usec*: LONGINT - END ; - - Timezone* = RECORD - minuteswest*, dsttime*: LONGINT - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 8 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - - Dirent* = RECORD - ino, off: LONGINT; - reclen: INTEGER; - name: ARRAY 256 OF CHAR; - END ; - - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - - Iovec* = RECORD - base*, len*: LONGINT - END ; - - SocketPair* = ARRAY 2 OF LONGINT; - - Pollfd* = RECORD - fd*: LONGINT; - events*, revents*: INTEGER - END ; - - Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; - END ; - - HostEntry* = POINTER [1] TO Hostent; - Hostent* = RECORD - name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for read(), write() and sleep() *) - PROCEDURE -includeUnistd() - "#include "; - - (* for system() *) -(* commented, doesn't compile on 32bit GNU/Linux platforms - PROCEDURE -includeStdlib() - "#include "; -*) - (* for nanosleep() *) - PROCEDURE -includeTime() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - PROCEDURE -err(): LONGINT - "errno"; - - PROCEDURE errno*(): LONGINT; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -Fork*(): LONGINT - "fork()"; - - PROCEDURE -Wait*(VAR status: LONGINT): LONGINT - "wait(status)"; - - PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT - "select(width, readfds, writefds, exceptfds, timeout)"; - - PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: LONGINT): LONGINT - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): LONGINT - "pipe(fds)"; - - PROCEDURE -Getpid*(): LONGINT - "getpid()"; - - PROCEDURE -Getuid*(): LONGINT - "getuid()"; - - PROCEDURE -Geteuid*(): LONGINT - "geteuid()"; - - PROCEDURE -Getgid*(): LONGINT - "getgid()"; - - PROCEDURE -Getegid*(): LONGINT - "getegid()"; - - PROCEDURE -Unlink*(name: Name): LONGINT - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: LONGINT): LONGINT - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT - "stat((const char*)name, (struct stat*)statbuf)"; - - PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := stat(name, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT - "fstat(fd, (struct stat*)statbuf)"; - - PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := fstat(fd, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: LONGINT): LONGINT - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): LONGINT - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): LONGINT - "chdir(path)"; - - PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : LONGINT): LONGINT - "sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): LONGINT - "nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): LONGINT - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "send(socket, bufadr, buflen, flags)"; - - PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; - -BEGIN - - StatCheck(); -END Unix. diff --git a/src/system/linux/clang/powerpc/Args.Mod b/src/system/linux/clang/powerpc/Args.Mod deleted file mode 100644 index c6b7b56e..00000000 --- a/src/system/linux/clang/powerpc/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-, argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/linux/clang/powerpc/Files.Mod b/src/system/linux/clang/powerpc/Files.Mod deleted file mode 100644 index 6307407d..00000000 --- a/src/system/linux/clang/powerpc/Files.Mod +++ /dev/null @@ -1,663 +0,0 @@ -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/system/linux/clang/powerpc/Files0.Mod b/src/system/linux/clang/powerpc/Files0.Mod deleted file mode 100644 index 4f021ede..00000000 --- a/src/system/linux/clang/powerpc/Files0.Mod +++ /dev/null @@ -1,635 +0,0 @@ -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/system/linux/clang/powerpc/SYSTEM.c0 b/src/system/linux/clang/powerpc/SYSTEM.c0 deleted file mode 100644 index 580449aa..00000000 --- a/src/system/linux/clang/powerpc/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the Ofront runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(long size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/linux/clang/powerpc/SYSTEM.h b/src/system/linux/clang/powerpc/SYSTEM.h deleted file mode 100644 index ea9ae5d6..00000000 --- a/src/system/linux/clang/powerpc/SYSTEM.h +++ /dev/null @@ -1,220 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -the Ofront runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -gcc for Linux version (same as SPARC/Solaris2) -uses double # as concatenation operator - -*/ - -#include -#include /* for type sizes -- noch */ - -//extern void *memcpy(void *dest, const void *src, long n); -extern void *memcpy(void *dest, const void *src, size_t n); -extern void *malloc(long size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -typedef char BOOLEAN; -typedef unsigned char CHAR; -typedef signed char SHORTINT; -typedef short int INTEGER; -typedef long LONGINT; -typedef float REAL; -typedef double LONGREAL; -typedef unsigned long SET; -typedef void *SYSTEM_PTR; -typedef unsigned char SYSTEM_BYTE; -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned)(x)<<(n)|(unsigned)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned)(x)>>(n)|(unsigned)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/linux/clang/powerpc/Unix.Mod b/src/system/linux/clang/powerpc/Unix.Mod deleted file mode 100644 index 99c35a64..00000000 --- a/src/system/linux/clang/powerpc/Unix.Mod +++ /dev/null @@ -1,465 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* system procedure added by noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM; - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - - -TYPE - JmpBuf* = RECORD - bx*, si*, di*, bp*, sp*, pc*: LONGINT; - maskWasSaved*: LONGINT; - savedMask*: ARRAY 32 OF LONGINT; - END ; - - Status* = RECORD (* struct stat *) - dev*, devX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad1: INTEGER; - ino*, mode*, nlink*, uid*, gid*: LONGINT; - rdev*, rdevX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad2: INTEGER; - size*, blksize*, blocks*, atime*, unused1*, mtime*, unused2*, ctime*, - unused3*, unused4*, unused5*: LONGINT; - END ; - - Timeval* = RECORD - sec*, usec*: LONGINT - END ; - - Timezone* = RECORD - minuteswest*, dsttime*: LONGINT - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 8 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - - Dirent* = RECORD - ino, off: LONGINT; - reclen: INTEGER; - name: ARRAY 256 OF CHAR; - END ; - - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - - Iovec* = RECORD - base*, len*: LONGINT - END ; - - SocketPair* = ARRAY 2 OF LONGINT; - - Pollfd* = RECORD - fd*: LONGINT; - events*, revents*: INTEGER - END ; - - Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; - END ; - - HostEntry* = POINTER [1] TO Hostent; - Hostent* = RECORD - name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for read(), write() and sleep() *) - PROCEDURE -includeUnistd() - "#include "; - - (* for system() *) -(* commented, doesn't compile on 32bit GNU/Linux platforms - PROCEDURE -includeStdlib() - "#include "; -*) - (* for nanosleep() *) - PROCEDURE -includeTime() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - PROCEDURE -err(): LONGINT - "errno"; - - PROCEDURE errno*(): LONGINT; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -Fork*(): LONGINT - "fork()"; - - PROCEDURE -Wait*(VAR status: LONGINT): LONGINT - "wait(status)"; - - PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT - "select(width, readfds, writefds, exceptfds, timeout)"; - - PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: LONGINT): LONGINT - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): LONGINT - "pipe(fds)"; - - PROCEDURE -Getpid*(): LONGINT - "getpid()"; - - PROCEDURE -Getuid*(): LONGINT - "getuid()"; - - PROCEDURE -Geteuid*(): LONGINT - "geteuid()"; - - PROCEDURE -Getgid*(): LONGINT - "getgid()"; - - PROCEDURE -Getegid*(): LONGINT - "getegid()"; - - PROCEDURE -Unlink*(name: Name): LONGINT - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: LONGINT): LONGINT - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT - "stat((const char*)name, (struct stat*)statbuf)"; - - PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := stat(name, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT - "fstat(fd, (struct stat*)statbuf)"; - - PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := fstat(fd, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: LONGINT): LONGINT - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): LONGINT - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): LONGINT - "chdir(path)"; - - PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : LONGINT): LONGINT - "sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): LONGINT - "nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): LONGINT - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "send(socket, bufadr, buflen, flags)"; - - PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; - -BEGIN - - StatCheck(); -END Unix. diff --git a/src/system/linux/clang/x86/Args.Mod b/src/system/linux/clang/x86/Args.Mod deleted file mode 100644 index c6b7b56e..00000000 --- a/src/system/linux/clang/x86/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-, argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/linux/clang/x86/Files.Mod b/src/system/linux/clang/x86/Files.Mod deleted file mode 100644 index 6307407d..00000000 --- a/src/system/linux/clang/x86/Files.Mod +++ /dev/null @@ -1,663 +0,0 @@ -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/system/linux/clang/x86/Files0.Mod b/src/system/linux/clang/x86/Files0.Mod deleted file mode 100644 index 4f021ede..00000000 --- a/src/system/linux/clang/x86/Files0.Mod +++ /dev/null @@ -1,635 +0,0 @@ -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/system/linux/clang/x86/SYSTEM.c0 b/src/system/linux/clang/x86/SYSTEM.c0 deleted file mode 100644 index 580449aa..00000000 --- a/src/system/linux/clang/x86/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the Ofront runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(long size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/linux/clang/x86/SYSTEM.h b/src/system/linux/clang/x86/SYSTEM.h deleted file mode 100644 index ea9ae5d6..00000000 --- a/src/system/linux/clang/x86/SYSTEM.h +++ /dev/null @@ -1,220 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -the Ofront runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -gcc for Linux version (same as SPARC/Solaris2) -uses double # as concatenation operator - -*/ - -#include -#include /* for type sizes -- noch */ - -//extern void *memcpy(void *dest, const void *src, long n); -extern void *memcpy(void *dest, const void *src, size_t n); -extern void *malloc(long size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -typedef char BOOLEAN; -typedef unsigned char CHAR; -typedef signed char SHORTINT; -typedef short int INTEGER; -typedef long LONGINT; -typedef float REAL; -typedef double LONGREAL; -typedef unsigned long SET; -typedef void *SYSTEM_PTR; -typedef unsigned char SYSTEM_BYTE; -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned)(x)<<(n)|(unsigned)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned)(x)>>(n)|(unsigned)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/linux/clang/x86/Unix.Mod b/src/system/linux/clang/x86/Unix.Mod deleted file mode 100644 index a77bccae..00000000 --- a/src/system/linux/clang/x86/Unix.Mod +++ /dev/null @@ -1,465 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* system procedure added by noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM; - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - - -TYPE - JmpBuf* = RECORD - bx*, si*, di*, bp*, sp*, pc*: LONGINT; - maskWasSaved*: LONGINT; - savedMask*: ARRAY 32 OF LONGINT; - END ; - - Status* = RECORD (* struct stat *) - dev*, devX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad1: INTEGER; - ino*, mode*, nlink*, uid*, gid*: LONGINT; - rdev*, rdevX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad2: INTEGER; - size*, blksize*, blocks*, atime*, unused1*, mtime*, unused2*, ctime*, - unused3*, unused4*, unused5*: LONGINT; - END ; - - Timeval* = RECORD - sec*, usec*: LONGINT - END ; - - Timezone* = RECORD - minuteswest*, dsttime*: LONGINT - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 8 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - - Dirent* = RECORD - ino, off: LONGINT; - reclen: INTEGER; - name: ARRAY 256 OF CHAR; - END ; - - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - - Iovec* = RECORD - base*, len*: LONGINT - END ; - - SocketPair* = ARRAY 2 OF LONGINT; - - Pollfd* = RECORD - fd*: LONGINT; - events*, revents*: INTEGER - END ; - - Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; - END ; - - HostEntry* = POINTER [1] TO Hostent; - Hostent* = RECORD - name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for read(), write() and sleep() *) - PROCEDURE -includeUnistd() - "#include "; - - (* for system() *) -(* commented, doesn't compile on 32bit GNU/Linux platforms - PROCEDURE -includeStdlib() - "#include "; -*) - (* for nanosleep() *) - PROCEDURE -includeTime() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - PROCEDURE -err(): LONGINT - "errno"; - - PROCEDURE errno*(): LONGINT; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -Fork*(): LONGINT - "fork()"; - - PROCEDURE -Wait*(VAR status: LONGINT): LONGINT - "wait(status)"; - - PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT - "select(width, readfds, writefds, exceptfds, timeout)"; - - PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: LONGINT): LONGINT - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): LONGINT - "pipe(fds)"; - - PROCEDURE -Getpid*(): LONGINT - "getpid()"; - - PROCEDURE -Getuid*(): LONGINT - "getuid()"; - - PROCEDURE -Geteuid*(): LONGINT - "geteuid()"; - - PROCEDURE -Getgid*(): LONGINT - "getgid()"; - - PROCEDURE -Getegid*(): LONGINT - "getegid()"; - - PROCEDURE -Unlink*(name: Name): LONGINT - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: LONGINT): LONGINT - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT - "stat((const char*)name, (struct stat*)statbuf)"; - - PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := stat(name, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT - "fstat(fd, (struct stat*)statbuf)"; - - PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := fstat(fd, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: LONGINT): LONGINT - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): LONGINT - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): LONGINT - "chdir(path)"; - - PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : LONGINT): LONGINT - "sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): LONGINT - "nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): LONGINT - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "send(socket, bufadr, buflen, flags)"; - - PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; - -BEGIN - - StatCheck(); -END Unix. diff --git a/src/system/linux/clang/x86_64/Args.Mod b/src/system/linux/clang/x86_64/Args.Mod deleted file mode 100644 index 0e90a48b..00000000 --- a/src/system/linux/clang/x86_64/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-:INTEGER; argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/linux/clang/x86_64/Files.Mod b/src/system/linux/clang/x86_64/Files.Mod deleted file mode 100644 index c8f42ca5..00000000 --- a/src/system/linux/clang/x86_64/Files.Mod +++ /dev/null @@ -1,664 +0,0 @@ -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/system/linux/clang/x86_64/Files0.Mod b/src/system/linux/clang/x86_64/Files0.Mod deleted file mode 100644 index 1d9cd953..00000000 --- a/src/system/linux/clang/x86_64/Files0.Mod +++ /dev/null @@ -1,636 +0,0 @@ -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/system/linux/clang/x86_64/Unix.Mod b/src/system/linux/clang/x86_64/Unix.Mod deleted file mode 100644 index 151541ad..00000000 --- a/src/system/linux/clang/x86_64/Unix.Mod +++ /dev/null @@ -1,519 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* ported to gnu x86_64 and added system function, noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM; - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - -CONST sigsetarrlength = 1024 / 8 * SIZE(LONGINT); - - -TYPE - (* cpp /usr/include/setjmp.h - struct __jmp_buf_tag - { - __jmp_buf __jmpbuf; - int __mask_was_saved; - __sigset_t __saved_mask; - }; - - typedef struct __jmp_buf_tag jmp_buf[1]; - - __sigset_t is 128 byte long in glibc on arm, x86, x86_64 - __jmp_buf is 24 bytes long in glibc on x86 - 256 bytes long in glibc on armv6 - 64 bytes long in glibc on x86_64 - - *) - JmpBuf* = RECORD - jmpbuf: ARRAY 8 OF LONGINT; (* 8 * 8 = 64 *) - maskWasSaved*: INTEGER; - savedMask*: ARRAY 16 OF LONGINT; (* 16 * 8 = 128 *) - END ; - - Status* = RECORD (* struct stat *) - dev* : LONGINT; (* dev_t 8 *) - ino* : LONGINT; (* ino 8 *) - nlink* : LONGINT; - mode* : INTEGER; - uid*, gid*: INTEGER; - pad0* : INTEGER; - rdev* : LONGINT; - size* : LONGINT; - blksize* : LONGINT; - blocks* : LONGINT; - atime* : LONGINT; - atimences* : LONGINT; - mtime* : LONGINT; - mtimensec* : LONGINT; - ctime* : LONGINT; - ctimensec* : LONGINT; - unused0*, unused1*, unused2*: LONGINT; - END ; - -(* from /usr/include/bits/time.h - -struct timeval - { - __time_t tv_sec; /* Seconds. */ //__time_t 8 - __suseconds_t tv_usec; /* Microseconds. */ __suseconds_t 8 - }; - - -*) - - Timeval* = RECORD - sec*, usec*: LONGINT - END ; - - -(* -from man gettimeofday - - struct timezone { - int tz_minuteswest; /* minutes west of Greenwich */ int 4 - int tz_dsttime; /* type of DST correction */ int 4 - }; -*) - - - Timezone* = RECORD - (*minuteswest*, dsttime*: LONGINT*) - minuteswest*, dsttime*: INTEGER - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 8 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - - Dirent* = RECORD - ino, off: LONGINT; - reclen: INTEGER; - name: ARRAY 256 OF CHAR; - END ; - - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - - Iovec* = RECORD - base*, len*: LONGINT - END ; - - SocketPair* = ARRAY 2 OF LONGINT; - - Pollfd* = RECORD - fd*: LONGINT; - events*, revents*: INTEGER - END ; - - Sockaddr* = RECORD - 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*: INTEGER; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for read(), write() and sleep() *) - PROCEDURE -includeUnistd() - "#include "; - - (* for system() *) - PROCEDURE -includeStdlib() - "#include "; - - (* for nanosleep() *) - PROCEDURE -includeTime() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - PROCEDURE -err(): INTEGER - "errno"; - - PROCEDURE errno*(): INTEGER; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: INTEGER) - "exit(n)"; - - PROCEDURE -Fork*(): INTEGER - "fork()"; - - PROCEDURE -Wait*(VAR status: INTEGER): INTEGER - "wait(status)"; - - 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) : INTEGER - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: INTEGER): INTEGER - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: INTEGER): INTEGER - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): INTEGER - "pipe(fds)"; - - PROCEDURE -Getpid*(): INTEGER - "getpid()"; - - PROCEDURE -Getuid*(): INTEGER - "getuid()"; - - PROCEDURE -Geteuid*(): INTEGER - "geteuid()"; - - PROCEDURE -Getgid*(): INTEGER - "getgid()"; - - PROCEDURE -Getegid*(): INTEGER - "getegid()"; - - PROCEDURE -Unlink*(name: Name): INTEGER - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag: INTEGER; mode: LONGINT): INTEGER - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: INTEGER): INTEGER - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): INTEGER - "stat((const char*)name, (struct stat*)statbuf)"; - - 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!) *) - (* don't understand this - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); *) - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: INTEGER; VAR statbuf: Status): INTEGER - "fstat(fd, (struct stat*)statbuf)"; - - 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!) *) - (*INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); *) - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: INTEGER): INTEGER - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: INTEGER): INTEGER - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd: INTEGER; offset: LONGINT; origin: INTEGER): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: INTEGER): INTEGER - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd: INTEGER; cmd: INTEGER; arg: LONGINT ): INTEGER - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: INTEGER): INTEGER - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd: INTEGER; length: LONGINT): INTEGER - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): INTEGER - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): INTEGER - "chdir(path)"; - - PROCEDURE -Ioctl*(fd: INTEGER; request, arg: LONGINT): INTEGER - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: INTEGER): INTEGER - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: INTEGER): INTEGER - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : INTEGER): INTEGER - "(INTEGER)sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): INTEGER - "(INTEGER)nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): INTEGER - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: INTEGER): INTEGER - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: INTEGER; VAR name: Sockaddr; VAR namelen: INTEGER): INTEGER - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: INTEGER): INTEGER - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: INTEGER; VAR addr: Sockaddr; VAR addrlen: INTEGER): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - 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 *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; - -BEGIN - - StatCheck(); - -END Unix. diff --git a/src/system/linux/gcc/Console.Mod b/src/system/linux/gcc/Console.Mod deleted file mode 100644 index e523ef7b..00000000 --- a/src/system/linux/gcc/Console.Mod +++ /dev/null @@ -1,86 +0,0 @@ -MODULE Console; (* J. Templ, 29-June-96 *) - - (* output to Unix standard output device based Write system call *) - - IMPORT SYSTEM; - - VAR line: ARRAY 128 OF CHAR; - pos: INTEGER; - - PROCEDURE -Write(adr, n: LONGINT) - "write(1/*stdout*/, adr, n)"; - - PROCEDURE -read(VAR ch: CHAR): LONGINT - "read(0/*stdin*/, ch, 1)"; - - PROCEDURE Flush*(); - BEGIN - Write(SYSTEM.ADR(line), pos); pos := 0; - END Flush; - - PROCEDURE Char*(ch: CHAR); - BEGIN - IF pos = LEN(line) THEN Flush() END ; - line[pos] := ch; INC(pos); - IF ch = 0AX THEN Flush() END - END Char; - - PROCEDURE String*(s: ARRAY OF CHAR); - VAR i: INTEGER; - BEGIN i := 0; - WHILE s[i] # 0X DO Char(s[i]); INC(i) END - END String; - - PROCEDURE Int*(i, n: LONGINT); - VAR s: ARRAY 32 OF CHAR; i1, k: LONGINT; - BEGIN - IF i = SYSTEM.LSH(LONG(LONG(1)), SIZE(LONGINT)*8 - 1) THEN - IF SIZE(LONGINT) = 8 THEN s := "8085774586302733229"; k := 19 - ELSE s := "8463847412"; k := 10 - END - ELSE - i1 := ABS(i); - s[0] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; k := 1; - WHILE i1 > 0 DO s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k) END - END ; - IF i < 0 THEN s[k] := "-"; INC(k) END ; - WHILE n > k DO Char(" "); DEC(n) END ; - WHILE k > 0 DO DEC(k); Char(s[k]) END - END Int; - - PROCEDURE Ln*; - BEGIN Char(0AX); (* Unix end-of-line *) - END Ln; - - PROCEDURE Bool*(b: BOOLEAN); - BEGIN IF b THEN String("TRUE") ELSE String("FALSE") END - END Bool; - - PROCEDURE Hex*(i: LONGINT); - VAR k, n: LONGINT; - BEGIN - k := -28; - WHILE k <= 0 DO - n := ASH(i, k) MOD 16; - IF n <= 9 THEN Char(CHR(ORD("0") + n)) ELSE Char(CHR(ORD("A") - 10 + n)) END ; - INC(k, 4) - END - END Hex; - - PROCEDURE Read*(VAR ch: CHAR); - VAR n: LONGINT; - BEGIN Flush(); - n := read(ch); - IF n # 1 THEN ch := 0X END - END Read; - - PROCEDURE ReadLine*(VAR line: ARRAY OF CHAR); - VAR i: LONGINT; ch: CHAR; - BEGIN Flush(); - i := 0; Read(ch); - WHILE (i < LEN(line) - 1) & (ch # 0AX) & (ch # 0X) DO line[i] := ch; INC(i); Read(ch) END ; - line[i] := 0X - END ReadLine; - -BEGIN pos := 0; -END Console. diff --git a/src/system/linux/gcc/Kernel.Mod b/src/system/linux/gcc/Kernel.Mod deleted file mode 100644 index 4fa025ab..00000000 --- a/src/system/linux/gcc/Kernel.Mod +++ /dev/null @@ -1,188 +0,0 @@ -MODULE Kernel; -(* - J. Templ, 16.4.95 - communication with C-runtime and storage management -*) - - IMPORT SYSTEM, Unix, Args; - - TYPE - RealTime = POINTER TO TimeDesc; - TimeDesc = RECORD - sec, min, hour, mday, mon, year, wday, isdst, zone, gmtoff: LONGINT - END ; - - KeyCmd* = PROCEDURE; - - ObjFinalizer* = PROCEDURE(obj: SYSTEM.PTR); - - - VAR - (* trap handling *) - trapEnv*: Unix.JmpBuf; (* saved stack environment for trap handling *) - - (* oberon heap management *) - nofiles*: LONGINT; - - (* input event handling *) - readSet*, readySet*: Unix.FdSet; - - FKey*: ARRAY 16 OF KeyCmd; - - littleEndian*: BOOLEAN; - - TimeUnit*: LONGINT; (* 1 sec *) - - LIB*, CWD*: ARRAY 256 OF CHAR; - OBERON*: ARRAY 1024 OF CHAR; - - - timeStart: LONGINT; (* milliseconds *) - - PROCEDURE -includesetjmp() - '#include "setjmp.h"'; -(* for localtime *) - PROCEDURE -includetime() - '#include "time.h"'; - - PROCEDURE -Lock*() - "SYSTEM_lock++"; - - PROCEDURE -Unlock*() - "SYSTEM_lock--; if (SYSTEM_interrupted && SYSTEM_lock == 0) __HALT(-9)"; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -sigsetjmp*(VAR env: Unix.JmpBuf; savemask: LONGINT): LONGINT - "__sigsetjmp(env, savemask)"; - - PROCEDURE -siglongjmp*(VAR env:Unix.JmpBuf; val: LONGINT) - "siglongjmp(env, val)"; - - PROCEDURE -heapsize*(): LONGINT - "SYSTEM_heapsize"; - - PROCEDURE -allocated*(): LONGINT - "SYSTEM_allocated"; - - PROCEDURE -localtime(VAR clock: LONGINT): RealTime - "(Kernel_RealTime)localtime(clock)"; - - PROCEDURE -malloc*(size: LONGINT): LONGINT - "(LONGINT)malloc(size)"; - - PROCEDURE -free*(adr: LONGINT) - "(void)free(adr)"; - - PROCEDURE -getcwd(VAR cwd: Unix.Name) - "getcwd(cwd, cwd__len)"; - - - PROCEDURE GetClock* (VAR t, d: LONGINT); - VAR tv: Unix.Timeval; tz: Unix.Timezone; time: RealTime; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(tv, tz); - time := localtime(tv.sec); - 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 GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - VAR err: ARRAY 25 OF CHAR; - BEGIN err := "not yet implemented"; HALT(99) - END SetClock; - - PROCEDURE Time*(): LONGINT; - VAR timeval: Unix.Timeval; timezone: Unix.Timezone; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(timeval, timezone); - RETURN (timeval.usec DIV 1000 + timeval.sec * 1000 - timeStart) MOD 7FFFFFFFH - END Time; - -(* - PROCEDURE UserTime*(): LONGINT; - VAR rusage: Unix.Rusage; - BEGIN - Unix.Getrusage(0, S.ADR(rusage)); - RETURN rusage.utime.sec*1000 + rusage.utime.usec DIV 1000 - (* + rusage.stime.sec*1000 + rusage.stime.usec DIV 1000*) - END UserTime; -*) - - PROCEDURE Select*(delay: LONGINT); - VAR rs, ws, xs: Unix.FdSet; n: LONGINT; tv: Unix.Timeval; - BEGIN - rs := readSet; - FOR n := 0 TO 7 DO ws[n] := {}; xs[n] := {}; readySet[n] := {} END; - IF delay < 0 THEN delay := 0 END ; - tv.sec := delay DIV 1000; tv.usec := delay MOD 1000 * 1000; - n := Unix.Select(256, rs, ws, xs, tv); - IF n >= 0 THEN readySet := rs END - END Select; - - PROCEDURE -GC*(markStack: BOOLEAN) - "SYSTEM_GC(markStack)"; - - PROCEDURE -RegisterObject*(obj: SYSTEM.PTR; finalize: ObjFinalizer) - "SYSTEM_REGFIN(obj, finalize)"; - - PROCEDURE -SetHalt*(p: PROCEDURE(n: LONGINT)) - "SYSTEM_Halt = p"; - - PROCEDURE InstallTermHandler*(p: PROCEDURE); - (* not yet supported; no Modules.Free *) - END InstallTermHandler; - - PROCEDURE LargestAvailable*(): LONGINT; - BEGIN - (* dummy proc for System 3 compatibility - no meaningful value except may be the remaining swap space can be returned - in the context of an extensible heap *) - RETURN MAX(LONGINT) - END LargestAvailable; - - PROCEDURE Halt(n: LONGINT); - VAR res: LONGINT; - BEGIN res := Unix.Kill(Unix.Getpid(), 4); - END Halt; - - PROCEDURE EndianTest; - VAR i: LONGINT; dmy: INTEGER; - BEGIN - dmy := 1; i := SYSTEM.ADR(dmy); - SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *) - END EndianTest; - - PROCEDURE -SizeofUnixJmpBuf(): INTEGER - "sizeof(Unix_JmpBuf)"; - - PROCEDURE -SizeofSigJmpBuf(): INTEGER - "sizeof(sigjmp_buf)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE JmpBufCheck; (* check for inconsistent usage of sigjmp_buf *) - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixJmpBuf(); - y := SizeofSigJmpBuf(); - IF x < y THEN - Error("Kernel.JmpBufCheck: inconsistent usage of sigjmp_buf", 52); - Exit(1); - END - END JmpBufCheck; - -BEGIN - EndianTest(); - SetHalt(Halt); - CWD := ""; OBERON := "."; LIB := ""; - getcwd(CWD); - Args.GetEnv("OBERON", OBERON); - Args.GetEnv("OBERON_LIB", LIB); - TimeUnit := 1000; timeStart := 0; timeStart := Time(); - JmpBufCheck() -END Kernel. diff --git a/src/system/linux/gcc/Kernel0.Mod b/src/system/linux/gcc/Kernel0.Mod deleted file mode 100644 index 6a58650f..00000000 --- a/src/system/linux/gcc/Kernel0.Mod +++ /dev/null @@ -1,200 +0,0 @@ -MODULE Kernel0; -(* - J. Templ, 16.4.95 - communication with C-runtime and storage management -*) -(* version for bootstrapping voc *) - - IMPORT SYSTEM, Unix, Args, Strings, version; - - TYPE - RealTime = 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 ; - - KeyCmd* = PROCEDURE; - - ObjFinalizer* = PROCEDURE(obj: SYSTEM.PTR); - - - VAR - (* trap handling *) - trapEnv*: Unix.JmpBuf; (* saved stack environment for trap handling *) - - (* oberon heap management *) - nofiles*: LONGINT; - - (* input event handling *) - readSet*, readySet*: Unix.FdSet; - - FKey*: ARRAY 16 OF KeyCmd; - - littleEndian*: BOOLEAN; - - TimeUnit*: LONGINT; (* 1 sec *) - - LIB*, CWD*: ARRAY 256 OF CHAR; - OBERON*: ARRAY 1024 OF CHAR; - MODULES-: ARRAY 1024 OF CHAR; - - prefix*, fullprefix* : ARRAY 256 OF CHAR; - timeStart: LONGINT; (* milliseconds *) - - - PROCEDURE -includesetjmp() - '#include "setjmp.h"'; -(* for localtime *) - PROCEDURE -includetime() - '#include "time.h"'; - - PROCEDURE -Lock*() - "SYSTEM_lock++"; - - PROCEDURE -Unlock*() - "SYSTEM_lock--; if (SYSTEM_interrupted && SYSTEM_lock == 0) __HALT(-9)"; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -sigsetjmp*(VAR env: Unix.JmpBuf; savemask: LONGINT): LONGINT - "__sigsetjmp(env, savemask)"; - - PROCEDURE -siglongjmp*(VAR env:Unix.JmpBuf; val: LONGINT) - "siglongjmp(env, val)"; - - PROCEDURE -heapsize*(): LONGINT - "SYSTEM_heapsize"; - - PROCEDURE -allocated*(): LONGINT - "SYSTEM_allocated"; - - PROCEDURE -localtime(VAR clock: LONGINT): RealTime - "(Kernel0_RealTime)localtime(clock)"; - - PROCEDURE -malloc*(size: LONGINT): LONGINT - "(LONGINT)malloc(size)"; - - PROCEDURE -free*(adr: LONGINT) - "(void)free(adr)"; - - PROCEDURE -getcwd(VAR cwd: Unix.Name) - "getcwd(cwd, cwd__len)"; - - - PROCEDURE GetClock* (VAR t, d: LONGINT); - VAR tv: Unix.Timeval; tz: Unix.Timezone; time: RealTime; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(tv, tz); - time := localtime(tv.sec); - 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 GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - VAR err: ARRAY 25 OF CHAR; - BEGIN err := "not yet implemented"; HALT(99) - END SetClock; - - PROCEDURE Time*(): LONGINT; - VAR timeval: Unix.Timeval; timezone: Unix.Timezone; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(timeval, timezone); - RETURN (timeval.usec DIV 1000 + timeval.sec * 1000 - timeStart) MOD 7FFFFFFFH - END Time; - -(* - PROCEDURE UserTime*(): LONGINT; - VAR rusage: Unix.Rusage; - BEGIN - Unix.Getrusage(0, S.ADR(rusage)); - RETURN rusage.utime.sec*1000 + rusage.utime.usec DIV 1000 - (* + rusage.stime.sec*1000 + rusage.stime.usec DIV 1000*) - END UserTime; -*) - - PROCEDURE Select*(delay: LONGINT); - VAR rs, ws, xs: Unix.FdSet; n: LONGINT; tv: Unix.Timeval; - BEGIN - rs := readSet; - FOR n := 0 TO 7 DO ws[n] := {}; xs[n] := {}; readySet[n] := {} END; - IF delay < 0 THEN delay := 0 END ; - tv.sec := delay DIV 1000; tv.usec := delay MOD 1000 * 1000; - n := Unix.Select(256, rs, ws, xs, tv); - IF n >= 0 THEN readySet := rs END - END Select; - - PROCEDURE -GC*(markStack: BOOLEAN) - "SYSTEM_GC(markStack)"; - - PROCEDURE -RegisterObject*(obj: SYSTEM.PTR; finalize: ObjFinalizer) - "SYSTEM_REGFIN(obj, finalize)"; - - PROCEDURE -SetHalt*(p: PROCEDURE(n: LONGINT)) - "SYSTEM_Halt = p"; - - PROCEDURE InstallTermHandler*(p: PROCEDURE); - (* not yet supported; no Modules.Free *) - END InstallTermHandler; - - PROCEDURE LargestAvailable*(): LONGINT; - BEGIN - (* dummy proc for System 3 compatibility - no meaningful value except may be the remaining swap space can be returned - in the context of an extensible heap *) - RETURN MAX(LONGINT) - END LargestAvailable; - - PROCEDURE Halt(n: LONGINT); - VAR res: LONGINT; - BEGIN res := Unix.Kill(Unix.Getpid(), 4); - END Halt; - - PROCEDURE EndianTest; - VAR i: LONGINT; dmy: INTEGER; - BEGIN - dmy := 1; i := SYSTEM.ADR(dmy); - SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *) - END EndianTest; - - PROCEDURE -SizeofUnixJmpBuf(): INTEGER - "sizeof(Unix_JmpBuf)"; - - PROCEDURE -SizeofSigJmpBuf(): INTEGER - "sizeof(sigjmp_buf)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE JmpBufCheck; (* check for inconsistent usage of sigjmp_buf *) - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixJmpBuf(); - y := SizeofSigJmpBuf(); - IF x < y THEN - Error("Kernel.JmpBufCheck: inconsistent usage of sigjmp_buf", 52); - Exit(1); - END - END JmpBufCheck; - -BEGIN - EndianTest(); - SetHalt(Halt); - CWD := ""; OBERON := "."; LIB := ""; - MODULES := ""; (* additional modules path which can be specified on commandline and will be added to the OBERON variable; noch *) - getcwd(CWD); - Args.GetEnv ("MODULES", MODULES); - Args.GetEnv("OBERON", OBERON); - (* always have current directory in module search path, noch *) - Strings.Append(":.:", OBERON); - Strings.Append(MODULES, OBERON); - Strings.Append(":", OBERON); - Strings.Append(version.prefix, OBERON); - Strings.Append("/lib/voc/sym:", OBERON); - Args.GetEnv("OBERON_LIB", LIB); - TimeUnit := 1000; timeStart := 0; timeStart := Time(); - JmpBufCheck() -END Kernel0. diff --git a/src/system/linux/gcc/SYSTEM.Mod b/src/system/linux/gcc/SYSTEM.Mod deleted file mode 100644 index 6fc08dcf..00000000 --- a/src/system/linux/gcc/SYSTEM.Mod +++ /dev/null @@ -1,520 +0,0 @@ -(* -* voc (jet backend) runtime system, Version 1.1 -* -* Copyright (c) Software Templ, 1994, 1995, 1996 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -*) - -MODULE SYSTEM; (* J. Templ, 31.5.95 *) - - IMPORT SYSTEM; (*must not import other modules*) - - CONST - ModNameLen = 20; - CmdNameLen = 24; - SZL = SIZE(LONGINT); - Unit = 4*SZL; (* smallest possible heap block *) - nofLists = 9; (* number of free_lists *) - heapSize0 = 8000*Unit; (* startup heap size *) - - (* all blocks look the same: - free blocks describe themselves: size = Unit - tag = &tag++ - ->blksize - sentinel = -SZL - next - *) - - (* heap chunks *) - nextChnkOff = 0; (* next heap chunk, sorted ascendingly! *) - endOff = SZL; (* end of heap chunk *) - blkOff = 3*SZL; (* first block in a chunk *) - - (* heap blocks *) - tagOff = 0; (* block starts with tag *) - sizeOff = SZL; (* block size in free block relative to block start *) - sntlOff = 2*SZL; (* pointer offset table sentinel in free block relative to block start *) - nextOff = 3*SZL; (* next pointer in free block relative to block start *) - NoPtrSntl = LONG(LONG(-SZL)); - - - TYPE - ModuleName = ARRAY ModNameLen OF CHAR; - CmdName = ARRAY CmdNameLen OF CHAR; - - Module = POINTER TO ModuleDesc; - Cmd = POINTER TO CmdDesc; - EnumProc = PROCEDURE(P: PROCEDURE(p: SYSTEM.PTR)); - ModuleDesc = RECORD - next: Module; - name: ModuleName; - refcnt: LONGINT; - cmds: Cmd; - types: LONGINT; - enumPtrs: EnumProc; - reserved1, reserved2: LONGINT - END ; - - Command = PROCEDURE; - - CmdDesc = RECORD - next: Cmd; - name: CmdName; - cmd: Command - END ; - - Finalizer = PROCEDURE(obj: SYSTEM.PTR); - - FinNode = POINTER TO FinDesc; - FinDesc = RECORD - next: FinNode; - obj: LONGINT; (* weak pointer *) - marked: BOOLEAN; - finalize: Finalizer; - END ; - - VAR - (* the list of loaded (=initialization started) modules *) - modules*: SYSTEM.PTR; - - freeList: ARRAY nofLists + 1 OF LONGINT; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *) - bigBlocks, allocated*: LONGINT; - firstTry: BOOLEAN; - - (* extensible heap *) - heap, (* the sorted list of heap chunks *) - heapend, (* max possible pointer value (used for stack collection) *) - heapsize*: LONGINT; (* the sum of all heap chunk sizes *) - - (* finalization candidates *) - fin: FinNode; - - (* garbage collector locking *) - gclock*: SHORTINT; - - - PROCEDURE -malloc(size: LONGINT): LONGINT "(LONGINT)malloc(size)"; - PROCEDURE -Lock() "Lock"; - PROCEDURE -Unlock() "Unlock"; - PROCEDURE -Mainfrm(): LONGINT "SYSTEM_mainfrm"; -(* - 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 REGMOD*(VAR name: ModuleName; enumPtrs: EnumProc): SYSTEM.PTR; - VAR m: Module; - BEGIN - IF name = "SYSTEM" THEN (* cannot use NEW *) - SYSTEM.NEW(m, SIZE(ModuleDesc)); m.cmds := NIL - ELSE NEW(m) - END ; - COPY(name, m.name); m.refcnt := 0; m.enumPtrs := enumPtrs; m.next := SYSTEM.VAL(Module, modules); - modules := m; - RETURN m - END REGMOD; - - PROCEDURE REGCMD*(m: Module; VAR name: CmdName; cmd: Command); - VAR c: Cmd; - BEGIN NEW(c); - COPY(name, c.name); c.cmd := cmd; c.next := m.cmds; m.cmds := c - END REGCMD; - - PROCEDURE REGTYP*(m: Module; typ: LONGINT); - BEGIN SYSTEM.PUT(typ, m.types); m.types := typ - END REGTYP; - - PROCEDURE INCREF*(m: Module); - BEGIN INC(m.refcnt) - END INCREF; - - PROCEDURE NewChunk(blksz: LONGINT): LONGINT; - VAR chnk: LONGINT; - BEGIN - chnk := malloc(blksz + blkOff); - IF chnk # 0 THEN - SYSTEM.PUT(chnk + endOff, chnk + (blkOff + blksz)); - SYSTEM.PUT(chnk + blkOff, chnk + (blkOff + sizeOff)); - SYSTEM.PUT(chnk + (blkOff + sizeOff), blksz); - SYSTEM.PUT(chnk + (blkOff + sntlOff), NoPtrSntl); - SYSTEM.PUT(chnk + (blkOff + nextOff), bigBlocks); - bigBlocks := chnk + blkOff; - INC(heapsize, blksz) - END ; - RETURN chnk - END NewChunk; - - PROCEDURE ExtendHeap(blksz: LONGINT); - VAR size, chnk, j, next: LONGINT; - BEGIN - IF blksz > 10000*Unit THEN size := blksz - ELSE size := 10000*Unit (* additional heuristics *) - END ; - chnk := NewChunk(size); - IF chnk # 0 THEN - (*sorted insertion*) - IF chnk < heap THEN - SYSTEM.PUT(chnk, heap); heap := chnk - ELSE - j := heap; SYSTEM.GET(j, next); - WHILE (next # 0) & (chnk > next) DO j := next; SYSTEM.GET(j, next) END ; - SYSTEM.PUT(chnk, next); SYSTEM.PUT(j, chnk) - END ; - IF next = 0 THEN SYSTEM.GET(chnk + endOff, heapend) END - END - END ExtendHeap; - - PROCEDURE ^GC*(markStack: BOOLEAN); - - PROCEDURE NEWREC*(tag: LONGINT): SYSTEM.PTR; - VAR i, i0, di, blksz, restsize, t, adr, end, next, prev: LONGINT; new: SYSTEM.PTR; - BEGIN - Lock(); - SYSTEM.GET(tag, blksz); - ASSERT(blksz MOD Unit = 0); - i0 := blksz DIV Unit; i := i0; - IF i < nofLists THEN adr := freeList[i]; - WHILE adr = 0 DO INC(i); adr := freeList[i] END - END ; - IF i < nofLists THEN (* unlink *) - SYSTEM.GET(adr + nextOff, next); - freeList[i] := next; - IF i # i0 THEN (* split *) - di := i - i0; restsize := di * Unit; end := adr + restsize; - SYSTEM.PUT(end + sizeOff, blksz); - SYSTEM.PUT(end + sntlOff, NoPtrSntl); - SYSTEM.PUT(end, end + sizeOff); - SYSTEM.PUT(adr + sizeOff, restsize); - SYSTEM.PUT(adr + nextOff, freeList[di]); - freeList[di] := adr; - INC(adr, restsize) - END - ELSE - adr := bigBlocks; prev := 0; - LOOP - IF adr = 0 THEN - IF firstTry THEN - GC(TRUE); INC(blksz, Unit); - IF (heapsize - allocated - blksz) * 4 < heapsize THEN - (* heap is still almost full; expand to avoid thrashing *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize) - END ; - firstTry := FALSE; new := NEWREC(tag); firstTry := TRUE; - IF new = NIL THEN - (* depending on the fragmentation, the heap may not have been extended by - the anti-thrashing heuristics above *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize); - new := NEWREC(tag); (* will find a free block if heap has been expanded properly *) - END ; - Unlock(); RETURN new - ELSE - Unlock(); RETURN NIL - END - END ; - SYSTEM.GET(adr+sizeOff, t); - IF t >= blksz THEN EXIT END ; - prev := adr; SYSTEM.GET(adr + nextOff, adr) - END ; - restsize := t - blksz; end := adr + restsize; - SYSTEM.PUT(end + sizeOff, blksz); - SYSTEM.PUT(end + sntlOff, NoPtrSntl); - SYSTEM.PUT(end, end + sizeOff); - IF restsize > nofLists * Unit THEN (*resize*) - SYSTEM.PUT(adr + sizeOff, restsize) - ELSE (*unlink*) - SYSTEM.GET(adr + nextOff, next); - IF prev = 0 THEN bigBlocks := next - ELSE SYSTEM.PUT(prev + nextOff, next); - END ; - IF restsize > 0 THEN (*move*) - di := restsize DIV Unit; - SYSTEM.PUT(adr + sizeOff, restsize); - SYSTEM.PUT(adr + nextOff, freeList[di]); - freeList[di] := adr - END - END ; - INC(adr, restsize) - END ; - i := adr + 4*SZL; end := adr + blksz; - WHILE i < end DO (*deliberately unrolled*) - SYSTEM.PUT(i, LONG(LONG(0))); - SYSTEM.PUT(i + SZL, LONG(LONG(0))); - SYSTEM.PUT(i + 2*SZL, LONG(LONG(0))); - SYSTEM.PUT(i + 3*SZL, LONG(LONG(0))); - INC(i, 4*SZL) - END ; - SYSTEM.PUT(adr + nextOff, LONG(LONG(0))); - SYSTEM.PUT(adr, tag); - SYSTEM.PUT(adr + sizeOff, LONG(LONG(0))); - SYSTEM.PUT(adr + sntlOff, LONG(LONG(0))); - INC(allocated, blksz); - Unlock(); - RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZL) - END NEWREC; - - PROCEDURE NEWBLK*(size: LONGINT): SYSTEM.PTR; - VAR blksz, tag: LONGINT; new: SYSTEM.PTR; - BEGIN - Lock(); - blksz := (size + (4*SZL + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*) - new := NEWREC(SYSTEM.ADR(blksz)); - tag := SYSTEM.VAL(LONGINT, new) + blksz - 3*SZL; - SYSTEM.PUT(tag - SZL, LONG(LONG(0))); (*reserved for meta info*) - SYSTEM.PUT(tag, blksz); - SYSTEM.PUT(tag + SZL, NoPtrSntl); - SYSTEM.PUT(SYSTEM.VAL(LONGINT, new) - SZL, tag); - Unlock(); - RETURN new - END NEWBLK; - - PROCEDURE Mark(q: LONGINT); - VAR p, tag, fld, n, offset, tagbits: LONGINT; - BEGIN - IF q # 0 THEN SYSTEM.GET(q - SZL, tagbits); - IF ~ODD(tagbits) THEN - SYSTEM.PUT(q - SZL, tagbits + 1); - p := 0; tag := tagbits + SZL; - LOOP - SYSTEM.GET(tag, offset); - IF offset < 0 THEN - SYSTEM.PUT(q - SZL, tag + offset + 1); - IF p = 0 THEN EXIT END ; - n := q; q := p; - SYSTEM.GET(q - SZL, tag); DEC(tag, 1); - SYSTEM.GET(tag, offset); fld := q + offset; - SYSTEM.GET(fld, p); SYSTEM.PUT(fld, n) - ELSE - fld := q + offset; - SYSTEM.GET(fld, n); - IF n # 0 THEN - SYSTEM.GET(n - SZL, tagbits); - IF ~ODD(tagbits) THEN - SYSTEM.PUT(n - SZL, tagbits + 1); - SYSTEM.PUT(q - SZL, tag + 1); - SYSTEM.PUT(fld, p); p := q; q := n; - tag := tagbits - END - END - END ; - INC(tag, SZL) - END - END - END - END Mark; - - PROCEDURE MarkP(p: SYSTEM.PTR); (* for compatibility with EnumPtrs in ANSI mode *) - BEGIN - Mark(SYSTEM.VAL(LONGINT, p)) - END MarkP; - - PROCEDURE Scan; - VAR chnk, adr, end, start, tag, i, size, freesize: LONGINT; - BEGIN bigBlocks := 0; i := 1; - WHILE i < nofLists DO freeList[i] := 0; INC(i) END ; - freesize := 0; allocated := 0; chnk := heap; - WHILE chnk # 0 DO - adr := chnk + blkOff; SYSTEM.GET(chnk + endOff, end); - WHILE adr < end DO - SYSTEM.GET(adr, tag); - IF ODD(tag) THEN (*marked*) - IF freesize > 0 THEN - start := adr - freesize; - SYSTEM.PUT(start, start+SZL); - SYSTEM.PUT(start+sizeOff, freesize); - SYSTEM.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; - IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start - ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start - END - END ; - DEC(tag, 1); - SYSTEM.PUT(adr, tag); - SYSTEM.GET(tag, size); - INC(allocated, size); - INC(adr, size) - ELSE (*unmarked*) - SYSTEM.GET(tag, size); - INC(freesize, size); - INC(adr, size) - END - END ; - IF freesize > 0 THEN (*collect last block*) - start := adr - freesize; - SYSTEM.PUT(start, start+SZL); - SYSTEM.PUT(start+sizeOff, freesize); - SYSTEM.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; - IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start - ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start - END - END ; - SYSTEM.GET(chnk, chnk) - END - END Scan; - - PROCEDURE Sift (l, r: LONGINT; VAR a: ARRAY OF LONGINT); - VAR i, j, x: LONGINT; - BEGIN j := l; x := a[j]; - LOOP i := j; j := 2*j + 1; - IF (j < r) & (a[j] < a[j+1]) THEN INC(j) END; - IF (j > r) OR (a[j] <= x) THEN EXIT END; - a[i] := a[j] - END; - a[i] := x - END Sift; - - PROCEDURE HeapSort (n: LONGINT; VAR a: ARRAY OF LONGINT); - VAR l, r, x: LONGINT; - BEGIN l := n DIV 2; r := n - 1; - WHILE l > 0 DO DEC(l); Sift(l, r, a) END; - WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END - END HeapSort; - - PROCEDURE MarkCandidates(n: LONGINT; VAR cand: ARRAY OF LONGINT); - VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: LONGINT; - BEGIN - chnk := heap; i := 0; lim := cand[n-1]; - WHILE (chnk # 0 ) & (chnk < lim) DO - adr := chnk + blkOff; - SYSTEM.GET(chnk + endOff, lim1); - IF lim < lim1 THEN lim1 := lim END ; - WHILE adr < lim1 DO - SYSTEM.GET(adr, tag); - IF ODD(tag) THEN (*already marked*) - SYSTEM.GET(tag-1, size); INC(adr, size) - ELSE - SYSTEM.GET(tag, size); - ptr := adr + SZL; - WHILE cand[i] < ptr DO INC(i) END ; - IF i = n THEN RETURN END ; - next := adr + size; - IF cand[i] < next THEN Mark(ptr) END ; - adr := next - END - END ; - SYSTEM.GET(chnk, chnk) - END - END MarkCandidates; - - PROCEDURE CheckFin; - VAR n: FinNode; tag: LONGINT; - BEGIN n := fin; - WHILE n # NIL DO - SYSTEM.GET(n.obj - SZL, tag); - IF ~ODD(tag) THEN n.marked := FALSE; Mark(n.obj) - ELSE n.marked := TRUE - END ; - n := n.next - END - END CheckFin; - - PROCEDURE Finalize; - VAR n, prev: FinNode; - BEGIN n := fin; prev := NIL; - WHILE n # NIL DO - IF ~n.marked THEN - IF n = fin THEN fin := fin.next ELSE prev.next := n.next END ; - n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj)); - (* new nodes may have been pushed in n.finalize, therefore: *) - IF prev = NIL THEN n := fin ELSE n := n.next END - ELSE prev := n; n := n.next - END - END - END Finalize; - - PROCEDURE FINALL*; - VAR n: FinNode; - BEGIN - WHILE fin # NIL DO - n := fin; fin := fin.next; - n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj)) - END - END FINALL; - - PROCEDURE MarkStack(n: LONGINT; VAR cand: ARRAY OF LONGINT); - VAR - frame: SYSTEM.PTR; - inc, nofcand: LONGINT; - sp, p, stack0, ptr: LONGINT; - align: RECORD ch: CHAR; p: SYSTEM.PTR END ; - BEGIN - IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *) - IF n > 100 THEN RETURN END (* prevent tail recursion optimization *) - END ; - IF n = 0 THEN - nofcand := 0; sp := SYSTEM.ADR(frame); - stack0 := Mainfrm(); - (* check for minimum alignment of pointers *) - inc := SYSTEM.ADR(align.p) - SYSTEM.ADR(align); - IF sp > stack0 THEN inc := -inc END ; - WHILE sp # stack0 DO - SYSTEM.GET(sp, p); - IF (p > heap) & (p < heapend) THEN - IF nofcand = LEN(cand) THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand); nofcand := 0 END ; - cand[nofcand] := p; INC(nofcand) - END ; - INC(sp, inc) - END ; - IF nofcand > 0 THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand) END - END - END MarkStack; - - PROCEDURE GC*(markStack: BOOLEAN); - VAR - m: Module; - i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: LONGINT; - cand: ARRAY 10000 OF LONGINT; - BEGIN - IF (gclock = 0) OR (gclock = 1) & ~markStack THEN - Lock(); - m := SYSTEM.VAL(Module, modules); - WHILE m # NIL DO - IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END ; - m := m^.next - END ; - IF markStack THEN - (* generate register pressure to force callee saved registers to memory; - may be simplified by inlining OS calls or processor specific instructions - *) - i0 := -100; i1 := -101; i2 := -102; i3 := -103; i4 := -104; i5 := -105; i6 := -106; i7 := -107; - i8 := 1; i9 := 2; i10 := 3; i11 := 4; i12 := 5; i13 := 6; i14 := 7; i15 := 8; - i16 := 9; i17 := 10; i18 := 11; i19 := 12; i20 := 13; i21 := 14; i22 := 15; i23 := 16; - LOOP INC(i0, 1); INC(i1, 2); INC(i2, 3); INC(i3, 4); INC(i4, 5); INC(i5, 6); INC(i6, 7); INC(i7, 8); - INC(i8, 9); INC(i9, 10); INC(i10, 11); INC(i11, 12); INC(i12, 13); INC(i13, 14); INC(i14, 15); INC(i15, 16); - INC(i16, 17); INC(i17, 18); INC(i18, 19); INC(i19, 20); INC(i20, 21); INC(i21, 22); INC(i22, 23); INC(i23, 24); - IF (i0 = -99) & (i15 = 24) THEN MarkStack(32, cand); EXIT END - END ; - IF i0 + i1 + i2 + i3 + i4 + i5 + i6 + i7 + i8 + i9 + i10 + i11 + i12 + i13 + i14 + i15 - + i16 + i17 + i18 + i19 + i20 + i21 + i22 + i23 > 10000 THEN RETURN (* use all variables *) - END ; - END; - CheckFin; - Scan; - Finalize; - Unlock() - END - END GC; - - PROCEDURE REGFIN*(obj: SYSTEM.PTR; finalize: Finalizer); - VAR f: FinNode; - BEGIN NEW(f); - f.obj := SYSTEM.VAL(LONGINT, obj); f.finalize := finalize; f.marked := TRUE; f.next := fin; fin := f - END REGFIN; - - PROCEDURE InitHeap; (* initialized before body to enable NEW, SYSTEM.NEW *) - BEGIN - heap := NewChunk(heapSize0); - SYSTEM.GET(heap + endOff, heapend); - SYSTEM.PUT(heap, LONG(LONG(0))); - allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; gclock := 0 - END InitHeap; - -END SYSTEM. diff --git a/src/system/linux/gcc/armv6j_hardfp/Args.Mod b/src/system/linux/gcc/armv6j_hardfp/Args.Mod deleted file mode 100644 index c6b7b56e..00000000 --- a/src/system/linux/gcc/armv6j_hardfp/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-, argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/linux/gcc/armv6j_hardfp/Files.Mod b/src/system/linux/gcc/armv6j_hardfp/Files.Mod deleted file mode 100644 index 6307407d..00000000 --- a/src/system/linux/gcc/armv6j_hardfp/Files.Mod +++ /dev/null @@ -1,663 +0,0 @@ -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/system/linux/gcc/armv6j_hardfp/Files0.Mod b/src/system/linux/gcc/armv6j_hardfp/Files0.Mod deleted file mode 100644 index 4f021ede..00000000 --- a/src/system/linux/gcc/armv6j_hardfp/Files0.Mod +++ /dev/null @@ -1,635 +0,0 @@ -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/system/linux/gcc/armv6j_hardfp/SYSTEM.c0 b/src/system/linux/gcc/armv6j_hardfp/SYSTEM.c0 deleted file mode 100644 index 580449aa..00000000 --- a/src/system/linux/gcc/armv6j_hardfp/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the Ofront runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(long size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/linux/gcc/armv6j_hardfp/SYSTEM.h b/src/system/linux/gcc/armv6j_hardfp/SYSTEM.h deleted file mode 100644 index ea9ae5d6..00000000 --- a/src/system/linux/gcc/armv6j_hardfp/SYSTEM.h +++ /dev/null @@ -1,220 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -the Ofront runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -gcc for Linux version (same as SPARC/Solaris2) -uses double # as concatenation operator - -*/ - -#include -#include /* for type sizes -- noch */ - -//extern void *memcpy(void *dest, const void *src, long n); -extern void *memcpy(void *dest, const void *src, size_t n); -extern void *malloc(long size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -typedef char BOOLEAN; -typedef unsigned char CHAR; -typedef signed char SHORTINT; -typedef short int INTEGER; -typedef long LONGINT; -typedef float REAL; -typedef double LONGREAL; -typedef unsigned long SET; -typedef void *SYSTEM_PTR; -typedef unsigned char SYSTEM_BYTE; -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned)(x)<<(n)|(unsigned)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned)(x)>>(n)|(unsigned)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/linux/gcc/armv6j_hardfp/Unix.Mod b/src/system/linux/gcc/armv6j_hardfp/Unix.Mod deleted file mode 100644 index a882720a..00000000 --- a/src/system/linux/gcc/armv6j_hardfp/Unix.Mod +++ /dev/null @@ -1,482 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* system procedure added by noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM; - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - - -TYPE - (* cpp /usr/include/setjmp.h - struct __jmp_buf_tag - { - __jmp_buf __jmpbuf; - int __mask_was_saved; - __sigset_t __saved_mask; - }; - - typedef struct __jmp_buf_tag jmp_buf[1]; - - __sigset_t is 128 byte long in glibc on arm, x86, x86_64 - __jmp_buf is 24 bytes long in glibc on x86 - 256 bytes long in glibc on armv6 - 64 bytes long in glibc on x86_64 - - *) - JmpBuf* = RECORD - jmpbuf: ARRAY 64 OF LONGINT; (* 256 / 4 = 64 *) - maskWasSaved*: LONGINT; - savedMask*: ARRAY 32 OF LONGINT; (* 32 * 4 = 128 *) - unknown*: LONGINT; (* jmp_buf seems to have unknown 4 bytes field at the end (see http://hastebin.com/conujujeyu.pl) which is not defined in header file *) - END ; - - Status* = RECORD (* struct stat *) - dev*, devX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad1: INTEGER; - ino*, mode*, nlink*, uid*, gid*: LONGINT; - rdev*, rdevX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad2: INTEGER; - size*, blksize*, blocks*, atime*, unused1*, mtime*, unused2*, ctime*, - unused3*, unused4*, unused5*: LONGINT; - END ; - - Timeval* = RECORD - sec*, usec*: LONGINT - END ; - - Timezone* = RECORD - minuteswest*, dsttime*: LONGINT - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 8 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - - Dirent* = RECORD - ino, off: LONGINT; - reclen: INTEGER; - name: ARRAY 256 OF CHAR; - END ; - - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - - Iovec* = RECORD - base*, len*: LONGINT - END ; - - SocketPair* = ARRAY 2 OF LONGINT; - - Pollfd* = RECORD - fd*: LONGINT; - events*, revents*: INTEGER - END ; - - Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; - END ; - - HostEntry* = POINTER [1] TO Hostent; - Hostent* = RECORD - name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for read(), write() and sleep() *) - PROCEDURE -includeUnistd() - "#include "; - - (* for system() *) -(* commented, doesn't compile on 32bit GNU/Linux platforms - PROCEDURE -includeStdlib() - "#include "; -*) - (* for nanosleep() *) - PROCEDURE -includeTime() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - PROCEDURE -err(): LONGINT - "errno"; - - PROCEDURE errno*(): LONGINT; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -Fork*(): LONGINT - "fork()"; - - PROCEDURE -Wait*(VAR status: LONGINT): LONGINT - "wait(status)"; - - PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT - "select(width, readfds, writefds, exceptfds, timeout)"; - - PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: LONGINT): LONGINT - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): LONGINT - "pipe(fds)"; - - PROCEDURE -Getpid*(): LONGINT - "getpid()"; - - PROCEDURE -Getuid*(): LONGINT - "getuid()"; - - PROCEDURE -Geteuid*(): LONGINT - "geteuid()"; - - PROCEDURE -Getgid*(): LONGINT - "getgid()"; - - PROCEDURE -Getegid*(): LONGINT - "getegid()"; - - PROCEDURE -Unlink*(name: Name): LONGINT - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: LONGINT): LONGINT - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT - "stat((const char*)name, (struct stat*)statbuf)"; - - PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := stat(name, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT - "fstat(fd, (struct stat*)statbuf)"; - - PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := fstat(fd, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: LONGINT): LONGINT - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): LONGINT - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): LONGINT - "chdir(path)"; - - PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : LONGINT): LONGINT - "sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): LONGINT - "nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): LONGINT - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "send(socket, bufadr, buflen, flags)"; - - PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; - -BEGIN - - StatCheck(); -END Unix. diff --git a/src/system/linux/gcc/powerpc/Args.Mod b/src/system/linux/gcc/powerpc/Args.Mod deleted file mode 100644 index c6b7b56e..00000000 --- a/src/system/linux/gcc/powerpc/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-, argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/linux/gcc/powerpc/Files.Mod b/src/system/linux/gcc/powerpc/Files.Mod deleted file mode 100644 index 6307407d..00000000 --- a/src/system/linux/gcc/powerpc/Files.Mod +++ /dev/null @@ -1,663 +0,0 @@ -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/system/linux/gcc/powerpc/Files0.Mod b/src/system/linux/gcc/powerpc/Files0.Mod deleted file mode 100644 index 4f021ede..00000000 --- a/src/system/linux/gcc/powerpc/Files0.Mod +++ /dev/null @@ -1,635 +0,0 @@ -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/system/linux/gcc/powerpc/SYSTEM.c0 b/src/system/linux/gcc/powerpc/SYSTEM.c0 deleted file mode 100644 index 580449aa..00000000 --- a/src/system/linux/gcc/powerpc/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the Ofront runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(long size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/linux/gcc/powerpc/SYSTEM.h b/src/system/linux/gcc/powerpc/SYSTEM.h deleted file mode 100644 index ea9ae5d6..00000000 --- a/src/system/linux/gcc/powerpc/SYSTEM.h +++ /dev/null @@ -1,220 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -the Ofront runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -gcc for Linux version (same as SPARC/Solaris2) -uses double # as concatenation operator - -*/ - -#include -#include /* for type sizes -- noch */ - -//extern void *memcpy(void *dest, const void *src, long n); -extern void *memcpy(void *dest, const void *src, size_t n); -extern void *malloc(long size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -typedef char BOOLEAN; -typedef unsigned char CHAR; -typedef signed char SHORTINT; -typedef short int INTEGER; -typedef long LONGINT; -typedef float REAL; -typedef double LONGREAL; -typedef unsigned long SET; -typedef void *SYSTEM_PTR; -typedef unsigned char SYSTEM_BYTE; -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned)(x)<<(n)|(unsigned)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned)(x)>>(n)|(unsigned)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/linux/gcc/powerpc/Unix.Mod b/src/system/linux/gcc/powerpc/Unix.Mod deleted file mode 100644 index 99c35a64..00000000 --- a/src/system/linux/gcc/powerpc/Unix.Mod +++ /dev/null @@ -1,465 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* system procedure added by noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM; - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - - -TYPE - JmpBuf* = RECORD - bx*, si*, di*, bp*, sp*, pc*: LONGINT; - maskWasSaved*: LONGINT; - savedMask*: ARRAY 32 OF LONGINT; - END ; - - Status* = RECORD (* struct stat *) - dev*, devX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad1: INTEGER; - ino*, mode*, nlink*, uid*, gid*: LONGINT; - rdev*, rdevX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad2: INTEGER; - size*, blksize*, blocks*, atime*, unused1*, mtime*, unused2*, ctime*, - unused3*, unused4*, unused5*: LONGINT; - END ; - - Timeval* = RECORD - sec*, usec*: LONGINT - END ; - - Timezone* = RECORD - minuteswest*, dsttime*: LONGINT - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 8 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - - Dirent* = RECORD - ino, off: LONGINT; - reclen: INTEGER; - name: ARRAY 256 OF CHAR; - END ; - - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - - Iovec* = RECORD - base*, len*: LONGINT - END ; - - SocketPair* = ARRAY 2 OF LONGINT; - - Pollfd* = RECORD - fd*: LONGINT; - events*, revents*: INTEGER - END ; - - Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; - END ; - - HostEntry* = POINTER [1] TO Hostent; - Hostent* = RECORD - name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for read(), write() and sleep() *) - PROCEDURE -includeUnistd() - "#include "; - - (* for system() *) -(* commented, doesn't compile on 32bit GNU/Linux platforms - PROCEDURE -includeStdlib() - "#include "; -*) - (* for nanosleep() *) - PROCEDURE -includeTime() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - PROCEDURE -err(): LONGINT - "errno"; - - PROCEDURE errno*(): LONGINT; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -Fork*(): LONGINT - "fork()"; - - PROCEDURE -Wait*(VAR status: LONGINT): LONGINT - "wait(status)"; - - PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT - "select(width, readfds, writefds, exceptfds, timeout)"; - - PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: LONGINT): LONGINT - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): LONGINT - "pipe(fds)"; - - PROCEDURE -Getpid*(): LONGINT - "getpid()"; - - PROCEDURE -Getuid*(): LONGINT - "getuid()"; - - PROCEDURE -Geteuid*(): LONGINT - "geteuid()"; - - PROCEDURE -Getgid*(): LONGINT - "getgid()"; - - PROCEDURE -Getegid*(): LONGINT - "getegid()"; - - PROCEDURE -Unlink*(name: Name): LONGINT - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: LONGINT): LONGINT - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT - "stat((const char*)name, (struct stat*)statbuf)"; - - PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := stat(name, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT - "fstat(fd, (struct stat*)statbuf)"; - - PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := fstat(fd, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: LONGINT): LONGINT - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): LONGINT - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): LONGINT - "chdir(path)"; - - PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : LONGINT): LONGINT - "sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): LONGINT - "nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): LONGINT - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "send(socket, bufadr, buflen, flags)"; - - PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; - -BEGIN - - StatCheck(); -END Unix. diff --git a/src/system/linux/gcc/x86/Args.Mod b/src/system/linux/gcc/x86/Args.Mod deleted file mode 100644 index c6b7b56e..00000000 --- a/src/system/linux/gcc/x86/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-, argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/linux/gcc/x86/Files.Mod b/src/system/linux/gcc/x86/Files.Mod deleted file mode 100644 index 6307407d..00000000 --- a/src/system/linux/gcc/x86/Files.Mod +++ /dev/null @@ -1,663 +0,0 @@ -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/system/linux/gcc/x86/Files0.Mod b/src/system/linux/gcc/x86/Files0.Mod deleted file mode 100644 index 4f021ede..00000000 --- a/src/system/linux/gcc/x86/Files0.Mod +++ /dev/null @@ -1,635 +0,0 @@ -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/system/linux/gcc/x86/SYSTEM.c0 b/src/system/linux/gcc/x86/SYSTEM.c0 deleted file mode 100644 index 580449aa..00000000 --- a/src/system/linux/gcc/x86/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the Ofront runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(long size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/linux/gcc/x86/SYSTEM.h b/src/system/linux/gcc/x86/SYSTEM.h deleted file mode 100644 index ea9ae5d6..00000000 --- a/src/system/linux/gcc/x86/SYSTEM.h +++ /dev/null @@ -1,220 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -the Ofront runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -gcc for Linux version (same as SPARC/Solaris2) -uses double # as concatenation operator - -*/ - -#include -#include /* for type sizes -- noch */ - -//extern void *memcpy(void *dest, const void *src, long n); -extern void *memcpy(void *dest, const void *src, size_t n); -extern void *malloc(long size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -typedef char BOOLEAN; -typedef unsigned char CHAR; -typedef signed char SHORTINT; -typedef short int INTEGER; -typedef long LONGINT; -typedef float REAL; -typedef double LONGREAL; -typedef unsigned long SET; -typedef void *SYSTEM_PTR; -typedef unsigned char SYSTEM_BYTE; -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned)(x)<<(n)|(unsigned)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned)(x)>>(n)|(unsigned)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/linux/gcc/x86/Unix.Mod b/src/system/linux/gcc/x86/Unix.Mod deleted file mode 100644 index a77bccae..00000000 --- a/src/system/linux/gcc/x86/Unix.Mod +++ /dev/null @@ -1,465 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* system procedure added by noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM; - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - - -TYPE - JmpBuf* = RECORD - bx*, si*, di*, bp*, sp*, pc*: LONGINT; - maskWasSaved*: LONGINT; - savedMask*: ARRAY 32 OF LONGINT; - END ; - - Status* = RECORD (* struct stat *) - dev*, devX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad1: INTEGER; - ino*, mode*, nlink*, uid*, gid*: LONGINT; - rdev*, rdevX*: LONGINT; (* 64 bit in Linux 2.2 *) - pad2: INTEGER; - size*, blksize*, blocks*, atime*, unused1*, mtime*, unused2*, ctime*, - unused3*, unused4*, unused5*: LONGINT; - END ; - - Timeval* = RECORD - sec*, usec*: LONGINT - END ; - - Timezone* = RECORD - minuteswest*, dsttime*: LONGINT - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 8 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - - Dirent* = RECORD - ino, off: LONGINT; - reclen: INTEGER; - name: ARRAY 256 OF CHAR; - END ; - - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - - Iovec* = RECORD - base*, len*: LONGINT - END ; - - SocketPair* = ARRAY 2 OF LONGINT; - - Pollfd* = RECORD - fd*: LONGINT; - events*, revents*: INTEGER - END ; - - Sockaddr* = RECORD - family*: INTEGER; - port*: INTEGER; - internetAddr*: LONGINT; - pad*: ARRAY 8 OF CHAR; - END ; - - HostEntry* = POINTER [1] TO Hostent; - Hostent* = RECORD - name*, aliases*: LONGINT; - addrtype*, length*: LONGINT; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for read(), write() and sleep() *) - PROCEDURE -includeUnistd() - "#include "; - - (* for system() *) -(* commented, doesn't compile on 32bit GNU/Linux platforms - PROCEDURE -includeStdlib() - "#include "; -*) - (* for nanosleep() *) - PROCEDURE -includeTime() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - PROCEDURE -err(): LONGINT - "errno"; - - PROCEDURE errno*(): LONGINT; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -Fork*(): LONGINT - "fork()"; - - PROCEDURE -Wait*(VAR status: LONGINT): LONGINT - "wait(status)"; - - PROCEDURE -Select*(width: LONGINT; VAR readfds, writefds, exceptfds: FdSet; VAR timeout: Timeval): LONGINT - "select(width, readfds, writefds, exceptfds, timeout)"; - - PROCEDURE -Gettimeofday* (VAR tv: Timeval; VAR tz: Timezone) : LONGINT - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd, buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd, buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: LONGINT): LONGINT - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: LONGINT): LONGINT - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): LONGINT - "pipe(fds)"; - - PROCEDURE -Getpid*(): LONGINT - "getpid()"; - - PROCEDURE -Getuid*(): LONGINT - "getuid()"; - - PROCEDURE -Geteuid*(): LONGINT - "geteuid()"; - - PROCEDURE -Getgid*(): LONGINT - "getgid()"; - - PROCEDURE -Getegid*(): LONGINT - "getegid()"; - - PROCEDURE -Unlink*(name: Name): LONGINT - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag, mode: SET): LONGINT - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: LONGINT): LONGINT - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): LONGINT - "stat((const char*)name, (struct stat*)statbuf)"; - - PROCEDURE Stat*(name: Name; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := stat(name, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: LONGINT; VAR statbuf: Status): LONGINT - "fstat(fd, (struct stat*)statbuf)"; - - PROCEDURE Fstat*(fd: LONGINT; VAR statbuf: Status): LONGINT; - VAR res: LONGINT; - BEGIN - res := fstat(fd, statbuf); - (* make the first 4 bytes as unique as possible (used in module Files for caching!) *) - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: LONGINT): LONGINT - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: LONGINT): LONGINT - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd, offset, origin: LONGINT): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: LONGINT): LONGINT - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd, cmd, arg: LONGINT ): LONGINT - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: LONGINT): LONGINT - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd, length: LONGINT): LONGINT - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: LONGINT; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): LONGINT - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): LONGINT - "chdir(path)"; - - PROCEDURE -Ioctl*(fd, request, arg: LONGINT): LONGINT - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: LONGINT): LONGINT - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: LONGINT): LONGINT - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : LONGINT): LONGINT - "sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): LONGINT - "nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): LONGINT - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: LONGINT): LONGINT - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: LONGINT; VAR name: Sockaddr; VAR namelen: LONGINT): LONGINT - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: LONGINT; name: Sockaddr; namelen: LONGINT): LONGINT - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: LONGINT): LONGINT - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: LONGINT; VAR addr: Sockaddr; VAR addrlen: LONGINT): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - PROCEDURE -Send*(socket, bufadr, buflen, flags: LONGINT): LONGINT - "send(socket, bufadr, buflen, flags)"; - - PROCEDURE -sys(str: ARRAY OF CHAR): INTEGER (* need this to call external tools like gcc or gas; noch *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; - -BEGIN - - StatCheck(); -END Unix. diff --git a/src/system/linux/gcc/x86_64/Args.Mod b/src/system/linux/gcc/x86_64/Args.Mod deleted file mode 100644 index 2c0d25b5..00000000 --- a/src/system/linux/gcc/x86_64/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-: INTEGER; argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/linux/gcc/x86_64/Files.Mod b/src/system/linux/gcc/x86_64/Files.Mod deleted file mode 100644 index c8f42ca5..00000000 --- a/src/system/linux/gcc/x86_64/Files.Mod +++ /dev/null @@ -1,664 +0,0 @@ -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/system/linux/gcc/x86_64/Files0.Mod b/src/system/linux/gcc/x86_64/Files0.Mod deleted file mode 100644 index 1d9cd953..00000000 --- a/src/system/linux/gcc/x86_64/Files0.Mod +++ /dev/null @@ -1,636 +0,0 @@ -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/system/linux/gcc/x86_64/SYSTEM.c0 b/src/system/linux/gcc/x86_64/SYSTEM.c0 deleted file mode 100644 index 3d875068..00000000 --- a/src/system/linux/gcc/x86_64/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the voc(jet backend) runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(unsigned long size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/linux/gcc/x86_64/SYSTEM.h b/src/system/linux/gcc/x86_64/SYSTEM.h deleted file mode 100644 index 2c8e71d0..00000000 --- a/src/system/linux/gcc/x86_64/SYSTEM.h +++ /dev/null @@ -1,238 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -voc (jet backend) runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -gcc for Linux version (same as SPARC/Solaris2) -uses double # as concatenation operator - -*/ - -#include -#include /* for type sizes -- noch */ - -extern void *memcpy(void *dest, const void *src, unsigned long n); -extern void *malloc(unsigned long size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -//typedef char BOOLEAN; -#define BOOLEAN char -//typedef unsigned char CHAR; -#define CHAR unsigned char -//exactly two bytes -#define LONGCHAR unsigned short int -//typedef signed char SHORTINT; -#define SHORTINT signed char -//for x86 GNU/Linux -//typedef short int INTEGER; -//for x86_64 GNU/Linux -//typedef int INTEGER; -#define INTEGER int -//typedef long LONGINT; -#define LONGINT long -//typedef float REAL; -#define REAL float -//typedef double LONGREAL; -#define LONGREAL double -//typedef unsigned long SET; -#define SET unsigned long -typedef void *SYSTEM_PTR; -//#define *SYSTEM_PTR void -//typedef unsigned char SYSTEM_BYTE; -#define SYSTEM_BYTE unsigned char -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned t)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) -#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/openbsd/gcc/Console.Mod b/src/system/openbsd/gcc/Console.Mod deleted file mode 100644 index e523ef7b..00000000 --- a/src/system/openbsd/gcc/Console.Mod +++ /dev/null @@ -1,86 +0,0 @@ -MODULE Console; (* J. Templ, 29-June-96 *) - - (* output to Unix standard output device based Write system call *) - - IMPORT SYSTEM; - - VAR line: ARRAY 128 OF CHAR; - pos: INTEGER; - - PROCEDURE -Write(adr, n: LONGINT) - "write(1/*stdout*/, adr, n)"; - - PROCEDURE -read(VAR ch: CHAR): LONGINT - "read(0/*stdin*/, ch, 1)"; - - PROCEDURE Flush*(); - BEGIN - Write(SYSTEM.ADR(line), pos); pos := 0; - END Flush; - - PROCEDURE Char*(ch: CHAR); - BEGIN - IF pos = LEN(line) THEN Flush() END ; - line[pos] := ch; INC(pos); - IF ch = 0AX THEN Flush() END - END Char; - - PROCEDURE String*(s: ARRAY OF CHAR); - VAR i: INTEGER; - BEGIN i := 0; - WHILE s[i] # 0X DO Char(s[i]); INC(i) END - END String; - - PROCEDURE Int*(i, n: LONGINT); - VAR s: ARRAY 32 OF CHAR; i1, k: LONGINT; - BEGIN - IF i = SYSTEM.LSH(LONG(LONG(1)), SIZE(LONGINT)*8 - 1) THEN - IF SIZE(LONGINT) = 8 THEN s := "8085774586302733229"; k := 19 - ELSE s := "8463847412"; k := 10 - END - ELSE - i1 := ABS(i); - s[0] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; k := 1; - WHILE i1 > 0 DO s[k] := CHR(i1 MOD 10 + ORD("0")); i1 := i1 DIV 10; INC(k) END - END ; - IF i < 0 THEN s[k] := "-"; INC(k) END ; - WHILE n > k DO Char(" "); DEC(n) END ; - WHILE k > 0 DO DEC(k); Char(s[k]) END - END Int; - - PROCEDURE Ln*; - BEGIN Char(0AX); (* Unix end-of-line *) - END Ln; - - PROCEDURE Bool*(b: BOOLEAN); - BEGIN IF b THEN String("TRUE") ELSE String("FALSE") END - END Bool; - - PROCEDURE Hex*(i: LONGINT); - VAR k, n: LONGINT; - BEGIN - k := -28; - WHILE k <= 0 DO - n := ASH(i, k) MOD 16; - IF n <= 9 THEN Char(CHR(ORD("0") + n)) ELSE Char(CHR(ORD("A") - 10 + n)) END ; - INC(k, 4) - END - END Hex; - - PROCEDURE Read*(VAR ch: CHAR); - VAR n: LONGINT; - BEGIN Flush(); - n := read(ch); - IF n # 1 THEN ch := 0X END - END Read; - - PROCEDURE ReadLine*(VAR line: ARRAY OF CHAR); - VAR i: LONGINT; ch: CHAR; - BEGIN Flush(); - i := 0; Read(ch); - WHILE (i < LEN(line) - 1) & (ch # 0AX) & (ch # 0X) DO line[i] := ch; INC(i); Read(ch) END ; - line[i] := 0X - END ReadLine; - -BEGIN pos := 0; -END Console. diff --git a/src/system/openbsd/gcc/Kernel.Mod b/src/system/openbsd/gcc/Kernel.Mod deleted file mode 100644 index 73cc80f3..00000000 --- a/src/system/openbsd/gcc/Kernel.Mod +++ /dev/null @@ -1,206 +0,0 @@ -MODULE Kernel; -(* - J. Templ, 16.4.95 - communication with C-runtime and storage management -*) - - IMPORT SYSTEM, Unix, Args; - - TYPE -(* from time.h on OpenBSD; added yday; changed gmtoff, zone order; - sec to isdst changed to INTEGER; -- antranigv - struct tm { - int tm_sec; - int tm_min; - int tm_hour; - int tm_mday; - int tm_mon; - int tm_year; - int tm_wday; - int tm_yday; - int tm_isdst; - long tm_gmtoff; - char *tm_zone; -}; *) - - RealTime = POINTER TO TimeDesc; - TimeDesc = RECORD - sec, min, hour, mday, mon, year, wday, yday, isdst : INTEGER; - gmtoff, zone : LONGINT -(* sec, min, hour, mday, mon, year, wday, isdst, zone, gmtoff: INTEGER*) - END ; - - KeyCmd* = PROCEDURE; - - ObjFinalizer* = PROCEDURE(obj: SYSTEM.PTR); - - - VAR - (* trap handling *) - trapEnv*: Unix.JmpBuf; (* saved stack environment for trap handling *) - - (* oberon heap management *) - nofiles*: LONGINT; - - (* input event handling *) - readSet*, readySet*: Unix.FdSet; - - FKey*: ARRAY 16 OF KeyCmd; - - littleEndian*: BOOLEAN; - - TimeUnit*: LONGINT; (* 1 sec *) - - LIB*, CWD*: ARRAY 256 OF CHAR; - OBERON*: ARRAY 1024 OF CHAR; - - - timeStart: LONGINT; (* milliseconds *) - - PROCEDURE -includesetjmp() - '#include "setjmp.h"'; -(* for localtime *) - PROCEDURE -includetime() - '#include "time.h"'; - - PROCEDURE -Lock*() - "SYSTEM_lock++"; - - PROCEDURE -Unlock*() - "SYSTEM_lock--; if (SYSTEM_interrupted && SYSTEM_lock == 0) __HALT(-9)"; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -sigsetjmp*(VAR env: Unix.JmpBuf; savemask: LONGINT): LONGINT - "__sigsetjmp(env, savemask)"; - - PROCEDURE -siglongjmp*(VAR env:Unix.JmpBuf; val: LONGINT) - "siglongjmp(env, val)"; - - PROCEDURE -heapsize*(): LONGINT - "SYSTEM_heapsize"; - - PROCEDURE -allocated*(): LONGINT - "SYSTEM_allocated"; - - PROCEDURE -localtime(VAR clock: LONGINT): RealTime - "(Kernel_RealTime)localtime(clock)"; - - PROCEDURE -malloc*(size: LONGINT): LONGINT - "(LONGINT)malloc(size)"; - - PROCEDURE -free*(adr: LONGINT) - "(void)free(adr)"; - - PROCEDURE -getcwd(VAR cwd: Unix.Name) - "getcwd(cwd, cwd__len)"; - - - PROCEDURE GetClock* (VAR t, d: LONGINT); - VAR tv: Unix.Timeval; tz: Unix.Timezone; time: RealTime; - l : INTEGER; - BEGIN - l := Unix.Gettimeofday(tv, tz); - time := localtime(tv.sec); - 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 GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - VAR err: ARRAY 25 OF CHAR; - BEGIN err := "not yet implemented"; HALT(99) - END SetClock; - - PROCEDURE Time*(): LONGINT; - VAR timeval: Unix.Timeval; timezone: Unix.Timezone; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(timeval, timezone); - RETURN (timeval.usec DIV 1000 + timeval.sec * 1000 - timeStart) MOD 7FFFFFFFH - END Time; - -(* - PROCEDURE UserTime*(): LONGINT; - VAR rusage: Unix.Rusage; - BEGIN - Unix.Getrusage(0, S.ADR(rusage)); - RETURN rusage.utime.sec*1000 + rusage.utime.usec DIV 1000 - (* + rusage.stime.sec*1000 + rusage.stime.usec DIV 1000*) - END UserTime; -*) - - PROCEDURE Select*(delay: LONGINT); - VAR rs, ws, xs: Unix.FdSet; n: LONGINT; tv: Unix.Timeval; - BEGIN - rs := readSet; - FOR n := 0 TO 7 DO ws[n] := {}; xs[n] := {}; readySet[n] := {} END; - IF delay < 0 THEN delay := 0 END ; - tv.sec := delay DIV 1000; tv.usec := delay MOD 1000 * 1000; - n := Unix.Select(256, rs, ws, xs, tv); - IF n >= 0 THEN readySet := rs END - END Select; - - PROCEDURE -GC*(markStack: BOOLEAN) - "SYSTEM_GC(markStack)"; - - PROCEDURE -RegisterObject*(obj: SYSTEM.PTR; finalize: ObjFinalizer) - "SYSTEM_REGFIN(obj, finalize)"; - - PROCEDURE -SetHalt*(p: PROCEDURE(n: LONGINT)) - "SYSTEM_Halt = p"; - - PROCEDURE InstallTermHandler*(p: PROCEDURE); - (* not yet supported; no Modules.Free *) - END InstallTermHandler; - - PROCEDURE LargestAvailable*(): LONGINT; - BEGIN - (* dummy proc for System 3 compatibility - no meaningful value except may be the remaining swap space can be returned - in the context of an extensible heap *) - RETURN MAX(LONGINT) - END LargestAvailable; - - PROCEDURE Halt(n: LONGINT); - VAR res: LONGINT; - BEGIN res := Unix.Kill(Unix.Getpid(), 4); - END Halt; - - PROCEDURE EndianTest; - VAR i: LONGINT; dmy: INTEGER; - BEGIN - dmy := 1; i := SYSTEM.ADR(dmy); - SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *) - END EndianTest; - - PROCEDURE -SizeofUnixJmpBuf(): INTEGER - "sizeof(Unix_JmpBuf)"; - - PROCEDURE -SizeofSigJmpBuf(): INTEGER - "sizeof(sigjmp_buf)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE JmpBufCheck; (* check for inconsistent usage of sigjmp_buf *) - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixJmpBuf(); - y := SizeofSigJmpBuf(); - IF x < y THEN - Error("Kernel.JmpBufCheck: inconsistent usage of sigjmp_buf", 52); - Exit(1); - END - END JmpBufCheck; - -BEGIN - EndianTest(); - SetHalt(Halt); - CWD := ""; OBERON := "."; LIB := ""; - getcwd(CWD); - Args.GetEnv("OBERON", OBERON); - Args.GetEnv("OBERON_LIB", LIB); - TimeUnit := 1000; timeStart := 0; timeStart := Time(); - JmpBufCheck() -END Kernel. diff --git a/src/system/openbsd/gcc/Kernel0.Mod b/src/system/openbsd/gcc/Kernel0.Mod deleted file mode 100644 index dd44b415..00000000 --- a/src/system/openbsd/gcc/Kernel0.Mod +++ /dev/null @@ -1,217 +0,0 @@ -MODULE Kernel0; -(* - J. Templ, 16.4.95 - communication with C-runtime and storage management -*) -(* version for bootstrapping voc *) - - IMPORT SYSTEM, Unix, Args, Strings, version; - - TYPE -(* from time.h on OpenBSD; added yday; changed gmtoff, zone order; - sec to isdst changed to INTEGER; -- antranigv - struct tm { - int tm_sec; - int tm_min; - int tm_hour; - int tm_mday; - int tm_mon; - int tm_year; - int tm_wday; - int tm_yday; - int tm_isdst; - long tm_gmtoff; - char *tm_zone; -}; *) - - RealTime = POINTER TO TimeDesc; - TimeDesc = RECORD - sec, min, hour, mday, mon, year, wday, yday, isdst : INTEGER; - gmtoff, zone : LONGINT -(* sec, min, hour, mday, mon, year, wday, isdst, zone, gmtoff: INTEGER*) - END ; - - KeyCmd* = PROCEDURE; - - ObjFinalizer* = PROCEDURE(obj: SYSTEM.PTR); - - - VAR - (* trap handling *) - trapEnv*: Unix.JmpBuf; (* saved stack environment for trap handling *) - - (* oberon heap management *) - nofiles*: LONGINT; - - (* input event handling *) - readSet*, readySet*: Unix.FdSet; - - FKey*: ARRAY 16 OF KeyCmd; - - littleEndian*: BOOLEAN; - - TimeUnit*: LONGINT; (* 1 sec *) - - LIB*, CWD*: ARRAY 256 OF CHAR; - OBERON*: ARRAY 1024 OF CHAR; - MODULES-: ARRAY 1024 OF CHAR; - - prefix*, fullprefix* : ARRAY 256 OF CHAR; - timeStart: LONGINT; (* milliseconds *) - - - PROCEDURE -includesetjmp() - '#include "setjmp.h"'; -(* for localtime *) - PROCEDURE -includetime() - '#include "time.h"'; - - PROCEDURE -Lock*() - "SYSTEM_lock++"; - - PROCEDURE -Unlock*() - "SYSTEM_lock--; if (SYSTEM_interrupted && SYSTEM_lock == 0) __HALT(-9)"; - - PROCEDURE -Exit*(n: LONGINT) - "exit(n)"; - - PROCEDURE -sigsetjmp*(VAR env: Unix.JmpBuf; savemask: LONGINT): LONGINT - "__sigsetjmp(env, savemask)"; - - PROCEDURE -siglongjmp*(VAR env:Unix.JmpBuf; val: LONGINT) - "siglongjmp(env, val)"; - - PROCEDURE -heapsize*(): LONGINT - "SYSTEM_heapsize"; - - PROCEDURE -allocated*(): LONGINT - "SYSTEM_allocated"; - - PROCEDURE -localtime(VAR clock: LONGINT): RealTime - "(Kernel0_RealTime)localtime(clock)"; - - PROCEDURE -malloc*(size: LONGINT): LONGINT - "(LONGINT)malloc(size)"; - - PROCEDURE -free*(adr: LONGINT) - "(void)free(adr)"; - - PROCEDURE -getcwd(VAR cwd: Unix.Name) - "getcwd(cwd, cwd__len)"; - - - PROCEDURE GetClock* (VAR t, d: LONGINT); - VAR tv: Unix.Timeval; tz: Unix.Timezone; time: RealTime; - l : INTEGER; - BEGIN - l := Unix.Gettimeofday(tv, tz); - time := localtime(tv.sec); - 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 GetClock; - - PROCEDURE SetClock* (t, d: LONGINT); - VAR err: ARRAY 25 OF CHAR; - BEGIN err := "not yet implemented"; HALT(99) - END SetClock; - - PROCEDURE Time*(): LONGINT; - VAR timeval: Unix.Timeval; timezone: Unix.Timezone; - l : LONGINT; - BEGIN - l := Unix.Gettimeofday(timeval, timezone); - RETURN (timeval.usec DIV 1000 + timeval.sec * 1000 - timeStart) MOD 7FFFFFFFH - END Time; - -(* - PROCEDURE UserTime*(): LONGINT; - VAR rusage: Unix.Rusage; - BEGIN - Unix.Getrusage(0, S.ADR(rusage)); - RETURN rusage.utime.sec*1000 + rusage.utime.usec DIV 1000 - (* + rusage.stime.sec*1000 + rusage.stime.usec DIV 1000*) - END UserTime; -*) - - PROCEDURE Select*(delay: LONGINT); - VAR rs, ws, xs: Unix.FdSet; n: LONGINT; tv: Unix.Timeval; - BEGIN - rs := readSet; - FOR n := 0 TO 7 DO ws[n] := {}; xs[n] := {}; readySet[n] := {} END; - IF delay < 0 THEN delay := 0 END ; - tv.sec := delay DIV 1000; tv.usec := delay MOD 1000 * 1000; - n := Unix.Select(256, rs, ws, xs, tv); - IF n >= 0 THEN readySet := rs END - END Select; - - PROCEDURE -GC*(markStack: BOOLEAN) - "SYSTEM_GC(markStack)"; - - PROCEDURE -RegisterObject*(obj: SYSTEM.PTR; finalize: ObjFinalizer) - "SYSTEM_REGFIN(obj, finalize)"; - - PROCEDURE -SetHalt*(p: PROCEDURE(n: LONGINT)) - "SYSTEM_Halt = p"; - - PROCEDURE InstallTermHandler*(p: PROCEDURE); - (* not yet supported; no Modules.Free *) - END InstallTermHandler; - - PROCEDURE LargestAvailable*(): LONGINT; - BEGIN - (* dummy proc for System 3 compatibility - no meaningful value except may be the remaining swap space can be returned - in the context of an extensible heap *) - RETURN MAX(LONGINT) - END LargestAvailable; - - PROCEDURE Halt(n: LONGINT); - VAR res: LONGINT; - BEGIN res := Unix.Kill(Unix.Getpid(), 4); - END Halt; - - PROCEDURE EndianTest; - VAR i: LONGINT; dmy: INTEGER; - BEGIN - dmy := 1; i := SYSTEM.ADR(dmy); - SYSTEM.GET(i, littleEndian); (* indirection via i avoids warning on SUN cc -O *) - END EndianTest; - - PROCEDURE -SizeofUnixJmpBuf(): INTEGER - "sizeof(Unix_JmpBuf)"; - - PROCEDURE -SizeofSigJmpBuf(): INTEGER - "sizeof(sigjmp_buf)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE JmpBufCheck; (* check for inconsistent usage of sigjmp_buf *) - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixJmpBuf(); - y := SizeofSigJmpBuf(); - IF x < y THEN - Error("Kernel.JmpBufCheck: inconsistent usage of sigjmp_buf", 52); - Exit(1); - END - END JmpBufCheck; - -BEGIN - EndianTest(); - SetHalt(Halt); - CWD := ""; OBERON := "."; LIB := ""; - MODULES := ""; (* additional modules path which can be specified on commandline and will be added to the OBERON variable; noch *) - getcwd(CWD); - Args.GetEnv ("MODULES", MODULES); - Args.GetEnv("OBERON", OBERON); - (* always have current directory in module search path, noch *) - Strings.Append(":.:", OBERON); - Strings.Append(MODULES, OBERON); - Strings.Append(":", OBERON); - Strings.Append(version.prefix, OBERON); - Strings.Append("/lib/voc/sym:", OBERON); - Args.GetEnv("OBERON_LIB", LIB); - TimeUnit := 1000; timeStart := 0; timeStart := Time(); - JmpBufCheck() -END Kernel0. diff --git a/src/system/openbsd/gcc/SYSTEM.Mod b/src/system/openbsd/gcc/SYSTEM.Mod deleted file mode 100644 index 6fc08dcf..00000000 --- a/src/system/openbsd/gcc/SYSTEM.Mod +++ /dev/null @@ -1,520 +0,0 @@ -(* -* voc (jet backend) runtime system, Version 1.1 -* -* Copyright (c) Software Templ, 1994, 1995, 1996 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -*) - -MODULE SYSTEM; (* J. Templ, 31.5.95 *) - - IMPORT SYSTEM; (*must not import other modules*) - - CONST - ModNameLen = 20; - CmdNameLen = 24; - SZL = SIZE(LONGINT); - Unit = 4*SZL; (* smallest possible heap block *) - nofLists = 9; (* number of free_lists *) - heapSize0 = 8000*Unit; (* startup heap size *) - - (* all blocks look the same: - free blocks describe themselves: size = Unit - tag = &tag++ - ->blksize - sentinel = -SZL - next - *) - - (* heap chunks *) - nextChnkOff = 0; (* next heap chunk, sorted ascendingly! *) - endOff = SZL; (* end of heap chunk *) - blkOff = 3*SZL; (* first block in a chunk *) - - (* heap blocks *) - tagOff = 0; (* block starts with tag *) - sizeOff = SZL; (* block size in free block relative to block start *) - sntlOff = 2*SZL; (* pointer offset table sentinel in free block relative to block start *) - nextOff = 3*SZL; (* next pointer in free block relative to block start *) - NoPtrSntl = LONG(LONG(-SZL)); - - - TYPE - ModuleName = ARRAY ModNameLen OF CHAR; - CmdName = ARRAY CmdNameLen OF CHAR; - - Module = POINTER TO ModuleDesc; - Cmd = POINTER TO CmdDesc; - EnumProc = PROCEDURE(P: PROCEDURE(p: SYSTEM.PTR)); - ModuleDesc = RECORD - next: Module; - name: ModuleName; - refcnt: LONGINT; - cmds: Cmd; - types: LONGINT; - enumPtrs: EnumProc; - reserved1, reserved2: LONGINT - END ; - - Command = PROCEDURE; - - CmdDesc = RECORD - next: Cmd; - name: CmdName; - cmd: Command - END ; - - Finalizer = PROCEDURE(obj: SYSTEM.PTR); - - FinNode = POINTER TO FinDesc; - FinDesc = RECORD - next: FinNode; - obj: LONGINT; (* weak pointer *) - marked: BOOLEAN; - finalize: Finalizer; - END ; - - VAR - (* the list of loaded (=initialization started) modules *) - modules*: SYSTEM.PTR; - - freeList: ARRAY nofLists + 1 OF LONGINT; (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *) - bigBlocks, allocated*: LONGINT; - firstTry: BOOLEAN; - - (* extensible heap *) - heap, (* the sorted list of heap chunks *) - heapend, (* max possible pointer value (used for stack collection) *) - heapsize*: LONGINT; (* the sum of all heap chunk sizes *) - - (* finalization candidates *) - fin: FinNode; - - (* garbage collector locking *) - gclock*: SHORTINT; - - - PROCEDURE -malloc(size: LONGINT): LONGINT "(LONGINT)malloc(size)"; - PROCEDURE -Lock() "Lock"; - PROCEDURE -Unlock() "Unlock"; - PROCEDURE -Mainfrm(): LONGINT "SYSTEM_mainfrm"; -(* - 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 REGMOD*(VAR name: ModuleName; enumPtrs: EnumProc): SYSTEM.PTR; - VAR m: Module; - BEGIN - IF name = "SYSTEM" THEN (* cannot use NEW *) - SYSTEM.NEW(m, SIZE(ModuleDesc)); m.cmds := NIL - ELSE NEW(m) - END ; - COPY(name, m.name); m.refcnt := 0; m.enumPtrs := enumPtrs; m.next := SYSTEM.VAL(Module, modules); - modules := m; - RETURN m - END REGMOD; - - PROCEDURE REGCMD*(m: Module; VAR name: CmdName; cmd: Command); - VAR c: Cmd; - BEGIN NEW(c); - COPY(name, c.name); c.cmd := cmd; c.next := m.cmds; m.cmds := c - END REGCMD; - - PROCEDURE REGTYP*(m: Module; typ: LONGINT); - BEGIN SYSTEM.PUT(typ, m.types); m.types := typ - END REGTYP; - - PROCEDURE INCREF*(m: Module); - BEGIN INC(m.refcnt) - END INCREF; - - PROCEDURE NewChunk(blksz: LONGINT): LONGINT; - VAR chnk: LONGINT; - BEGIN - chnk := malloc(blksz + blkOff); - IF chnk # 0 THEN - SYSTEM.PUT(chnk + endOff, chnk + (blkOff + blksz)); - SYSTEM.PUT(chnk + blkOff, chnk + (blkOff + sizeOff)); - SYSTEM.PUT(chnk + (blkOff + sizeOff), blksz); - SYSTEM.PUT(chnk + (blkOff + sntlOff), NoPtrSntl); - SYSTEM.PUT(chnk + (blkOff + nextOff), bigBlocks); - bigBlocks := chnk + blkOff; - INC(heapsize, blksz) - END ; - RETURN chnk - END NewChunk; - - PROCEDURE ExtendHeap(blksz: LONGINT); - VAR size, chnk, j, next: LONGINT; - BEGIN - IF blksz > 10000*Unit THEN size := blksz - ELSE size := 10000*Unit (* additional heuristics *) - END ; - chnk := NewChunk(size); - IF chnk # 0 THEN - (*sorted insertion*) - IF chnk < heap THEN - SYSTEM.PUT(chnk, heap); heap := chnk - ELSE - j := heap; SYSTEM.GET(j, next); - WHILE (next # 0) & (chnk > next) DO j := next; SYSTEM.GET(j, next) END ; - SYSTEM.PUT(chnk, next); SYSTEM.PUT(j, chnk) - END ; - IF next = 0 THEN SYSTEM.GET(chnk + endOff, heapend) END - END - END ExtendHeap; - - PROCEDURE ^GC*(markStack: BOOLEAN); - - PROCEDURE NEWREC*(tag: LONGINT): SYSTEM.PTR; - VAR i, i0, di, blksz, restsize, t, adr, end, next, prev: LONGINT; new: SYSTEM.PTR; - BEGIN - Lock(); - SYSTEM.GET(tag, blksz); - ASSERT(blksz MOD Unit = 0); - i0 := blksz DIV Unit; i := i0; - IF i < nofLists THEN adr := freeList[i]; - WHILE adr = 0 DO INC(i); adr := freeList[i] END - END ; - IF i < nofLists THEN (* unlink *) - SYSTEM.GET(adr + nextOff, next); - freeList[i] := next; - IF i # i0 THEN (* split *) - di := i - i0; restsize := di * Unit; end := adr + restsize; - SYSTEM.PUT(end + sizeOff, blksz); - SYSTEM.PUT(end + sntlOff, NoPtrSntl); - SYSTEM.PUT(end, end + sizeOff); - SYSTEM.PUT(adr + sizeOff, restsize); - SYSTEM.PUT(adr + nextOff, freeList[di]); - freeList[di] := adr; - INC(adr, restsize) - END - ELSE - adr := bigBlocks; prev := 0; - LOOP - IF adr = 0 THEN - IF firstTry THEN - GC(TRUE); INC(blksz, Unit); - IF (heapsize - allocated - blksz) * 4 < heapsize THEN - (* heap is still almost full; expand to avoid thrashing *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize) - END ; - firstTry := FALSE; new := NEWREC(tag); firstTry := TRUE; - IF new = NIL THEN - (* depending on the fragmentation, the heap may not have been extended by - the anti-thrashing heuristics above *) - ExtendHeap((allocated + blksz) DIV (3*Unit) * (4*Unit) - heapsize); - new := NEWREC(tag); (* will find a free block if heap has been expanded properly *) - END ; - Unlock(); RETURN new - ELSE - Unlock(); RETURN NIL - END - END ; - SYSTEM.GET(adr+sizeOff, t); - IF t >= blksz THEN EXIT END ; - prev := adr; SYSTEM.GET(adr + nextOff, adr) - END ; - restsize := t - blksz; end := adr + restsize; - SYSTEM.PUT(end + sizeOff, blksz); - SYSTEM.PUT(end + sntlOff, NoPtrSntl); - SYSTEM.PUT(end, end + sizeOff); - IF restsize > nofLists * Unit THEN (*resize*) - SYSTEM.PUT(adr + sizeOff, restsize) - ELSE (*unlink*) - SYSTEM.GET(adr + nextOff, next); - IF prev = 0 THEN bigBlocks := next - ELSE SYSTEM.PUT(prev + nextOff, next); - END ; - IF restsize > 0 THEN (*move*) - di := restsize DIV Unit; - SYSTEM.PUT(adr + sizeOff, restsize); - SYSTEM.PUT(adr + nextOff, freeList[di]); - freeList[di] := adr - END - END ; - INC(adr, restsize) - END ; - i := adr + 4*SZL; end := adr + blksz; - WHILE i < end DO (*deliberately unrolled*) - SYSTEM.PUT(i, LONG(LONG(0))); - SYSTEM.PUT(i + SZL, LONG(LONG(0))); - SYSTEM.PUT(i + 2*SZL, LONG(LONG(0))); - SYSTEM.PUT(i + 3*SZL, LONG(LONG(0))); - INC(i, 4*SZL) - END ; - SYSTEM.PUT(adr + nextOff, LONG(LONG(0))); - SYSTEM.PUT(adr, tag); - SYSTEM.PUT(adr + sizeOff, LONG(LONG(0))); - SYSTEM.PUT(adr + sntlOff, LONG(LONG(0))); - INC(allocated, blksz); - Unlock(); - RETURN SYSTEM.VAL(SYSTEM.PTR, adr + SZL) - END NEWREC; - - PROCEDURE NEWBLK*(size: LONGINT): SYSTEM.PTR; - VAR blksz, tag: LONGINT; new: SYSTEM.PTR; - BEGIN - Lock(); - blksz := (size + (4*SZL + Unit - 1)) DIV Unit * Unit; (*size + tag + meta + blksz + sntnl + UnitAlignment*) - new := NEWREC(SYSTEM.ADR(blksz)); - tag := SYSTEM.VAL(LONGINT, new) + blksz - 3*SZL; - SYSTEM.PUT(tag - SZL, LONG(LONG(0))); (*reserved for meta info*) - SYSTEM.PUT(tag, blksz); - SYSTEM.PUT(tag + SZL, NoPtrSntl); - SYSTEM.PUT(SYSTEM.VAL(LONGINT, new) - SZL, tag); - Unlock(); - RETURN new - END NEWBLK; - - PROCEDURE Mark(q: LONGINT); - VAR p, tag, fld, n, offset, tagbits: LONGINT; - BEGIN - IF q # 0 THEN SYSTEM.GET(q - SZL, tagbits); - IF ~ODD(tagbits) THEN - SYSTEM.PUT(q - SZL, tagbits + 1); - p := 0; tag := tagbits + SZL; - LOOP - SYSTEM.GET(tag, offset); - IF offset < 0 THEN - SYSTEM.PUT(q - SZL, tag + offset + 1); - IF p = 0 THEN EXIT END ; - n := q; q := p; - SYSTEM.GET(q - SZL, tag); DEC(tag, 1); - SYSTEM.GET(tag, offset); fld := q + offset; - SYSTEM.GET(fld, p); SYSTEM.PUT(fld, n) - ELSE - fld := q + offset; - SYSTEM.GET(fld, n); - IF n # 0 THEN - SYSTEM.GET(n - SZL, tagbits); - IF ~ODD(tagbits) THEN - SYSTEM.PUT(n - SZL, tagbits + 1); - SYSTEM.PUT(q - SZL, tag + 1); - SYSTEM.PUT(fld, p); p := q; q := n; - tag := tagbits - END - END - END ; - INC(tag, SZL) - END - END - END - END Mark; - - PROCEDURE MarkP(p: SYSTEM.PTR); (* for compatibility with EnumPtrs in ANSI mode *) - BEGIN - Mark(SYSTEM.VAL(LONGINT, p)) - END MarkP; - - PROCEDURE Scan; - VAR chnk, adr, end, start, tag, i, size, freesize: LONGINT; - BEGIN bigBlocks := 0; i := 1; - WHILE i < nofLists DO freeList[i] := 0; INC(i) END ; - freesize := 0; allocated := 0; chnk := heap; - WHILE chnk # 0 DO - adr := chnk + blkOff; SYSTEM.GET(chnk + endOff, end); - WHILE adr < end DO - SYSTEM.GET(adr, tag); - IF ODD(tag) THEN (*marked*) - IF freesize > 0 THEN - start := adr - freesize; - SYSTEM.PUT(start, start+SZL); - SYSTEM.PUT(start+sizeOff, freesize); - SYSTEM.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; - IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start - ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start - END - END ; - DEC(tag, 1); - SYSTEM.PUT(adr, tag); - SYSTEM.GET(tag, size); - INC(allocated, size); - INC(adr, size) - ELSE (*unmarked*) - SYSTEM.GET(tag, size); - INC(freesize, size); - INC(adr, size) - END - END ; - IF freesize > 0 THEN (*collect last block*) - start := adr - freesize; - SYSTEM.PUT(start, start+SZL); - SYSTEM.PUT(start+sizeOff, freesize); - SYSTEM.PUT(start+sntlOff, NoPtrSntl); - i := freesize DIV Unit; freesize := 0; - IF i < nofLists THEN SYSTEM.PUT(start + nextOff, freeList[i]); freeList[i] := start - ELSE SYSTEM.PUT(start + nextOff, bigBlocks); bigBlocks := start - END - END ; - SYSTEM.GET(chnk, chnk) - END - END Scan; - - PROCEDURE Sift (l, r: LONGINT; VAR a: ARRAY OF LONGINT); - VAR i, j, x: LONGINT; - BEGIN j := l; x := a[j]; - LOOP i := j; j := 2*j + 1; - IF (j < r) & (a[j] < a[j+1]) THEN INC(j) END; - IF (j > r) OR (a[j] <= x) THEN EXIT END; - a[i] := a[j] - END; - a[i] := x - END Sift; - - PROCEDURE HeapSort (n: LONGINT; VAR a: ARRAY OF LONGINT); - VAR l, r, x: LONGINT; - BEGIN l := n DIV 2; r := n - 1; - WHILE l > 0 DO DEC(l); Sift(l, r, a) END; - WHILE r > 0 DO x := a[0]; a[0] := a[r]; a[r] := x; DEC(r); Sift(l, r, a) END - END HeapSort; - - PROCEDURE MarkCandidates(n: LONGINT; VAR cand: ARRAY OF LONGINT); - VAR chnk, adr, tag, next, lim, lim1, i, ptr, size: LONGINT; - BEGIN - chnk := heap; i := 0; lim := cand[n-1]; - WHILE (chnk # 0 ) & (chnk < lim) DO - adr := chnk + blkOff; - SYSTEM.GET(chnk + endOff, lim1); - IF lim < lim1 THEN lim1 := lim END ; - WHILE adr < lim1 DO - SYSTEM.GET(adr, tag); - IF ODD(tag) THEN (*already marked*) - SYSTEM.GET(tag-1, size); INC(adr, size) - ELSE - SYSTEM.GET(tag, size); - ptr := adr + SZL; - WHILE cand[i] < ptr DO INC(i) END ; - IF i = n THEN RETURN END ; - next := adr + size; - IF cand[i] < next THEN Mark(ptr) END ; - adr := next - END - END ; - SYSTEM.GET(chnk, chnk) - END - END MarkCandidates; - - PROCEDURE CheckFin; - VAR n: FinNode; tag: LONGINT; - BEGIN n := fin; - WHILE n # NIL DO - SYSTEM.GET(n.obj - SZL, tag); - IF ~ODD(tag) THEN n.marked := FALSE; Mark(n.obj) - ELSE n.marked := TRUE - END ; - n := n.next - END - END CheckFin; - - PROCEDURE Finalize; - VAR n, prev: FinNode; - BEGIN n := fin; prev := NIL; - WHILE n # NIL DO - IF ~n.marked THEN - IF n = fin THEN fin := fin.next ELSE prev.next := n.next END ; - n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj)); - (* new nodes may have been pushed in n.finalize, therefore: *) - IF prev = NIL THEN n := fin ELSE n := n.next END - ELSE prev := n; n := n.next - END - END - END Finalize; - - PROCEDURE FINALL*; - VAR n: FinNode; - BEGIN - WHILE fin # NIL DO - n := fin; fin := fin.next; - n.finalize(SYSTEM.VAL(SYSTEM.PTR, n.obj)) - END - END FINALL; - - PROCEDURE MarkStack(n: LONGINT; VAR cand: ARRAY OF LONGINT); - VAR - frame: SYSTEM.PTR; - inc, nofcand: LONGINT; - sp, p, stack0, ptr: LONGINT; - align: RECORD ch: CHAR; p: SYSTEM.PTR END ; - BEGIN - IF n > 0 THEN MarkStack(n-1, cand); (* flush register windows by means of recursive calls *) - IF n > 100 THEN RETURN END (* prevent tail recursion optimization *) - END ; - IF n = 0 THEN - nofcand := 0; sp := SYSTEM.ADR(frame); - stack0 := Mainfrm(); - (* check for minimum alignment of pointers *) - inc := SYSTEM.ADR(align.p) - SYSTEM.ADR(align); - IF sp > stack0 THEN inc := -inc END ; - WHILE sp # stack0 DO - SYSTEM.GET(sp, p); - IF (p > heap) & (p < heapend) THEN - IF nofcand = LEN(cand) THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand); nofcand := 0 END ; - cand[nofcand] := p; INC(nofcand) - END ; - INC(sp, inc) - END ; - IF nofcand > 0 THEN HeapSort(nofcand, cand); MarkCandidates(nofcand, cand) END - END - END MarkStack; - - PROCEDURE GC*(markStack: BOOLEAN); - VAR - m: Module; - i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, i21, i22, i23: LONGINT; - cand: ARRAY 10000 OF LONGINT; - BEGIN - IF (gclock = 0) OR (gclock = 1) & ~markStack THEN - Lock(); - m := SYSTEM.VAL(Module, modules); - WHILE m # NIL DO - IF m.enumPtrs # NIL THEN m.enumPtrs(MarkP) END ; - m := m^.next - END ; - IF markStack THEN - (* generate register pressure to force callee saved registers to memory; - may be simplified by inlining OS calls or processor specific instructions - *) - i0 := -100; i1 := -101; i2 := -102; i3 := -103; i4 := -104; i5 := -105; i6 := -106; i7 := -107; - i8 := 1; i9 := 2; i10 := 3; i11 := 4; i12 := 5; i13 := 6; i14 := 7; i15 := 8; - i16 := 9; i17 := 10; i18 := 11; i19 := 12; i20 := 13; i21 := 14; i22 := 15; i23 := 16; - LOOP INC(i0, 1); INC(i1, 2); INC(i2, 3); INC(i3, 4); INC(i4, 5); INC(i5, 6); INC(i6, 7); INC(i7, 8); - INC(i8, 9); INC(i9, 10); INC(i10, 11); INC(i11, 12); INC(i12, 13); INC(i13, 14); INC(i14, 15); INC(i15, 16); - INC(i16, 17); INC(i17, 18); INC(i18, 19); INC(i19, 20); INC(i20, 21); INC(i21, 22); INC(i22, 23); INC(i23, 24); - IF (i0 = -99) & (i15 = 24) THEN MarkStack(32, cand); EXIT END - END ; - IF i0 + i1 + i2 + i3 + i4 + i5 + i6 + i7 + i8 + i9 + i10 + i11 + i12 + i13 + i14 + i15 - + i16 + i17 + i18 + i19 + i20 + i21 + i22 + i23 > 10000 THEN RETURN (* use all variables *) - END ; - END; - CheckFin; - Scan; - Finalize; - Unlock() - END - END GC; - - PROCEDURE REGFIN*(obj: SYSTEM.PTR; finalize: Finalizer); - VAR f: FinNode; - BEGIN NEW(f); - f.obj := SYSTEM.VAL(LONGINT, obj); f.finalize := finalize; f.marked := TRUE; f.next := fin; fin := f - END REGFIN; - - PROCEDURE InitHeap; (* initialized before body to enable NEW, SYSTEM.NEW *) - BEGIN - heap := NewChunk(heapSize0); - SYSTEM.GET(heap + endOff, heapend); - SYSTEM.PUT(heap, LONG(LONG(0))); - allocated := 0; firstTry := TRUE; freeList[nofLists] := 1; gclock := 0 - END InitHeap; - -END SYSTEM. diff --git a/src/system/openbsd/gcc/x86_64/Args.Mod b/src/system/openbsd/gcc/x86_64/Args.Mod deleted file mode 100644 index 2c0d25b5..00000000 --- a/src/system/openbsd/gcc/x86_64/Args.Mod +++ /dev/null @@ -1,65 +0,0 @@ -MODULE Args; (* jt, 8.12.94 *) - - (* command line argument handling for voc (jet backend) *) - - - IMPORT SYSTEM; - - TYPE - ArgPtr = POINTER TO ARRAY 1024 OF CHAR; - ArgVec = POINTER TO ARRAY 1024 OF ArgPtr; - - VAR argc-: INTEGER; argv-: LONGINT; - (*PROCEDURE -includestdlib() "#include ";*) - PROCEDURE -externgetenv() "extern char *getenv(const char *name);"; (* took this from stdlib.h*) - PROCEDURE -Argc(): INTEGER "SYSTEM_argc"; - PROCEDURE -Argv(): LONGINT "(long)SYSTEM_argv"; - PROCEDURE -getenv(var: ARRAY OF CHAR): ArgPtr - "(Args_ArgPtr)getenv(var)"; - - PROCEDURE Get*(n: INTEGER; VAR val: ARRAY OF CHAR); - VAR av: ArgVec; - BEGIN - IF n < argc THEN av := SYSTEM.VAL(ArgVec, argv); COPY(av[n]^, val) END - END Get; - - PROCEDURE GetInt*(n: INTEGER; VAR val: LONGINT); - VAR s: ARRAY 64 OF CHAR; k, d, i: LONGINT; - BEGIN - s := ""; Get(n, s); i := 0; - IF s[0] = "-" THEN i := 1 END ; - k := 0; d := ORD(s[i]) - ORD("0"); - WHILE (d >= 0 ) & (d <= 9) DO k := k*10 + d; INC(i); d := ORD(s[i]) - ORD("0") END ; - IF s[0] = "-" THEN d := -d; DEC(i) END ; - IF i > 0 THEN val := k END - END GetInt; - - PROCEDURE Pos*(s: ARRAY OF CHAR): INTEGER; - VAR i: INTEGER; arg: ARRAY 256 OF CHAR; - BEGIN - i := 0; Get(i, arg); - WHILE (i < argc) & (s # arg) DO INC(i); Get(i, arg) END ; - RETURN i - END Pos; - - PROCEDURE GetEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR); - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN COPY(p^, val) END - END GetEnv; - - PROCEDURE getEnv*(var: ARRAY OF CHAR; VAR val: ARRAY OF CHAR): BOOLEAN; - VAR p: ArgPtr; - BEGIN - p := getenv(var); - IF p # NIL THEN - COPY(p^, val); - RETURN TRUE - ELSE - RETURN FALSE - END - END getEnv; - -BEGIN argc := Argc(); argv := Argv() -END Args. diff --git a/src/system/openbsd/gcc/x86_64/Files.Mod b/src/system/openbsd/gcc/x86_64/Files.Mod deleted file mode 100644 index 344cb213..00000000 --- a/src/system/openbsd/gcc/x86_64/Files.Mod +++ /dev/null @@ -1,681 +0,0 @@ -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 ; - -(* from time.h on OpenBSD; added yday; changed gmtoff, zone order; - sec to isdst changed to INTEGER; -- antranigv - struct tm { - int tm_sec; - int tm_min; - int tm_hour; - int tm_mday; - int tm_mon; - int tm_year; - int tm_wday; - int tm_yday; - int tm_isdst; - long tm_gmtoff; - char *tm_zone; -}; *) - - Time = POINTER TO TimeDesc; - TimeDesc = RECORD - sec, min, hour, mday, mon, year, wday, yday, isdst : INTEGER; - gmtoff, zone : 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/system/openbsd/gcc/x86_64/Files0.Mod b/src/system/openbsd/gcc/x86_64/Files0.Mod deleted file mode 100644 index 4d2661fd..00000000 --- a/src/system/openbsd/gcc/x86_64/Files0.Mod +++ /dev/null @@ -1,653 +0,0 @@ -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 ; - -(* from time.h on OpenBSD; added yday; changed gmtoff, zone order; - sec to isdst changed to INTEGER; -- antranigv - struct tm { - int tm_sec; - int tm_min; - int tm_hour; - int tm_mday; - int tm_mon; - int tm_year; - int tm_wday; - int tm_yday; - int tm_isdst; - long tm_gmtoff; - char *tm_zone; -}; *) - - Time = POINTER TO TimeDesc; - TimeDesc = RECORD - sec, min, hour, mday, mon, year, wday, yday, isdst : INTEGER; - gmtoff, zone : 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/system/openbsd/gcc/x86_64/SYSTEM.c0 b/src/system/openbsd/gcc/x86_64/SYSTEM.c0 deleted file mode 100644 index 3d875068..00000000 --- a/src/system/openbsd/gcc/x86_64/SYSTEM.c0 +++ /dev/null @@ -1,205 +0,0 @@ -/* -* The body prefix file of the voc(jet backend) runtime system, Version 1.0 -* -* Copyright (c) Software Templ, 1994, 1995 -* -* Module SYSTEM is subject to change any time without prior notification. -* Software Templ disclaims all warranties with regard to module SYSTEM, -* in particular shall Software Templ not be liable for any damage resulting -* from inappropriate use or modification of module SYSTEM. -* -* Version 1.1 jt, 24.11.95 fixes for correct pointer arithmetic on Cray computers -* jt 31.1.2007 ANSI prototypes for malloc and exit in order to avoid cc warnings -* -*/ - -#include "SYSTEM.h" -#ifdef __STDC__ -#include "stdarg.h" -#else -#include "varargs.h" -#endif - -extern void *malloc(unsigned long size); -extern void exit(int status); - -void (*SYSTEM_Halt)(); -LONGINT SYSTEM_halt; /* x in HALT(x) */ -LONGINT SYSTEM_assert; /* x in ASSERT(cond, x) */ -LONGINT SYSTEM_argc; -LONGINT SYSTEM_argv; -LONGINT SYSTEM_lock; -BOOLEAN SYSTEM_interrupted; -static LONGINT SYSTEM_mainfrm; /* adr of main proc stack frame, used for stack collection */ - -#define Lock SYSTEM_lock++ -#define Unlock SYSTEM_lock--; if (SYSTEM_interrupted && (SYSTEM_lock == 0)) __HALT(-9) - - -static void SYSTEM_InitHeap(); -void *SYSTEM__init(); - -void SYSTEM_INIT(argc, argvadr) - int argc; long argvadr; -{ - SYSTEM_mainfrm = argvadr; - SYSTEM_argc = argc; - SYSTEM_argv = *(long*)argvadr; - SYSTEM_InitHeap(); - SYSTEM_halt = -128; - SYSTEM__init(); -} - -void SYSTEM_FINI() -{ - SYSTEM_FINALL(); -} - -long SYSTEM_XCHK(i, ub) long i, ub; {return __X(i, ub);} -long SYSTEM_RCHK(i, ub) long i, ub; {return __R(i, ub);} -long SYSTEM_ASH(i, n) long i, n; {return __ASH(i, n);} -long SYSTEM_ABS(i) long i; {return __ABS(i);} -double SYSTEM_ABSD(i) double i; {return __ABS(i);} - -void SYSTEM_INHERIT(t, t0) - long *t, *t0; -{ - t -= __TPROC0OFF; - t0 -= __TPROC0OFF; - while (*t0 != __EOM) {*t = *t0; t--; t0--;} -} - -void SYSTEM_ENUMP(adr, n, P) - long *adr; - long n; - void (*P)(); -{ - while (n > 0) {P(*adr); adr++; n--;} -} - -void SYSTEM_ENUMR(adr, typ, size, n, P) - char *adr; - long *typ, size, n; - void (*P)(); -{ - long *t, off; - typ++; - while (n > 0) { - t = typ; - off = *t; - while (off >= 0) {P(*(long*)(adr+off)); t++; off = *t;} - adr += size; n--; - } -} - -long SYSTEM_DIV(x, y) - unsigned long x, y; -{ if ((long) x >= 0) return (x / y); - else return -((y - 1 - x) / y); -} - -long SYSTEM_MOD(x, y) - unsigned long x, y; -{ unsigned long m; - if ((long) x >= 0) return (x % y); - else { m = (-x) % y; - if (m != 0) return (y - m); else return 0; - } -} - -long SYSTEM_ENTIER(x) - double x; -{ - long y; - if (x >= 0) - return (long)x; - else { - y = (long)x; - if (y <= x) return y; else return y - 1; - } -} - -void SYSTEM_HALT(n) - int n; -{ - SYSTEM_halt = n; - if (SYSTEM_Halt!=0) SYSTEM_Halt(n); - exit(n); -} - -#ifdef __STDC__ -SYSTEM_PTR SYSTEM_NEWARR(long *typ, long elemsz, int elemalgn, int nofdim, int nofdyn, ...) -#else -SYSTEM_PTR SYSTEM_NEWARR(typ, elemsz, elemalgn, nofdim, nofdyn, va_alist) - long *typ, elemsz; - int elemalgn, nofdim, nofdyn; - va_dcl -#endif -{ - long nofelems, size, dataoff, n, nptr, *x, *p, nofptrs, i, *ptab, off; - va_list ap; -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - nofelems = 1; - while (nofdim > 0) { - nofelems = nofelems * va_arg(ap, long); nofdim--; - if (nofelems <= 0) __HALT(-20); - } - va_end(ap); - dataoff = nofdyn * sizeof(long); - if (elemalgn > sizeof(long)) { - n = dataoff % elemalgn; - if (n != 0) dataoff += elemalgn - n; - } - size = dataoff + nofelems * elemsz; - Lock; - if (typ == NIL) { - /* element typ does not contain pointers */ - x = SYSTEM_NEWBLK(size); - } - else if (typ == POINTER__typ) { - /* element type is a pointer */ - x = SYSTEM_NEWBLK(size + nofelems * sizeof(long)); - p = (long*)x[-1]; - p[-nofelems] = *p; /* build new type desc in situ: 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nofelems - 1; n = 1; /* n =1 for skipping the size field */ - while (n <= nofelems) {*p = n*sizeof(long); p++; n++;} - *p = - (nofelems + 1) * sizeof(long); /* sentinel */ - x[-1] -= nofelems * sizeof(long); - } - else { - /* element type is a record that contains pointers */ - ptab = typ + 1; nofptrs = 0; - while (ptab[nofptrs] >= 0) {nofptrs++;} /* number of pointers per element */ - nptr = nofelems * nofptrs; /* total number of pointers */ - x = SYSTEM_NEWBLK(size + nptr * sizeof(long)); - p = (long*)x[- 1]; - p[-nptr] = *p; /* build new type desc in situ; 1. copy block size; 2. setup ptr tab; 3. set sentinel; 4. patch tag */ - p -= nptr - 1; n = 0; off = dataoff; - while (n < nofelems) {i = 0; - while (i < nofptrs) {*p = off + ptab[i]; p++; i++;} - off += elemsz; n++; - } - *p = - (nptr + 1) * sizeof(long); /* sentinel */ - x[-1] -= nptr * sizeof(long); - } - if (nofdyn != 0) { - /* setup len vector for index checks */ -#ifdef __STDC__ - va_start(ap, nofdyn); -#else - va_start(ap); -#endif - p = x; - while (nofdyn > 0) {*p = va_arg(ap, long); p++, nofdyn--;} - va_end(ap); - } - Unlock; - return x; -} - -/* ----------- end of SYSTEM.co ------------- */ - diff --git a/src/system/openbsd/gcc/x86_64/SYSTEM.h b/src/system/openbsd/gcc/x86_64/SYSTEM.h deleted file mode 100644 index becece08..00000000 --- a/src/system/openbsd/gcc/x86_64/SYSTEM.h +++ /dev/null @@ -1,239 +0,0 @@ -#ifndef SYSTEM__h -#define SYSTEM__h - -/* - -voc (jet backend) runtime system interface and macros library -copyright (c) Josef Templ, 1995, 1996 - -gcc for Linux version (same as SPARC/Solaris2) -uses double # as concatenation operator - -*/ - -//#include -#include /* for type sizes -- noch */ -#include /* for malloc -- antranigv */ - -extern void *memcpy(void *dest, const void *src, unsigned long n); -extern void *malloc(unsigned long size); -extern void exit(int status); - -#define export -#define import extern - -/* constants */ -#define __MAXEXT 16 -#define NIL 0L -#define POINTER__typ (long*)1L /* not NIL and not a valid type */ - -/* basic types */ -//typedef char BOOLEAN; -#define BOOLEAN char -//typedef unsigned char CHAR; -#define CHAR unsigned char -//exactly two bytes -#define LONGCHAR unsigned short int -//typedef signed char SHORTINT; -#define SHORTINT signed char -//for x86 GNU/Linux -//typedef short int INTEGER; -//for x86_64 GNU/Linux -//typedef int INTEGER; -#define INTEGER int -//typedef long LONGINT; -#define LONGINT long -//typedef float REAL; -#define REAL float -//typedef double LONGREAL; -#define LONGREAL double -//typedef unsigned long SET; -#define SET unsigned long -typedef void *SYSTEM_PTR; -//#define *SYSTEM_PTR void -//typedef unsigned char SYSTEM_BYTE; -#define SYSTEM_BYTE unsigned char -typedef int8_t SYSTEM_INT8; -typedef int16_t SYSTEM_INT16; -typedef int32_t SYSTEM_INT32; -typedef int64_t SYSTEM_INT64; - -/* runtime system routines */ -extern long SYSTEM_DIV(); -extern long SYSTEM_MOD(); -extern long SYSTEM_ENTIER(); -extern long SYSTEM_ASH(); -extern long SYSTEM_ABS(); -extern long SYSTEM_XCHK(); -extern long SYSTEM_RCHK(); -extern double SYSTEM_ABSD(); -extern SYSTEM_PTR SYSTEM_NEWREC(); -extern SYSTEM_PTR SYSTEM_NEWBLK(); -#ifdef __STDC__ -extern SYSTEM_PTR SYSTEM_NEWARR(long*, long, int, int, int, ...); -#else -extern SYSTEM_PTR SYSTEM_NEWARR(); -#endif -extern SYSTEM_PTR SYSTEM_REGMOD(); -extern void SYSTEM_INCREF(); -extern void SYSTEM_REGCMD(); -extern void SYSTEM_REGTYP(); -extern void SYSTEM_REGFIN(); -extern void SYSTEM_FINALL(); -extern void SYSTEM_INIT(); -extern void SYSTEM_FINI(); -extern void SYSTEM_HALT(); -extern void SYSTEM_INHERIT(); -extern void SYSTEM_ENUMP(); -extern void SYSTEM_ENUMR(); - -/* module registry */ -#define __DEFMOD static void *m; if(m!=0)return m -#define __REGMOD(name, enum) if(m==0)m=SYSTEM_REGMOD((CHAR*)name,enum); else return m -#define __ENDMOD return m -#define __INIT(argc, argv) static void *m; SYSTEM_INIT(argc, (long)&argv); -#define __REGMAIN(name, enum) m=SYSTEM_REGMOD(name,enum) -#define __FINI SYSTEM_FINI(); return 0 -#define __IMPORT(name) SYSTEM_INCREF(name##__init()) -#define __REGCMD(name, cmd) SYSTEM_REGCMD(m, name, cmd) - -/* SYSTEM ops */ -#define __SYSNEW(p, len) p=SYSTEM_NEWBLK((long)(len)) -#define __VAL(t, x) (*(t*)&(x)) -#define __GET(a, x, t) x= *(t*)(a) -#define __PUT(a, x, t) *(t*)(a)=x -#define __LSHL(x, n, t) ((t)((unsigned t)(x)<<(n))) -#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) -#define __LSHR(x, n, t) ((t)((unsigned t)(x)>>(n))) -#define __LSH(x, n, t) ((n)>=0? __LSHL(x, n, t): __LSHR(x, -(n), t)) -#define __ROTL(x, n, t) ((t)((unsigned t)(x)<<(n)|(unsigned t)(x)>>(8*sizeof(t)-(n)))) -#define __ROTR(x, n, t) ((t)((unsigned t)(x)>>(n)|(unsigned t)(x)<<(8*sizeof(t)-(n)))) -#define __ROT(x, n, t) ((n)>=0? __ROTL(x, n, t): __ROTR(x, -(n), t)) -#define __BIT(x, n) (*(unsigned long*)(x)>>(n)&1) -#define __MOVE(s, d, n) memcpy((char*)(d),(char*)(s),n) - -/* std procs and operator mappings */ -#define __SHORT(x, y) ((int)((unsigned long)(x)+(y)<(y)+(y)?(x):(__HALT(-8),0))) -#define __SHORTF(x, y) ((int)(__RF((x)+(y),(y)+(y))-(y))) -#define __CHR(x) ((CHAR)__R(x, 256)) -#define __CHRF(x) ((CHAR)__RF(x, 256)) -#define __DIV(x, y) ((x)>=0?(x)/(y):-(((y)-1-(x))/(y))) -#define __DIVF(x, y) SYSTEM_DIV((long)(x),(long)(y)) -#define __MOD(x, y) ((x)>=0?(x)%(y):__MODF(x,y)) -#define __MODF(x, y) SYSTEM_MOD((long)(x),(long)(y)) -#define __NEW(p, t) p=SYSTEM_NEWREC((long)t##__typ) -#define __NEWARR SYSTEM_NEWARR -#define __HALT(x) SYSTEM_HALT(x) -#define __ASSERT(cond, x) if (!(cond)) {SYSTEM_assert = x; SYSTEM_HALT(-1);} -#define __ENTIER(x) SYSTEM_ENTIER(x) -#define __ABS(x) (((x)<0)?-(x):(x)) -#define __ABSF(x) SYSTEM_ABS((long)(x)) -#define __ABSFD(x) SYSTEM_ABSD((double)(x)) -#define __CAP(ch) ((CHAR)((ch)&0x5f)) -#define __ODD(x) ((x)&1) -#define __IN(x, s) (((s)>>(x))&1) -#define __SETOF(x) ((SET)1<<(x)) -#define __SETRNG(l, h) ((~(SET)0<<(l))&~(SET)0>>(8*sizeof(SET)-1-(h))) -#define __MASK(x, m) ((x)&~(m)) -#define __COPY(s, d, n) {char*_a=(void*)s,*_b=(void*)d;long _i=0,_t=n-1;while(_i<_t&&((_b[_i]=_a[_i])!=0)){_i++;};_b[_i]=0;} -static int __STRCMP(x, y) - CHAR *x, *y; -{long i = 0; CHAR ch1, ch2; - do {ch1 = x[i]; ch2 = y[i]; i++; - if (!ch1) return -(int)ch2; - } while (ch1==ch2); - return (int)ch1 - (int)ch2; -} -#define __ASH(x, n) ((n)>=0?__ASHL(x,n):__ASHR(x,-(n))) -#define __ASHL(x, n) ((long)(x)<<(n)) -#define __ASHR(x, n) ((long)(x)>>(n)) -#define __ASHF(x, n) SYSTEM_ASH((long)(x), (long)(n)) -#define __DUP(x, l, t) x=(void*)memcpy(alloca(l*sizeof(t)),x,l*sizeof(t)) -#define __DUPARR(v, t) v=(void*)memcpy(v##__copy,v,sizeof(t)) -#define __DEL(x) /* DUP with alloca frees storage automatically */ -#define __IS(tag, typ, level) (*(tag-(__BASEOFF-level))==(long)typ##__typ) -#define __TYPEOF(p) (*(((long**)(p))-1)) -#define __ISP(p, typ, level) __IS(__TYPEOF(p),typ,level) - -/* runtime checks */ -#define __X(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-2),0)) -#define __XF(i, ub) SYSTEM_XCHK((long)(i), (long)(ub)) -#define __RETCHK __retchk: __HALT(-3) -#define __CASECHK __HALT(-4) -#define __GUARDP(p, typ, level) ((typ*)(__ISP(p,typ,level)?p:(__HALT(-5),p))) -#define __GUARDR(r, typ, level) (*((typ*)(__IS(r##__typ,typ,level)?r:(__HALT(-5),r)))) -#define __GUARDA(p, typ, level) ((struct typ*)(__IS(__TYPEOF(p),typ,level)?p:(__HALT(-5),p))) -#define __GUARDEQR(p, dyntyp, typ) if(dyntyp!=typ##__typ) __HALT(-6);*(p) -#define __GUARDEQP(p, typ) if(__TYPEOF(p)!=typ##__typ)__HALT(-6);*(p) -#define __WITHCHK __HALT(-7) -#define __R(i, ub) (((unsigned)(long)(i)<(unsigned long)(ub))?i:(__HALT(-8),0)) -#define __RF(i, ub) SYSTEM_RCHK((long)(i),(long)(ub)) - -/* record type descriptors */ -#define __TDESC(t, m, n) \ - static struct t##__desc {\ - long tproc[m]; \ - long tag, next, level, module; \ - char name[24]; \ - long *base[__MAXEXT]; \ - char *rsrvd; \ - long blksz, ptr[n+1]; \ - } t##__desc - -#define __BASEOFF (__MAXEXT+1) -#define __TPROC0OFF (__BASEOFF+24/sizeof(long)+5) -#define __EOM 1 -#define __TDFLDS(name, size) {__EOM}, 1, 0, 0, 0, name, {0}, 0, size -#define __ENUMP(adr, n, P) SYSTEM_ENUMP(adr, (long)(n), P) -#define __ENUMR(adr, typ, size, n, P) SYSTEM_ENUMR(adr, typ, (long)(size), (long)(n), P) - -#define __INITYP(t, t0, level) \ - t##__typ= &t##__desc.blksz; \ - memcpy(t##__desc.base, t0##__typ - __BASEOFF, level*sizeof(long)); \ - t##__desc.base[level]=t##__typ; \ - t##__desc.module=(long)m; \ - if(t##__desc.blksz!=sizeof(struct t)) __HALT(-15); \ - t##__desc.blksz=(t##__desc.blksz+5*sizeof(long)-1)/(4*sizeof(long))*(4*sizeof(long)); \ - SYSTEM_REGTYP(m, (long)&t##__desc.next); \ - SYSTEM_INHERIT(t##__typ, t0##__typ) - -/* Oberon-2 type bound procedures support */ -#define __INITBP(t, proc, num) *(t##__typ-(__TPROC0OFF+num))=(long)proc -#define __SEND(typ, num, funtyp, parlist) ((funtyp)(*(typ-(__TPROC0OFF+num))))parlist - -/* runtime system variables */ -extern LONGINT SYSTEM_argc; -extern LONGINT SYSTEM_argv; -extern void (*SYSTEM_Halt)(); -extern LONGINT SYSTEM_halt; -extern LONGINT SYSTEM_assert; -extern SYSTEM_PTR SYSTEM_modules; -extern LONGINT SYSTEM_heapsize; -extern LONGINT SYSTEM_allocated; -extern LONGINT SYSTEM_lock; -extern SHORTINT SYSTEM_gclock; -extern BOOLEAN SYSTEM_interrupted; - -/* ANSI prototypes; not used so far -static int __STRCMP(CHAR *x, CHAR *y); -void SYSTEM_INIT(int argc, long argvadr); -void SYSTEM_FINI(void); -long SYSTEM_XCHK(long i, long ub); -long SYSTEM_RCHK(long i, long ub); -long SYSTEM_ASH(long i, long n); -long SYSTEM_ABS(long i); -double SYSTEM_ABSD(double i); -void SYSTEM_INHERIT(long *t, long *t0); -void SYSTEM_ENUMP(long *adr, long n, void (*P)(void*)); -void SYSTEM_ENUMR(char *adr, long *typ, long size, long n, void (*P)(void*)); -long SYSTEM_DIV(unsigned long x, unsigned long y); -long SYSTEM_MOD(unsigned long x, unsigned long y); -long SYSTEM_ENTIER(double x); -void SYSTEM_HALT(int n); -*/ - -#endif - diff --git a/src/system/openbsd/gcc/x86_64/Unix.Mod b/src/system/openbsd/gcc/x86_64/Unix.Mod deleted file mode 100644 index 1e1e7ecb..00000000 --- a/src/system/openbsd/gcc/x86_64/Unix.Mod +++ /dev/null @@ -1,595 +0,0 @@ -MODULE Unix; (* Josef Templ, 5.3.90 Linux system calls *) -(* ported to gnu x86_64 and added system(), sleep() functions, noch *) -(* Module Unix provides a system call interface to Linux. - Naming conventions: - Procedure and Type-names always start with a capital letter. - error numbers as defined in Unix - other constants start with lower case letters *) - -IMPORT SYSTEM(*, Console*); - -CONST - -(* various important constants *) - - stdin* = 0; stdout* =1; stderr* = 2; - - LOCKEX* = 2; LOCKUN* = 8; (* /usr/include/file.h *) - AFINET* = 2; (* /usr/include/sys/socket.h *) - PFINET* = AFINET; (* /usr/include/linux/socket.h *) - SOCKSTREAM* = 1; (* /usr/include/linux/socket.h *) - FIONREAD* = 541BH; (* in /usr/include/asm/termios.h *) - SETFL* = 4; (* set file descriptor flags; in asm/fcntl.h *) - TCP* = 0; - -(* flag sets, cf. /usr/include/asm/fcntl.h *) - rdonly* = {}; wronly* = {0}; rdwr* = {1}; creat* = {6}; excl* = {7}; trunc* = {9}; append* = {10}; ndelay = {11}; - -(* error numbers *) - - EPERM* = 1; (* Not owner *) - ENOENT* = 2; (* No such file or directory *) - ESRCH* = 3; (* No such process *) - EINTR* = 4; (* Interrupted system call *) - EIO* = 5; (* I/O error *) - ENXIO* = 6; (* No such device or address *) - E2BIG* = 7; (* Arg list too long *) - ENOEXEC* = 8; (* Exec format error *) - EBADF* = 9; (* Bad file number *) - ECHILD* = 10; (* No children *) - EAGAIN* = 11; (* No more processes *) - ENOMEM* = 12; (* Not enough core *) - EACCES* = 13; (* Permission denied *) - EFAULT* = 14; (* Bad address *) - ENOTBLK* = 15; (* Block device required *) - EBUSY* = 16; (* Mount device busy *) - EEXIST* = 17; (* File exists *) - EXDEV* = 18; (* Cross-device link *) - ENODEV* = 19; (* No such device *) - ENOTDIR* = 20; (* Not a directory*) - EISDIR* = 21; (* Is a directory *) - EINVAL* = 22; (* Invalid argument *) - ENFILE* = 23; (* File table overflow *) - EMFILE* = 24; (* Too many open files *) - ENOTTY* = 25; (* Not a typewriter *) - ETXTBSY* = 26; (* Text file busy *) - EFBIG* = 27; (* File too large *) - ENOSPC* = 28; (* No space left on device *) - ESPIPE* = 29; (* Illegal seek *) - EROFS* = 30; (* Read-only file system *) - EMLINK* = 31; (* Too many links *) - EPIPE* = 32; (* Broken pipe *) - EDOM* = 33; (* Argument too large *) - ERANGE* = 34; (* Result too large *) - EDEADLK* = 35; (* Resource deadlock would occur *) - ENAMETOOLONG* = 36; (* File name too long *) - ENOLCK* = 37; (* No record locks available *) - ENOSYS* = 38; (* Function not implemented *) - ENOTEMPTY* = 39; (* Directory not empty *) - ELOOP* = 40; (* Too many symbolic links encountered *) - EWOULDBLOCK* = EAGAIN; (* Operation would block *) - ENOMSG* = 42; (* No message of desired type *) - EIDRM* = 43; (* Identifier removed *) - ECHRNG* = 44; (* Channel number out of range *) - EL2NSYNC* = 45; (* Level 2 not synchronized *) - EL3HLT* = 46; (* Level 3 halted *) - EL3RST* = 47; (* Level 3 reset *) - ELNRNG* = 48; (* Link number out of range *) - EUNATCH* = 49; (* Protocol driver not attached *) - ENOCSI* = 50; (* No CSI structure available *) - EL2HLT* = 51; (* Level 2 halted *) - EBADE* = 52; (* Invalid exchange *) - EBADR* = 53; (* Invalid request descriptor *) - EXFULL* = 54; (* Exchange full *) - ENOANO* = 55; (* No anode *) - EBADRQC* = 56; (* Invalid request code *) - EBADSLT* = 57; (* Invalid slot *) - EDEADLOCK* = 58; (* File locking deadlock error *) - EBFONT* = 59; (* Bad font file format *) - ENOSTR* = 60; (* Device not a stream *) - ENODATA* = 61; (* No data available *) - ETIME* = 62; (* Timer expired *) - ENOSR* = 63; (* Out of streams resources *) - ENONET* = 64; (* Machine is not on the network *) - ENOPKG* = 65; (* Package not installed *) - EREMOTE* = 66; (* Object is remote *) - ENOLINK* = 67; (* Link has been severed *) - EADV* = 68; (* Advertise error *) - ESRMNT* = 69; (* Srmount error *) - ECOMM* = 70; (* Communication error on send *) - EPROTO* = 71; (* Protocol error *) - EMULTIHOP* = 72; (* Multihop attempted *) - EDOTDOT* = 73; (* RFS specific error *) - EBADMSG* = 74; (* Not a data message *) - EOVERFLOW* = 75; (* Value too large for defined data type *) - ENOTUNIQ* = 76; (* Name not unique on network *) - EBADFD* = 77; (* File descriptor in bad state *) - EREMCHG* = 78; (* Remote address changed *) - ELIBACC* = 79; (* Can not access a needed shared library *) - ELIBBAD* = 80; (* Accessing a corrupted shared library *) - ELIBSCN* = 81; (* .lib section in a.out corrupted *) - ELIBMAX* = 82; (* Attempting to link in too many shared libraries *) - ELIBEXEC* = 83; (* Cannot exec a shared library directly *) - EILSEQ* = 84; (* Illegal byte sequence *) - ERESTART* = 85; (* Interrupted system call should be restarted *) - ESTRPIPE* = 86; (* Streams pipe error *) - EUSERS* = 87; (* Too many users *) - ENOTSOCK* = 88; (* Socket operation on non-socket *) - EDESTADDRREQ* = 89; (* Destination address required *) - EMSGSIZE* = 90; (* Message too long *) - EPROTOTYPE* = 91; (* Protocol wrong type for socket *) - ENOPROTOOPT* = 92; (* Protocol not available *) - EPROTONOSUPPORT* = 93; (* Protocol not supported *) - ESOCKTNOSUPPORT* = 94; (* Socket type not supported *) - EOPNOTSUPP* = 95; (* Operation not supported on transport endpoint *) - EPFNOSUPPORT* = 96; (* Protocol family not supported *) - EAFNOSUPPORT* = 97; (* Address family not supported by protocol *) - EADDRINUSE* = 98; (* Address already in use *) - EADDRNOTAVAIL* = 99; (* Cannot assign requested address *) - ENETDOWN* = 100; (* Network is down *) - ENETUNREACH* = 101; (* Network is unreachable *) - ENETRESET* = 102; (* Network dropped connection because of reset *) - ECONNABORTED* = 103; (* Software caused connection abort *) - ECONNRESET* = 104; (* Connection reset by peer *) - ENOBUFS* = 105; (* No buffer space available *) - EISCONN* = 106; (* Transport endpoint is already connected *) - ENOTCONN* = 107; (* Transport endpoint is not connected *) - ESHUTDOWN* = 108; (* Cannot send after transport endpoint shutdown *) - ETOOMANYREFS* = 109; (* Too many references: cannot splice *) - ETIMEDOUT* = 110; (* Connection timed out *) - ECONNREFUSED* = 111; (* Connection refused *) - EHOSTDOWN* = 112; (* Host is down *) - EHOSTUNREACH* = 113; (* No route to host *) - EALREADY* = 114; (* Operation already in progress *) - EINPROGRESS* = 115; (* Operation now in progress *) - ESTALE* = 116; (* Stale NFS file handle *) - EUCLEAN* = 117; (* Structure needs cleaning *) - ENOTNAM* = 118; (* Not a XENIX named type file *) - ENAVAIL* = 119; (* No XENIX semaphores available *) - EISNAM* = 120; (* Is a named type file *) - EREMOTEIO* = 121; (* Remote I/O error *) - EDQUOT* = 122; (* Quota exceeded *) - -CONST sigsetarrlength = 1024 / 8 * SIZE(LONGINT); - - -TYPE - (* cpp /usr/include/setjmp.h - struct __jmp_buf_tag - { - __jmp_buf __jmpbuf; - int __mask_was_saved; - __sigset_t __saved_mask; - }; - - typedef struct __jmp_buf_tag jmp_buf[1]; - - __sigset_t is 128 byte long in glibc on arm, x86, x86_64 - __jmp_buf is 24 bytes long in glibc on x86 - 256 bytes long in glibc on armv6 - 64 bytes long in glibc on x86_64 - - *) - (* on openbsd - typedef long sigjmp_buf[11 + 1]; - typedef long jmp_buf[11]; - it seems we need sigjmp_buf - *) - JmpBuf* = RECORD - jmpbuf: ARRAY 12 OF LONGINT; (* 8 * 8 = 64 *) - END ; - - Status* = RECORD (* struct stat *) - mode* : INTEGER; (* mode_t *) - dev* : INTEGER; (* dev_t 4 *) - ino* : LONGINT; (* ino_t 8 *) - nlink* : INTEGER; (* nlink_t *) - uid*, gid*: INTEGER; (* uid_t, gid_t *) - rdev* : INTEGER; (* dev_t *) - atime* : LONGINT; - atimences* : LONGINT; - mtime* : LONGINT; - mtimensec* : LONGINT; - ctime* : LONGINT; - ctimensec* : LONGINT; - size* : LONGINT; (* off_t *) - blocks* : LONGINT; (* int64_t *) - blksize* : INTEGER; (* u_int32_t *) - flags, gen*: INTEGER; (* u_int32_t *) - birthtim: ARRAY 2 OF LONGINT; - END ; - -(* from /usr/include/bits/time.h - -struct timeval - { - __time_t tv_sec; /* Seconds. */ //__time_t 8 - __suseconds_t tv_usec; /* Microseconds. */ __suseconds_t 8 - }; - - -*) -(* from sys/time.h on OpenBSD *) - Timeval* = RECORD - sec*, usec*: LONGINT - END ; - - -(* -from man gettimeofday - - struct timezone { - int tz_minuteswest; /* minutes west of Greenwich */ int 4 - int tz_dsttime; /* type of DST correction */ int 4 - }; -*) - - - Timezone* = RECORD - (*minuteswest*, dsttime*: LONGINT*) - minuteswest*, dsttime*: INTEGER - END ; - - Itimerval* = RECORD - interval*, value*: Timeval - END ; - - FdSet* = ARRAY 16 OF SET; - - SigCtxPtr* = POINTER TO SigContext; - SigContext* = RECORD - END ; - - SignalHandler* = PROCEDURE (sig, code: LONGINT; scp: SigCtxPtr); - -(* From sys/dirent.h on OpenBSD 5.6 *) - Dirent* = RECORD - ino, off: LONGINT; - reclen: ARRAY 2 OF CHAR; - type, namlen : CHAR; - padding : ARRAY 4 OF CHAR; - name : ARRAY 256 OF CHAR; - END ; - -(* from sys/resource.h on OpenBSD *) - Rusage* = RECORD - utime*, stime*: Timeval; - maxrss*, ixrss*, idrss*, isrss*, - minflt*, majflt*, nswap*, inblock*, - oublock*, msgsnd*, msgrcv*, nsignals*, - nvcsw*, nivcsw*: LONGINT - END ; - -(* from sys/uio.h on OpenBSD 5.6 -- antranigv*) - Iovec* = RECORD - base*, len*: LONGINT - END ; - -(* TOBEDONE *) - SocketPair* = ARRAY 2 OF LONGINT; - -(* from sys/poll.h on OpenBSD 5.6 -- antranigv *) - Pollfd* = RECORD - fd*: INTEGER; - events*, revents*: ARRAY 2 OF CHAR; - END ; - -(* different from linux, written new for OpenBSD from sys/socket.h -- antranigv *) - Sockaddr* = RECORD - (*family0*, family1*: SHORTINT; - pad0, pad1: SHORTINT; - pad2 : INTEGER; - (*port*: INTEGER; - internetAddr*: LONGINT;*) - pad*: ARRAY 14 OF CHAR;*) - len* : CHAR; - family* : CHAR; - data* : ARRAY 14 OF CHAR; - END ; - - (* identical to linux. OpenBSD 5.6 -- antranigv *) - HostEntry* = POINTER [1] TO Hostent; - Hostent* = RECORD - name*, aliases*: LONGINT; - addrtype*, length*: INTEGER; - addrlist*: LONGINT; (*POINTER TO POINTER TO LONGINT, network byte order*) - END; - - Name* = ARRAY OF CHAR; - - PROCEDURE -includeStat() - "#include "; - (* for jmp_buf *) - PROCEDURE -includeSetjmp() - "#include "; - - (* for dirent *) - PROCEDURE -includeDirent() - "#include "; - - (* for rusage *) - PROCEDURE -includeResource() - "#include "; - - (* for iovec *) - PROCEDURE -includeIovec() - "#include "; - - PROCEDURE -includeErrno() - "#include "; - - (* for read(), write() and sleep(), and fd_set *) - PROCEDURE -includeUnistd() - "#include "; - - (* for system() *) - PROCEDURE -includeStdlib() - "#include "; - - (* for nanosleep() *) - PROCEDURE -includeTime() - "#include "; - - (* for select() *) - PROCEDURE -includeSelect() - "#include "; - - PROCEDURE -err(): INTEGER - "errno"; - - PROCEDURE errno*(): INTEGER; - BEGIN - RETURN err() - END errno; - - PROCEDURE -Exit*(n: INTEGER) - "exit(n)"; - - PROCEDURE -Fork*(): INTEGER - "fork()"; - - PROCEDURE -Wait*(VAR status: INTEGER): INTEGER - "wait(status)"; - - 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) : INTEGER - "gettimeofday(tv, tz)"; - - PROCEDURE -Read* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT - "read(fd, buf, nbyte)"; - - PROCEDURE -ReadBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "read(fd, buf, buf__len)"; - - PROCEDURE -Write* (fd: INTEGER; buf, nbyte: LONGINT): LONGINT - "write(fd, buf, nbyte)"; - - PROCEDURE -WriteBlk* (fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE): LONGINT - "write(fd, buf, buf__len)"; - - PROCEDURE -Dup*(fd: INTEGER): INTEGER - "dup(fd)"; - - PROCEDURE -Dup2*(fd1, fd2: INTEGER): INTEGER - "dup(fd1, fd2)"; - - PROCEDURE -Pipe*(fds : LONGINT): INTEGER - "pipe(fds)"; - - PROCEDURE -Getpid*(): INTEGER - "getpid()"; - - PROCEDURE -Getuid*(): INTEGER - "getuid()"; - - PROCEDURE -Geteuid*(): INTEGER - "geteuid()"; - - PROCEDURE -Getgid*(): INTEGER - "getgid()"; - - PROCEDURE -Getegid*(): INTEGER - "getegid()"; - - PROCEDURE -Unlink*(name: Name): INTEGER - "unlink(name)"; - - PROCEDURE -Open*(name: Name; flag: INTEGER; mode: LONGINT): INTEGER - "open(name, flag, mode)"; - - PROCEDURE -Close*(fd: INTEGER): INTEGER - "close(fd)"; - - PROCEDURE -stat(name: Name; VAR statbuf: Status): INTEGER - "stat((const char*)name, (struct stat*)statbuf)"; - - 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!) *) - (* don't understand this - INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); *) - RETURN res; - END Stat; - - PROCEDURE -fstat(fd: INTEGER; VAR statbuf: Status): INTEGER - "fstat(fd, (struct stat*)statbuf)"; - - 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!) *) - (*INC(statbuf.dev, statbuf.devX); - INC(statbuf.rdev, statbuf.rdevX); *) - RETURN res; - END Fstat; - - PROCEDURE -Fchmod*(fd, mode: INTEGER): INTEGER - "fchmod(fd, mode)"; - - PROCEDURE -Chmod*(path: Name; mode: INTEGER): INTEGER - "chmod(path, mode)"; - - PROCEDURE -Lseek*(fd: INTEGER; offset: LONGINT; origin: INTEGER): LONGINT - "lseek(fd, offset, origin)"; - - PROCEDURE -Fsync*(fd: INTEGER): INTEGER - "fsync(fd)"; - - PROCEDURE -Fcntl*(fd: INTEGER; cmd: INTEGER; arg: LONGINT ): INTEGER - "fcntl(fd, cmd, arg)"; - - PROCEDURE -Flock*(fd, operation: INTEGER): INTEGER - "flock(fd, operation)"; - - PROCEDURE -Ftruncate*(fd: INTEGER; length: LONGINT): INTEGER - "ftruncate(fd, length)"; - - PROCEDURE -Readblk*(fd: INTEGER; VAR buf: ARRAY OF SYSTEM.BYTE; len: LONGINT): LONGINT - "read(fd, buf, len)"; - - PROCEDURE -Rename*(old, new: Name): INTEGER - "rename(old, new)"; - - PROCEDURE -Chdir*(path: Name): INTEGER - "chdir(path)"; - - PROCEDURE -Ioctl*(fd: INTEGER; request, arg: LONGINT): INTEGER - "ioctl(fd, request, arg)"; - - PROCEDURE -Kill*(pid, sig: INTEGER): INTEGER - "kill(pid, sig)"; - - PROCEDURE -Sigsetmask*(mask: INTEGER): INTEGER - "sigsetmask(mask)"; - - PROCEDURE -Sleep*(ms : INTEGER): INTEGER - "(INTEGER)sleep(ms)"; - - PROCEDURE -Nanosleep*(VAR req : Timeval; VAR rem : Timeval): INTEGER - "(INTEGER)nanosleep(req, rem)"; - - (* TCP/IP networking *) - - PROCEDURE -Gethostbyname*(name: Name): HostEntry - "(Unix_HostEntry)gethostbyname(name)"; - - PROCEDURE -Gethostname*(VAR name: Name): INTEGER - "gethostname(name, name__len)"; - - PROCEDURE -Socket*(af, type, protocol: INTEGER): INTEGER - "socket(af, type, protocol)"; - - PROCEDURE -Connect*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER - "connect(socket, &(name), namelen)"; - - PROCEDURE -Getsockname*(socket: INTEGER; VAR name: Sockaddr; VAR namelen: INTEGER): INTEGER - "getsockname(socket, name, namelen)"; - - PROCEDURE -Bind*(socket: INTEGER; name: Sockaddr; namelen: INTEGER): INTEGER - "bind(socket, &(name), namelen)"; - - PROCEDURE -Listen*(socket, backlog: INTEGER): INTEGER - "listen(socket, backlog)"; - - PROCEDURE -Accept*(socket: INTEGER; VAR addr: Sockaddr; VAR addrlen: INTEGER): LONGINT - "accept(socket, addr, addrlen)"; - - PROCEDURE -Recv*(socket: INTEGER; bufadr, buflen: LONGINT; flags: INTEGER): LONGINT - "recv(socket, bufadr, buflen, flags)"; - - 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 *) - "system(str)"; - - PROCEDURE system*(cmd : ARRAY OF CHAR); - VAR r : INTEGER; - BEGIN - r := sys(cmd); - END system; - - PROCEDURE System*(cmd : ARRAY OF CHAR): INTEGER; - VAR r : INTEGER; - BEGIN - r := sys(cmd); - RETURN r - END System; - - PROCEDURE -SizeofUnixStat(): INTEGER - "sizeof(Unix_Status)"; - - PROCEDURE -SizeofStat(): INTEGER - "sizeof(struct stat)"; - - PROCEDURE -SizeofJmpBuf(): INTEGER - "sizeof(jmp_buf)"; - - PROCEDURE -SizeofSigJmpBuf(): INTEGER - "sizeof(sigjmp_buf)"; - - PROCEDURE -SizeofTimeval(): INTEGER - "sizeof(struct timeval)"; - - PROCEDURE -SizeofTimezone(): INTEGER - "sizeof(struct timezone)"; - - PROCEDURE -SizeofRusage(): INTEGER - "sizeof(struct rusage)"; - - PROCEDURE -SizeofFdSet(): INTEGER - "sizeof(fd_set)"; - - PROCEDURE -SizeofDirent(): INTEGER - "sizeof(struct dirent)"; - - PROCEDURE -SizeofIovec(): INTEGER - "sizeof(struct iovec)"; - - PROCEDURE -Error(msg: ARRAY OF CHAR; len: INTEGER) - "write(1/*stdout*/, msg, len); char ch = 0xa; write(1, &ch, 1)"; - - PROCEDURE StatCheck; - VAR x, y: LONGINT; - BEGIN - x := SizeofUnixStat(); - y := SizeofStat(); - IF x # y THEN - Error("Unix.StatCheck: inconsistent usage of struct stat", 49); - Exit(1); - END - END StatCheck; -(* - PROCEDURE Check; - BEGIN - Console.String("struct stat size: "); Console.Int(SizeofStat(), 0); Console.Ln; - Console.String("Unix.Stat size: "); Console.Int(SIZE(Status), 0); Console.Ln; - Console.String("Unix.JmpBuf size: "); Console.Int(SIZE(JmpBuf), 0); Console.Ln; - Console.String("sigjmp_buf size: "); Console.Int(SizeofSigJmpBuf(), 0); Console.Ln; - Console.String("Unix.Timeval size: "); Console.Int(SIZE(Timeval), 0); Console.Ln; - Console.String("struct timeval size: "); Console.Int(SizeofTimeval(), 0); Console.Ln; - Console.String("Unix.Timezone size: "); Console.Int(SIZE(Timezone), 0); Console.Ln; - Console.String("struct timezone size: "); Console.Int(SizeofTimezone(), 0); Console.Ln; - Console.String("Unix.Rusage size: "); Console.Int(SIZE(Rusage), 0); Console.Ln; - Console.String("struct rusage size: "); Console.Int(SizeofRusage(), 0); Console.Ln; - Console.String("Unix.FdSet size: "); Console.Int(SIZE(FdSet), 0); Console.Ln; - Console.String("fdset size: "); Console.Int(SizeofFdSet(), 0); Console.Ln; - Console.String("Unix.Dirent size: "); Console.Int(SIZE(Dirent), 0); Console.Ln; - Console.String("struct dirent size: "); Console.Int(SizeofDirent(), 0); Console.Ln; - Console.String("Unix.Iovec size: "); Console.Int(SIZE(Iovec), 0); Console.Ln; - Console.String("struct iovec size: "); Console.Int(SizeofIovec(), 0); Console.Ln; - END Check; -*) -BEGIN - - (*Check;*) - StatCheck(); - -END Unix. -