-/* If any of those are true, we need to store the hint in a global table. */
-
-#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION
-
-typedef struct {
- SV *code;
-#if I_WORKAROUND_REQUIRE_PROPAGATION
- I32 requires;
-#endif
-} indirect_hint_t;
-
-#define PTABLE_NAME ptable_hints
-
-#define PTABLE_VAL_FREE(V) \
- { indirect_hint_t *h = (V); SvREFCNT_dec(h->code); PerlMemShared_free(h); }
-
-#define pPTBL pTHX
-#define pPTBL_ pTHX_
-#define aPTBL aTHX
-#define aPTBL_ aTHX_
-
-#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))
-
-#endif /* I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION */
-
-/* Define the op->str ptable here because we need to be able to clean it during
- * thread cleanup. */
-
-typedef struct {
- const char *pos;
- char *buf;
- STRLEN len, size;
- line_t line;
-} indirect_op_info_t;
-
-#define PTABLE_NAME ptable
-#define PTABLE_VAL_FREE(V) if (V) { Safefree(((indirect_op_info_t *) (V))->buf); Safefree(V); }
-
-#define pPTBL pTHX
-#define pPTBL_ pTHX_
-#define aPTBL aTHX
-#define aPTBL_ aTHX_
-
-#include "ptable.h"
-
-#define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V))
-#define ptable_clear(T) ptable_clear(aTHX_ (T))
-#define ptable_free(T) ptable_free(aTHX_ (T))
-
-#define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
-
-typedef struct {
-#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION
- ptable *tbl; /* It really is a ptable_hints */
-#endif
- ptable *map;
- const char *linestr;
-#if I_THREADSAFE
- tTHX owner;
-#endif
-} my_cxt_t;
-
-START_MY_CXT
-
-#if I_THREADSAFE
-
-STATIC SV *indirect_clone(pTHX_ SV *sv, tTHX owner) {
-#define indirect_clone(S, O) indirect_clone(aTHX_ (S), (O))
- CLONE_PARAMS param;
- AV *stashes = NULL;
- SV *dupsv;
-
- if (SvTYPE(sv) == SVt_PVHV && HvNAME_get(sv))
- stashes = newAV();
-
- param.stashes = stashes;
- param.flags = 0;
- param.proto_perl = owner;
-
- dupsv = sv_dup(sv, ¶m);
-
- if (stashes) {
- av_undef(stashes);
- SvREFCNT_dec(stashes);
- }
-
- return SvREFCNT_inc(dupsv);
-}
-
-STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
- my_cxt_t *ud = ud_;
- indirect_hint_t *h1 = ent->val;
- indirect_hint_t *h2 = PerlMemShared_malloc(sizeof *h2);
-
- *h2 = *h1;
-
- if (ud->owner != aTHX)
- h2->code = indirect_clone(h1->code, ud->owner);
-
- ptable_hints_store(ud->tbl, ent->key, h2);
- SvREFCNT_inc(h2->code);
-}
-
-STATIC void indirect_thread_cleanup(pTHX_ void *);
-
-STATIC void indirect_thread_cleanup(pTHX_ void *ud) {
- int *level = ud;
-
- if (*level) {
- *level = 0;
- LEAVE;
- SAVEDESTRUCTOR_X(indirect_thread_cleanup, level);
- ENTER;
- } else {
- dMY_CXT;
- PerlMemShared_free(level);
- ptable_free(MY_CXT.map);
- ptable_hints_free(MY_CXT.tbl);
- }
-}
-
-#endif /* I_THREADSAFE */
-
-#if I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION
-
-STATIC SV *indirect_tag(pTHX_ SV *value) {
-#define indirect_tag(V) indirect_tag(aTHX_ (V))
- indirect_hint_t *h;
- SV *code = NULL;
- dMY_CXT;
-
- if (SvROK(value)) {
- value = SvRV(value);
- if (SvTYPE(value) >= SVt_PVCV) {
- code = value;
- if (CvANON(code) && !CvCLONED(code))
- CvCLONE_on(code);
- SvREFCNT_inc_simple_NN(code);
- }