From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 7 Apr 2007 12:15:40 +0000 (+0000)
Subject: Turn op_pmreplroot in struct pmop into a real union.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=20e98b0f9ccd1237d697ca82b2dc40058ff7f30b;p=p5sagit%2Fp5-mst-13.2.git
Turn op_pmreplroot in struct pmop into a real union.
p4raw-id: //depot/perl@30865
---
diff --git a/dump.c b/dump.c
index 8a6c1248..f3ebf4d 100644
--- a/dump.c
+++ b/dump.c
@@ -538,9 +538,9 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
(pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
else
Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
- if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
+ if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
- op_dump(pm->op_pmreplroot);
+ op_dump(pm->op_pmreplrootu.op_pmreplroot);
}
if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
SV * const tmpsv = pm_description(pm);
@@ -2461,10 +2461,10 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
}
level--;
- if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
+ if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
Perl_xmldump_indent(aTHX_ level, file, ">\n");
Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
- do_op_xmldump(level+2, file, pm->op_pmreplroot);
+ do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
}
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 717dbf1..c09ddc3 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -487,7 +487,12 @@ walkoptree(pTHX_ SV *opsv, const char *method)
}
}
if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
- && (kid = cPMOPo->op_pmreplroot))
+#if PERL_VERSION >= 9
+ && (kid = cPMOPo->op_pmreplrootu.op_pmreplroot)
+#else
+ && (kid = cPMOPo->op_pmreplroot)
+#endif
+ )
{
sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
walkoptree(aTHX_ opsv, method);
@@ -981,7 +986,6 @@ LISTOP_children(o)
OUTPUT:
RETVAL
-#define PMOP_pmreplroot(o) o->op_pmreplroot
#if PERL_VERSION >= 9
# define PMOP_pmreplstart(o) o->op_pmstashstartu.op_pmreplstart
#else
@@ -999,6 +1003,8 @@ LISTOP_children(o)
MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
+#if PERL_VERSION <= 8
+
void
PMOP_pmreplroot(o)
B::PMOP o
@@ -1008,18 +1014,43 @@ PMOP_pmreplroot(o)
root = o->op_pmreplroot;
/* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
if (o->op_type == OP_PUSHRE) {
-#ifdef USE_ITHREADS
+# ifdef USE_ITHREADS
sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
-#else
+# else
sv_setiv(newSVrv(ST(0), root ?
svclassnames[SvTYPE((SV*)root)] : "B::SV"),
PTR2IV(root));
-#endif
+# endif
}
else {
sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
}
+#else
+
+void
+PMOP_pmreplroot(o)
+ B::PMOP o
+ CODE:
+ ST(0) = sv_newmortal();
+ if (o->op_type == OP_PUSHRE) {
+# ifdef USE_ITHREADS
+ sv_setiv(ST(0), o->op_pmreplrootu.op_pmtargetoff);
+# else
+ GV *const target = o->op_pmreplrootu.op_pmtargetgv;
+ sv_setiv(newSVrv(ST(0), target ?
+ svclassnames[SvTYPE((SV*)target)] : "B::SV"),
+ PTR2IV(target));
+# endif
+ }
+ else {
+ OP *const root = o->op_pmreplrootu.op_pmreplroot;
+ sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)),
+ PTR2IV(root));
+ }
+
+#endif
+
B::OP
PMOP_pmreplstart(o)
B::PMOP o
diff --git a/op.c b/op.c
index d457ea7..58dba8f 100644
--- a/op.c
+++ b/op.c
@@ -569,24 +569,24 @@ Perl_op_clear(pTHX_ OP *o)
}
break;
case OP_SUBST:
- op_free(cPMOPo->op_pmreplroot);
+ op_free(cPMOPo->op_pmreplrootu.op_pmreplroot);
goto clear_pmop;
case OP_PUSHRE:
#ifdef USE_ITHREADS
- if (INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot)) {
+ if (cPMOPo->op_pmreplrootu.op_pmtargetoff) {
/* No GvIN_PAD_off here, because other references may still
* exist on the pad */
- pad_swipe(INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot), TRUE);
+ pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE);
}
#else
- SvREFCNT_dec((SV*)cPMOPo->op_pmreplroot);
+ SvREFCNT_dec((SV*)cPMOPo->op_pmreplrootu.op_pmtargetgv);
#endif
/* FALL THROUGH */
case OP_MATCH:
case OP_QR:
clear_pmop:
forget_pmop(cPMOPo, 1);
- cPMOPo->op_pmreplroot = NULL;
+ cPMOPo->op_pmreplrootu.op_pmreplroot = NULL;
/* we use the "SAFE" version of the PM_ macros here
* since sv_clean_all might release some PMOPs
* after PL_regex_padav has been cleared
@@ -793,7 +793,7 @@ Perl_scalar(pTHX_ OP *o)
break;
case OP_SPLIT:
if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
- if (!kPMOP->op_pmreplroot)
+ if (!kPMOP->op_pmreplrootu.op_pmreplroot)
deprecate_old("implicit split to @_");
}
/* FALL THROUGH */
@@ -1088,7 +1088,7 @@ Perl_scalarvoid(pTHX_ OP *o)
return scalar(o);
case OP_SPLIT:
if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
- if (!kPMOP->op_pmreplroot)
+ if (!kPMOP->op_pmreplrootu.op_pmreplroot)
deprecate_old("implicit split to @_");
}
break;
@@ -3524,7 +3524,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
rcop->op_next = LINKLIST(repl);
repl->op_next = (OP*)rcop;
- pm->op_pmreplroot = scalar((OP*)rcop);
+ pm->op_pmreplrootu.op_pmreplroot = scalar((OP*)rcop);
assert(!(pm->op_pmflags & PMf_ONCE));
pm->op_pmstashstartu.op_pmreplstart = LINKLIST(rcop);
rcop->op_next = 0;
@@ -4007,19 +4007,24 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
break;
}
else if (curop->op_type == OP_PUSHRE) {
- if (((PMOP*)curop)->op_pmreplroot) {
#ifdef USE_ITHREADS
- GV *gv = (GV*)PAD_SVl(INT2PTR(PADOFFSET,
- ((PMOP*)curop)->op_pmreplroot));
-#else
- GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
-#endif
+ if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) {
+ GV *const gv = (GV*)PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff);
if (gv == PL_defgv
|| (int)GvASSIGN_GENERATION(gv) == PL_generation)
break;
GvASSIGN_GENERATION_set(gv, PL_generation);
+ }
+#else
+ GV *const gv
+ = ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv;
+ if (gv) {
+ if (gv == PL_defgv
+ || (int)GvASSIGN_GENERATION(gv) == PL_generation)
+ break;
GvASSIGN_GENERATION_set(gv, PL_generation);
}
+#endif
}
else
break;
@@ -4077,12 +4082,20 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
!(o->op_private & OPpASSIGN_COMMON) )
{
tmpop = ((UNOP*)left)->op_first;
- if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
+ if (tmpop->op_type == OP_GV
+#ifdef USE_ITHREADS
+ && !pm->op_pmreplrootu.op_pmtargetoff
+#else
+ && !pm->op_pmreplrootu.op_pmtargetgv
+#endif
+ ) {
#ifdef USE_ITHREADS
- pm->op_pmreplroot = INT2PTR(OP*, cPADOPx(tmpop)->op_padix);
+ pm->op_pmreplrootu.op_pmtargetoff
+ = cPADOPx(tmpop)->op_padix;
cPADOPx(tmpop)->op_padix = 0; /* steal it */
#else
- pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv;
+ pm->op_pmreplrootu.op_pmtargetgv
+ = (GV*)cSVOPx(tmpop)->op_sv;
cSVOPx(tmpop)->op_sv = NULL; /* steal it */
#endif
pm->op_pmflags |= PMf_ONCE;
diff --git a/op.h b/op.h
index 31bce2f..2141e2b 100644
--- a/op.h
+++ b/op.h
@@ -318,7 +318,6 @@ struct pmop {
BASEOP
OP * op_first;
OP * op_last;
- OP * op_pmreplroot; /* (type is really union {OP*,GV*,PADOFFSET}) */
#ifdef USE_ITHREADS
IV op_pmoffset;
#else
@@ -326,6 +325,14 @@ struct pmop {
#endif
U32 op_pmflags;
union {
+ OP * op_pmreplroot; /* For OP_SUBST */
+#ifdef USE_ITHREADS
+ PADOFFSET op_pmtargetoff; /* For OP_PUSHRE */
+#else
+ GV * op_pmtargetgv;
+#endif
+ } op_pmreplrootu;
+ union {
OP * op_pmreplstart; /* Only used in OP_SUBST */
#ifdef USE_ITHREADS
char * op_pmstashpv; /* Only used in OP_MATCH, with PMf_ONCE set */
diff --git a/pp.c b/pp.c
index bec9933..8d53497 100644
--- a/pp.c
+++ b/pp.c
@@ -4572,13 +4572,15 @@ PP(pp_split)
RX_MATCH_UTF8_set(rx, do_utf8);
- if (pm->op_pmreplroot) {
#ifdef USE_ITHREADS
- ary = GvAVn((GV*)PAD_SVl(INT2PTR(PADOFFSET, pm->op_pmreplroot)));
+ if (pm->op_pmreplrootu.op_pmtargetoff) {
+ ary = GvAVn((GV*)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
+ }
#else
- ary = GvAVn((GV*)pm->op_pmreplroot);
-#endif
+ if (pm->op_pmreplrootu.op_pmtargetgv) {
+ ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv);
}
+#endif
else if (gimme != G_ARRAY)
ary = GvAVn(PL_defgv);
else
diff --git a/pp_hot.c b/pp_hot.c
index 9d0cf95..76a55cb 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2261,7 +2261,7 @@ PP(pp_subst)
register PERL_CONTEXT *cx;
SPAGAIN;
PUSHSUBST(cx);
- RETURNOP(cPMOP->op_pmreplroot);
+ RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot);
}
r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
do {