Use official Perl C API for creating host obj Make S_lazy_init_host_obj return an incref'd, blessed reference.
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/f049e48b Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/f049e48b Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/f049e48b Branch: refs/heads/master Commit: f049e48b3e626a0c2cf90b613f85e536dcb7d37d Parents: f87eb6e Author: Nick Wellnhofer <[email protected]> Authored: Mon May 18 13:04:40 2015 +0200 Committer: Nick Wellnhofer <[email protected]> Committed: Mon May 18 21:25:33 2015 +0200 ---------------------------------------------------------------------- runtime/perl/xs/XSBind.c | 50 ++++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 24 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/f049e48b/runtime/perl/xs/XSBind.c ---------------------------------------------------------------------- diff --git a/runtime/perl/xs/XSBind.c b/runtime/perl/xs/XSBind.c index 1e2aa7e..ba9af78 100644 --- a/runtime/perl/xs/XSBind.c +++ b/runtime/perl/xs/XSBind.c @@ -633,50 +633,49 @@ SI_is_string_type(cfish_Class *klass) { return false; } -static void +// Returns an incref'd, blessed RV. +static SV* S_lazy_init_host_obj(pTHX_ cfish_Obj *self) { - SV *inner_obj = newSV(0); - SvOBJECT_on(inner_obj); -#if (PERL_VERSION <= 16) - PL_sv_objcount++; -#endif - (void)SvUPGRADE(inner_obj, SVt_PVMG); - sv_setiv(inner_obj, PTR2IV(self)); + cfish_Class *klass = self->klass; + cfish_String *class_name = CFISH_Class_Get_Name(klass); - // Connect class association. - cfish_String *class_name = CFISH_Class_Get_Name(self->klass); - HV *stash = gv_stashpvn(CFISH_Str_Get_Ptr8(class_name), - CFISH_Str_Get_Size(class_name), TRUE); - SvSTASH_set(inner_obj, (HV*)SvREFCNT_inc(stash)); + SV *outer_obj = newSV(0); + sv_setref_pv(outer_obj, CFISH_Str_Get_Ptr8(class_name), self); + SV *inner_obj = SvRV(outer_obj); /* 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. */ + * will assume responsibility for maintaining the refcount. */ cfish_ref_t old_ref = self->ref; - size_t excess = (old_ref.count >> XSBIND_REFCOUNT_SHIFT) - 1; + size_t excess = old_ref.count >> XSBIND_REFCOUNT_SHIFT; SvREFCNT(inner_obj) += excess; // Overwrite refcount with host object. - cfish_Class *klass = self->klass; if (SI_immortal(klass)) { SvSHARE(inner_obj); - if (!cfish_Atomic_cas_ptr((void**)&self->ref, old_ref.host_obj, inner_obj)) { - // Another thread beat us to it. Now we have a Perl object to defuse. + if (!cfish_Atomic_cas_ptr((void**)&self->ref, old_ref.host_obj, + inner_obj)) { + // Another thread beat us to it. Now we have a Perl object to + // defuse. "Unbless" the object first to make sure the + // Clownfish destructor won't be called. + HV *stash = SvSTASH(inner_obj); SvSTASH_set(inner_obj, NULL); SvREFCNT_dec((SV*)stash); SvOBJECT_off(inner_obj); SvREFCNT(inner_obj) -= excess; - SvREFCNT_dec(inner_obj); #if (PERL_VERSION <= 16) PL_sv_objcount--; #endif + SvREFCNT_dec(outer_obj); + + return newRV_inc((SV*)self->ref.host_obj); } } else { self->ref.host_obj = inner_obj; } + + return outer_obj; } uint32_t @@ -760,11 +759,14 @@ cfish_dec_refcount(void *vself) { void* CFISH_Obj_To_Host_IMP(cfish_Obj *self) { dTHX; + SV *perl_obj; if (self->ref.count & XSBIND_REFCOUNT_FLAG) { - S_lazy_init_host_obj(aTHX_ self); + perl_obj = S_lazy_init_host_obj(aTHX_ self); + } + else { + perl_obj = newRV_inc((SV*)self->ref.host_obj); } - SV *perl_obj = newRV_inc((SV*)self->ref.host_obj); -#if PERL_VERSION <= 16 +#if PERL_VERSION <= 8 // Enable overloading. SvAMAGIC_on(perl_obj); #endif
