This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Only append ?? match ops to the list used by reset. This saves memory
authorNicholas Clark <nick@ccl4.org>
Fri, 6 Apr 2007 21:53:46 +0000 (21:53 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 6 Apr 2007 21:53:46 +0000 (21:53 +0000)
and time.

p4raw-id: //depot/perl@30857

op.c
op.h
toke.c

diff --git a/op.c b/op.c
index e0be444..56b9d9f 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3326,20 +3326,6 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
     }
 #endif
 
-    /* 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);
-       }
-       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);
-    }
-
     return CHECKOP(type, pmop);
 }
 
diff --git a/op.h b/op.h
index 0dee522..f99cd3b 100644 (file)
--- a/op.h
+++ b/op.h
@@ -326,6 +326,11 @@ struct pmop {
     REGEXP *    op_pmregexp;            /* compiled expression */
 #endif
     U32                op_pmflags;
+    /* This field is only needed so that PMOPs can delete themselves from the
+       list held by the stash. In turn, that list is only needed for reset
+       to work correctly, and is now only a list of ops used by ?? matches,
+       which are rare. Hence it would be useful if we could find a way to
+       shave it. */
 #ifdef USE_ITHREADS
     char *     op_pmstashpv;
 #else
diff --git a/toke.c b/toke.c
index 5a79dcd..0485df1 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -10841,8 +10841,28 @@ S_scan_pat(pTHX_ char *start, I32 type)
     }
 
     pm = (PMOP*)newPMOP(type, 0);
-    if (PL_multi_open == '?')
+    if (PL_multi_open == '?') {
+       /* This is the only point in the code that sets PMf_ONCE:  */
        pm->op_pmflags |= PMf_ONCE;
+
+       /* Hence it's safe to do this bit of PMOP book-keeping here, which
+          allows us to restrict the list needed by reset to just the ??
+          matches.  */
+       assert(type != OP_TRANS);
+       if (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);
+           }
+           elements = mg->mg_len / sizeof(PMOP**);
+           Renewc(mg->mg_ptr, elements + 1, PMOP*, char);
+           ((PMOP**)mg->mg_ptr) [elements++] = pm;
+           mg->mg_len = elements * sizeof(PMOP**);
+           PmopSTASH_set(pm,PL_curstash);
+       }
+    }
 #ifdef PERL_MAD
     modstart = s;
 #endif