You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by nw...@apache.org on 2015/05/18 21:29:29 UTC
[03/10] lucy-clownfish git commit: Use official Perl C API for
creating host obj
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 <we...@aevum.de>
Authored: Mon May 18 13:04:40 2015 +0200
Committer: Nick Wellnhofer <we...@aevum.de>
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