mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 21:32:26 +00:00
initial of OpenBSD changes for voc on X86_64
Former-commit-id: 0170d2b442
This commit is contained in:
Antranig Vartanian
parent
5305dbaa89
commit
7d3258c2f2
12 changed files with 3413 additions and 0 deletions
86
src/lib/system/openbsd/gcc/Console.Mod
Normal file
86
src/lib/system/openbsd/gcc/Console.Mod
Normal file
|
|
@ -0,0 +1,86 @@
|
||||||
|
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.
|
||||||
188
src/lib/system/openbsd/gcc/Kernel.Mod
Normal file
188
src/lib/system/openbsd/gcc/Kernel.Mod
Normal file
|
|
@ -0,0 +1,188 @@
|
||||||
|
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.
|
||||||
200
src/lib/system/openbsd/gcc/Kernel0.Mod
Normal file
200
src/lib/system/openbsd/gcc/Kernel0.Mod
Normal file
|
|
@ -0,0 +1,200 @@
|
||||||
|
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.
|
||||||
520
src/lib/system/openbsd/gcc/SYSTEM.Mod
Normal file
520
src/lib/system/openbsd/gcc/SYSTEM.Mod
Normal file
|
|
@ -0,0 +1,520 @@
|
||||||
|
(*
|
||||||
|
* 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.
|
||||||
65
src/lib/system/openbsd/gcc/x86_64/Args.Mod
Normal file
65
src/lib/system/openbsd/gcc/x86_64/Args.Mod
Normal file
|
|
@ -0,0 +1,65 @@
|
||||||
|
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 <stdlib.h>";*)
|
||||||
|
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.
|
||||||
664
src/lib/system/openbsd/gcc/x86_64/Files.Mod
Normal file
664
src/lib/system/openbsd/gcc/x86_64/Files.Mod
Normal file
|
|
@ -0,0 +1,664 @@
|
||||||
|
MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
|
||||||
|
(* modified version of Files, which opens only the file provided and does not scan any path in any environment variable, also ReadLine procedure added; -- noch *)
|
||||||
|
IMPORT SYSTEM, Unix, Kernel, Args, Console;
|
||||||
|
|
||||||
|
(* standard data type I/O
|
||||||
|
|
||||||
|
little endian,
|
||||||
|
Sint:1, Int:2, Lint:4
|
||||||
|
ORD({0}) = 1,
|
||||||
|
false = 0, true =1
|
||||||
|
IEEE real format,
|
||||||
|
null terminated strings,
|
||||||
|
compact numbers according to M.Odersky *)
|
||||||
|
|
||||||
|
|
||||||
|
CONST
|
||||||
|
nofbufs = 4;
|
||||||
|
bufsize = 4096;
|
||||||
|
fileTabSize = 64;
|
||||||
|
noDesc = -1;
|
||||||
|
notDone = -1;
|
||||||
|
|
||||||
|
(* file states *)
|
||||||
|
open = 0; create = 1; close = 2;
|
||||||
|
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
FileName = ARRAY 101 OF CHAR;
|
||||||
|
File* = POINTER TO Handle;
|
||||||
|
Buffer = POINTER TO BufDesc;
|
||||||
|
|
||||||
|
Handle = RECORD
|
||||||
|
workName, registerName: FileName;
|
||||||
|
tempFile: BOOLEAN;
|
||||||
|
dev, ino, mtime: LONGINT;
|
||||||
|
fd-: INTEGER;
|
||||||
|
len, pos: LONGINT;
|
||||||
|
bufs: ARRAY nofbufs OF Buffer;
|
||||||
|
swapper, state: INTEGER
|
||||||
|
END ;
|
||||||
|
|
||||||
|
BufDesc = RECORD
|
||||||
|
f: File;
|
||||||
|
chg: BOOLEAN;
|
||||||
|
org, size: LONGINT;
|
||||||
|
data: ARRAY bufsize OF SYSTEM.BYTE
|
||||||
|
END ;
|
||||||
|
|
||||||
|
Rider* = RECORD
|
||||||
|
res*: LONGINT;
|
||||||
|
eof*: BOOLEAN;
|
||||||
|
buf: Buffer;
|
||||||
|
org, offset: LONGINT
|
||||||
|
END ;
|
||||||
|
|
||||||
|
Time = POINTER TO TimeDesc;
|
||||||
|
TimeDesc = RECORD
|
||||||
|
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
|
||||||
|
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
|
||||||
|
END ;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
|
||||||
|
tempno: INTEGER;
|
||||||
|
|
||||||
|
(* for localtime *)
|
||||||
|
PROCEDURE -includetime()
|
||||||
|
'#include "time.h"';
|
||||||
|
|
||||||
|
PROCEDURE -localtime(VAR clock: LONGINT): Time
|
||||||
|
"(Files_Time) localtime(clock)";
|
||||||
|
|
||||||
|
PROCEDURE -getcwd(VAR cwd: Unix.Name)
|
||||||
|
"getcwd(cwd, cwd__len)";
|
||||||
|
|
||||||
|
PROCEDURE -IdxTrap "__HALT(-1)";
|
||||||
|
|
||||||
|
PROCEDURE^ Finalize(o: SYSTEM.PTR);
|
||||||
|
|
||||||
|
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
|
||||||
|
BEGIN
|
||||||
|
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
|
||||||
|
IF f # NIL THEN
|
||||||
|
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
|
||||||
|
END ;
|
||||||
|
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
|
||||||
|
Console.Ln;
|
||||||
|
HALT(99)
|
||||||
|
END Err;
|
||||||
|
|
||||||
|
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
|
||||||
|
VAR i, j: INTEGER;
|
||||||
|
BEGIN i := 0; j := 0;
|
||||||
|
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
|
||||||
|
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
|
||||||
|
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
|
||||||
|
dest[i] := 0X
|
||||||
|
END MakeFileName;
|
||||||
|
|
||||||
|
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
|
||||||
|
VAR n, i, j: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
INC(tempno); n := tempno; i := 0;
|
||||||
|
IF finalName[0] # "/" THEN (* relative pathname *)
|
||||||
|
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
|
||||||
|
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
|
||||||
|
END;
|
||||||
|
j := 0;
|
||||||
|
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
|
||||||
|
DEC(i);
|
||||||
|
WHILE name[i] # "/" DO DEC(i) END;
|
||||||
|
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
|
||||||
|
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
|
||||||
|
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
|
||||||
|
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
|
||||||
|
name[i] := 0X
|
||||||
|
END GetTempName;
|
||||||
|
|
||||||
|
PROCEDURE Create(f: File);
|
||||||
|
VAR stat: Unix.Status; done: BOOLEAN;
|
||||||
|
errno: LONGINT; err: ARRAY 32 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
IF f.fd = noDesc THEN
|
||||||
|
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
|
||||||
|
ELSIF f.state = close THEN
|
||||||
|
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
|
||||||
|
END ;
|
||||||
|
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
|
||||||
|
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
|
||||||
|
done := f.fd >= 0; errno := Unix.errno();
|
||||||
|
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
|
||||||
|
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
|
||||||
|
Kernel.GC(TRUE);
|
||||||
|
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
|
||||||
|
done := f.fd >= 0
|
||||||
|
END ;
|
||||||
|
IF done THEN
|
||||||
|
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
|
||||||
|
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
|
||||||
|
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
|
||||||
|
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
|
||||||
|
END
|
||||||
|
ELSE errno := Unix.errno();
|
||||||
|
IF errno = Unix.ENOENT THEN err := "no such directory"
|
||||||
|
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
|
||||||
|
ELSE err := "file not created"
|
||||||
|
END ;
|
||||||
|
Err(err, f, errno)
|
||||||
|
END
|
||||||
|
END
|
||||||
|
END Create;
|
||||||
|
|
||||||
|
PROCEDURE Flush(buf: Buffer);
|
||||||
|
VAR res: LONGINT; f: File; stat: Unix.Status;
|
||||||
|
BEGIN
|
||||||
|
IF buf.chg THEN f := buf.f; Create(f);
|
||||||
|
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
|
||||||
|
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
|
||||||
|
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
|
||||||
|
f.pos := buf.org + buf.size;
|
||||||
|
buf.chg := FALSE;
|
||||||
|
res := Unix.Fstat(f.fd, stat);
|
||||||
|
f.mtime := stat.mtime
|
||||||
|
END
|
||||||
|
END Flush;
|
||||||
|
|
||||||
|
PROCEDURE Close* (f: File);
|
||||||
|
VAR i, res: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
IF (f.state # create) OR (f.registerName # "") THEN
|
||||||
|
Create(f); i := 0;
|
||||||
|
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
|
||||||
|
res := Unix.Fsync(f.fd);
|
||||||
|
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
|
||||||
|
END
|
||||||
|
END Close;
|
||||||
|
|
||||||
|
PROCEDURE Length* (f: File): LONGINT;
|
||||||
|
BEGIN RETURN f.len
|
||||||
|
END Length;
|
||||||
|
|
||||||
|
PROCEDURE New* (name: ARRAY OF CHAR): File;
|
||||||
|
VAR f: File;
|
||||||
|
BEGIN
|
||||||
|
NEW(f); f.workName := ""; COPY(name, f.registerName);
|
||||||
|
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
|
||||||
|
RETURN f
|
||||||
|
END New;
|
||||||
|
(*
|
||||||
|
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
|
||||||
|
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
i := 0; ch := Kernel.OBERON[pos];
|
||||||
|
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
|
||||||
|
IF ch = "~" THEN
|
||||||
|
INC(pos); ch := Kernel.OBERON[pos];
|
||||||
|
home := ""; Args.GetEnv("HOME", home);
|
||||||
|
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
|
||||||
|
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
|
||||||
|
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
|
||||||
|
END
|
||||||
|
END ;
|
||||||
|
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
|
||||||
|
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
|
||||||
|
dir[i] := 0X
|
||||||
|
END ScanPath;
|
||||||
|
*)
|
||||||
|
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
|
||||||
|
VAR i: INTEGER; ch: CHAR;
|
||||||
|
BEGIN i := 0; ch := name[0];
|
||||||
|
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
|
||||||
|
RETURN ch = "/"
|
||||||
|
END HasDir;
|
||||||
|
|
||||||
|
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
|
||||||
|
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
|
||||||
|
BEGIN i := 0;
|
||||||
|
WHILE i < fileTabSize DO
|
||||||
|
f := SYSTEM.VAL(File, fileTab[i]);
|
||||||
|
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
|
||||||
|
IF mtime # f.mtime THEN i := 0;
|
||||||
|
WHILE i < nofbufs DO
|
||||||
|
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
|
||||||
|
INC(i)
|
||||||
|
END ;
|
||||||
|
f.swapper := -1; f.mtime := mtime;
|
||||||
|
res := Unix.Fstat(f.fd, stat); f.len := stat.size
|
||||||
|
END ;
|
||||||
|
RETURN f
|
||||||
|
END ;
|
||||||
|
INC(i)
|
||||||
|
END ;
|
||||||
|
RETURN NIL
|
||||||
|
END CacheEntry;
|
||||||
|
|
||||||
|
PROCEDURE Old* (name: ARRAY OF CHAR): File;
|
||||||
|
VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
|
||||||
|
dir, path: ARRAY 256 OF CHAR;
|
||||||
|
stat: Unix.Status;
|
||||||
|
BEGIN
|
||||||
|
IF name # "" THEN
|
||||||
|
IF HasDir(name) THEN dir := ""; COPY(name, path)
|
||||||
|
ELSE
|
||||||
|
pos := 0;
|
||||||
|
COPY(name, path); (* -- noch *)
|
||||||
|
(*ScanPath(pos, dir);*) (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
|
||||||
|
END ;
|
||||||
|
LOOP
|
||||||
|
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno();
|
||||||
|
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
|
||||||
|
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
|
||||||
|
Kernel.GC(TRUE);
|
||||||
|
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {})));
|
||||||
|
done := fd >= 0; errno := Unix.errno();
|
||||||
|
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
|
||||||
|
END ;
|
||||||
|
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
|
||||||
|
(* errno EAGAIN observed on Solaris 2.4 *)
|
||||||
|
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno()
|
||||||
|
END ;
|
||||||
|
IF (~done) & (errno # Unix.ENOENT) THEN
|
||||||
|
Console.String("warning Files.Old "); Console.String(name);
|
||||||
|
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
|
||||||
|
END ;
|
||||||
|
IF done THEN
|
||||||
|
res := Unix.Fstat(fd, stat);
|
||||||
|
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
|
||||||
|
IF f # NIL THEN res := Unix.Close(fd); RETURN f
|
||||||
|
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
|
||||||
|
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
|
||||||
|
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
|
||||||
|
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
|
||||||
|
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
|
||||||
|
RETURN f
|
||||||
|
END
|
||||||
|
ELSIF dir = "" THEN RETURN NIL
|
||||||
|
ELSE (*MakeFileName(dir, name, path);*) (*ScanPath(pos, dir)*)
|
||||||
|
RETURN NIL
|
||||||
|
END
|
||||||
|
END
|
||||||
|
ELSE RETURN NIL
|
||||||
|
END
|
||||||
|
END Old;
|
||||||
|
|
||||||
|
PROCEDURE Purge* (f: File);
|
||||||
|
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
|
||||||
|
BEGIN i := 0;
|
||||||
|
WHILE i < nofbufs DO
|
||||||
|
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
|
||||||
|
INC(i)
|
||||||
|
END ;
|
||||||
|
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
|
||||||
|
f.pos := 0; f.len := 0; f.swapper := -1;
|
||||||
|
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
|
||||||
|
END Purge;
|
||||||
|
|
||||||
|
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
|
||||||
|
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
|
||||||
|
BEGIN
|
||||||
|
Create(f); res := Unix.Fstat(f.fd, stat);
|
||||||
|
time := localtime(stat.mtime);
|
||||||
|
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
|
||||||
|
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
|
||||||
|
END GetDate;
|
||||||
|
|
||||||
|
PROCEDURE Pos* (VAR r: Rider): LONGINT;
|
||||||
|
BEGIN RETURN r.org + r.offset
|
||||||
|
END Pos;
|
||||||
|
|
||||||
|
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
|
||||||
|
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
IF f # NIL THEN
|
||||||
|
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
|
||||||
|
offset := pos MOD bufsize; org := pos - offset; i := 0;
|
||||||
|
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
|
||||||
|
IF i < nofbufs THEN
|
||||||
|
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
|
||||||
|
ELSE buf := f.bufs[i]
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
f.swapper := (f.swapper + 1) MOD nofbufs;
|
||||||
|
buf := f.bufs[f.swapper];
|
||||||
|
Flush(buf)
|
||||||
|
END ;
|
||||||
|
IF buf.org # org THEN
|
||||||
|
IF org = f.len THEN buf.size := 0
|
||||||
|
ELSE Create(f);
|
||||||
|
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
|
||||||
|
n := Unix.ReadBlk(f.fd, buf.data);
|
||||||
|
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
|
||||||
|
f.pos := org + n;
|
||||||
|
buf.size := n
|
||||||
|
END ;
|
||||||
|
buf.org := org; buf.chg := FALSE
|
||||||
|
END
|
||||||
|
ELSE buf := NIL; org := 0; offset := 0
|
||||||
|
END ;
|
||||||
|
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
|
||||||
|
END Set;
|
||||||
|
|
||||||
|
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
|
||||||
|
VAR offset: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
buf := r.buf; offset := r.offset;
|
||||||
|
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
|
||||||
|
IF (offset < buf.size) THEN
|
||||||
|
x := buf.data[offset]; r.offset := offset + 1
|
||||||
|
ELSIF r.org + offset < buf.f.len THEN
|
||||||
|
Set(r, r.buf.f, r.org + offset);
|
||||||
|
x := r.buf.data[0]; r.offset := 1
|
||||||
|
ELSE
|
||||||
|
x := 0X; r.eof := TRUE
|
||||||
|
END
|
||||||
|
END Read;
|
||||||
|
|
||||||
|
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
|
||||||
|
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
IF n > LEN(x) THEN IdxTrap END ;
|
||||||
|
xpos := 0; buf := r.buf; offset := r.offset;
|
||||||
|
WHILE n > 0 DO
|
||||||
|
IF (r.org # buf.org) OR (offset >= bufsize) THEN
|
||||||
|
Set(r, buf.f, r.org + offset);
|
||||||
|
buf := r.buf; offset := r.offset
|
||||||
|
END ;
|
||||||
|
restInBuf := buf.size - offset;
|
||||||
|
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
|
||||||
|
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
|
||||||
|
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
|
||||||
|
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
|
||||||
|
END ;
|
||||||
|
r.res := 0; r.eof := FALSE
|
||||||
|
END ReadBytes;
|
||||||
|
|
||||||
|
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
|
||||||
|
BEGIN
|
||||||
|
ReadBytes(r, x, 1);
|
||||||
|
END ReadByte;
|
||||||
|
|
||||||
|
PROCEDURE Base* (VAR r: Rider): File;
|
||||||
|
BEGIN RETURN r.buf.f
|
||||||
|
END Base;
|
||||||
|
|
||||||
|
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
|
||||||
|
VAR buf: Buffer; offset: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
buf := r.buf; offset := r.offset;
|
||||||
|
IF (r.org # buf.org) OR (offset >= bufsize) THEN
|
||||||
|
Set(r, buf.f, r.org + offset);
|
||||||
|
buf := r.buf; offset := r.offset
|
||||||
|
END ;
|
||||||
|
buf.data[offset] := x;
|
||||||
|
buf.chg := TRUE;
|
||||||
|
IF offset = buf.size THEN
|
||||||
|
INC(buf.size); INC(buf.f.len)
|
||||||
|
END ;
|
||||||
|
r.offset := offset + 1; r.res := 0
|
||||||
|
END Write;
|
||||||
|
|
||||||
|
PROCEDURE WriteByte* (VAR r : Rider; x : SYSTEM.BYTE); (* added for compatibility with PO 2013, -- noch *)
|
||||||
|
BEGIN
|
||||||
|
Write(r, x);
|
||||||
|
END WriteByte;
|
||||||
|
|
||||||
|
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
|
||||||
|
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
IF n > LEN(x) THEN IdxTrap END ;
|
||||||
|
xpos := 0; buf := r.buf; offset := r.offset;
|
||||||
|
WHILE n > 0 DO
|
||||||
|
IF (r.org # buf.org) OR (offset >= bufsize) THEN
|
||||||
|
Set(r, buf.f, r.org + offset);
|
||||||
|
buf := r.buf; offset := r.offset
|
||||||
|
END ;
|
||||||
|
restInBuf := bufsize - offset;
|
||||||
|
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
|
||||||
|
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
|
||||||
|
INC(offset, min); r.offset := offset;
|
||||||
|
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
|
||||||
|
INC(xpos, min); DEC(n, min); buf.chg := TRUE
|
||||||
|
END ;
|
||||||
|
r.res := 0
|
||||||
|
END WriteBytes;
|
||||||
|
|
||||||
|
(* another solution would be one that is similar to ReadBytes, WriteBytes.
|
||||||
|
No code duplication, more symmetric, only two ifs for
|
||||||
|
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
|
||||||
|
must be made consistent with offset (if offset > buf.size) in a lazy way.
|
||||||
|
|
||||||
|
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
|
||||||
|
VAR buf: Buffer; offset: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
buf := r.buf; offset := r.offset;
|
||||||
|
IF (offset >= bufsize) OR (r.org # buf.org) THEN
|
||||||
|
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
|
||||||
|
END ;
|
||||||
|
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
|
||||||
|
END Write;
|
||||||
|
|
||||||
|
|
||||||
|
PROCEDURE WriteBytes ...
|
||||||
|
|
||||||
|
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
|
||||||
|
VAR offset: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
buf := r.buf; offset := r.offset;
|
||||||
|
IF (offset >= buf.size) OR (r.org # buf.org) THEN
|
||||||
|
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
|
||||||
|
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
|
||||||
|
END
|
||||||
|
END ;
|
||||||
|
x := buf.data[offset]; r.offset := offset + 1
|
||||||
|
END Read;
|
||||||
|
|
||||||
|
but this would also affect Set, Length, and Flush.
|
||||||
|
Especially Length would become fairly complex.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
|
||||||
|
BEGIN
|
||||||
|
res := SHORT(Unix.Unlink(name));
|
||||||
|
res := SHORT(Unix.errno())
|
||||||
|
END Delete;
|
||||||
|
|
||||||
|
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
|
||||||
|
VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT;
|
||||||
|
ostat, nstat: Unix.Status;
|
||||||
|
buf: ARRAY 4096 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
r := Unix.Stat(old, ostat);
|
||||||
|
IF r >= 0 THEN
|
||||||
|
r := Unix.Stat(new, nstat);
|
||||||
|
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
|
||||||
|
Delete(new, res); (* work around stale nfs handles *)
|
||||||
|
END ;
|
||||||
|
r := Unix.Rename(old, new);
|
||||||
|
IF r < 0 THEN res := SHORT(Unix.errno());
|
||||||
|
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
|
||||||
|
fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {})));
|
||||||
|
IF fdold < 0 THEN res := 2; RETURN END ;
|
||||||
|
fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
|
||||||
|
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
|
||||||
|
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
|
||||||
|
WHILE n > 0 DO
|
||||||
|
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
|
||||||
|
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
|
||||||
|
Err("cannot move file", NIL, errno)
|
||||||
|
END ;
|
||||||
|
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
|
||||||
|
END ;
|
||||||
|
errno := Unix.errno();
|
||||||
|
r := Unix.Close(fdold); r := Unix.Close(fdnew);
|
||||||
|
IF n = 0 THEN r := Unix.Unlink(old); res := 0
|
||||||
|
ELSE Err("cannot move file", NIL, errno)
|
||||||
|
END ;
|
||||||
|
ELSE RETURN (* res is Unix.Rename return code *)
|
||||||
|
END
|
||||||
|
END ;
|
||||||
|
res := 0
|
||||||
|
ELSE res := 2 (* old file not found *)
|
||||||
|
END
|
||||||
|
END Rename;
|
||||||
|
|
||||||
|
PROCEDURE Register* (f: File);
|
||||||
|
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
|
||||||
|
Close(f);
|
||||||
|
IF f.registerName # "" THEN
|
||||||
|
Rename(f.workName, f.registerName, errno);
|
||||||
|
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
|
||||||
|
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
|
||||||
|
END
|
||||||
|
END Register;
|
||||||
|
|
||||||
|
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
|
||||||
|
BEGIN
|
||||||
|
res := SHORT(Unix.Chdir(path));
|
||||||
|
getcwd(Kernel.CWD)
|
||||||
|
END ChangeDirectory;
|
||||||
|
|
||||||
|
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
|
||||||
|
VAR i, j: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
|
||||||
|
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
|
||||||
|
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
|
||||||
|
END
|
||||||
|
END FlipBytes;
|
||||||
|
|
||||||
|
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
|
||||||
|
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
|
||||||
|
END ReadBool;
|
||||||
|
|
||||||
|
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
|
||||||
|
VAR b: ARRAY 2 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 2);
|
||||||
|
x := ORD(b[0]) + ORD(b[1])*256
|
||||||
|
END ReadInt;
|
||||||
|
|
||||||
|
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 4);
|
||||||
|
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
|
||||||
|
END ReadLInt;
|
||||||
|
|
||||||
|
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 4);
|
||||||
|
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
|
||||||
|
END ReadSet;
|
||||||
|
|
||||||
|
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
|
||||||
|
END ReadReal;
|
||||||
|
|
||||||
|
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
|
||||||
|
VAR b: ARRAY 8 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
|
||||||
|
END ReadLReal;
|
||||||
|
|
||||||
|
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
|
||||||
|
VAR i: INTEGER; ch: CHAR;
|
||||||
|
BEGIN i := 0;
|
||||||
|
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
|
||||||
|
END ReadString;
|
||||||
|
|
||||||
|
(* need to read line; -- noch *)
|
||||||
|
PROCEDURE ReadLine* (VAR R: Rider; VAR x: ARRAY OF CHAR);
|
||||||
|
VAR i: INTEGER; ch: CHAR; b : BOOLEAN;
|
||||||
|
BEGIN i := 0;
|
||||||
|
b := FALSE;
|
||||||
|
REPEAT
|
||||||
|
Read(R, ch);
|
||||||
|
IF ((ch = 0X) OR (ch = 0AX) OR (ch = 0DX)) THEN
|
||||||
|
b := TRUE
|
||||||
|
ELSE
|
||||||
|
x[i] := ch;
|
||||||
|
INC(i);
|
||||||
|
END;
|
||||||
|
UNTIL b
|
||||||
|
END ReadLine;
|
||||||
|
|
||||||
|
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
|
||||||
|
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
|
||||||
|
BEGIN s := 0; n := 0; Read(R, ch);
|
||||||
|
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
|
||||||
|
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
|
||||||
|
x := n
|
||||||
|
END ReadNum;
|
||||||
|
|
||||||
|
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
|
||||||
|
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
|
||||||
|
END WriteBool;
|
||||||
|
|
||||||
|
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
|
||||||
|
VAR b: ARRAY 2 OF CHAR;
|
||||||
|
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
|
||||||
|
WriteBytes(R, b, 2);
|
||||||
|
END WriteInt;
|
||||||
|
|
||||||
|
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
|
||||||
|
WriteBytes(R, b, 4);
|
||||||
|
END WriteLInt;
|
||||||
|
|
||||||
|
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
|
||||||
|
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
|
||||||
|
BEGIN i := SYSTEM.VAL(LONGINT, x);
|
||||||
|
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
|
||||||
|
WriteBytes(R, b, 4);
|
||||||
|
END WriteSet;
|
||||||
|
|
||||||
|
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
|
||||||
|
END WriteReal;
|
||||||
|
|
||||||
|
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
|
||||||
|
VAR b: ARRAY 8 OF CHAR;
|
||||||
|
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
|
||||||
|
END WriteLReal;
|
||||||
|
|
||||||
|
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
|
||||||
|
VAR i: INTEGER;
|
||||||
|
BEGIN i := 0;
|
||||||
|
WHILE x[i] # 0X DO INC(i) END ;
|
||||||
|
WriteBytes(R, x, i+1)
|
||||||
|
END WriteString;
|
||||||
|
|
||||||
|
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
|
||||||
|
BEGIN
|
||||||
|
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
|
||||||
|
Write(R, CHR(x MOD 128))
|
||||||
|
END WriteNum;
|
||||||
|
|
||||||
|
PROCEDURE GetName*(f: File; VAR name: ARRAY OF CHAR);
|
||||||
|
BEGIN
|
||||||
|
COPY (f.workName, name);
|
||||||
|
END GetName;
|
||||||
|
|
||||||
|
PROCEDURE Finalize(o: SYSTEM.PTR);
|
||||||
|
VAR f: File; res: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
f := SYSTEM.VAL(File, o);
|
||||||
|
IF f.fd >= 0 THEN
|
||||||
|
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
|
||||||
|
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
|
||||||
|
END
|
||||||
|
END Finalize;
|
||||||
|
|
||||||
|
PROCEDURE Init;
|
||||||
|
VAR i: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
|
||||||
|
tempno := -1; Kernel.nofiles := 0
|
||||||
|
END Init;
|
||||||
|
|
||||||
|
BEGIN Init
|
||||||
|
END Files.
|
||||||
636
src/lib/system/openbsd/gcc/x86_64/Files0.Mod
Normal file
636
src/lib/system/openbsd/gcc/x86_64/Files0.Mod
Normal file
|
|
@ -0,0 +1,636 @@
|
||||||
|
MODULE Files0; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files *)
|
||||||
|
|
||||||
|
(* this module is not for use by developers and inteded to bootstrap voc *)
|
||||||
|
(* for general use import Files module *)
|
||||||
|
|
||||||
|
IMPORT SYSTEM, Unix, Kernel := Kernel0, Args, Console;
|
||||||
|
|
||||||
|
(* standard data type I/O
|
||||||
|
|
||||||
|
little endian,
|
||||||
|
Sint:1, Int:2, Lint:4
|
||||||
|
ORD({0}) = 1,
|
||||||
|
false = 0, true =1
|
||||||
|
IEEE real format,
|
||||||
|
null terminated strings,
|
||||||
|
compact numbers according to M.Odersky *)
|
||||||
|
|
||||||
|
|
||||||
|
CONST
|
||||||
|
nofbufs = 4;
|
||||||
|
bufsize = 4096;
|
||||||
|
fileTabSize = 64;
|
||||||
|
noDesc = -1;
|
||||||
|
notDone = -1;
|
||||||
|
|
||||||
|
(* file states *)
|
||||||
|
open = 0; create = 1; close = 2;
|
||||||
|
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
FileName = ARRAY 101 OF CHAR;
|
||||||
|
File* = POINTER TO Handle;
|
||||||
|
Buffer = POINTER TO BufDesc;
|
||||||
|
|
||||||
|
Handle = RECORD
|
||||||
|
workName, registerName: FileName;
|
||||||
|
tempFile: BOOLEAN;
|
||||||
|
dev, ino, mtime: LONGINT;
|
||||||
|
fd-: INTEGER;
|
||||||
|
len, pos: LONGINT;
|
||||||
|
bufs: ARRAY nofbufs OF Buffer;
|
||||||
|
swapper, state: INTEGER
|
||||||
|
END ;
|
||||||
|
|
||||||
|
BufDesc = RECORD
|
||||||
|
f: File;
|
||||||
|
chg: BOOLEAN;
|
||||||
|
org, size: LONGINT;
|
||||||
|
data: ARRAY bufsize OF SYSTEM.BYTE
|
||||||
|
END ;
|
||||||
|
|
||||||
|
Rider* = RECORD
|
||||||
|
res*: LONGINT;
|
||||||
|
eof*: BOOLEAN;
|
||||||
|
buf: Buffer;
|
||||||
|
org, offset: LONGINT
|
||||||
|
END ;
|
||||||
|
|
||||||
|
Time = POINTER TO TimeDesc;
|
||||||
|
TimeDesc = RECORD
|
||||||
|
sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: LONGINT;
|
||||||
|
(* sec*, min*, hour*, mday*, mon*, year*, wday*, isdst*, zone*, gmtoff*: INTEGER;*)
|
||||||
|
END ;
|
||||||
|
|
||||||
|
VAR
|
||||||
|
fileTab: ARRAY fileTabSize OF LONGINT (*=File*);
|
||||||
|
tempno: INTEGER;
|
||||||
|
|
||||||
|
(* for localtime *)
|
||||||
|
PROCEDURE -includetime()
|
||||||
|
'#include "time.h"';
|
||||||
|
|
||||||
|
PROCEDURE -localtime(VAR clock: LONGINT): Time
|
||||||
|
"(Files0_Time) localtime(clock)";
|
||||||
|
|
||||||
|
PROCEDURE -getcwd(VAR cwd: Unix.Name)
|
||||||
|
"getcwd(cwd, cwd__len)";
|
||||||
|
|
||||||
|
PROCEDURE -IdxTrap "__HALT(-1)";
|
||||||
|
|
||||||
|
PROCEDURE^ Finalize(o: SYSTEM.PTR);
|
||||||
|
|
||||||
|
PROCEDURE Err(s: ARRAY OF CHAR; f: File; errno: LONGINT);
|
||||||
|
BEGIN
|
||||||
|
Console.Ln; Console.String("-- "); Console.String(s); Console.String(": ");
|
||||||
|
IF f # NIL THEN
|
||||||
|
IF f.registerName # "" THEN Console.String(f.registerName) ELSE Console.String(f.workName) END
|
||||||
|
END ;
|
||||||
|
IF errno # 0 THEN Console.String(" errno = "); Console.Int(errno, 1) END ;
|
||||||
|
Console.Ln;
|
||||||
|
HALT(99)
|
||||||
|
END Err;
|
||||||
|
|
||||||
|
PROCEDURE MakeFileName(dir, name: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR);
|
||||||
|
VAR i, j: INTEGER;
|
||||||
|
BEGIN i := 0; j := 0;
|
||||||
|
WHILE dir[i] # 0X DO dest[i] := dir[i]; INC(i) END ;
|
||||||
|
IF dest[i-1] # "/" THEN dest[i] := "/"; INC(i) END ;
|
||||||
|
WHILE name[j] # 0X DO dest[i] := name[j]; INC(i); INC(j) END ;
|
||||||
|
dest[i] := 0X
|
||||||
|
END MakeFileName;
|
||||||
|
|
||||||
|
PROCEDURE GetTempName(finalName: ARRAY OF CHAR; VAR name: ARRAY OF CHAR);
|
||||||
|
VAR n, i, j: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
INC(tempno); n := tempno; i := 0;
|
||||||
|
IF finalName[0] # "/" THEN (* relative pathname *)
|
||||||
|
WHILE Kernel.CWD[i] # 0X DO name[i] := Kernel.CWD[i]; INC(i) END;
|
||||||
|
IF Kernel.CWD[i-1] # "/" THEN name[i] := "/"; INC(i) END
|
||||||
|
END;
|
||||||
|
j := 0;
|
||||||
|
WHILE finalName[j] # 0X DO name[i] := finalName[j]; INC(i); INC(j) END;
|
||||||
|
DEC(i);
|
||||||
|
WHILE name[i] # "/" DO DEC(i) END;
|
||||||
|
name[i+1] := "."; name[i+2] := "t"; name[i+3] := "m"; name[i+4] := "p"; name[i+5] := "."; INC(i, 6);
|
||||||
|
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
|
||||||
|
name[i] := "."; INC(i); n := SHORT(Unix.Getpid());
|
||||||
|
WHILE n > 0 DO name[i] := CHR(n MOD 10 + ORD("0")); n := n DIV 10; INC(i) END;
|
||||||
|
name[i] := 0X
|
||||||
|
END GetTempName;
|
||||||
|
|
||||||
|
PROCEDURE Create(f: File);
|
||||||
|
VAR stat: Unix.Status; done: BOOLEAN;
|
||||||
|
errno: LONGINT; err: ARRAY 32 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
IF f.fd = noDesc THEN
|
||||||
|
IF f.state = create THEN GetTempName(f.registerName, f.workName); f.tempFile := TRUE
|
||||||
|
ELSIF f.state = close THEN
|
||||||
|
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
|
||||||
|
END ;
|
||||||
|
errno := Unix.Unlink(f.workName); (*unlink first to avoid stale NFS handles and to avoid reuse of inodes*)
|
||||||
|
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, ({2, 4,5, 7,8}))));
|
||||||
|
done := f.fd >= 0; errno := Unix.errno();
|
||||||
|
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (f.fd >= fileTabSize)) THEN
|
||||||
|
IF done & (f.fd >= fileTabSize) THEN errno := Unix.Close(f.fd) END ;
|
||||||
|
Kernel.GC(TRUE);
|
||||||
|
f.fd := Unix.Open(f.workName, SHORT(SYSTEM.VAL(LONGINT, (Unix.rdwr + Unix.creat + Unix.trunc))), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
|
||||||
|
done := f.fd >= 0
|
||||||
|
END ;
|
||||||
|
IF done THEN
|
||||||
|
IF f.fd >= fileTabSize THEN errno := Unix.Close(f.fd); Err("too many files open", f, 0)
|
||||||
|
ELSE fileTab[f.fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
|
||||||
|
f.state := open; f.pos := 0; errno := Unix.Fstat(f.fd, stat);
|
||||||
|
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime
|
||||||
|
END
|
||||||
|
ELSE errno := Unix.errno();
|
||||||
|
IF errno = Unix.ENOENT THEN err := "no such directory"
|
||||||
|
ELSIF (errno = Unix.ENFILE) OR (errno = Unix.EMFILE) THEN err := "too many files open"
|
||||||
|
ELSE err := "file not created"
|
||||||
|
END ;
|
||||||
|
Err(err, f, errno)
|
||||||
|
END
|
||||||
|
END
|
||||||
|
END Create;
|
||||||
|
|
||||||
|
PROCEDURE Flush(buf: Buffer);
|
||||||
|
VAR res: LONGINT; f: File; stat: Unix.Status;
|
||||||
|
BEGIN
|
||||||
|
IF buf.chg THEN f := buf.f; Create(f);
|
||||||
|
IF buf.org # f.pos THEN res := Unix.Lseek(f.fd, buf.org, 0) END ;
|
||||||
|
res := Unix.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
|
||||||
|
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END ;
|
||||||
|
f.pos := buf.org + buf.size;
|
||||||
|
buf.chg := FALSE;
|
||||||
|
res := Unix.Fstat(f.fd, stat);
|
||||||
|
f.mtime := stat.mtime
|
||||||
|
END
|
||||||
|
END Flush;
|
||||||
|
|
||||||
|
PROCEDURE Close* (f: File);
|
||||||
|
VAR i, res: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
IF (f.state # create) OR (f.registerName # "") THEN
|
||||||
|
Create(f); i := 0;
|
||||||
|
WHILE (i < nofbufs) & (f.bufs[i] # NIL) DO Flush(f.bufs[i]); INC(i) END ;
|
||||||
|
res := Unix.Fsync(f.fd);
|
||||||
|
IF res < 0 THEN Err("error in writing file", f, Unix.errno()) END
|
||||||
|
END
|
||||||
|
END Close;
|
||||||
|
|
||||||
|
PROCEDURE Length* (f: File): LONGINT;
|
||||||
|
BEGIN RETURN f.len
|
||||||
|
END Length;
|
||||||
|
|
||||||
|
PROCEDURE New* (name: ARRAY OF CHAR): File;
|
||||||
|
VAR f: File;
|
||||||
|
BEGIN
|
||||||
|
NEW(f); f.workName := ""; COPY(name, f.registerName);
|
||||||
|
f.fd := noDesc; f.state := create; f.len := 0; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
|
||||||
|
RETURN f
|
||||||
|
END New;
|
||||||
|
|
||||||
|
PROCEDURE ScanPath(VAR pos: INTEGER; VAR dir: ARRAY OF CHAR); (* supports ~, ~user and blanks inside path *)
|
||||||
|
VAR i: INTEGER; ch: CHAR; home: ARRAY 256 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
i := 0; ch := Kernel.OBERON[pos];
|
||||||
|
WHILE (ch = " ") OR (ch = ":") DO INC(pos); ch := Kernel.OBERON[pos] END ;
|
||||||
|
IF ch = "~" THEN
|
||||||
|
INC(pos); ch := Kernel.OBERON[pos];
|
||||||
|
home := ""; Args.GetEnv("HOME", home);
|
||||||
|
WHILE home[i] # 0X DO dir[i] := home[i]; INC(i) END ;
|
||||||
|
IF (ch # "/") & (ch # 0X) & (ch # ":") & (ch # " ") THEN
|
||||||
|
WHILE (i > 0) & (dir[i-1] # "/") DO DEC(i) END
|
||||||
|
END
|
||||||
|
END ;
|
||||||
|
WHILE (ch # 0X) & (ch # ":") DO dir[i] := ch; INC(i); INC(pos); ch := Kernel.OBERON[pos] END ;
|
||||||
|
WHILE (i > 0) & (dir[i-1] = " ") DO DEC(i) END ;
|
||||||
|
dir[i] := 0X
|
||||||
|
END ScanPath;
|
||||||
|
|
||||||
|
PROCEDURE HasDir(VAR name: ARRAY OF CHAR): BOOLEAN;
|
||||||
|
VAR i: INTEGER; ch: CHAR;
|
||||||
|
BEGIN i := 0; ch := name[0];
|
||||||
|
WHILE (ch # 0X) & (ch # "/") DO INC(i); ch := name[i] END ;
|
||||||
|
RETURN ch = "/"
|
||||||
|
END HasDir;
|
||||||
|
|
||||||
|
PROCEDURE CacheEntry(dev, ino: LONGINT; mtime: LONGINT): File;
|
||||||
|
VAR f: File; i: INTEGER; stat: Unix.Status; res: LONGINT;
|
||||||
|
BEGIN i := 0;
|
||||||
|
WHILE i < fileTabSize DO
|
||||||
|
f := SYSTEM.VAL(File, fileTab[i]);
|
||||||
|
IF (f # NIL) & (ino = f.ino) & (dev = f.dev) THEN
|
||||||
|
IF mtime # f.mtime THEN i := 0;
|
||||||
|
WHILE i < nofbufs DO
|
||||||
|
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
|
||||||
|
INC(i)
|
||||||
|
END ;
|
||||||
|
f.swapper := -1; f.mtime := mtime;
|
||||||
|
res := Unix.Fstat(f.fd, stat); f.len := stat.size
|
||||||
|
END ;
|
||||||
|
RETURN f
|
||||||
|
END ;
|
||||||
|
INC(i)
|
||||||
|
END ;
|
||||||
|
RETURN NIL
|
||||||
|
END CacheEntry;
|
||||||
|
|
||||||
|
PROCEDURE Old* (name: ARRAY OF CHAR): File;
|
||||||
|
VAR f: File; fd: INTEGER; res, errno: LONGINT; pos: INTEGER; done: BOOLEAN;
|
||||||
|
dir, path: ARRAY 256 OF CHAR;
|
||||||
|
stat: Unix.Status;
|
||||||
|
BEGIN
|
||||||
|
IF name # "" THEN
|
||||||
|
IF HasDir(name) THEN dir := ""; COPY(name, path)
|
||||||
|
ELSE pos := 0; ScanPath(pos, dir); MakeFileName(dir, name, path); ScanPath(pos, dir)
|
||||||
|
END ;
|
||||||
|
LOOP
|
||||||
|
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno();
|
||||||
|
IF (~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE))) OR (done & (fd >= fileTabSize)) THEN
|
||||||
|
IF done & (fd >= fileTabSize) THEN res := Unix.Close(fd) END ;
|
||||||
|
Kernel.GC(TRUE);
|
||||||
|
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr)), SHORT(SYSTEM.VAL(LONGINT, {})));
|
||||||
|
done := fd >= 0; errno := Unix.errno();
|
||||||
|
IF ~done & ((errno = Unix.ENFILE) OR (errno = Unix.EMFILE)) THEN Err("too many files open", f, errno) END
|
||||||
|
END ;
|
||||||
|
IF ~done & ((errno = Unix.EACCES) OR (errno = Unix.EROFS) OR (errno = Unix.EAGAIN)) THEN
|
||||||
|
(* errno EAGAIN observed on Solaris 2.4 *)
|
||||||
|
fd := Unix.Open(path, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {}))); done := fd >= 0; errno := Unix.errno()
|
||||||
|
END ;
|
||||||
|
IF (~done) & (errno # Unix.ENOENT) THEN
|
||||||
|
Console.String("warning Files0.Old "); Console.String(name);
|
||||||
|
Console.String(" errno = "); Console.Int(errno, 0); Console.Ln;
|
||||||
|
END ;
|
||||||
|
IF done THEN
|
||||||
|
res := Unix.Fstat(fd, stat);
|
||||||
|
f := CacheEntry(stat.dev, stat.ino, stat.mtime);
|
||||||
|
IF f # NIL THEN res := Unix.Close(fd); RETURN f
|
||||||
|
ELSIF fd >= fileTabSize THEN res := Unix.Close(fd); Err("too many files open", f, 0)
|
||||||
|
ELSE NEW(f); fileTab[fd] := SYSTEM.VAL(LONGINT, f); INC(Kernel.nofiles); Kernel.RegisterObject(f, Finalize);
|
||||||
|
f.fd := fd; f.state := open; f.len := stat.size; f.pos := 0; f.swapper := -1; (*all f.buf[i] = NIL*)
|
||||||
|
COPY(name, f.workName); f.registerName := ""; f.tempFile := FALSE;
|
||||||
|
f.dev := stat.dev; f.ino := stat.ino; f.mtime := stat.mtime;
|
||||||
|
RETURN f
|
||||||
|
END
|
||||||
|
ELSIF dir = "" THEN RETURN NIL
|
||||||
|
ELSE MakeFileName(dir, name, path); ScanPath(pos, dir)
|
||||||
|
END
|
||||||
|
END
|
||||||
|
ELSE RETURN NIL
|
||||||
|
END
|
||||||
|
END Old;
|
||||||
|
|
||||||
|
PROCEDURE Purge* (f: File);
|
||||||
|
VAR i: INTEGER; stat: Unix.Status; res: LONGINT;
|
||||||
|
BEGIN i := 0;
|
||||||
|
WHILE i < nofbufs DO
|
||||||
|
IF f.bufs[i] # NIL THEN f.bufs[i].org := -1; f.bufs[i] := NIL END ;
|
||||||
|
INC(i)
|
||||||
|
END ;
|
||||||
|
IF f.fd # noDesc THEN res := Unix.Ftruncate(f.fd, 0); res := Unix.Lseek(f.fd, 0, 0) END ;
|
||||||
|
f.pos := 0; f.len := 0; f.swapper := -1;
|
||||||
|
res := Unix.Fstat(f.fd, stat); f.mtime := stat.mtime
|
||||||
|
END Purge;
|
||||||
|
|
||||||
|
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
|
||||||
|
VAR stat: Unix.Status; clock, res: LONGINT; time: Time;
|
||||||
|
BEGIN
|
||||||
|
Create(f); res := Unix.Fstat(f.fd, stat);
|
||||||
|
time := localtime(stat.mtime);
|
||||||
|
t := time.sec + ASH(time.min, 6) + ASH(time.hour, 12);
|
||||||
|
d := time.mday + ASH(time.mon+1, 5) + ASH(time.year MOD 100, 9)
|
||||||
|
END GetDate;
|
||||||
|
|
||||||
|
PROCEDURE Pos* (VAR r: Rider): LONGINT;
|
||||||
|
BEGIN RETURN r.org + r.offset
|
||||||
|
END Pos;
|
||||||
|
|
||||||
|
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
|
||||||
|
VAR org, offset, i, n, res: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
IF f # NIL THEN
|
||||||
|
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END ;
|
||||||
|
offset := pos MOD bufsize; org := pos - offset; i := 0;
|
||||||
|
WHILE (i < nofbufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END ;
|
||||||
|
IF i < nofbufs THEN
|
||||||
|
IF f.bufs[i] = NIL THEN NEW(buf); buf.chg := FALSE; buf.org := -1; buf.f := f; f.bufs[i] := buf
|
||||||
|
ELSE buf := f.bufs[i]
|
||||||
|
END
|
||||||
|
ELSE
|
||||||
|
f.swapper := (f.swapper + 1) MOD nofbufs;
|
||||||
|
buf := f.bufs[f.swapper];
|
||||||
|
Flush(buf)
|
||||||
|
END ;
|
||||||
|
IF buf.org # org THEN
|
||||||
|
IF org = f.len THEN buf.size := 0
|
||||||
|
ELSE Create(f);
|
||||||
|
IF f.pos # org THEN res := Unix.Lseek(f.fd, org, 0) END ;
|
||||||
|
n := Unix.ReadBlk(f.fd, buf.data);
|
||||||
|
IF n < 0 THEN Err("read from file not done", f, Unix.errno()) END ;
|
||||||
|
f.pos := org + n;
|
||||||
|
buf.size := n
|
||||||
|
END ;
|
||||||
|
buf.org := org; buf.chg := FALSE
|
||||||
|
END
|
||||||
|
ELSE buf := NIL; org := 0; offset := 0
|
||||||
|
END ;
|
||||||
|
r.buf := buf; r.org := org; r.offset := offset; r.eof := FALSE; r.res := 0
|
||||||
|
END Set;
|
||||||
|
|
||||||
|
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
|
||||||
|
VAR offset: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
buf := r.buf; offset := r.offset;
|
||||||
|
IF r.org # buf.org THEN Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset END ;
|
||||||
|
IF (offset < buf.size) THEN
|
||||||
|
x := buf.data[offset]; r.offset := offset + 1
|
||||||
|
ELSIF r.org + offset < buf.f.len THEN
|
||||||
|
Set(r, r.buf.f, r.org + offset);
|
||||||
|
x := r.buf.data[0]; r.offset := 1
|
||||||
|
ELSE
|
||||||
|
x := 0X; r.eof := TRUE
|
||||||
|
END
|
||||||
|
END Read;
|
||||||
|
|
||||||
|
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
|
||||||
|
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
IF n > LEN(x) THEN IdxTrap END ;
|
||||||
|
xpos := 0; buf := r.buf; offset := r.offset;
|
||||||
|
WHILE n > 0 DO
|
||||||
|
IF (r.org # buf.org) OR (offset >= bufsize) THEN
|
||||||
|
Set(r, buf.f, r.org + offset);
|
||||||
|
buf := r.buf; offset := r.offset
|
||||||
|
END ;
|
||||||
|
restInBuf := buf.size - offset;
|
||||||
|
IF restInBuf = 0 THEN r.res := n; r.eof := TRUE; RETURN
|
||||||
|
ELSIF n > restInBuf THEN min := restInBuf ELSE min := n END ;
|
||||||
|
SYSTEM.MOVE(SYSTEM.ADR(buf.data) + offset, SYSTEM.ADR(x) + xpos, min);
|
||||||
|
INC(offset, min); r.offset := offset; INC(xpos, min); DEC(n, min)
|
||||||
|
END ;
|
||||||
|
r.res := 0; r.eof := FALSE
|
||||||
|
END ReadBytes;
|
||||||
|
|
||||||
|
PROCEDURE ReadByte* (VAR r : Rider; VAR x : ARRAY OF SYSTEM.BYTE);
|
||||||
|
BEGIN
|
||||||
|
ReadBytes(r, x, 1);
|
||||||
|
END ReadByte;
|
||||||
|
|
||||||
|
PROCEDURE Base* (VAR r: Rider): File;
|
||||||
|
BEGIN RETURN r.buf.f
|
||||||
|
END Base;
|
||||||
|
|
||||||
|
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
|
||||||
|
VAR buf: Buffer; offset: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
buf := r.buf; offset := r.offset;
|
||||||
|
IF (r.org # buf.org) OR (offset >= bufsize) THEN
|
||||||
|
Set(r, buf.f, r.org + offset);
|
||||||
|
buf := r.buf; offset := r.offset
|
||||||
|
END ;
|
||||||
|
buf.data[offset] := x;
|
||||||
|
buf.chg := TRUE;
|
||||||
|
IF offset = buf.size THEN
|
||||||
|
INC(buf.size); INC(buf.f.len)
|
||||||
|
END ;
|
||||||
|
r.offset := offset + 1; r.res := 0
|
||||||
|
END Write;
|
||||||
|
|
||||||
|
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
|
||||||
|
VAR xpos, min, restInBuf, offset: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
IF n > LEN(x) THEN IdxTrap END ;
|
||||||
|
xpos := 0; buf := r.buf; offset := r.offset;
|
||||||
|
WHILE n > 0 DO
|
||||||
|
IF (r.org # buf.org) OR (offset >= bufsize) THEN
|
||||||
|
Set(r, buf.f, r.org + offset);
|
||||||
|
buf := r.buf; offset := r.offset
|
||||||
|
END ;
|
||||||
|
restInBuf := bufsize - offset;
|
||||||
|
IF n > restInBuf THEN min := restInBuf ELSE min := n END ;
|
||||||
|
SYSTEM.MOVE(SYSTEM.ADR(x) + xpos, SYSTEM.ADR(buf.data) + offset, min);
|
||||||
|
INC(offset, min); r.offset := offset;
|
||||||
|
IF offset > buf.size THEN INC(buf.f.len, offset - buf.size); buf.size := offset END ;
|
||||||
|
INC(xpos, min); DEC(n, min); buf.chg := TRUE
|
||||||
|
END ;
|
||||||
|
r.res := 0
|
||||||
|
END WriteBytes;
|
||||||
|
|
||||||
|
(* another solution would be one that is similar to ReadBytes, WriteBytes.
|
||||||
|
No code duplication, more symmetric, only two ifs for
|
||||||
|
Read and Write in buffer, buf.size replaced by bufsize in Write ops, buf.size and len
|
||||||
|
must be made consistent with offset (if offset > buf.size) in a lazy way.
|
||||||
|
|
||||||
|
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
|
||||||
|
VAR buf: Buffer; offset: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
buf := r.buf; offset := r.offset;
|
||||||
|
IF (offset >= bufsize) OR (r.org # buf.org) THEN
|
||||||
|
Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset;
|
||||||
|
END ;
|
||||||
|
buf.data[offset] := x; r.offset := offset + 1; buf.chg := TRUE
|
||||||
|
END Write;
|
||||||
|
|
||||||
|
PROCEDURE WriteBytes ...
|
||||||
|
|
||||||
|
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
|
||||||
|
VAR offset: LONGINT; buf: Buffer;
|
||||||
|
BEGIN
|
||||||
|
buf := r.buf; offset := r.offset;
|
||||||
|
IF (offset >= buf.size) OR (r.org # buf.org) THEN
|
||||||
|
IF r.org + offset >= buf.f.len THEN x := 0X; r.eof := TRUE; RETURN
|
||||||
|
ELSE Set(r, buf.f, r.org + offset); buf := r.buf; offset := r.offset
|
||||||
|
END
|
||||||
|
END ;
|
||||||
|
x := buf.data[offset]; r.offset := offset + 1
|
||||||
|
END Read;
|
||||||
|
|
||||||
|
but this would also affect Set, Length, and Flush.
|
||||||
|
Especially Length would become fairly complex.
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
|
||||||
|
BEGIN
|
||||||
|
res := SHORT(Unix.Unlink(name));
|
||||||
|
res := SHORT(Unix.errno())
|
||||||
|
END Delete;
|
||||||
|
|
||||||
|
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
|
||||||
|
VAR fdold, fdnew: INTEGER; n, errno, r: LONGINT;
|
||||||
|
ostat, nstat: Unix.Status;
|
||||||
|
buf: ARRAY 4096 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
r := Unix.Stat(old, ostat);
|
||||||
|
IF r >= 0 THEN
|
||||||
|
r := Unix.Stat(new, nstat);
|
||||||
|
IF (r >= 0) & ((ostat.dev # nstat.dev) OR (ostat.ino # nstat.ino)) THEN
|
||||||
|
Delete(new, res); (* work around stale nfs handles *)
|
||||||
|
END ;
|
||||||
|
r := Unix.Rename(old, new);
|
||||||
|
IF r < 0 THEN res := SHORT(Unix.errno());
|
||||||
|
IF res = Unix.EXDEV THEN (* cross device link, move the file *)
|
||||||
|
fdold := Unix.Open(old, SHORT(SYSTEM.VAL(LONGINT, Unix.rdonly)), SHORT(SYSTEM.VAL(LONGINT, {})));
|
||||||
|
IF fdold < 0 THEN res := 2; RETURN END ;
|
||||||
|
fdnew := Unix.Open(new, SHORT(SYSTEM.VAL(LONGINT, Unix.rdwr + Unix.creat + Unix.trunc)), SHORT(SYSTEM.VAL(LONGINT, {2, 4,5, 7,8})));
|
||||||
|
IF fdnew < 0 THEN r := Unix.Close(fdold); res := 3; RETURN END ;
|
||||||
|
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize);
|
||||||
|
WHILE n > 0 DO
|
||||||
|
r := Unix.Write(fdnew, SYSTEM.ADR(buf), n);
|
||||||
|
IF r < 0 THEN errno := Unix.errno(); r := Unix.Close(fdold); r := Unix.Close(fdnew);
|
||||||
|
Err("cannot move file", NIL, errno)
|
||||||
|
END ;
|
||||||
|
n := Unix.Read(fdold, SYSTEM.ADR(buf), bufsize)
|
||||||
|
END ;
|
||||||
|
errno := Unix.errno();
|
||||||
|
r := Unix.Close(fdold); r := Unix.Close(fdnew);
|
||||||
|
IF n = 0 THEN r := Unix.Unlink(old); res := 0
|
||||||
|
ELSE Err("cannot move file", NIL, errno)
|
||||||
|
END ;
|
||||||
|
ELSE RETURN (* res is Unix.Rename return code *)
|
||||||
|
END
|
||||||
|
END ;
|
||||||
|
res := 0
|
||||||
|
ELSE res := 2 (* old file not found *)
|
||||||
|
END
|
||||||
|
END Rename;
|
||||||
|
|
||||||
|
PROCEDURE Register* (f: File);
|
||||||
|
VAR idx, errno: INTEGER; f1: File; file: ARRAY 104 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
IF (f.state = create) & (f.registerName # "") THEN f.state := close (* shortcut renaming *) END ;
|
||||||
|
Close(f);
|
||||||
|
IF f.registerName # "" THEN
|
||||||
|
Rename(f.workName, f.registerName, errno);
|
||||||
|
IF errno # 0 THEN COPY(f.registerName, file); HALT(99) END ;
|
||||||
|
f.workName := f.registerName; f.registerName := ""; f.tempFile := FALSE
|
||||||
|
END
|
||||||
|
END Register;
|
||||||
|
|
||||||
|
PROCEDURE ChangeDirectory*(path: ARRAY OF CHAR; VAR res: INTEGER);
|
||||||
|
BEGIN
|
||||||
|
res := SHORT(Unix.Chdir(path));
|
||||||
|
getcwd(Kernel.CWD)
|
||||||
|
END ChangeDirectory;
|
||||||
|
|
||||||
|
PROCEDURE FlipBytes(VAR src, dest: ARRAY OF SYSTEM.BYTE);
|
||||||
|
VAR i, j: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
IF ~Kernel.littleEndian THEN i := LEN(src); j := 0;
|
||||||
|
WHILE i > 0 DO DEC(i); dest[j] := src[i]; INC(j) END
|
||||||
|
ELSE SYSTEM.MOVE(SYSTEM.ADR(src), SYSTEM.ADR(dest), LEN(src))
|
||||||
|
END
|
||||||
|
END FlipBytes;
|
||||||
|
|
||||||
|
PROCEDURE ReadBool* (VAR R: Rider; VAR x: BOOLEAN);
|
||||||
|
BEGIN Read(R, SYSTEM.VAL(CHAR, x))
|
||||||
|
END ReadBool;
|
||||||
|
|
||||||
|
PROCEDURE ReadInt* (VAR R: Rider; VAR x: INTEGER);
|
||||||
|
VAR b: ARRAY 2 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 2);
|
||||||
|
x := ORD(b[0]) + ORD(b[1])*256
|
||||||
|
END ReadInt;
|
||||||
|
|
||||||
|
PROCEDURE ReadLInt* (VAR R: Rider; VAR x: LONGINT);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 4);
|
||||||
|
x := ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H
|
||||||
|
END ReadLInt;
|
||||||
|
|
||||||
|
PROCEDURE ReadSet* (VAR R: Rider; VAR x: SET);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 4);
|
||||||
|
x := SYSTEM.VAL(SET, ORD(b[0]) + ORD(b[1])*100H + ORD(b[2])*10000H + ORD(b[3])*1000000H)
|
||||||
|
END ReadSet;
|
||||||
|
|
||||||
|
PROCEDURE ReadReal* (VAR R: Rider; VAR x: REAL);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 4); FlipBytes(b, x)
|
||||||
|
END ReadReal;
|
||||||
|
|
||||||
|
PROCEDURE ReadLReal* (VAR R: Rider; VAR x: LONGREAL);
|
||||||
|
VAR b: ARRAY 8 OF CHAR;
|
||||||
|
BEGIN ReadBytes(R, b, 8); FlipBytes(b, x)
|
||||||
|
END ReadLReal;
|
||||||
|
|
||||||
|
PROCEDURE ReadString* (VAR R: Rider; VAR x: ARRAY OF CHAR);
|
||||||
|
VAR i: INTEGER; ch: CHAR;
|
||||||
|
BEGIN i := 0;
|
||||||
|
REPEAT Read(R, ch); x[i] := ch; INC(i) UNTIL ch = 0X
|
||||||
|
END ReadString;
|
||||||
|
|
||||||
|
PROCEDURE ReadNum* (VAR R: Rider; VAR x: LONGINT);
|
||||||
|
VAR s: SHORTINT; ch: CHAR; n: LONGINT;
|
||||||
|
BEGIN s := 0; n := 0; Read(R, ch);
|
||||||
|
WHILE ORD(ch) >= 128 DO INC(n, ASH(ORD(ch) - 128, s) ); INC(s, 7); Read(R, ch) END;
|
||||||
|
INC(n, ASH(ORD(ch) MOD 64 - ORD(ch) DIV 64 * 64, s) );
|
||||||
|
x := n
|
||||||
|
END ReadNum;
|
||||||
|
|
||||||
|
PROCEDURE WriteBool* (VAR R: Rider; x: BOOLEAN);
|
||||||
|
BEGIN Write(R, SYSTEM.VAL(CHAR, x))
|
||||||
|
END WriteBool;
|
||||||
|
|
||||||
|
PROCEDURE WriteInt* (VAR R: Rider; x: INTEGER);
|
||||||
|
VAR b: ARRAY 2 OF CHAR;
|
||||||
|
BEGIN b[0] := CHR(x); b[1] := CHR(x DIV 256);
|
||||||
|
WriteBytes(R, b, 2);
|
||||||
|
END WriteInt;
|
||||||
|
|
||||||
|
PROCEDURE WriteLInt* (VAR R: Rider; x: LONGINT);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
b[0] := CHR(x); b[1] := CHR(x DIV 100H); b[2] := CHR(x DIV 10000H); b[3] := CHR(x DIV 1000000H);
|
||||||
|
WriteBytes(R, b, 4);
|
||||||
|
END WriteLInt;
|
||||||
|
|
||||||
|
PROCEDURE WriteSet* (VAR R: Rider; x: SET);
|
||||||
|
VAR b: ARRAY 4 OF CHAR; i: LONGINT;
|
||||||
|
BEGIN i := SYSTEM.VAL(LONGINT, x);
|
||||||
|
b[0] := CHR(i); b[1] := CHR(i DIV 100H); b[2] := CHR(i DIV 10000H); b[3] := CHR(i DIV 1000000H);
|
||||||
|
WriteBytes(R, b, 4);
|
||||||
|
END WriteSet;
|
||||||
|
|
||||||
|
PROCEDURE WriteReal* (VAR R: Rider; x: REAL);
|
||||||
|
VAR b: ARRAY 4 OF CHAR;
|
||||||
|
BEGIN FlipBytes(x, b); WriteBytes(R, b, 4)
|
||||||
|
END WriteReal;
|
||||||
|
|
||||||
|
PROCEDURE WriteLReal* (VAR R: Rider; x: LONGREAL);
|
||||||
|
VAR b: ARRAY 8 OF CHAR;
|
||||||
|
BEGIN FlipBytes(x, b); WriteBytes(R, b, 8)
|
||||||
|
END WriteLReal;
|
||||||
|
|
||||||
|
PROCEDURE WriteString* (VAR R: Rider; x: ARRAY [1] OF CHAR);
|
||||||
|
VAR i: INTEGER;
|
||||||
|
BEGIN i := 0;
|
||||||
|
WHILE x[i] # 0X DO INC(i) END ;
|
||||||
|
WriteBytes(R, x, i+1)
|
||||||
|
END WriteString;
|
||||||
|
|
||||||
|
PROCEDURE WriteNum* (VAR R: Rider; x: LONGINT);
|
||||||
|
BEGIN
|
||||||
|
WHILE (x < - 64) OR (x > 63) DO Write(R, CHR(x MOD 128 + 128)); x := x DIV 128 END;
|
||||||
|
Write(R, CHR(x MOD 128))
|
||||||
|
END WriteNum;
|
||||||
|
|
||||||
|
PROCEDURE Finalize(o: SYSTEM.PTR);
|
||||||
|
VAR f: File; res: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
f := SYSTEM.VAL(File, o);
|
||||||
|
IF f.fd >= 0 THEN
|
||||||
|
fileTab[f.fd] := 0; res := Unix.Close(f.fd); f.fd := -1; DEC(Kernel.nofiles);
|
||||||
|
IF f.tempFile THEN res := Unix.Unlink(f.workName) END
|
||||||
|
END
|
||||||
|
END Finalize;
|
||||||
|
|
||||||
|
PROCEDURE Init;
|
||||||
|
VAR i: LONGINT;
|
||||||
|
BEGIN
|
||||||
|
i := 0; WHILE i < fileTabSize DO fileTab[i] := 0; INC(i) END ;
|
||||||
|
tempno := -1; Kernel.nofiles := 0
|
||||||
|
END Init;
|
||||||
|
|
||||||
|
BEGIN Init
|
||||||
|
END Files0.
|
||||||
205
src/lib/system/openbsd/gcc/x86_64/SYSTEM.c0
Normal file
205
src/lib/system/openbsd/gcc/x86_64/SYSTEM.c0
Normal file
|
|
@ -0,0 +1,205 @@
|
||||||
|
/*
|
||||||
|
* 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 ------------- */
|
||||||
|
|
||||||
238
src/lib/system/openbsd/gcc/x86_64/SYSTEM.h
Normal file
238
src/lib/system/openbsd/gcc/x86_64/SYSTEM.h
Normal file
|
|
@ -0,0 +1,238 @@
|
||||||
|
#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 <alloca.h>
|
||||||
|
#include <stdint.h> /* 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
|
||||||
|
|
||||||
519
src/lib/system/openbsd/gcc/x86_64/Unix.Mod
Normal file
519
src/lib/system/openbsd/gcc/x86_64/Unix.Mod
Normal file
|
|
@ -0,0 +1,519 @@
|
||||||
|
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;
|
||||||
|
|
||||||
|
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 *)
|
||||||
|
mode* : INTEGER;
|
||||||
|
dev* : INTEGER; (* dev_t 4 *)
|
||||||
|
ino* : LONGINT; (* ino 8 *)
|
||||||
|
nlink* : INTEGER;
|
||||||
|
uid*, gid*: INTEGER;
|
||||||
|
rdev* : INTEGER;
|
||||||
|
atime* : LONGINT;
|
||||||
|
atimences* : LONGINT;
|
||||||
|
mtime* : LONGINT;
|
||||||
|
mtimensec* : LONGINT;
|
||||||
|
ctime* : LONGINT;
|
||||||
|
ctimensec* : LONGINT;
|
||||||
|
size* : LONGINT;
|
||||||
|
blocks* : LONGINT;
|
||||||
|
blksize* : INTEGER;
|
||||||
|
unused0*, unused1*: INTEGER;
|
||||||
|
unused2*, unused3*: 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 <sys/stat.h>";
|
||||||
|
|
||||||
|
PROCEDURE -includeErrno()
|
||||||
|
"#include <errno.h>";
|
||||||
|
|
||||||
|
(* for read(), write() and sleep() *)
|
||||||
|
PROCEDURE -includeUnistd()
|
||||||
|
"#include <unistd.h>";
|
||||||
|
|
||||||
|
(* for system() *)
|
||||||
|
PROCEDURE -includeStdlib()
|
||||||
|
"#include <stdlib.h>";
|
||||||
|
|
||||||
|
(* for nanosleep() *)
|
||||||
|
PROCEDURE -includeTime()
|
||||||
|
"#include <time.h>";
|
||||||
|
|
||||||
|
(* for select() *)
|
||||||
|
PROCEDURE -includeSelect()
|
||||||
|
"#include <sys/select.h>";
|
||||||
|
|
||||||
|
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.
|
||||||
88
src/voc/openbsd/gcc/extTools.Mod
Normal file
88
src/voc/openbsd/gcc/extTools.Mod
Normal file
|
|
@ -0,0 +1,88 @@
|
||||||
|
MODULE extTools;
|
||||||
|
IMPORT Args, Unix, Strings, Console, version;
|
||||||
|
(*
|
||||||
|
INCLUDEPATH = -Isrc/lib/system/gnuc/x86_64
|
||||||
|
CCOPT = -fPIC $(INCLUDEPATH) -g
|
||||||
|
CLOBERONOPTS = -fPIC $(INCLUDEPATH) -L. -L/usr/lib -lOberon -static -g
|
||||||
|
CC = cc $(CCOPT) -c
|
||||||
|
*)
|
||||||
|
CONST compiler="gcc";
|
||||||
|
|
||||||
|
VAR incPath0, incPath1, ccOpt, ccString, CFLAGS, tmp0, tmp1 : ARRAY 1023 OF CHAR;
|
||||||
|
|
||||||
|
PROCEDURE Assemble*(m : ARRAY OF CHAR);
|
||||||
|
VAR cmd : ARRAY 1023 OF CHAR;
|
||||||
|
cc : ARRAY 1023 OF CHAR;
|
||||||
|
ext : ARRAY 5 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
COPY (ccString, cc);
|
||||||
|
Strings.Append (" -c ", cc);
|
||||||
|
COPY(cc, cmd);
|
||||||
|
Strings.Append (" ", cmd);
|
||||||
|
Strings.Append (ccOpt, cmd);
|
||||||
|
ext := ".c";
|
||||||
|
Strings.Append (ext, m);
|
||||||
|
Strings.Append(m, cmd);
|
||||||
|
(*Console.Ln; Console.String (cmd); Console.Ln;*)
|
||||||
|
Unix.system(cmd);
|
||||||
|
END Assemble;
|
||||||
|
|
||||||
|
|
||||||
|
PROCEDURE LinkMain*(VAR m : ARRAY OF CHAR; statically : BOOLEAN; additionalopts : ARRAY OF CHAR);
|
||||||
|
VAR lpath : ARRAY 1023 OF CHAR;
|
||||||
|
cc : ARRAY 1023 OF CHAR;
|
||||||
|
ccopt : ARRAY 1023 OF CHAR;
|
||||||
|
cmd : ARRAY 1023 OF CHAR;
|
||||||
|
ext : ARRAY 5 OF CHAR;
|
||||||
|
BEGIN
|
||||||
|
(*
|
||||||
|
gcc -g -o hello hello.c -I $RPATH/src/lib/system/gnuc/x86_64 -I. -I$RPATH -lOberon -L. -L$RPATH -static
|
||||||
|
*)
|
||||||
|
cmd := "";
|
||||||
|
cc := "";
|
||||||
|
ext := ".c";
|
||||||
|
COPY(ccString, cc);
|
||||||
|
COPY (cc, cmd);
|
||||||
|
Strings.Append(" ", cmd);
|
||||||
|
Strings.Append(m, cmd);
|
||||||
|
Strings.Append(ext, cmd);
|
||||||
|
Strings.Append(additionalopts, cmd);
|
||||||
|
IF statically THEN Strings.Append(" -static ", cmd) END;
|
||||||
|
Strings.Append(" -o ", cmd);
|
||||||
|
Strings.Append(m, cmd);
|
||||||
|
Strings.Append(" ", cmd);
|
||||||
|
|
||||||
|
Strings.Append (" -lVishapOberon -L. -L", ccOpt);
|
||||||
|
Strings.Append (version.prefix, ccOpt);
|
||||||
|
Strings.Append ("/lib ", ccOpt);
|
||||||
|
|
||||||
|
Strings.Append(ccOpt, cmd);
|
||||||
|
Console.Ln; Console.String(cmd); Console.Ln; (* may be it's feasible to add debug mode later *)
|
||||||
|
Unix.system(cmd);
|
||||||
|
END LinkMain;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
|
||||||
|
incPath0 := "src/lib/system/linux/";
|
||||||
|
Strings.Append (compiler, incPath0);
|
||||||
|
incPath1 := "lib/voc/obj ";
|
||||||
|
ccOpt := " -fPIC -g ";
|
||||||
|
|
||||||
|
COPY ("-I ", tmp1);
|
||||||
|
Strings.Append (version.prefix, tmp1);
|
||||||
|
Strings.Append("/", tmp1);
|
||||||
|
Strings.Append(incPath0, tmp1);
|
||||||
|
Strings.Append("/", tmp1);
|
||||||
|
Strings.Append(version.arch, tmp1);
|
||||||
|
Strings.Append(" -I ", tmp1);
|
||||||
|
Strings.Append(version.prefix, tmp1);
|
||||||
|
Strings.Append("/", tmp1);
|
||||||
|
Strings.Append(incPath1, tmp1);
|
||||||
|
Strings.Append(tmp1, ccOpt);
|
||||||
|
Args.GetEnv("CFLAGS", CFLAGS);
|
||||||
|
Strings.Append (CFLAGS, ccOpt);
|
||||||
|
Strings.Append (" ", ccOpt);
|
||||||
|
ccString := compiler;
|
||||||
|
Strings.Append (" ", ccString);
|
||||||
|
|
||||||
|
END extTools.
|
||||||
4
src/voc/openbsd/gcc/x86_64/architecture.Mod
Normal file
4
src/voc/openbsd/gcc/x86_64/architecture.Mod
Normal file
|
|
@ -0,0 +1,4 @@
|
||||||
|
MODULE architecture;
|
||||||
|
CONST arch* = "x86_64";
|
||||||
|
|
||||||
|
END architecture.
|
||||||
Loading…
Add table
Add a link
Reference in a new issue