X-Git-Url: https://deadsoftware.ru/gitweb?p=cpc.git;a=blobdiff_plain;f=src%2Fcpfront%2Fposix%2Fgeneric%2FSystem%2FMod%2FKernel.cp;h=87ea635fc7524de0eca557d825ed0fc6dfee3f8c;hp=a3f6d712bf86c35e95adf33de2d7de72e3e7957a;hb=7f31515b8ffa0954d6b96af35a3925ab82800ae2;hpb=76d1e8d98f1d80d24fa52a15e6b2c6fb0a5f44d0 diff --git a/src/cpfront/posix/generic/System/Mod/Kernel.cp b/src/cpfront/posix/generic/System/Mod/Kernel.cp index a3f6d71..87ea635 100644 --- a/src/cpfront/posix/generic/System/Mod/Kernel.cp +++ b/src/cpfront/posix/generic/System/Mod/Kernel.cp @@ -1,14 +1,14 @@ 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; @@ -203,8 +203,8 @@ MODULE Kernel; 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; @@ -238,7 +238,9 @@ MODULE Kernel; wouldFinalize: BOOLEAN; - watcher*: PROCEDURE (event: INTEGER); (* for debugging *) + watcher*: PROCEDURE (event: INTEGER); (* for debugging *) + + intTrap*: BOOLEAN; PROCEDURE Erase (adr, words: INTEGER); BEGIN @@ -460,12 +462,18 @@ MODULE Kernel; 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; @@ -479,7 +487,7 @@ MODULE Kernel; 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; @@ -513,28 +521,27 @@ MODULE Kernel; 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) -------------------- *) @@ -903,10 +910,190 @@ MODULE Kernel; (* -------------------- 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) --------------------- *) @@ -1553,7 +1740,7 @@ MODULE Kernel; 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 @@ -1566,20 +1753,21 @@ MODULE Kernel; 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 *) @@ -1595,17 +1783,16 @@ MODULE Kernel; 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; @@ -1613,17 +1800,15 @@ MODULE Kernel; (* !!! 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 @@ -1656,6 +1841,7 @@ MODULE Kernel; PROCEDURE Init; VAR i: INTEGER; BEGIN + intTrap := TRUE; baseStack := S.ADR(i); (* XXX *) pagesize := unistd.sysconf(unistd._SC_PAGESIZE);