static void S_lazy_init_host_obj(kino_Obj *self) { SV *inner_obj = newSV(0); SvOBJECT_on(inner_obj); PL_sv_objcount++; SvUPGRADE(inner_obj, SVt_PVMG); sv_setiv(inner_obj, PTR2IV(self)); // Connect class association. kino_CharBuf *class_name = Kino_VTable_Get_Name(self->vtable); HV *stash = gv_stashpvn((char*)Kino_CB_Get_Ptr8(class_name), Kino_CB_Get_Size(class_name), TRUE); SvSTASH_set(inner_obj, (HV*)SvREFCNT_inc(stash)); /* Up till now we've been keeping track of the refcount in * self->ref.count. We're replacing ref.count with ref.host_obj, which * will assume responsibility for maintaining the refcount. ref.host_obj * starts off with a refcount of 1, so we need to transfer any refcounts * in excess of that. */ size_t old_refcount = self->ref.count; self->ref.host_obj = inner_obj; while (old_refcount > 1) { SvREFCNT_inc_simple_void_NN(inner_obj); old_refcount--; } }
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; }