X-Git-Url: https://deadsoftware.ru/gitweb?p=cpc.git;a=blobdiff_plain;f=src%2Fcpfront%2Fposix%2Fgeneric%2FSystem%2FMod%2FKernel.cp;h=279fef9483a2960fa170d6ef66c71e7771eae372;hp=622e0b10cc31ffb511333206090233333c0fd193;hb=4399688214fe9abbf588fe811bfc5a8cd074ae98;hpb=b3b6bda116f414a5cb857bf73a41a75e9d48c837 diff --git a/src/cpfront/posix/generic/System/Mod/Kernel.cp b/src/cpfront/posix/generic/System/Mod/Kernel.cp index 622e0b1..279fef9 100644 --- a/src/cpfront/posix/generic/System/Mod/Kernel.cp +++ b/src/cpfront/posix/generic/System/Mod/Kernel.cp @@ -3,7 +3,8 @@ MODULE Kernel; 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; + unistd := PosixCunistd, signal := PosixCsignal, setjmp := PosixCsetjmp, + LibFFI; (* init fpu? *) (* add signal blocking to avoid race conditions in Try/Trap/TrapHandler *) @@ -911,10 +912,180 @@ 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 PushVal (size: INTEGER); + BEGIN + ASSERT(size IN {1, 2, 4, 8}, 20); + ASSERT(littleEndian); (* !!! swap 64bit value *) + varg[cn] := S.ADR(par[d]); + INC(cn); INC(d, MAX(1, size DIV 4)) + END PushVal; + + PROCEDURE Push (IN typ: LibFFI.type); + BEGIN + SetType(typ); PushVal(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 := MIN(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 + 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) --------------------- *)