# define SvPVX_const SvPVX
#endif
+#ifndef SvREFCNT_inc_simple_NN
+# define SvREFCNT_inc_simple_NN SvREFCNT_inc
+#endif
+
#ifndef sv_catpvn_nomg
# define sv_catpvn_nomg sv_catpvn
#endif
STATIC SV *indirect_tag(pTHX_ SV *value) {
#define indirect_tag(V) indirect_tag(aTHX_ (V))
indirect_hint_t *h;
+ SV *code = NULL;
dMY_CXT;
- value = SvOK(value) && SvROK(value) ? SvRV(value) : NULL;
+ 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);
+ }
+ }
h = PerlMemShared_malloc(sizeof *h);
- h->code = SvREFCNT_inc(value);
+ h->code = code;
#if I_WORKAROUND_REQUIRE_PROPAGATION
{
/* We only need for the key to be an unique tag for looking up the value later.
* Allocated memory provides convenient unique identifiers, so that's why we
- * use the value pointer as the key itself. */
- ptable_hints_store(MY_CXT.tbl, value, h);
+ * use the hint as the key itself. */
+ ptable_hints_store(MY_CXT.tbl, h, h);
- return newSVuv(PTR2UV(value));
+ return newSViv(PTR2IV(h));
}
STATIC SV *indirect_detag(pTHX_ const SV *hint) {
indirect_hint_t *h;
dMY_CXT;
- if (!(hint && SvOK(hint) && SvIOK(hint)))
+ if (!(hint && SvIOK(hint)))
return NULL;
- h = ptable_fetch(MY_CXT.tbl, INT2PTR(void *, SvUVX(hint)));
+ h = ptable_fetch(MY_CXT.tbl, INT2PTR(void *, SvIVX(hint)));
#if I_WORKAROUND_REQUIRE_PROPAGATION
{
#define indirect_tag(V) indirect_tag(aTHX_ (V))
UV tag = 0;
- if (SvOK(value) && SvROK(value)) {
+ if (SvROK(value)) {
value = SvRV(value);
- SvREFCNT_inc(value);
- tag = PTR2UV(value);
+ SvREFCNT_inc_simple_NN(value);
+ tag = PTR2IV(value);
}
- return newSVuv(tag);
+ return newSViv(tag);
}
-#define indirect_detag(H) (((H) && SvOK(H)) ? INT2PTR(SV *, SvUVX(H)) : NULL)
+#define indirect_detag(H) (((H) && SvIOK(H)) ? INT2PTR(SV *, SvIVX(H)) : NULL)
#endif /* I_THREADSAFE || I_WORKAROUND_REQUIRE_PROPAGATION */
STATIC SV *indirect_hint(pTHX) {
#define indirect_hint() indirect_hint(aTHX)
SV *hint;
+
+ if (IN_PERL_RUNTIME)
+ return NULL;
+
#if I_HAS_PERL(5, 9, 5)
hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
NULL,
0,
indirect_hash);
#else
- SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__,
+ {
+ SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__,
indirect_hash);
- if (!val)
- return 0;
- hint = *val;
+ if (!val)
+ return 0;
+ hint = *val;
+ }
#endif
return indirect_detag(hint);
}
oi->size = 0;
}
- s = SvPV_const(sv, len);
+ if (sv) {
+ s = SvPV_const(sv, len);
+ } else {
+ s = "{";
+ len = 1;
+ }
+
if (len > oi->size) {
Safefree(oi->buf);
Newx(oi->buf, len, char);
oi->size = len;
}
Copy(s, oi->buf, len, char);
+
oi->len = len;
oi->pos = src;
oi->line = line;
return o;
}
+/* ... ck_scope ............................................................ */
+
+STATIC OP *(*indirect_old_ck_scope) (pTHX_ OP *) = 0;
+STATIC OP *(*indirect_old_ck_lineseq)(pTHX_ OP *) = 0;
+
+STATIC OP *indirect_ck_scope(pTHX_ OP *o) {
+ OP *(*old_ck)(pTHX_ OP *) = 0;
+
+ switch (o->op_type) {
+ case OP_SCOPE: old_ck = indirect_old_ck_scope; break;
+ case OP_LINESEQ: old_ck = indirect_old_ck_lineseq; break;
+ }
+ o = CALL_FPTR(old_ck)(aTHX_ o);
+
+ if (indirect_hint()) {
+ indirect_map_store(o, PL_oldbufptr, NULL, CopLINE(&PL_compiling));
+ return o;
+ }
+
+ indirect_map_delete(o);
+ return o;
+}
+
+/* We don't need to clean the map entries for leave ops because they can only
+ * be created by mutating from a lineseq. */
+
/* ... ck_method ........................................................... */
STATIC OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0;
/* ... ck_entersub ......................................................... */
+STATIC int indirect_is_indirect(const indirect_op_info_t *moi, const indirect_op_info_t *ooi) {
+ if (moi->pos > ooi->pos)
+ return 0;
+
+ if (moi->pos == ooi->pos)
+ return moi->len == ooi->len && !memcmp(moi->buf, ooi->buf, moi->len);
+
+ return 1;
+}
+
STATIC OP *(*indirect_old_ck_entersub)(pTHX_ OP *) = 0;
STATIC OP *indirect_ck_entersub(pTHX_ OP *o) {
case OP_CONST:
case OP_RV2SV:
case OP_PADSV:
+ case OP_SCOPE:
+ case OP_LEAVE:
break;
default:
goto done;
if (!(ooi && ooi->pos))
goto done;
- if (moi->pos < ooi->pos) {
+ if (indirect_is_indirect(moi, ooi)) {
SV *file;
dSP;
PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_ck_rv2sv);
indirect_old_ck_padany = PL_check[OP_PADANY];
PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_ck_padany);
+ indirect_old_ck_scope = PL_check[OP_SCOPE];
+ PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_ck_scope);
+ indirect_old_ck_lineseq = PL_check[OP_LINESEQ];
+ PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_ck_scope);
+
indirect_old_ck_method = PL_check[OP_METHOD];
PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_ck_method);
indirect_old_ck_entersub = PL_check[OP_ENTERSUB];