lucy-commits mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From nwelln...@apache.org
Subject lucy-clownfish git commit: Use PERL_NO_GET_CONTEXT
Date Wed, 08 Apr 2015 21:23:57 GMT
Repository: lucy-clownfish
Updated Branches:
  refs/heads/CLOWNFISH-29-perl-no-get-context [created] c5889df2e


Use PERL_NO_GET_CONTEXT

Pass the Perl interpreter context explicitly. This avoids many unneeded
calls to Perl_get_context for threaded Perls. See section "How multiple
interpreters and concurrency are supported" in the perlguts man page.

Decreases the size of the i386 binary by 15 KB which illustrates the
extent of this optimization.

Fixes CLOWNFISH-29.


Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/c5889df2
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/c5889df2
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/c5889df2

Branch: refs/heads/CLOWNFISH-29-perl-no-get-context
Commit: c5889df2ea0a1f91ad49d15fc9113774241aee28
Parents: bad0e07
Author: Nick Wellnhofer <wellnhofer@aevum.de>
Authored: Wed Apr 8 23:08:12 2015 +0200
Committer: Nick Wellnhofer <wellnhofer@aevum.de>
Committed: Wed Apr 8 23:18:42 2015 +0200

----------------------------------------------------------------------
 compiler/src/CFCPerl.c                          |  21 ++--
 compiler/src/CFCPerlConstructor.c               |   2 +-
 compiler/src/CFCPerlMethod.c                    |  17 +--
 compiler/src/CFCPerlSub.c                       |   2 +-
 compiler/src/CFCPerlTypeMap.c                   |   7 +-
 .../perl/buildlib/Clownfish/Build/Binding.pm    |  21 ++--
 runtime/perl/xs/XSBind.c                        | 121 +++++++++++--------
 runtime/perl/xs/XSBind.h                        |  31 ++---
 8 files changed, 129 insertions(+), 93 deletions(-)
----------------------------------------------------------------------


http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/c5889df2/compiler/src/CFCPerl.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerl.c b/compiler/src/CFCPerl.c
index a5921d9..68261d7 100644
--- a/compiler/src/CFCPerl.c
+++ b/compiler/src/CFCPerl.c
@@ -299,12 +299,15 @@ S_write_boot_c(CFCPerl *self) {
         "\n"
         "/* Avoid conflicts with Clownfish bool type. */\n"
         "#define HAS_BOOL\n"
+        "#define PERL_NO_GET_CONTEXT\n"
         "#include \"EXTERN.h\"\n"
         "#include \"perl.h\"\n"
         "#include \"XSUB.h\"\n"
         "\n"
         "void\n"
         "%s() {\n"
+        "    dTHX;\n"
+        "\n"
         "%s"
         "\n"
         "%s"
@@ -530,7 +533,7 @@ S_write_callbacks_c(CFCPerl *self) {
         "%s"
         "\n"
         "static void\n"
-        "S_finish_callback_void(const char *meth_name) {\n"
+        "S_finish_callback_void(pTHX_ const char *meth_name) {\n"
         "    int count = call_method(meth_name, G_VOID | G_DISCARD);\n"
         "    if (count != 0) {\n"
         "        CFISH_THROW(CFISH_ERR, \"Bad callback to '%%s': %%i32\",\n"
@@ -541,7 +544,7 @@ S_write_callbacks_c(CFCPerl *self) {
         "}\n"
         "\n"
         "static CFISH_INLINE SV*\n"
-        "SI_do_callback_sv(const char *meth_name) {\n"
+        "SI_do_callback_sv(pTHX_ const char *meth_name) {\n"
         "    int count = call_method(meth_name, G_SCALAR);\n"
         "    if (count != 1) {\n"
         "        CFISH_THROW(CFISH_ERR, \"Bad callback to '%%s': %%i32\",\n"
@@ -554,8 +557,8 @@ S_write_callbacks_c(CFCPerl *self) {
         "}\n"
         "\n"
         "static int64_t\n"
-        "S_finish_callback_i64(const char *meth_name) {\n"
-        "    SV *return_sv = SI_do_callback_sv(meth_name);\n"
+        "S_finish_callback_i64(pTHX_ const char *meth_name) {\n"
+        "    SV *return_sv = SI_do_callback_sv(aTHX_ meth_name);\n"
         "    int64_t retval;\n"
         "    if (sizeof(IV) == 8) {\n"
         "        retval = (int64_t)SvIV(return_sv);\n"
@@ -577,8 +580,8 @@ S_write_callbacks_c(CFCPerl *self) {
         "}\n"
         "\n"
         "static double\n"
-        "S_finish_callback_f64(const char *meth_name) {\n"
-        "    SV *return_sv = SI_do_callback_sv(meth_name);\n"
+        "S_finish_callback_f64(pTHX_ const char *meth_name) {\n"
+        "    SV *return_sv = SI_do_callback_sv(aTHX_ meth_name);\n"
         "    double retval = SvNV(return_sv);\n"
         "    FREETMPS;\n"
         "    LEAVE;\n"
@@ -586,10 +589,10 @@ S_write_callbacks_c(CFCPerl *self) {
         "}\n"
         "\n"
         "static cfish_Obj*\n"
-        "S_finish_callback_obj(void *vself, const char *meth_name,\n"
+        "S_finish_callback_obj(pTHX_ void *vself, const char *meth_name,\n"
         "                      int nullable) {\n"
-        "    SV *return_sv = SI_do_callback_sv(meth_name);\n"
-        "    cfish_Obj *retval = XSBind_perl_to_cfish(return_sv);\n"
+        "    SV *return_sv = SI_do_callback_sv(aTHX_ meth_name);\n"
+        "    cfish_Obj *retval = XSBind_perl_to_cfish(aTHX_ return_sv);\n"
         "    FREETMPS;\n"
         "    LEAVE;\n"
         "    if (!nullable && !retval) {\n"

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/c5889df2/compiler/src/CFCPerlConstructor.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerlConstructor.c b/compiler/src/CFCPerlConstructor.c
index 5752e43..9f82ab7 100644
--- a/compiler/src/CFCPerlConstructor.c
+++ b/compiler/src/CFCPerlConstructor.c
@@ -129,7 +129,7 @@ CFCPerlConstructor_xsub_def(CFCPerlConstructor *self) {
         "    %s\n"
         // Create "self" last, so that earlier exceptions while fetching
         // params don't trigger a bad invocation of DESTROY.
-        "    arg_self = (%s)XSBind_new_blank_obj(ST(0));%s\n"
+        "    arg_self = (%s)XSBind_new_blank_obj(aTHX_ ST(0));%s\n"
         "\n"
         "    retval = %s(%s);\n"
         "    if (retval) {\n"

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/c5889df2/compiler/src/CFCPerlMethod.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerlMethod.c b/compiler/src/CFCPerlMethod.c
index 0f6f5ec..547f948 100644
--- a/compiler/src/CFCPerlMethod.c
+++ b/compiler/src/CFCPerlMethod.c
@@ -222,7 +222,8 @@ S_self_assign_statement(CFCPerlMethod *self, CFCType *type) {
         CFCUtil_die("Not an object type: %s", type_c);
     }
     const char *class_var = CFCType_get_class_var(type);
-    char pattern[] = "arg_self = (%s)XSBind_sv_to_cfish_obj(ST(0), %s, NULL);";
+    char pattern[] = "arg_self = (%s)XSBind_sv_to_cfish_obj("
+                     "aTHX_ ST(0), %s, NULL);";
     char *statement = CFCUtil_sprintf(pattern, type_c, class_var);
 
     return statement;
@@ -355,7 +356,8 @@ S_xsub_def_positional_args(CFCPerlMethod *self) {
         }
         if (val) {
             char pattern[] =
-                "\n    arg_%s = ( items >= %u && XSBind_sv_defined(ST(%u)) )"
+                "\n    arg_%s ="
+                " ( items >= %u"" && XSBind_sv_defined(aTHX_ ST(%u)) )"
                 " ? %s : %s;";
             char *statement = CFCUtil_sprintf(pattern, var_name, i, i,
                                               conversion, val);
@@ -468,6 +470,7 @@ static char*
 S_callback_start(CFCMethod *method) {
     CFCParamList *param_list = CFCMethod_get_param_list(method);
     static const char pattern[] =
+        "    dTHX;\n"
         "    dSP;\n"
         "    EXTEND(SP, %d);\n"
         "    ENTER;\n"
@@ -499,12 +502,12 @@ S_callback_start(CFCMethod *method) {
         if (CFCType_is_string_type(type)) {
             // Convert Clownfish string type to UTF-8 Perl string scalars.
             params = CFCUtil_cat(params, "    mPUSHs(XSBind_str_to_sv(",
-                                 "(cfish_String*)", name, "));\n", NULL);
+                                 "aTHX_ (cfish_String*)", name, "));\n", NULL);
         }
         else if (CFCType_is_object(type)) {
             // Wrap other Clownfish object types in Perl objects.
             params = CFCUtil_cat(params, "    mPUSHs(XSBind_cfish_to_perl(",
-                                 "(cfish_Obj*)", name, "));\n", NULL);
+                                 "aTHX_ (cfish_Obj*)", name, "));\n", NULL);
         }
         else if (CFCType_is_integer(type)) {
             // Convert primitive integer types to IV Perl scalars.
@@ -617,7 +620,7 @@ S_void_callback_def(CFCMethod *method, const char *callback_start,
         "void\n"
         "%s(%s) {\n"
         "%s"
-        "    S_finish_callback_void(\"%s\");%s\n"
+        "    S_finish_callback_void(aTHX_ \"%s\");%s\n"
         "}\n";
     char *callback_def
         = CFCUtil_sprintf(pattern, override_sym, params, callback_start,
@@ -657,7 +660,7 @@ S_primitive_callback_def(CFCMethod *method, const char *callback_start,
         "%s\n"
         "%s(%s) {\n"
         "%s"
-        "    %s retval = (%s)%s(\"%s\");%s\n"
+        "    %s retval = (%s)%s(aTHX_ \"%s\");%s\n"
         "    return retval;\n"
         "}\n";
     char *callback_def
@@ -684,7 +687,7 @@ S_obj_callback_def(CFCMethod *method, const char *callback_start,
         "%s\n"
         "%s(%s) {\n"
         "%s"
-        "    %s retval = (%s)S_finish_callback_obj(self, \"%s\", %s);%s\n"
+        "    %s retval = (%s)S_finish_callback_obj(aTHX_ self, \"%s\", %s);%s\n"
         "    return retval;\n"
         "}\n";
     char *callback_def

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/c5889df2/compiler/src/CFCPerlSub.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerlSub.c b/compiler/src/CFCPerlSub.c
index 0051258..32e4720 100644
--- a/compiler/src/CFCPerlSub.c
+++ b/compiler/src/CFCPerlSub.c
@@ -239,7 +239,7 @@ CFCPerlSub_build_allot_params(CFCPerlSub *self) {
     // Iterate over args in param list.
     allot_params
         = CFCUtil_cat(allot_params,
-                      "args_ok = XSBind_allot_params(\n"
+                      "args_ok = XSBind_allot_params(aTHX_\n"
                       "        &(ST(0)), 1, items,\n", NULL);
     for (size_t i = 1; i < num_vars; i++) {
         CFCVariable *var = arg_vars[i];

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/c5889df2/compiler/src/CFCPerlTypeMap.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerlTypeMap.c b/compiler/src/CFCPerlTypeMap.c
index 4189213..a2b682e 100644
--- a/compiler/src/CFCPerlTypeMap.c
+++ b/compiler/src/CFCPerlTypeMap.c
@@ -52,7 +52,7 @@ CFCPerlTypeMap_from_perl(CFCType *type, const char *xs_var) {
         else {
             allocation = "NULL";
         }
-        const char pattern[] = "(%s*)XSBind_sv_to_cfish_obj(%s, %s, %s)";
+        const char pattern[] = "(%s*)XSBind_sv_to_cfish_obj(aTHX_ %s, %s, %s)";
         result = CFCUtil_sprintf(pattern, struct_sym, xs_var, class_var,
                                  allocation);
     }
@@ -122,7 +122,8 @@ CFCPerlTypeMap_to_perl(CFCType *type, const char *cf_var) {
 
     if (CFCType_is_object(type)) {
         const char pattern[] =
-            "(%s == NULL ? newSV(0) : XSBind_cfish_to_perl((cfish_Obj*)%s))";
+            "(%s == NULL ?"
+            " newSV(0) : XSBind_cfish_to_perl(aTHX_ (cfish_Obj*)%s))";
         result = CFCUtil_sprintf(pattern, cf_var, cf_var);
     }
     else if (CFCType_is_primitive(type)) {
@@ -272,7 +273,7 @@ CFCPerlTypeMap_write_xs_typemap(CFCHierarchy *hierarchy) {
         }
         input = CFCUtil_cat(input, class_var, "_\n"
                             "    $var = (", full_struct_sym,
-                            "*)XSBind_sv_to_cfish_obj($arg, ", class_var,
+                            "*)XSBind_sv_to_cfish_obj(aTHX_ $arg, ", class_var,
                             ", ", allocation, ");\n\n", NULL);
 
         output = CFCUtil_cat(output, class_var, "_\n"

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/c5889df2/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 232e223..e793f08 100644
--- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm
+++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm
@@ -52,7 +52,7 @@ to_clownfish(sv)
     SV *sv;
 CODE:
 {
-    cfish_Obj *obj = XSBind_perl_to_cfish(sv);
+    cfish_Obj *obj = XSBind_perl_to_cfish(aTHX_ sv);
     RETVAL = CFISH_OBJ_TO_SV_NOINC(obj);
 }
 OUTPUT: RETVAL
@@ -65,7 +65,7 @@ CODE:
     if (sv_isobject(sv) && sv_derived_from(sv, "Clownfish::Obj")) {
         IV tmp = SvIV(SvRV(sv));
         cfish_Obj* obj = INT2PTR(cfish_Obj*, tmp);
-        RETVAL = XSBind_cfish_to_perl(obj);
+        RETVAL = XSBind_cfish_to_perl(aTHX_ obj);
     }
     else {
         RETVAL = newSVsv(sv);
@@ -107,7 +107,7 @@ void
 invoke_to_string(sv)
     SV *sv;
 PPCODE:
-    cfish_Obj *obj = XSBind_sv_to_cfish_obj(sv, CFISH_OBJ, NULL);
+    cfish_Obj *obj = XSBind_sv_to_cfish_obj(aTHX_ sv, CFISH_OBJ, NULL);
     cfish_String *str = CFISH_Obj_To_String(obj);
     CFISH_DECREF(str);
 
@@ -152,7 +152,8 @@ CODE:
 {
     STRLEN size;
     char *ptr = SvPV(sv, size);
-    cfish_ByteBuf *self = (cfish_ByteBuf*)XSBind_new_blank_obj(either_sv);
+    cfish_ByteBuf *self
+        = (cfish_ByteBuf*)XSBind_new_blank_obj(aTHX_ either_sv);
     cfish_BB_init(self, size);
     CFISH_BB_Mimic_Bytes(self, ptr, size);
     RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
@@ -182,7 +183,7 @@ CODE:
 {
     STRLEN size;
     char *ptr = SvPVutf8(sv, size);
-    cfish_String *self = (cfish_String*)XSBind_new_blank_obj(either_sv);
+    cfish_String *self = (cfish_String*)XSBind_new_blank_obj(aTHX_ either_sv);
     cfish_Str_init_from_trusted_utf8(self, ptr, size);
     RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
 }
@@ -199,7 +200,7 @@ SV*
 to_perl(self)
     cfish_String *self;
 CODE:
-    RETVAL = XSBind_str_to_sv(self);
+    RETVAL = XSBind_str_to_sv(aTHX_ self);
 OUTPUT: RETVAL
 END_XS_CODE
 
@@ -331,7 +332,8 @@ new(either_sv, value)
     float  value;
 CODE:
 {
-    cfish_Float32 *self = (cfish_Float32*)XSBind_new_blank_obj(either_sv);
+    cfish_Float32 *self
+        = (cfish_Float32*)XSBind_new_blank_obj(aTHX_ either_sv);
     cfish_Float32_init(self, value);
     RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
 }
@@ -358,7 +360,8 @@ new(either_sv, value)
     double  value;
 CODE:
 {
-    cfish_Float64 *self = (cfish_Float64*)XSBind_new_blank_obj(either_sv);
+    cfish_Float64 *self
+        = (cfish_Float64*)XSBind_new_blank_obj(aTHX_ either_sv);
     cfish_Float64_init(self, value);
     RETVAL = CFISH_OBJ_TO_SV_NOINC(self);
 }
@@ -620,7 +623,7 @@ CODE:
     cfish_Class  *parent     = NULL;
     cfish_Class  *singleton  = NULL;
     bool args_ok
-        = XSBind_allot_params(&(ST(0)), 1, items,
+        = XSBind_allot_params(aTHX_ &(ST(0)), 1, items,
                               ALLOT_OBJ(&class_name, "class_name", 10, true,
                                         CFISH_STRING, alloca(cfish_SStr_size())),
                               ALLOT_OBJ(&parent, "parent", 6, false,

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/c5889df2/runtime/perl/xs/XSBind.c
----------------------------------------------------------------------
diff --git a/runtime/perl/xs/XSBind.c b/runtime/perl/xs/XSBind.c
index 2534c8d..33e41af 100644
--- a/runtime/perl/xs/XSBind.c
+++ b/runtime/perl/xs/XSBind.c
@@ -38,24 +38,24 @@
 // Convert a Perl hash into a Clownfish Hash.  Caller takes responsibility for
 // a refcount.
 static cfish_Hash*
-S_perl_hash_to_cfish_hash(HV *phash);
+S_perl_hash_to_cfish_hash(pTHX_ HV *phash);
 
 // Convert a Perl array into a Clownfish VArray.  Caller takes responsibility
 // for a refcount.
 static cfish_VArray*
-S_perl_array_to_cfish_array(AV *parray);
+S_perl_array_to_cfish_array(pTHX_ AV *parray);
 
 // Convert a VArray to a Perl array.  Caller takes responsibility for a
 // refcount.
 static SV*
-S_cfish_array_to_perl_array(cfish_VArray *varray);
+S_cfish_array_to_perl_array(pTHX_ cfish_VArray *varray);
 
 // Convert a Hash to a Perl hash.  Caller takes responsibility for a refcount.
 static SV*
-S_cfish_hash_to_perl_hash(cfish_Hash *hash);
+S_cfish_hash_to_perl_hash(pTHX_ cfish_Hash *hash);
 
 cfish_Obj*
-XSBind_new_blank_obj(SV *either_sv) {
+XSBind_new_blank_obj(pTHX_ SV *either_sv) {
     cfish_Class *klass;
 
     // Get a Class.
@@ -80,8 +80,9 @@ XSBind_new_blank_obj(SV *either_sv) {
 }
 
 cfish_Obj*
-XSBind_sv_to_cfish_obj(SV *sv, cfish_Class *klass, void *allocation) {
-    cfish_Obj *retval = XSBind_maybe_sv_to_cfish_obj(sv, klass, allocation);
+XSBind_sv_to_cfish_obj(pTHX_ SV *sv, cfish_Class *klass, void *allocation) {
+    cfish_Obj *retval
+        = XSBind_maybe_sv_to_cfish_obj(aTHX_ sv, klass, allocation);
     if (!retval) {
         THROW(CFISH_ERR, "Not a %o", CFISH_Class_Get_Name(klass));
     }
@@ -89,9 +90,10 @@ XSBind_sv_to_cfish_obj(SV *sv, cfish_Class *klass, void *allocation) {
 }
 
 cfish_Obj*
-XSBind_maybe_sv_to_cfish_obj(SV *sv, cfish_Class *klass, void *allocation) {
+XSBind_maybe_sv_to_cfish_obj(pTHX_ SV *sv, cfish_Class *klass,
+                             void *allocation) {
     cfish_Obj *retval = NULL;
-    if (XSBind_sv_defined(sv)) {
+    if (XSBind_sv_defined(aTHX_ sv)) {
         // Assume that the class name is always NULL-terminated. Somewhat
         // dangerous but should be safe.
         if (sv_isobject(sv)
@@ -117,10 +119,12 @@ XSBind_maybe_sv_to_cfish_obj(SV *sv, cfish_Class *klass, void *allocation)
{
             // analogues.
             SV *inner = SvRV(sv);
             if (SvTYPE(inner) == SVt_PVAV && klass == CFISH_VARRAY) {
-                retval = (cfish_Obj*)S_perl_array_to_cfish_array((AV*)inner);
+                retval = (cfish_Obj*)
+                         S_perl_array_to_cfish_array(aTHX_ (AV*)inner);
             }
             else if (SvTYPE(inner) == SVt_PVHV && klass == CFISH_HASH) {
-                retval = (cfish_Obj*)S_perl_hash_to_cfish_hash((HV*)inner);
+                retval = (cfish_Obj*)
+                         S_perl_hash_to_cfish_hash(aTHX_ (HV*)inner);
             }
 
             if (retval) {
@@ -138,21 +142,21 @@ XSBind_maybe_sv_to_cfish_obj(SV *sv, cfish_Class *klass, void *allocation)
{
 }
 
 SV*
-XSBind_cfish_to_perl(cfish_Obj *obj) {
+XSBind_cfish_to_perl(pTHX_ cfish_Obj *obj) {
     if (obj == NULL) {
         return newSV(0);
     }
     else if (CFISH_Obj_Is_A(obj, CFISH_STRING)) {
-        return XSBind_str_to_sv((cfish_String*)obj);
+        return XSBind_str_to_sv(aTHX_ (cfish_String*)obj);
     }
     else if (CFISH_Obj_Is_A(obj, CFISH_BYTEBUF)) {
-        return XSBind_bb_to_sv((cfish_ByteBuf*)obj);
+        return XSBind_bb_to_sv(aTHX_ (cfish_ByteBuf*)obj);
     }
     else if (CFISH_Obj_Is_A(obj, CFISH_VARRAY)) {
-        return S_cfish_array_to_perl_array((cfish_VArray*)obj);
+        return S_cfish_array_to_perl_array(aTHX_ (cfish_VArray*)obj);
     }
     else if (CFISH_Obj_Is_A(obj, CFISH_HASH)) {
-        return S_cfish_hash_to_perl_hash((cfish_Hash*)obj);
+        return S_cfish_hash_to_perl_hash(aTHX_ (cfish_Hash*)obj);
     }
     else if (CFISH_Obj_Is_A(obj, CFISH_FLOATNUM)) {
         return newSVnv(CFISH_Obj_To_F64(obj));
@@ -181,18 +185,20 @@ XSBind_cfish_to_perl(cfish_Obj *obj) {
 }
 
 cfish_Obj*
-XSBind_perl_to_cfish(SV *sv) {
+XSBind_perl_to_cfish(pTHX_ SV *sv) {
     cfish_Obj *retval = NULL;
 
-    if (XSBind_sv_defined(sv)) {
+    if (XSBind_sv_defined(aTHX_ sv)) {
         if (SvROK(sv)) {
             // Deep conversion of references.
             SV *inner = SvRV(sv);
             if (SvTYPE(inner) == SVt_PVAV) {
-                retval = (cfish_Obj*)S_perl_array_to_cfish_array((AV*)inner);
+                retval = (cfish_Obj*)
+                         S_perl_array_to_cfish_array(aTHX_ (AV*)inner);
             }
             else if (SvTYPE(inner) == SVt_PVHV) {
-                retval = (cfish_Obj*)S_perl_hash_to_cfish_hash((HV*)inner);
+                retval = (cfish_Obj*)
+                         S_perl_hash_to_cfish_hash(aTHX_ (HV*)inner);
             }
             else if (sv_isobject(sv)
                      && sv_derived_from(sv, "Clownfish::Obj")
@@ -214,10 +220,10 @@ XSBind_perl_to_cfish(SV *sv) {
     else if (sv) {
         // Deep conversion of raw AVs and HVs.
         if (SvTYPE(sv) == SVt_PVAV) {
-            retval = (cfish_Obj*)S_perl_array_to_cfish_array((AV*)sv);
+            retval = (cfish_Obj*)S_perl_array_to_cfish_array(aTHX_ (AV*)sv);
         }
         else if (SvTYPE(sv) == SVt_PVHV) {
-            retval = (cfish_Obj*)S_perl_hash_to_cfish_hash((HV*)sv);
+            retval = (cfish_Obj*)S_perl_hash_to_cfish_hash(aTHX_ (HV*)sv);
         }
     }
 
@@ -225,14 +231,14 @@ XSBind_perl_to_cfish(SV *sv) {
 }
 
 SV*
-XSBind_bb_to_sv(cfish_ByteBuf *bb) {
+XSBind_bb_to_sv(pTHX_ cfish_ByteBuf *bb) {
     return bb
            ? newSVpvn(CFISH_BB_Get_Buf(bb), CFISH_BB_Get_Size(bb))
            : newSV(0);
 }
 
 SV*
-XSBind_str_to_sv(cfish_String *str) {
+XSBind_str_to_sv(pTHX_ cfish_String *str) {
     if (!str) {
         return newSV(0);
     }
@@ -244,7 +250,7 @@ XSBind_str_to_sv(cfish_String *str) {
 }
 
 static cfish_Hash*
-S_perl_hash_to_cfish_hash(HV *phash) {
+S_perl_hash_to_cfish_hash(pTHX_ HV *phash) {
     uint32_t    num_keys = hv_iterinit(phash);
     cfish_Hash *retval   = cfish_Hash_new(num_keys);
 
@@ -252,7 +258,7 @@ S_perl_hash_to_cfish_hash(HV *phash) {
         HE        *entry    = hv_iternext(phash);
         STRLEN     key_len  = HeKLEN(entry);
         SV        *value_sv = HeVAL(entry);
-        cfish_Obj *value    = XSBind_perl_to_cfish(value_sv); // Recurse.
+        cfish_Obj *value    = XSBind_perl_to_cfish(aTHX_ value_sv); // Recurse.
 
         // Force key to UTF-8 if necessary.
         if (key_len == (STRLEN)HEf_SVKEY) {
@@ -286,7 +292,7 @@ S_perl_hash_to_cfish_hash(HV *phash) {
 }
 
 static cfish_VArray*
-S_perl_array_to_cfish_array(AV *parray) {
+S_perl_array_to_cfish_array(pTHX_ AV *parray) {
     const uint32_t  size   = av_len(parray) + 1;
     cfish_VArray   *retval = cfish_VA_new(size);
 
@@ -294,7 +300,7 @@ S_perl_array_to_cfish_array(AV *parray) {
     for (uint32_t i = 0; i < size; i++) {
         SV **elem_sv = av_fetch(parray, i, false);
         if (elem_sv) {
-            cfish_Obj *elem = XSBind_perl_to_cfish(*elem_sv);
+            cfish_Obj *elem = XSBind_perl_to_cfish(aTHX_ *elem_sv);
             if (elem) { CFISH_VA_Store(retval, i, elem); }
         }
     }
@@ -304,7 +310,7 @@ S_perl_array_to_cfish_array(AV *parray) {
 }
 
 static SV*
-S_cfish_array_to_perl_array(cfish_VArray *varray) {
+S_cfish_array_to_perl_array(pTHX_ cfish_VArray *varray) {
     AV *perl_array = newAV();
     uint32_t num_elems = CFISH_VA_Get_Size(varray);
 
@@ -318,7 +324,7 @@ S_cfish_array_to_perl_array(cfish_VArray *varray) {
             }
             else {
                 // Recurse for each value.
-                SV *const val_sv = XSBind_cfish_to_perl(val);
+                SV *const val_sv = XSBind_cfish_to_perl(aTHX_ val);
                 av_store(perl_array, i, val_sv);
             }
         }
@@ -328,7 +334,7 @@ S_cfish_array_to_perl_array(cfish_VArray *varray) {
 }
 
 static SV*
-S_cfish_hash_to_perl_hash(cfish_Hash *hash) {
+S_cfish_hash_to_perl_hash(pTHX_ cfish_Hash *hash) {
     HV *perl_hash = newHV();
     SV *key_sv    = newSV(1);
     cfish_String *key;
@@ -342,7 +348,7 @@ S_cfish_hash_to_perl_hash(cfish_Hash *hash) {
     CFISH_Hash_Iterate(hash);
     while (CFISH_Hash_Next(hash, (cfish_Obj**)&key, &val)) {
         // Recurse for each value.
-        SV *val_sv = XSBind_cfish_to_perl(val);
+        SV *val_sv = XSBind_cfish_to_perl(aTHX_ val);
         if (!CFISH_Obj_Is_A((cfish_Obj*)key, CFISH_STRING)) {
             CFISH_THROW(CFISH_ERR,
                         "Can't convert a key of class %o to a Perl hash key",
@@ -370,6 +376,7 @@ struct trap_context {
 static void
 S_attempt_perl_call(void *context) {
     struct trap_context *args = (struct trap_context*)context;
+    dTHX;
     dSP;
     ENTER;
     SAVETMPS;
@@ -390,7 +397,7 @@ XSBind_trap(SV *routine, SV *context) {
 }
 
 void
-XSBind_enable_overload(void *pobj) {
+XSBind_enable_overload(pTHX_ void *pobj) {
     SV *perl_obj = (SV*)pobj;
     HV *stash = SvSTASH(SvRV(perl_obj));
 #if (PERL_VERSION > 10)
@@ -402,12 +409,12 @@ XSBind_enable_overload(void *pobj) {
 }
 
 static bool
-S_extract_from_sv(SV *value, void *target, const char *label,
+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(value)) {
+    if (XSBind_sv_defined(aTHX_ value)) {
         switch (type) {
             case XSBIND_WANT_I8:
                 *((int8_t*)target) = (int8_t)SvIV(value);
@@ -467,7 +474,7 @@ S_extract_from_sv(SV *value, void *target, const char *label,
                 break;
             case XSBIND_WANT_OBJ: {
                     cfish_Obj *object
-                        = XSBind_maybe_sv_to_cfish_obj(value, klass,
+                        = XSBind_maybe_sv_to_cfish_obj(aTHX_ value, klass,
                                                        allocation);
                     if (object) {
                         *((cfish_Obj**)target) = object;
@@ -510,7 +517,8 @@ S_extract_from_sv(SV *value, void *target, const char *label,
 }
 
 bool
-XSBind_allot_params(SV** stack, int32_t start, int32_t num_stack_elems, ...) {
+XSBind_allot_params(pTHX_ SV** stack, int32_t start, int32_t num_stack_elems,
+                    ...) {
     va_list args;
     size_t size = sizeof(int64_t) + num_stack_elems / 64;
     void *verified_labels = alloca(size);
@@ -564,9 +572,9 @@ XSBind_allot_params(SV** stack, int32_t start, int32_t num_stack_elems,
...) {
         else {
             // Found the arg.  Extract the value.
             SV *value = stack[found_arg + 1];
-            bool got_arg = S_extract_from_sv(value, target, label,
-                                                   required, type, klass,
-                                                   allocation);
+            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;
@@ -626,7 +634,7 @@ SI_threadsafe_but_not_immortal(cfish_Class *klass) {
 }
 
 static void
-S_lazy_init_host_obj(cfish_Obj *self) {
+S_lazy_init_host_obj(pTHX_ cfish_Obj *self) {
     SV *inner_obj = newSV(0);
     SvOBJECT_on(inner_obj);
 #if (PERL_VERSION <= 16)
@@ -746,6 +754,7 @@ cfish_dec_refcount(void *vself) {
         }
     }
     else {
+        dTHX;
         modified_refcount = SvREFCNT((SV*)self->ref.host_obj) - 1;
         // If the SV's refcount falls to 0, DESTROY will be invoked from
         // Perl-space.
@@ -756,7 +765,10 @@ cfish_dec_refcount(void *vself) {
 
 void*
 CFISH_Obj_To_Host_IMP(cfish_Obj *self) {
-    if (self->ref.count & XSBIND_REFCOUNT_FLAG) { S_lazy_init_host_obj(self); }
+    dTHX;
+    if (self->ref.count & XSBIND_REFCOUNT_FLAG) {
+        S_lazy_init_host_obj(aTHX_ self);
+    }
     return newRV_inc((SV*)self->ref.host_obj);
 }
 
@@ -781,6 +793,7 @@ CFISH_Class_Init_Obj_IMP(cfish_Class *self, void *allocation) {
 
 cfish_Obj*
 CFISH_Class_Foster_Obj_IMP(cfish_Class *self, void *host_obj) {
+    dTHX;
     cfish_Obj *obj
         = (cfish_Obj*)cfish_Memory_wrapped_calloc(self->obj_alloc_size, 1);
     SV *inner_obj = SvRV((SV*)host_obj);
@@ -792,6 +805,7 @@ CFISH_Class_Foster_Obj_IMP(cfish_Class *self, void *host_obj) {
 
 void
 cfish_Class_register_with_host(cfish_Class *singleton, cfish_Class *parent) {
+    dTHX;
     dSP;
     ENTER;
     SAVETMPS;
@@ -807,16 +821,17 @@ cfish_Class_register_with_host(cfish_Class *singleton, cfish_Class *parent)
{
 
 cfish_VArray*
 cfish_Class_fresh_host_methods(cfish_String *class_name) {
+    dTHX;
     dSP;
     ENTER;
     SAVETMPS;
     EXTEND(SP, 1);
     PUSHMARK(SP);
-    mPUSHs(XSBind_str_to_sv(class_name));
+    mPUSHs(XSBind_str_to_sv(aTHX_ class_name));
     PUTBACK;
     call_pv("Clownfish::Class::_fresh_host_methods", G_SCALAR);
     SPAGAIN;
-    cfish_VArray *methods = (cfish_VArray*)XSBind_perl_to_cfish(POPs);
+    cfish_VArray *methods = (cfish_VArray*)XSBind_perl_to_cfish(aTHX_ POPs);
     PUTBACK;
     FREETMPS;
     LEAVE;
@@ -825,19 +840,20 @@ cfish_Class_fresh_host_methods(cfish_String *class_name) {
 
 cfish_String*
 cfish_Class_find_parent_class(cfish_String *class_name) {
+    dTHX;
     dSP;
     ENTER;
     SAVETMPS;
     EXTEND(SP, 1);
     PUSHMARK(SP);
-    mPUSHs(XSBind_str_to_sv(class_name));
+    mPUSHs(XSBind_str_to_sv(aTHX_ class_name));
     PUTBACK;
     call_pv("Clownfish::Class::_find_parent_class", G_SCALAR);
     SPAGAIN;
     SV *parent_class_sv = POPs;
     PUTBACK;
     cfish_String *parent_class
-        = (cfish_String*)XSBind_perl_to_cfish(parent_class_sv);
+        = (cfish_String*)XSBind_perl_to_cfish(aTHX_ parent_class_sv);
     FREETMPS;
     LEAVE;
     return parent_class;
@@ -895,12 +911,14 @@ XS(cfish_Err_attempt_via_xs) {
 
 void
 cfish_Err_init_class(void) {
+    dTHX;
     char *file = (char*)__FILE__;
     attempt_xsub = (SV*)newXS(NULL, cfish_Err_attempt_via_xs, file);
 }
 
 cfish_Err*
 cfish_Err_get_error() {
+    dTHX;
     dSP;
     ENTER;
     SAVETMPS;
@@ -908,7 +926,7 @@ cfish_Err_get_error() {
     PUTBACK;
     call_pv("Clownfish::Err::get_error", G_SCALAR);
     SPAGAIN;
-    cfish_Err *error = (cfish_Err*)XSBind_perl_to_cfish(POPs);
+    cfish_Err *error = (cfish_Err*)XSBind_perl_to_cfish(aTHX_ POPs);
     PUTBACK;
     FREETMPS;
     LEAVE;
@@ -917,6 +935,7 @@ cfish_Err_get_error() {
 
 void
 cfish_Err_set_error(cfish_Err *error) {
+    dTHX;
     dSP;
     ENTER;
     SAVETMPS;
@@ -937,6 +956,7 @@ cfish_Err_set_error(cfish_Err *error) {
 
 void
 cfish_Err_do_throw(cfish_Err *err) {
+    dTHX;
     dSP;
     SV *error_sv = (SV*)CFISH_Err_To_Host(err);
     CFISH_DECREF(err);
@@ -952,10 +972,11 @@ cfish_Err_do_throw(cfish_Err *err) {
 
 void*
 CFISH_Err_To_Host_IMP(cfish_Err *self) {
+    dTHX;
     CFISH_Err_To_Host_t super_to_host
         = CFISH_SUPER_METHOD_PTR(CFISH_ERR, CFISH_Err_To_Host);
     SV *perl_obj = (SV*)super_to_host(self);
-    XSBind_enable_overload(perl_obj);
+    XSBind_enable_overload(aTHX_ perl_obj);
     return perl_obj;
 }
 
@@ -968,7 +989,8 @@ cfish_Err_throw_mess(cfish_Class *klass, cfish_String *message) {
 
 void
 cfish_Err_warn_mess(cfish_String *message) {
-    SV *error_sv = XSBind_str_to_sv(message);
+    dTHX;
+    SV *error_sv = XSBind_str_to_sv(aTHX_ message);
     CFISH_DECREF(message);
     warn("%s", SvPV_nolen(error_sv));
     SvREFCNT_dec(error_sv);
@@ -976,6 +998,7 @@ cfish_Err_warn_mess(cfish_String *message) {
 
 cfish_Err*
 cfish_Err_trap(CFISH_Err_Attempt_t routine, void *context) {
+    dTHX;
     cfish_Err *error = NULL;
     SV *routine_sv = newSViv(PTR2IV(routine));
     SV *context_sv = newSViv(PTR2IV(context));

http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/c5889df2/runtime/perl/xs/XSBind.h
----------------------------------------------------------------------
diff --git a/runtime/perl/xs/XSBind.h b/runtime/perl/xs/XSBind.h
index 5d237fc..357af1e 100644
--- a/runtime/perl/xs/XSBind.h
+++ b/runtime/perl/xs/XSBind.h
@@ -31,6 +31,7 @@
 
 /* Avoid conflicts with Clownfish bool type. */
 #define HAS_BOOL
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -46,13 +47,13 @@ extern "C" {
  * object suitable for supplying to a cfish_Foo_init() function.
  */
 CFISH_VISIBLE cfish_Obj*
-cfish_XSBind_new_blank_obj(SV *either_sv);
+cfish_XSBind_new_blank_obj(pTHX_ SV *either_sv);
 
 /** Test whether an SV is defined.  Handles "get" magic, unlike SvOK on its
  * own.
  */
 static CFISH_INLINE bool
-cfish_XSBind_sv_defined(SV *sv) {
+cfish_XSBind_sv_defined(pTHX_ SV *sv) {
     if (!sv || !SvANY(sv)) { return false; }
     if (SvGMAGICAL(sv)) { mg_get(sv); }
     return !!SvOK(sv);
@@ -66,13 +67,14 @@ cfish_XSBind_sv_defined(SV *sv) {
  * instead.  If all else fails, throw an exception.
  */
 CFISH_VISIBLE cfish_Obj*
-cfish_XSBind_sv_to_cfish_obj(SV *sv, cfish_Class *klass, void *allocation);
+cfish_XSBind_sv_to_cfish_obj(pTHX_ SV *sv, cfish_Class *klass,
+                             void *allocation);
 
 /** As XSBind_sv_to_cfish_obj above, but returns NULL instead of throwing an
  * exception.
  */
 CFISH_VISIBLE cfish_Obj*
-cfish_XSBind_maybe_sv_to_cfish_obj(SV *sv, cfish_Class *klass,
+cfish_XSBind_maybe_sv_to_cfish_obj(pTHX_ SV *sv, cfish_Class *klass,
                                    void *allocation);
 
 
@@ -83,20 +85,21 @@ cfish_XSBind_maybe_sv_to_cfish_obj(SV *sv, cfish_Class *klass,
  * responsibility.
  */
 static CFISH_INLINE SV*
-cfish_XSBind_cfish_obj_to_sv(cfish_Obj *obj) {
+cfish_XSBind_cfish_obj_to_sv(pTHX_ cfish_Obj *obj) {
     return obj ? (SV*)CFISH_Obj_To_Host(obj) : newSV(0);
 }
 
 /** XSBind_cfish_obj_to_sv, with a cast.
  */
-#define CFISH_OBJ_TO_SV(_obj) cfish_XSBind_cfish_obj_to_sv((cfish_Obj*)_obj)
+#define CFISH_OBJ_TO_SV(_obj) \
+    cfish_XSBind_cfish_obj_to_sv(aTHX_ (cfish_Obj*)_obj)
 
 /** As XSBind_cfish_obj_to_sv above, except decrements the object's refcount
  * after creating the SV. This is useful when the Clownfish expression creates a new
  * refcount, e.g.  a call to a constructor.
  */
 static CFISH_INLINE SV*
-cfish_XSBind_cfish_obj_to_sv_noinc(cfish_Obj *obj) {
+cfish_XSBind_cfish_obj_to_sv_noinc(pTHX_ cfish_Obj *obj) {
     SV *retval;
     if (obj) {
         retval = (SV*)CFISH_Obj_To_Host(obj);
@@ -111,31 +114,31 @@ cfish_XSBind_cfish_obj_to_sv_noinc(cfish_Obj *obj) {
 /** XSBind_cfish_obj_to_sv_noinc, with a cast.
  */
 #define CFISH_OBJ_TO_SV_NOINC(_obj) \
-    cfish_XSBind_cfish_obj_to_sv_noinc((cfish_Obj*)_obj)
+    cfish_XSBind_cfish_obj_to_sv_noinc(aTHX_ (cfish_Obj*)_obj)
 
 /** Deep conversion of Clownfish objects to Perl objects -- Strings to UTF-8
  * SVs, ByteBufs to SVs, VArrays to Perl array refs, Hashes to Perl hashrefs,
  * and any other object to a Perl object wrapping the Clownfish Obj.
  */
 CFISH_VISIBLE SV*
-cfish_XSBind_cfish_to_perl(cfish_Obj *obj);
+cfish_XSBind_cfish_to_perl(pTHX_ cfish_Obj *obj);
 
 /** Deep conversion of Perl data structures to Clownfish objects -- Perl hash
  * to Hash, Perl array to VArray, Clownfish objects stripped of their
  * wrappers, and everything else stringified and turned to a String.
  */
 CFISH_VISIBLE cfish_Obj*
-cfish_XSBind_perl_to_cfish(SV *sv);
+cfish_XSBind_perl_to_cfish(pTHX_ SV *sv);
 
 /** Convert a ByteBuf into a new string SV.
  */
 CFISH_VISIBLE SV*
-cfish_XSBind_bb_to_sv(cfish_ByteBuf *bb);
+cfish_XSBind_bb_to_sv(pTHX_ cfish_ByteBuf *bb);
 
 /** Convert a String into a new UTF-8 string SV.
  */
 CFISH_VISIBLE SV*
-cfish_XSBind_str_to_sv(cfish_String *str);
+cfish_XSBind_str_to_sv(pTHX_ cfish_String *str);
 
 /** Perl-specific wrapper for Err#trap.  The "routine" must be either a
  * subroutine reference or the name of a subroutine.
@@ -146,7 +149,7 @@ cfish_XSBind_trap(SV *routine, SV *context);
 /** Turn on overloading for the supplied Perl object and its class.
  */
 CFISH_VISIBLE void
-cfish_XSBind_enable_overload(void *pobj);
+cfish_XSBind_enable_overload(pTHX_ void *pobj);
 
 /** Process hash-style params passed to an XS subroutine.  The varargs must be
  * a NULL-terminated series of ALLOT_ macros.
@@ -210,7 +213,7 @@ cfish_XSBind_enable_overload(void *pobj);
  * @return true on success, false on failure (sets the global error object).
  */
 CFISH_VISIBLE bool
-cfish_XSBind_allot_params(SV** stack, int32_t start,
+cfish_XSBind_allot_params(pTHX_ SV** stack, int32_t start,
                           int32_t num_stack_elems, ...);
 
 #define XSBIND_WANT_I8       0x1


Mime
View raw message