From: DeaDDooMER Date: Sun, 28 Jul 2019 12:49:40 +0000 (+0300) Subject: implement Kernel.Call for CPfront using libffi X-Git-Url: https://deadsoftware.ru/gitweb?p=cpc.git;a=commitdiff_plain;h=4399688214fe9abbf588fe811bfc5a8cd074ae98;hp=b3b6bda116f414a5cb857bf73a41a75e9d48c837 implement Kernel.Call for CPfront using libffi --- diff --git a/make.sh b/make.sh index 7626314..af287d9 100755 --- a/make.sh +++ b/make.sh @@ -118,7 +118,7 @@ cpfront_link() { done local _cc_cflags= case "$CC" in - *gcc) _cc_cflags="-Wno-int-conversion -Wno-int-to-pointer-cast -Wno-incompatible-pointer-types -Wno-implicit-function-declaration" ;; + *gcc) _cc_cflags="-g -Wno-int-conversion -Wno-int-to-pointer-cast -Wno-incompatible-pointer-types -Wno-implicit-function-declaration" ;; *) _cc_cflags="" ;; esac local _cpu_cflags= @@ -132,7 +132,7 @@ cpfront_link() { cygwin) _system_cflags="-liconv" ;; *) _system_cflags="" ;; esac - "$CC" $_cc_cflags $_cpu_cflags $CFLAGS -o "${_main}" -I "$_this/C" "$_this/C/SYSTEM.c" $_list -lm -ldl $_system_cflags + "$CC" $_cc_cflags $_cpu_cflags $CFLAGS -o "${_main}" -I "$_this/C" "$_this/C/SYSTEM.c" $_list -lm -ldl -lffi $_system_cflags fi } @@ -167,6 +167,9 @@ compile_all() { Posix/Mod/Cdlfcn.cp Posix/Mod/Csignal.cp Posix/Mod/Csetjmp.cp \ Posix/Mod/Clibgen.cp \ Posix/Mod/Cmacro.cp + if [ "$_target" = "cpfront" ]; then + compile Lib/Mod/FFI.cp + fi fi ###^^^^^^^^^^^^^^^^^^^^^^^^^^^^### diff --git a/src/cpfront/486/Lib/Mod/FFI.cp b/src/cpfront/486/Lib/Mod/FFI.cp new file mode 100644 index 0000000..02f61d3 --- /dev/null +++ b/src/cpfront/486/Lib/Mod/FFI.cp @@ -0,0 +1,89 @@ +MODULE LibFFI ["ffi.h"]; + + IMPORT SYSTEM, types := PosixCtypes, sys_types := PosixCsys_types; + + CONST + SIZEOF_ARG* = 4; + + CONST (* abi *) + FIRST_ABI* = 0; + SYSV* = 1; + STDCALL_WIN32* = 2; (* FFI_STDCALL for win32 *) + THISCALL* = 3; + FASTCALL* = 4; + MS_CDECL_WIN32* = 5; (* FFI_MS_CDECL for win32 *) + STDCALL_GENERIC* = 5; (* FFI_STDCALL for ~win32 *) + PASCAL* = 6; + REGISTER* = 7; + LAST_ABI* = 7; + DEFAULT_ABI* = SYSV; + + CONST (* status *) + OK* = 0; BAD_TYPEDEF* = 1; BAD_ABI* = 2; + + CONST + TYPE_VOID* = 0; + TYPE_INT* = 1; + TYPE_FLOAT* = 2; + TYPE_DOUBLE* = 3; + TYPE_LONGDOUBLE* = 4; + TYPE_UINT8* = 5; + TYPE_SINT8* = 6; + TYPE_UINT16* = 7; + TYPE_SINT16* = 8; + TYPE_UINT32* = 9; + TYPE_SINT32* = 10; + TYPE_UINT64* = 11; + TYPE_SINT64* = 12; + TYPE_STRUCT* = 13; + TYPE_POINTER* = 14; + TYPE_COMPLEX* = 15; + TYPE_LAST* = TYPE_COMPLEX; + + TYPE + abi* ["ffi_abi"] = types.int; (* !!! enum *) + status* ["ffi_status"] = types.int; (* !!! enum *) + + (* Ptype* = POINTER [untagged] TO type; + PPtype* = POINTER [untagged] TO ARRAY [untagged] OF Ptype; *) + type* ["ffi_type"] = RECORD [untagged] + size*: sys_types.size_t; + alignment*: types.unsigned_short; + type*: types.unsigned_short; + elements*: POINTER [untagged] TO ARRAY [untagged] OF POINTER TO type; + END; + + (* Pcif* = POINTER TO cif; *) + cif* ["ffi_cif"] = RECORD [untagged] + abi*: abi; + nargs*: types.unsigned; + arg_type*: POINTER [untagged] TO ARRAY [untagged] OF POINTER TO type; + rtype*: POINTER TO type; + bytes*: types.unsigned; + flags*: types.unsigned; + END; + + VAR + type_void- ["ffi_type_void"]: type; + type_uint8- ["ffi_type_uint8"]: type; + type_sint8- ["ffi_type_sint8"]: type; + type_uint16- ["ffi_type_uint16"]: type; + type_sint16- ["ffi_type_sint16"]: type; + type_uint32- ["ffi_type_uint32"]: type; + type_sint32- ["ffi_type_sint32"]: type; + type_uint64- ["ffi_type_uint64"]: type; + type_sint64- ["ffi_type_sint64"]: type; + type_float- ["ffi_type_float"]: type; + type_double- ["ffi_type_double"]: type; + type_pointer- ["ffi_type_pointer"]: type; + type_longdouble- ["ffi_type_longdouble"]: type; + + type_complex_single- ["ffi_type_complex_single"]: type; + type_complex_double- ["ffi_type_complex_double"]: type; + type_complex_longdouble- ["ffi_type_complex_longdouble"]: type; + + PROCEDURE [ccall] prep_cif* ["ffi_prep_cif"] (VAR c: cif; a: abi; nargs: types.unsigned_int; rtype: POINTER TO type; atypes: POINTER [untagged] TO ARRAY [untagged] OF POINTER TO type): status; + PROCEDURE [ccall] prep_cif_var* ["ffi_prep_cif_var"] (VAR c: cif; a: abi; nfixedargs, ntotalargs: types.unsigned_int; rtype: POINTER TO type; atypes: POINTER [untagged] TO ARRAY [untagged] OF POINTER TO type): status; + PROCEDURE [ccall] call* ["ffi_call"] (VAR c: cif; fn, rvalue, avalue: SYSTEM.ADDRESS); + +END LibFFI. 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) --------------------- *)