Remove op_pmnext from PMOPs, and instead store the list for reset as

an array hanging from the mg_ptr of the symbol table magic.
(Previously the linked list head was in the mg_obj member)

p4raw-id: //depot/perl@30853

diff --git a/embed.fnc b/embed.fnc
index eb7817e..bf8d7a6 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1195,6 +1195,7 @@ pR        |OP*    |ck_trunc       |NN OP *o
 pR     |OP*    |ck_unpack      |NN OP *o
 sRn    |bool   |is_handle_constructor|NN const OP *o|I32 numargs
 sR     |I32    |is_list_assignment|NULLOK const OP *o
+s      |void   |forget_pmop    |NN PMOP *const o|U32 flags
 s      |void   |cop_free       |NN COP *cop
 s      |OP*    |modkids        |NULLOK OP *o|I32 type
 s      |OP*    |scalarboolean  |NN OP *o

diff --git a/embed.h b/embed.h
index 182afca..7a44131 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1192,6 +1192,7 @@
 #define ck_unpack              Perl_ck_unpack
 #define is_handle_constructor  S_is_handle_constructor
 #define is_list_assignment     S_is_list_assignment
+#define forget_pmop            S_forget_pmop
 #define cop_free               S_cop_free
 #define modkids                        S_modkids
 #define scalarboolean          S_scalarboolean
@@ -3429,6 +3430,7 @@
 #define ck_unpack(a)           Perl_ck_unpack(aTHX_ a)
 #define is_handle_constructor  S_is_handle_constructor
 #define is_list_assignment(a)  S_is_list_assignment(aTHX_ a)
+#define forget_pmop(a,b)       S_forget_pmop(aTHX_ a,b)
 #define cop_free(a)            S_cop_free(aTHX_ a)
 #define modkids(a,b)           S_modkids(aTHX_ a,b)
 #define scalarboolean(a)       S_scalarboolean(aTHX_ a)

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 12eb6a3..9d62ff2 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1016,10 +1016,14 @@ B::OP
 PMOP_pmreplstart(o)
        B::PMOP         o
 
+#if PERL_VERSION < 9
+
 B::PMOP
 PMOP_pmnext(o)
        B::PMOP         o
 
+#endif
+
 #ifdef USE_ITHREADS
 
 IV

diff --git a/op.c b/op.c
index f1a1c1b..b00164c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -581,28 +581,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
@@ -641,6 +620,38 @@ 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);
+}
+
 void
 Perl_op_null(pTHX_ OP *o)
 {
@@ -3292,15 +3303,17 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
     }
 #endif
 
-        /* link into pm list */
+    /* append to pm list */
     if (type != OP_TRANS && PL_curstash) {
        MAGIC *mg = mg_find((SV*)PL_curstash, PERL_MAGIC_symtab);
-
+       U32 elements;
        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;
+       elements = mg->mg_len / sizeof(PMOP**);
+       Renewc(mg->mg_ptr, elements + 1, PMOP*, char);
+       ((PMOP**)mg->mg_ptr) [elements++] = pmop;
+       mg->mg_len = elements * sizeof(PMOP**);
        PmopSTASH_set(pmop,PL_curstash);
     }
 

diff --git a/op.h b/op.h
index 0586592..0dee522 100644 (file)
--- a/op.h
+++ b/op.h
@@ -320,7 +320,6 @@ struct pmop {
     OP *       op_last;
     OP *       op_pmreplroot; /* (type is really union {OP*,GV*,PADOFFSET}) */
     OP *       op_pmreplstart;
-    PMOP *     op_pmnext;              /* list of all scanpats */
 #ifdef USE_ITHREADS
     IV          op_pmoffset;
 #else

diff --git a/sv.c b/sv.c
index 2d3af25..09dec1f 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -7267,14 +7267,17 @@ Perl_sv_reset(pTHX_ register const char *s, HV *stash)
     if (!*s) {         /* reset ?? searches */
        MAGIC * const mg = mg_find((SV *)stash, PERL_MAGIC_symtab);
        if (mg) {
-           PMOP *pm = (PMOP *) mg->mg_obj;
-           while (pm) {
+           const U32 count = mg->mg_len / sizeof(PMOP**);
+           PMOP **pmp = (PMOP**) mg->mg_ptr;
+           PMOP *const *const end = pmp + count;
+
+           while (pmp < end) {
 #ifdef USE_ITHREADS
-                SvREADONLY_off(PL_regex_pad[pm->op_pmoffset]);
+                SvREADONLY_off(PL_regex_pad[(*pmp)->op_pmoffset]);
 #else
-               pm->op_pmflags &= ~PMf_USED;
+               (*pmp)->op_pmflags &= ~PMf_USED;
 #endif
-               pm = pm->op_pmnext;
+               ++pmp;
            }
        }
        return;
@@ -9651,9 +9654,6 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
               1.  */
            nmg->mg_obj = SvREFCNT_inc(av_dup_inc((AV*) mg->mg_obj, param));
        }
-       else if (mg->mg_type == PERL_MAGIC_symtab) {
-           nmg->mg_obj = mg->mg_obj;
-       }
        else {
            nmg->mg_obj = (mg->mg_flags & MGf_REFCOUNTED)
                              ? sv_dup_inc(mg->mg_obj, param)