#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include "ffi_platypus.h" #include "ffi_platypus_guts.h" #include "perl_math_int64.h" void ffi_pl_closure_add_data(SV *closure, ffi_pl_closure *closure_data) { dSP; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(closure); XPUSHs(sv_2mortal(newSViv(PTR2IV(closure_data)))); XPUSHs(sv_2mortal(newSViv(PTR2IV(closure_data->type)))); PUTBACK; call_pv("FFI::Platypus::Closure::add_data", G_DISCARD); FREETMPS; LEAVE; } ffi_pl_closure * ffi_pl_closure_get_data(SV *closure, ffi_pl_type *type) { dSP; int count; ffi_pl_closure *ret; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(closure); XPUSHs(sv_2mortal(newSViv(PTR2IV(type)))); PUTBACK; count = call_pv("FFI::Platypus::Closure::get_data", G_SCALAR); SPAGAIN; if (count != 1) ret = NULL; else ret = INT2PTR(void*, POPi); PUTBACK; FREETMPS; LEAVE; return ret; } void ffi_pl_closure_call(ffi_cif *ffi_cif, void *result, void **arguments, void *user) { dSP; ffi_pl_closure *closure = (ffi_pl_closure*) user; ffi_pl_type_extra_closure *extra = &closure->type->extra[0].closure; int flags = extra->flags; int i; int count; SV *sv,*ref; if(!(flags & G_NOARGS)) { ENTER; SAVETMPS; } PUSHMARK(SP); if(!(flags & G_NOARGS)) { for(i=0; i< ffi_cif->nargs; i++) { switch(extra->argument_types[i]->type_code) { case FFI_PL_TYPE_VOID: break; case FFI_PL_TYPE_SINT8: sv = sv_newmortal(); sv_setiv(sv, *((int8_t*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_SINT16: sv = sv_newmortal(); sv_setiv(sv, *((int16_t*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_SINT32: sv = sv_newmortal(); sv_setiv(sv, *((int32_t*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_SINT64: sv = sv_newmortal(); sv_seti64(sv, *((int64_t*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_UINT8: sv = sv_newmortal(); sv_setuv(sv, *((uint8_t*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_UINT16: sv = sv_newmortal(); sv_setuv(sv, *((uint16_t*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_UINT32: sv = sv_newmortal(); sv_setuv(sv, *((uint32_t*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_UINT64: sv = sv_newmortal(); sv_setu64(sv, *((uint64_t*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_FLOAT: sv = sv_newmortal(); sv_setnv(sv, *((float*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_DOUBLE: sv = sv_newmortal(); sv_setnv(sv, *((double*)arguments[i])); XPUSHs(sv); break; case FFI_PL_TYPE_OPAQUE: sv = sv_newmortal(); if( *((void**)arguments[i]) != NULL) sv_setiv(sv, PTR2IV( *((void**)arguments[i]) )); XPUSHs(sv); break; case FFI_PL_TYPE_STRING: sv = sv_newmortal(); if( *((char**)arguments[i]) != NULL) { sv_setpv(sv, *((char**)arguments[i])); } XPUSHs(sv); break; case FFI_PL_TYPE_RECORD: sv = sv_newmortal(); if( *((char**)arguments[i]) != NULL) { sv_setpvn(sv, *((char**)arguments[i]), extra->argument_types[i]->extra[0].record.size); if(extra->argument_types[i]->extra[0].record.class != NULL) { ref = newRV_inc(sv); sv_bless(ref, gv_stashpv(extra->argument_types[i]->extra[0].record.class, GV_ADD)); SvREADONLY_on(sv); sv = ref; } else { SvREADONLY_on(sv); } } XPUSHs(sv); break; case FFI_PL_TYPE_RECORD_VALUE: sv = sv_newmortal(); sv_setpvn(sv, (char*)arguments[i], extra->argument_types[i]->extra[0].record.size); ref = newRV_inc(sv); sv_bless(ref, gv_stashpv(extra->argument_types[i]->extra[0].record.class, GV_ADD)); SvREADONLY_on(sv); XPUSHs(ref); break; default: warn("bad type"); break; } } PUTBACK; } count = call_sv(closure->coderef, flags | G_EVAL); if(SvTRUE(ERRSV)) { #ifdef warn_sv warn_sv(ERRSV); #else warn("%s", SvPV_nolen(ERRSV)); #endif } if(!(flags & G_DISCARD)) { SPAGAIN; if(count != 1) sv = &PL_sv_undef; else sv = POPs; switch(extra->return_type->type_code) { case FFI_PL_TYPE_VOID: break; case FFI_PL_TYPE_UINT8: #if defined FFI_PL_PROBE_BIGENDIAN ((uint8_t*)result)[3] = SvUV(sv); #elif defined FFI_PL_PROBE_BIGENDIAN64 ((uint8_t*)result)[7] = SvUV(sv); #else *((uint8_t*)result) = SvUV(sv); #endif break; case FFI_PL_TYPE_SINT8: #if defined FFI_PL_PROBE_BIGENDIAN ((int8_t*)result)[3] = SvIV(sv); #elif defined FFI_PL_PROBE_BIGENDIAN64 ((int8_t*)result)[7] = SvIV(sv); #else *((int8_t*)result) = SvIV(sv); #endif break; case FFI_PL_TYPE_UINT16: #if defined FFI_PL_PROBE_BIGENDIAN ((uint16_t*)result)[1] = SvUV(sv); #elif defined FFI_PL_PROBE_BIGENDIAN64 ((uint16_t*)result)[3] = SvUV(sv); #else *((uint16_t*)result) = SvUV(sv); #endif break; case FFI_PL_TYPE_SINT16: #if defined FFI_PL_PROBE_BIGENDIAN ((int16_t*)result)[1] = SvIV(sv); #elif defined FFI_PL_PROBE_BIGENDIAN64 ((int16_t*)result)[3] = SvIV(sv); #else *((int16_t*)result) = SvIV(sv); #endif break; case FFI_PL_TYPE_UINT32: #if defined FFI_PL_PROBE_BIGENDIAN64 ((uint32_t*)result)[1] = SvUV(sv); #else *((uint32_t*)result) = SvUV(sv); #endif break; case FFI_PL_TYPE_SINT32: #if defined FFI_PL_PROBE_BIGENDIAN64 ((int32_t*)result)[1] = SvIV(sv); #else *((int32_t*)result) = SvIV(sv); #endif break; case FFI_PL_TYPE_UINT64: *((uint64_t*)result) = SvU64(sv); break; case FFI_PL_TYPE_SINT64: *((int64_t*)result) = SvI64(sv); break; case FFI_PL_TYPE_FLOAT: *((float*)result) = SvNV(sv); break; case FFI_PL_TYPE_DOUBLE: *((double*)result) = SvNV(sv); break; case FFI_PL_TYPE_OPAQUE: *((void**)result) = SvOK(sv) ? INT2PTR(void*, SvIV(sv)) : NULL; break; case FFI_PL_TYPE_RECORD_VALUE: if(sv_isobject(sv) && sv_derived_from(sv, extra->return_type->extra[0].record.class)) { char *ptr; STRLEN len; ptr = SvPV(SvRV(sv), len); if(len > extra->return_type->extra[0].record.size) len = extra->return_type->extra[0].record.size; else if(len < extra->return_type->extra[0].record.size) { warn("Return record from closure is wrong size!"); memset(result, 0, extra->return_type->extra[0].record.size); } memcpy(result, ptr, len); break; } warn("Return record from closure is wrong type!"); memset(result, 0, extra->return_type->extra[0].record.size); break; default: warn("bad type"); break; } PUTBACK; } if(!(flags & G_NOARGS)) { FREETMPS; LEAVE; } }