Merge op_pmreplstart and op_pmstash/op_pmstashpv into a union in

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 537322a..9d9494b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -384,7 +384,7 @@ Perl_allocmy(pTHX_ const char *const name)
 /* free the body of an op without examining its contents.
  * Always use this rather than FreeOp directly */
 
-void
+static void
 S_op_destroy(pTHX_ OP *o)
 {
     if (o->op_latefree) {
@@ -428,9 +428,13 @@ Perl_op_free(pTHX_ OP *o)
            OP_REFCNT_LOCK;
            refcnt = OpREFCNT_dec(o);
            OP_REFCNT_UNLOCK;
-           if (refcnt)
+           if (refcnt) {
+               /* Need to find and remove any pattern match ops from the list
+                  we maintain for reset().  */
+               find_and_forget_pmops(o);
                return;
            }
+           }
            break;
        default:
            break;
@@ -449,8 +453,12 @@ Perl_op_free(pTHX_ OP *o)
 
     /* COP* is not cleared by op_clear() so that we may track line
      * numbers etc even after null() */
-    if (type == OP_NEXTSTATE || type == OP_SETSTATE || type == OP_DBSTATE)
+    if (type == OP_NEXTSTATE || type == OP_SETSTATE || type == OP_DBSTATE) {
+#ifdef PERL_DEBUG_READONLY_OPS
+       Slab_to_rw(o);
+#endif
        cop_free((COP*)o);
+    }
 
     op_clear(o);
     if (o->op_latefree) {
@@ -577,28 +585,7 @@ Perl_op_clear(pTHX_ OP *o)
     case OP_MATCH:
     case OP_QR:
 clear_pmop:
-       {
-           HV * const pmstash = PmopSTASH(cPMOPo);
-           if (pmstash && !SvIS_FREED(pmstash)) {
-               MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
-               if (mg) {
-                   PMOP *pmop = (PMOP*) mg->mg_obj;
-                   PMOP *lastpmop = NULL;
-                   while (pmop) {
-                       if (cPMOPo == pmop) {
-                           if (lastpmop)
-                               lastpmop->op_pmnext = pmop->op_pmnext;
-                           else
-                               mg->mg_obj = (SV*) pmop->op_pmnext;
-                           break;
-                       }
-                       lastpmop = pmop;
-                       pmop = pmop->op_pmnext;
-                   }
-               }
-           }
-           PmopSTASH_free(cPMOPo);
-       }
+       forget_pmop(cPMOPo, 1);
        cPMOPo->op_pmreplroot = NULL;
         /* we use the "SAFE" version of the PM_ macros here
          * since sv_clean_all might release some PMOPs
@@ -637,6 +624,57 @@ S_cop_free(pTHX_ COP* cop)
     Perl_refcounted_he_free(aTHX_ cop->cop_hints_hash);
 }
 
+STATIC void
+S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
+{
+    HV * const pmstash = PmopSTASH(o);
+    if (pmstash && !SvIS_FREED(pmstash)) {
+       MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
+       if (mg) {
+           PMOP **const array = (PMOP**) mg->mg_ptr;
+           U32 count = mg->mg_len / sizeof(PMOP**);
+           U32 i = count;
+
+           while (i--) {
+               if (array[i] == o) {
+                   /* Found it. Move the entry at the end to overwrite it.  */
+                   array[i] = array[--count];
+                   mg->mg_len = count * sizeof(PMOP**);
+                   /* Could realloc smaller at this point always, but probably
+                      not worth it. Probably worth free()ing if we're the
+                      last.  */
+                   if(!count) {
+                       Safefree(mg->mg_ptr);
+                       mg->mg_ptr = NULL;
+                   }
+                   break;
+               }
+           }
+       }
+    }
+    if (flags)
+       PmopSTASH_free(o);
+}
+
+STATIC void
+S_find_and_forget_pmops(pTHX_ OP *o)
+{
+    if (o->op_flags & OPf_KIDS) {
+        OP *kid = cUNOPo->op_first;
+       while (kid) {
+           switch (kid->op_type) {
+           case OP_SUBST:
+           case OP_PUSHRE:
+           case OP_MATCH:
+           case OP_QR:
+               forget_pmop((PMOP*)kid, 0);
+           }
+           find_and_forget_pmops(kid);
+           kid = kid->op_sibling;
+       }
+    }
+}
+
 void
 Perl_op_null(pTHX_ OP *o)
 {
@@ -3288,18 +3326,6 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
     }
 #endif
 
-        /* link into pm list */
-    if (type != OP_TRANS && PL_curstash) {
-       MAGIC *mg = mg_find((SV*)PL_curstash, PERL_MAGIC_symtab);
-
-       if (!mg) {
-           mg = sv_magicext((SV*)PL_curstash, 0, PERL_MAGIC_symtab, 0, 0, 0);
-       }
-       pmop->op_pmnext = (PMOP*)mg->mg_obj;
-       mg->mg_obj = (SV*)pmop;
-       PmopSTASH_set(pmop,PL_curstash);
-    }
-
     return CHECKOP(type, pmop);
 }
 
@@ -3499,7 +3525,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
            repl->op_next = (OP*)rcop;
 
            pm->op_pmreplroot = scalar((OP*)rcop);
-           pm->op_pmreplstart = LINKLIST(rcop);
+           assert(!(pm->op_pmflags & PMf_ONCE));
+           pm->op_pmstashstartu.op_pmreplstart = LINKLIST(rcop);
            rcop->op_next = 0;
        }
     }
@@ -4791,8 +4818,7 @@ S_ref_array_or_hash(pTHX_ OP *cond)
    op_other if the match fails.)
  */
 
-STATIC
-OP *
+STATIC OP *
 S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
                   I32 enter_opcode, I32 leave_opcode,
                   PADOFFSET entertarg)
@@ -4846,8 +4872,7 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
    
    [*] possibly surprising
  */
-STATIC
-bool
+STATIC bool
 S_looks_like_bool(pTHX_ const OP *o)
 {
     dVAR;
@@ -8007,14 +8032,14 @@ Perl_peep(pTHX_ register OP *o)
            peep(cLOOP->op_lastop);
            break;
 
-       case OP_QR:
-       case OP_MATCH:
        case OP_SUBST:
            o->op_opt = 1;
-           while (cPMOP->op_pmreplstart &&
-                  cPMOP->op_pmreplstart->op_type == OP_NULL)
-               cPMOP->op_pmreplstart = cPMOP->op_pmreplstart->op_next;
-           peep(cPMOP->op_pmreplstart);
+           assert(!(cPMOP->op_pmflags & PMf_ONCE));
+           while (cPMOP->op_pmstashstartu.op_pmreplstart &&
+                  cPMOP->op_pmstashstartu.op_pmreplstart->op_type == OP_NULL)
+               cPMOP->op_pmstashstartu.op_pmreplstart
+                   = cPMOP->op_pmstashstartu.op_pmreplstart->op_next;
+           peep(cPMOP->op_pmstashstartu.op_pmreplstart);
            break;
 
        case OP_EXEC:
@@ -8403,6 +8428,12 @@ Perl_peep(pTHX_ register OP *o)
        }
 
        
+       case OP_QR:
+       case OP_MATCH:
+           if (!(cPMOP->op_pmflags & PMf_ONCE)) {
+               assert (!cPMOP->op_pmstashstartu.op_pmreplstart);
+           }
+           /* FALL THROUGH */
        default:
            o->op_opt = 1;
            break;