#define A_HINT_WARN 2
#define A_HINT_FETCH 4
#define A_HINT_STORE 8
-#define A_HINT_EXISTS 16
-#define A_HINT_DELETE 32
+#define A_HINT_KEYS 16
+#define A_HINT_VALUES 32
+#define A_HINT_EXISTS 64
+#define A_HINT_DELETE 128
#define A_HINT_NOTIFY (A_HINT_STRICT|A_HINT_WARN)
-#define A_HINT_DO (A_HINT_FETCH|A_HINT_STORE|A_HINT_EXISTS|A_HINT_DELETE)
+#define A_HINT_DO (A_HINT_FETCH|A_HINT_STORE|A_HINT_KEYS|A_HINT_VALUES|A_HINT_EXISTS|A_HINT_DELETE)
#define A_HINT_MASK (A_HINT_NOTIFY|A_HINT_DO)
/* Only used in op flags */
-#define A_HINT_ROOT 64
-#define A_HINT_DEREF 128
+#define A_HINT_ROOT 256
+#define A_HINT_SECOND 512
+#define A_HINT_DEREF 1024
#define XSH_HINTS_TYPE_UV 1
# define A_HAS_MULTIDEREF XSH_HAS_PERL(5, 21, 7)
#endif
+#ifndef A_HAS_SCALARKEYS_OPT
+# define A_HAS_SCALARKEYS_OPT XSH_HAS_PERL(5, 27, 3)
+#endif
+
/* ... Our vivify_ref() .................................................... */
/* Perl_vivify_ref() is not exported, so we have to reimplement it. */
} a_op_info;
#define PTABLE_NAME ptable_map
-#define PTABLE_VAL_FREE(V) PerlMemShared_free(V)
+#define PTABLE_VAL_FREE(V) XSH_SHARED_FREE((V), 1, a_op_info)
#define PTABLE_VAL_NEED_CONTEXT 0
#define PTABLE_NEED_DELETE 1
#define PTABLE_NEED_WALK 0
a_op_info *oi;
if (!(oi = ptable_fetch(a_op_map, o))) {
- oi = PerlMemShared_malloc(sizeof *oi);
+ XSH_SHARED_ALLOC(oi, 1, a_op_info);
ptable_map_store(a_op_map, o, oi);
}
return;
}
-static void a_map_update_flags_topdown(const OP *root, UV flags) {
+static void a_map_update_flags_topdown(const OP *root, UV mask, UV flags) {
a_op_info *oi;
const OP *o = root;
XSH_LOCK(&a_op_map_mutex);
- flags &= ~A_HINT_ROOT;
+ mask |= A_HINT_ROOT;
+ flags &= ~mask;
do {
if ((oi = ptable_fetch(a_op_map, o)))
- oi->flags = (oi->flags & A_HINT_ROOT) | flags;
+ oi->flags = (oi->flags & mask) | flags;
if (!(o->op_flags & OPf_KIDS))
break;
o = a_map_descend(o);
return;
}
-#define a_map_cancel(R) a_map_update_flags_topdown((R), 0)
-
static void a_map_update_flags_bottomup(const OP *o, UV flags, UV rflags) {
a_op_info *oi;
if (root->op_flags & OPf_MOD) {
if (rflags & A_HINT_STORE)
flags = (A_HINT_STORE|A_HINT_DEREF);
- } else if (rflags & A_HINT_FETCH)
- flags = (A_HINT_FETCH|A_HINT_DEREF);
+ } else {
+ if (rflags & (A_HINT_FETCH|A_HINT_KEYS|A_HINT_VALUES))
+ flags = (rflags|A_HINT_DEREF);
+ }
if (!flags) {
cancel:
return oi->old_pp(aTHX);
}
+#if A_HAS_SCALARKEYS_OPT
+
+static OP *a_pp_rv2hv_dokeys(pTHX) {
+ dA_MAP_THX;
+ const a_op_info *oi;
+ dSP;
+
+ oi = a_map_fetch(PL_op);
+
+ if (oi->flags & A_HINT_KEYS) {
+ if (a_undef(TOPs)) {
+ dTARGET;
+ (void) POPs;
+ PUSHi(0);
+ RETURN;
+ }
+ }
+
+ return oi->old_pp(aTHX);
+}
+
+#endif
+
/* ... pp_deref (aelem,helem,rv2sv,padsv) .................................. */
static void a_cannot_vivify(pTHX_ UV flags) {
static OP *a_ck_root(pTHX_ OP *o) {
OP * (*old_ck)(pTHX_ OP *o) = 0;
OP * (*new_pp)(pTHX) = 0;
- bool enabled = FALSE;
+ int enabled = 0;
UV hint = a_hint();
switch (o->op_type) {
case OP_KEYS:
old_ck = a_old_ck_keys;
new_pp = a_pp_root_unop;
- enabled = hint & A_HINT_FETCH;
+ enabled = hint & A_HINT_KEYS;
break;
case OP_VALUES:
old_ck = a_old_ck_values;
new_pp = a_pp_root_unop;
- enabled = hint & A_HINT_FETCH;
+ enabled = hint & A_HINT_VALUES;
break;
}
o = old_ck(aTHX_ o);
if (hint & A_HINT_DO) {
if (enabled) {
- a_map_update_flags_topdown(o, hint | A_HINT_DEREF);
+#if A_HAS_SCALARKEYS_OPT
+ if ((enabled == A_HINT_KEYS) && (o->op_flags & OPf_KIDS)) {
+ OP *kid = cUNOPo->op_first;
+ if (kid->op_type == OP_RV2HV) {
+ dA_MAP_THX;
+ const a_op_info *koi = a_map_fetch(kid);
+ a_map_store(kid, koi ? koi->old_pp : kid->op_ppaddr, NULL,
+ hint | A_HINT_SECOND);
+ if (!koi)
+ kid->op_ppaddr = a_pp_rv2hv;
+ }
+ }
+#endif
+ a_map_update_flags_topdown(o, A_HINT_SECOND, hint | A_HINT_DEREF);
a_map_store_root(o, o->op_ppaddr, hint);
o->op_ppaddr = new_pp;
} else {
- a_map_cancel(o);
+ a_map_update_flags_topdown(o, 0, 0);
}
} else
a_map_delete(o);
o->op_ppaddr = oi->old_pp;
break;
case OP_RV2AV:
- case OP_RV2HV:
- if ( o->op_ppaddr != a_pp_rv2av
- && o->op_ppaddr != a_pp_rv2hv
- && o->op_ppaddr != a_pp_rv2hv_simple)
+ if (o->op_ppaddr != a_pp_rv2av)
break;
oi = a_map_fetch(o);
if (!oi)
break;
if (!(oi->flags & A_HINT_DEREF))
- o->op_ppaddr = oi->old_pp;
+ o->op_ppaddr = oi->old_pp;
+ break;
+ case OP_RV2HV:
+ if (o->op_ppaddr != a_pp_rv2hv && o->op_ppaddr != a_pp_rv2hv_simple)
+ break;
+ oi = a_map_fetch(o);
+ if (!oi)
+ break;
+ if (!(oi->flags & A_HINT_DEREF)) {
+ o->op_ppaddr = oi->old_pp;
+ break;
+ }
+#if A_HAS_SCALARKEYS_OPT
+ flags = oi->flags;
+ if ((flags & A_HINT_KEYS) && (flags & A_HINT_SECOND)) {
+ U8 want = o->op_flags & OPf_WANT;
+ if (want == OPf_WANT_VOID || want == OPf_WANT_SCALAR)
+ o->op_ppaddr = a_pp_rv2hv_dokeys;
+ else if (oi->old_pp == a_pp_rv2hv || oi->old_pp == a_pp_rv2hv_simple)
+ o->op_ppaddr = oi->old_pp;
+ }
+#endif
break;
#if A_HAS_MULTIDEREF
case OP_MULTIDEREF:
newCONSTSUB(stash, "A_HINT_WARN", newSVuv(A_HINT_WARN));
newCONSTSUB(stash, "A_HINT_FETCH", newSVuv(A_HINT_FETCH));
newCONSTSUB(stash, "A_HINT_STORE", newSVuv(A_HINT_STORE));
+ newCONSTSUB(stash, "A_HINT_KEYS", newSVuv(A_HINT_KEYS));
+ newCONSTSUB(stash, "A_HINT_VALUES", newSVuv(A_HINT_VALUES));
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));