Rework labeled argument assignment Change the code to assign labeled arguments from
bool args_ok = XSBind_allot_params(aTHX_ &ST(0), 1, items, ALLOT_SIZE_T(&arg_first, "first", ...), ALLOT_OBJ(&arg_second, "second", ...), NULL); if (!args_ok) { CFISH_RETHROW(...); } to static const XSBind_Param param_specs[2] = { XSBIND_PARAM("first", ...), XSBIND_PARAM("second", ...), }; int32_t locations[2]; XSBind_locate_args(aTHX_ &ST(0), 1, items, param_specs, locations, 2); arg_first = (size_t)SvIV(ST(locations[0])); arg_second = (Type*)XSBind_arg_to_cfish(..., ST(locations[1]), ...); This simplifies the code, replaces the vararg lists with static arrays and replaces the switch statement in S_extract_from_sv with direct calls to conversion functions. Accept undef for nullable parameters. Optimize constructors with no parameters. Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/ffeefa58 Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/ffeefa58 Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/ffeefa58 Branch: refs/heads/master Commit: ffeefa582cf9fb07d07edcf3f7badc4e160bc32c Parents: fab17a8 Author: Nick Wellnhofer <wellnho...@aevum.de> Authored: Fri Nov 20 20:42:27 2015 +0100 Committer: Nick Wellnhofer <wellnho...@aevum.de> Committed: Thu Nov 26 19:18:22 2015 +0100 ---------------------------------------------------------------------- compiler/perl/lib/Clownfish/CFC.xs | 11 +- compiler/src/CFCParamList.c | 6 + compiler/src/CFCPerlConstructor.c | 72 ++++-- compiler/src/CFCPerlMethod.c | 85 +++---- compiler/src/CFCPerlSub.c | 197 ++++++++-------- compiler/src/CFCPerlSub.h | 13 +- compiler/src/CFCPerlTypeMap.c | 14 +- compiler/src/CFCPerlTypeMap.h | 3 +- .../perl/buildlib/Clownfish/Build/Binding.pm | 21 +- runtime/perl/t/binding/019-obj.t | 2 +- runtime/perl/xs/XSBind.c | 226 ++++--------------- runtime/perl/xs/XSBind.h | 203 ++++------------- 12 files changed, 306 insertions(+), 547 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/compiler/perl/lib/Clownfish/CFC.xs ---------------------------------------------------------------------- diff --git a/compiler/perl/lib/Clownfish/CFC.xs b/compiler/perl/lib/Clownfish/CFC.xs index 27fa942..d7a5385 100644 --- a/compiler/perl/lib/Clownfish/CFC.xs +++ b/compiler/perl/lib/Clownfish/CFC.xs @@ -2068,11 +2068,11 @@ CODE: OUTPUT: RETVAL SV* -build_allot_params(self, first) +build_param_specs(self, first) CFCPerlSub *self; size_t first; CODE: - RETVAL = S_sv_eat_c_string(CFCPerlSub_build_allot_params(self, first)); + RETVAL = S_sv_eat_c_string(CFCPerlSub_build_param_specs(self, first)); OUTPUT: RETVAL @@ -2418,11 +2418,12 @@ OUTPUT: RETVAL MODULE = Clownfish PACKAGE = Clownfish::CFC::Binding::Perl::TypeMap SV* -from_perl(type, xs_var) - CFCType *type; +from_perl(type, xs_var, label) + CFCType *type; const char *xs_var; + const char *label; CODE: - RETVAL = S_sv_eat_c_string(CFCPerlTypeMap_from_perl(type, xs_var)); + RETVAL = S_sv_eat_c_string(CFCPerlTypeMap_from_perl(type, xs_var, label)); OUTPUT: RETVAL SV* http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/compiler/src/CFCParamList.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCParamList.c b/compiler/src/CFCParamList.c index 190dd97..6c23f7f 100644 --- a/compiler/src/CFCParamList.c +++ b/compiler/src/CFCParamList.c @@ -72,6 +72,12 @@ void CFCParamList_add_param(CFCParamList *self, CFCVariable *variable, const char *value) { CFCUTIL_NULL_CHECK(variable); + // It might be better to enforce that object parameters with a NULL + // default are also nullable. + if (value && strcmp(value, "NULL") == 0) { + CFCType *type = CFCVariable_get_type(variable); + CFCType_set_nullable(type, 1); + } self->num_vars++; size_t amount = (self->num_vars + 1) * sizeof(void*); self->variables = (CFCVariable**)REALLOCATE(self->variables, amount); http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/compiler/src/CFCPerlConstructor.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlConstructor.c b/compiler/src/CFCPerlConstructor.c index 9dfce1f..1d235ca 100644 --- a/compiler/src/CFCPerlConstructor.c +++ b/compiler/src/CFCPerlConstructor.c @@ -89,17 +89,43 @@ CFCPerlConstructor_destroy(CFCPerlConstructor *self) { char* CFCPerlConstructor_xsub_def(CFCPerlConstructor *self, CFCClass *klass) { - const char *c_name = self->sub.c_name; - CFCParamList *param_list = self->sub.param_list; - 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, 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); + const char *c_name = self->sub.c_name; + CFCParamList *param_list = self->sub.param_list; + size_t num_vars = CFCParamList_num_vars(param_list); + CFCVariable **arg_vars = CFCParamList_get_variables(param_list); + 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); + const char *items_check = NULL; + + char *param_specs = NULL; + char *arg_decls = CFCPerlSub_arg_declarations((CFCPerlSub*)self, 0); + char *locs_decl = NULL; + char *locate_args = NULL; + char *arg_assigns = CFCPerlSub_arg_assignments((CFCPerlSub*)self); + char *func_sym = CFCFunction_full_func_sym(self->init_func, klass); + char *name_list = CFCPerlSub_arg_name_list((CFCPerlSub*)self); + + if (num_vars <= 1) { + // No params. + items_check = "items != 1"; + param_specs = CFCUtil_strdup(""); + locs_decl = CFCUtil_strdup(""); + locate_args = CFCUtil_strdup(""); + } + else { + unsigned num_params = num_vars - 1; + items_check = "items < 1"; + param_specs = CFCPerlSub_build_param_specs((CFCPerlSub*)self, 1); + locs_decl = CFCUtil_sprintf(" int32_t locations[%u];\n", + num_params); + + const char *pattern = + " XSBind_locate_args(aTHX_ &ST(0), 1, items, param_specs,\n" + " locations, %u);\n"; + locate_args = CFCUtil_sprintf(pattern, num_params); + } // Compensate for swallowed refcounts. char *refcount_mods = CFCUtil_strdup(""); @@ -118,15 +144,17 @@ CFCPerlConstructor_xsub_def(CFCPerlConstructor *self, CFCClass *klass) { "XS(%s);\n" "XS(%s) {\n" " dXSARGS;\n" - "%s" - " bool args_ok;\n" + "%s" // param_specs + "%s" // locs_decl + "%s" // arg_decls " %s retval;\n" "\n" " CFISH_UNUSED_VAR(cv);\n" - " if (items < 1) { CFISH_THROW(CFISH_ERR, \"Usage: %%s(class_name, ...)\", GvNAME(CvGV(cv))); }\n" + " if (%s) { CFISH_THROW(CFISH_ERR, \"Usage: %%s(class_name, ...)\", GvNAME(CvGV(cv))); }\n" " SP -= items;\n" "\n" - " %s\n" + "%s" // locate_args + "%s" // arg_assigns // Create "self" last, so that earlier exceptions while fetching // params don't trigger a bad invocation of DESTROY. " arg_%s = (%s)XSBind_new_blank_obj(aTHX_ ST(0));%s\n" @@ -143,15 +171,19 @@ CFCPerlConstructor_xsub_def(CFCPerlConstructor *self, CFCClass *klass) { " XSRETURN(1);\n" "}\n\n"; char *xsub_def - = 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); + = CFCUtil_sprintf(pattern, c_name, c_name, param_specs, locs_decl, + arg_decls, self_type_str, items_check, locate_args, + arg_assigns, self_name, self_type_str, refcount_mods, + func_sym, name_list); FREEMEM(refcount_mods); + FREEMEM(name_list); FREEMEM(func_sym); + FREEMEM(arg_assigns); + FREEMEM(locate_args); + FREEMEM(locs_decl); FREEMEM(arg_decls); - FREEMEM(allot_params); - FREEMEM(name_list); + FREEMEM(param_specs); return xsub_def; } http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/compiler/src/CFCPerlMethod.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlMethod.c b/compiler/src/CFCPerlMethod.c index 7939748..06f92e4 100644 --- a/compiler/src/CFCPerlMethod.c +++ b/compiler/src/CFCPerlMethod.c @@ -240,12 +240,14 @@ S_xsub_def_labeled_params(CFCPerlMethod *self, CFCClass *klass) { CFCVariable **arg_vars = CFCParamList_get_variables(param_list); CFCVariable *self_var = arg_vars[0]; CFCType *return_type = CFCMethod_get_return_type(method); + size_t num_vars = CFCParamList_num_vars(param_list); const char *self_name = CFCVariable_get_name(self_var); - 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); - char *allot_params = CFCPerlSub_build_allot_params((CFCPerlSub*)self, 1); - char *body = S_xsub_body(self, klass); + char *param_specs = CFCPerlSub_build_param_specs((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); + char *arg_assigns = CFCPerlSub_arg_assignments((CFCPerlSub*)self); + char *body = S_xsub_body(self, klass); char *retval_decl; if (CFCType_is_void(return_type)) { @@ -260,31 +262,34 @@ S_xsub_def_labeled_params(CFCPerlMethod *self, CFCClass *klass) { "XS(%s);\n" "XS(%s) {\n" " dXSARGS;\n" - "%s" + "%s" // param_specs + " int32_t locations[%d];\n" + "%s" // arg_decls " %s method;\n" - " bool args_ok;\n" "%s" "\n" " CFISH_UNUSED_VAR(cv);\n" " if (items < 1) { CFISH_THROW(CFISH_ERR, \"Usage: %%s(%s, ...)\", GvNAME(CvGV(cv))); }\n" " SP -= items;\n" "\n" - " /* Extract vars from Perl stack. */\n" - " %s\n" - " %s\n" + " /* Locate args on Perl stack. */\n" + " XSBind_locate_args(aTHX_ &ST(0), 1, items, param_specs,\n" + " locations, %d);\n" + " %s\n" // self_assign + "%s" // arg_assigns "\n" " /* Execute */\n" - " %s\n" + " %s\n" // body "}\n"; char *xsub_def - = CFCUtil_sprintf(pattern, c_name, c_name, arg_decls, - meth_type_c, retval_decl, self_name, - allot_params, self_assign, body); + = CFCUtil_sprintf(pattern, c_name, c_name, param_specs, num_vars - 1, + arg_decls, meth_type_c, retval_decl, self_name, + num_vars - 1, self_assign, arg_assigns, body); + FREEMEM(param_specs); FREEMEM(arg_decls); FREEMEM(meth_type_c); FREEMEM(self_assign); - FREEMEM(allot_params); FREEMEM(body); FREEMEM(retval_decl); return xsub_def; @@ -297,15 +302,16 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { CFCVariable **arg_vars = CFCParamList_get_variables(param_list); CFCType *return_type = CFCMethod_get_return_type(method); const char **arg_inits = CFCParamList_get_initial_values(param_list); - unsigned num_vars = (unsigned)CFCParamList_num_vars(param_list); + size_t num_vars = CFCParamList_num_vars(param_list); 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); + char *arg_assigns = CFCPerlSub_arg_assignments((CFCPerlSub*)self); char *body = S_xsub_body(self, klass); // Determine how many args are truly required and build an error check. - unsigned min_required = 0; - for (unsigned i = 0; i < num_vars; i++) { + size_t min_required = 0; + for (size_t i = 0; i < num_vars; i++) { if (arg_inits[i] == NULL) { min_required = i + 1; } @@ -313,7 +319,7 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { char *xs_name_list = num_vars > 0 ? CFCUtil_strdup(CFCVariable_get_name(arg_vars[0])) : CFCUtil_strdup(""); - for (unsigned i = 1; i < num_vars; i++) { + for (size_t i = 1; i < num_vars; i++) { const char *var_name = CFCVariable_get_name(arg_vars[i]); if (i < min_required) { xs_name_list = CFCUtil_cat(xs_name_list, ", ", var_name, NULL); @@ -335,41 +341,6 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { xs_name_list); } - // Var assignments. - char *var_assignments = CFCUtil_strdup(""); - for (unsigned i = 1; i < num_vars; i++) { - CFCVariable *var = arg_vars[i]; - const char *val = arg_inits[i]; - const char *var_name = CFCVariable_get_name(var); - CFCType *var_type = CFCVariable_get_type(var); - const char *type_c = CFCType_to_c(var_type); - - char perl_stack_var[30]; - sprintf(perl_stack_var, "ST(%u)", i); - char *conversion - = CFCPerlTypeMap_from_perl(var_type, perl_stack_var); - if (!conversion) { - CFCUtil_die("Can't map type '%s'", type_c); - } - if (val) { - char pattern[] = - "\n arg_%s =" - " ( items >= %u"" && XSBind_sv_defined(aTHX_ ST(%u)) )" - " ? %s : %s;"; - char *statement = CFCUtil_sprintf(pattern, var_name, i, i, - conversion, val); - var_assignments - = CFCUtil_cat(var_assignments, statement, NULL); - FREEMEM(statement); - } - else { - var_assignments - = CFCUtil_cat(var_assignments, "\n arg_", var_name, " = ", - conversion, ";", NULL); - } - FREEMEM(conversion); - } - char *retval_decl; if (CFCType_is_void(return_type)) { retval_decl = CFCUtil_strdup(""); @@ -393,7 +364,7 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { "\n" " /* Extract vars from Perl stack. */\n" " %s\n" - " %s\n" + "%s" // arg_assigns "\n" " /* Execute */\n" " %s\n" @@ -401,10 +372,10 @@ S_xsub_def_positional_args(CFCPerlMethod *self, CFCClass *klass) { char *xsub = CFCUtil_sprintf(pattern, self->sub.c_name, self->sub.c_name, arg_decls, meth_type_c, retval_decl, - num_args_check, self_assign, var_assignments, body); + num_args_check, self_assign, arg_assigns, body); FREEMEM(num_args_check); - FREEMEM(var_assignments); + FREEMEM(arg_assigns); FREEMEM(arg_decls); FREEMEM(meth_type_c); FREEMEM(self_assign); http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/compiler/src/CFCPerlSub.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlSub.c b/compiler/src/CFCPerlSub.c index 1695b43..f1dee85 100644 --- a/compiler/src/CFCPerlSub.c +++ b/compiler/src/CFCPerlSub.c @@ -23,6 +23,7 @@ #include "CFCFunction.h" #include "CFCUtil.h" #include "CFCParamList.h" +#include "CFCPerlTypeMap.h" #include "CFCVariable.h" #include "CFCType.h" @@ -31,6 +32,10 @@ #define false 0 #endif +static char* +S_arg_assignment(CFCVariable *var, const char *val, + const char *stack_location); + CFCPerlSub* CFCPerlSub_init(CFCPerlSub *self, CFCParamList *param_list, const char *class_name, const char *alias, @@ -111,73 +116,6 @@ CFCPerlSub_params_hash_def(CFCPerlSub *self) { return def; } -struct allot_macro_map { - const char *prim_type; - const char *allot_macro; -}; - -struct allot_macro_map prim_type_to_allot_macro[] = { - { "double", "ALLOT_F64" }, - { "float", "ALLOT_F32" }, - { "int", "ALLOT_INT" }, - { "short", "ALLOT_SHORT" }, - { "long", "ALLOT_LONG" }, - { "size_t", "ALLOT_SIZE_T" }, - { "uint64_t", "ALLOT_U64" }, - { "uint32_t", "ALLOT_U32" }, - { "uint16_t", "ALLOT_U16" }, - { "uint8_t", "ALLOT_U8" }, - { "int64_t", "ALLOT_I64" }, - { "int32_t", "ALLOT_I32" }, - { "int16_t", "ALLOT_I16" }, - { "int8_t", "ALLOT_I8" }, - { "bool", "ALLOT_BOOL" }, - { NULL, NULL } -}; - -static char* -S_allot_params_arg(CFCType *type, const char *label, int required) { - const char *type_c_string = CFCType_to_c(type); - unsigned label_len = (unsigned)strlen(label); - const char *req_string = required ? "true" : "false"; - - if (CFCType_is_object(type)) { - const char *struct_sym = CFCType_get_specifier(type); - const char *class_var = CFCType_get_class_var(type); - - // Share buffers rather than copy between Perl scalars and Clownfish - // string types. - int use_sv_buffer = false; - if (strcmp(struct_sym, "cfish_String") == 0 - || strcmp(struct_sym, "cfish_Obj") == 0 - ) { - use_sv_buffer = true; - } - const char *allocation = use_sv_buffer - ? "CFISH_ALLOCA_OBJ(CFISH_STRING)" - : "NULL"; - const char pattern[] = "ALLOT_OBJ(&arg_%s, \"%s\", %u, %s, %s, %s)"; - char *arg = CFCUtil_sprintf(pattern, label, label, label_len, - req_string, class_var, allocation); - return arg; - } - else if (CFCType_is_primitive(type)) { - for (int i = 0; prim_type_to_allot_macro[i].prim_type != NULL; i++) { - const char *prim_type = prim_type_to_allot_macro[i].prim_type; - if (strcmp(prim_type, type_c_string) == 0) { - const char *allot = prim_type_to_allot_macro[i].allot_macro; - char pattern[] = "%s(&arg_%s, \"%s\", %u, %s)"; - char *arg = CFCUtil_sprintf(pattern, allot, label, label, - label_len, req_string); - return arg; - } - } - } - - CFCUtil_die("Missing typemap for %s", type_c_string); - return NULL; // unreachable -} - char* CFCPerlSub_arg_declarations(CFCPerlSub *self, size_t first) { CFCParamList *param_list = self->param_list; @@ -217,51 +155,100 @@ CFCPerlSub_arg_name_list(CFCPerlSub *self) { } char* -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); - size_t num_vars = CFCParamList_num_vars(param_list); - char *allot_params = CFCUtil_strdup(""); +CFCPerlSub_build_param_specs(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); + size_t num_vars = CFCParamList_num_vars(param_list); - // Declare variables and assign default values. - 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); - if (val == NULL) { - CFCType *arg_type = CFCVariable_get_type(arg_var); - val = CFCType_is_object(arg_type) - ? "NULL" - : "0"; - } - allot_params = CFCUtil_cat(allot_params, "arg_", var_name, " = ", val, - ";\n ", NULL); - } + const char *pattern + = " static const XSBind_ParamSpec param_specs[%d] = {"; + char *param_specs = CFCUtil_sprintf(pattern, num_vars - first); // Iterate over args in param list. - allot_params - = CFCUtil_cat(allot_params, - "args_ok = XSBind_allot_params(aTHX_\n" - " &(ST(0)), 1, items,\n", NULL); for (size_t i = first; i < num_vars; i++) { - CFCVariable *var = arg_vars[i]; - const char *val = arg_inits[i]; + if (i != first) { + param_specs = CFCUtil_cat(param_specs, ",", NULL); + } + + CFCVariable *var = arg_vars[i]; + const char *val = arg_inits[i]; + const char *name = CFCVariable_get_name(var); int required = val ? 0 : 1; - const char *name = CFCVariable_get_name(var); - CFCType *type = CFCVariable_get_type(var); - char *arg = S_allot_params_arg(type, name, required); - allot_params - = CFCUtil_cat(allot_params, " ", arg, ",\n", NULL); - FREEMEM(arg); + + char *spec = CFCUtil_sprintf("XSBIND_PARAM(\"%s\", %d)", name, + required); + param_specs = CFCUtil_cat(param_specs, "\n ", spec, NULL); + FREEMEM(spec); + } + + param_specs = CFCUtil_cat(param_specs, "\n };\n", NULL); + + return param_specs; +} + +char* +CFCPerlSub_arg_assignments(CFCPerlSub *self) { + CFCParamList *param_list = self->param_list; + CFCVariable **arg_vars = CFCParamList_get_variables(param_list); + const char **arg_inits = CFCParamList_get_initial_values(param_list); + size_t num_vars = CFCParamList_num_vars(param_list); + + char *arg_assigns = CFCUtil_strdup(""); + + for (size_t i = 1; i < num_vars; i++) { + char stack_location[30]; + if (self->use_labeled_params) { + sprintf(stack_location, "locations[%u]", (unsigned)(i - 1)); + } + else { + sprintf(stack_location, "%u", (unsigned)i); + } + char *statement = S_arg_assignment(arg_vars[i], arg_inits[i], + stack_location); + arg_assigns = CFCUtil_cat(arg_assigns, statement, NULL); + FREEMEM(statement); + } + + return arg_assigns; +} + +static char* +S_arg_assignment(CFCVariable *var, const char *val, + const char *stack_location) { + const char *var_name = CFCVariable_get_name(var); + CFCType *var_type = CFCVariable_get_type(var); + char *statement = NULL; + + char perl_stack_var[40]; + sprintf(perl_stack_var, "ST(%s)", stack_location); + char *conversion = CFCPerlTypeMap_from_perl(var_type, perl_stack_var, + var_name); + if (!conversion) { + const char *type_c = CFCType_to_c(var_type); + CFCUtil_die("Can't map type '%s'", type_c); + } + if (val) { + if (CFCType_is_object(var_type)) { + char pattern[] = " arg_%s = %s < items ? %s : %s;\n"; + statement = CFCUtil_sprintf(pattern, var_name, stack_location, + conversion, val); + } + else { + char pattern[] = + " arg_%s = %s < items && XSBind_sv_defined(aTHX_ %s)\n" + " ? %s : %s;\n"; + statement = CFCUtil_sprintf(pattern, var_name, stack_location, + perl_stack_var, conversion, val); + } + } + else { + const char pattern[] = " arg_%s = %s;\n"; + statement = CFCUtil_sprintf(pattern, var_name, conversion); } - allot_params - = CFCUtil_cat(allot_params, " NULL);\n", - " if (!args_ok) {\n" - " CFISH_RETHROW(CFISH_INCREF(cfish_Err_get_error()));\n" - " }", NULL); + FREEMEM(conversion); - return allot_params; + return statement; } CFCParamList* http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/compiler/src/CFCPerlSub.h ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlSub.h b/compiler/src/CFCPerlSub.h index ffb4a2f..d45852a 100644 --- a/compiler/src/CFCPerlSub.h +++ b/compiler/src/CFCPerlSub.h @@ -25,6 +25,7 @@ typedef struct CFCPerlSub CFCPerlSub; struct CFCFunction; struct CFCParamList; struct CFCType; +struct CFCVariable; #ifdef CFC_NEED_PERLSUB_STRUCT_DEF #define CFC_NEED_BASE_STRUCT_DEF @@ -83,12 +84,16 @@ CFCPerlSub_arg_declarations(CFCPerlSub *self, size_t first); char* CFCPerlSub_arg_name_list(CFCPerlSub *self); -/** Generate code which will invoke XSBind_allot_params() to parse labeled - * parameters supplied to an XSUB. Parameters from `first` onwards are - * included. +/** Generate code that initializes a static array of XSBind_ParamSpecs. + * Parameters from `first` onwards are included. */ char* -CFCPerlSub_build_allot_params(CFCPerlSub *self, size_t first); +CFCPerlSub_build_param_specs(CFCPerlSub *self, size_t first); + +/** Generate code that that converts and assigns the arguments. + */ +char* +CFCPerlSub_arg_assignments(CFCPerlSub *self); /** Accessor for param list. */ http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/compiler/src/CFCPerlTypeMap.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlTypeMap.c b/compiler/src/CFCPerlTypeMap.c index ef76755..f320a82 100644 --- a/compiler/src/CFCPerlTypeMap.c +++ b/compiler/src/CFCPerlTypeMap.c @@ -35,12 +35,14 @@ struct char_map { char* -CFCPerlTypeMap_from_perl(CFCType *type, const char *xs_var) { +CFCPerlTypeMap_from_perl(CFCType *type, const char *xs_var, + const char *label) { char *result = NULL; if (CFCType_is_object(type)) { - const char *struct_sym = CFCType_get_specifier(type); - const char *class_var = CFCType_get_class_var(type); + const char *struct_sym = CFCType_get_specifier(type); + const char *class_var = CFCType_get_class_var(type); + const char *nullable_str = CFCType_nullable(type) ? "true" : "false"; const char *allocation; if (strcmp(struct_sym, "cfish_String") == 0 || strcmp(struct_sym, "cfish_Obj") == 0 @@ -53,9 +55,9 @@ CFCPerlTypeMap_from_perl(CFCType *type, const char *xs_var) { allocation = "NULL"; } const char pattern[] - = "(%s*)XSBind_perl_to_cfish_noinc(aTHX_ %s, %s, %s)"; - result = CFCUtil_sprintf(pattern, struct_sym, xs_var, class_var, - allocation); + = "(%s*)XSBind_arg_to_cfish(aTHX_ %s, \"%s\", %s, %s, %s)"; + result = CFCUtil_sprintf(pattern, struct_sym, xs_var, label, + nullable_str, class_var, allocation); } else if (CFCType_is_primitive(type)) { const char *specifier = CFCType_get_specifier(type); http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/compiler/src/CFCPerlTypeMap.h ---------------------------------------------------------------------- diff --git a/compiler/src/CFCPerlTypeMap.h b/compiler/src/CFCPerlTypeMap.h index eceb86d..0f8d271 100644 --- a/compiler/src/CFCPerlTypeMap.h +++ b/compiler/src/CFCPerlTypeMap.h @@ -42,7 +42,8 @@ struct CFCType; * a value. */ char* -CFCPerlTypeMap_from_perl(struct CFCType *type, const char *xs_var); +CFCPerlTypeMap_from_perl(struct CFCType *type, const char *xs_var, + const char *label); /** Return an expression converts from a variable of type $type to a Perl * scalar. http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/runtime/perl/buildlib/Clownfish/Build/Binding.pm ---------------------------------------------------------------------- diff --git a/runtime/perl/buildlib/Clownfish/Build/Binding.pm b/runtime/perl/buildlib/Clownfish/Build/Binding.pm index 9ddc150..068a29e 100644 --- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm +++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm @@ -959,19 +959,22 @@ singleton(unused_sv, ...) SV *unused_sv; CODE: { + static const XSBind_ParamSpec param_specs[2] = { + XSBIND_PARAM("class_name", true), + XSBIND_PARAM("parent", false), + }; + int32_t locations[2]; cfish_String *class_name = NULL; cfish_Class *parent = NULL; cfish_Class *singleton = NULL; - bool args_ok - = XSBind_allot_params(aTHX_ &(ST(0)), 1, items, - ALLOT_OBJ(&class_name, "class_name", 10, true, - CFISH_STRING, CFISH_ALLOCA_OBJ(CFISH_STRING)), - ALLOT_OBJ(&parent, "parent", 6, false, - CFISH_CLASS, NULL), - NULL); CFISH_UNUSED_VAR(unused_sv); - if (!args_ok) { - CFISH_RETHROW(CFISH_INCREF(cfish_Err_get_error())); + XSBind_locate_args(aTHX_ &(ST(0)), 1, items, param_specs, locations, 2); + class_name = (cfish_String*)XSBind_arg_to_cfish( + aTHX_ ST(locations[0]), "class_name", false, CFISH_STRING, + CFISH_ALLOCA_OBJ(CFISH_STRING)); + if (locations[1] < items) { + parent = (cfish_Class*)XSBind_arg_to_cfish( + aTHX_ ST(locations[1]), "parent", true, CFISH_CLASS, NULL); } singleton = cfish_Class_singleton(class_name, parent); RETVAL = (SV*)CFISH_Class_To_Host(singleton); http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/runtime/perl/t/binding/019-obj.t ---------------------------------------------------------------------- diff --git a/runtime/perl/t/binding/019-obj.t b/runtime/perl/t/binding/019-obj.t index 545b235..7d71149 100644 --- a/runtime/perl/t/binding/019-obj.t +++ b/runtime/perl/t/binding/019-obj.t @@ -103,7 +103,7 @@ ok( !$object->is_a(""), "custom is_a blank" ); ok( !$object->is_a("thing"), "custom is_a wrong" ); eval { my $another_obj = TestObj->new( kill_me_now => 1 ) }; -like( $@, qr/kill_me_now/, "reject bad param" ); +like( $@, qr/Usage: new/, "reject bad param" ); eval { $object->clone }; like( $@, qr/Abstract method 'Clone' not defined by TestObj/, http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/runtime/perl/xs/XSBind.c ---------------------------------------------------------------------- diff --git a/runtime/perl/xs/XSBind.c b/runtime/perl/xs/XSBind.c index e72d1e0..7b9e1e5 100644 --- a/runtime/perl/xs/XSBind.c +++ b/runtime/perl/xs/XSBind.c @@ -307,218 +307,92 @@ XSBind_trap(SV *routine, SV *context) { return cfish_Err_trap(S_attempt_perl_call, &args); } -static bool -S_extract_from_sv(pTHX_ SV *value, void *target, const char *label, - bool required, int type, cfish_Class *klass, - void *allocation) { - bool valid_assignment = false; - - if (XSBind_sv_defined(aTHX_ value)) { - switch (type) { - case XSBIND_WANT_I8: - *((int8_t*)target) = (int8_t)SvIV(value); - valid_assignment = true; - break; - case XSBIND_WANT_I16: - *((int16_t*)target) = (int16_t)SvIV(value); - valid_assignment = true; - break; - case XSBIND_WANT_I32: - *((int32_t*)target) = (int32_t)SvIV(value); - valid_assignment = true; - break; - case XSBIND_WANT_I64: - if (sizeof(IV) == 8) { - *((int64_t*)target) = (int64_t)SvIV(value); - } - else { // sizeof(IV) == 4 - // lossy. - *((int64_t*)target) = (int64_t)SvNV(value); - } - valid_assignment = true; - break; - case XSBIND_WANT_U8: - *((uint8_t*)target) = (uint8_t)SvUV(value); - valid_assignment = true; - break; - case XSBIND_WANT_U16: - *((uint16_t*)target) = (uint16_t)SvUV(value); - valid_assignment = true; - break; - case XSBIND_WANT_U32: - *((uint32_t*)target) = (uint32_t)SvUV(value); - valid_assignment = true; - break; - case XSBIND_WANT_U64: - if (sizeof(UV) == 8) { - *((uint64_t*)target) = (uint64_t)SvUV(value); - } - else { // sizeof(UV) == 4 - // lossy. - *((uint64_t*)target) = (uint64_t)SvNV(value); - } - valid_assignment = true; - break; - case XSBIND_WANT_BOOL: - *((bool*)target) = !!SvTRUE(value); - valid_assignment = true; - break; - case XSBIND_WANT_F32: - *((float*)target) = (float)SvNV(value); - valid_assignment = true; - break; - case XSBIND_WANT_F64: - *((double*)target) = SvNV(value); - valid_assignment = true; - break; - case XSBIND_WANT_OBJ: { - cfish_Obj *object = NULL; - bool success - = S_maybe_perl_to_cfish(aTHX_ value, klass, false, - allocation, &object); - if (success && object) { - *((cfish_Obj**)target) = object; - valid_assignment = true; - } - else { - cfish_String *mess - = CFISH_MAKE_MESS( - "Invalid value for '%s' - not a %o", - label, CFISH_Class_Get_Name(klass)); - cfish_Err_set_error(cfish_Err_new(mess)); - return false; - } - } - break; - case XSBIND_WANT_SV: - *((SV**)target) = value; - valid_assignment = true; - break; - default: { - cfish_String *mess - = CFISH_MAKE_MESS("Unrecognized type: %i32 for param '%s'", - (int32_t)type, label); - cfish_Err_set_error(cfish_Err_new(mess)); - return false; - } - } - } - - // Enforce that required params cannot be undef and must present valid - // values. - if (required && !valid_assignment) { - cfish_String *mess = CFISH_MAKE_MESS("Missing required param %s", - label); - cfish_Err_set_error(cfish_Err_new(mess)); - return false; - } - - return true; -} - -bool -XSBind_allot_params(pTHX_ SV** stack, int32_t start, int32_t num_stack_elems, - ...) { - va_list args; - - // Verify that our args come in pairs. Return success if there are no - // args. - if ((num_stack_elems - start) % 2 != 0) { - cfish_String *mess - = CFISH_MAKE_MESS( - "Expecting hash-style params, got odd number of args"); - cfish_Err_set_error(cfish_Err_new(mess)); - return false; +void +cfish_XSBind_locate_args(pTHX_ SV** stack, int32_t start, int32_t items, + const XSBind_ParamSpec *specs, int32_t *locations, + int32_t num_params) { + // Verify that our args come in pairs. + if ((items - start) % 2 != 0) { + THROW(CFISH_ERR, + "Expecting hash-style params, got odd number of args"); + return; } int32_t num_consumed = 0; - void *target; - va_start(args, num_stack_elems); - while (NULL != (target = va_arg(args, void*))) { - char *label = va_arg(args, char*); - int label_len = va_arg(args, int); - int required = va_arg(args, int); - int type = va_arg(args, int); - cfish_Class *klass = va_arg(args, cfish_Class*); - void *allocation = va_arg(args, void*); + for (int32_t i = 0; i < num_params; i++) { + const XSBind_ParamSpec *spec = &specs[i]; // Iterate through the stack looking for labels which match this param // name. If the label appears more than once, keep track of where it // appears *last*, as the last time a param appears overrides all // previous appearances. - int32_t found_arg = -1; - for (int32_t tick = start; tick < num_stack_elems; tick += 2) { + int32_t location = items; + for (int32_t tick = start; tick < items; tick += 2) { SV *const key_sv = stack[tick]; - if (SvCUR(key_sv) == (STRLEN)label_len) { - if (memcmp(SvPVX(key_sv), label, label_len) == 0) { - found_arg = tick; + if (SvCUR(key_sv) == (STRLEN)spec->label_len) { + if (memcmp(SvPVX(key_sv), spec->label, spec->label_len) == 0) { + location = tick + 1; ++num_consumed; } } } - if (found_arg == -1) { - // Didn't find this parameter. Throw an error if it was required. - if (required) { - cfish_String *mess - = CFISH_MAKE_MESS("Missing required parameter: '%s'", - label); - cfish_Err_set_error(cfish_Err_new(mess)); - return false; - } - } - else { - // Found the arg. Extract the value. - SV *value = stack[found_arg + 1]; - bool got_arg = S_extract_from_sv(aTHX_ value, target, label, - required, type, klass, - allocation); - if (!got_arg) { - CFISH_ERR_ADD_FRAME(cfish_Err_get_error()); - return false; - } + // Didn't find this parameter. Throw an error if it was required. + if (location == items && spec->required) { + THROW(CFISH_ERR, "Missing required parameter: '%s'", spec->label); + return; } + + // Store the location. + locations[i] = location; } - va_end(args); // Ensure that all parameter labels were valid. - if (num_consumed != (num_stack_elems - start) / 2) { + if (num_consumed != (items - start) / 2) { // Find invalid parameter. - for (int32_t tick = start; tick < num_stack_elems; tick += 2) { + for (int32_t tick = start; tick < items; tick += 2) { SV *const key_sv = stack[tick]; const char *key = SvPVX(key_sv); STRLEN key_len = SvCUR(key_sv); bool found = false; - va_start(args, num_stack_elems); - while (NULL != (target = va_arg(args, void*))) { - char *label = va_arg(args, char*); - int label_len = va_arg(args, int); - va_arg(args, int); - va_arg(args, int); - va_arg(args, cfish_Class*); - va_arg(args, void*); - - if (key_len == (STRLEN)label_len - && memcmp(key, label, label_len) == 0 + for (int32_t i = 0; i < num_params; ++i) { + const XSBind_ParamSpec *spec = &specs[i]; + + if (key_len == (STRLEN)spec->label_len + && memcmp(key, spec->label, key_len) == 0 ) { found = true; break; } } - va_end(args); if (!found) { const char *key_c = SvPV_nolen(key_sv); - cfish_String *mess - = CFISH_MAKE_MESS("Invalid parameter: '%s'", key_c); - cfish_Err_set_error(cfish_Err_new(mess)); - return false; + THROW(CFISH_ERR, "Invalid parameter: '%s'", key_c); + return; } } } +} - return true; +cfish_Obj* +XSBind_arg_to_cfish(pTHX_ SV *value, const char *label, bool nullable, + cfish_Class *klass, void *allocation) { + cfish_Obj *obj = NULL; + + if (!S_maybe_perl_to_cfish(aTHX_ value, klass, false, allocation, &obj)) { + THROW(CFISH_ERR, "Invalid value for '%s' - not a %o", label, + CFISH_Class_Get_Name(klass)); + CFISH_UNREACHABLE_RETURN(cfish_Obj*); + } + + if (!obj && !nullable) { + THROW(CFISH_ERR, "'%s' must not be undef", label); + CFISH_UNREACHABLE_RETURN(cfish_Obj*); + } + + return obj; } /*************************************************************************** http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ffeefa58/runtime/perl/xs/XSBind.h ---------------------------------------------------------------------- diff --git a/runtime/perl/xs/XSBind.h b/runtime/perl/xs/XSBind.h index 096fbc0..a104797 100644 --- a/runtime/perl/xs/XSBind.h +++ b/runtime/perl/xs/XSBind.h @@ -44,6 +44,12 @@ extern "C" { #endif +typedef struct cfish_XSBind_ParamSpec { + const char *label; + uint16_t label_len; + char required; +} cfish_XSBind_ParamSpec; + /** Given either a class name or a perl object, manufacture a new Clownfish * object suitable for supplying to a cfish_Foo_init() function. */ @@ -153,157 +159,44 @@ cfish_XSBind_hash_key_to_utf8(pTHX_ HE *entry, STRLEN *size_ptr); cfish_Err* cfish_XSBind_trap(SV *routine, SV *context); -/** Process hash-style params passed to an XS subroutine. The varargs must be - * a NULL-terminated series of ALLOT_ macros. - * - * cfish_XSBind_allot_params(stack, start, num_stack_elems, - * ALLOT_OBJ(&field, "field", 5, CFISH_STRING, true, CFISH_ALLOCA_OBJ(CFISH_STRING), - * ALLOT_OBJ(&term, "term", 4, CFISH_STRING, true, CFISH_ALLOCA_OBJ(CFISH_STRING), - * NULL); - * - * The following ALLOT_ macros are available for primitive types: - * - * ALLOT_I8(ptr, key, keylen, required) - * ALLOT_I16(ptr, key, keylen, required) - * ALLOT_I32(ptr, key, keylen, required) - * ALLOT_I64(ptr, key, keylen, required) - * ALLOT_U8(ptr, key, keylen, required) - * ALLOT_U16(ptr, key, keylen, required) - * ALLOT_U32(ptr, key, keylen, required) - * ALLOT_U64(ptr, key, keylen, required) - * ALLOT_BOOL(ptr, key, keylen, required) - * ALLOT_CHAR(ptr, key, keylen, required) - * ALLOT_SHORT(ptr, key, keylen, required) - * ALLOT_INT(ptr, key, keylen, required) - * ALLOT_LONG(ptr, key, keylen, required) - * ALLOT_SIZE_T(ptr, key, keylen, required) - * ALLOT_F32(ptr, key, keylen, required) - * ALLOT_F64(ptr, key, keylen, required) - * - * The four arguments to these ALLOT_ macros have the following meanings: - * - * ptr -- A pointer to the variable to be extracted. - * key -- The name of the parameter as a C string. - * keylen -- The length of the parameter name in bytes. - * required -- A boolean indicating whether the parameter is required. - * - * If a required parameter is not present, allot_params() will set the global - * error object and return false. - * - * Use the following macro if a Clownfish object is desired: - * - * ALLOT_OBJ(ptr, key, keylen, required, klass, allocation) - * - * The "klass" argument must be the Class corresponding to the class of the - * desired object. The "allocation" argument must be a blob of memory - * allocated on the stack sufficient to hold a String. (Use - * CFISH_ALLOCA_OBJ to allocate the object.) - * - * To extract a Perl scalar, use the following ALLOT_ macro: - * - * ALLOT_SV(ptr, key, keylen, required) +/** Locate hash-style params passed to an XS subroutine. If a required + * parameter is not present, locate_args() will throw an error. * - * All possible valid param names must be passed via the ALLOT_ macros; if a - * user-supplied param cannot be matched up with an ALLOT_ macro, - * allot_params() will set the global error object and return false. + * All possible valid param names must be passed in `specs`; if a + * user-supplied param cannot be matched up, locate_args() will throw an + * error. * * @param stack The Perl stack. * @param start Where on the Perl stack to start looking for params. For * methods, this would typically be 1; for functions, most likely 0. - * @param num_stack_elems The number of arguments passed to the Perl function - * (generally, the XS variable "items"). - * @return true on success, false on failure (sets the global error object). + * @param items The number of arguments passed to the Perl function + * (generally, the XS variable `items`). + * @params specs An array of XSBind_ParamSpec structs describing the + * parameters. + * @param locations On success, this output argument will be set to the + * location on the stack of each param. Optional arguments that could not + * be found have their location set to `items`. + * @param The number of parameters in `specs` and elements in `locations`. + */ +CFISH_VISIBLE void +cfish_XSBind_locate_args(pTHX_ SV** stack, int32_t start, int32_t items, + const cfish_XSBind_ParamSpec *specs, + int32_t *locations, int32_t num_params); + +/** Convert an argument from the Perl stack to a Clownfish object. + * + * @param value The SV from the Perl stack. + * @param label The name of the param. + * @param nullable Whether undef is allowed for objects. + * @param klass The class to convert to. + * @param allocation Stack allocation for Obj and String. */ -CFISH_VISIBLE bool -cfish_XSBind_allot_params(pTHX_ SV** stack, int32_t start, - int32_t num_stack_elems, ...); - -#define XSBIND_WANT_I8 0x1 -#define XSBIND_WANT_I16 0x2 -#define XSBIND_WANT_I32 0x3 -#define XSBIND_WANT_I64 0x4 -#define XSBIND_WANT_U8 0x5 -#define XSBIND_WANT_U16 0x6 -#define XSBIND_WANT_U32 0x7 -#define XSBIND_WANT_U64 0x8 -#define XSBIND_WANT_BOOL 0x9 -#define XSBIND_WANT_F32 0xA -#define XSBIND_WANT_F64 0xB -#define XSBIND_WANT_OBJ 0xC -#define XSBIND_WANT_SV 0xD - -#if (CFISH_SIZEOF_CHAR == 1) - #define XSBIND_WANT_CHAR XSBIND_WANT_I8 -#else - #error "Can't build unless sizeof(char) == 1" -#endif - -#if (CFISH_SIZEOF_SHORT == 2) - #define XSBIND_WANT_SHORT XSBIND_WANT_I16 -#else - #error "Can't build unless sizeof(short) == 2" -#endif - -#if (CFISH_SIZEOF_INT == 4) - #define XSBIND_WANT_INT XSBIND_WANT_I32 -#elif (CFISH_SIZEOF_INT == 8) - #define XSBIND_WANT_INT XSBIND_WANT_I64 -#else - #error "Can't build unless sizeof(int) == 4 or sizeof(int) == 8" -#endif - -#if (CFISH_SIZEOF_LONG == 4) - #define XSBIND_WANT_LONG XSBIND_WANT_I32 -#elif (CFISH_SIZEOF_LONG == 8) - #define XSBIND_WANT_LONG XSBIND_WANT_I64 -#else - #error "Can't build unless sizeof(long) == 4 or sizeof(long) == 8" -#endif - -#if (CFISH_SIZEOF_SIZE_T == 4) - #define XSBIND_WANT_SIZE_T XSBIND_WANT_U32 -#elif (CFISH_SIZEOF_SIZE_T == 8) - #define XSBIND_WANT_SIZE_T XSBIND_WANT_U64 -#else - #error "Can't build unless sizeof(size_t) == 4 or sizeof(size_t) == 8" -#endif +CFISH_VISIBLE cfish_Obj* +cfish_XSBind_arg_to_cfish(pTHX_ SV *value, const char *label, bool nullable, + cfish_Class *klass, void *allocation); -#define XSBIND_ALLOT_I8(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_I8, NULL, NULL -#define XSBIND_ALLOT_I16(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_I16, NULL, NULL -#define XSBIND_ALLOT_I32(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_I32, NULL, NULL -#define XSBIND_ALLOT_I64(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_I64, NULL, NULL -#define XSBIND_ALLOT_U8(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_U8, NULL, NULL -#define XSBIND_ALLOT_U16(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_U16, NULL, NULL -#define XSBIND_ALLOT_U32(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_U32, NULL, NULL -#define XSBIND_ALLOT_U64(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_U64, NULL, NULL -#define XSBIND_ALLOT_BOOL(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_BOOL, NULL, NULL -#define XSBIND_ALLOT_CHAR(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_CHAR, NULL, NULL -#define XSBIND_ALLOT_SHORT(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_SHORT, NULL, NULL -#define XSBIND_ALLOT_INT(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_INT, NULL, NULL -#define XSBIND_ALLOT_LONG(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_LONG, NULL, NULL -#define XSBIND_ALLOT_SIZE_T(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_SIZE_T, NULL, NULL -#define XSBIND_ALLOT_F32(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_F32, NULL, NULL -#define XSBIND_ALLOT_F64(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_F64, NULL, NULL -#define XSBIND_ALLOT_OBJ(ptr, key, keylen, required, klass, allocation) \ - ptr, key, keylen, required, XSBIND_WANT_OBJ, klass, allocation -#define XSBIND_ALLOT_SV(ptr, key, keylen, required) \ - ptr, key, keylen, required, XSBIND_WANT_SV, NULL, NULL +#define XSBIND_PARAM(key, required) \ + { key, (int16_t)sizeof("" key) - 1, (char)required } /* Define short names for most of the symbols in this file. Note that these * short names are ALWAYS in effect, since they are only used for Perl and we @@ -311,6 +204,7 @@ cfish_XSBind_allot_params(pTHX_ SV** stack, int32_t start, * full symbols nevertheless in case someone else defines e.g. a function * named "XSBind_sv_defined".) */ +#define XSBind_ParamSpec cfish_XSBind_ParamSpec #define XSBind_new_blank_obj cfish_XSBind_new_blank_obj #define XSBind_foster_obj cfish_XSBind_foster_obj #define XSBind_sv_defined cfish_XSBind_sv_defined @@ -322,25 +216,8 @@ cfish_XSBind_allot_params(pTHX_ SV** stack, int32_t start, #define XSBind_perl_to_cfish_noinc cfish_XSBind_perl_to_cfish_noinc #define XSBind_hash_key_to_utf8 cfish_XSBind_hash_key_to_utf8 #define XSBind_trap cfish_XSBind_trap -#define XSBind_allot_params cfish_XSBind_allot_params -#define ALLOT_I8 XSBIND_ALLOT_I8 -#define ALLOT_I16 XSBIND_ALLOT_I16 -#define ALLOT_I32 XSBIND_ALLOT_I32 -#define ALLOT_I64 XSBIND_ALLOT_I64 -#define ALLOT_U8 XSBIND_ALLOT_U8 -#define ALLOT_U16 XSBIND_ALLOT_U16 -#define ALLOT_U32 XSBIND_ALLOT_U32 -#define ALLOT_U64 XSBIND_ALLOT_U64 -#define ALLOT_BOOL XSBIND_ALLOT_BOOL -#define ALLOT_CHAR XSBIND_ALLOT_CHAR -#define ALLOT_SHORT XSBIND_ALLOT_SHORT -#define ALLOT_INT XSBIND_ALLOT_INT -#define ALLOT_LONG XSBIND_ALLOT_LONG -#define ALLOT_SIZE_T XSBIND_ALLOT_SIZE_T -#define ALLOT_F32 XSBIND_ALLOT_F32 -#define ALLOT_F64 XSBIND_ALLOT_F64 -#define ALLOT_OBJ XSBIND_ALLOT_OBJ -#define ALLOT_SV XSBIND_ALLOT_SV +#define XSBind_locate_args cfish_XSBind_locate_args +#define XSBind_arg_to_cfish cfish_XSBind_arg_to_cfish /* Strip the prefix from some common ClownFish symbols where we know there's * no conflict with Perl. It's a little inconsistent to do this rather than