# endif
#endif
+/* ... Our vivify_ref() .................................................... */
+
+/* Perl_vivify_ref() is not exported, so we have to reimplement it. */
+
+#if A_HAS_MULTIDEREF
+
+static SV *a_vivify_ref(pTHX_ SV *sv, int to_hash) {
+#define a_vivify_ref(S, TH) a_vivify_ref(aTHX_ (S), (TH))
+ SvGETMAGIC(sv);
+
+ if (!SvOK(sv)) {
+ SV *val;
+
+ if (SvREADONLY(sv))
+ Perl_croak_no_modify();
+
+ /* Inlined prepare_SV_for_RV() */
+ if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) {
+ sv_upgrade(sv, SVt_IV);
+ } else if (SvTYPE(sv) >= SVt_PV) {
+ SvPV_free(sv);
+ SvLEN_set(sv, 0);
+ SvCUR_set(sv, 0);
+ }
+
+ val = to_hash ? MUTABLE_SV(newHV()) : MUTABLE_SV(newAV());
+ SvRV_set(sv, val);
+ SvROK_on(sv);
+ SvSETMAGIC(sv);
+ SvGETMAGIC(sv);
+ }
+
+ if (SvGMAGICAL(sv)) {
+ SV *msv = sv_newmortal();
+ sv_setsv_nomg(msv, sv);
+ return msv;
+ }
+
+ return sv;
+}
+
+#endif /* A_HAS_MULTIDEREF */
+
/* ... Thread safety and multiplicity ...................................... */
/* Always safe when the workaround isn't needed */
/* PerlMemShared_free() needs the [ap]PTBLMS_? default values */
#define ptable_map_store(T, K, V) ptable_map_store(aPTBLMS_ (T), (K), (V))
#define ptable_map_delete(T, K) ptable_map_delete(aPTBLMS_ (T), (K))
+#define ptable_map_free(T) ptable_map_free(aPTBLMS_ (T))
static ptable *a_op_map = NULL;
if (a_undef(sv))
goto ret_undef;
do_AV_vivify_rv2av_aelem:
- sv = Perl_vivify_ref(aTHX_ sv, OPpDEREF_AV);
+ sv = a_vivify_ref(sv, 0);
do_AV_rv2av_aelem:
sv = a_do_pp_rv2av(sv);
do_AV_aelem:
if (a_undef(sv))
goto ret_undef;
do_HV_vivify_rv2hv_helem:
- sv = Perl_vivify_ref(aTHX_ sv, OPpDEREF_HV);
+ sv = a_vivify_ref(sv, 1);
do_HV_rv2hv_helem:
sv = a_do_pp_rv2hv(sv);
do_HV_helem:
break;
case A_HINT_STORE:
sv = a_do_pp_hfetch_lv(sv, key);
- break;
+ break;
case A_HINT_EXISTS:
sv = a_do_pp_hexists(sv, key);
break;
}
o = old_ck(aTHX_ o);
- if (hint & A_HINT_DO) {
#if A_HAS_MULTIDEREF
- if (old_ck == a_old_ck_rv2sv && o->op_flags & OPf_KIDS) {
- OP *kid = cUNOPo->op_first;
- if (kid && kid->op_type == OP_GV)
+ if (old_ck == a_old_ck_rv2sv && o->op_flags & OPf_KIDS) {
+ OP *kid = cUNOPo->op_first;
+ if (kid && kid->op_type == OP_GV) {
+ if (hint & A_HINT_DO)
a_map_store(kid, kid->op_ppaddr, NULL, hint);
+ else
+ a_map_delete(kid);
}
+ }
#endif
+
+ if (hint & A_HINT_DO) {
a_map_store_root(o, o->op_ppaddr, hint);
o->op_ppaddr = a_pp_deref;
} else
ptable_map_free(a_op_map);
a_op_map = NULL;
+
+#ifdef USE_ITHREADS
+ MUTEX_DESTROY(&a_op_map_mutex);
+#endif
}
A_LOADED_UNLOCK;
PERL_HASH(a_hash, __PACKAGE__, __PACKAGE_LEN__);
a_op_map = ptable_new();
+
#ifdef USE_ITHREADS
MUTEX_INIT(&a_op_map_mutex);
#endif