diff --git a/src/cpfront/posix/generic/System/Mod/Kernel.cp b/src/cpfront/posix/generic/System/Mod/Kernel.cp
index a3f6d712bf86c35e95adf33de2d7de72e3e7957a..87ea635fc7524de0eca557d825ed0fc6dfee3f8c 100644 (file)
MODULE Kernel;
- IMPORT S := SYSTEM, stdlib := C99stdlib, stdio := C99stdio,
- time := C99time, wctype := C99wctype, sysmman := C99sys_mman,
- dlfcn := C99dlfcn, fcntl := C99fcntl, types := C99types,
- unistd := C99unistd, signal := C99signal, setjmp := C99setjmp;
+ IMPORT S := SYSTEM, stdlib := PosixCstdlib, stdio := PosixCstdio,
+ time := PosixCtime, wctype := PosixCwctype, sysmman := PosixCsys_mman,
+ dlfcn := PosixCdlfcn, fcntl := PosixCfcntl, types := PosixCtypes,
+ unistd := PosixCunistd, signal := PosixCsignal, setjmp := PosixCsetjmp,
+ LibFFI;
(* init fpu? *)
(* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *)
(* add BeepHook for Beep *)
- (* implement Call using libffi *)
CONST
nameLen* = 256;
trapCount-: INTEGER;
err-, pc-, sp-, fp-, stack-, val-: INTEGER;
- isTry: BOOLEAN;
- startEnv: setjmp.sigjmp_buf;
+ isTry, checkReadable: BOOLEAN;
+ startEnv, checkReadableEnv: setjmp.sigjmp_buf;
tryEnv: setjmp.jmp_buf;
startDLink, tryDLink: DLink;
wouldFinalize: BOOLEAN;
- watcher*: PROCEDURE (event: INTEGER); (* for debugging *)
+ watcher*: PROCEDURE (event: INTEGER); (* for debugging *)
+
+ intTrap*: BOOLEAN;
PROCEDURE Erase (adr, words: INTEGER);
BEGIN
PROCEDURE AllocHeapMem (size: INTEGER; VAR c: Cluster);
CONST N = 65536; (* cluster size for dll *)
- VAR adr, allocated: INTEGER;
+ VAR adr, allocated, newsize: INTEGER;
BEGIN
INC(size, 16);
ASSERT(size > 0, 100); adr := 0;
- IF size < N THEN adr := stdlib.malloc(N) END;
- IF adr = 0 THEN adr := stdlib.malloc(size); allocated := size ELSE allocated := N END;
+ IF size < N THEN
+ adr := AllocMem(N, newsize);
+ allocated := newsize
+ END;
+ IF adr = 0 THEN
+ adr := AllocMem(size, newsize);
+ allocated := newsize
+ END;
IF adr = 0 THEN c := NIL
ELSE
c := S.VAL(Cluster, (adr + 15) DIV 16 * 16); c.max := adr;
PROCEDURE FreeHeapMem (c: Cluster);
BEGIN
DEC(used, c.size); DEC(total, c.size);
- stdlib.free(S.VAL(ADDRESS, c.max))
+ FreeMem(S.VAL(ADDRESS, c.max), c.size)
END FreeHeapMem;
PROCEDURE HeapFull (size: INTEGER): BOOLEAN;
FreeMem(modAdr, modSize)
END InvalModMem;
- PROCEDURE TryRead (from, to, c: INTEGER);
- VAR i: INTEGER; x: BYTE;
+ PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
+ VAR r: BOOLEAN; jmp: setjmp.sigjmp_buf; res: setjmp.int; i: INTEGER; x: BYTE;
BEGIN
- IF from <= to THEN
- FOR i := from TO to DO
- S.GET(i, x)
- END
- ELSE
- FOR i := to TO from BY -1 DO
- S.GET(i, x)
+ r := checkReadable;
+ jmp := checkReadableEnv;
+ checkReadable := TRUE;
+ res := setjmp.sigsetjmp(checkReadableEnv, 1);
+ IF res = 0 THEN
+ IF from <= to THEN
+ FOR i := from TO to DO
+ S.GET(i, x)
+ END
+ ELSE
+ FOR i := to TO from BY -1 DO
+ S.GET(i, x)
+ END
END
END;
- END TryRead;
-
- PROCEDURE^ Try* (h: TryHandler; a, b, c: INTEGER);
-
- PROCEDURE IsReadable* (from, to: INTEGER): BOOLEAN;
- VAR i: INTEGER;
- BEGIN
- i := trapCount;
- Try(TryRead, from, to, 0);
- RETURN trapCount = i
+ checkReadableEnv := jmp;
+ checkReadable := r;
+ RETURN res = 0
END IsReadable;
(* --------------------- NEW implementation (portable) -------------------- *)
(* -------------------- dynamic procedure call --------------------- *)
- PROCEDURE Call* (adr: INTEGER; sig: Signature; IN par: ARRAY OF INTEGER; n: INTEGER): LONGINT;
- BEGIN
- HALT(126); (* !!! *)
- RETURN 0
+ (*
+ type par
+ 32 bit scalar value
+ 64 bit scalar low hi
+ var scalar address
+ record address tag
+ array address size
+ open array address length .. length
+ *)
+
+ PROCEDURE Call* (adr: ADDRESS; sig: Signature; IN par: ARRAY OF INTEGER; n: INTEGER): LONGINT;
+ CONST
+ (* obj.id MOD 16 *)
+ mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
+ (* typ *)
+ mBool = 1; mChar8 = 2; mChar16 = 3; mInt8 = 4; mInt16 = 5; mInt32 = 6;
+ mReal32 = 7; mReal64 = 8; mSet = 9; mInt64 = 10; mAnyRec = 11; mAnyPtr = 12; mSysPtr = 13;
+ (* typ.id MOD 4 *)
+ mProctyp = 0; mRecord = 1; mArray = 2; mPointer = 3;
+ (* ??? obj.id DIV 16 MOD 16 *)
+ mInternal = 1; mReadonly = 2; mPrivate = 3; mExported = 4;
+ (* sig.par[].id MOD 16 *)
+ mValue = 10; mInPar = 11; mOutPar = 12; mVarPar = 13;
+ mInterface = 32; mGuid = 33; mResult = 34;
+ (* implementation restrictions *)
+ maxPars = 127;
+ maxStrs = 127;
+ maxElms = 256;
+ TYPE
+ Ptype = POINTER TO LibFFI.type;
+ PPtype = POINTER TO ARRAY [untagged] OF Ptype;
+ VAR
+ status: LibFFI.status;
+ kind, form, size: INTEGER;
+ i, p, d, cn, ut, ue: INTEGER;
+ fret: Ptype;
+ vret: LONGINT;
+ earg: ARRAY maxElms OF Ptype;
+ targ: ARRAY maxStrs OF LibFFI.type;
+ farg: ARRAY maxPars OF Ptype;
+ varg: ARRAY maxPars OF ADDRESS;
+ typ: Type;
+ cif: LibFFI.cif;
+
+ PROCEDURE SetType (IN typ: LibFFI.type);
+ BEGIN
+ farg[cn] := S.VAL(Ptype, S.ADR(typ));
+ END SetType;
+
+ PROCEDURE PushAdr (size: INTEGER);
+ BEGIN
+ ASSERT(size IN {1, 2, 4, 8}, 20);
+ ASSERT(littleEndian OR (size <= 4), 100); (* !!! swap 64bit value *)
+ varg[cn] := S.ADR(par[d]);
+ INC(cn); INC(d, MAX(1, size DIV 4))
+ END PushAdr;
+
+ PROCEDURE PushVal (size: INTEGER);
+ BEGIN
+ ASSERT(size IN {1, 2, 4, 8}, 20);
+ ASSERT(littleEndian OR (size <= 4), 100); (* !!! swap 64bit value *)
+ varg[cn] := par[d];
+ INC(cn); INC(d, MAX(1, size DIV 4))
+ END PushVal;
+
+ PROCEDURE Push (IN typ: LibFFI.type);
+ BEGIN
+ SetType(typ); PushAdr(typ.size)
+ END Push;
+
+ BEGIN
+ p := 0; cn := 0; d := 0; ut := 0; ue := 0;
+ WHILE p < sig.num DO
+ typ := sig.par[p].struct;
+ kind := sig.par[p].id MOD 16;
+ IF S.VAL(ADDRESS, typ) DIV 256 = 0 THEN (* basic types *)
+ form := S.VAL(ADDRESS, typ) MOD 256;
+ IF kind = mValue THEN
+ CASE form OF
+ | mBool, mChar8: Push(LibFFI.type_uint8)
+ | mChar16: Push(LibFFI.type_uint16)
+ | mInt8: Push(LibFFI.type_sint8)
+ | mInt16: Push(LibFFI.type_sint16)
+ | mInt32: Push(LibFFI.type_sint32)
+ | mReal32: Push(LibFFI.type_float)
+ | mReal64: Push(LibFFI.type_double)
+ | mSet: Push(LibFFI.type_uint32)
+ | mInt64: Push(LibFFI.type_sint64)
+ | mAnyPtr, mSysPtr: Push(LibFFI.type_pointer)
+ ELSE HALT(100) (* unsupported type *)
+ END;
+ ELSIF kind IN {mInPar..mVarPar} THEN
+ CASE form OF
+ | mBool..mInt64, mAnyPtr, mSysPtr: Push(LibFFI.type_pointer)
+ | mAnyRec: Push(LibFFI.type_pointer); Push(LibFFI.type_pointer) (* address + tag *)
+ ELSE HALT(101) (* unsupported type *)
+ END
+ ELSE
+ HALT(102) (* unsupported parameter kind *)
+ END
+ ELSE
+ CASE typ.id MOD 4 OF
+ | mProctyp, mPointer:
+ Push(LibFFI.type_pointer)
+ | mRecord:
+ IF kind = mValue THEN
+ targ[ut].size := 0;
+ targ[ut].alignment := 0;
+ targ[ut].type := LibFFI.TYPE_STRUCT;
+ targ[ut].elements := S.VAL(PPtype, S.ADR(earg[ue]));
+ SetType(targ[ut]); INC(ut);
+ size := MAX(1, typ.size);
+ (* !!! better to pass original layout *)
+ WHILE size >= 8 DO
+ earg[ue] := S.VAL(Ptype, S.ADR(LibFFI.type_uint64));
+ INC(ue); DEC(size, 8)
+ END;
+ IF size >= 4 THEN
+ earg[ue] := S.VAL(Ptype, S.ADR(LibFFI.type_uint32));
+ INC(ue); DEC(size, 4)
+ END;
+ IF size >= 2 THEN
+ earg[ue] := S.VAL(Ptype, S.ADR(LibFFI.type_uint16));
+ INC(ue); DEC(size, 2)
+ END;
+ IF size >= 1 THEN
+ earg[ue] := S.VAL(Ptype, S.ADR(LibFFI.type_uint32));
+ INC(ue); DEC(size)
+ END;
+ earg[ue] := NIL;
+ INC(ue);
+ PushVal(LibFFI.type_pointer.size);
+ INC(d) (* skip tag *)
+ ELSIF kind IN {mInPar..mVarPar} THEN
+ Push(LibFFI.type_pointer); (* address *)
+ Push(LibFFI.type_pointer); (* tag *)
+ ELSE HALT(103) (* unsupported parameter kind *)
+ END
+ | mArray:
+ Push(LibFFI.type_pointer);
+ ASSERT(kind IN {mValue..mVarPar}, 104); (* unsupported parameter kind *)
+ (* array copying generated by CPfront, so we can just pass address *)
+ IF typ.size = 0 THEN (* open array *)
+ FOR i := 0 TO typ.id DIV 16 - 1 DO
+ Push(LibFFI.type_sint32) (* dim size *)
+ END
+ ELSE (* fix array *)
+ INC(d) (* skip size *)
+ END
+ END
+ END;
+ INC(p)
+ END;
+ ASSERT(d = n, 105);
+ typ := sig.retStruct;
+ IF typ = NIL THEN fret := S.VAL(Ptype, S.ADR(LibFFI.type_void))
+ ELSIF S.VAL(ADDRESS, typ) DIV 256 = 0 THEN
+ form := S.VAL(ADDRESS, typ) MOD 256;
+ CASE form OF
+ | mBool, mChar8: fret := S.VAL(Ptype, S.ADR(LibFFI.type_uint8))
+ | mChar16: fret := S.VAL(Ptype, S.ADR(LibFFI.type_uint16))
+ | mInt8: fret := S.VAL(Ptype, S.ADR(LibFFI.type_sint8))
+ | mInt16: fret := S.VAL(Ptype, S.ADR(LibFFI.type_sint16))
+ | mInt32: fret := S.VAL(Ptype, S.ADR(LibFFI.type_sint32))
+ | mReal32: fret := S.VAL(Ptype, S.ADR(LibFFI.type_float))
+ | mReal64: fret := S.VAL(Ptype, S.ADR(LibFFI.type_double))
+ | mSet: fret := S.VAL(Ptype, S.ADR(LibFFI.type_uint32))
+ | mInt64: fret := S.VAL(Ptype, S.ADR(LibFFI.type_sint64))
+ | mAnyPtr, mSysPtr: fret := S.VAL(Ptype, S.ADR(LibFFI.type_pointer))
+ ELSE HALT(106) (* unsupported type *)
+ END
+ ELSE
+ CASE typ.id MOD 4 OF
+ | mProctyp, mPointer: fret := S.VAL(Ptype, S.ADR(LibFFI.type_pointer))
+ ELSE HALT(107) (* unsupported type *)
+ END
+ END;
+ status := LibFFI.prep_cif(cif, LibFFI.DEFAULT_ABI, cn, fret, farg);
+ ASSERT(status = LibFFI.OK, 108);
+ vret := 0;
+ IF littleEndian THEN LibFFI.call(cif, adr, S.ADR(vret), S.ADR(varg))
+ ELSE LibFFI.call(cif, adr, S.ADR(vret) + (8 - fret.size), S.ADR(varg))
+ END;
+ RETURN vret
END Call;
(* -------------------- reference information (portable) --------------------- *)
SetDLink(tryDLink);
setjmp._longjmp(tryEnv, 1)
END;
- IF err = 128 THEN (* do nothing *)
+ IF (err = 128) OR (err = 200) & ~intTrap THEN (* do nothing *)
ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
trapped := TRUE; trapViewer()
ELSE DefaultTrapViewer
stdlib.abort
END Trap;
- PROCEDURE [ccall] TrapHandler (signo: signal.int; IN _info: signal.siginfo_t; context: ADDRESS);
- TYPE SigInfo = POINTER [untagged] TO signal._siginfo_t;
- VAR res: signal.int; info: SigInfo;
+ PROCEDURE [ccall] TrapHandler (signo: signal.int; IN info: signal.siginfo_t; context: ADDRESS);
+ VAR res: signal.int;
BEGIN
- info := S.VAL(SigInfo, S.ADR(_info)); (* !!! hack for CPfront *)
+ IF checkReadable THEN
+ setjmp.siglongjmp(checkReadableEnv, 1)
+ END;
IF trapped THEN
DefaultTrapViewer;
IF ~secondTrap THEN trapped := FALSE; secondTrap := TRUE END
END;
- err := -signo; pc := 0; sp := 0; fp := 0; stack := 0; val := 0;
+ err := -signo; pc := 0; sp := 0; fp := 0; stack := baseStack; val := 0;
CASE signo OF
| signal.SIGFPE:
- pc := info.si_addr;
val := info.si_code;
+ pc := info.info.sigfpe.si_addr;
CASE info.si_code OF
| signal.FPE_INTDIV: err := 139 (* division by zero *)
| signal.FPE_INTOVF: err := 138 (* integer overflow *)
val := info.si_code;
err := 200 (* keyboard interrupt *)
| signal.SIGSEGV:
- val := info.si_addr;
+ val := info.info.sigsegv.si_addr;
err := 203 (* illigal read *)
| signal.SIGBUS:
- val := info.si_addr;
+ val := info.info.sigbus.si_addr;
err := 10001H (* bus error *)
| signal.SIGILL:
- pc := info.si_addr;
+ pc := info.info.sigill.si_addr;
err := 202; (* illigal instruction *)
IF IsReadable(pc, pc + 4) THEN
S.GET(pc, val)
- (* !!! err := halt code *)
END;
ELSE (* unknown *)
END;
(* !!! InitFPU *)
TrapCleanup;
IF isTry THEN
- SetDLink(tryDLink);
setjmp._longjmp(tryEnv, 1)
END;
- IF err = 128 THEN (* do nothing *)
+ IF (err = 128) OR (err = 200) & ~intTrap THEN (* do nothing *)
ELSIF (trapViewer # NIL) & (restart # NIL) & ~trapped & ~guarded THEN
trapped := TRUE; trapViewer()
ELSE DefaultTrapViewer
END;
trapped := FALSE; secondTrap := FALSE;
IF restart # NIL THEN
- SetDLink(startDLink);
setjmp.siglongjmp(startEnv, 1)
END;
stdlib.abort
PROCEDURE Init;
VAR i: INTEGER;
BEGIN
+ intTrap := TRUE;
baseStack := S.ADR(i); (* XXX *)
pagesize := unistd.sysconf(unistd._SC_PAGESIZE);