In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/01f9673fe8388317fdf7fca63774e3bc0dfd58d3?hp=e770df115e2ad9be7f44f308e5a2be61181c051e>
- Log ----------------------------------------------------------------- commit 01f9673fe8388317fdf7fca63774e3bc0dfd58d3 Author: David Mitchell <[email protected]> Date: Sat Jan 14 16:02:46 2017 +0000 add S_process_optree() function to op.c Extract into a new static function, S_process_optree(), some of the common code that calls rpeep(), finalize_optree() etc in the various newSUB()-style functions. There should be no functional changes, except that for formats, pad_tidy() is now called *after* optimisation. This matches what already happens for normals subs, and can possibly be regarded as a bug fix - although I can't think of anything it actually fixes. There are probably more things that could be consolidated into this function, but because the details vary amongst the various call sites, I've left them alone for now. ----------------------------------------------------------------------- Summary of changes: op.c | 90 ++++++++++++++++++++++++++++++++++++-------------------------------- 1 file changed, 48 insertions(+), 42 deletions(-) diff --git a/op.c b/op.c index 2c4935ec81..118c519cb8 100644 --- a/op.c +++ b/op.c @@ -2450,6 +2450,39 @@ S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op) } +/* do all the final processing on an optree (e.g. running the peephole + * optimiser on it), then attach it to cv (if cv is non-null) + */ + +static void +S_process_optree(pTHX_ CV *cv, OP *optree, OP* start) +{ + OP **startp; + + /* XXX for some reason, evals, require and main optrees are + * never attached to their CV; instead they just hang off + * PL_main_root + PL_main_start or PL_eval_root + PL_eval_start + * and get manually freed when appropriate */ + if (cv) + startp = &CvSTART(cv); + else + startp = PL_in_eval? &PL_eval_start : &PL_main_start; + + *startp = start; + optree->op_private |= OPpREFCOUNTED; + OpREFCNT_set(optree, 1); + CALL_PEEP(*startp); + finalize_optree(optree); + S_prune_chain_head(startp); + + if (cv) { + /* now that optimizer has done its work, adjust pad values */ + pad_tidy(optree->op_type == OP_LEAVEWRITE ? padtidy_FORMAT + : CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB); + } +} + + /* =for apidoc finalize_optree @@ -4197,6 +4230,8 @@ Perl_blockhook_register(pTHX_ BHK *hk) void Perl_newPROG(pTHX_ OP *o) { + OP *start; + PERL_ARGS_ASSERT_NEWPROG; if (PL_in_eval) { @@ -4218,16 +4253,12 @@ Perl_newPROG(pTHX_ OP *o) else scalar(PL_eval_root); - PL_eval_start = op_linklist(PL_eval_root); - PL_eval_root->op_private |= OPpREFCOUNTED; - OpREFCNT_set(PL_eval_root, 1); + start = op_linklist(PL_eval_root); PL_eval_root->op_next = 0; i = PL_savestack_ix; SAVEFREEOP(o); ENTER; - CALL_PEEP(PL_eval_start); - finalize_optree(PL_eval_root); - S_prune_chain_head(&PL_eval_start); + S_process_optree(aTHX_ NULL, PL_eval_root, start); LEAVE; PL_savestack_ix = i; } @@ -4266,13 +4297,9 @@ Perl_newPROG(pTHX_ OP *o) } PL_main_root = op_scope(sawparens(scalarvoid(o))); PL_curcop = &PL_compiling; - PL_main_start = LINKLIST(PL_main_root); - PL_main_root->op_private |= OPpREFCOUNTED; - OpREFCNT_set(PL_main_root, 1); + start = LINKLIST(PL_main_root); PL_main_root->op_next = 0; - CALL_PEEP(PL_main_start); - finalize_optree(PL_main_root); - S_prune_chain_head(&PL_main_start); + S_process_optree(aTHX_ NULL, PL_main_root, start); cv_forget_slab(PL_compcv); PL_compcv = 0; @@ -8352,8 +8379,6 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) PL_breakable_sub_gen++; CvROOT(cv) = block; - CvROOT(cv)->op_private |= OPpREFCOUNTED; - OpREFCNT_set(CvROOT(cv), 1); /* The cv no longer needs to hold a refcount on the slab, as CvROOT itself has a refcount. */ CvSLABBED_off(cv); @@ -8361,14 +8386,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) #ifdef PERL_DEBUG_READONLY_OPS slab = (OPSLAB *)CvSTART(cv); #endif - CvSTART(cv) = start; - CALL_PEEP(start); - finalize_optree(CvROOT(cv)); - S_prune_chain_head(&CvSTART(cv)); - - /* now that optimizer has done its work, adjust pad values */ - - pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB); + S_process_optree(aTHX_ cv, block, start); } attrs: @@ -8845,8 +8863,6 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, PL_breakable_sub_gen++; CvROOT(cv) = block; - CvROOT(cv)->op_private |= OPpREFCOUNTED; - OpREFCNT_set(CvROOT(cv), 1); /* The cv no longer needs to hold a refcount on the slab, as CvROOT itself has a refcount. */ CvSLABBED_off(cv); @@ -8854,14 +8870,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, #ifdef PERL_DEBUG_READONLY_OPS slab = (OPSLAB *)CvSTART(cv); #endif - CvSTART(cv) = start; - CALL_PEEP(start); - finalize_optree(CvROOT(cv)); - S_prune_chain_head(&CvSTART(cv)); - - /* now that optimizer has done its work, adjust pad values */ - - pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB); + S_process_optree(aTHX_ cv, block, start); } attrs: @@ -9267,8 +9276,9 @@ void Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) { CV *cv; - GV *gv; + OP *root; + OP *start; if (PL_parser && PL_parser->error_count) { op_free(block); @@ -9303,15 +9313,11 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) CvFILE_set_from_cop(cv, PL_curcop); - pad_tidy(padtidy_FORMAT); - CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); - CvROOT(cv)->op_private |= OPpREFCOUNTED; - OpREFCNT_set(CvROOT(cv), 1); - CvSTART(cv) = LINKLIST(CvROOT(cv)); - CvROOT(cv)->op_next = 0; - CALL_PEEP(CvSTART(cv)); - finalize_optree(CvROOT(cv)); - S_prune_chain_head(&CvSTART(cv)); + root = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); + CvROOT(cv) = root; + start = LINKLIST(root); + root->op_next = 0; + S_process_optree(aTHX_ cv, root, start); cv_forget_slab(cv); finish: -- Perl5 Master Repository
