From 7c1dc695c496352a9d44eb1a686d1ecc94b24ee9 Mon Sep 17 00:00:00 2001 From: Marvin Humphrey Date: Fri, 8 May 2015 18:06:16 -0700 Subject: [PATCH 1/7] Make PerlSub helpers more flexible. Add an extra argument, `first`, controlling which params to include. Don't force the first argument name to `self`. --- compiler/perl/lib/Clownfish/CFC.xs | 5 +++-- compiler/src/CFCPerlConstructor.c | 4 ++-- compiler/src/CFCPerlMethod.c | 6 +++--- compiler/src/CFCPerlSub.c | 19 +++++++++++-------- compiler/src/CFCPerlSub.h | 10 ++++++---- 5 files changed, 25 insertions(+), 19 deletions(-) diff --git a/compiler/perl/lib/Clownfish/CFC.xs b/compiler/perl/lib/Clownfish/CFC.xs index 090a63d6..8e8f0f3b 100644 --- a/compiler/perl/lib/Clownfish/CFC.xs +++ b/compiler/perl/lib/Clownfish/CFC.xs @@ -2092,10 +2092,11 @@ CODE: OUTPUT: RETVAL SV* -build_allot_params(self) +build_allot_params(self, first) CFCPerlSub *self; + size_t first; CODE: - RETVAL = S_sv_eat_c_string(CFCPerlSub_build_allot_params(self)); + RETVAL = S_sv_eat_c_string(CFCPerlSub_build_allot_params(self, first)); OUTPUT: RETVAL diff --git a/compiler/src/CFCPerlConstructor.c b/compiler/src/CFCPerlConstructor.c index 8004ca41..8c5e8759 100644 --- a/compiler/src/CFCPerlConstructor.c +++ b/compiler/src/CFCPerlConstructor.c @@ -94,8 +94,8 @@ CFCPerlConstructor_xsub_def(CFCPerlConstructor *self, CFCClass *klass) { char *name_list = CFCPerlSub_arg_name_list((CFCPerlSub*)self); CFCVariable **arg_vars = CFCParamList_get_variables(param_list); char *func_sym = CFCFunction_full_func_sym(self->init_func, klass); - char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self); - char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self); + char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 1); + char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self, 1); CFCVariable *self_var = arg_vars[0]; CFCType *self_type = CFCVariable_get_type(self_var); const char *self_type_str = CFCType_to_c(self_type); diff --git a/compiler/src/CFCPerlMethod.c b/compiler/src/CFCPerlMethod.c index 0c2861c1..c68c5cbd 100644 --- a/compiler/src/CFCPerlMethod.c +++ b/compiler/src/CFCPerlMethod.c @@ -233,10 +233,10 @@ S_xsub_def_labeled_params(CFCPerlMethod *self, CFCClass *klass) { CFCType *return_type = CFCMethod_get_return_type(method); const char *self_type_c = CFCType_to_c(self_type); const char *self_name = CFCVariable_get_name(self_var); - char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self); + char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 1); char *meth_type_c = CFCMethod_full_typedef(method, klass); char *self_assign = S_self_assign_statement(self, self_type); - char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self); + char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self, 1); char *body = S_xsub_body(self, klass); char *retval_decl; @@ -294,7 +294,7 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { const char *self_type_c = CFCType_to_c(self_type); const char **arg_inits = CFCParamList_get_initial_values(param_list); unsigned num_vars = (unsigned)CFCParamList_num_vars(param_list); - char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self); + char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 1); char *meth_type_c = CFCMethod_full_typedef(method, klass); char *self_assign = S_self_assign_statement(self, self_type); char *body = S_xsub_body(self, klass); diff --git a/compiler/src/CFCPerlSub.c b/compiler/src/CFCPerlSub.c index 588e5691..35f7939e 100644 --- a/compiler/src/CFCPerlSub.c +++ b/compiler/src/CFCPerlSub.c @@ -179,14 +179,14 @@ S_allot_params_arg(CFCType *type, const char *label, int required) { } char* -CFCPerlSub_arg_declarations(CFCPerlSub *self) { +CFCPerlSub_arg_declarations(CFCPerlSub *self, size_t first) { CFCParamList *param_list = self->param_list; CFCVariable **arg_vars = CFCParamList_get_variables(param_list); size_t num_vars = CFCParamList_num_vars(param_list); char *decls = CFCUtil_strdup(""); // Declare variables. - for (size_t i = 1; i < num_vars; i++) { + for (size_t i = first; i < num_vars; i++) { CFCVariable *arg_var = arg_vars[i]; CFCType *type = CFCVariable_get_type(arg_var); const char *type_str = CFCType_to_c(type); @@ -203,18 +203,21 @@ CFCPerlSub_arg_name_list(CFCPerlSub *self) { CFCParamList *param_list = self->param_list; CFCVariable **arg_vars = CFCParamList_get_variables(param_list); size_t num_vars = CFCParamList_num_vars(param_list); - char *name_list = CFCUtil_strdup("arg_self"); + char *name_list = CFCUtil_strdup(""); - for (size_t i = 1; i < num_vars; i++) { + for (size_t i = 0; i < num_vars; i++) { const char *var_name = CFCVariable_get_name(arg_vars[i]); - name_list = CFCUtil_cat(name_list, ", arg_", var_name, NULL); + if (i > 0) { + name_list = CFCUtil_cat(name_list, ", ", NULL); + } + name_list = CFCUtil_cat(name_list, "arg_", var_name, NULL); } return name_list; } char* -CFCPerlSub_build_allot_params(CFCPerlSub *self) { +CFCPerlSub_build_allot_params(CFCPerlSub *self, size_t first) { CFCParamList *param_list = self->param_list; CFCVariable **arg_vars = CFCParamList_get_variables(param_list); const char **arg_inits = CFCParamList_get_initial_values(param_list); @@ -222,7 +225,7 @@ CFCPerlSub_build_allot_params(CFCPerlSub *self) { char *allot_params = CFCUtil_strdup(""); // Declare variables and assign default values. - for (size_t i = 1; i < num_vars; i++) { + for (size_t i = first; i < num_vars; i++) { CFCVariable *arg_var = arg_vars[i]; const char *val = arg_inits[i]; const char *var_name = CFCVariable_get_name(arg_var); @@ -241,7 +244,7 @@ CFCPerlSub_build_allot_params(CFCPerlSub *self) { = CFCUtil_cat(allot_params, "args_ok = XSBind_allot_params(aTHX_\n" " &(ST(0)), 1, items,\n", NULL); - for (size_t i = 1; i < num_vars; i++) { + for (size_t i = first; i < num_vars; i++) { CFCVariable *var = arg_vars[i]; const char *val = arg_inits[i]; int required = val ? 0 : 1; diff --git a/compiler/src/CFCPerlSub.h b/compiler/src/CFCPerlSub.h index 945ad6df..ffb4a2fc 100644 --- a/compiler/src/CFCPerlSub.h +++ b/compiler/src/CFCPerlSub.h @@ -72,10 +72,11 @@ CFCPerlSub_destroy(CFCPerlSub *self); char* CFCPerlSub_params_hash_def(CFCPerlSub *self); -/** Generate C declarations for the variables holding the arguments. +/** Generate C declarations for the variables holding the arguments, from + * `first` onwards. */ char* -CFCPerlSub_arg_declarations(CFCPerlSub *self); +CFCPerlSub_arg_declarations(CFCPerlSub *self, size_t first); /** Create a comma-separated list of argument names prefixed by "arg_". */ @@ -83,10 +84,11 @@ char* CFCPerlSub_arg_name_list(CFCPerlSub *self); /** Generate code which will invoke XSBind_allot_params() to parse labeled - * parameters supplied to an XSUB. + * parameters supplied to an XSUB. Parameters from `first` onwards are + * included. */ char* -CFCPerlSub_build_allot_params(CFCPerlSub *self); +CFCPerlSub_build_allot_params(CFCPerlSub *self, size_t first); /** Accessor for param list. */ From 88895811c67745db71926895dfeea97931a474de Mon Sep 17 00:00:00 2001 From: Marvin Humphrey Date: Fri, 8 May 2015 19:04:07 -0700 Subject: [PATCH 2/7] Change test to subclass Obj rather than Hash. Hash is about to become final, so we need to subclass a class which will remain extensible: Obj. --- runtime/perl/t/021-class.t | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/runtime/perl/t/021-class.t b/runtime/perl/t/021-class.t index 61feec2a..2a87d5de 100644 --- a/runtime/perl/t/021-class.t +++ b/runtime/perl/t/021-class.t @@ -16,8 +16,8 @@ use strict; use warnings; -package MyHash; -use base qw( Clownfish::Hash ); +package MyObj; +use base qw( Clownfish::Obj ); sub oodle { } @@ -29,29 +29,26 @@ my $stringified; my $storage = Clownfish::Hash->new; { - my $subclassed_hash = MyHash->new; - $stringified = $subclassed_hash->to_string; + my $subclassed_obj = MyObj->new; + $stringified = $subclassed_obj->to_string; - isa_ok( $subclassed_hash, "MyHash", "Perl isa reports correct subclass" ); + isa_ok( $subclassed_obj, "MyObj", "Perl isa reports correct subclass" ); # Store the subclassed object. At the end of this block, the Perl object # will go out of scope and DESTROY will be called, but the Clownfish object # will persist. - $storage->store( "test", $subclassed_hash ); + $storage->store( "test", $subclassed_obj ); } my $resurrected = $storage->_fetch("test"); -isa_ok( $resurrected, "MyHash", "subclass name survived Perl destruction" ); +isa_ok( $resurrected, "MyObj", "subclass name survived Perl destruction" ); is( $resurrected->to_string, $stringified, "It's the same Hash from earlier (though a different Perl object)" ); -my $booga = Clownfish::String->new("booga"); -$resurrected->store( "ooga", $booga ); +is( $resurrected->get_class_name, + "MyObj", "subclassed object still performs correctly at the C level" ); -is( $resurrected->fetch("ooga"), - "booga", "subclassed object still performs correctly at the C level" ); - -my $methods = Clownfish::Class::_fresh_host_methods('MyHash'); +my $methods = Clownfish::Class::_fresh_host_methods('MyObj'); is_deeply( $methods->to_perl, ['oodle'], "fresh_host_methods" ); From 5bcadfd0094adc7521dd3ab4dcc6c69017902870 Mon Sep 17 00:00:00 2001 From: Marvin Humphrey Date: Fri, 8 May 2015 19:05:31 -0700 Subject: [PATCH 3/7] Export OFFSET vars for `final` methods. Without the export, symbol resolution fails during dynamic linking. --- compiler/src/CFCBindMethod.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/compiler/src/CFCBindMethod.c b/compiler/src/CFCBindMethod.c index cede011f..3f7bccd8 100644 --- a/compiler/src/CFCBindMethod.c +++ b/compiler/src/CFCBindMethod.c @@ -48,6 +48,7 @@ CFCBindMeth_method_def(CFCMethod *method, CFCClass *klass) { * this method may not be overridden. */ static char* S_final_method_def(CFCMethod *method, CFCClass *klass) { + const char *PREFIX = CFCClass_get_PREFIX(klass); const char *self_type = CFCType_to_c(CFCMethod_self_type(method)); const char *arg_names = CFCParamList_name_list(CFCMethod_get_param_list(method)); @@ -57,12 +58,12 @@ S_final_method_def(CFCMethod *method, CFCClass *klass) { char *full_offset_sym = CFCMethod_full_offset_sym(method, klass); const char pattern[] = - "extern size_t %s;\n" + "extern %sVISIBLE size_t %s;\n" "#define %s(%s) \\\n" " %s((%s)%s)\n"; char *method_def - = CFCUtil_sprintf(pattern, full_offset_sym, full_meth_sym, arg_names, - full_func_sym, self_type, arg_names); + = CFCUtil_sprintf(pattern, PREFIX, full_offset_sym, full_meth_sym, + arg_names, full_func_sym, self_type, arg_names); FREEMEM(full_offset_sym); FREEMEM(full_meth_sym); From cb6f14bacbbb1057ebba074b899e1d7994c28297 Mon Sep 17 00:00:00 2001 From: Marvin Humphrey Date: Fri, 8 May 2015 19:24:56 -0700 Subject: [PATCH 4/7] Export all _IMP symbols. It is not sufficient to export only _IMP symbols for final methods, because it's possible that a subclass final method be an alias for it. --- compiler/src/CFCBindClass.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/compiler/src/CFCBindClass.c b/compiler/src/CFCBindClass.c index 3aa62db9..a30ea18e 100644 --- a/compiler/src/CFCBindClass.c +++ b/compiler/src/CFCBindClass.c @@ -615,10 +615,8 @@ S_sub_declarations(CFCBindClass *self) { for (int i = 0; fresh_methods[i] != NULL; i++) { CFCMethod *method = fresh_methods[i]; char *dec = CFCBindMeth_imp_declaration(method, self->client); - if (CFCMethod_final(method)) { - declarations = CFCUtil_cat(declarations, PREFIX, "VISIBLE ", NULL); - } - declarations = CFCUtil_cat(declarations, dec, "\n\n", NULL); + declarations = CFCUtil_cat(declarations, PREFIX, "VISIBLE ", dec, + "\n\n", NULL); FREEMEM(dec); } return declarations; From 0ea34cf37ac3a536c5be75aac71f13cac8ff2a0a Mon Sep 17 00:00:00 2001 From: Marvin Humphrey Date: Mon, 11 May 2015 19:13:31 -0700 Subject: [PATCH 5/7] Temporarily disable broken final methods. Right now, final methods are broken unless they are fresh. Disable the final method optimization. --- compiler/src/CFCBindMethod.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/compiler/src/CFCBindMethod.c b/compiler/src/CFCBindMethod.c index 3f7bccd8..117c3ece 100644 --- a/compiler/src/CFCBindMethod.c +++ b/compiler/src/CFCBindMethod.c @@ -36,7 +36,9 @@ S_virtual_method_def(CFCMethod *method, CFCClass *klass); char* CFCBindMeth_method_def(CFCMethod *method, CFCClass *klass) { - if (CFCMethod_final(method)) { + // FIXME: Temporarily disable broken final method optimization. + // if (CFCMethod_final(method)) { + if (CFCMethod_final(method) && CFCMethod_is_fresh(method, klass)) { return S_final_method_def(method, klass); } else { From 308086649bc83c549e4e67dcfaf2ee1ccbba8a44 Mon Sep 17 00:00:00 2001 From: Marvin Humphrey Date: Fri, 8 May 2015 19:27:49 -0700 Subject: [PATCH 6/7] Mark many core types as `final`. Blob, ByteBuf, CharBuf, Class, Hash, HashIterator, Method, Integer32, Integer64, Float32, Float64, Vector. --- runtime/core/Clownfish/Blob.cfh | 2 +- runtime/core/Clownfish/ByteBuf.cfh | 2 +- runtime/core/Clownfish/CharBuf.cfh | 2 +- runtime/core/Clownfish/Class.cfh | 2 +- runtime/core/Clownfish/Hash.cfh | 2 +- runtime/core/Clownfish/HashIterator.cfh | 2 +- runtime/core/Clownfish/Method.cfh | 2 +- runtime/core/Clownfish/Num.cfh | 8 ++++---- runtime/core/Clownfish/Vector.cfh | 2 +- 9 files changed, 12 insertions(+), 12 deletions(-) diff --git a/runtime/core/Clownfish/Blob.cfh b/runtime/core/Clownfish/Blob.cfh index 77a31ed6..4f236e02 100644 --- a/runtime/core/Clownfish/Blob.cfh +++ b/runtime/core/Clownfish/Blob.cfh @@ -20,7 +20,7 @@ parcel Clownfish; * Immutable buffer holding arbitrary bytes. */ -class Clownfish::Blob inherits Clownfish::Obj { +final class Clownfish::Blob inherits Clownfish::Obj { const char *buf; size_t size; diff --git a/runtime/core/Clownfish/ByteBuf.cfh b/runtime/core/Clownfish/ByteBuf.cfh index b5aa406a..93e5a7c1 100644 --- a/runtime/core/Clownfish/ByteBuf.cfh +++ b/runtime/core/Clownfish/ByteBuf.cfh @@ -20,7 +20,7 @@ parcel Clownfish; * Growable buffer holding arbitrary bytes. */ -class Clownfish::ByteBuf nickname BB inherits Clownfish::Obj { +final class Clownfish::ByteBuf nickname BB inherits Clownfish::Obj { char *buf; size_t size; /* number of valid bytes */ diff --git a/runtime/core/Clownfish/CharBuf.cfh b/runtime/core/Clownfish/CharBuf.cfh index f8134e57..6e7cc563 100644 --- a/runtime/core/Clownfish/CharBuf.cfh +++ b/runtime/core/Clownfish/CharBuf.cfh @@ -20,7 +20,7 @@ parcel Clownfish; * Growable buffer holding Unicode characters. */ -class Clownfish::CharBuf nickname CB +final class Clownfish::CharBuf nickname CB inherits Clownfish::Obj { char *ptr; diff --git a/runtime/core/Clownfish/Class.cfh b/runtime/core/Clownfish/Class.cfh index e333ebe0..ff4e6233 100644 --- a/runtime/core/Clownfish/Class.cfh +++ b/runtime/core/Clownfish/Class.cfh @@ -23,7 +23,7 @@ parcel Clownfish; * behavior of Classes.) */ -class Clownfish::Class inherits Clownfish::Obj { +final class Clownfish::Class inherits Clownfish::Obj { Class *parent; String *name; diff --git a/runtime/core/Clownfish/Hash.cfh b/runtime/core/Clownfish/Hash.cfh index 8fe27e01..62174159 100644 --- a/runtime/core/Clownfish/Hash.cfh +++ b/runtime/core/Clownfish/Hash.cfh @@ -21,7 +21,7 @@ parcel Clownfish; * * Values are stored by reference and may be any kind of Obj. */ -public class Clownfish::Hash inherits Clownfish::Obj { +public final class Clownfish::Hash inherits Clownfish::Obj { void *entries; size_t capacity; diff --git a/runtime/core/Clownfish/HashIterator.cfh b/runtime/core/Clownfish/HashIterator.cfh index f4dea3ee..c346bb29 100644 --- a/runtime/core/Clownfish/HashIterator.cfh +++ b/runtime/core/Clownfish/HashIterator.cfh @@ -20,7 +20,7 @@ parcel Clownfish; * Hashtable Iterator. */ -class Clownfish::HashIterator nickname HashIter inherits Clownfish::Obj { +final class Clownfish::HashIterator nickname HashIter inherits Clownfish::Obj { Hash *hash; size_t tick; size_t capacity; diff --git a/runtime/core/Clownfish/Method.cfh b/runtime/core/Clownfish/Method.cfh index e71a549e..4fb4f28b 100644 --- a/runtime/core/Clownfish/Method.cfh +++ b/runtime/core/Clownfish/Method.cfh @@ -19,7 +19,7 @@ parcel Clownfish; /** Method metadata. */ -class Clownfish::Method inherits Clownfish::Obj { +final class Clownfish::Method inherits Clownfish::Obj { String *name; String *name_internal; diff --git a/runtime/core/Clownfish/Num.cfh b/runtime/core/Clownfish/Num.cfh index f52ed186..8cf03fcf 100644 --- a/runtime/core/Clownfish/Num.cfh +++ b/runtime/core/Clownfish/Num.cfh @@ -58,7 +58,7 @@ abstract class Clownfish::IntNum inherits Clownfish::Num { /** Single precision floating point number. */ -class Clownfish::Float32 inherits Clownfish::FloatNum { +final class Clownfish::Float32 inherits Clownfish::FloatNum { float value; @@ -92,7 +92,7 @@ class Clownfish::Float32 inherits Clownfish::FloatNum { /** Double precision floating point number. */ -class Clownfish::Float64 inherits Clownfish::FloatNum { +final class Clownfish::Float64 inherits Clownfish::FloatNum { double value; @@ -126,7 +126,7 @@ class Clownfish::Float64 inherits Clownfish::FloatNum { /** 32-bit signed integer. */ -class Clownfish::Integer32 nickname Int32 +final class Clownfish::Integer32 nickname Int32 inherits Clownfish::IntNum { int32_t value; @@ -162,7 +162,7 @@ class Clownfish::Integer32 nickname Int32 /** * 64-bit signed integer. */ -class Clownfish::Integer64 nickname Int64 +final class Clownfish::Integer64 nickname Int64 inherits Clownfish::IntNum { int64_t value; diff --git a/runtime/core/Clownfish/Vector.cfh b/runtime/core/Clownfish/Vector.cfh index be2abc6e..4034ebf9 100644 --- a/runtime/core/Clownfish/Vector.cfh +++ b/runtime/core/Clownfish/Vector.cfh @@ -18,7 +18,7 @@ parcel Clownfish; /** Variable-sized array. */ -public class Clownfish::Vector nickname Vec inherits Clownfish::Obj { +public final class Clownfish::Vector nickname Vec inherits Clownfish::Obj { Obj **elems; size_t size; From d199d868af846d53b632dbdf7390dad5029c2fb0 Mon Sep 17 00:00:00 2001 From: Marvin Humphrey Date: Sat, 9 May 2015 16:09:54 -0700 Subject: [PATCH 7/7] Eliminate `arg_self` assumptions. Always use real name of first argument rather than assuming that it is `self`. --- compiler/src/CFCPerlConstructor.c | 10 +++++----- compiler/src/CFCPerlMethod.c | 27 ++++++++++++++------------- 2 files changed, 19 insertions(+), 18 deletions(-) diff --git a/compiler/src/CFCPerlConstructor.c b/compiler/src/CFCPerlConstructor.c index 8c5e8759..c1b98393 100644 --- a/compiler/src/CFCPerlConstructor.c +++ b/compiler/src/CFCPerlConstructor.c @@ -94,11 +94,12 @@ CFCPerlConstructor_xsub_def(CFCPerlConstructor *self, CFCClass *klass) { char *name_list = CFCPerlSub_arg_name_list((CFCPerlSub*)self); CFCVariable **arg_vars = CFCParamList_get_variables(param_list); char *func_sym = CFCFunction_full_func_sym(self->init_func, klass); - char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 1); + char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 0); char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self, 1); CFCVariable *self_var = arg_vars[0]; CFCType *self_type = CFCVariable_get_type(self_var); const char *self_type_str = CFCType_to_c(self_type); + const char *self_name = CFCVariable_get_name(self_var); // Compensate for swallowed refcounts. char *refcount_mods = CFCUtil_strdup(""); @@ -117,7 +118,6 @@ CFCPerlConstructor_xsub_def(CFCPerlConstructor *self, CFCClass *klass) { "XS(%s);\n" "XS(%s) {\n" " dXSARGS;\n" - " %s arg_self;\n" "%s" " bool args_ok;\n" " %s retval;\n" @@ -129,7 +129,7 @@ CFCPerlConstructor_xsub_def(CFCPerlConstructor *self, CFCClass *klass) { " %s\n" // Create "self" last, so that earlier exceptions while fetching // params don't trigger a bad invocation of DESTROY. - " arg_self = (%s)XSBind_new_blank_obj(aTHX_ ST(0));%s\n" + " arg_%s = (%s)XSBind_new_blank_obj(aTHX_ ST(0));%s\n" "\n" " retval = %s(%s);\n" " if (retval) {\n" @@ -143,8 +143,8 @@ CFCPerlConstructor_xsub_def(CFCPerlConstructor *self, CFCClass *klass) { " XSRETURN(1);\n" "}\n\n"; char *xsub_def - = CFCUtil_sprintf(pattern, c_name, c_name, self_type_str, arg_decls, - self_type_str, allot_params, self_type_str, + = CFCUtil_sprintf(pattern, c_name, c_name, arg_decls, self_type_str, + allot_params, self_name, self_type_str, refcount_mods, func_sym, name_list); FREEMEM(refcount_mods); diff --git a/compiler/src/CFCPerlMethod.c b/compiler/src/CFCPerlMethod.c index c68c5cbd..ca5f34e1 100644 --- a/compiler/src/CFCPerlMethod.c +++ b/compiler/src/CFCPerlMethod.c @@ -43,7 +43,7 @@ S_xsub_body(CFCPerlMethod *self, CFCClass *klass); // Create an assignment statement for extracting $self from the Perl stack. static char* -S_self_assign_statement(CFCPerlMethod *self, CFCType *type); +S_self_assign_statement(CFCPerlMethod *self); // Return code for an xsub which uses labeled params. static char* @@ -208,16 +208,19 @@ S_xsub_body(CFCPerlMethod *self, CFCClass *klass) { // Create an assignment statement for extracting $self from the Perl stack. static char* -S_self_assign_statement(CFCPerlMethod *self, CFCType *type) { - (void)self; // unused +S_self_assign_statement(CFCPerlMethod *self) { + CFCParamList *param_list = CFCMethod_get_param_list(self->method); + CFCVariable **vars = CFCParamList_get_variables(param_list); + CFCType *type = CFCVariable_get_type(vars[0]); + const char *self_name = CFCVariable_get_name(vars[0]); const char *type_c = CFCType_to_c(type); if (!CFCType_is_object(type)) { CFCUtil_die("Not an object type: %s", type_c); } const char *class_var = CFCType_get_class_var(type); - char pattern[] = "arg_self = (%s)XSBind_sv_to_cfish_obj(" + char pattern[] = "arg_%s = (%s)XSBind_sv_to_cfish_obj(" "aTHX_ ST(0), %s, NULL);"; - char *statement = CFCUtil_sprintf(pattern, type_c, class_var); + char *statement = CFCUtil_sprintf(pattern, self_name, type_c, class_var); return statement; } @@ -233,9 +236,9 @@ S_xsub_def_labeled_params(CFCPerlMethod *self, CFCClass *klass) { CFCType *return_type = CFCMethod_get_return_type(method); const char *self_type_c = CFCType_to_c(self_type); const char *self_name = CFCVariable_get_name(self_var); - char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 1); + char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 0); char *meth_type_c = CFCMethod_full_typedef(method, klass); - char *self_assign = S_self_assign_statement(self, self_type); + char *self_assign = S_self_assign_statement(self); char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self, 1); char *body = S_xsub_body(self, klass); @@ -252,7 +255,6 @@ S_xsub_def_labeled_params(CFCPerlMethod *self, CFCClass *klass) { "XS(%s);\n" "XS(%s) {\n" " dXSARGS;\n" - " %s arg_self;\n" "%s" " %s method;\n" " bool args_ok;\n" @@ -270,7 +272,7 @@ S_xsub_def_labeled_params(CFCPerlMethod *self, CFCClass *klass) { " %s\n" "}\n"; char *xsub_def - = CFCUtil_sprintf(pattern, c_name, c_name, self_type_c, arg_decls, + = CFCUtil_sprintf(pattern, c_name, c_name, arg_decls, meth_type_c, retval_decl, self_name, allot_params, self_assign, body); @@ -294,9 +296,9 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { const char *self_type_c = CFCType_to_c(self_type); const char **arg_inits = CFCParamList_get_initial_values(param_list); unsigned num_vars = (unsigned)CFCParamList_num_vars(param_list); - char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 1); + char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 0); char *meth_type_c = CFCMethod_full_typedef(method, klass); - char *self_assign = S_self_assign_statement(self, self_type); + char *self_assign = S_self_assign_statement(self); char *body = S_xsub_body(self, klass); // Determine how many args are truly required and build an error check. @@ -379,7 +381,6 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { "XS(%s);\n" "XS(%s) {\n" " dXSARGS;\n" - " %s arg_self;\n" "%s" " %s method;\n" "%s" @@ -397,7 +398,7 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { "}\n"; char *xsub = CFCUtil_sprintf(pattern, self->sub.c_name, self->sub.c_name, - self_type_c, arg_decls, meth_type_c, retval_decl, + arg_decls, meth_type_c, retval_decl, num_args_check, self_assign, var_assignments, body); FREEMEM(num_args_check);