diff --git a/pp_ctl.c b/pp_ctl.c index 0eb57e71282a..93fb22c1512b 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2249,30 +2249,43 @@ Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp) return cx; } -PP_wrapped(pp_caller, MAXARG, 0) +PP(pp_caller) { - dSP; const PERL_CONTEXT *cx; const PERL_CONTEXT *dbcx; U8 gimme = GIMME_V; const HEK *stash_hek; - I32 count = 0; - bool has_arg = MAXARG && TOPs; + bool has_arg = false; + I32 count = cBOOL(PL_op->op_private & OPpOFFBYONE); const COP *lcop; - if (MAXARG) { - if (has_arg) - count = POPi; - else (void)POPs; + if (PL_op->op_flags & OPf_KIDS) { + if (PL_stack_sp[0]) { + has_arg = true; + count += (IV)SvIVx(PL_stack_sp[0]); + } + rpp_popfree_1(); } - cx = caller_cx(count + cBOOL(PL_op->op_private & OPpOFFBYONE), &dbcx); + /* pp_caller traditionally had separate EXTEND(SP, 1) checks where + * that was all that was needed, with this larger check occuring later. + * However, when an application reaches a steady stack size - and often + * prior to that, the stack will already have space to accomodate 11 + * more pointers. For example, during a perl build and run of the test + * harness, gcov showed that pp_caller never had to extend the stack. + * Consolidating the EXTENDs was found to shrink pp_caller by 46 + * instructions on a non-DEBUGGING, non-threaded gcc build. + * Additionally, subsequent commits will cause pp_caller to push + * a varying assortment of SV*s to the stack, so an early catch-all + * check will be even more desirable at that point.*/ + rpp_extend(11); + + cx = caller_cx(count, &dbcx); if (!cx) { if (gimme != G_LIST) { - EXTEND(SP, 1); - RETPUSHUNDEF; + rpp_push_IMM(&PL_sv_undef); } - RETURN; + return NORMAL; } /* populate @DB::args ? */ @@ -2317,86 +2330,85 @@ PP_wrapped(pp_caller, MAXARG, 0) ? HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop)) : NULL; if (gimme != G_LIST) { - EXTEND(SP, 1); if (!stash_hek) - PUSHs(&PL_sv_undef); + rpp_push_IMM(&PL_sv_undef); else { dTARGET; sv_sethek(TARG, stash_hek); - PUSHs(TARG); + rpp_push_1(TARG); } - RETURN; + return NORMAL; } - EXTEND(SP, 11); - if (!stash_hek) - PUSHs(&PL_sv_undef); + rpp_push_IMM(&PL_sv_undef); else { dTARGET; sv_sethek(TARG, stash_hek); - PUSHTARG; + rpp_push_1(TARG); } - mPUSHs(newSVpv(OutCopFILE(cx->blk_oldcop), 0)); + rpp_push_1_norc(newSVpv(OutCopFILE(cx->blk_oldcop), 0)); lcop = closest_cop(cx->blk_oldcop, OpSIBLING(cx->blk_oldcop), cx->blk_sub.retop, TRUE); if (!lcop) lcop = cx->blk_oldcop; - mPUSHu(CopLINE(lcop)); + rpp_push_1_norc( newSVuv( (UV)(CopLINE(lcop)) ) ); + if (!has_arg) - RETURN; + return NORMAL; + if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { /* So is ccstack[dbcxix]. */ if (CvHASGV(dbcx->blk_sub.cv)) { - PUSHs(cv_name(dbcx->blk_sub.cv, 0, 0)); - PUSHs(boolSV(CxHASARGS(cx))); + rpp_push_1(cv_name(dbcx->blk_sub.cv, 0, 0)); + rpp_push_IMM(boolSV(CxHASARGS(cx))); } else { - PUSHs(newSVpvs_flags("(unknown)", SVs_TEMP)); - PUSHs(boolSV(CxHASARGS(cx))); + rpp_push_1_norc( newSVpvs_flags("(unknown)", 0)); + rpp_push_IMM(boolSV(CxHASARGS(cx))); } } else { - PUSHs(newSVpvs_flags("(eval)", SVs_TEMP)); - PUSHs(&PL_sv_zero); + rpp_push_1_norc( newSVpvs_flags("(eval)", 0) ); + rpp_push_IMM(&PL_sv_zero); } gimme = cx->blk_gimme; if (gimme == G_VOID) - PUSHs(&PL_sv_undef); + rpp_push_IMM(&PL_sv_undef); else - PUSHs(boolSV((gimme & G_WANT) == G_LIST)); + rpp_push_IMM(boolSV((gimme & G_WANT) == G_LIST)); if (CxTYPE(cx) == CXt_EVAL) { /* eval STRING */ if (CxOLD_OP_TYPE(cx) == OP_ENTEREVAL) { SV *cur_text = cx->blk_eval.cur_text; if (SvCUR(cur_text) >= 2) { - PUSHs(newSVpvn_flags(SvPVX(cur_text), SvCUR(cur_text)-2, - SvUTF8(cur_text)|SVs_TEMP)); + rpp_push_1_norc( newSVpvn_flags(SvPVX(cur_text), SvCUR(cur_text)-2, + SvUTF8(cur_text)) ); } else { /* I think this is will always be "", but be sure */ - PUSHs(sv_mortalcopy_flags(cur_text, SV_GMAGIC|SV_NOSTEAL)); + rpp_push_1_norc(newSVsv_flags(cur_text, SV_GMAGIC|SV_NOSTEAL)); } - PUSHs(&PL_sv_no); + rpp_push_IMM(&PL_sv_no); } /* require */ else if (cx->blk_eval.old_namesv) { - mPUSHs(newSVsv(cx->blk_eval.old_namesv)); - PUSHs(&PL_sv_yes); + rpp_push_1_norc(newSVsv(cx->blk_eval.old_namesv)); + rpp_push_IMM(&PL_sv_yes); } /* eval BLOCK (try blocks have old_namesv == 0) */ else { - PUSHs(&PL_sv_undef); - PUSHs(&PL_sv_undef); + rpp_push_IMM(&PL_sv_undef); + rpp_push_IMM(&PL_sv_undef); } } else { - PUSHs(&PL_sv_undef); - PUSHs(&PL_sv_undef); + rpp_push_IMM(&PL_sv_undef); + rpp_push_IMM(&PL_sv_undef); } - mPUSHi(CopHINTS_get(cx->blk_oldcop)); + rpp_push_1_norc(newSViv( (IV)(CopHINTS_get(cx->blk_oldcop)) )); { SV * mask ; char *old_warnings = cx->blk_oldcop->cop_warnings; @@ -2411,13 +2423,16 @@ PP_wrapped(pp_caller, MAXARG, 0) } else mask = newSVpvn(old_warnings, RCPV_LEN(old_warnings)); - mPUSHs(mask); + rpp_push_1_norc(mask); } - PUSHs(cx->blk_oldcop->cop_hints_hash ? - sv_2mortal(newRV_noinc(MUTABLE_SV(cop_hints_2hv(cx->blk_oldcop, 0)))) - : &PL_sv_undef); - RETURN; + if (cx->blk_oldcop->cop_hints_hash) { + rpp_push_1_norc( newRV_noinc(MUTABLE_SV(cop_hints_2hv(cx->blk_oldcop, 0))) ); + } else { + rpp_push_IMM(&PL_sv_undef); + } + + return NORMAL; }