From 15057369196a69b662a11c006adc2d180ce7a103 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 15 Jul 2025 13:09:05 +0000 Subject: [PATCH 1/4] pp_caller: use OPf_KIDS rather than MAXARG to free up bits --- pp_ctl.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index 0eb57e71282a..af88c4b19464 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2249,7 +2249,7 @@ Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp) return cx; } -PP_wrapped(pp_caller, MAXARG, 0) +PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) { dSP; const PERL_CONTEXT *cx; @@ -2257,10 +2257,10 @@ PP_wrapped(pp_caller, MAXARG, 0) U8 gimme = GIMME_V; const HEK *stash_hek; I32 count = 0; - bool has_arg = MAXARG && TOPs; + bool has_arg = (PL_op->op_flags & OPf_KIDS) && TOPs; const COP *lcop; - if (MAXARG) { + if (PL_op->op_flags & OPf_KIDS) { if (has_arg) count = POPi; else (void)POPs; From 3017c5c98325b49f92914db9238b50442c8fbdfc Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 15 Jul 2025 13:25:06 +0000 Subject: [PATCH 2/4] pp_caller: do the EXTEND check once and early --- pp_ctl.c | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index af88c4b19464..a9fa924e7b17 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2266,10 +2266,22 @@ PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) else (void)POPs; } + /* 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.*/ + EXTEND(SP, 11); + cx = caller_cx(count + cBOOL(PL_op->op_private & OPpOFFBYONE), &dbcx); if (!cx) { if (gimme != G_LIST) { - EXTEND(SP, 1); RETPUSHUNDEF; } RETURN; @@ -2317,7 +2329,6 @@ PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) ? HvNAME_HEK((HV*)CopSTASH(cx->blk_oldcop)) : NULL; if (gimme != G_LIST) { - EXTEND(SP, 1); if (!stash_hek) PUSHs(&PL_sv_undef); else { @@ -2328,8 +2339,6 @@ PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) RETURN; } - EXTEND(SP, 11); - if (!stash_hek) PUSHs(&PL_sv_undef); else { From a2591174ea01a97423255bc710c80a26c7f719f2 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 15 Jul 2025 16:02:53 +0000 Subject: [PATCH 3/4] pp_caller: minor refactoring ahead of PP unwrapping --- pp_ctl.c | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index a9fa924e7b17..ffc352711704 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2256,14 +2256,16 @@ PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) const PERL_CONTEXT *dbcx; U8 gimme = GIMME_V; const HEK *stash_hek; - I32 count = 0; - bool has_arg = (PL_op->op_flags & OPf_KIDS) && TOPs; + bool has_arg = false; + I32 count = cBOOL(PL_op->op_private & OPpOFFBYONE); const COP *lcop; if (PL_op->op_flags & OPf_KIDS) { - if (has_arg) - count = POPi; - else (void)POPs; + if (PL_stack_sp[0]) { + has_arg = true; + count += (IV)SvIVx(PL_stack_sp[0]); + } + (void)POPs; } /* pp_caller traditionally had separate EXTEND(SP, 1) checks where @@ -2279,7 +2281,7 @@ PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) * check will be even more desirable at that point.*/ EXTEND(SP, 11); - cx = caller_cx(count + cBOOL(PL_op->op_private & OPpOFFBYONE), &dbcx); + cx = caller_cx(count, &dbcx); if (!cx) { if (gimme != G_LIST) { RETPUSHUNDEF; From 039dd5b846ce775734968a7d18d8629546f72050 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 15 Jul 2025 22:53:40 +0000 Subject: [PATCH 4/4] pp_caller - RC stack unwrapped --- pp_ctl.c | 80 +++++++++++++++++++++++++++++--------------------------- 1 file changed, 42 insertions(+), 38 deletions(-) diff --git a/pp_ctl.c b/pp_ctl.c index ffc352711704..93fb22c1512b 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2249,9 +2249,8 @@ Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp) return cx; } -PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) +PP(pp_caller) { - dSP; const PERL_CONTEXT *cx; const PERL_CONTEXT *dbcx; U8 gimme = GIMME_V; @@ -2265,7 +2264,7 @@ PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) has_arg = true; count += (IV)SvIVx(PL_stack_sp[0]); } - (void)POPs; + rpp_popfree_1(); } /* pp_caller traditionally had separate EXTEND(SP, 1) checks where @@ -2279,14 +2278,14 @@ PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) * 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.*/ - EXTEND(SP, 11); + rpp_extend(11); cx = caller_cx(count, &dbcx); if (!cx) { if (gimme != G_LIST) { - RETPUSHUNDEF; + rpp_push_IMM(&PL_sv_undef); } - RETURN; + return NORMAL; } /* populate @DB::args ? */ @@ -2332,82 +2331,84 @@ PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 0) : NULL; if (gimme != G_LIST) { 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; } 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; @@ -2422,13 +2423,16 @@ PP_wrapped(pp_caller, ((PL_op->op_flags & OPf_KIDS) ? 1 : 0), 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; }