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
