#include "ptable.h"
+#define ptable_hints_store(T, K, V) ptable_hints_store(aTHX_ (T), (K), (V))
+#define ptable_hints_free(T) ptable_hints_free(aTHX_ (T))
+
#define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
typedef struct {
}
}
- ptable_hints_store(aPTBL_ ud->tbl, ent->key, val);
+ ptable_hints_store(ud->tbl, ent->key, val);
SvREFCNT_inc(val);
}
STATIC void lt_thread_cleanup(pTHX_ void *ud) {
int *level = ud;
- SV *id;
if (*level) {
*level = 0;
} else {
dMY_CXT;
PerlMemShared_free(level);
- ptable_hints_free(aPTBL_ MY_CXT.tbl);
+ ptable_hints_free(MY_CXT.tbl);
}
}
-STATIC SV *lt_tag(pPTBL_ SV *value) {
-#define lt_tag(V) lt_tag(aPTBL_ (V))
+STATIC SV *lt_tag(pTHX_ SV *value) {
+#define lt_tag(V) lt_tag(aTHX_ (V))
dMY_CXT;
value = SvOK(value) && SvROK(value) ? SvRV(value) : NULL;
/* We only need for the key to be an unique tag for looking up the value later.
* Allocated memory provides convenient unique identifiers, so that's why we
* use the value pointer as the key itself. */
- ptable_hints_store(aPTBL_ MY_CXT.tbl, value, value);
+ ptable_hints_store(MY_CXT.tbl, value, value);
SvREFCNT_inc(value);
return newSVuv(PTR2UV(value));
STATIC SV *lt_hint(pTHX) {
#define lt_hint() lt_hint(aTHX)
- SV *id;
-#if LT_HAS_PERL(5, 10, 0)
- id = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
- NULL,
- __PACKAGE__, __PACKAGE_LEN__,
- 0,
- lt_hash);
+ SV *hint;
+#if LT_HAS_PERL(5, 9, 5)
+ hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
+ NULL,
+ __PACKAGE__, __PACKAGE_LEN__,
+ 0,
+ lt_hash);
#else
SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, lt_hash);
if (!val)
return 0;
- id = *val;
+ hint = *val;
#endif
- return (id && SvOK(id)) ? id : NULL;
+ return (hint && SvOK(hint)) ? hint : NULL;
}
/* ... op => info map ...................................................... */
+#define PTABLE_NAME ptable_map
#define PTABLE_VAL_FREE(V) PerlMemShared_free(V)
#include "ptable.h"
+/* PerlMemShared_free() needs the [ap]PTBLMS_? default values */
+#define ptable_map_store(T, K, V) ptable_map_store(aPTBLMS_ (T), (K), (V))
+
STATIC ptable *lt_op_map = NULL;
#ifdef USE_ITHREADS
OP *(*pp_padsv)(pTHX);
} lt_op_info;
-STATIC void lt_map_store(pPTBL_ const OP *o, SV *orig_pkg, SV *type_pkg, SV *type_meth, OP *(*pp_padsv)(pTHX)) {
-#define lt_map_store(O, OP, TP, TM, PP) lt_map_store(aPTBL_ (O), (OP), (TP), (TM), (PP))
+STATIC void lt_map_store(pPTBLMS_ const OP *o, SV *orig_pkg, SV *type_pkg, SV *type_meth, OP *(*pp_padsv)(pTHX)) {
+#define lt_map_store(O, OP, TP, TM, PP) lt_map_store(aPTBLMS_ (O), (OP), (TP), (TM), (PP))
lt_op_info *oi;
#ifdef USE_ITHREADS
if (!(oi = ptable_fetch(lt_op_map, o))) {
oi = PerlMemShared_malloc(sizeof *oi);
- ptable_store(aPTBL_ lt_op_map, o, oi);
+ ptable_map_store(lt_op_map, o, oi);
}
oi->orig_pkg = orig_pkg;
return val;
}
+STATIC void lt_map_delete(pTHX_ const OP *o) {
+#define lt_map_delete(O) lt_map_delete(aTHX_ (O))
+#ifdef USE_ITHREADS
+ MUTEX_LOCK(<_op_map_mutex);
+#endif
+
+ ptable_map_store(lt_op_map, o, NULL);
+
+#ifdef USE_ITHREADS
+ MUTEX_UNLOCK(<_op_map_mutex);
+#endif
+}
+
/* --- Hooks --------------------------------------------------------------- */
/* ... Our pp_padsv ........................................................ */
lt_pp_padsv_save();
lt_map_store(o, orig_pkg, type_pkg, type_meth, lt_pp_padsv_saved);
+ } else {
+skip:
+ lt_map_delete(o);
}
-skip:
return o;
}
STATIC OP *lt_ck_padsv(pTHX_ OP *o) {
lt_pp_padsv_restore(o);
+ lt_map_delete(o);
+
return CALL_FPTR(lt_old_ck_padsv)(aTHX_ o);
}