The hint in a_hint() need not to be const

[perl/modules/autovivification.git] / autovivification.xs

diff --git a/autovivification.xs b/autovivification.xs
index a2377592246a4b41e7fa013e6e3e199410de863b..a71eb6430923c99f7c7ca0521294065eca1193cd 100644 (file)
--- a/autovivification.xs
+++ b/autovivification.xs
@@ -21,66 +21,73 @@
 
 #if A_WORKAROUND_REQUIRE_PROPAGATION
 
-typedef struct {
- UV  bits;
- I32 requires;
-} a_hint_t;
+#define A_ENCODE_UV(B, U)   \
+ len = 0;                   \
+ while (len < sizeof(UV)) { \
+  (B)[len++] = (U) & 0xFF;  \
+  (U) >>= 8;                \
+ }
+
+#define A_DECODE_UV(U, B)        \
+ len = sizeof(UV);               \
+ while (len > 0)                 \
+  (U) = ((U) << 8) | (B)[--len];
 
 STATIC SV *a_tag(pTHX_ UV bits) {
 #define a_tag(B) a_tag(aTHX_ (B))
- SV *tag;
- a_hint_t h;
-
- h.bits = bits;
-
- {
-  const PERL_SI *si;
-  I32            requires = 0;
+ SV            *hint;
+ const PERL_SI *si;
+ UV             requires = 0;
+ unsigned char  buf[sizeof(UV) * 2];
+ STRLEN         len;
 
-  for (si = PL_curstackinfo; si; si = si->si_prev) {
-   I32 cxix;
+ for (si = PL_curstackinfo; si; si = si->si_prev) {
+  I32 cxix;
 
-   for (cxix = si->si_cxix; cxix >= 0; --cxix) {
-    const PERL_CONTEXT *cx = si->si_cxstack + cxix;
+  for (cxix = si->si_cxix; cxix >= 0; --cxix) {
+   const PERL_CONTEXT *cx = si->si_cxstack + cxix;
 
-    if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
-     ++requires;
-   }
+   if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
+    ++requires;
   }
-
-  h.requires = requires;
  }
 
- return newSVpvn((const char *) &h, sizeof h);
+ A_ENCODE_UV(buf,              requires);
+ A_ENCODE_UV(buf + sizeof(UV), bits);
+ hint = newSVpvn(buf, sizeof buf);
+ SvREADONLY_on(hint);
+
+ return hint;
 }
 
 STATIC UV a_detag(pTHX_ const SV *hint) {
 #define a_detag(H) a_detag(aTHX_ (H))
- const a_hint_t *h;
+ const PERL_SI *si;
+ UV             requires = 0, requires_max = 0, bits = 0;
+ unsigned char *buf;
+ STRLEN         len;
 
  if (!(hint && SvOK(hint)))
   return 0;
 
- h = (const a_hint_t *) SvPVX(hint);
-
- {
-  const PERL_SI *si;
-  I32            requires = 0;
+ buf = SvPVX(hint);
+ A_DECODE_UV(requires_max, buf);
 
-  for (si = PL_curstackinfo; si; si = si->si_prev) {
-   I32 cxix;
+ for (si = PL_curstackinfo; si; si = si->si_prev) {
+  I32 cxix;
 
-   for (cxix = si->si_cxix; cxix >= 0; --cxix) {
-    const PERL_CONTEXT *cx = si->si_cxstack + cxix;
+  for (cxix = si->si_cxix; cxix >= 0; --cxix) {
+   const PERL_CONTEXT *cx = si->si_cxstack + cxix;
 
-    if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE
-                               && ++requires > h->requires)
-     return 0;
-   }
+   if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE
+                              && ++requires > requires_max)
+    return 0;
   }
  }
 
- return h->bits;
+ A_DECODE_UV(bits, buf + sizeof(UV));
+
+ return bits;
 }
 
 #else /* A_WORKAROUND_REQUIRE_PROPAGATION */
@@ -108,7 +115,7 @@ STATIC U32 a_hash = 0;
 
 STATIC UV a_hint(pTHX) {
 #define a_hint() a_hint(aTHX)
- const SV *hint;
+ SV *hint;
 #if A_HAS_PERL(5, 9, 5)
  hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
                                        NULL,
@@ -272,7 +279,9 @@ STATIC OP *a_pp_rv2av(pTHX) {
 
  a_map_fetch(PL_op, &oi);
 
- if (PL_op != oi.root && !SvOK(TOPs)) {
+ if (PL_op == oi.root) { /* This means "@$arrayref" */
+  PL_op->op_ppaddr = oi.old_pp;
+ } else if (!SvOK(TOPs)) {
   /* We always need to push an empty array to fool the pp_aelem() that comes
    * later. */
   SV *av;
@@ -294,13 +303,9 @@ STATIC OP *a_pp_rv2hv(pTHX) {
 
  a_map_fetch(PL_op, &oi);
 
- if (PL_op != oi.root && !SvOK(TOPs)) {
-  if (oi.root->op_flags & OPf_MOD) {
-   SV *hv;
-   POPs;
-   hv = sv_2mortal((SV *) newHV());
-   PUSHs(hv);
-  }
+ if (PL_op == oi.root) { /* This means "%$hashref" */
+  PL_op->op_ppaddr = oi.old_pp;
+ } else if (!SvOK(TOPs)) {
   RETURN;
  }
 
@@ -343,11 +348,11 @@ deref:
  } else if (flags && (PL_op->op_private & OPpDEREF || PL_op == oi.root)) {
   oi.flags = flags & A_HINT_NOTIFY;
 
-  if ((oi.root->op_flags & (OPf_MOD|OPf_REF)) != (OPf_MOD|OPf_REF)) {
-   if (flags & A_HINT_FETCH)
-    oi.flags |= (A_HINT_FETCH|A_HINT_DEREF);
-  } else if (flags & A_HINT_STORE)
+  if (oi.root->op_flags & OPf_MOD) {
+   if (flags & A_HINT_STORE)
     oi.flags |= (A_HINT_STORE|A_HINT_DEREF);
+  } else if (flags & A_HINT_FETCH)
+    oi.flags |= (A_HINT_FETCH|A_HINT_DEREF);
 
   if (PL_op == oi.root)
    oi.flags &= ~A_HINT_DEREF;