void dcArgStructUnroll(DCCallVM* vm, DCstruct* s, DCpointer value) { DCsize i; /*printf("UNROLLING STRUCT !\n");@@@*/ assert(s && value); for (i = 0; i < s->fieldCount; i++) { DCfield *f = s->pFields + i; DCpointer p = (char*)value + f->offset; switch(f->type) { case DC_SIGCHAR_STRUCT: dcArgStruct(vm, f->pSubStruct, p); break; case DC_SIGCHAR_BOOL: dcArgBool (vm, *(DCbool*)p); break; case DC_SIGCHAR_CHAR: case DC_SIGCHAR_UCHAR: dcArgChar (vm, *(DCchar*)p); break; case DC_SIGCHAR_SHORT: case DC_SIGCHAR_USHORT: dcArgShort (vm, *(DCshort*)p); break; case DC_SIGCHAR_INT: case DC_SIGCHAR_UINT: dcArgInt (vm, *(DCint*)p); break; case DC_SIGCHAR_LONG: case DC_SIGCHAR_ULONG: dcArgLong (vm, *(DCulong*)p); break; case DC_SIGCHAR_LONGLONG: case DC_SIGCHAR_ULONGLONG: dcArgLongLong (vm, *(DCulonglong*)p); break; case DC_SIGCHAR_FLOAT: dcArgFloat (vm, *(DCfloat*)p); break; case DC_SIGCHAR_DOUBLE: dcArgDouble (vm, *(DCdouble*)p); break; case DC_SIGCHAR_POINTER: case DC_SIGCHAR_STRING: dcArgPointer (vm, *(DCpointer**)p); break; default: assert(0); } } }
// Shareable implementation for argument binding used in ArgF and CallF below. static void dcArgF_impl(DCCallVM* vm, const DCsigchar** sigptr, va_list args) { DCsigchar ch; dcReset(vm); while((ch=*(*sigptr)++) != '\0' && ch != DC_SIGCHAR_ENDARG) { switch(ch) { case DC_SIGCHAR_BOOL: dcArgBool (vm, (DCbool) va_arg(args, DCint )); break; case DC_SIGCHAR_CHAR: dcArgChar (vm, (DCchar) va_arg(args, DCint )); break; case DC_SIGCHAR_UCHAR: dcArgChar (vm, (DCchar)(DCuchar) va_arg(args, DCint )); break; case DC_SIGCHAR_SHORT: dcArgShort (vm, (DCshort) va_arg(args, DCint )); break; case DC_SIGCHAR_USHORT: dcArgShort (vm, (DCshort)(DCushort)va_arg(args, DCint )); break; case DC_SIGCHAR_INT: dcArgInt (vm, (DCint) va_arg(args, DCint )); break; case DC_SIGCHAR_UINT: dcArgInt (vm, (DCint)(DCuint) va_arg(args, DCint )); break; case DC_SIGCHAR_LONG: dcArgLong (vm, (DClong) va_arg(args, DClong )); break; case DC_SIGCHAR_ULONG: dcArgLong (vm, (DCulong) va_arg(args, DClong )); break; case DC_SIGCHAR_LONGLONG: dcArgLongLong(vm, (DClonglong) va_arg(args, DClonglong)); break; case DC_SIGCHAR_ULONGLONG: dcArgLongLong(vm, (DCulonglong) va_arg(args, DClonglong)); break; case DC_SIGCHAR_FLOAT: dcArgFloat (vm, (DCfloat) va_arg(args, DCdouble )); break; case DC_SIGCHAR_DOUBLE: dcArgDouble (vm, (DCdouble) va_arg(args, DCdouble )); break; case DC_SIGCHAR_POINTER: dcArgPointer (vm, (DCpointer) va_arg(args, DCpointer )); break; case DC_SIGCHAR_STRING: dcArgPointer (vm, (DCpointer) va_arg(args, DCpointer )); break; } } }
SEXP r_dcCall(SEXP sCallVM, SEXP sFuncPtr, SEXP sSignature, SEXP sArgs) { DCCallVM* pvm; void* funcPtr; const char* signature; const char* ptr; int i,l,protect_count; SEXP r; pvm = R_ExternalPtrAddr(sCallVM); if (!pvm) error("callvm is null"); funcPtr = R_ExternalPtrAddr(sFuncPtr); if (!funcPtr) error("funcptr is null"); signature = CHAR(STRING_ELT(sSignature,0) ); if (!signature) error("signature is null"); dcReset(pvm); ptr = signature; l = LENGTH(sArgs); i = 0; protect_count = 0; for(;;) { char ch = *ptr++; SEXP arg; if (ch == '\0') error("invalid signature - no return type specified"); if (ch == ')') break; if (i >= l) error("not enough arguments for given signature (arg length = %d %d %c)", l,i,ch ); arg = VECTOR_ELT(sArgs,i); switch(ch) { case DC_SIGCHAR_BOOL: { DCbool value; if ( isLogical(arg) ) { value = ( LOGICAL(arg)[0] == 0 ) ? DC_FALSE : DC_TRUE; } else { value = LOGICAL( coerceVector(arg, LGLSXP) )[0] ? DC_FALSE : DC_TRUE; } dcArgBool(pvm, value ); break; } case DC_SIGCHAR_INT: { int value; if ( isInteger(arg) ) { value = INTEGER(arg)[0]; } else { value = INTEGER( coerceVector(arg, INTSXP) )[0]; } dcArgInt(pvm, value); break; } case DC_SIGCHAR_FLOAT: { dcArgFloat( pvm, (float) REAL( coerceVector(arg, REALSXP) )[0] ); break; } case DC_SIGCHAR_DOUBLE: { double value; if ( isReal(arg) ) { value = REAL(arg)[0]; } else { value = REAL( coerceVector(arg,REALSXP) )[0]; } dcArgDouble( pvm, value ); break; } /* case DC_SIGCHAR_LONG: { PROTECT(arg = coerceVector(arg, REALSXP) ); dcArgLong( pvm, (DClong) ( REAL(arg)[0] ) ); UNPROTECT(1); break; } */ case DC_SIGCHAR_STRING: { DCpointer ptr; if (arg == R_NilValue) ptr = (DCpointer) 0; else if (isString(arg)) ptr = (DCpointer) CHAR( STRING_ELT(arg,0) ); else { if (protect_count) UNPROTECT(protect_count); error("invalid value for C string argument"); break; } } case DC_SIGCHAR_POINTER: { DCpointer ptr; if ( arg == R_NilValue ) ptr = (DCpointer) 0; else if (isString(arg) ) ptr = (DCpointer) CHAR( STRING_ELT(arg,0) ); else if (isReal(arg) ) ptr = (DCpointer) REAL(arg); else if (isInteger(arg) ) ptr = (DCpointer) INTEGER(arg); else if (isLogical(arg) ) ptr = (DCpointer) LOGICAL(arg); else if (TYPEOF(arg) == EXTPTRSXP) ptr = R_ExternalPtrAddr(arg); else { if (protect_count) UNPROTECT(protect_count); error("invalid signature"); break; } dcArgPointer(pvm, ptr); break; } } ++i; } if ( i != l ) { if (protect_count) UNPROTECT(protect_count); error ("signature claims to have %d arguments while %d arguments are given", i, l); } switch(*ptr) { case DC_SIGCHAR_BOOL: PROTECT( r = allocVector(LGLSXP, 1) ); protect_count++; LOGICAL(r)[0] = ( dcCallBool(pvm, funcPtr) == DC_FALSE ) ? FALSE : TRUE; UNPROTECT(protect_count); return r; case DC_SIGCHAR_CHAR: PROTECT( r = allocVector(INTSXP, 1) ); protect_count++; INTEGER(r)[0] = dcCallChar(pvm, funcPtr); UNPROTECT(protect_count); return r; case DC_SIGCHAR_SHORT: PROTECT( r = allocVector(INTSXP, 1) ); protect_count++; INTEGER(r)[0] = dcCallShort(pvm, funcPtr); UNPROTECT(protect_count); return r; case DC_SIGCHAR_LONG: PROTECT( r = allocVector(INTSXP, 1) ); protect_count++; INTEGER(r)[0] = dcCallLong(pvm, funcPtr); UNPROTECT(protect_count); return r; case DC_SIGCHAR_INT: PROTECT( r = allocVector(INTSXP, 1) ); protect_count++; INTEGER(r)[0] = dcCallInt(pvm, funcPtr); UNPROTECT(protect_count); return r; case DC_SIGCHAR_LONGLONG: PROTECT( r = allocVector(REALSXP, 1) ); protect_count++; REAL(r)[0] = (double) ( dcCallLong(pvm, funcPtr) ); UNPROTECT(protect_count); return r; case DC_SIGCHAR_FLOAT: PROTECT( r = allocVector(REALSXP, 1) ); protect_count++; REAL(r)[0] = (double) ( dcCallFloat(pvm, funcPtr) ); UNPROTECT(protect_count); return r; case DC_SIGCHAR_DOUBLE: PROTECT( r = allocVector(REALSXP, 1) ); protect_count++; REAL(r)[0] = dcCallDouble(pvm, funcPtr); UNPROTECT(protect_count); return r; case DC_SIGCHAR_POINTER: PROTECT( r = R_MakeExternalPtr( dcCallPointer(pvm,funcPtr), R_NilValue, R_NilValue ) ); protect_count++; UNPROTECT(protect_count); return r; case DC_SIGCHAR_VOID: dcCallVoid(pvm,funcPtr); if (protect_count) UNPROTECT(protect_count); break; default: { if (protect_count) UNPROTECT(protect_count); error("invalid return type signature"); } break; } return R_NilValue; }
// template<typename T> void _push_fn_arg(T t) { dcArgPointer(vm, t); } // assume it's a pointer template<> void _push_fn_arg<bool>(bool value) { dcArgBool(vm, value); }
static PyObject* pydc_call(PyObject* self, PyObject* in_args) { PyObject* pcobj_funcptr; const char* signature; PyObject* args; int l; const char* ptr; char ch; int pos; void* pfunc; if ( !PyArg_ParseTuple(in_args,"OsO", &pcobj_funcptr, &signature, &args) ) return PyErr_Format(PyExc_RuntimeError, "argument mismatch"); pfunc = PyCObject_AsVoidPtr(pcobj_funcptr); if ( !pfunc ) return PyErr_Format( PyExc_RuntimeError, "function pointer is NULL" ); l = PyTuple_Size(args); ptr = signature; pos = 0; dcReset(gpCall); while ( (ch = *ptr) != '\0' && ch != ')' ) { PyObject* po; int index = pos+1; if (pos > l) return PyErr_Format( PyExc_RuntimeError, "expecting more arguments" ); po = PyTuple_GetItem(args,pos); switch(ch) { case DC_SIGCHAR_BOOL: { DCbool b; if ( !PyBool_Check(po) ) return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expecting a bool", index ); b = (Py_True == po) ? DC_TRUE : DC_FALSE; dcArgBool(gpCall, b); } break; case DC_SIGCHAR_CHAR: { DCchar c; if ( PyString_Check(po) ) { // Py_ssize_t l; size_t l; char* s; l = PyString_GET_SIZE(po); if (l != 1) return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expecting a string with length of 1 (a char string)", index ); s = PyString_AsString(po); c = (DCchar) s[0]; } else if ( PyInt_Check(po) ) { long l; l = PyInt_AsLong(po); if ( (l > CHAR_MAX) || (l < CHAR_MIN)) return PyErr_Format( PyExc_RuntimeError, "value out of range at argument %d - expecting a char code", index ); c = (DCchar) l; } else return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expecting a char", index ); dcArgChar(gpCall, c); } break; case DC_SIGCHAR_SHORT: { DCshort s; long v; if ( !PyInt_Check(po) ) return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expecting a short int", index ); v = PyInt_AS_LONG(po); if ( (v < SHRT_MIN) || (v > SHRT_MAX) ) return PyErr_Format( PyExc_RuntimeError, "value out of range at argument %d - expecting a short value", index ); s = (DCshort) v; dcArgShort(gpCall, s); } break; case DC_SIGCHAR_INT: { long v; if ( !PyInt_Check(po) ) return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expecting an int", index ); v = PyInt_AS_LONG(po); dcArgInt(gpCall, (DCint) v ); } break; case DC_SIGCHAR_LONG: { long v; if ( !PyInt_Check(po) ) return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expecting an int", index ); v = PyInt_AsLong(po); } break; case DC_SIGCHAR_LONGLONG: { PY_LONG_LONG pl; DClonglong dl; if ( !PyLong_Check(po) ) return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expecting a long long", index ); pl = PyLong_AsLongLong(po); dl = (DClonglong) pl; dcArgLongLong(gpCall, dl ); } break; case DC_SIGCHAR_FLOAT: { DCfloat f; if (!PyFloat_Check(po)) return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expeecting a float", index ); f = (float) PyFloat_AsDouble(po); dcArgFloat(gpCall, f); } break; case DC_SIGCHAR_DOUBLE: { double d; if (!PyFloat_Check(po)) return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expeecting a float", index ); d = PyFloat_AsDouble(po); dcArgDouble(gpCall, d); } break; case DC_SIGCHAR_POINTER: { DCpointer ptr; if ( PyString_Check(po) ) { ptr = (DCpointer) PyString_AsString(po); } else if ( PyLong_Check(po) ) { ptr = (DCpointer) ( (DCint) PyLong_AsLongLong(po) ); } else { return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expecting a promoting pointer-type (int,string)", index ); } dcArgPointer(gpCall, ptr ); } break; case 'S': { char* p; if (!PyString_Check(po) ) return PyErr_Format( PyExc_RuntimeError, "argument mismatch at pos %d - expecting a string", index ); p = PyString_AsString(po); dcArgPointer(gpCall, (DCpointer) p ); } break; default: return PyErr_Format( PyExc_RuntimeError, "unknown signature character '%c'", ch); } ++pos; ++ptr; } if (pos != l) return PyErr_Format( PyExc_RuntimeError, "too many arguments"); if (ch == '\0') return PyErr_Format( PyExc_RuntimeError, "return value missing in signature"); ch = *++ptr; switch(ch) { case DC_SIGCHAR_VOID: dcCallVoid(gpCall, pfunc); Py_RETURN_NONE; case DC_SIGCHAR_BOOL: return Py_BuildValue("i", dcCallBool(gpCall, pfunc) ); case DC_SIGCHAR_INT: return Py_BuildValue("i", dcCallInt(gpCall, pfunc) ); case DC_SIGCHAR_LONGLONG: return Py_BuildValue("L", (unsigned long long) dcCallLongLong(gpCall, pfunc) ); case DC_SIGCHAR_FLOAT: return Py_BuildValue("f", dcCallFloat(gpCall, pfunc) ); case DC_SIGCHAR_DOUBLE: return Py_BuildValue("d", dcCallDouble(gpCall, pfunc) ); case 's': return Py_BuildValue("s", dcCallPointer(gpCall, pfunc) ); case DC_SIGCHAR_POINTER: return Py_BuildValue("p", dcCallPointer(gpCall, pfunc) ); default: return PyErr_Format( PyExc_RuntimeError, "invalid return type signature" ); } }