summaryrefslogtreecommitdiff
path: root/op.c
diff options
context:
space:
mode:
Diffstat (limited to 'op.c')
-rw-r--r--op.c259
1 files changed, 256 insertions, 3 deletions
diff --git a/op.c b/op.c
index e82e29adc9..f38ce49c49 100644
--- a/op.c
+++ b/op.c
@@ -210,6 +210,9 @@ S_Slab_to_rw(pTHX_ void *op)
{
I32 * const * const ptr = (I32 **) op;
I32 * const slab = ptr[-1];
+
+ PERL_ARGS_ASSERT_SLAB_TO_RW;
+
assert( ptr-1 > (I32 **) slab );
assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
assert( *slab > 0 );
@@ -233,6 +236,7 @@ Perl_op_refcnt_inc(pTHX_ OP *o)
PADOFFSET
Perl_op_refcnt_dec(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_OP_REFCNT_DEC;
Slab_to_rw(o);
return --o->op_targ;
}
@@ -245,6 +249,7 @@ Perl_Slab_Free(pTHX_ void *op)
{
I32 * const * const ptr = (I32 **) op;
I32 * const slab = ptr[-1];
+ PERL_ARGS_ASSERT_SLAB_FREE;
assert( ptr-1 > (I32 **) slab );
assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
assert( *slab > 0 );
@@ -304,6 +309,9 @@ STATIC const char*
S_gv_ename(pTHX_ GV *gv)
{
SV* const tmpsv = sv_newmortal();
+
+ PERL_ARGS_ASSERT_GV_ENAME;
+
gv_efullname3(tmpsv, gv, NULL);
return SvPV_nolen_const(tmpsv);
}
@@ -311,6 +319,8 @@ S_gv_ename(pTHX_ GV *gv)
STATIC OP *
S_no_fh_allowed(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_NO_FH_ALLOWED;
+
yyerror(Perl_form(aTHX_ "Missing comma after first argument to %s function",
OP_DESC(o)));
return o;
@@ -319,6 +329,8 @@ S_no_fh_allowed(pTHX_ OP *o)
STATIC OP *
S_too_few_arguments(pTHX_ OP *o, const char *name)
{
+ PERL_ARGS_ASSERT_TOO_FEW_ARGUMENTS;
+
yyerror(Perl_form(aTHX_ "Not enough arguments for %s", name));
return o;
}
@@ -326,6 +338,8 @@ S_too_few_arguments(pTHX_ OP *o, const char *name)
STATIC OP *
S_too_many_arguments(pTHX_ OP *o, const char *name)
{
+ PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS;
+
yyerror(Perl_form(aTHX_ "Too many arguments for %s", name));
return o;
}
@@ -333,6 +347,8 @@ S_too_many_arguments(pTHX_ OP *o, const char *name)
STATIC void
S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid)
{
+ PERL_ARGS_ASSERT_BAD_TYPE;
+
yyerror(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)",
(int)n, name, t, OP_DESC(kid)));
}
@@ -340,6 +356,8 @@ S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid)
STATIC void
S_no_bareword_allowed(pTHX_ const OP *o)
{
+ PERL_ARGS_ASSERT_NO_BAREWORD_ALLOWED;
+
if (PL_madskills)
return; /* various ok barewords are hidden in extra OP_NULL */
qerror(Perl_mess(aTHX_
@@ -356,6 +374,8 @@ Perl_allocmy(pTHX_ const char *const name)
PADOFFSET off;
const bool is_our = (PL_parser->in_my == KEY_our);
+ PERL_ARGS_ASSERT_ALLOCMY;
+
/* complain about "my $<special_var>" etc etc */
if (*name &&
!(is_our ||
@@ -506,6 +526,9 @@ Perl_op_clear(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_OP_CLEAR;
+
#ifdef PERL_MAD
/* if (o->op_madprop && o->op_madprop->mad_next)
abort(); */
@@ -646,6 +669,8 @@ clear_pmop:
STATIC void
S_cop_free(pTHX_ COP* cop)
{
+ PERL_ARGS_ASSERT_COP_FREE;
+
CopLABEL_free(cop);
CopFILE_free(cop);
CopSTASH_free(cop);
@@ -662,6 +687,9 @@ S_forget_pmop(pTHX_ PMOP *const o
)
{
HV * const pmstash = PmopSTASH(o);
+
+ PERL_ARGS_ASSERT_FORGET_PMOP;
+
if (pmstash && !SvIS_FREED(pmstash)) {
MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
if (mg) {
@@ -697,6 +725,8 @@ S_forget_pmop(pTHX_ PMOP *const o
STATIC void
S_find_and_forget_pmops(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_FIND_AND_FORGET_PMOPS;
+
if (o->op_flags & OPf_KIDS) {
OP *kid = cUNOPo->op_first;
while (kid) {
@@ -717,6 +747,9 @@ void
Perl_op_null(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_OP_NULL;
+
if (o->op_type == OP_NULL)
return;
if (!PL_madskills)
@@ -751,6 +784,8 @@ Perl_linklist(pTHX_ OP *o)
{
OP *first;
+ PERL_ARGS_ASSERT_LINKLIST;
+
if (o->op_next)
return o->op_next;
@@ -791,6 +826,9 @@ STATIC OP *
S_scalarboolean(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_SCALARBOOLEAN;
+
if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
if (ckWARN(WARN_SYNTAX)) {
const line_t oldline = CopLINE(PL_curcop);
@@ -885,6 +923,8 @@ Perl_scalarvoid(pTHX_ OP *o)
SV* sv;
U8 want;
+ PERL_ARGS_ASSERT_SCALARVOID;
+
/* trailing mad null ops don't count as "there" for void processing */
if (PL_madskills &&
o->op_type != OP_NULL &&
@@ -1627,6 +1667,8 @@ Perl_mod(pTHX_ OP *o, I32 type)
STATIC bool
S_scalar_mod_type(const OP *o, I32 type)
{
+ PERL_ARGS_ASSERT_SCALAR_MOD_TYPE;
+
switch (type) {
case OP_SASSIGN:
if (o->op_type == OP_RV2GV)
@@ -1675,6 +1717,8 @@ S_scalar_mod_type(const OP *o, I32 type)
STATIC bool
S_is_handle_constructor(const OP *o, I32 numargs)
{
+ PERL_ARGS_ASSERT_IS_HANDLE_CONSTRUCTOR;
+
switch (o->op_type) {
case OP_PIPE_OP:
case OP_SOCKPAIR:
@@ -1712,6 +1756,8 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
dVAR;
OP *kid;
+ PERL_ARGS_ASSERT_DOREF;
+
if (!o || (PL_parser && PL_parser->error_count))
return o;
@@ -1803,6 +1849,8 @@ S_dup_attrlist(pTHX_ OP *o)
dVAR;
OP *rop;
+ PERL_ARGS_ASSERT_DUP_ATTRLIST;
+
/* An attrlist is either a simple OP_CONST or an OP_LIST with kids,
* where the first kid is OP_PUSHMARK and the remaining ones
* are OP_CONST. We need to push the OP_CONST values.
@@ -1832,6 +1880,8 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
dVAR;
SV *stashsv;
+ PERL_ARGS_ASSERT_APPLY_ATTRS;
+
/* fake up C<use attributes $pkg,$rv,@attrs> */
ENTER; /* need to protect against side-effects of 'use' */
stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
@@ -1869,6 +1919,8 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
OP *pack, *imop, *arg;
SV *meth, *stashsv;
+ PERL_ARGS_ASSERT_APPLY_ATTRS_MY;
+
if (!attrs)
return;
@@ -1929,6 +1981,8 @@ Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv,
{
OP *attrs = NULL;
+ PERL_ARGS_ASSERT_APPLY_ATTRS_STRING;
+
if (!len) {
len = strlen(attrstr);
}
@@ -1960,6 +2014,8 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
dVAR;
I32 type;
+ PERL_ARGS_ASSERT_MY_KID;
+
if (!o || (PL_parser && PL_parser->error_count))
return o;
@@ -2039,6 +2095,8 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
OP *rops;
int maybe_scalar = 0;
+ PERL_ARGS_ASSERT_MY_ATTRS;
+
/* [perl #17376]: this appears to be premature, and results in code such as
C< our(%x); > executing in list mode rather than void mode */
#if 0
@@ -2069,6 +2127,8 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
OP *
Perl_my(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_MY;
+
return my_attrs(o, NULL);
}
@@ -2089,6 +2149,8 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
const OPCODE ltype = left->op_type;
const OPCODE rtype = right->op_type;
+ PERL_ARGS_ASSERT_BIND_MATCH;
+
if ( (ltype == OP_RV2AV || ltype == OP_RV2HV || ltype == OP_PADAV
|| ltype == OP_PADHV) && ckWARN(WARN_MISC))
{
@@ -2224,6 +2286,9 @@ void
Perl_newPROG(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_NEWPROG;
+
if (PL_in_eval) {
if (PL_eval_root)
return;
@@ -2271,6 +2336,9 @@ OP *
Perl_localize(pTHX_ OP *o, I32 lex)
{
dVAR;
+
+ PERL_ARGS_ASSERT_LOCALIZE;
+
if (o->op_flags & OPf_PARENS)
/* [perl #17376]: this appears to be premature, and results in code such as
C< our(%x); > executing in list mode rather than void mode */
@@ -2329,6 +2397,8 @@ Perl_localize(pTHX_ OP *o, I32 lex)
OP *
Perl_jmaybe(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_JMAYBE;
+
if (o->op_type == OP_LIST) {
OP * const o2
= newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, SVt_PV)));
@@ -2352,6 +2422,8 @@ Perl_fold_constants(pTHX_ register OP *o)
SV * const olddiehook = PL_diehook;
dJMPENV;
+ PERL_ARGS_ASSERT_FOLD_CONSTANTS;
+
if (PL_opargs[type] & OA_RETSCALAR)
scalar(o);
if (PL_opargs[type] & OA_TARGET && !o->op_targ)
@@ -2644,6 +2716,8 @@ Perl_newTOKEN(pTHX_ I32 optype, YYSTYPE lval, MADPROP* madprop)
void
Perl_token_free(pTHX_ TOKEN* tk)
{
+ PERL_ARGS_ASSERT_TOKEN_FREE;
+
if (tk->tk_type != 12345)
return;
mad_free(tk->tk_mad);
@@ -2655,6 +2729,9 @@ Perl_token_getmad(pTHX_ TOKEN* tk, OP* o, char slot)
{
MADPROP* mp;
MADPROP* tm;
+
+ PERL_ARGS_ASSERT_TOKEN_GETMAD;
+
if (tk->tk_type != 12345) {
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Invalid TOKEN object ignored");
@@ -2818,6 +2895,8 @@ Perl_addmad(pTHX_ MADPROP* tm, MADPROP** root, char slot)
MADPROP *
Perl_newMADsv(pTHX_ char key, SV* sv)
{
+ PERL_ARGS_ASSERT_NEWMADSV;
+
return newMADPROP(key, MAD_SV, sv, 0);
}
@@ -3035,6 +3114,9 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
const I32 squash = o->op_private & OPpTRANS_SQUASH;
I32 del = o->op_private & OPpTRANS_DELETE;
SV* swash;
+
+ PERL_ARGS_ASSERT_PMTRANS;
+
PL_hints |= HINT_BLOCK_SCOPE;
if (SvUTF8(tstr))
@@ -3411,6 +3493,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
OP* repl = NULL;
bool reglist;
+ PERL_ARGS_ASSERT_PMRUNTIME;
+
if (o->op_type == OP_SUBST || o->op_type == OP_TRANS) {
/* last element in list is the replacement; pop it */
OP* kid;
@@ -3590,6 +3674,9 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
{
dVAR;
SVOP *svop;
+
+ PERL_ARGS_ASSERT_NEWSVOP;
+
NewOp(1101, svop, 1, SVOP);
svop->op_type = (OPCODE)type;
svop->op_ppaddr = PL_ppaddr[type];
@@ -3609,6 +3696,9 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
{
dVAR;
PADOP *padop;
+
+ PERL_ARGS_ASSERT_NEWPADOP;
+
NewOp(1101, padop, 1, PADOP);
padop->op_type = (OPCODE)type;
padop->op_ppaddr = PL_ppaddr[type];
@@ -3631,7 +3721,9 @@ OP *
Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
{
dVAR;
- assert(gv);
+
+ PERL_ARGS_ASSERT_NEWGVOP;
+
#ifdef USE_ITHREADS
GvIN_PAD_on(gv);
return newPADOP(type, flags, SvREFCNT_inc_simple_NN(gv));
@@ -3671,6 +3763,8 @@ Perl_package(pTHX_ OP *o)
OP *pegop;
#endif
+ PERL_ARGS_ASSERT_PACKAGE;
+
save_hptr(&PL_curstash);
save_item(PL_curstname);
@@ -3711,6 +3805,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
OP *pegop = newOP(OP_NULL,0);
#endif
+ PERL_ARGS_ASSERT_UTILIZE;
+
if (idop->op_type != OP_CONST)
Perl_croak(aTHX_ "Module name must be constant");
@@ -3838,6 +3934,9 @@ void
Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...)
{
va_list args;
+
+ PERL_ARGS_ASSERT_LOAD_MODULE;
+
va_start(args, ver);
vload_module(flags, name, ver, &args);
va_end(args);
@@ -3849,6 +3948,7 @@ Perl_load_module_nocontext(U32 flags, SV *name, SV *ver, ...)
{
dTHX;
va_list args;
+ PERL_ARGS_ASSERT_LOAD_MODULE_NOCONTEXT;
va_start(args, ver);
vload_module(flags, name, ver, &args);
va_end(args);
@@ -3860,8 +3960,10 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
{
dVAR;
OP *veop, *imop;
-
OP * const modname = newSVOP(OP_CONST, 0, name);
+
+ PERL_ARGS_ASSERT_VLOAD_MODULE;
+
modname->op_private |= OPpCONST_BARE;
if (ver) {
veop = newSVOP(OP_CONST, 0, ver);
@@ -3905,6 +4007,8 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin)
OP *doop;
GV *gv = NULL;
+ PERL_ARGS_ASSERT_DOFILE;
+
if (!force_builtin) {
gv = gv_fetchpvs("do", GV_NOTQUAL, SVt_PVCV);
if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) {
@@ -4295,6 +4399,9 @@ OP *
Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other)
{
dVAR;
+
+ PERL_ARGS_ASSERT_NEWLOGOP;
+
return new_logop(type, flags, &first, &other);
}
@@ -4307,6 +4414,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
OP *first = *firstp;
OP * const other = *otherp;
+ PERL_ARGS_ASSERT_NEW_LOGOP;
+
if (type == OP_XOR) /* Not short circuit, but here by precedence. */
return newBINOP(type, flags, scalar(first), scalar(other));
@@ -4457,6 +4566,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
OP *start;
OP *o;
+ PERL_ARGS_ASSERT_NEWCONDOP;
+
if (!falseop)
return newLOGOP(OP_AND, 0, first, trueop);
if (!trueop)
@@ -4519,6 +4630,8 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
OP *leftstart;
OP *o;
+ PERL_ARGS_ASSERT_NEWRANGE;
+
NewOp(1101, range, 1, LOGOP);
range->op_type = OP_RANGE;
@@ -4730,6 +4843,8 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
I32 iterpflags = 0;
OP *madsv = NULL;
+ PERL_ARGS_ASSERT_NEWFOROP;
+
if (sv) {
if (sv->op_type == OP_RV2SV) { /* symbol table variable */
iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */
@@ -4849,6 +4964,8 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
dVAR;
OP *o;
+ PERL_ARGS_ASSERT_NEWLOOPEX;
+
if (type != OP_GOTO || label->op_type == OP_CONST) {
/* "last()" means "last" */
if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
@@ -4913,6 +5030,8 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
LOGOP *enterop;
OP *o;
+ PERL_ARGS_ASSERT_NEWGIVWHENOP;
+
NewOp(1101, enterop, 1, LOGOP);
enterop->op_type = enter_opcode;
enterop->op_ppaddr = PL_ppaddr[enter_opcode];
@@ -4962,6 +5081,9 @@ STATIC bool
S_looks_like_bool(pTHX_ const OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_LOOKS_LIKE_BOOL;
+
switch(o->op_type) {
case OP_OR:
return looks_like_bool(cLOGOPo->op_first);
@@ -5023,7 +5145,7 @@ OP *
Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off)
{
dVAR;
- assert( cond );
+ PERL_ARGS_ASSERT_NEWGIVENOP;
return newGIVWHENOP(
ref_array_or_hash(cond),
block,
@@ -5038,6 +5160,8 @@ Perl_newWHENOP(pTHX_ OP *cond, OP *block)
const bool cond_llb = (!cond || looks_like_bool(cond));
OP *cond_op;
+ PERL_ARGS_ASSERT_NEWWHENOP;
+
if (cond_llb)
cond_op = cond;
else {
@@ -5068,6 +5192,8 @@ Perl_cv_undef(pTHX_ CV *cv)
{
dVAR;
+ PERL_ARGS_ASSERT_CV_UNDEF;
+
DEBUG_X(PerlIO_printf(Perl_debug_log,
"CV undef: cv=0x%"UVxf" comppad=0x%"UVxf"\n",
PTR2UV(cv), PTR2UV(PL_comppad))
@@ -5119,6 +5245,8 @@ void
Perl_cv_ckproto_len(pTHX_ const CV *cv, const GV *gv, const char *p,
const STRLEN len)
{
+ PERL_ARGS_ASSERT_CV_CKPROTO_LEN;
+
/* Can't just use a strcmp on the prototype, as CONSTSUBs "cheat" by
relying on SvCUR, and doubling up the buffer to hold CvFILE(). */
if (((!p != !SvPOK(cv)) /* One has prototype, one has not. */
@@ -5652,6 +5780,8 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
const char *const colon = strrchr(fullname,':');
const char *const name = colon ? colon + 1 : fullname;
+ PERL_ARGS_ASSERT_PROCESS_SPECIAL_BLOCKS;
+
if (*name == 'B') {
if (strEQ(name, "BEGIN")) {
const I32 oldscope = PL_scopestack_ix;
@@ -5780,6 +5910,8 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
{
CV *cv = newXS(name, subaddr, filename);
+ PERL_ARGS_ASSERT_NEWXS_FLAGS;
+
if (flags & XS_DYNAMIC_FILENAME) {
/* We need to "make arrangements" (ie cheat) to ensure that the
filename lasts as long as the PVCV we just created, but also doesn't
@@ -5836,6 +5968,8 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
GV_ADDMULTI, SVt_PVCV);
register CV *cv;
+ PERL_ARGS_ASSERT_NEWXS;
+
if (!subaddr)
Perl_croak(aTHX_ "panic: no address for '%s' in '%s'", name, filename);
@@ -5989,6 +6123,9 @@ OP *
Perl_oopsAV(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_OOPSAV;
+
switch (o->op_type) {
case OP_PADSV:
o->op_type = OP_PADAV;
@@ -6013,6 +6150,9 @@ OP *
Perl_oopsHV(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_OOPSHV;
+
switch (o->op_type) {
case OP_PADSV:
case OP_PADAV:
@@ -6039,6 +6179,9 @@ OP *
Perl_newAVREF(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_NEWAVREF;
+
if (o->op_type == OP_PADANY) {
o->op_type = OP_PADAV;
o->op_ppaddr = PL_ppaddr[OP_PADAV];
@@ -6064,6 +6207,9 @@ OP *
Perl_newHVREF(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_NEWHVREF;
+
if (o->op_type == OP_PADANY) {
o->op_type = OP_PADHV;
o->op_ppaddr = PL_ppaddr[OP_PADHV];
@@ -6087,6 +6233,9 @@ OP *
Perl_newSVREF(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_NEWSVREF;
+
if (o->op_type == OP_PADANY) {
o->op_type = OP_PADSV;
o->op_ppaddr = PL_ppaddr[OP_PADSV];
@@ -6101,6 +6250,8 @@ Perl_newSVREF(pTHX_ OP *o)
OP *
Perl_ck_anoncode(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_ANONCODE;
+
cSVOPo->op_targ = pad_add_anon(cSVOPo->op_sv, o->op_type);
if (!PL_madskills)
cSVOPo->op_sv = NULL;
@@ -6111,6 +6262,9 @@ OP *
Perl_ck_bitop(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_CK_BITOP;
+
#define OP_IS_NUMCOMPARE(op) \
((op) == OP_LT || (op) == OP_I_LT || \
(op) == OP_GT || (op) == OP_I_GT || \
@@ -6145,7 +6299,10 @@ OP *
Perl_ck_concat(pTHX_ OP *o)
{
const OP * const kid = cUNOPo->op_first;
+
+ PERL_ARGS_ASSERT_CK_CONCAT;
PERL_UNUSED_CONTEXT;
+
if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) &&
!(kUNOP->op_first->op_flags & OPf_MOD))
o->op_flags |= OPf_STACKED;
@@ -6156,6 +6313,9 @@ OP *
Perl_ck_spair(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_CK_SPAIR;
+
if (o->op_flags & OPf_KIDS) {
OP* newop;
OP* kid;
@@ -6184,6 +6344,8 @@ Perl_ck_spair(pTHX_ OP *o)
OP *
Perl_ck_delete(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_DELETE;
+
o = ck_fun(o);
o->op_private = 0;
if (o->op_flags & OPf_KIDS) {
@@ -6212,6 +6374,8 @@ Perl_ck_delete(pTHX_ OP *o)
OP *
Perl_ck_die(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_DIE;
+
#ifdef VMS
if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH;
#endif
@@ -6223,6 +6387,8 @@ Perl_ck_eof(pTHX_ OP *o)
{
dVAR;
+ PERL_ARGS_ASSERT_CK_EOF;
+
if (o->op_flags & OPf_KIDS) {
if (cLISTOPo->op_first->op_type == OP_STUB) {
OP * const newop
@@ -6243,6 +6409,9 @@ OP *
Perl_ck_eval(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_CK_EVAL;
+
PL_hints |= HINT_BLOCK_SCOPE;
if (o->op_flags & OPf_KIDS) {
SVOP * const kid = (SVOP*)cUNOPo->op_first;
@@ -6308,6 +6477,8 @@ Perl_ck_eval(pTHX_ OP *o)
OP *
Perl_ck_exit(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_EXIT;
+
#ifdef VMS
HV * const table = GvHV(PL_hintgv);
if (table) {
@@ -6323,6 +6494,8 @@ Perl_ck_exit(pTHX_ OP *o)
OP *
Perl_ck_exec(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_EXEC;
+
if (o->op_flags & OPf_STACKED) {
OP *kid;
o = ck_fun(o);
@@ -6339,6 +6512,9 @@ OP *
Perl_ck_exists(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_CK_EXISTS;
+
o = ck_fun(o);
if (o->op_flags & OPf_KIDS) {
OP * const kid = cUNOPo->op_first;
@@ -6366,6 +6542,8 @@ Perl_ck_rvconst(pTHX_ register OP *o)
dVAR;
SVOP * const kid = (SVOP*)cUNOPo->op_first;
+ PERL_ARGS_ASSERT_CK_RVCONST;
+
o->op_private |= (PL_hints & HINT_STRICT_REFS);
if (o->op_type == OP_RV2CV)
o->op_private &= ~1;
@@ -6482,6 +6660,8 @@ Perl_ck_ftst(pTHX_ OP *o)
dVAR;
const I32 type = o->op_type;
+ PERL_ARGS_ASSERT_CK_FTST;
+
if (o->op_flags & OPf_REF) {
NOOP;
}
@@ -6527,6 +6707,8 @@ Perl_ck_fun(pTHX_ OP *o)
const int type = o->op_type;
register I32 oa = PL_opargs[type] >> OASHIFT;
+ PERL_ARGS_ASSERT_CK_FUN;
+
if (o->op_flags & OPf_STACKED) {
if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
oa &= ~OA_OPTIONAL;
@@ -6802,6 +6984,8 @@ Perl_ck_glob(pTHX_ OP *o)
dVAR;
GV *gv;
+ PERL_ARGS_ASSERT_CK_GLOB;
+
o = ck_fun(o);
if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
append_elem(OP_GLOB, o, newDEFSVOP());
@@ -6860,6 +7044,8 @@ Perl_ck_grep(pTHX_ OP *o)
const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
PADOFFSET offset;
+ PERL_ARGS_ASSERT_CK_GREP;
+
o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
/* don't allocate gwop here, as we may leak it if PL_parser->error_count > 0 */
@@ -6919,6 +7105,8 @@ Perl_ck_grep(pTHX_ OP *o)
OP *
Perl_ck_index(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_INDEX;
+
if (o->op_flags & OPf_KIDS) {
OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (kid)
@@ -6932,6 +7120,8 @@ Perl_ck_index(pTHX_ OP *o)
OP *
Perl_ck_lengthconst(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_LENGTHCONST;
+
/* XXX length optimization goes here */
return ck_fun(o);
}
@@ -6940,12 +7130,17 @@ OP *
Perl_ck_lfun(pTHX_ OP *o)
{
const OPCODE type = o->op_type;
+
+ PERL_ARGS_ASSERT_CK_LFUN;
+
return modkids(ck_fun(o), type);
}
OP *
Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */
{
+ PERL_ARGS_ASSERT_CK_DEFINED;
+
if ((o->op_flags & OPf_KIDS) && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) {
switch (cUNOPo->op_first->op_type) {
case OP_RV2AV:
@@ -6984,6 +7179,8 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */
OP *
Perl_ck_readline(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_READLINE;
+
if (!(o->op_flags & OPf_KIDS)) {
OP * const newop
= newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, PL_argvgv));
@@ -7001,6 +7198,9 @@ OP *
Perl_ck_rfun(pTHX_ OP *o)
{
const OPCODE type = o->op_type;
+
+ PERL_ARGS_ASSERT_CK_RFUN;
+
return refkids(ck_fun(o), type);
}
@@ -7009,6 +7209,8 @@ Perl_ck_listiob(pTHX_ OP *o)
{
register OP *kid;
+ PERL_ARGS_ASSERT_CK_LISTIOB;
+
kid = cLISTOPo->op_first;
if (!kid) {
o = force_list(o);
@@ -7067,6 +7269,9 @@ Perl_ck_sassign(pTHX_ OP *o)
{
dVAR;
OP * const kid = cLISTOPo->op_first;
+
+ PERL_ARGS_ASSERT_CK_SASSIGN;
+
/* has a disposable target? */
if ((PL_opargs[kid->op_type] & OA_TARGLEX)
&& !(kid->op_flags & OPf_STACKED)
@@ -7128,6 +7333,9 @@ OP *
Perl_ck_match(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_CK_MATCH;
+
if (o->op_type != OP_QR && PL_compcv) {
const PADOFFSET offset = pad_findmy("$_");
if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) {
@@ -7144,6 +7352,9 @@ OP *
Perl_ck_method(pTHX_ OP *o)
{
OP * const kid = cUNOPo->op_first;
+
+ PERL_ARGS_ASSERT_CK_METHOD;
+
if (kid->op_type == OP_CONST) {
SV* sv = kSVOP->op_sv;
const char * const method = SvPVX_const(sv);
@@ -7170,6 +7381,7 @@ Perl_ck_method(pTHX_ OP *o)
OP *
Perl_ck_null(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_NULL;
PERL_UNUSED_CONTEXT;
return o;
}
@@ -7179,6 +7391,9 @@ Perl_ck_open(pTHX_ OP *o)
{
dVAR;
HV * const table = GvHV(PL_hintgv);
+
+ PERL_ARGS_ASSERT_CK_OPEN;
+
if (table) {
SV **svp = hv_fetchs(table, "open_IN", FALSE);
if (svp && *svp) {
@@ -7236,6 +7451,8 @@ Perl_ck_open(pTHX_ OP *o)
OP *
Perl_ck_repeat(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_REPEAT;
+
if (cBINOPo->op_first->op_flags & OPf_PARENS) {
o->op_private |= OPpREPEAT_DOLIST;
cBINOPo->op_first = force_list(cBINOPo->op_first);
@@ -7251,6 +7468,8 @@ Perl_ck_require(pTHX_ OP *o)
dVAR;
GV* gv = NULL;
+ PERL_ARGS_ASSERT_CK_REQUIRE;
+
if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
SVOP * const kid = (SVOP*)cUNOPo->op_first;
@@ -7320,6 +7539,9 @@ OP *
Perl_ck_return(pTHX_ OP *o)
{
dVAR;
+
+ PERL_ARGS_ASSERT_CK_RETURN;
+
if (CvLVALUE(PL_compcv)) {
OP *kid;
for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
@@ -7333,6 +7555,9 @@ Perl_ck_select(pTHX_ OP *o)
{
dVAR;
OP* kid;
+
+ PERL_ARGS_ASSERT_CK_SELECT;
+
if (o->op_flags & OPf_KIDS) {
kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
if (kid && kid->op_sibling) {
@@ -7355,6 +7580,8 @@ Perl_ck_shift(pTHX_ OP *o)
dVAR;
const I32 type = o->op_type;
+ PERL_ARGS_ASSERT_CK_SHIFT;
+
if (!(o->op_flags & OPf_KIDS)) {
OP *argop;
/* FIXME - this can be refactored to reduce code in #ifdefs */
@@ -7382,6 +7609,8 @@ Perl_ck_sort(pTHX_ OP *o)
dVAR;
OP *firstkid;
+ PERL_ARGS_ASSERT_CK_SORT;
+
if (o->op_type == OP_SORT && (PL_hints & HINT_LOCALIZE_HH) != 0) {
HV * const hinthv = GvHV(PL_hintgv);
if (hinthv) {
@@ -7463,6 +7692,9 @@ S_simplify_sort(pTHX_ OP *o)
int descending;
GV *gv;
const char *gvname;
+
+ PERL_ARGS_ASSERT_SIMPLIFY_SORT;
+
if (!(o->op_flags & OPf_STACKED))
return;
GvMULTI_on(gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV));
@@ -7534,6 +7766,8 @@ Perl_ck_split(pTHX_ OP *o)
dVAR;
register OP *kid;
+ PERL_ARGS_ASSERT_CK_SPLIT;
+
if (o->op_flags & OPf_STACKED)
return no_fh_allowed(o);
@@ -7589,6 +7823,9 @@ OP *
Perl_ck_join(pTHX_ OP *o)
{
const OP * const kid = cLISTOPo->op_first->op_sibling;
+
+ PERL_ARGS_ASSERT_CK_JOIN;
+
if (kid && kid->op_type == OP_MATCH) {
if (ckWARN(WARN_SYNTAX)) {
const REGEXP *re = PM_GETRE(kPMOP);
@@ -7620,6 +7857,8 @@ Perl_ck_subr(pTHX_ OP *o)
const char *e = NULL;
bool delete_op = 0;
+ PERL_ARGS_ASSERT_CK_SUBR;
+
o->op_private |= OPpENTERSUB_HASTARG;
for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
if (cvop->op_type == OP_RV2CV) {
@@ -7859,6 +8098,7 @@ Perl_ck_subr(pTHX_ OP *o)
OP *
Perl_ck_svconst(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_SVCONST;
PERL_UNUSED_CONTEXT;
SvREADONLY_on(cSVOPo->op_sv);
return o;
@@ -7883,6 +8123,8 @@ Perl_ck_chdir(pTHX_ OP *o)
OP *
Perl_ck_trunc(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_TRUNC;
+
if (o->op_flags & OPf_KIDS) {
SVOP *kid = (SVOP*)cUNOPo->op_first;
@@ -7902,6 +8144,9 @@ OP *
Perl_ck_unpack(pTHX_ OP *o)
{
OP *kid = cLISTOPo->op_first;
+
+ PERL_ARGS_ASSERT_CK_UNPACK;
+
if (kid->op_sibling) {
kid = kid->op_sibling;
if (!kid->op_sibling)
@@ -7913,6 +8158,8 @@ Perl_ck_unpack(pTHX_ OP *o)
OP *
Perl_ck_substr(pTHX_ OP *o)
{
+ PERL_ARGS_ASSERT_CK_SUBSTR;
+
o = ck_fun(o);
if ((o->op_flags & OPf_KIDS) && (o->op_private == 4)) {
OP *kid = cLISTOPo->op_first;
@@ -7932,6 +8179,8 @@ Perl_ck_each(pTHX_ OP *o)
dVAR;
OP *kid = cLISTOPo->op_first;
+ PERL_ARGS_ASSERT_CK_EACH;
+
if (kid->op_type == OP_PADAV || kid->op_type == OP_RV2AV) {
const unsigned new_type = o->op_type == OP_EACH ? OP_AEACH
: o->op_type == OP_KEYS ? OP_AKEYS : OP_AVALUES;
@@ -8564,6 +8813,8 @@ Perl_custom_op_name(pTHX_ const OP* o)
SV* keysv;
HE* he;
+ PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
+
if (!PL_custom_op_names) /* This probably shouldn't happen */
return (char *)PL_op_name[OP_CUSTOM];
@@ -8584,6 +8835,8 @@ Perl_custom_op_desc(pTHX_ const OP* o)
SV* keysv;
HE* he;
+ PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
+
if (!PL_custom_op_descs)
return (char *)PL_op_desc[OP_CUSTOM];
View Lorry Controller Status