void dcVCallF(DCCallVM* vm, DCValue* result, DCpointer funcptr, const DCsigchar* signature, va_list args)
{
const DCsigchar* ptr = signature;
dcArgF_impl(vm, &ptr, args);
switch(*ptr) {
case DC_SIGCHAR_VOID: dcCallVoid (vm,funcptr); break;
case DC_SIGCHAR_BOOL: result->B = dcCallBool (vm,funcptr); break;
case DC_SIGCHAR_CHAR: result->c = dcCallChar (vm,funcptr); break;
case DC_SIGCHAR_UCHAR: result->C = (DCuchar)dcCallChar (vm,funcptr); break;
case DC_SIGCHAR_SHORT: result->s = dcCallShort (vm,funcptr); break;
case DC_SIGCHAR_USHORT: result->S = dcCallShort (vm,funcptr); break;
case DC_SIGCHAR_INT: result->i = dcCallInt (vm,funcptr); break;
case DC_SIGCHAR_UINT: result->I = dcCallInt (vm,funcptr); break;
case DC_SIGCHAR_LONG: result->j = dcCallLong (vm,funcptr); break;
case DC_SIGCHAR_ULONG: result->J = dcCallLong (vm,funcptr); break;
case DC_SIGCHAR_LONGLONG: result->l = dcCallLongLong (vm,funcptr); break;
case DC_SIGCHAR_ULONGLONG: result->L = dcCallLongLong (vm,funcptr); break;
case DC_SIGCHAR_FLOAT: result->f = dcCallFloat (vm,funcptr); break;
case DC_SIGCHAR_DOUBLE: result->d = dcCallDouble (vm,funcptr); break;
case DC_SIGCHAR_POINTER: result->p = dcCallPointer (vm,funcptr); break;
case DC_SIGCHAR_STRING: result->Z = (DCstring)dcCallPointer(vm,funcptr); break;
}
}
template<> bool _call_fn_internal<bool>(void* fn_ptr) { return dcCallBool(vm, fn_ptr); }
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;
}
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" );
}
}
