static SV*
do_callback_sv(kino_Obj *obj, char *method, chy_u32_t num_args, va_list args)
{
dSP;
int num_returned;
SV *return_val;
SV *invoker;
chy_u32_t i;
if (KINO_OBJ_IS_A(obj, KINO_VTABLE)) {
kino_VTable *vtable = (kino_VTable*)obj;
invoker = XSBind_cb_to_sv(vtable->name);
}
else {
invoker = (SV*)Kino_Obj_To_Host(obj);
}
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs( sv_2mortal(invoker) );
for (i = 0; i < num_args; i++) {
PUSH_ARG(args, num_args);
}
PUTBACK;
num_returned = call_method(method, G_SCALAR);
SPAGAIN;
if (num_returned != 1) {
KINO_THROW("Bad number of return vals from %s: %i32", method,
(chy_i32_t)num_returned);
}
return_val = POPs;
PUTBACK;
return return_val;
}
void
kino_Host_callback(void *vobj, char *method, chy_u32_t num_args, ...)
{
kino_Obj *obj = (kino_Obj*)vobj;
dSP;
va_list args;
int count;
chy_u32_t i;
SV *invoker;
kino_VTable *vtable;
if (KINO_OBJ_IS_A(obj, KINO_VTABLE)) {
vtable = (kino_VTable*)obj;
invoker = XSBind_cb_to_sv(vtable->name);
}
else {
vtable = obj->vtable;
invoker = (SV*)Kino_Obj_To_Host(obj);
}
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs( sv_2mortal(invoker) );
va_start(args, num_args);
for (i = 0; i < num_args; i++) {
PUSH_ARG(args, num_args);
}
va_end(args);
PUTBACK;
count = call_method(method, G_VOID|G_DISCARD);
if (count != 0) {
KINO_THROW("callback '%s' in '%o' returned too many values: %i32",
method, Kino_VTable_Get_Name(vtable), (chy_i32_t)count);
}
PUTBACK;
FREETMPS;
LEAVE;
}
// Convert all arguments to Perl and place them on the Perl stack.
static CHY_INLINE void
SI_push_args(void *vobj, va_list args, uint32_t num_args)
{
kino_Obj *obj = (kino_Obj*)vobj;
SV *invoker;
uint32_t i;
dSP;
uint32_t stack_slots_needed = num_args < 2
? num_args + 1
: (num_args * 2) + 1;
EXTEND(SP, stack_slots_needed);
if (Kino_Obj_Is_A(obj, KINO_VTABLE)) {
kino_VTable *vtable = (kino_VTable*)obj;
// TODO: Creating a new class name SV every time is wasteful.
invoker = XSBind_cb_to_sv(Kino_VTable_Get_Name(vtable));
}
else {
invoker = (SV*)Kino_Obj_To_Host(obj);
}
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUSHs( sv_2mortal(invoker) );
for (i = 0; i < num_args; i++) {
uint32_t arg_type = va_arg(args, uint32_t);
char *label = va_arg(args, char*);
if (num_args > 1) {
PUSHs( sv_2mortal( newSVpvn(label, strlen(label)) ) );
}
switch (arg_type & CFISH_HOST_ARGTYPE_MASK) {
case CFISH_HOST_ARGTYPE_I32: {
int32_t value = va_arg(args, int32_t);
PUSHs( sv_2mortal( newSViv(value) ) );
}
break;
case CFISH_HOST_ARGTYPE_I64: {
int64_t value = va_arg(args, int64_t);
if (sizeof(IV) == 8) {
PUSHs( sv_2mortal( newSViv((IV)value) ) );
}
else {
// lossy
PUSHs( sv_2mortal( newSVnv((double)value) ) );
}
}
break;
case CFISH_HOST_ARGTYPE_F32:
case CFISH_HOST_ARGTYPE_F64: {
// Floats are promoted to doubles by variadic calling.
double value = va_arg(args, double);
PUSHs( sv_2mortal( newSVnv(value) ) );
}
break;
case CFISH_HOST_ARGTYPE_STR: {
kino_CharBuf *string = va_arg(args, kino_CharBuf*);
PUSHs( sv_2mortal( XSBind_cb_to_sv(string) ) );
}
break;
case CFISH_HOST_ARGTYPE_OBJ: {
kino_Obj* anObj = va_arg(args, kino_Obj*);
SV *arg_sv = anObj == NULL
? newSV(0)
: XSBind_cfish_to_perl(anObj);
PUSHs( sv_2mortal(arg_sv) );
}
break;
default:
CFISH_THROW(KINO_ERR, "Unrecognized arg type: %u32", arg_type);
}
}
PUTBACK;
}
