From: Nicholas Clark Date: Wed, 2 Jan 2008 13:47:42 +0000 (+0000) Subject: Make struct regexp the body of SVt_REGEXP SVs, REGEXPs become SVs, X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=288b8c02c5ee89a2978a1b9e56ed255c53beb793;p=p5sagit%2Fp5-mst-13.2.git Make struct regexp the body of SVt_REGEXP SVs, REGEXPs become SVs, and regexp reference counting is via the regular SV reference counting. This was not as easy at it looks. p4raw-id: //depot/perl@32804 --- diff --git a/cflags.SH b/cflags.SH index 9dd6181..4e62f92 100755 --- a/cflags.SH +++ b/cflags.SH @@ -134,7 +134,7 @@ case "$gccversion" in '') ;; [12]*) ;; # gcc versions 1 (gasp!) and 2 are not good for this. Intel*) ;; # # Is that you, Intel C++? -*) for opt in -ansi -pedantic -std=c89 -W -Wextra -Wdeclaration-after-statement -Wendif-labels -Wc++-compat +*) for opt in -ansi -std=c89 -W -Wextra -Wdeclaration-after-statement -Wendif-labels -Wc++-compat do case " $ccflags " in *" $opt "*) ;; # Skip if already there. diff --git a/dump.c b/dump.c index 9010c65..dee5c10 100644 --- a/dump.c +++ b/dump.c @@ -1592,8 +1592,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " PV = 0\n"); } if (type == SVt_REGEXP) { + /* FIXME dumping Perl_dump_indent(aTHX_ level, file, " REGEXP = 0x%"UVxf"\n", - PTR2UV(((struct xregexp *)SvANY(sv))->xrx_regexp)); + PTR2UV(((struct regexp *)SvANY(sv))->xrx_regexp)); + */ } if (type >= SVt_PVMG) { if (type == SVt_PVMG && SvPAD_OUR(sv)) { diff --git a/embed.fnc b/embed.fnc index 678cf99..c041296 100644 --- a/embed.fnc +++ b/embed.fnc @@ -437,7 +437,6 @@ dp |int |magic_clearhint|NN SV* sv|NN MAGIC* mg p |int |magic_clearpack|NN SV* sv|NN MAGIC* mg p |int |magic_clearsig |NN SV* sv|NN MAGIC* mg p |int |magic_existspack|NN SV* sv|NN const MAGIC* mg -p |int |magic_freeregexp|NN SV* sv|NN MAGIC* mg p |int |magic_freeovrld|NN SV* sv|NN MAGIC* mg p |int |magic_get |NN SV* sv|NN MAGIC* mg p |int |magic_getarylen|NN SV* sv|NN const MAGIC* mg @@ -686,6 +685,7 @@ Ap |I32 |pregexec |NN REGEXP * const prog|NN char* stringarg \ |NN char* strend|NN char* strbeg|I32 minend \ |NN SV* screamer|U32 nosave Ap |void |pregfree |NULLOK REGEXP* r +Ap |void |pregfree2 |NN REGEXP* prog EXp |REGEXP*|reg_temp_copy |NN REGEXP* r Ap |void |regfree_internal|NULLOK REGEXP * const r Ap |char * |reg_stringify |NN MAGIC *mg|NULLOK STRLEN *lp|NULLOK U32 *flags|NULLOK I32 *haseval @@ -1085,7 +1085,8 @@ Apa |ANY* |ss_dup |NN PerlInterpreter* proto_perl|NN CLONE_PARAMS* param ApR |void* |any_dup |NULLOK void* v|NN const PerlInterpreter* proto_perl ApR |HE* |he_dup |NULLOK const HE* e|bool shared|NN CLONE_PARAMS* param ApR |HEK* |hek_dup |NULLOK HEK* e|NN CLONE_PARAMS* param -ApR |REGEXP*|re_dup |NULLOK const REGEXP* r|NN CLONE_PARAMS* param +Ap |void |re_dup_guts |NN const REGEXP *sstr|NN REGEXP *dstr \ + |NN CLONE_PARAMS* param Ap |PerlIO*|fp_dup |NULLOK PerlIO* fp|char type|NN CLONE_PARAMS* param ApR |DIR* |dirp_dup |NULLOK DIR* dp ApR |GP* |gp_dup |NULLOK GP* gp|NN CLONE_PARAMS* param diff --git a/embed.h b/embed.h index ed58cc1..ba24871 100644 --- a/embed.h +++ b/embed.h @@ -409,7 +409,6 @@ #define magic_clearpack Perl_magic_clearpack #define magic_clearsig Perl_magic_clearsig #define magic_existspack Perl_magic_existspack -#define magic_freeregexp Perl_magic_freeregexp #define magic_freeovrld Perl_magic_freeovrld #define magic_get Perl_magic_get #define magic_getarylen Perl_magic_getarylen @@ -682,6 +681,7 @@ #define regclass_swash Perl_regclass_swash #define pregexec Perl_pregexec #define pregfree Perl_pregfree +#define pregfree2 Perl_pregfree2 #if defined(PERL_CORE) || defined(PERL_EXT) #define reg_temp_copy Perl_reg_temp_copy #endif @@ -1081,7 +1081,7 @@ #define any_dup Perl_any_dup #define he_dup Perl_he_dup #define hek_dup Perl_hek_dup -#define re_dup Perl_re_dup +#define re_dup_guts Perl_re_dup_guts #define fp_dup Perl_fp_dup #define dirp_dup Perl_dirp_dup #define gp_dup Perl_gp_dup @@ -2703,7 +2703,6 @@ #define magic_clearpack(a,b) Perl_magic_clearpack(aTHX_ a,b) #define magic_clearsig(a,b) Perl_magic_clearsig(aTHX_ a,b) #define magic_existspack(a,b) Perl_magic_existspack(aTHX_ a,b) -#define magic_freeregexp(a,b) Perl_magic_freeregexp(aTHX_ a,b) #define magic_freeovrld(a,b) Perl_magic_freeovrld(aTHX_ a,b) #define magic_get(a,b) Perl_magic_get(aTHX_ a,b) #define magic_getarylen(a,b) Perl_magic_getarylen(aTHX_ a,b) @@ -2973,6 +2972,7 @@ #define regclass_swash(a,b,c,d,e) Perl_regclass_swash(aTHX_ a,b,c,d,e) #define pregexec(a,b,c,d,e,f,g) Perl_pregexec(aTHX_ a,b,c,d,e,f,g) #define pregfree(a) Perl_pregfree(aTHX_ a) +#define pregfree2(a) Perl_pregfree2(aTHX_ a) #if defined(PERL_CORE) || defined(PERL_EXT) #define reg_temp_copy(a) Perl_reg_temp_copy(aTHX_ a) #endif @@ -3365,7 +3365,7 @@ #define any_dup(a,b) Perl_any_dup(aTHX_ a,b) #define he_dup(a,b,c) Perl_he_dup(aTHX_ a,b,c) #define hek_dup(a,b) Perl_hek_dup(aTHX_ a,b) -#define re_dup(a,b) Perl_re_dup(aTHX_ a,b) +#define re_dup_guts(a,b,c) Perl_re_dup_guts(aTHX_ a,b,c) #define fp_dup(a,b,c) Perl_fp_dup(aTHX_ a,b,c) #define dirp_dup(a) Perl_dirp_dup(aTHX_ a) #define gp_dup(a,b) Perl_gp_dup(aTHX_ a,b) diff --git a/ext/B/B.xs b/ext/B/B.xs index a6f1d22..8f22122 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1514,18 +1514,16 @@ IV REGEX(sv) B::REGEXP sv CODE: - RETVAL = PTR2IV(((struct xregexp *)SvANY(sv))->xrx_regexp); + /* FIXME - can we code this method more efficiently? */ + RETVAL = PTR2IV(sv); OUTPUT: RETVAL SV* precomp(sv) B::REGEXP sv - REGEXP* rx = NO_INIT CODE: - rx = ((struct xregexp *)SvANY(sv))->xrx_regexp; - /* FIXME - UTF-8? And the equivalent precomp methods? */ - RETVAL = newSVpvn( RX_PRECOMP(rx), RX_PRELEN(rx) ); + RETVAL = newSVpvn( RX_PRECOMP(sv), RX_PRELEN(sv) ); OUTPUT: RETVAL diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t index 2c4cfbf..af9dc02 100644 --- a/ext/Devel/Peek/t/Peek.t +++ b/ext/Devel/Peek/t/Peek.t @@ -283,12 +283,11 @@ do_test(15, FLAGS = \\(ROK\\) RV = $ADDR SV = REGEXP\\($ADDR\\) at $ADDR - REFCNT = 1 + REFCNT = 2 FLAGS = \\(\\) IV = 0 NV = 0 - PV = 0 - REGEXP = $ADDR'); + PV = 0'); } else { do_test(15, qr(tic), diff --git a/mg.c b/mg.c index b81570d..48618c0 100644 --- a/mg.c +++ b/mg.c @@ -2151,17 +2151,6 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg) return sv_unmagic(sv, type); } -int -Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg) -{ - dVAR; - regexp * const re = (regexp *)mg->mg_obj; - PERL_UNUSED_ARG(sv); - - ReREFCNT_dec(re); - return 0; -} - #ifdef USE_LOCALE_COLLATE int Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg) diff --git a/perl.h b/perl.h index 3bad1eb..0f65572 100644 --- a/perl.h +++ b/perl.h @@ -2352,7 +2352,8 @@ typedef struct STRUCT_SV SV; typedef struct av AV; typedef struct hv HV; typedef struct cv CV; -typedef struct regexp REGEXP; +typedef struct regexp ORANGE; /* This is the body structure. */ +typedef SV REGEXP; typedef struct gp GP; typedef struct gv GV; typedef struct io IO; @@ -3308,8 +3309,8 @@ struct nexttoken { }; #endif -#include "regexp.h" #include "sv.h" +#include "regexp.h" #include "util.h" #include "form.h" #include "gv.h" @@ -5075,7 +5076,7 @@ MGVTBL_SET( MEMBER_TO_FPTR(Perl_magic_setregexp), 0, 0, - MEMBER_TO_FPTR(Perl_magic_freeregexp), + 0, 0, 0, 0 diff --git a/pp_ctl.c b/pp_ctl.c index ae0c61e..8681cd9 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -117,7 +117,7 @@ PP(pp_regcomp) if (SvROK(tmpstr)) { SV * const sv = SvRV(tmpstr); if (SvTYPE(sv) == SVt_REGEXP) - re = ((struct xregexp *)SvANY(sv))->xrx_regexp; + re = sv; } if (re) { re = reg_temp_copy(re); @@ -3905,11 +3905,11 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) # define SM_REGEX ( \ (SvROK(d) && (SvTYPE(This = SvRV(d)) == SVt_REGEXP) \ - && (this_regex = ((struct xregexp *)SvANY(This))->xrx_regexp) \ + && (this_regex = This) \ && (Other = e)) \ || \ (SvROK(e) && (SvTYPE(This = SvRV(e)) == SVt_REGEXP) \ - && (this_regex = ((struct xregexp *)SvANY(This))->xrx_regexp) \ + && (this_regex = This) \ && (Other = d)) ) @@ -3918,7 +3918,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) # define SM_OTHER_REGEX (SvROK(Other) \ && (SvTYPE(SvRV(Other)) == SVt_REGEXP) \ - && (other_regex = ((struct xregexp *)SvANY(SvRV(Other)))->xrx_regexp)) + && (other_regex = SvRV(Other))) # define SM_SEEN_THIS(sv) hv_exists_ent(seen_this, \ diff --git a/pp_hot.c b/pp_hot.c index e686b2a..9099c88 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1194,11 +1194,21 @@ PP(pp_qr) REGEXP * rx = PM_GETRE(pm); SV * const pkg = CALLREG_PACKAGE(rx); SV * const rv = sv_newmortal(); - SV * const sv = newSVrv(rv, pkg ? SvPV_nolen(pkg) : NULL); + + SvUPGRADE(rv, SVt_IV); + /* This RV is about to own a reference to the regexp. (In addition to the + reference already owned by the PMOP. */ + ReREFCNT_inc(rx); + SvRV_set(rv, rx); + SvROK_on(rv); + + if (pkg) { + HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD); + (void)sv_bless(rv, stash); + } + if (RX_EXTFLAGS(rx) & RXf_TAINTED) SvTAINTED_on(rv); - sv_upgrade(sv, SVt_REGEXP); - ((struct xregexp *)SvANY(sv))->xrx_regexp = ReREFCNT_inc(rx); XPUSHs(rv); RETURN; } diff --git a/proto.h b/proto.h index 79e2428..668aea1 100644 --- a/proto.h +++ b/proto.h @@ -1108,10 +1108,6 @@ PERL_CALLCONV int Perl_magic_existspack(pTHX_ SV* sv, const MAGIC* mg) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); -PERL_CALLCONV int Perl_magic_freeregexp(pTHX_ SV* sv, MAGIC* mg) - __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2); - PERL_CALLCONV int Perl_magic_freeovrld(pTHX_ SV* sv, MAGIC* mg) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); @@ -1852,6 +1848,9 @@ PERL_CALLCONV I32 Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, char __attribute__nonnull__(pTHX_6); PERL_CALLCONV void Perl_pregfree(pTHX_ REGEXP* r); +PERL_CALLCONV void Perl_pregfree2(pTHX_ REGEXP* prog) + __attribute__nonnull__(pTHX_1); + PERL_CALLCONV REGEXP* Perl_reg_temp_copy(pTHX_ REGEXP* r) __attribute__nonnull__(pTHX_1); @@ -2892,9 +2891,10 @@ PERL_CALLCONV HEK* Perl_hek_dup(pTHX_ HEK* e, CLONE_PARAMS* param) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_2); -PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ const REGEXP* r, CLONE_PARAMS* param) - __attribute__warn_unused_result__ - __attribute__nonnull__(pTHX_2); +PERL_CALLCONV void Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS* param) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2) + __attribute__nonnull__(pTHX_3); PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type, CLONE_PARAMS* param) __attribute__nonnull__(pTHX_3); diff --git a/regcomp.c b/regcomp.c index 775049d..8bd1894 100644 --- a/regcomp.c +++ b/regcomp.c @@ -102,6 +102,7 @@ typedef struct RExC_state_t { U32 flags; /* are we folding, multilining? */ char *precomp; /* uncompiled string. */ + REGEXP *rx_sv; /* The SV that is the regexp. */ regexp *rx; /* perl core regexp structure */ regexp_internal *rxi; /* internal data for regexp object pprivate field */ char *start; /* Start of input for compile */ @@ -149,6 +150,7 @@ typedef struct RExC_state_t { #define RExC_flags (pRExC_state->flags) #define RExC_precomp (pRExC_state->precomp) +#define RExC_rx_sv (pRExC_state->rx_sv) #define RExC_rx (pRExC_state->rx) #define RExC_rxi (pRExC_state->rxi) #define RExC_start (pRExC_state->start) @@ -389,7 +391,7 @@ static const scan_data_t zero_scan_data = IV len = RExC_end - RExC_precomp; \ \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \ + SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \ if (len > RegexLengthToShowInErrorMessages) { \ /* chop 10 shorter than the max, to ensure meaning of "..." */ \ len = RegexLengthToShowInErrorMessages - 10; \ @@ -420,7 +422,7 @@ static const scan_data_t zero_scan_data = */ #define vFAIL(m) STMT_START { \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \ + SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \ Simple_vFAIL(m); \ } STMT_END @@ -438,7 +440,7 @@ static const scan_data_t zero_scan_data = */ #define vFAIL2(m,a1) STMT_START { \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \ + SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \ Simple_vFAIL2(m, a1); \ } STMT_END @@ -457,7 +459,7 @@ static const scan_data_t zero_scan_data = */ #define vFAIL3(m,a1,a2) STMT_START { \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx); \ + SAVEDESTRUCTOR_X(clear_re,(void*)RExC_rx_sv); \ Simple_vFAIL3(m, a1, a2); \ } STMT_END @@ -4155,7 +4157,8 @@ REGEXP * Perl_re_compile(pTHX_ const SV * const pattern, const U32 pm_flags) { dVAR; - register REGEXP *r; + REGEXP *rx; + struct regexp *r; register regexp_internal *ri; STRLEN plen; char* exp = SvPV((SV*)pattern, plen); @@ -4264,7 +4267,8 @@ redo_first_pass: /* Allocate space and zero-initialize. Note, the two step process of zeroing when in debug mode, thus anything assigned has to happen after that */ - Newxz(r, 1, regexp); + rx = newSV_type(SVt_REGEXP); + r = (struct regexp*)SvANY(rx); Newxc(ri, sizeof(regexp_internal) + (unsigned)RExC_size * sizeof(regnode), char, regexp_internal); if ( r == NULL || ri == NULL ) @@ -4280,7 +4284,6 @@ redo_first_pass: /* non-zero initialization begins here */ RXi_SET( r, ri ); r->engine= RE_ENGINE_PTR; - r->refcnt = 1; r->extflags = pm_flags; { bool has_p = ((r->extflags & RXf_PMf_KEEPCOPY) == RXf_PMf_KEEPCOPY); @@ -4347,6 +4350,7 @@ redo_first_pass: (UV)((2*RExC_size+1) * sizeof(U32)))); #endif SetProgLen(ri,RExC_size); + RExC_rx_sv = rx; RExC_rx = r; RExC_rxi = ri; @@ -4364,7 +4368,7 @@ redo_first_pass: RExC_rx->seen_evals = RExC_seen_evals; REGC((U8)REG_MAGIC, (char*) RExC_emit++); if (reg(pRExC_state, 0, &flags,1) == NULL) { - ReREFCNT_dec(r); + ReREFCNT_dec(rx); return(NULL); } /* XXXX To minimize changes to RE engine we always allocate @@ -4856,7 +4860,7 @@ reStudy: PerlIO_printf(Perl_debug_log, "\n"); }); #endif - return(r); + return rx; } #undef RE_ENGINE_PTR @@ -4904,10 +4908,12 @@ Perl_reg_named_buff_iter(pTHX_ REGEXP * const rx, const SV * const lastkey, } SV* -Perl_reg_named_buff_fetch(pTHX_ REGEXP * const rx, SV * const namesv, const U32 flags) +Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv, + const U32 flags) { AV *retarray = NULL; SV *ret; + struct regexp *const rx = (struct regexp *)SvANY(r); if (flags & RXapif_ALL) retarray=newAV(); @@ -4923,7 +4929,7 @@ Perl_reg_named_buff_fetch(pTHX_ REGEXP * const rx, SV * const namesv, const U32 && rx->offs[nums[i]].end != -1) { ret = newSVpvs(""); - CALLREG_NUMBUF_FETCH(rx,nums[i],ret); + CALLREG_NUMBUF_FETCH(r,nums[i],ret); if (!retarray) return ret; } else { @@ -4942,14 +4948,15 @@ Perl_reg_named_buff_fetch(pTHX_ REGEXP * const rx, SV * const namesv, const U32 } bool -Perl_reg_named_buff_exists(pTHX_ REGEXP * const rx, SV * const key, +Perl_reg_named_buff_exists(pTHX_ REGEXP * const r, SV * const key, const U32 flags) { + struct regexp *const rx = (struct regexp *)SvANY(r); if (rx && rx->paren_names) { if (flags & RXapif_ALL) { return hv_exists_ent(rx->paren_names, key, 0); } else { - SV *sv = CALLREG_NAMED_BUFF_FETCH(rx, key, flags); + SV *sv = CALLREG_NAMED_BUFF_FETCH(r, key, flags); if (sv) { SvREFCNT_dec(sv); return TRUE; @@ -4963,20 +4970,22 @@ Perl_reg_named_buff_exists(pTHX_ REGEXP * const rx, SV * const key, } SV* -Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const rx, const U32 flags) +Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const r, const U32 flags) { + struct regexp *const rx = (struct regexp *)SvANY(r); if ( rx && rx->paren_names ) { (void)hv_iterinit(rx->paren_names); - return CALLREG_NAMED_BUFF_NEXTKEY(rx, NULL, flags & ~RXapif_FIRSTKEY); + return CALLREG_NAMED_BUFF_NEXTKEY(r, NULL, flags & ~RXapif_FIRSTKEY); } else { return FALSE; } } SV* -Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const rx, const U32 flags) +Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const r, const U32 flags) { + struct regexp *const rx = (struct regexp *)SvANY(r); if (rx && rx->paren_names) { HV *hv = rx->paren_names; HE *temphe; @@ -5005,17 +5014,18 @@ Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const rx, const U32 flags) } SV* -Perl_reg_named_buff_scalar(pTHX_ REGEXP * const rx, const U32 flags) +Perl_reg_named_buff_scalar(pTHX_ REGEXP * const r, const U32 flags) { SV *ret; AV *av; I32 length; + struct regexp *const rx = (struct regexp *)SvANY(r); if (rx && rx->paren_names) { if (flags & (RXapif_ALL | RXapif_REGNAMES_COUNT)) { return newSViv(HvTOTALKEYS(rx->paren_names)); } else if (flags & RXapif_ONE) { - ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES)); + ret = CALLREG_NAMED_BUFF_ALL(r, (flags | RXapif_REGNAMES)); av = (AV*)SvRV(ret); length = av_len(av); return newSViv(length + 1); @@ -5028,8 +5038,9 @@ Perl_reg_named_buff_scalar(pTHX_ REGEXP * const rx, const U32 flags) } SV* -Perl_reg_named_buff_all(pTHX_ REGEXP * const rx, const U32 flags) +Perl_reg_named_buff_all(pTHX_ REGEXP * const r, const U32 flags) { + struct regexp *const rx = (struct regexp *)SvANY(r); AV *av = newAV(); if (rx && rx->paren_names) { @@ -5062,8 +5073,10 @@ Perl_reg_named_buff_all(pTHX_ REGEXP * const rx, const U32 flags) } void -Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const rx, const I32 paren, SV * const sv) +Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, + SV * const sv) { + struct regexp *const rx = (struct regexp *)SvANY(r); char *s = NULL; I32 i = 0; I32 s1, t1; @@ -5149,9 +5162,10 @@ Perl_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren, } I32 -Perl_reg_numbered_buff_length(pTHX_ REGEXP * const rx, const SV * const sv, +Perl_reg_numbered_buff_length(pTHX_ REGEXP * const r, const SV * const sv, const I32 paren) { + struct regexp *const rx = (struct regexp *)SvANY(r); I32 i; I32 s1, t1; @@ -9095,9 +9109,10 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) } SV * -Perl_re_intuit_string(pTHX_ REGEXP * const prog) +Perl_re_intuit_string(pTHX_ REGEXP * const r) { /* Assume that RE_INTUIT is set */ dVAR; + struct regexp *const prog = (struct regexp *)SvANY(r); GET_RE_DEBUG_FLAGS_DECL; PERL_UNUSED_CONTEXT; @@ -9136,15 +9151,20 @@ Perl_re_intuit_string(pTHX_ REGEXP * const prog) void Perl_pregfree(pTHX_ REGEXP *r) { + SvREFCNT_dec(r); +} + +void +Perl_pregfree2(pTHX_ REGEXP *rx) +{ dVAR; + struct regexp *const r = (struct regexp *)SvANY(rx); GET_RE_DEBUG_FLAGS_DECL; - if (!r || (--r->refcnt > 0)) - return; if (r->mother_re) { ReREFCNT_dec(r->mother_re); } else { - CALLREGFREE_PVT(r); /* free the private data */ + CALLREGFREE_PVT(rx); /* free the private data */ if (r->paren_names) SvREFCNT_dec(r->paren_names); Safefree(RXp_WRAPPED(r)); @@ -9160,14 +9180,13 @@ Perl_pregfree(pTHX_ REGEXP *r) SvREFCNT_dec(r->float_utf8); Safefree(r->substrs); } - RX_MATCH_COPY_FREE(r); + RX_MATCH_COPY_FREE(rx); #ifdef PERL_OLD_COPY_ON_WRITE if (r->saved_copy) SvREFCNT_dec(r->saved_copy); #endif Safefree(r->swap); Safefree(r->offs); - Safefree(r); } /* reg_temp_copy() @@ -9188,15 +9207,16 @@ Perl_pregfree(pTHX_ REGEXP *r) REGEXP * -Perl_reg_temp_copy (pTHX_ REGEXP *r) { - regexp *ret; +Perl_reg_temp_copy (pTHX_ REGEXP *rx) { + REGEXP *ret_x = newSV_type(SVt_REGEXP); + struct regexp *ret = (struct regexp *)SvANY(ret_x); + struct regexp *const r = (struct regexp *)SvANY(rx); register const I32 npar = r->nparens+1; - (void)ReREFCNT_inc(r); - Newx(ret, 1, regexp); + (void)ReREFCNT_inc(rx); + /* FIXME ORANGE (once we start actually using the regular SV fields.) */ StructCopy(r, ret, regexp); Newx(ret->offs, npar, regexp_paren_pair); Copy(r->offs, ret->offs, npar, regexp_paren_pair); - ret->refcnt = 1; if (r->substrs) { Newx(ret->substrs, 1, struct reg_substr_data); StructCopy(r->substrs, ret->substrs, struct reg_substr_data); @@ -9209,14 +9229,14 @@ Perl_reg_temp_copy (pTHX_ REGEXP *r) { /* check_substr and check_utf8, if non-NULL, point to either their anchored or float namesakes, and don't hold a second reference. */ } - RX_MATCH_COPIED_off(ret); + RX_MATCH_COPIED_off(ret_x); #ifdef PERL_OLD_COPY_ON_WRITE ret->saved_copy = NULL; #endif - ret->mother_re = r; + ret->mother_re = rx; ret->swap = NULL; - return ret; + return ret_x; } #endif @@ -9233,9 +9253,10 @@ Perl_reg_temp_copy (pTHX_ REGEXP *r) { */ void -Perl_regfree_internal(pTHX_ REGEXP * const r) +Perl_regfree_internal(pTHX_ REGEXP * const rx) { dVAR; + struct regexp *const r = (struct regexp *)SvANY(rx); RXi_GET_DECL(r,ri); GET_RE_DEBUG_FLAGS_DECL; @@ -9366,23 +9387,15 @@ Perl_regfree_internal(pTHX_ REGEXP * const r) */ #if defined(USE_ITHREADS) #ifndef PERL_IN_XSUB_RE -regexp * -Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param) +void +Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) { dVAR; - regexp *ret; I32 npar; - - if (!r) - return (REGEXP *)NULL; - - if ((ret = (REGEXP *)ptr_table_fetch(PL_ptr_table, r))) - return ret; - + const struct regexp *r = (const struct regexp *)SvANY(sstr); + struct regexp *ret = (struct regexp *)SvANY(dstr); npar = r->nparens+1; - Newx(ret, 1, regexp); - StructCopy(r, ret, regexp); Newx(ret->offs, npar, regexp_paren_pair); Copy(r->offs, ret->offs, npar, regexp_paren_pair); if(ret->swap) { @@ -9424,9 +9437,9 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param) ret->paren_names = hv_dup_inc(ret->paren_names, param); if (ret->pprivate) - RXi_SET(ret,CALLREGDUPE_PVT(ret,param)); + RXi_SET(ret,CALLREGDUPE_PVT(dstr,param)); - if (RX_MATCH_COPIED(ret)) + if (RX_MATCH_COPIED(dstr)) ret->subbeg = SAVEPVN(ret->subbeg, ret->sublen); else ret->subbeg = NULL; @@ -9437,9 +9450,6 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param) ret->mother_re = NULL; ret->gofs = 0; ret->seen_evals = 0; - - ptr_table_store(PL_ptr_table, r, ret); - return ret; } #endif /* PERL_IN_XSUB_RE */ @@ -9458,9 +9468,10 @@ Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param) */ void * -Perl_regdupe_internal(pTHX_ REGEXP * const r, CLONE_PARAMS *param) +Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) { dVAR; + struct regexp *const r = (struct regexp *)SvANY(rx); regexp_internal *reti; int len, npar; RXi_GET_DECL(r,ri); diff --git a/regcomp.h b/regcomp.h index d3c75f0..dee7d78 100644 --- a/regcomp.h +++ b/regcomp.h @@ -528,10 +528,10 @@ struct reg_data { #define check_offset_max substrs->data[2].max_offset #define check_end_shift substrs->data[2].end_shift -#define RX_ANCHORED_SUBSTR(rx) ((rx)->anchored_substr) -#define RX_ANCHORED_UTF8(rx) ((rx)->anchored_utf8) -#define RX_FLOAT_SUBSTR(rx) ((rx)->float_substr) -#define RX_FLOAT_UTF8(rx) ((rx)->float_utf8) +#define RX_ANCHORED_SUBSTR(rx) (((struct regexp *)SvANY(rx))->anchored_substr) +#define RX_ANCHORED_UTF8(rx) (((struct regexp *)SvANY(rx))->anchored_utf8) +#define RX_FLOAT_SUBSTR(rx) (((struct regexp *)SvANY(rx))->float_substr) +#define RX_FLOAT_UTF8(rx) (((struct regexp *)SvANY(rx))->float_utf8) /* trie related stuff */ diff --git a/regexec.c b/regexec.c index 59fc53e..2b7ae4a 100644 --- a/regexec.c +++ b/regexec.c @@ -371,10 +371,11 @@ Perl_pregexec(pTHX_ REGEXP * const prog, char* stringarg, register char *strend, deleted from the finite automaton. */ char * -Perl_re_intuit_start(pTHX_ REGEXP * const prog, SV *sv, char *strpos, +Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos, char *strend, const U32 flags, re_scream_pos_data *data) { dVAR; + struct regexp *const prog = (struct regexp *)SvANY(rx); register I32 start_shift = 0; /* Should be nonnegative! */ register I32 end_shift = 0; @@ -394,7 +395,7 @@ Perl_re_intuit_start(pTHX_ REGEXP * const prog, SV *sv, char *strpos, GET_RE_DEBUG_FLAGS_DECL; - RX_MATCH_UTF8_set(prog,do_utf8); + RX_MATCH_UTF8_set(rx,do_utf8); if (prog->extflags & RXf_UTF8) { PL_reg_flags |= RF_utf8; @@ -1742,7 +1743,7 @@ S_swap_match_buff (pTHX_ regexp *prog) { - regexec_flags - match a regexp against a string */ I32 -Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *strend, +Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *strend, char *strbeg, I32 minend, SV *sv, void *data, U32 flags) /* strend: pointer to null at end of string */ /* strbeg: real beginning of string */ @@ -1753,6 +1754,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st /* nosave: For optimizations. */ { dVAR; + struct regexp *const prog = (struct regexp *)SvANY(rx); /*register*/ char *s; register regnode *c; /*register*/ char *startpos = stringarg; @@ -1778,9 +1780,9 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st } multiline = prog->extflags & RXf_PMf_MULTILINE; - reginfo.prog = prog; + reginfo.prog = rx; /* Yes, sorry that this is confusing. */ - RX_MATCH_UTF8_set(prog, do_utf8); + RX_MATCH_UTF8_set(rx, do_utf8); DEBUG_EXECUTE_r( debug_start_match(prog, do_utf8, startpos, strend, "Matching"); @@ -1842,7 +1844,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st } else /* pos() not defined */ reginfo.ganch = strbeg; } - if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) { + if (PL_curpm && (PM_GETRE(PL_curpm) == rx)) { swap_on_fail = 1; swap_match_buff(prog); /* do we need a save destructor here for eval dies? */ @@ -1852,7 +1854,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st d.scream_olds = &scream_olds; d.scream_pos = &scream_pos; - s = re_intuit_start(prog, sv, s, strend, flags, &d); + s = re_intuit_start(rx, sv, s, strend, flags, &d); if (!s) { DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n")); goto phooey; /* not present */ @@ -1885,7 +1887,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st if (s > end) goto phooey; if (prog->extflags & RXf_USE_INTUIT) { - s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL); + s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL); if (!s) goto phooey; } @@ -2144,7 +2146,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const prog, char *stringarg, register char *st goto phooey; got_it: - RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted); + RX_MATCH_TAINTED_set(rx, PL_reg_flags & RF_tainted); if (PL_reg_eval_set) restore_pos(aTHX_ prog); @@ -2153,7 +2155,7 @@ got_it: /* make sure $`, $&, $', and $digit will work later */ if ( !(flags & REXEC_NOT_FIRST) ) { - RX_MATCH_COPY_FREE(prog); + RX_MATCH_COPY_FREE(rx); if (flags & REXEC_COPY_STR) { const I32 i = PL_regeol - startpos + (stringarg - strbeg); #ifdef PERL_OLD_COPY_ON_WRITE @@ -2170,7 +2172,7 @@ got_it: } else #endif { - RX_MATCH_COPIED_on(prog); + RX_MATCH_COPIED_on(rx); s = savepvn(strbeg, i); prog->subbeg = s; } @@ -2205,7 +2207,8 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos) { dVAR; CHECKPOINT lastcp; - regexp *prog = reginfo->prog; + REGEXP *const rx = reginfo->prog; + regexp *const prog = (struct regexp *)SvANY(rx); RXi_GET_DECL(prog,progi); GET_RE_DEBUG_FLAGS_DECL; reginfo->cutpoint=NULL; @@ -2261,7 +2264,7 @@ S_regtry(pTHX_ regmatch_info *reginfo, char **startpos) } #endif } - PM_SETRE(PL_reg_curpm, prog); + PM_SETRE(PL_reg_curpm, rx); PL_reg_oldcurpm = PL_curpm; PL_curpm = PL_reg_curpm; if (RXp_MATCH_COPIED(prog)) { @@ -2696,7 +2699,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) register const bool do_utf8 = PL_reg_match_utf8; const U32 uniflags = UTF8_ALLOW_DEFAULT; - regexp *rex = reginfo->prog; + REGEXP *rex_sv = reginfo->prog; + regexp *rex = (struct regexp *)SvANY(rex_sv); RXi_GET_DECL(rex,rexi); I32 oldsave; @@ -3629,6 +3633,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) #define ST st->u.eval { SV *ret; + SV *re_sv; regexp *re; regexp_internal *rei; regnode *startpoint; @@ -3645,9 +3650,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) } else { nochange_depth = 0; } + re_sv = rex_sv; re = rex; rei = rexi; - (void)ReREFCNT_inc(rex); + (void)ReREFCNT_inc(rex_sv); if (OP(scan)==GOSUB) { startpoint = scan + ARG2L(scan); ST.close_paren = ARG(scan); @@ -3708,19 +3714,19 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) /* extract RE object from returned value; compiling if * necessary */ MAGIC *mg = NULL; - re = NULL; + REGEXP *rx = NULL; if (SvROK(ret)) { - const SV *const sv = SvRV(ret); + SV *const sv = SvRV(ret); if (SvTYPE(sv) == SVt_REGEXP) { - re = ((struct xregexp *)SvANY(sv))->xrx_regexp; + rx = sv; } else if (SvSMAGICAL(sv)) { mg = mg_find(sv, PERL_MAGIC_qr); assert(mg); } } else if (SvTYPE(ret) == SVt_REGEXP) { - re = ((struct xregexp *)SvANY(ret))->xrx_regexp; + rx = ret; } else if (SvSMAGICAL(ret)) { if (SvGMAGICAL(ret)) { /* I don't believe that there is ever qr magic @@ -3739,28 +3745,30 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) } if (mg) { - re = (regexp *)mg->mg_obj; /*XXX:dmq*/ + rx = mg->mg_obj; /*XXX:dmq*/ assert(re); } - if (re) - re = reg_temp_copy(re); + if (rx) { + rx = reg_temp_copy(rx); + } else { U32 pm_flags = 0; const I32 osize = PL_regsize; if (DO_UTF8(ret)) pm_flags |= RXf_UTF8; - re = CALLREGCOMP(ret, pm_flags); + rx = CALLREGCOMP(ret, pm_flags); if (!(SvFLAGS(ret) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY | SVs_GMG))) { /* This isn't a first class regexp. Instead, it's caching a regexp onto an existing, Perl visible scalar. */ - sv_magic(ret,(SV*)ReREFCNT_inc(re), - PERL_MAGIC_qr,0,0); + sv_magic(ret, rx, PERL_MAGIC_qr, 0, 0); } PL_regsize = osize; } + re_sv = rx; + re = (struct regexp *)SvANY(rx); } RXp_MATCH_COPIED_off(re); re->subbeg = rex->subbeg; @@ -3803,9 +3811,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) PL_reg_flags &= ~RF_utf8; ST.toggle_reg_flags ^= PL_reg_flags; /* diff of old and new */ - ST.prev_rex = rex; + ST.prev_rex = rex_sv; ST.prev_curlyx = cur_curlyx; - SETREX(rex,re); + SETREX(rex_sv,re_sv); + rex = re; rexi = rei; cur_curlyx = NULL; ST.B = next; @@ -3824,8 +3833,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) case EVAL_AB: /* cleanup after a successful (??{A})B */ /* note: this is called twice; first after popping B, then A */ PL_reg_flags ^= ST.toggle_reg_flags; - ReREFCNT_dec(rex); - SETREX(rex,ST.prev_rex); + ReREFCNT_dec(rex_sv); + SETREX(rex_sv,ST.prev_rex); + rex = (struct regexp *)SvANY(rex_sv); rexi = RXi_GET(rex); regcpblow(ST.cp); cur_eval = ST.prev_eval; @@ -3840,8 +3850,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog) case EVAL_AB_fail: /* unsuccessfully ran A or B in (??{A})B */ /* note: this is called twice; first after popping B, then A */ PL_reg_flags ^= ST.toggle_reg_flags; - ReREFCNT_dec(rex); - SETREX(rex,ST.prev_rex); + ReREFCNT_dec(rex_sv); + SETREX(rex_sv,ST.prev_rex); + rex = (struct regexp *)SvANY(rex_sv); rexi = RXi_GET(rex); PL_reginput = locinput; REGCP_UNWIND(ST.lastcp); @@ -4835,11 +4846,12 @@ NULL = cur_eval->u.eval.toggle_reg_flags; PL_reg_flags ^= st->u.eval.toggle_reg_flags; - st->u.eval.prev_rex = rex; /* inner */ - SETREX(rex,cur_eval->u.eval.prev_rex); + st->u.eval.prev_rex = rex_sv; /* inner */ + SETREX(rex_sv,cur_eval->u.eval.prev_rex); + rex = (struct regexp *)SvANY(rex_sv); rexi = RXi_GET(rex); cur_curlyx = cur_eval->u.eval.prev_curlyx; - ReREFCNT_inc(rex); + ReREFCNT_inc(rex_sv); st->u.eval.cp = regcppush(0); /* Save *all* the positions. */ REGCP_SET(st->u.eval.lastcp); PL_reginput = locinput; diff --git a/regexp.h b/regexp.h index 17dfbb6..6fd42c6 100644 --- a/regexp.h +++ b/regexp.h @@ -67,9 +67,11 @@ typedef struct regexp_paren_pair { */ typedef struct regexp { + _XPV_HEAD; + _XPVMG_HEAD; /* what engine created this regexp? */ const struct regexp_engine* engine; - struct regexp* mother_re; /* what re is this a lightweight copy of? */ + REGEXP *mother_re; /* what re is this a lightweight copy of? */ /* Information about the match that the perl core uses to manage things */ U32 extflags; /* Flags used both externally and internally */ @@ -104,9 +106,6 @@ typedef struct regexp { unsigned pre_prefix:4; /* offset from wrapped to the start of precomp */ unsigned seen_evals:28; /* number of eval groups in the pattern - for security checks */ HV *paren_names; /* Optional hash of paren names */ - - /* Refcount of this regexp */ - I32 refcnt; /* Refcount of this regexp */ } regexp; /* used for high speed searches */ @@ -369,25 +368,25 @@ and check for NULL. #define RXp_EXTFLAGS(rx) ((rx)->extflags) /* For source compatibility. We used to store these explicitly. */ -#define RX_PRECOMP(prog) ((prog)->wrapped + (prog)->pre_prefix) -#define RX_PRELEN(prog) ((prog)->wraplen - (prog)->pre_prefix - 1) -#define RX_WRAPPED(prog) ((prog)->wrapped) -#define RX_WRAPLEN(prog) ((prog)->wraplen) -#define RX_CHECK_SUBSTR(prog) ((prog)->check_substr) -#define RX_EXTFLAGS(prog) ((prog)->extflags) -#define RX_REFCNT(prog) ((prog)->refcnt) -#define RX_ENGINE(prog) ((prog)->engine) -#define RX_SUBBEG(prog) ((prog)->subbeg) -#define RX_OFFS(prog) ((prog)->offs) -#define RX_NPARENS(prog) ((prog)->nparens) -#define RX_SUBLEN(prog) ((prog)->sublen) -#define RX_SUBBEG(prog) ((prog)->subbeg) -#define RX_MINLEN(prog) ((prog)->minlen) -#define RX_MINLENRET(prog) ((prog)->minlenret) -#define RX_GOFS(prog) ((prog)->gofs) -#define RX_LASTPAREN(prog) ((prog)->lastparen) -#define RX_LASTCLOSEPAREN(prog) ((prog)->lastcloseparen) -#define RX_SEEN_EVALS(prog) ((prog)->seen_evals) +#define RX_PRECOMP(prog) RXp_PRECOMP((struct regexp *)SvANY(prog)) +#define RX_PRELEN(prog) RXp_PRELEN((struct regexp *)SvANY(prog)) +#define RX_WRAPPED(prog) RXp_WRAPPED((struct regexp *)SvANY(prog)) +#define RX_WRAPLEN(prog) RXp_WRAPLEN((struct regexp *)SvANY(prog)) +#define RX_CHECK_SUBSTR(prog) (((struct regexp *)SvANY(prog))->check_substr) +#define RX_EXTFLAGS(prog) RXp_EXTFLAGS((struct regexp *)SvANY(prog)) +#define RX_REFCNT(prog) SvREFCNT(prog) +#define RX_ENGINE(prog) (((struct regexp *)SvANY(prog))->engine) +#define RX_SUBBEG(prog) (((struct regexp *)SvANY(prog))->subbeg) +#define RX_OFFS(prog) (((struct regexp *)SvANY(prog))->offs) +#define RX_NPARENS(prog) (((struct regexp *)SvANY(prog))->nparens) +#define RX_SUBLEN(prog) (((struct regexp *)SvANY(prog))->sublen) +#define RX_SUBBEG(prog) (((struct regexp *)SvANY(prog))->subbeg) +#define RX_MINLEN(prog) (((struct regexp *)SvANY(prog))->minlen) +#define RX_MINLENRET(prog) (((struct regexp *)SvANY(prog))->minlenret) +#define RX_GOFS(prog) (((struct regexp *)SvANY(prog))->gofs) +#define RX_LASTPAREN(prog) (((struct regexp *)SvANY(prog))->lastparen) +#define RX_LASTCLOSEPAREN(prog) (((struct regexp *)SvANY(prog))->lastcloseparen) +#define RX_SEEN_EVALS(prog) (((struct regexp *)SvANY(prog))->seen_evals) #endif /* PLUGGABLE_RE_EXTENSION */ @@ -424,8 +423,25 @@ and check for NULL. #define REXEC_IGNOREPOS 0x08 /* \G matches at start. */ #define REXEC_NOT_FIRST 0x10 /* This is another iteration of //g. */ -#define ReREFCNT_inc(re) ((void)(re && re->refcnt++), re) -#define ReREFCNT_dec(re) CALLREGFREE(re) +#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) +# define ReREFCNT_inc(re) \ + ({ \ + /* This is here to generate a casting warning if incorrect. */ \ + REGEXP *const zwapp = (re); \ + SvREFCNT_inc(zwapp); \ + }) +# define ReREFCNT_dec(re) \ + ({ \ + /* This is here to generate a casting warning if incorrect. */ \ + REGEXP *const boff = (re); \ + SvREFCNT_dec(boff); \ + }) +#else +# define ReREFCNT_dec(re) SvREFCNT_dec(re) +# define ReREFCNT_inc(re) SvREFCNT_inc(re) +#endif + +/* FIXME for plugins. */ #define FBMcf_TAIL_DOLLAR 1 #define FBMcf_TAIL_DOLLARM 2 @@ -446,7 +462,7 @@ typedef struct _reg_trie_accepted reg_trie_accepted; * Perl_regexec_flags and then passed to regtry(), regmatch() etc */ typedef struct { - regexp *prog; + REGEXP *prog; char *bol; char *till; SV *sv; @@ -516,7 +532,7 @@ typedef struct regmatch_state { struct regmatch_state *prev_yes_state; struct regmatch_state *prev_eval; struct regmatch_state *prev_curlyx; - regexp *prev_rex; + REGEXP *prev_rex; U32 toggle_reg_flags; /* what bits in PL_reg_flags to flip when transitioning between inner and outer rexen */ diff --git a/sv.c b/sv.c index 7844c49..551d458 100644 --- a/sv.c +++ b/sv.c @@ -916,9 +916,9 @@ static const struct body_details bodies_by_type[] = { { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(XPVMG)) }, - /* 32 */ - { sizeof(struct xregexp), copy_length(struct xregexp, xrx_regexp), 0, - SVt_REGEXP, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(struct xregexp)) + /* something big */ + { sizeof(struct regexp), sizeof(struct regexp), 0, + SVt_REGEXP, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(struct regexp)) }, /* 48 */ @@ -2713,8 +2713,9 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags) I32 haseval = 0; U32 flags = 0; struct magic temp; - temp.mg_obj - = (SV*)((struct xregexp *)SvANY(referent))->xrx_regexp; + /* FIXME - get rid of this cast away of const, or work out + how to do it better. */ + temp.mg_obj = (SV *)referent; assert(temp.mg_obj); (str) = CALLREG_AS_STR(&temp,lp,&flags,&haseval); if (flags & 1) @@ -4475,7 +4476,6 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, const MGVTBL *vtable, */ if (!obj || obj == sv || how == PERL_MAGIC_arylen || - how == PERL_MAGIC_qr || how == PERL_MAGIC_symtab || (SvTYPE(obj) == SVt_PVGV && (GvSV(obj) == sv || GvHV(obj) == (HV*)sv || GvAV(obj) == (AV*)sv || @@ -5232,7 +5232,8 @@ Perl_sv_clear(pTHX_ register SV *sv) Safefree(IoBOTTOM_NAME(sv)); goto freescalar; case SVt_REGEXP: - ReREFCNT_dec(((struct xregexp *)SvANY(sv))->xrx_regexp); + /* FIXME for plugins */ + pregfree2(sv); goto freescalar; case SVt_PVCV: case SVt_PVFM: @@ -9822,10 +9823,13 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param) nmg->mg_private = mg->mg_private; nmg->mg_type = mg->mg_type; nmg->mg_flags = mg->mg_flags; + /* FIXME for plugins if (mg->mg_type == PERL_MAGIC_qr) { nmg->mg_obj = (SV*)CALLREGDUPE((REGEXP*)mg->mg_obj, param); } - else if(mg->mg_type == PERL_MAGIC_backref) { + else + */ + if(mg->mg_type == PERL_MAGIC_backref) { /* The backref AV has its reference count deliberately bumped by 1. */ nmg->mg_obj = SvREFCNT_inc(av_dup_inc((AV*) mg->mg_obj, param)); @@ -10205,9 +10209,8 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param) case SVt_PVMG: break; case SVt_REGEXP: - ((struct xregexp *)SvANY(dstr))->xrx_regexp - = CALLREGDUPE(((struct xregexp *)SvANY(dstr))->xrx_regexp, - param); + /* FIXME for plugins */ + re_dup_guts(sstr, dstr, param); break; case SVt_PVLV: /* XXX LvTARGOFF sometimes holds PMOP* when DEBUGGING */ @@ -11195,12 +11198,17 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, av_push(PL_regex_padav, sv_dup_inc_NN(regexen[0],param)); for(i = 1; i <= len; i++) { const SV * const regex = regexen[i]; + /* FIXME for plugins + newSViv(PTR2IV(CALLREGDUPE( + INT2PTR(REGEXP *, SvIVX(regex)), param)))) + */ + /* And while we're at it, can we FIXME on the whole hiding + pointer inside an IV hack? */ SV * const sv = SvREPADTMP(regex) ? sv_dup_inc(regex, param) : SvREFCNT_inc( - newSViv(PTR2IV(CALLREGDUPE( - INT2PTR(REGEXP *, SvIVX(regex)), param)))) + newSViv(PTR2IV(sv_dup_inc(INT2PTR(REGEXP *, SvIVX(regex)), param)))) ; if (SvFLAGS(regex) & SVf_BREAK) SvFLAGS(sv) |= SVf_BREAK; /* unrefcnted PL_curpm */ diff --git a/sv.h b/sv.h index 443a3de..df42dcf 100644 --- a/sv.h +++ b/sv.h @@ -471,12 +471,6 @@ struct xpvmg { _XPVMG_HEAD; }; -struct xregexp { - _XPV_HEAD; - _XPVMG_HEAD; - REGEXP * xrx_regexp; /* Our regular expression */ -}; - struct xpvlv { _XPV_HEAD; _XPVMG_HEAD; diff --git a/util.c b/util.c index fef0393..1710e6f 100644 --- a/util.c +++ b/util.c @@ -5922,7 +5922,7 @@ Perl_get_re_arg(pTHX_ SV *sv) { (tmpsv = (SV*)SvRV(sv)) && /* assign deliberate */ SvTYPE(tmpsv) == SVt_REGEXP) { - return ((struct xregexp *)SvANY(tmpsv))->xrx_regexp; + return tmpsv; } }