From a1941760704242726e754cde1820f738676ca838 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Thu, 4 Apr 2013 17:29:53 +0100 Subject: [PATCH] Eliminate PL_reg_state.re_reparsing, part 1 PL_reg_state.re_reparsing is a hacky flag used to allow runtime code blocks to be included in patterns. Basically, since code blocks are now handled by the perl parser within literal patterns, runtime patterns are handled by taking the (assembled at runtime) pattern, and feeding it back through the parser via the equivalent of eval q{qr'the_pattern'}, so that run-time (?{..})'s appear to be literal code blocks. When this happens, the global flag PL_reg_state.re_reparsing is set, which modifies lexing and parsing in minor ways (such as whether \\ is stripped). Now, I'm in the slow process of trying to eliminate global regex state (i.e. gradually removing the fields of PL_reg_state), and also a change which will be coming a few commits ahead requires the info which this flag indicates to linger for longer (currently it is cleared immediately after the call to scan_str(). For those two reasons, this commit adds a new mechanism to indicate this: a new flag to eval_sv(), G_RE_REPARSING (which sets OPpEVAL_RE_REPARSING in the entereval op), which sets the EVAL_RE_REPARSING bit in PL_in_eval. Its still a yukky global flag hack, but its a *different* global flag hack now. For this commit, we add the new flag(s) but keep the old PL_reg_state.re_reparsing flag and assert that the two mechanisms always match. The next commit will remove re_reparsing. --- cop.h | 2 ++ op.h | 1 + perl.c | 6 ++++-- pp_ctl.c | 4 +++- regcomp.c | 11 ++++++----- regexec.c | 1 + toke.c | 12 +++++++++--- 7 files changed, 26 insertions(+), 11 deletions(-) diff --git a/cop.h b/cop.h index 086cd22..b20eddb 100644 --- a/cop.h +++ b/cop.h @@ -1048,6 +1048,7 @@ L. Perl_magic_methcall(). */ #define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling Perl_magic_methcall(). */ +#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ @@ -1055,6 +1056,7 @@ L. #define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */ #define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */ #define EVAL_INREQUIRE 8 /* The code is being required. */ +#define EVAL_RE_REPARSING 0x10 /* eval_sv() called with G_RE_REPARSING */ /* Support for switching (stack and block) contexts. * This ensures magic doesn't invalidate local stack and cx pointers. diff --git a/op.h b/op.h index 8b87a9c..7c5030d 100644 --- a/op.h +++ b/op.h @@ -308,6 +308,7 @@ Deprecated. Use C instead. #define OPpEVAL_UNICODE 4 #define OPpEVAL_BYTES 8 #define OPpEVAL_COPHH 16 /* Construct %^H from cop hints */ +#define OPpEVAL_RE_REPARSING 32 /* eval_sv(..., G_RE_REPARSING) */ /* Private for OP_CALLER, OP_WANTARRAY and OP_RUNCV */ #define OPpOFFBYONE 128 /* Treat caller(1) as caller(2) */ diff --git a/perl.c b/perl.c index 87d98dc..9f41768 100644 --- a/perl.c +++ b/perl.c @@ -2808,8 +2808,10 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) myop.op_flags |= OP_GIMME_REVERSE(flags); if (flags & G_KEEPERR) myop.op_flags |= OPf_SPECIAL; - if (PL_reg_state.re_reparsing) - myop.op_private = OPpEVAL_COPHH; + assert (! (!!(PL_reg_state.re_reparsing ^ !!(flags & G_RE_REPARSING)))); + + if (flags & G_RE_REPARSING) + myop.op_private = (OPpEVAL_COPHH | OPpEVAL_RE_REPARSING); /* fail now; otherwise we could fail after the JMPENV_PUSH but * before a PUSHEVAL, which corrupts the stack after a croak */ diff --git a/pp_ctl.c b/pp_ctl.c index f518bc2..721a8a9 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3358,7 +3358,9 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) PL_in_eval = (in_require ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL)) - : EVAL_INEVAL); + : (EVAL_INEVAL | + ((PL_op->op_private & OPpEVAL_RE_REPARSING) + ? EVAL_RE_REPARSING : 0))); PUSHMARK(SP); diff --git a/regcomp.c b/regcomp.c index f680717..9873aaf 100644 --- a/regcomp.c +++ b/regcomp.c @@ -5003,11 +5003,11 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, SAVETMPS; save_re_context(); PUSHSTACKi(PERLSI_REQUIRE); - /* this causes the toker to collapse \\ into \ when parsing - * qr''; normally only q'' does this. It also alters hints - * handling */ + /* G_RE_REPARSING causes the toker to collapse \\ into \ when + * parsing qr''; normally only q'' does this. It also alters + * hints handling */ PL_reg_state.re_reparsing = TRUE; - eval_sv(sv, G_SCALAR); + eval_sv(sv, G_SCALAR|G_RE_REPARSING); SvREFCNT_dec_NN(sv); SPAGAIN; qr_ref = POPs; @@ -5634,6 +5634,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, * from the compile flags. */ + assert (!(!!(PL_reg_state.re_reparsing ^ !!(PL_in_eval & EVAL_RE_REPARSING)))); if ( old_re && !recompile && !!RX_UTF8(old_re) == !!RExC_utf8 @@ -5653,7 +5654,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, else if ((pm_flags & PMf_USE_RE_EVAL) /* this second condition covers the non-regex literal case, * i.e. $foo =~ '(?{})'. */ - || ( !PL_reg_state.re_reparsing && IN_PERL_COMPILETIME + || ( !(PL_in_eval & EVAL_RE_REPARSING) && IN_PERL_COMPILETIME && (PL_hints & HINT_RE_EVAL)) ) runtime_code = S_has_runtime_code(aTHX_ pRExC_state, expr, pm_flags, diff --git a/regexec.c b/regexec.c index d376e26..017cbff 100644 --- a/regexec.c +++ b/regexec.c @@ -4879,6 +4879,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) Copy(&PL_reg_state, &saved_state, 1, struct re_save_state); PL_reg_state.re_reparsing = FALSE; + PL_in_eval &= ~EVAL_RE_REPARSING; if (!caller_cv) caller_cv = find_runcv(NULL); diff --git a/toke.c b/toke.c index 275c957..929bdee 100644 --- a/toke.c +++ b/toke.c @@ -9047,7 +9047,9 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what) } } -/* Either returns sv, or mortalizes/frees sv and returns a new SV*. +/* S_new_constant(): do any overload::constant lookup. + + Either returns sv, or mortalizes/frees sv and returns a new SV*. Best used as sv=new_constant(..., sv, ...). If s, pv are NULL, calls subroutine with one argument, and is used with error messages only. @@ -9502,8 +9504,7 @@ S_scan_pat(pTHX_ char *start, I32 type) { dVAR; PMOP *pm; - char *s = scan_str(start,!!PL_madskills,FALSE, PL_reg_state.re_reparsing, - TRUE /* look for escaped bracketed metas */ ); + char *s; const char * const valid_flags = (const char *)((type == OP_QR) ? QR_PAT_MODS : M_PAT_MODS); char charset = '\0'; /* character set modifier */ @@ -9513,8 +9514,13 @@ S_scan_pat(pTHX_ char *start, I32 type) PERL_ARGS_ASSERT_SCAN_PAT; + assert (!(!!(PL_reg_state.re_reparsing ^ !!(PL_in_eval & EVAL_RE_REPARSING)))); + s = scan_str(start,!!PL_madskills,FALSE, (PL_in_eval & EVAL_RE_REPARSING), + TRUE /* look for escaped bracketed metas */ ); + /* this was only needed for the initial scan_str; set it to false * so that any (?{}) code blocks etc are parsed normally */ + PL_in_eval &= ~EVAL_RE_REPARSING; PL_reg_state.re_reparsing = FALSE; if (!s) { const char * const delimiter = skipspace(start); -- 2.7.4