From: Nicholas Clark Date: Sat, 19 Mar 2011 20:03:47 +0000 (+0000) Subject: Add PERL_NO_GET_CONTEXT to Hash::Util::FieldHash X-Git-Tag: accepted/trunk/20130322.191538~4908 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=4b6bf1741b5642667354adaf3bb957be8c0e1ef8;p=platform%2Fupstream%2Fperl.git Add PERL_NO_GET_CONTEXT to Hash::Util::FieldHash For threaded platforms, this reduces the object code size, and should slight reduce CPU usage. --- diff --git a/ext/Hash-Util-FieldHash/FieldHash.xs b/ext/Hash-Util-FieldHash/FieldHash.xs index c7df46b..e726041 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,