From: Nicholas Clark Date: Fri, 6 Apr 2007 19:50:12 +0000 (+0000) Subject: Remove op_pmnext from PMOPs, and instead store the list for reset as X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c2b1997a64b4faf9c52a72614bfeb0a1f6eeeba8;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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)