Add PERL_NO_GET_CONTEXT to Hash::Util::FieldHash

For threaded platforms, this reduces the object code size, and should slight
reduce CPU usage.

1 files changed, 63 insertions, 45 deletions

diff --git a/ext/Hash-Util-FieldHash/FieldHash.xs b/ext/Hash-Util-FieldHash/FieldHash.xs
index c7df46bcb5..e726041f60 100644
--- a/ext/Hash-Util-FieldHash/FieldHash.xs
+++ b/ext/Hash-Util-FieldHash/FieldHash.xs
@@ -1,3 +1,5 @@
+#define PERL_NO_GET_CONTEXT
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -17,7 +19,8 @@ typedef struct {
 START_MY_CXT
 
 /* Inquire the object registry (a lexical hash) from perl */
-HV* HUF_get_ob_reg(void) {
+HV *
+HUF_get_ob_reg(pTHX) {
     dSP;
     HV* ob_reg = NULL;
     I32 items;
@@ -44,16 +47,17 @@ HV* HUF_get_ob_reg(void) {
 #define HUF_CLONE 0
 #define HUF_RESET -1
 
-void HUF_global(I32 how) {
+void
+HUF_global(pTHX_ I32 how) {
     if (how == HUF_INIT) {
         MY_CXT_INIT;
-        MY_CXT.ob_reg = HUF_get_ob_reg();
+        MY_CXT.ob_reg = HUF_get_ob_reg(aTHX);
     } else if (how == HUF_CLONE) {
         MY_CXT_CLONE;
-        MY_CXT.ob_reg = HUF_get_ob_reg();
+        MY_CXT.ob_reg = HUF_get_ob_reg(aTHX);
     } else if (how == HUF_RESET) {
         dMY_CXT;
-        MY_CXT.ob_reg = HUF_get_ob_reg();
+        MY_CXT.ob_reg = HUF_get_ob_reg(aTHX);
     }
 }
 
@@ -62,7 +66,8 @@ void HUF_global(I32 how) {
 /* definition of id transformation */
 #define HUF_OBJ_ID(x) newSVuv(PTR2UV(x))
 
-SV* HUF_obj_id(SV* obj) {
+SV *
+HUF_obj_id(pTHX_ SV *obj) {
     SV *item = SvRV(obj);
     MAGIC *mg;
     SV *id;
@@ -89,7 +94,9 @@ SV* HUF_obj_id(SV* obj) {
 }
 
 /* set up uvar magic for any sv */
-void HUF_add_uvar_magic(
+void
+HUF_add_uvar_magic(
+    pTHX_
     SV* sv,                    /* the sv to enchant, visible to get/set */
     I32(* val)(pTHX_ IV, SV*), /* "get" function */
     I32(* set)(pTHX_ IV, SV*), /* "set" function */
@@ -104,7 +111,8 @@ void HUF_add_uvar_magic(
 }
 
 /* Fetch the data container of a trigger */
-AV* HUF_get_trigger_content(SV* trigger) {
+AV *
+HUF_get_trigger_content(pTHX_ SV *trigger) {
     MAGIC* mg;
     if (trigger && (mg = mg_find(trigger, PERL_MAGIC_uvar)))
         return (AV*)mg->mg_obj;
@@ -115,13 +123,13 @@ AV* HUF_get_trigger_content(SV* trigger) {
  * the object's entry from the object registry.  This function goes in
  * the uf_set field of the uvar magic of a trigger.
  */
-I32 HUF_destroy_obj(pTHX_ IV index, SV* trigger) {
+I32 HUF_destroy_obj(pTHX_ IV index, SV *trigger) {
     PERL_UNUSED_ARG(index);
     /* Do nothing if the weakref wasn't undef'd.  Also don't bother
      * during global destruction.  (MY_CXT.ob_reg is sometimes funny there) */
     if (!SvROK(trigger) && (!PL_in_clean_all)) {
         dMY_CXT;
-        AV* cont = HUF_get_trigger_content(trigger);
+        AV* cont = HUF_get_trigger_content(aTHX_ trigger);
         SV* ob_id = *av_fetch(cont, 0, 0);
         HV* field_tab = (HV*) *av_fetch(cont, 1, 0);
         HE* ent;
@@ -133,7 +141,7 @@ I32 HUF_destroy_obj(pTHX_ IV index, SV* trigger) {
         }
         /* make it safe in case we must run in global clenaup, after all */
         if (PL_in_clean_all)
-            HUF_global(HUF_RESET); /* shoudn't be needed */
+            HUF_global(aTHX_ HUF_RESET); /* shoudn't be needed */
         (void) hv_delete_ent(MY_CXT.ob_reg, ob_id, 0, 0);
     }
     return 0;
@@ -147,20 +155,22 @@ I32 HUF_destroy_obj(pTHX_ IV index, SV* trigger) {
  * object may * have to be deleted.  The trigger is stored in the
  * object registry and is also deleted when the object expires.
  */
-SV* HUF_new_trigger(SV* obj, SV* ob_id) {
+SV *
+HUF_new_trigger(pTHX_ SV *obj, SV *ob_id) {
     dMY_CXT;
     SV* trigger = sv_rvweaken(newRV_inc(SvRV(obj)));
     AV* cont = newAV();
     sv_2mortal((SV*)cont);
     av_store(cont, 0, SvREFCNT_inc(ob_id));
     av_store(cont, 1, (SV*)newHV());
-    HUF_add_uvar_magic(trigger, NULL, &HUF_destroy_obj, 0, (SV*)cont);
+    HUF_add_uvar_magic(aTHX_ trigger, NULL, &HUF_destroy_obj, 0, (SV*)cont);
     (void) hv_store_ent(MY_CXT.ob_reg, ob_id, trigger, 0);
     return trigger;
 }
 
 /* retrieve a trigger for obj if one exists, return NULL otherwise */
-SV* HUF_ask_trigger(SV* ob_id) {
+SV *
+HUF_ask_trigger(pTHX_ SV *ob_id) {
     dMY_CXT;
     HE* ent;
     if ((ent = hv_fetch_ent(MY_CXT.ob_reg, ob_id, 0, 0)))
@@ -169,25 +179,28 @@ SV* HUF_ask_trigger(SV* ob_id) {
 }
 
 /* get the trigger for an object, creating it if necessary */
-SV* HUF_get_trigger0(SV* obj, SV* ob_id) {
+SV *
+HUF_get_trigger0(pTHX_ SV *obj, SV *ob_id) {
     SV* trigger;
-    if (!(trigger = HUF_ask_trigger(ob_id)))
-        trigger = HUF_new_trigger(obj, ob_id);
+    if (!(trigger = HUF_ask_trigger(aTHX_ ob_id)))
+        trigger = HUF_new_trigger(aTHX_ obj, ob_id);
     return trigger;
 }
 
-SV* HUF_get_trigger(SV* obj, SV* ob_id) {
-    SV* trigger = HUF_ask_trigger(ob_id);
+SV *
+HUF_get_trigger(pTHX_ SV *obj, SV *ob_id) {
+    SV* trigger = HUF_ask_trigger(aTHX_ ob_id);
     if (!trigger)
-        trigger = HUF_new_trigger(obj, ob_id);
+        trigger = HUF_new_trigger(aTHX_ obj, ob_id);
     return( trigger);
 }
 
 /* mark an object (trigger) as having been used with a field
    (a clenup-liability)
 */
-void HUF_mark_field(SV* trigger, SV* field) {
-    AV* cont = HUF_get_trigger_content(trigger);
+void
+HUF_mark_field(pTHX_ SV *trigger, SV *field) {
+    AV* cont = HUF_get_trigger_content(aTHX_ trigger);
     HV* field_tab = (HV*) *av_fetch(cont, 1, 0);
     SV* field_ref = newRV_inc(field);
     UV field_addr = PTR2UV(field);
@@ -205,17 +218,17 @@ I32 HUF_watch_key_safe(pTHX_ IV action, SV* field) {
     SV* keysv;
     if (mg && (keysv = mg->mg_obj)) {
         if (SvROK(keysv)) { /* ref key */
-            SV* ob_id = HUF_obj_id(keysv);
+            SV* ob_id = HUF_obj_id(aTHX_ keysv);
             mg->mg_obj = ob_id; /* key replacement */
             if (HUF_WOULD_CREATE_KEY(action)) {
-                SV* trigger = HUF_get_trigger(keysv, ob_id);
-                HUF_mark_field(trigger, field);
+                SV* trigger = HUF_get_trigger(aTHX_ keysv, ob_id);
+                HUF_mark_field(aTHX_ trigger, field);
             }
         } else if (HUF_WOULD_CREATE_KEY(action)) { /* string key */
             /* registered as object id? */
             SV* trigger;
-            if (( trigger = HUF_ask_trigger(keysv)))
-                HUF_mark_field( trigger, field);
+            if (( trigger = HUF_ask_trigger(aTHX_ keysv)))
+                HUF_mark_field(aTHX_ trigger, field);
         }
     } else {
         Perl_die(aTHX_ "Rogue call of 'HUF_watch_key_safe'");
@@ -229,7 +242,7 @@ I32 HUF_watch_key_id(pTHX_ IV action, SV* field) {
     PERL_UNUSED_ARG(action);
     if (mg && (keysv = mg->mg_obj)) {
         if (SvROK(keysv)) /* ref key */
-            mg->mg_obj = HUF_obj_id(keysv); /* key replacement */
+            mg->mg_obj = HUF_obj_id(aTHX_ keysv); /* key replacement */
     } else {
         Perl_die(aTHX_ "Rogue call of 'HUF_watch_key_id'");
     }
@@ -259,7 +272,8 @@ I32(* HUF_mode_2func( int mode))(pTHX_ IV, SV*) {
 }
 
 /* see if something is a field hash */
-int HUF_get_status(HV* hash) {
+int
+HUF_get_status(pTHX_ HV *hash) {
     int ans = 0;
     if (hash && (SvTYPE(hash) == SVt_PVHV)) {
         MAGIC* mg;
@@ -277,8 +291,9 @@ int HUF_get_status(HV* hash) {
 /* Thread support.  These routines are called by CLONE (and nothing else) */
 
 /* Fix entries for one object in all field hashes */
-void HUF_fix_trigger(SV* trigger, SV* new_id) {
-    AV* cont = HUF_get_trigger_content(trigger);
+void
+HUF_fix_trigger(pTHX_ SV *trigger, SV *new_id) {
+    AV* cont = HUF_get_trigger_content(aTHX_ trigger);
     HV* field_tab = (HV*) *av_fetch(cont, 1, 0);
     HV* new_tab = newHV();
     HE* ent;
@@ -303,7 +318,8 @@ void HUF_fix_trigger(SV* trigger, SV* new_id) {
 /* Go over object registry and fix all objects.  Also fix the object
  * registry.
  */
-void HUF_fix_objects(void) {
+void
+HUF_fix_objects(pTHX) {
     dMY_CXT;
     I32 i, len;
     HE* ent;
@@ -329,7 +345,7 @@ void HUF_fix_objects(void) {
             }
         }
 
-        HUF_fix_trigger(trigger, new_id);
+        HUF_fix_trigger(aTHX_ trigger, new_id);
         (void) hv_store_ent(MY_CXT.ob_reg, new_id, SvREFCNT_inc(trigger), 0);
     }
 }
@@ -348,7 +364,7 @@ MODULE = Hash::Util::FieldHash          PACKAGE = Hash::Util::FieldHash
 
 BOOT:
 {
-    HUF_global(HUF_INIT); /* create variables */
+    HUF_global(aTHX_ HUF_INIT); /* create variables */
 }
 
 int
@@ -364,13 +380,14 @@ CODE:
     ) {
         
         HUF_add_uvar_magic(
+            aTHX_
             SvRV(href),
-            HUF_mode_2func( mode),
+            HUF_mode_2func(mode),
             NULL,
             0,
             NULL
         );
-        RETVAL = HUF_get_status(field);
+        RETVAL = HUF_get_status(aTHX_ field);
     }
 OUTPUT:
     RETVAL
@@ -380,7 +397,7 @@ id(SV* ref)
 PROTOTYPE: $
 PPCODE:
     if (SvROK(ref)) {
-        XPUSHs(HUF_obj_id(ref));
+        XPUSHs(HUF_obj_id(aTHX_ ref));
     } else {
         XPUSHs(ref);
     }
@@ -389,7 +406,7 @@ SV*
 id_2obj(SV* id)
 PROTOTYPE: $
 CODE:
-    SV* obj = HUF_ask_trigger(id);
+    SV* obj = HUF_ask_trigger(aTHX_ id);
     if (obj) {
         RETVAL = newRV_inc(SvRV(obj));
     } else {
@@ -410,11 +427,11 @@ CODE:
     } else {
         RETVAL = newRV_inc(SvRV(obj));
     }
-    trigger = HUF_get_trigger(obj, HUF_obj_id(obj));
+    trigger = HUF_get_trigger(aTHX_ obj, HUF_obj_id(aTHX_ obj));
     for (i = 1; i < items; ++ i) {
         SV* field_ref = POPs;
         if (SvROK(field_ref) && (SvTYPE(SvRV(field_ref)) == SVt_PVHV)) {
-            HUF_mark_field(trigger, SvRV(field_ref));
+            HUF_mark_field(aTHX_ trigger, SvRV(field_ref));
         }
     }
 OUTPUT:
@@ -424,18 +441,18 @@ void
 CLONE(char* classname)
 CODE:
     if (0 == strcmp(classname, "Hash::Util::FieldHash")) {
-        HUF_global(HUF_CLONE);
-        HUF_fix_objects();
+        HUF_global(aTHX_ HUF_CLONE);
+        HUF_fix_objects(aTHX);
     }
 
 void
 _active_fields(SV* obj)
 PPCODE:
     if (SvROK(obj)) {
-        SV* ob_id = HUF_obj_id(obj);
-        SV* trigger = HUF_ask_trigger(ob_id);
+        SV* ob_id = HUF_obj_id(aTHX_ obj);
+        SV* trigger = HUF_ask_trigger(aTHX_ ob_id);
         if (trigger) {
-            AV* cont = HUF_get_trigger_content(trigger);
+            AV* cont = HUF_get_trigger_content(aTHX_ trigger);
             HV* field_tab = (HV*) *av_fetch(cont, 1, 0);
             HE* ent;
             hv_iterinit(field_tab);
@@ -458,6 +475,7 @@ CODE:
         counter = SvRV(countref);
         sv_setiv(counter, 0);
         HUF_add_uvar_magic(
+            aTHX_
             SvRV(svref),
             ix & 1 ? &HUF_inc_var : 0,
             ix & 2 ? &HUF_inc_var : 0,