X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/148f39b7de6eae9ddd59e0b0aff691d6abea7aca..1d8d63dcc3ec46dd8a437dab18cca3fb42880079:/pp_ctl.c diff --git a/pp_ctl.c b/pp_ctl.c index c74e21e..5e671ee 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -40,7 +40,6 @@ PP(pp_wantarray) { - dVAR; dSP; I32 cxix; const PERL_CONTEXT *cx; @@ -68,14 +67,12 @@ PP(pp_wantarray) PP(pp_regcreset) { - dVAR; TAINT_NOT; return NORMAL; } PP(pp_regcomp) { - dVAR; dSP; PMOP *pm = (PMOP*)cLOGOP->op_other; SV **args; @@ -191,7 +188,6 @@ PP(pp_regcomp) PP(pp_substcont) { - dVAR; dSP; PERL_CONTEXT *cx = &cxstack[cxstack_ix]; PMOP * const pm = (PMOP*) cLOGOP->op_other; @@ -292,8 +288,7 @@ PP(pp_substcont) POPSUBST(cx); PERL_ASYNC_CHECK(); RETURNOP(pm->op_next); - /* NOTREACHED */ - assert(0); + assert(0); /* NOTREACHED */ } cx->sb_iters = saviters; } @@ -320,8 +315,8 @@ PP(pp_substcont) if (!(mg = mg_find_mglob(sv))) { mg = sv_magicext_mglob(sv); } - assert(SvPOK(dstr)); - MgBYTEPOS_set(mg, sv, SvPVX(dstr), m - orig); + assert(SvPOK(sv)); + MgBYTEPOS_set(mg, sv, SvPVX(sv), m - orig); } if (old != rx) (void)ReREFCNT_inc(rx); @@ -458,7 +453,7 @@ S_rxres_free(pTHX_ void **rsp) PP(pp_formline) { - dVAR; dSP; dMARK; dORIGMARK; + dSP; dMARK; dORIGMARK; SV * const tmpForm = *++MARK; SV *formsv; /* contains text of original format */ U32 *fpc; /* format ops program counter */ @@ -838,11 +833,14 @@ PP(pp_formline) } /* Formats aren't yet marked for locales, so assume "yes". */ { + Size_t max = SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)); + int len; DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED(); - arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK); + arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK); /* we generate fmt ourselves so it is safe */ GCC_DIAG_IGNORE(-Wformat-nonliteral); - my_snprintf(t, SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)), fmt, (int) fieldsize, (int) arg, value); + len = my_snprintf(t, max, fmt, (int) fieldsize, (int) arg, value); + PERL_MY_SNPRINTF_POST_GUARD(len, max); GCC_DIAG_RESTORE; RESTORE_LC_NUMERIC(); } @@ -917,7 +915,7 @@ PP(pp_formline) PP(pp_grepstart) { - dVAR; dSP; + dSP; SV *src; if (PL_stack_base + *PL_markstack_ptr == SP) { @@ -959,7 +957,7 @@ PP(pp_grepstart) PP(pp_mapwhile) { - dVAR; dSP; + dSP; const I32 gimme = GIMME_V; I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */ I32 count; @@ -1111,7 +1109,6 @@ PP(pp_mapwhile) PP(pp_range) { - dVAR; if (GIMME == G_ARRAY) return NORMAL; if (SvTRUEx(PAD_SV(PL_op->op_targ))) @@ -1122,7 +1119,6 @@ PP(pp_range) PP(pp_flip) { - dVAR; dSP; if (GIMME == G_ARRAY) { @@ -1177,7 +1173,7 @@ PP(pp_flip) PP(pp_flop) { - dVAR; dSP; + dSP; if (GIMME == G_ARRAY) { dPOPPOPssrl; @@ -1281,7 +1277,6 @@ static const char * const context_name[] = { STATIC I32 S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags) { - dVAR; I32 i; PERL_ARGS_ASSERT_DOPOPTOLABEL; @@ -1336,7 +1331,6 @@ S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags) I32 Perl_dowantarray(pTHX) { - dVAR; const I32 gimme = block_gimme(); return (gimme == G_VOID) ? G_SCALAR : gimme; } @@ -1344,7 +1338,6 @@ Perl_dowantarray(pTHX) I32 Perl_block_gimme(pTHX) { - dVAR; const I32 cxix = dopoptosub(cxstack_ix); if (cxix < 0) return G_VOID; @@ -1359,14 +1352,12 @@ Perl_block_gimme(pTHX) default: Perl_croak(aTHX_ "panic: bad gimme: %d\n", cxstack[cxix].blk_gimme); } - /* NOTREACHED */ - NOT_REACHED; + NOT_REACHED; /* NOTREACHED */ } I32 Perl_is_lvalue_sub(pTHX) { - dVAR; const I32 cxix = dopoptosub(cxstack_ix); assert(cxix >= 0); /* We should only be called from inside subs */ @@ -1380,7 +1371,6 @@ Perl_is_lvalue_sub(pTHX) I32 Perl_was_lvalue_sub(pTHX) { - dVAR; const I32 cxix = dopoptosub(cxstack_ix-1); assert(cxix >= 0); /* We should only be called from inside subs */ @@ -1393,10 +1383,12 @@ Perl_was_lvalue_sub(pTHX) STATIC I32 S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock) { - dVAR; I32 i; PERL_ARGS_ASSERT_DOPOPTOSUB_AT; +#ifndef DEBUGGING + PERL_UNUSED_CONTEXT; +#endif for (i = startingblock; i >= 0; i--) { const PERL_CONTEXT * const cx = &cxstk[i]; @@ -1423,7 +1415,6 @@ S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock) STATIC I32 S_dopoptoeval(pTHX_ I32 startingblock) { - dVAR; I32 i; for (i = startingblock; i >= 0; i--) { const PERL_CONTEXT *cx = &cxstack[i]; @@ -1441,7 +1432,6 @@ S_dopoptoeval(pTHX_ I32 startingblock) STATIC I32 S_dopoptoloop(pTHX_ I32 startingblock) { - dVAR; I32 i; for (i = startingblock; i >= 0; i--) { const PERL_CONTEXT * const cx = &cxstack[i]; @@ -1471,7 +1461,6 @@ S_dopoptoloop(pTHX_ I32 startingblock) STATIC I32 S_dopoptogiven(pTHX_ I32 startingblock) { - dVAR; I32 i; for (i = startingblock; i >= 0; i--) { const PERL_CONTEXT *cx = &cxstack[i]; @@ -1499,7 +1488,6 @@ S_dopoptogiven(pTHX_ I32 startingblock) STATIC I32 S_dopoptowhen(pTHX_ I32 startingblock) { - dVAR; I32 i; for (i = startingblock; i >= 0; i--) { const PERL_CONTEXT *cx = &cxstack[i]; @@ -1517,7 +1505,6 @@ S_dopoptowhen(pTHX_ I32 startingblock) void Perl_dounwind(pTHX_ I32 cxix) { - dVAR; I32 optype; if (!PL_curstackinfo) /* can happen if die during thread cloning */ @@ -1559,8 +1546,6 @@ Perl_dounwind(pTHX_ I32 cxix) void Perl_qerror(pTHX_ SV *err) { - dVAR; - PERL_ARGS_ASSERT_QERROR; if (PL_in_eval) { @@ -1582,7 +1567,6 @@ Perl_qerror(pTHX_ SV *err) void Perl_die_unwind(pTHX_ SV *msv) { - dVAR; SV *exceptsv = sv_mortalcopy(msv); U8 in_eval = PL_in_eval; PERL_ARGS_ASSERT_DIE_UNWIND; @@ -1693,20 +1677,18 @@ Perl_die_unwind(pTHX_ SV *msv) PL_restartjmpenv = restartjmpenv; PL_restartop = restartop; JMPENV_JUMP(3); - /* NOTREACHED */ - assert(0); + assert(0); /* NOTREACHED */ } } write_to_stderr(exceptsv); my_failure_exit(); - /* NOTREACHED */ - assert(0); + assert(0); /* NOTREACHED */ } PP(pp_xor) { - dVAR; dSP; dPOPTOPssrl; + dSP; dPOPTOPssrl; if (SvTRUE(left) != SvTRUE(right)) RETSETYES; else @@ -1778,7 +1760,6 @@ Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp) PP(pp_caller) { - dVAR; dSP; const PERL_CONTEXT *cx; const PERL_CONTEXT *dbcx; @@ -1830,7 +1811,7 @@ PP(pp_caller) PUSHTARG; } mPUSHs(newSVpv(OutCopFILE(cx->blk_oldcop), 0)); - lcop = closest_cop(cx->blk_oldcop, cx->blk_oldcop->op_sibling, + lcop = closest_cop(cx->blk_oldcop, OP_SIBLING(cx->blk_oldcop), cx->blk_sub.retop, TRUE); if (!lcop) lcop = cx->blk_oldcop; @@ -1938,7 +1919,6 @@ PP(pp_caller) PP(pp_reset) { - dVAR; dSP; const char * tmps; STRLEN len = 0; @@ -1955,7 +1935,6 @@ PP(pp_reset) PP(pp_dbstate) { - dVAR; PL_curcop = (COP*)PL_op; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -2068,7 +2047,7 @@ S_adjust_stack_on_leave(pTHX_ SV **newsp, SV **sp, SV **mark, I32 gimme, PP(pp_enter) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; I32 gimme = GIMME_V; @@ -2082,7 +2061,7 @@ PP(pp_enter) PP(pp_leave) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; SV **newsp; PMOP *newpm; @@ -2109,7 +2088,7 @@ PP(pp_leave) PP(pp_enteriter) { - dVAR; dSP; dMARK; + dSP; dMARK; PERL_CONTEXT *cx; const I32 gimme = GIMME_V; void *itervar; /* location of the iteration variable */ @@ -2232,7 +2211,7 @@ PP(pp_enteriter) PP(pp_enterloop) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; const I32 gimme = GIMME_V; @@ -2248,7 +2227,7 @@ PP(pp_enterloop) PP(pp_leaveloop) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; I32 gimme; SV **newsp; @@ -2386,7 +2365,7 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme, PP(pp_return) { - dVAR; dSP; dMARK; + dSP; dMARK; PERL_CONTEXT *cx; bool popsub2 = FALSE; bool clear_errsv = FALSE; @@ -2527,7 +2506,7 @@ PP(pp_return) * pp_return */ PP(pp_leavesublv) { - dVAR; dSP; + dSP; SV **newsp; PMOP *newpm; I32 gimme; @@ -2556,7 +2535,6 @@ PP(pp_leavesublv) static I32 S_unwind_loop(pTHX_ const char * const opname) { - dVAR; I32 cxix; if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); @@ -2595,7 +2573,6 @@ S_unwind_loop(pTHX_ const char * const opname) PP(pp_last) { - dVAR; PERL_CONTEXT *cx; I32 pop2 = 0; I32 gimme; @@ -2662,7 +2639,6 @@ PP(pp_last) PP(pp_next) { - dVAR; PERL_CONTEXT *cx; const I32 inner = PL_scopestack_ix; @@ -2680,7 +2656,6 @@ PP(pp_next) PP(pp_redo) { - dVAR; const I32 cxix = S_unwind_loop(aTHX_ "redo"); PERL_CONTEXT *cx; I32 oldsave; @@ -2705,7 +2680,6 @@ PP(pp_redo) STATIC OP * S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit) { - dVAR; OP **ops = opstack; static const char* const too_deep = "Target of goto is too deeply nested"; @@ -2727,7 +2701,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac if (o->op_flags & OPf_KIDS) { OP *kid; /* First try all the kids at this level, since that's likeliest. */ - for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { + for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid)) { if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) { STRLEN kid_label_len; U32 kid_label_flags; @@ -2747,7 +2721,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac return kid; } } - for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) { + for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid)) { if (kid == PL_lastgotoprobe) continue; if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) { @@ -3033,13 +3007,13 @@ PP(pp_goto) /* also pp_dump */ case CXt_LOOP_PLAIN: case CXt_GIVEN: case CXt_WHEN: - gotoprobe = cx->blk_oldcop->op_sibling; + gotoprobe = OP_SIBLING(cx->blk_oldcop); break; case CXt_SUBST: continue; case CXt_BLOCK: if (ix) { - gotoprobe = cx->blk_oldcop->op_sibling; + gotoprobe = OP_SIBLING(cx->blk_oldcop); in_block = TRUE; } else gotoprobe = PL_main_root; @@ -3061,14 +3035,17 @@ PP(pp_goto) /* also pp_dump */ break; } if (gotoprobe) { + OP *sibl1, *sibl2; + retop = dofindlabel(gotoprobe, label, label_len, label_flags, enterops, enterops + GOTO_DEPTH); if (retop) break; - if (gotoprobe->op_sibling && - gotoprobe->op_sibling->op_type == OP_UNSTACK && - gotoprobe->op_sibling->op_sibling) { - retop = dofindlabel(gotoprobe->op_sibling->op_sibling, + if ( (sibl1 = OP_SIBLING(gotoprobe)) && + sibl1->op_type == OP_UNSTACK && + (sibl2 = OP_SIBLING(sibl1))) + { + retop = dofindlabel(sibl2, label, label_len, label_flags, enterops, enterops + GOTO_DEPTH); if (retop) @@ -3147,7 +3124,6 @@ PP(pp_goto) /* also pp_dump */ PP(pp_exit) { - dVAR; dSP; I32 anum; @@ -3216,7 +3192,6 @@ establish a local jmpenv to handle exception traps. STATIC OP * S_docatch(pTHX_ OP *o) { - dVAR; int ret; OP * const oldop = PL_op; dJMPENV; @@ -3248,8 +3223,7 @@ S_docatch(pTHX_ OP *o) JMPENV_POP; PL_op = oldop; JMPENV_JUMP(ret); - /* NOTREACHED */ - assert(0); + assert(0); /* NOTREACHED */ } JMPENV_POP; PL_op = oldop; @@ -3279,7 +3253,6 @@ Perl_find_runcv(pTHX_ U32 *db_seqp) CV * Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp) { - dVAR; PERL_SI *si; int level = 0; @@ -3348,8 +3321,7 @@ S_try_yyparse(pTHX_ int gramtype) default: JMPENV_POP; JMPENV_JUMP(ret); - /* NOTREACHED */ - assert(0); + assert(0); /* NOTREACHED */ } JMPENV_POP; return ret; @@ -3373,7 +3345,7 @@ S_try_yyparse(pTHX_ int gramtype) STATIC bool S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh) { - dVAR; dSP; + dSP; OP * const saveop = PL_op; bool clear_hints = saveop->op_type != OP_ENTEREVAL; COP * const oldcurcop = PL_curcop; @@ -3682,7 +3654,7 @@ S_path_is_searchable(const char *name) PP(pp_require) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; SV *sv; const char *name; @@ -3708,6 +3680,7 @@ PP(pp_require) bool path_searchable; sv = POPs; + SvGETMAGIC(sv); if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) { sv = sv_2mortal(new_version(sv)); if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0)) @@ -3765,9 +3738,12 @@ PP(pp_require) RETPUSHYES; } - name = SvPV_const(sv, len); + if (!SvOK(sv)) + DIE(aTHX_ "Missing or undefined argument to require"); + name = SvPV_nomg_const(sv, len); if (!(name && len > 0 && *name)) - DIE(aTHX_ "Null filename used"); + DIE(aTHX_ "Missing or undefined argument to require"); + if (!IS_SAFE_PATHNAME(name, len, "require")) { DIE(aTHX_ "Can't locate %s: %s", pv_escape(newSVpvs_flags("",SVs_TEMP),SvPVX(sv),SvCUR(sv), @@ -4168,7 +4144,6 @@ PP(pp_require) PP(pp_hintseval) { - dVAR; dSP; mXPUSHs(MUTABLE_SV(hv_copy_hints_hv(MUTABLE_HV(cSVOP_sv)))); RETURN; @@ -4177,7 +4152,7 @@ PP(pp_hintseval) PP(pp_entereval) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; SV *sv; const I32 gimme = GIMME_V; @@ -4305,7 +4280,7 @@ PP(pp_entereval) PP(pp_leaveeval) { - dVAR; dSP; + dSP; SV **newsp; PMOP *newpm; I32 gimme; @@ -4342,8 +4317,7 @@ PP(pp_leaveeval) SvUTF8(namesv) ? -(I32)SvCUR(namesv) : (I32)SvCUR(namesv), G_DISCARD); Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(namesv)); - /* NOTREACHED */ - NOT_REACHED; + NOT_REACHED; /* NOTREACHED */ /* die_unwind() did LEAVE, or we won't be here */ } else { @@ -4403,7 +4377,6 @@ Perl_create_eval_scope(pTHX_ U32 flags) PP(pp_entertry) { - dVAR; PERL_CONTEXT * const cx = create_eval_scope(0); cx->blk_eval.retop = cLOGOP->op_other->op_next; return DOCATCH(PL_op->op_next); @@ -4411,7 +4384,7 @@ PP(pp_entertry) PP(pp_leavetry) { - dVAR; dSP; + dSP; SV **newsp; PMOP *newpm; I32 gimme; @@ -4435,7 +4408,7 @@ PP(pp_leavetry) PP(pp_entergiven) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; const I32 gimme = GIMME_V; @@ -4460,7 +4433,7 @@ PP(pp_entergiven) PP(pp_leavegiven) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; I32 gimme; SV **newsp; @@ -4483,7 +4456,6 @@ PP(pp_leavegiven) STATIC PMOP * S_make_matcher(pTHX_ REGEXP *re) { - dVAR; PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED); PERL_ARGS_ASSERT_MAKE_MATCHER; @@ -4499,7 +4471,6 @@ S_make_matcher(pTHX_ REGEXP *re) STATIC bool S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv) { - dVAR; dSP; PERL_ARGS_ASSERT_MATCHER_MATCHES_SV; @@ -4515,8 +4486,6 @@ S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv) STATIC void S_destroy_matcher(pTHX_ PMOP *matcher) { - dVAR; - PERL_ARGS_ASSERT_DESTROY_MATCHER; PERL_UNUSED_ARG(matcher); @@ -4537,7 +4506,6 @@ PP(pp_smartmatch) STATIC OP * S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied) { - dVAR; dSP; bool object_on_left = FALSE; @@ -5009,7 +4977,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied) PP(pp_enterwhen) { - dVAR; dSP; + dSP; PERL_CONTEXT *cx; const I32 gimme = GIMME_V; @@ -5033,7 +5001,7 @@ PP(pp_enterwhen) PP(pp_leavewhen) { - dVAR; dSP; + dSP; I32 cxix; PERL_CONTEXT *cx; I32 gimme; @@ -5081,7 +5049,7 @@ PP(pp_leavewhen) PP(pp_continue) { - dVAR; dSP; + dSP; I32 cxix; PERL_CONTEXT *cx; I32 gimme; @@ -5109,7 +5077,6 @@ PP(pp_continue) PP(pp_break) { - dVAR; I32 cxix; PERL_CONTEXT *cx; @@ -5412,7 +5379,6 @@ S_num_overflow(NV value, I32 fldsize, I32 frcsize) static I32 S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) { - dVAR; SV * const datasv = FILTER_DATA(idx); const int filter_has_file = IoLINES(datasv); SV * const filter_state = MUTABLE_SV(IoTOP_GV(datasv));