You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by ma...@apache.org on 2011/12/15 07:38:32 UTC
[lucy-commits] svn commit: r1214632 - in /incubator/lucy/trunk/clownfish:
perl/lib/Clownfish.xs src/CFCBase.c src/CFCBase.h
Author: marvin
Date: Thu Dec 15 06:38:32 2011
New Revision: 1214632
URL: http://svn.apache.org/viewvc?rev=1214632&view=rev
Log:
Purge inner Perl objects from CFC.
Use an integer refcount for CFC objects. Wrap Perl objects around the
outside, so that the Perl DESTROY method only decrements the refcount and
thus a CFC object may be associated with more than one Perl object during its
lifetime.
Modified:
incubator/lucy/trunk/clownfish/perl/lib/Clownfish.xs
incubator/lucy/trunk/clownfish/src/CFCBase.c
incubator/lucy/trunk/clownfish/src/CFCBase.h
Modified: incubator/lucy/trunk/clownfish/perl/lib/Clownfish.xs
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/perl/lib/Clownfish.xs?rev=1214632&r1=1214631&r2=1214632&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/perl/lib/Clownfish.xs (original)
+++ incubator/lucy/trunk/clownfish/perl/lib/Clownfish.xs Thu Dec 15 06:38:32 2011
@@ -50,13 +50,13 @@
static SV*
S_cfcbase_to_perlref(void *thing) {
+ SV *ref = newSV(0);
if (thing) {
- SV *perl_obj = (SV*)CFCBase_get_perl_obj((CFCBase*)thing);
- return newRV(perl_obj);
- }
- else {
- return newSV(0);
+ const char *klass = CFCBase_get_cfc_class((CFCBase*)thing);
+ CFCBase_incref((CFCBase*)thing);
+ sv_setref_pv(ref, klass, (void*)thing);
}
+ return ref;
}
// Transform a NULL-terminated array of CFCBase* into a Perl arrayref.
@@ -85,6 +85,15 @@ S_sv_eat_c_string(char *string) {
}
}
+MODULE = Clownfish PACKAGE = Clownfish::Base
+
+void
+DESTROY(self)
+ CFCBase *self;
+PPCODE:
+ CFCBase_decref((CFCBase*)self);
+
+
MODULE = Clownfish PACKAGE = Clownfish::CBlock
SV*
@@ -97,12 +106,6 @@ CODE:
OUTPUT: RETVAL
void
-DESTROY(self)
- CFCCBlock *self;
-PPCODE:
- CFCCBlock_destroy(self);
-
-void
_set_or_get(self, ...)
CFCCBlock *self;
ALIAS:
@@ -152,12 +155,6 @@ CODE:
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
-void
-DESTROY(self)
- CFCClass *self;
-PPCODE:
- CFCClass_destroy(self);
-
SV*
_fetch_singleton(parcel, class_name)
CFCParcel *parcel;
@@ -437,12 +434,6 @@ CODE:
OUTPUT: RETVAL
void
-DESTROY(self)
- CFCDocuComment *self;
-PPCODE:
- CFCDocuComment_destroy(self);
-
-void
_set_or_get(self, ...)
CFCDocuComment *self;
ALIAS:
@@ -517,12 +508,6 @@ CODE:
OUTPUT: RETVAL
void
-DESTROY(self)
- CFCDumpable *self;
-PPCODE:
- CFCDumpable_destroy(self);
-
-void
add_dumpables(self, klass)
CFCDumpable *self;
CFCClass *klass;
@@ -542,12 +527,6 @@ CODE:
OUTPUT: RETVAL
void
-_destroy(self)
- CFCFile *self;
-PPCODE:
- CFCFile_destroy(self);
-
-void
add_block(self, block)
CFCFile *self;
CFCBase *block;
@@ -667,12 +646,6 @@ CODE:
OUTPUT: RETVAL
void
-DESTROY(self)
- CFCFunction *self;
-PPCODE:
- CFCFunction_destroy(self);
-
-void
_set_or_get(self, ...)
CFCFunction *self;
ALIAS:
@@ -735,12 +708,6 @@ CODE:
OUTPUT: RETVAL
void
-DESTROY(self)
- CFCHierarchy *self;
-PPCODE:
- CFCHierarchy_destroy(self);
-
-void
build(self)
CFCHierarchy *self;
PPCODE:
@@ -817,12 +784,6 @@ CODE:
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
-void
-DESTROY(self)
- CFCMethod *self;
-PPCODE:
- CFCMethod_destroy(self);
-
int
compatible(self, other)
CFCMethod *self;
@@ -958,12 +919,6 @@ CODE:
OUTPUT: RETVAL
void
-DESTROY(self)
- CFCParamList *self;
-PPCODE:
- CFCParamList_destroy(self);
-
-void
add_param(self, variable, value_sv)
CFCParamList *self;
CFCVariable *variable;
@@ -1049,12 +1004,6 @@ CODE:
RETVAL = S_cfcbase_to_perlref(self);
OUTPUT: RETVAL
-void
-DESTROY(self)
- CFCParcel *self;
-PPCODE:
- CFCParcel_destroy(self);
-
int
equals(self, other)
CFCParcel *self;
@@ -1150,12 +1099,6 @@ CODE:
OUTPUT: RETVAL
void
-DESTROY(self)
- CFCSymbol *self;
-PPCODE:
- CFCSymbol_destroy(self);
-
-void
_set_or_get(self, ...)
CFCSymbol *self;
ALIAS:
@@ -1341,12 +1284,6 @@ CODE:
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
-void
-DESTROY(self)
- CFCType *self;
-PPCODE:
- CFCType_destroy(self);
-
int
equals(self, other)
CFCType *self;
@@ -1647,12 +1584,6 @@ CODE:
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
-void
-DESTROY(self)
- CFCVariable *self;
-PPCODE:
- CFCVariable_destroy(self);
-
int
equals(self, other)
CFCVariable *self;
@@ -1709,12 +1640,6 @@ CODE:
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
-void
-DESTROY(self);
- CFCBindCore *self;
-PPCODE:
- CFCBindCore_destroy(self);
-
int
write_all_modified(self, ...)
CFCBindCore *self;
@@ -1808,12 +1733,6 @@ CODE:
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
-void
-DESTROY(self)
- CFCBindClass *self;
-PPCODE:
- CFCBindClass_destroy(self);
-
SV*
to_c(self)
CFCBindClass *self;
@@ -1842,12 +1761,6 @@ PPCODE:
MODULE = Clownfish PACKAGE = Clownfish::Binding::Perl::Subroutine
void
-DESTROY(self)
- CFCPerlSub *self;
-PPCODE:
- CFCPerlSub_destroy(self);
-
-void
_set_or_get(self, ...)
CFCPerlSub *self;
ALIAS:
@@ -1917,12 +1830,6 @@ CODE:
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
-void
-DESTROY(self)
- CFCPerlMethod *self;
-PPCODE:
- CFCPerlMethod_destroy(self);
-
SV*
xsub_def(self)
CFCPerlMethod *self;
@@ -1943,12 +1850,6 @@ CODE:
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
-void
-DESTROY(self)
- CFCPerlConstructor *self;
-PPCODE:
- CFCPerlConstructor_destroy(self);
-
SV*
xsub_def(self)
CFCPerlConstructor *self;
@@ -1980,7 +1881,7 @@ void
_destroy(self)
CFCPerlClass *self;
PPCODE:
- CFCPerlClass_destroy(self);
+ CFCBase_decref((CFCBase*)self);
void
_add_to_registry(self)
@@ -2058,12 +1959,6 @@ CODE:
OUTPUT: RETVAL
void
-DESTROY(self)
- CFCPerlPod *self;
-PPCODE:
- CFCPerlPod_destroy(self);
-
-void
_add_method(self, name, pod_sv)
CFCPerlPod *self;
const char *name;
@@ -2191,12 +2086,6 @@ CODE:
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
-void
-DESTROY(self)
- CFCParser *self;
-PPCODE:
- CFCParser_destroy(self);
-
SV*
parse(self, string)
CFCParser *self;
@@ -2246,12 +2135,3 @@ CODE:
RETVAL = S_cfcbase_to_perlref((CFCBase*)parcel);
OUTPUT: RETVAL
-
-MODULE = Clownfish PACKAGE = Clownfish::MemPool
-
-void
-DESTROY(self)
- CFCMemPool *self;
-PPCODE:
- CFCMemPool_destroy(self);
-
Modified: incubator/lucy/trunk/clownfish/src/CFCBase.c
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/src/CFCBase.c?rev=1214632&r1=1214631&r2=1214632&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/src/CFCBase.c (original)
+++ incubator/lucy/trunk/clownfish/src/CFCBase.c Thu Dec 15 06:38:32 2011
@@ -14,12 +14,6 @@
* limitations under the License.
*/
-#include <stdlib.h>
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include "ppport.h"
-
#define CFC_NEED_BASE_STRUCT_DEF
#include "CFCBase.h"
#include "CFCUtil.h"
@@ -27,7 +21,7 @@
CFCBase*
CFCBase_allocate(const CFCMeta *meta) {
CFCBase *self = (CFCBase*)CALLOCATE(meta->obj_alloc_size, 1);
- self->perl_obj = CFCUtil_make_perl_obj(self, meta->cfc_class);
+ self->refcount = 1;
self->meta = meta;
return self;
}
@@ -40,7 +34,7 @@ CFCBase_destroy(CFCBase *self) {
CFCBase*
CFCBase_incref(CFCBase *self) {
if (self) {
- SvREFCNT_inc((SV*)self->perl_obj);
+ self->refcount++;
}
return self;
}
@@ -48,23 +42,16 @@ CFCBase_incref(CFCBase *self) {
unsigned
CFCBase_decref(CFCBase *self) {
if (!self) { return 0; }
- unsigned modified_refcount = SvREFCNT((SV*)self->perl_obj) - 1;
- /* When the SvREFCNT for this Perl object falls to zero, DESTROY will be
- * invoked from Perl space for the class that the Perl object was blessed
- * into. Thus even though the very simple CFC object model does not
- * generally support polymorphism, we get it for object destruction. */
- SvREFCNT_dec((SV*)self->perl_obj);
+ unsigned modified_refcount = self->refcount - 1;
+ if (modified_refcount == 0) {
+ self->meta->destroy(self);
+ }
return modified_refcount;
}
unsigned
CFCBase_get_refcount(CFCBase *self) {
- return SvREFCNT((SV*)self->perl_obj);
-}
-
-void*
-CFCBase_get_perl_obj(CFCBase *self) {
- return self->perl_obj;
+ return self->refcount;
}
const char*
Modified: incubator/lucy/trunk/clownfish/src/CFCBase.h
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/src/CFCBase.h?rev=1214632&r1=1214631&r2=1214632&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/src/CFCBase.h (original)
+++ incubator/lucy/trunk/clownfish/src/CFCBase.h Thu Dec 15 06:38:32 2011
@@ -30,7 +30,7 @@ typedef void (*CFCBase_destroy_t)(CFCBas
#ifdef CFC_NEED_BASE_STRUCT_DEF
struct CFCBase {
const CFCMeta *meta;
- void *perl_obj;
+ int refcount;
};
#endif
struct CFCMeta {
@@ -72,11 +72,6 @@ CFCBase_decref(CFCBase *self);
unsigned
CFCBase_get_refcount(CFCBase *self);
-/** Return the CFC object's cached Perl object.
- */
-void*
-CFCBase_get_perl_obj(CFCBase *self);
-
/** Return the class name of the CFC object. (Not the class name of any
* parsed object the CFC object might represent.)
*/