lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From nwelln...@apache.org
Subject [3/5] lucy-clownfish git commit: Rework labeled argument assignment
Date Thu, 26 Nov 2015 18:20:45 GMT
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 <wellnhofer@aevum.de>
Authored: Fri Nov 20 20:42:27 2015 +0100
Committer: Nick Wellnhofer <wellnhofer@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


Mime
View raw message