/* ... Thread safety and multiplicity ...................................... */
+/* Always safe when the workaround isn't needed */
+#if !A_WORKAROUND_REQUIRE_PROPAGATION
+# undef A_FORKSAFE
+# define A_FORKSAFE 1
+/* Otherwise, safe unless Makefile.PL says it's Win32 */
+#elif !defined(A_FORKSAFE)
+# define A_FORKSAFE 1
+#endif
+
#ifndef A_MULTIPLICITY
# if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT)
# define A_MULTIPLICITY 1
START_MY_CXT
-STATIC SV *a_clone(pTHX_ SV *sv, tTHX owner) {
-#define a_clone(S, O) a_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);
-}
+typedef struct {
+ ptable *tbl;
+#if A_HAS_PERL(5, 13, 2)
+ CLONE_PARAMS *params;
+#else
+ CLONE_PARAMS params;
+#endif
+} a_ptable_clone_ud;
+
+#if A_HAS_PERL(5, 13, 2)
+# define a_ptable_clone_ud_init(U, T, O) \
+ (U).tbl = (T); \
+ (U).params = Perl_clone_params_new((O), aTHX)
+# define a_ptable_clone_ud_deinit(U) Perl_clone_params_del((U).params)
+# define a_dup_inc(S, U) SvREFCNT_inc(sv_dup((S), (U)->params))
+#else
+# define a_ptable_clone_ud_init(U, T, O) \
+ (U).tbl = (T); \
+ (U).params.stashes = newAV(); \
+ (U).params.flags = 0; \
+ (U).params.proto_perl = (O)
+# define a_ptable_clone_ud_deinit(U) SvREFCNT_dec((U).params.stashes)
+# define a_dup_inc(S, U) SvREFCNT_inc(sv_dup((S), &((U)->params)))
+#endif
STATIC void a_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
- my_cxt_t *ud = ud_;
+ a_ptable_clone_ud *ud = ud_;
a_hint_t *h1 = ent->val;
a_hint_t *h2;
- if (ud->owner == aTHX)
- return;
-
h2 = PerlMemShared_malloc(sizeof *h2);
h2->bits = h1->bits;
- h2->require_tag = PTR2IV(a_clone(INT2PTR(SV *, h1->require_tag), ud->owner));
+ h2->require_tag = PTR2IV(a_dup_inc(INT2PTR(SV *, h1->require_tag), ud));
ptable_hints_store(ud->tbl, ent->key, h2);
}
-STATIC void a_thread_cleanup(pTHX_ void *);
+#include "reap.h"
STATIC void a_thread_cleanup(pTHX_ void *ud) {
- int *level = ud;
+ dMY_CXT;
- if (*level) {
- *level = 0;
- LEAVE;
- SAVEDESTRUCTOR_X(a_thread_cleanup, level);
- ENTER;
- } else {
- dMY_CXT;
- PerlMemShared_free(level);
- ptable_hints_free(MY_CXT.tbl);
- }
+ ptable_hints_free(MY_CXT.tbl);
}
#endif /* A_THREADSAFE */
STATIC ptable *a_op_map = NULL;
#ifdef USE_ITHREADS
+
+#define dA_MAP_THX a_op_info a_op_map_tmp_oi
+
STATIC perl_mutex a_op_map_mutex;
-#endif
STATIC const a_op_info *a_map_fetch(const OP *o, a_op_info *oi) {
const a_op_info *val;
-#ifdef USE_ITHREADS
MUTEX_LOCK(&a_op_map_mutex);
-#endif
val = ptable_fetch(a_op_map, o);
if (val) {
val = oi;
}
-#ifdef USE_ITHREADS
MUTEX_UNLOCK(&a_op_map_mutex);
-#endif
return val;
}
+#define a_map_fetch(O) a_map_fetch((O), &a_op_map_tmp_oi)
+
+#else /* USE_ITHREADS */
+
+#define dA_MAP_THX dNOOP
+
+#define a_map_fetch(O) ptable_fetch(a_op_map, (O))
+
+#endif /* !USE_ITHREADS */
+
STATIC const a_op_info *a_map_store_locked(pPTBLMS_ const OP *o, OP *(*old_pp)(pTHX), void *next, UV flags) {
#define a_map_store_locked(O, PP, N, F) a_map_store_locked(aPTBLMS_ (O), (PP), (N), (F))
a_op_info *oi;
/* ... Decide whether this expression should be autovivified or not ........ */
-STATIC UV a_map_resolve(const OP *o, a_op_info *oi) {
+STATIC UV a_map_resolve(const OP *o, const a_op_info *oi) {
UV flags = 0, rflags;
const OP *root;
- a_op_info *roi = oi;
+ const a_op_info *roi = oi;
while (!(roi->flags & A_HINT_ROOT))
roi = roi->next;
return oi->flags & A_HINT_ROOT ? 0 : flags;
}
-/* ... Lightweight pp_defined() ............................................ */
-
-STATIC bool a_defined(pTHX_ SV *sv) {
-#define a_defined(S) a_defined(aTHX_ (S))
- bool defined = FALSE;
+/* ... Inspired from pp_defined() .......................................... */
+STATIC int a_undef(pTHX_ SV *sv) {
+#define a_undef(S) a_undef(aTHX_ (S))
switch (SvTYPE(sv)) {
+ case SVt_NULL:
+ return 1;
case SVt_PVAV:
if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
|| (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
- defined = TRUE;
+ return 0;
break;
case SVt_PVHV:
if (HvARRAY(sv) || SvGMAGICAL(sv)
|| (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
- defined = TRUE;
+ return 0;
break;
default:
SvGETMAGIC(sv);
if (SvOK(sv))
- defined = TRUE;
+ return 0;
}
- return defined;
+ return 1;
}
/* --- PP functions -------------------------------------------------------- */
/* ... pp_rv2av ............................................................ */
STATIC OP *a_pp_rv2av(pTHX) {
- a_op_info oi;
- UV flags;
+ dA_MAP_THX;
+ const a_op_info *oi;
dSP;
- a_map_fetch(PL_op, &oi);
- flags = oi.flags;
+ oi = a_map_fetch(PL_op);
- if (flags & A_HINT_DEREF) {
- if (!a_defined(TOPs)) {
+ if (oi->flags & A_HINT_DEREF) {
+ if (a_undef(TOPs)) {
/* We always need to push an empty array to fool the pp_aelem() that comes
* later. */
SV *av;
RETURN;
}
} else {
- PL_op->op_ppaddr = oi.old_pp;
+ PL_op->op_ppaddr = oi->old_pp;
}
- return CALL_FPTR(oi.old_pp)(aTHX);
+ return oi->old_pp(aTHX);
}
/* ... pp_rv2hv ............................................................ */
STATIC OP *a_pp_rv2hv_simple(pTHX) {
- a_op_info oi;
- UV flags;
+ dA_MAP_THX;
+ const a_op_info *oi;
dSP;
- a_map_fetch(PL_op, &oi);
- flags = oi.flags;
+ oi = a_map_fetch(PL_op);
- if (flags & A_HINT_DEREF) {
- if (!a_defined(TOPs))
+ if (oi->flags & A_HINT_DEREF) {
+ if (a_undef(TOPs))
RETURN;
} else {
- PL_op->op_ppaddr = oi.old_pp;
+ PL_op->op_ppaddr = oi->old_pp;
}
- return CALL_FPTR(oi.old_pp)(aTHX);
+ return oi->old_pp(aTHX);
}
STATIC OP *a_pp_rv2hv(pTHX) {
- a_op_info oi;
- UV flags;
+ dA_MAP_THX;
+ const a_op_info *oi;
dSP;
- a_map_fetch(PL_op, &oi);
- flags = oi.flags;
+ oi = a_map_fetch(PL_op);
- if (flags & A_HINT_DEREF) {
- if (!a_defined(TOPs)) {
+ if (oi->flags & A_HINT_DEREF) {
+ if (a_undef(TOPs)) {
SV *hv;
POPs;
hv = sv_2mortal((SV *) newHV());
RETURN;
}
} else {
- PL_op->op_ppaddr = oi.old_pp;
+ PL_op->op_ppaddr = oi->old_pp;
}
- return CALL_FPTR(oi.old_pp)(aTHX);
+ return oi->old_pp(aTHX);
}
/* ... pp_deref (aelem,helem,rv2sv,padsv) .................................. */
STATIC OP *a_pp_deref(pTHX) {
- a_op_info oi;
+ dA_MAP_THX;
+ const a_op_info *oi;
UV flags;
dSP;
- a_map_fetch(PL_op, &oi);
- flags = oi.flags;
+ oi = a_map_fetch(PL_op);
+ flags = oi->flags;
if (flags & A_HINT_DEREF) {
OP *o;
deref:
old_private = PL_op->op_private;
PL_op->op_private = ((old_private & ~OPpDEREF) | OPpLVAL_DEFER);
- o = CALL_FPTR(oi.old_pp)(aTHX);
+ o = oi->old_pp(aTHX);
PL_op->op_private = old_private;
if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
SPAGAIN;
- if (!a_defined(TOPs)) {
+ if (a_undef(TOPs)) {
if (flags & A_HINT_STRICT)
croak("Reference vivification forbidden");
else if (flags & A_HINT_WARN)
&& (PL_op->op_private & OPpDEREF || flags & A_HINT_ROOT)) {
/* Decide if the expression must autovivify or not.
* This branch should be called only once by expression. */
- flags = a_map_resolve(PL_op, &oi);
+ flags = a_map_resolve(PL_op, oi);
/* We need the updated flags value in the deref branch. */
if (flags & A_HINT_DEREF)
/* This op doesn't need to skip autovivification, so restore the original
* state. */
- PL_op->op_ppaddr = oi.old_pp;
+ PL_op->op_ppaddr = oi->old_pp;
- return CALL_FPTR(oi.old_pp)(aTHX);
+ return oi->old_pp(aTHX);
}
/* ... pp_root (exists,delete,keys,values) ................................. */
STATIC OP *a_pp_root_unop(pTHX) {
- a_op_info oi;
dSP;
- if (!a_defined(TOPs)) {
+ if (a_undef(TOPs)) {
POPs;
/* Can only be reached by keys or values */
if (GIMME_V == G_SCALAR) {
RETURN;
}
- a_map_fetch(PL_op, &oi);
-
- return CALL_FPTR(oi.old_pp)(aTHX);
+ {
+ dA_MAP_THX;
+ const a_op_info *oi = a_map_fetch(PL_op);
+ return oi->old_pp(aTHX);
+ }
}
STATIC OP *a_pp_root_binop(pTHX) {
- a_op_info oi;
dSP;
- if (!a_defined(TOPm1s)) {
+ if (a_undef(TOPm1s)) {
POPs;
POPs;
if (PL_op->op_type == OP_EXISTS)
RETPUSHUNDEF;
}
- a_map_fetch(PL_op, &oi);
-
- return CALL_FPTR(oi.old_pp)(aTHX);
+ {
+ dA_MAP_THX;
+ const a_op_info *oi = a_map_fetch(PL_op);
+ return oi->old_pp(aTHX);
+ }
}
/* --- Check functions ----------------------------------------------------- */
STATIC void a_recheck_rv2xv(pTHX_ OP *o, OPCODE type, OP *(*new_pp)(pTHX)) {
#define a_recheck_rv2xv(O, T, PP) a_recheck_rv2xv(aTHX_ (O), (T), (PP))
- a_op_info oi;
if (o->op_type == type && o->op_ppaddr != new_pp
- && cUNOPo->op_first->op_type != OP_GV
- && a_map_fetch(o, &oi)) {
- a_map_store(o, o->op_ppaddr, oi.next, oi.flags);
- o->op_ppaddr = new_pp;
+ && cUNOPo->op_first->op_type != OP_GV) {
+ dA_MAP_THX;
+ const a_op_info *oi = a_map_fetch(o);
+ if (oi) {
+ a_map_store(o, o->op_ppaddr, oi->next, oi->flags);
+ o->op_ppaddr = new_pp;
+ }
}
return;
a_pp_padsv_restore(o);
- o = CALL_FPTR(a_old_ck_padany)(aTHX_ o);
+ o = a_old_ck_padany(aTHX_ o);
hint = a_hint();
if (hint & A_HINT_DO) {
a_pp_padsv_restore(o);
- o = CALL_FPTR(a_old_ck_padsv)(aTHX_ o);
+ o = a_old_ck_padsv(aTHX_ o);
hint = a_hint();
if (hint & A_HINT_DO) {
old_ck = a_old_ck_rv2sv;
break;
}
- o = CALL_FPTR(old_ck)(aTHX_ o);
+ o = old_ck(aTHX_ o);
if (hint & A_HINT_DO) {
a_map_store_root(o, o->op_ppaddr, hint);
case OP_RV2AV: old_ck = a_old_ck_rv2av; new_pp = a_pp_rv2av; break;
case OP_RV2HV: old_ck = a_old_ck_rv2hv; new_pp = a_pp_rv2hv_simple; break;
}
- o = CALL_FPTR(old_ck)(aTHX_ o);
+ o = old_ck(aTHX_ o);
if (cUNOPo->op_first->op_type == OP_GV)
return o;
a_recheck_rv2xv(cUNOPo->op_first->op_sibling, OP_RV2HV, a_pp_rv2hv);
break;
}
- o = CALL_FPTR(old_ck)(aTHX_ o);
+ o = old_ck(aTHX_ o);
if (hint & A_HINT_DO) {
a_map_store_root(o, 0, hint);
enabled = hint & A_HINT_FETCH;
break;
}
- o = CALL_FPTR(old_ck)(aTHX_ o);
+ o = old_ck(aTHX_ o);
if (hint & A_HINT_DO) {
if (enabled) {
STATIC U32 a_initialized = 0;
+STATIC void a_teardown(pTHX_ void *root) {
+
+ if (!a_initialized)
+ return;
+
+#if A_MULTIPLICITY
+ if (aTHX != root)
+ return;
+#endif
+
+#if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
+ {
+ dMY_CXT;
+ ptable_hints_free(MY_CXT.tbl);
+ }
+#endif
+
+ PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_old_ck_padany);
+ a_old_ck_padany = 0;
+ PL_check[OP_PADSV] = MEMBER_TO_FPTR(a_old_ck_padsv);
+ a_old_ck_padsv = 0;
+
+ PL_check[OP_AELEM] = MEMBER_TO_FPTR(a_old_ck_aelem);
+ a_old_ck_aelem = 0;
+ PL_check[OP_HELEM] = MEMBER_TO_FPTR(a_old_ck_helem);
+ a_old_ck_helem = 0;
+ PL_check[OP_RV2SV] = MEMBER_TO_FPTR(a_old_ck_rv2sv);
+ a_old_ck_rv2sv = 0;
+
+ PL_check[OP_RV2AV] = MEMBER_TO_FPTR(a_old_ck_rv2av);
+ a_old_ck_rv2av = 0;
+ PL_check[OP_RV2HV] = MEMBER_TO_FPTR(a_old_ck_rv2hv);
+ a_old_ck_rv2hv = 0;
+
+ PL_check[OP_ASLICE] = MEMBER_TO_FPTR(a_old_ck_aslice);
+ a_old_ck_aslice = 0;
+ PL_check[OP_HSLICE] = MEMBER_TO_FPTR(a_old_ck_hslice);
+ a_old_ck_hslice = 0;
+
+ PL_check[OP_EXISTS] = MEMBER_TO_FPTR(a_old_ck_exists);
+ a_old_ck_exists = 0;
+ PL_check[OP_DELETE] = MEMBER_TO_FPTR(a_old_ck_delete);
+ a_old_ck_delete = 0;
+ PL_check[OP_KEYS] = MEMBER_TO_FPTR(a_old_ck_keys);
+ a_old_ck_keys = 0;
+ PL_check[OP_VALUES] = MEMBER_TO_FPTR(a_old_ck_values);
+ a_old_ck_values = 0;
+
+ if (a_pp_padsv_saved) {
+ PL_ppaddr[OP_PADSV] = a_pp_padsv_saved;
+ a_pp_padsv_saved = 0;
+ }
+
+ a_initialized = 0;
+}
+
+STATIC void a_setup(pTHX) {
+#define a_setup() a_setup(aTHX)
+ if (a_initialized)
+ return;
+
+#if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
+ {
+ MY_CXT_INIT;
+ MY_CXT.tbl = ptable_new();
+ MY_CXT.owner = aTHX;
+ }
+#endif
+
+ a_old_ck_padany = PL_check[OP_PADANY];
+ PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_ck_padany);
+ a_old_ck_padsv = PL_check[OP_PADSV];
+ PL_check[OP_PADSV] = MEMBER_TO_FPTR(a_ck_padsv);
+
+ a_old_ck_aelem = PL_check[OP_AELEM];
+ PL_check[OP_AELEM] = MEMBER_TO_FPTR(a_ck_deref);
+ a_old_ck_helem = PL_check[OP_HELEM];
+ PL_check[OP_HELEM] = MEMBER_TO_FPTR(a_ck_deref);
+ a_old_ck_rv2sv = PL_check[OP_RV2SV];
+ PL_check[OP_RV2SV] = MEMBER_TO_FPTR(a_ck_deref);
+
+ a_old_ck_rv2av = PL_check[OP_RV2AV];
+ PL_check[OP_RV2AV] = MEMBER_TO_FPTR(a_ck_rv2xv);
+ a_old_ck_rv2hv = PL_check[OP_RV2HV];
+ PL_check[OP_RV2HV] = MEMBER_TO_FPTR(a_ck_rv2xv);
+
+ a_old_ck_aslice = PL_check[OP_ASLICE];
+ PL_check[OP_ASLICE] = MEMBER_TO_FPTR(a_ck_xslice);
+ a_old_ck_hslice = PL_check[OP_HSLICE];
+ PL_check[OP_HSLICE] = MEMBER_TO_FPTR(a_ck_xslice);
+
+ a_old_ck_exists = PL_check[OP_EXISTS];
+ PL_check[OP_EXISTS] = MEMBER_TO_FPTR(a_ck_root);
+ a_old_ck_delete = PL_check[OP_DELETE];
+ PL_check[OP_DELETE] = MEMBER_TO_FPTR(a_ck_root);
+ a_old_ck_keys = PL_check[OP_KEYS];
+ PL_check[OP_KEYS] = MEMBER_TO_FPTR(a_ck_root);
+ a_old_ck_values = PL_check[OP_VALUES];
+ PL_check[OP_VALUES] = MEMBER_TO_FPTR(a_ck_root);
+
+#if A_MULTIPLICITY
+ call_atexit(a_teardown, aTHX);
+#else
+ call_atexit(a_teardown, NULL);
+#endif
+
+ a_initialized = 1;
+}
+
+STATIC U32 a_booted = 0;
+
/* --- XS ------------------------------------------------------------------ */
MODULE = autovivification PACKAGE = autovivification
BOOT:
{
- if (!a_initialized++) {
+ if (!a_booted++) {
HV *stash;
-#if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
- MY_CXT_INIT;
- MY_CXT.tbl = ptable_new();
- MY_CXT.owner = aTHX;
-#endif
a_op_map = ptable_new();
#ifdef USE_ITHREADS
PERL_HASH(a_hash, __PACKAGE__, __PACKAGE_LEN__);
- a_old_ck_padany = PL_check[OP_PADANY];
- PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_ck_padany);
- a_old_ck_padsv = PL_check[OP_PADSV];
- PL_check[OP_PADSV] = MEMBER_TO_FPTR(a_ck_padsv);
-
- a_old_ck_aelem = PL_check[OP_AELEM];
- PL_check[OP_AELEM] = MEMBER_TO_FPTR(a_ck_deref);
- a_old_ck_helem = PL_check[OP_HELEM];
- PL_check[OP_HELEM] = MEMBER_TO_FPTR(a_ck_deref);
- a_old_ck_rv2sv = PL_check[OP_RV2SV];
- PL_check[OP_RV2SV] = MEMBER_TO_FPTR(a_ck_deref);
-
- a_old_ck_rv2av = PL_check[OP_RV2AV];
- PL_check[OP_RV2AV] = MEMBER_TO_FPTR(a_ck_rv2xv);
- a_old_ck_rv2hv = PL_check[OP_RV2HV];
- PL_check[OP_RV2HV] = MEMBER_TO_FPTR(a_ck_rv2xv);
-
- a_old_ck_aslice = PL_check[OP_ASLICE];
- PL_check[OP_ASLICE] = MEMBER_TO_FPTR(a_ck_xslice);
- a_old_ck_hslice = PL_check[OP_HSLICE];
- PL_check[OP_HSLICE] = MEMBER_TO_FPTR(a_ck_xslice);
-
- a_old_ck_exists = PL_check[OP_EXISTS];
- PL_check[OP_EXISTS] = MEMBER_TO_FPTR(a_ck_root);
- a_old_ck_delete = PL_check[OP_DELETE];
- PL_check[OP_DELETE] = MEMBER_TO_FPTR(a_ck_root);
- a_old_ck_keys = PL_check[OP_KEYS];
- PL_check[OP_KEYS] = MEMBER_TO_FPTR(a_ck_root);
- a_old_ck_values = PL_check[OP_VALUES];
- PL_check[OP_VALUES] = MEMBER_TO_FPTR(a_ck_root);
-
stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1);
newCONSTSUB(stash, "A_HINT_STRICT", newSVuv(A_HINT_STRICT));
newCONSTSUB(stash, "A_HINT_WARN", newSVuv(A_HINT_WARN));
newCONSTSUB(stash, "A_HINT_EXISTS", newSVuv(A_HINT_EXISTS));
newCONSTSUB(stash, "A_HINT_DELETE", newSVuv(A_HINT_DELETE));
newCONSTSUB(stash, "A_HINT_MASK", newSVuv(A_HINT_MASK));
+ newCONSTSUB(stash, "A_THREADSAFE", newSVuv(A_THREADSAFE));
+ newCONSTSUB(stash, "A_FORKSAFE", newSVuv(A_FORKSAFE));
}
+
+ a_setup();
}
#if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
PROTOTYPE: DISABLE
PREINIT:
ptable *t;
- int *level;
-CODE:
+PPCODE:
{
- my_cxt_t ud;
+ a_ptable_clone_ud ud;
dMY_CXT;
- ud.tbl = t = ptable_new();
- ud.owner = MY_CXT.owner;
+
+ t = ptable_new();
+ a_ptable_clone_ud_init(ud, t, MY_CXT.owner);
ptable_walk(MY_CXT.tbl, a_ptable_clone, &ud);
+ a_ptable_clone_ud_deinit(ud);
}
{
MY_CXT_CLONE;
MY_CXT.tbl = t;
MY_CXT.owner = aTHX;
}
- {
- level = PerlMemShared_malloc(sizeof *level);
- *level = 1;
- LEAVEn("sub");
- SAVEDESTRUCTOR_X(a_thread_cleanup, level);
- ENTERn("sub");
- }
+ reap(3, a_thread_cleanup, NULL);
+ XSRETURN(0);
#endif
projects / perl / modules / autovivification.git / blobdiff