Turn op_pmreplroot in struct pmop into a real union.
Nicholas Clark [Sat, 7 Apr 2007 12:15:40 +0000 (12:15 +0000)]
p4raw-id: //depot/perl@30865

dump.c
ext/B/B.xs
op.c
op.h
pp.c
pp_hot.c

diff --git a/dump.c b/dump.c
index 8a6c124..f3ebf4d 100644 (file)
--- 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");
     }
index 717dbf1..c09ddc3 100644 (file)
@@ -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 (file)
--- 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 (file)
--- 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 (file)
--- 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
index 9d0cf95..76a55cb 100644 (file)
--- 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 {