diff --git a/src/cpfront/posix/generic/System/Mod/Kernel.cp b/src/cpfront/posix/generic/System/Mod/Kernel.cp
index 622e0b10cc31ffb511333206090233333c0fd193..279fef9483a2960fa170d6ef66c71e7771eae372 100644 (file)
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 *)
(* -------------------- 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) --------------------- *)