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

6 files changed, 54 insertions, 35 deletions

diff --git a/embed.fnc b/embed.fnc
index eb7817ee6c..bf8d7a610d 100644
--- 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 182afca6d4..7a44131ee5 100644
--- 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 12eb6a3309..9d62ff27ee 100644
--- 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 f1a1c1b368..b00164cf18 100644
--- 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 0586592e6a..0dee522a40 100644
--- 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 2d3af25c6e..09dec1f812 100644
--- 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)