}
STATIC void
-S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP *kid)
+S_bad_type_pv(pTHX_ I32 n, const char *t, const OP *o, const OP *kid)
{
PERL_ARGS_ASSERT_BAD_TYPE_PV;
yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)",
- (int)n, name, t, OP_DESC(kid)), flags);
+ (int)n, PL_op_desc[(o)->op_type], t, OP_DESC(kid)), 0);
}
+/* remove flags var, its unused in all callers, move to to right end since gv
+ and kid are always the same */
STATIC void
-S_bad_type_gv(pTHX_ I32 n, const char *t, GV *gv, U32 flags, const OP *kid)
+S_bad_type_gv(pTHX_ I32 n, GV *gv, const OP *kid, const char *t)
{
SV * const namesv = cv_name((CV *)gv, NULL, 0);
PERL_ARGS_ASSERT_BAD_TYPE_GV;
yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %"SVf" must be %s (not %s)",
- (int)n, SVfARG(namesv), t, OP_DESC(kid)), SvUTF8(namesv) | flags);
+ (int)n, SVfARG(namesv), t, OP_DESC(kid)), SvUTF8(namesv));
}
STATIC void
(name[1] == '_' && (*name == '$' || len > 2))))
{
if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
+ && isASCII(name[1])
&& (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1]))) {
yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in \"%s\"",
name[0], toCTRL(name[1]), (int)(len - 2), name + 2,
if (o->op_flags & OPf_KIDS) {
OP *kid, *nextkid;
for (kid = cUNOPo->op_first; kid; kid = nextkid) {
- nextkid = OP_SIBLING(kid); /* Get before next freeing kid */
+ nextkid = OpSIBLING(kid); /* Get before next freeing kid */
if (!kid || kid->op_type == OP_FREED)
/* During the forced freeing of ops after
compilation failure, kidops may be freed before
/* FALLTHROUGH */
case OP_MATCH:
case OP_QR:
-clear_pmop:
+ clear_pmop:
if (!(cPMOPo->op_pmflags & PMf_CODELIST_PRIVATE))
op_free(cPMOPo->op_code_list);
cPMOPo->op_code_list = NULL;
forget_pmop((PMOP*)kid);
}
find_and_forget_pmops(kid);
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
}
}
}
OP *
Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
{
- OP *first = start ? OP_SIBLING(start) : cLISTOPx(parent)->op_first;
+ OP *first = start ? OpSIBLING(start) : cLISTOPx(parent)->op_first;
OP *rest;
OP *last_del = NULL;
OP *last_ins = NULL;
if (del_count && first) {
last_del = first;
- while (--del_count && OP_HAS_SIBLING(last_del))
- last_del = OP_SIBLING(last_del);
- rest = OP_SIBLING(last_del);
- OP_SIBLING_set(last_del, NULL);
+ while (--del_count && OpHAS_SIBLING(last_del))
+ last_del = OpSIBLING(last_del);
+ rest = OpSIBLING(last_del);
+ OpSIBLING_set(last_del, NULL);
last_del->op_lastsib = 1;
}
else
if (insert) {
last_ins = insert;
- while (OP_HAS_SIBLING(last_ins))
- last_ins = OP_SIBLING(last_ins);
- OP_SIBLING_set(last_ins, rest);
+ while (OpHAS_SIBLING(last_ins))
+ last_ins = OpSIBLING(last_ins);
+ OpSIBLING_set(last_ins, rest);
last_ins->op_lastsib = rest ? 0 : 1;
}
else
insert = rest;
if (start) {
- OP_SIBLING_set(start, insert);
+ OpSIBLING_set(start, insert);
start->op_lastsib = insert ? 0 : 1;
}
else {
{
PERL_ARGS_ASSERT_OP_PARENT;
#ifdef PERL_OP_PARENT
- while (OP_HAS_SIBLING(o))
- o = OP_SIBLING(o);
+ while (OpHAS_SIBLING(o))
+ o = OpSIBLING(o);
return o->op_sibling;
#else
PERL_UNUSED_ARG(o);
logop->op_first = first;
logop->op_other = other;
logop->op_flags = OPf_KIDS;
- while (kid && OP_HAS_SIBLING(kid))
- kid = OP_SIBLING(kid);
+ while (kid && OpHAS_SIBLING(kid))
+ kid = OpSIBLING(kid);
if (kid) {
kid->op_lastsib = 1;
#ifdef PERL_OP_PARENT
o->op_next = LINKLIST(first);
kid = first;
for (;;) {
- OP *sibl = OP_SIBLING(kid);
+ OP *sibl = OpSIBLING(kid);
if (sibl) {
kid->op_next = LINKLIST(sibl);
kid = sibl;
{
if (o && o->op_flags & OPf_KIDS) {
OP *kid;
- for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid))
scalar(kid);
}
return o;
return;
kid = cLISTOPo->op_first;
- kid = OP_SIBLING(kid); /* get past pushmark */
+ kid = OpSIBLING(kid); /* get past pushmark */
/* weed out false positives: any ops that can return lists */
switch (kid->op_type) {
case OP_BACKTICK:
if (kid->op_type == OP_NULL && kid->op_targ == OP_LIST)
return;
- assert(OP_SIBLING(kid));
- name = S_op_varname(aTHX_ OP_SIBLING(kid));
+ assert(OpSIBLING(kid));
+ name = S_op_varname(aTHX_ OpSIBLING(kid));
if (!name) /* XS module fiddling with the op tree */
return;
S_op_pretty(aTHX_ kid, &keysv, &key);
if (o->op_private & OPpREPEAT_DOLIST) {
kid = cLISTOPx(cUNOPo->op_first)->op_first;
assert(kid->op_type == OP_PUSHMARK);
- if (OP_HAS_SIBLING(kid) && !OP_HAS_SIBLING(OP_SIBLING(kid))) {
+ if (OpHAS_SIBLING(kid) && !OpHAS_SIBLING(OpSIBLING(kid))) {
op_null(cLISTOPx(cUNOPo->op_first)->op_first);
o->op_private &=~ OPpREPEAT_DOLIST;
}
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
- for (kid = OP_SIBLING(cUNOPo->op_first); kid; kid = OP_SIBLING(kid))
+ for (kid = OpSIBLING(cUNOPo->op_first); kid; kid = OpSIBLING(kid))
scalar(kid);
break;
/* FALLTHROUGH */
case OP_NULL:
default:
if (o->op_flags & OPf_KIDS) {
- for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
scalar(kid);
}
break;
case OP_LEAVETRY:
kid = cLISTOPo->op_first;
scalar(kid);
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
do_kids:
while (kid) {
- OP *sib = OP_SIBLING(kid);
+ OP *sib = OpSIBLING(kid);
if (sib && kid->op_type != OP_LEAVEWHEN
- && ( OP_HAS_SIBLING(sib) || sib->op_type != OP_NULL
+ && ( OpHAS_SIBLING(sib) || sib->op_type != OP_NULL
|| ( sib->op_targ != OP_NEXTSTATE
&& sib->op_targ != OP_DBSTATE )))
scalarvoid(kid);
if (!ckWARN(WARN_SYNTAX)) break;
kid = cLISTOPo->op_first;
- kid = OP_SIBLING(kid); /* get past pushmark */
- assert(OP_SIBLING(kid));
- name = S_op_varname(aTHX_ OP_SIBLING(kid));
+ kid = OpSIBLING(kid); /* get past pushmark */
+ assert(OpSIBLING(kid));
+ name = S_op_varname(aTHX_ OpSIBLING(kid));
if (!name) /* XS module fiddling with the op tree */
break;
S_op_pretty(aTHX_ kid, &keysv, &key);
case OP_REPEAT:
if (o->op_flags & OPf_STACKED)
break;
+ if (o->op_type == OP_REPEAT)
+ scalar(cBINOPo->op_first);
goto func_ops;
case OP_SUBSTR:
if (o->op_private == 4)
case OP_RV2AV:
case OP_RV2HV:
if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) &&
- (!OP_HAS_SIBLING(o) || OP_SIBLING(o)->op_type != OP_READLINE))
+ (!OpHAS_SIBLING(o) || OpSIBLING(o)->op_type != OP_READLINE))
useless = "a variable";
break;
case OP_COND_EXPR:
case OP_ENTERGIVEN:
case OP_ENTERWHEN:
- for (kid = OP_SIBLING(cUNOPo->op_first); kid; kid = OP_SIBLING(kid))
+ for (kid = OpSIBLING(cUNOPo->op_first); kid; kid = OpSIBLING(kid))
if (!(kid->op_flags & OPf_KIDS))
scalarvoid(kid);
else
case OP_LEAVEGIVEN:
case OP_LEAVEWHEN:
kids:
- for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid))
if (!(kid->op_flags & OPf_KIDS))
scalarvoid(kid);
else
optimisation would reject, then null the list and the pushmark.
*/
if ((kid = cLISTOPo->op_first)->op_type == OP_PUSHMARK
- && ( !(kid = OP_SIBLING(kid))
+ && ( !(kid = OpSIBLING(kid))
|| ( kid->op_type != OP_PADSV
&& kid->op_type != OP_PADAV
&& kid->op_type != OP_PADHV)
|| kid->op_private & ~OPpLVAL_INTRO
- || !(kid = OP_SIBLING(kid))
+ || !(kid = OpSIBLING(kid))
|| ( kid->op_type != OP_PADSV
&& kid->op_type != OP_PADAV
&& kid->op_type != OP_PADHV)
{
if (o && o->op_flags & OPf_KIDS) {
OP *kid;
- for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid))
list(kid);
}
return o;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
- for (kid = OP_SIBLING(cUNOPo->op_first); kid; kid = OP_SIBLING(kid))
+ for (kid = OpSIBLING(cUNOPo->op_first); kid; kid = OpSIBLING(kid))
list(kid);
break;
default:
case OP_LEAVETRY:
kid = cLISTOPo->op_first;
list(kid);
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
do_kids:
while (kid) {
- OP *sib = OP_SIBLING(kid);
+ OP *sib = OpSIBLING(kid);
if (sib && kid->op_type != OP_LEAVEWHEN)
scalarvoid(kid);
else
{
OP *kid, *sib;
for (kid = cLISTOPo->op_first; kid; kid = sib) {
- if ((sib = OP_SIBLING(kid))
- && ( OP_HAS_SIBLING(sib) || sib->op_type != OP_NULL
+ if ((sib = OpSIBLING(kid))
+ && ( OpHAS_SIBLING(sib) || sib->op_type != OP_NULL
|| ( sib->op_targ != OP_NEXTSTATE
&& sib->op_targ != OP_DBSTATE )))
{
{
if (o && o->op_flags & OPf_KIDS) {
OP *kid;
- for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid))
op_lvalue(kid, type);
}
return o;
&& (fields = (GV**)hv_fetchs(PadnameTYPE(lexname), "FIELDS", FALSE))
&& isGV(*fields) && GvHV(*fields);
- for (; key_op; key_op = (SVOP*)OP_SIBLING(key_op)) {
+ for (; key_op; key_op = (SVOP*)OpSIBLING(key_op)) {
SV **svp, *sv;
if (key_op->op_type != OP_CONST)
continue;
PL_curcop = ((COP*)o); /* for warnings */
break;
case OP_EXEC:
- if (OP_HAS_SIBLING(o)) {
- OP *sib = OP_SIBLING(o);
+ if (OpHAS_SIBLING(o)) {
+ OP *sib = OpSIBLING(o);
if (( sib->op_type == OP_NEXTSTATE || sib->op_type == OP_DBSTATE)
&& ckWARN(WARN_EXEC)
- && OP_HAS_SIBLING(sib))
+ && OpHAS_SIBLING(sib))
{
- const OPCODE type = OP_SIBLING(sib)->op_type;
+ const OPCODE type = OpSIBLING(sib)->op_type;
if (type != OP_EXIT && type != OP_WARN && type != OP_DIE) {
const line_t oldline = CopLINE(PL_curcop);
CopLINE_set(PL_curcop, CopLINE((COP*)sib));
/* FALLTHROUGH */
case OP_KVHSLICE:
- kid = OP_SIBLING(cLISTOPo->op_first);
+ kid = OpSIBLING(cLISTOPo->op_first);
if (/* I bet there's always a pushmark... */
OP_TYPE_ISNT_AND_WASNT_NN(kid, OP_LIST)
&& OP_TYPE_ISNT_NN(kid, OP_CONST))
key_op = (SVOP*)(kid->op_type == OP_CONST
? kid
- : OP_SIBLING(kLISTOP->op_first));
+ : OpSIBLING(kLISTOP->op_first));
rop = (UNOP*)((LISTOP*)o)->op_last;
|| type == OP_CUSTOM
|| type == OP_NULL /* new_logop does this */
);
- /* XXX list form of 'x' is has a null op_last. This is wrong,
- * but requires too much hacking (e.g. in Deparse) to fix for
- * now */
- if (type == OP_REPEAT && (o->op_private & OPpREPEAT_DOLIST)) {
- assert(has_last);
- has_last = 0;
- }
- for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid)) {
+ for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
# ifdef PERL_OP_PARENT
- if (!OP_HAS_SIBLING(kid)) {
+ if (!OpHAS_SIBLING(kid)) {
if (has_last)
assert(kid == cLISTOPo->op_last);
assert(kid->op_sibling == o);
}
# else
- if (OP_HAS_SIBLING(kid)) {
+ if (OpHAS_SIBLING(kid)) {
assert(!kid->op_lastsib);
}
else {
}
#endif
- for (kid = cUNOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
finalize_op(kid);
}
}
OP *kid;
switch (o->op_type) {
case OP_COND_EXPR:
- for (kid = OP_SIBLING(cUNOPo->op_first); kid;
- kid = OP_SIBLING(kid))
+ for (kid = OpSIBLING(cUNOPo->op_first); kid;
+ kid = OpSIBLING(kid))
S_lvref(aTHX_ kid, type);
/* FALLTHROUGH */
case OP_PUSHMARK:
}
/* FALLTHROUGH */
case OP_LIST:
- for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid)) {
+ for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid)) {
assert((kid->op_flags & OPf_WANT) != OPf_WANT_VOID);
S_lvref(aTHX_ kid, type);
}
(long)kid->op_type, (UV)kid->op_targ);
kid = kLISTOP->op_first;
}
- while (OP_HAS_SIBLING(kid))
- kid = OP_SIBLING(kid);
+ while (OpHAS_SIBLING(kid))
+ kid = OpSIBLING(kid);
if (!(kid->op_type == OP_NULL && kid->op_targ == OP_RV2CV)) {
break; /* Postpone until runtime */
}
case OP_COND_EXPR:
localize = 1;
- for (kid = OP_SIBLING(cUNOPo->op_first); kid; kid = OP_SIBLING(kid))
+ for (kid = OpSIBLING(cUNOPo->op_first); kid; kid = OpSIBLING(kid))
op_lvalue(kid, type);
break;
if (type == OP_LEAVESUBLV)
o->op_private |= OPpMAYBE_LVSUB;
if (o->op_flags & OPf_KIDS)
- op_lvalue(OP_SIBLING(cBINOPo->op_first), type);
+ op_lvalue(OpSIBLING(cBINOPo->op_first), type);
break;
case OP_AELEM:
/* FALLTHROUGH */
case OP_LIST:
localize = 0;
- for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid))
/* elements might be in void context because the list is
in scalar context or because they are attribute sub calls */
if ( (kid->op_flags & OPf_WANT) != OPf_WANT_VOID )
|| !S_vivifies(cLOGOPo->op_first->op_type))
op_lvalue(cLOGOPo->op_first, type);
if (type == OP_LEAVESUBLV
- || !S_vivifies(OP_SIBLING(cLOGOPo->op_first)->op_type))
- op_lvalue(OP_SIBLING(cLOGOPo->op_first), type);
+ || !S_vivifies(OpSIBLING(cLOGOPo->op_first)->op_type))
+ op_lvalue(OpSIBLING(cLOGOPo->op_first), type);
goto nomod;
case OP_SREFGEN:
goto nomod;
/* Don’t bother applying lvalue context to the ex-list. */
kid = cUNOPx(cUNOPo->op_first)->op_first;
- assert (!OP_HAS_SIBLING(kid));
+ assert (!OpHAS_SIBLING(kid));
goto kid_2lvref;
case OP_REFGEN:
if (type != OP_AASSIGN) goto nomod;
{
if (o && o->op_flags & OPf_KIDS) {
OP *kid;
- for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid))
ref(kid, type);
}
return o;
break;
case OP_COND_EXPR:
- for (kid = OP_SIBLING(cUNOPo->op_first); kid; kid = OP_SIBLING(kid))
+ for (kid = OpSIBLING(cUNOPo->op_first); kid; kid = OpSIBLING(kid))
doref(kid, type, set_op_ref);
break;
case OP_RV2SV:
else {
assert((o->op_type == OP_LIST) && (o->op_flags & OPf_KIDS));
rop = NULL;
- for (o = cLISTOPo->op_first; o; o = OP_SIBLING(o)) {
+ for (o = cLISTOPo->op_first; o; o = OpSIBLING(o)) {
if (o->op_type == OP_CONST)
rop = op_append_elem(OP_LIST, rop,
newSVOP(OP_CONST, o->op_flags,
assert(o->op_flags & OPf_KIDS);
lasto = cLISTOPo->op_first;
assert(lasto->op_type == OP_PUSHMARK);
- for (o = OP_SIBLING(lasto); o; o = OP_SIBLING(o)) {
+ for (o = OpSIBLING(lasto); o; o = OpSIBLING(o)) {
if (o->op_type == OP_CONST) {
pv = SvPV(cSVOPo_sv, pvlen);
if (pvlen >= 10 && memEQ(pv, "prototype(", 10)) {
}
/* If the list is now just the PUSHMARK, scrap the whole thing; otherwise attributes.xs
would get pulled in with no real need */
- if (!OP_HAS_SIBLING(cLISTOPx(*attrs)->op_first)) {
+ if (!OpHAS_SIBLING(cLISTOPx(*attrs)->op_first)) {
op_free(*attrs);
*attrs = NULL;
}
if (type == OP_LIST) {
OP *kid;
- for (kid = cLISTOPo->op_first; kid; kid = OP_SIBLING(kid))
+ for (kid = cLISTOPo->op_first; kid; kid = OpSIBLING(kid))
my_kid(kid, attrs, imopsp);
return o;
} else if (type == OP_UNDEF || type == OP_STUB) {
}
else
return bind_match(type, left,
- pmruntime(newPMOP(OP_MATCH, 0), right, 0, 0));
+ pmruntime(newPMOP(OP_MATCH, 0), right, NULL, 0, 0));
}
OP *
op_null(kid);
/* The following deals with things like 'do {1 for 1}' */
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
if (kid &&
(kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE))
op_null(kid);
{
if (o && o->op_type == OP_LINESEQ) {
OP *kid = cLISTOPo->op_first;
- for(; kid; kid = OP_SIBLING(kid))
+ for(; kid; kid = OpSIBLING(kid))
if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
op_null(kid);
}
*/
OP *kid = o->op_flags & OPf_KIDS ? cLISTOPo->op_first : o;
OP * const last = o->op_flags & OPf_KIDS ? cLISTOPo->op_last : o;
- for (;; kid = OP_SIBLING(kid)) {
+ for (;; kid = OpSIBLING(kid)) {
OP *newkid = newOP(OP_CLONECV, 0);
newkid->op_targ = kid->op_targ;
o = op_append_elem(OP_LINESEQ, o, newkid);
#endif
break;
case OP_PACK:
- if (!OP_HAS_SIBLING(cLISTOPo->op_first)
- || OP_SIBLING(cLISTOPo->op_first)->op_type != OP_CONST)
+ if (!OpHAS_SIBLING(cLISTOPo->op_first)
+ || OpSIBLING(cLISTOPo->op_first)->op_type != OP_CONST)
goto nope;
{
- SV * const sv = cSVOPx_sv(OP_SIBLING(cLISTOPo->op_first));
+ SV * const sv = cSVOPx_sv(OpSIBLING(cLISTOPo->op_first));
if (!SvPOK(sv) || SvGMAGICAL(sv)) goto nope;
{
const char *s = SvPVX_const(sv);
return op_append_elem(type, first, last);
((LISTOP*)first)->op_last->op_lastsib = 0;
- OP_SIBLING_set(((LISTOP*)first)->op_last, ((LISTOP*)last)->op_first);
+ OpSIBLING_set(((LISTOP*)first)->op_last, ((LISTOP*)last)->op_first);
((LISTOP*)first)->op_last = ((LISTOP*)last)->op_last;
((LISTOP*)first)->op_last->op_lastsib = 1;
#ifdef PERL_OP_PARENT
if (!(PL_opargs[type] & OA_MARK))
op_null(cLISTOPo->op_first);
else {
- OP * const kid2 = OP_SIBLING(cLISTOPo->op_first);
+ OP * const kid2 = OpSIBLING(cLISTOPo->op_first);
if (kid2 && kid2->op_type == OP_COREARGS) {
op_null(cLISTOPo->op_first);
kid2->op_private |= OPpCOREARGS_PUSHMARK;
OP *rest = NULL;
if (o) {
/* manually detach any siblings then add them back later */
- rest = OP_SIBLING(o);
- OP_SIBLING_set(o, NULL);
+ rest = OpSIBLING(o);
+ OpSIBLING_set(o, NULL);
o->op_lastsib = 1;
}
o = newLISTOP(OP_LIST, 0, o, NULL);
dVAR;
LISTOP *listop;
- assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LISTOP);
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LISTOP
+ || type == OP_CUSTOM);
NewOp(1101, listop, 1, LISTOP);
else if (!first && last)
first = last;
else if (first)
- OP_SIBLING_set(first, last);
+ OpSIBLING_set(first, last);
listop->op_first = first;
listop->op_last = last;
if (type == OP_LIST) {
OP* const pushop = newOP(OP_PUSHMARK, 0);
pushop->op_lastsib = 0;
- OP_SIBLING_set(pushop, first);
+ OpSIBLING_set(pushop, first);
listop->op_first = pushop;
listop->op_flags |= OPf_KIDS;
if (!last)
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP
|| type == OP_SASSIGN
|| type == OP_ENTERTRY
+ || type == OP_CUSTOM
|| type == OP_NULL );
if (!first)
unop->op_private = (U8)(1 | (flags >> 8));
#ifdef PERL_OP_PARENT
- if (!OP_HAS_SIBLING(first)) /* true unless weird syntax error */
+ if (!OpHAS_SIBLING(first)) /* true unless weird syntax error */
first->op_sibling = (OP*)unop;
#endif
dVAR;
UNOP_AUX *unop;
- assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP_AUX);
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP_AUX
+ || type == OP_CUSTOM);
NewOp(1101, unop, 1, UNOP_AUX);
unop->op_type = (OPCODE)type;
unop->op_aux = aux;
#ifdef PERL_OP_PARENT
- if (first && !OP_HAS_SIBLING(first)) /* true unless weird syntax error */
+ if (first && !OpHAS_SIBLING(first)) /* true unless weird syntax error */
first->op_sibling = (OP*)unop;
#endif
dVAR;
METHOP *methop;
- assert((PL_opargs[type] & OA_CLASS_MASK) == OA_METHOP);
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_METHOP
+ || type == OP_CUSTOM);
NewOp(1101, methop, 1, METHOP);
if (dynamic_meth) {
methop->op_private = (U8)(1 | (flags >> 8));
#ifdef PERL_OP_PARENT
- if (!OP_HAS_SIBLING(dynamic_meth))
+ if (!OpHAS_SIBLING(dynamic_meth))
dynamic_meth->op_sibling = (OP*)methop;
#endif
}
BINOP *binop;
ASSUME((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
- || type == OP_SASSIGN || type == OP_NULL );
+ || type == OP_SASSIGN || type == OP_NULL || type == OP_CUSTOM);
NewOp(1101, binop, 1, BINOP);
}
else {
binop->op_private = (U8)(2 | (flags >> 8));
- OP_SIBLING_set(first, last);
+ OpSIBLING_set(first, last);
first->op_lastsib = 0;
}
#ifdef PERL_OP_PARENT
- if (!OP_HAS_SIBLING(last)) /* true unless weird syntax error */
+ if (!OpHAS_SIBLING(last)) /* true unless weird syntax error */
last->op_sibling = (OP*)binop;
#endif
- binop->op_last = OP_SIBLING(binop->op_first);
+ binop->op_last = OpSIBLING(binop->op_first);
#ifdef PERL_OP_PARENT
if (binop->op_last)
binop->op_last->op_sibling = (OP*)binop;
dVAR;
PMOP *pmop;
- assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PMOP);
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PMOP
+ || type == OP_CUSTOM);
NewOp(1101, pmop, 1, PMOP);
CHANGE_TYPE(pmop, type);
* isreg indicates that the pattern is part of a regex construct, eg
* $x =~ /pattern/ or split /pattern/, as opposed to $x =~ $pattern or
* split "pattern", which aren't. In the former case, expr will be a list
- * if the pattern contains more than one term (eg /a$b/) or if it contains
- * a replacement, ie s/// or tr///.
+ * if the pattern contains more than one term (eg /a$b/).
*
* When the pattern has been compiled within a new anon CV (for
* qr/(?{...})/ ), then floor indicates the savestack level just before
*/
OP *
-Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
+Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
{
- dVAR;
PMOP *pm;
LOGOP *rcop;
I32 repl_has_vars = 0;
- OP* repl = NULL;
bool is_trans = (o->op_type == OP_TRANS || o->op_type == OP_TRANSR);
bool is_compiletime;
bool has_code;
PERL_ARGS_ASSERT_PMRUNTIME;
- /* for s/// and tr///, last element in list is the replacement; pop it */
-
- if (is_trans || o->op_type == OP_SUBST) {
- OP* kid;
- repl = cLISTOPx(expr)->op_last;
- kid = cLISTOPx(expr)->op_first;
- while (OP_SIBLING(kid) != repl)
- kid = OP_SIBLING(kid);
- op_sibling_splice(expr, kid, 1, NULL);
- }
-
- /* for TRANS, convert LIST/PUSH/CONST into CONST, and pass to pmtrans() */
-
if (is_trans) {
- OP *first, *last;
-
- assert(expr->op_type == OP_LIST);
- first = cLISTOPx(expr)->op_first;
- last = cLISTOPx(expr)->op_last;
- assert(first->op_type == OP_PUSHMARK);
- assert(OP_SIBLING(first) == last);
-
- /* cut 'last' from sibling chain, then free everything else */
- op_sibling_splice(expr, first, 1, NULL);
- op_free(expr);
-
- return pmtrans(o, last, repl);
+ return pmtrans(o, expr, repl);
}
/* find whether we have any runtime or code elements;
has_code = 0;
if (expr->op_type == OP_LIST) {
OP *o;
- for (o = cLISTOPx(expr)->op_first; o; o = OP_SIBLING(o)) {
+ for (o = cLISTOPx(expr)->op_first; o; o = OpSIBLING(o)) {
if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) {
has_code = 1;
assert(!o->op_next);
- if (UNLIKELY(!OP_HAS_SIBLING(o))) {
+ if (UNLIKELY(!OpHAS_SIBLING(o))) {
assert(PL_parser && PL_parser->error_count);
/* This can happen with qr/ (?{(^{})/. Just fake up
the op we were expecting to see, to avoid crashing
op_sibling_splice(expr, o, 0,
newSVOP(OP_CONST, 0, &PL_sv_no));
}
- o->op_next = OP_SIBLING(o);
+ o->op_next = OpSIBLING(o);
}
else if (o->op_type != OP_CONST && o->op_type != OP_PUSHMARK)
is_compiletime = 0;
if (expr->op_type == OP_LIST) {
OP *o;
- for (o = cLISTOPx(expr)->op_first; o; o = OP_SIBLING(o)) {
+ for (o = cLISTOPx(expr)->op_first; o; o = OpSIBLING(o)) {
if (o->op_type == OP_PADAV || o->op_type == OP_RV2AV) {
assert( !(o->op_flags & OPf_WANT));
LISTOP *leaveop = cLISTOPx(cLISTOPo->op_first);
/* skip ENTER */
assert(leaveop->op_first->op_type == OP_ENTER);
- assert(OP_HAS_SIBLING(leaveop->op_first));
- o->op_next = OP_SIBLING(leaveop->op_first);
+ assert(OpHAS_SIBLING(leaveop->op_first));
+ o->op_next = OpSIBLING(leaveop->op_first);
/* skip leave */
assert(leaveop->op_flags & OPf_KIDS);
assert(leaveop->op_last->op_next == (OP*)leaveop);
{
OP *sib;
OP *kid = cUNOPx(cUNOPx(curop)->op_first)->op_first;
- if (kid->op_type == OP_NULL && (sib = OP_SIBLING(kid))
- && !OP_HAS_SIBLING(sib))
+ if (kid->op_type == OP_NULL && (sib = OpSIBLING(kid))
+ && !OpHAS_SIBLING(sib))
curop = sib;
}
if (curop->op_type == OP_CONST)
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_SVOP
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
- || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP);
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
+ || type == OP_CUSTOM);
NewOp(1101, svop, 1, SVOP);
CHANGE_TYPE(svop, type);
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_SVOP
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
- || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP);
+ || (PL_opargs[type] & OA_CLASS_MASK) == OA_FILESTATOP
+ || type == OP_CUSTOM);
NewOp(1101, padop, 1, PADOP);
CHANGE_TYPE(padop, type);
flags &= ~SVf_UTF8;
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PVOP_OR_SVOP
- || type == OP_RUNCV
+ || type == OP_RUNCV || type == OP_CUSTOM
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
NewOp(1101, pvop, 1, PVOP);
flags = o->op_flags;
type = o->op_type;
if (type == OP_COND_EXPR) {
- OP * const sib = OP_SIBLING(cLOGOPo->op_first);
+ OP * const sib = OpSIBLING(cLOGOPo->op_first);
const I32 t = assignment_type(sib);
- const I32 f = assignment_type(OP_SIBLING(sib));
+ const I32 f = assignment_type(OpSIBLING(sib));
if (t == ASSIGN_LIST && f == ASSIGN_LIST)
return ASSIGN_LIST;
S_aassign_common_vars(pTHX_ OP* o)
{
OP *curop;
- for (curop = cUNOPo->op_first; curop; curop = OP_SIBLING(curop)) {
+ for (curop = cUNOPo->op_first; curop; curop = OpSIBLING(curop)) {
if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
if (curop->op_type == OP_GV || curop->op_type == OP_GVSV
|| curop->op_type == OP_AELEMFAST) {
S_aassign_common_vars_aliases_only(pTHX_ OP *o)
{
OP *curop;
- for (curop = cUNOPo->op_first; curop; curop = OP_SIBLING(curop)) {
+ for (curop = cUNOPo->op_first; curop; curop = OpSIBLING(curop)) {
if ((curop->op_type == OP_PADSV ||
curop->op_type == OP_PADAV ||
curop->op_type == OP_PADHV ||
/* Other ops in the list. */
maybe_common_vars = TRUE;
}
- lop = OP_SIBLING(lop);
+ lop = OpSIBLING(lop);
}
}
else if ((left->op_private & OPpLVAL_INTRO)
case OP_ENTER:
case OP_NULL:
case OP_NEXTSTATE:
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
break;
default:
if (kid != cLISTOPo->op_last)
} while (kid);
if (!kid)
kid = cLISTOPo->op_last;
-last:
+ last:
return search_const(kid);
}
}
if (type == OP_XOR) /* Not short circuit, but here by precedence. */
return newBINOP(type, flags, scalar(first), scalar(other));
- assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOGOP);
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOGOP
+ || type == OP_CUSTOM);
scalarboolean(first);
/* optimize AND and OR ops that have NOTs as children */
if ( ! (o2->op_type == OP_LIST
&& (( o2 = cUNOPx(o2)->op_first))
&& o2->op_type == OP_PUSHMARK
- && (( o2 = OP_SIBLING(o2))) )
+ && (( o2 = OpSIBLING(o2))) )
)
o2 = other;
if ((o2->op_type == OP_PADSV || o2->op_type == OP_PADAV
&& ckWARN(WARN_MISC)) /* [#24076] Don't warn for <FH> err FOO. */
{
const OP * const k1 = ((UNOP*)first)->op_first;
- const OP * const k2 = OP_SIBLING(k1);
+ const OP * const k2 = OpSIBLING(k1);
OPCODE warnop = 0;
switch (first->op_type)
{
/* establish postfix order */
logop->op_next = LINKLIST(first);
first->op_next = (OP*)logop;
- assert(!OP_HAS_SIBLING(first));
+ assert(!OpHAS_SIBLING(first));
op_sibling_splice((OP*)logop, first, 0, other);
CHECKOP(type,logop);
- o = newUNOP(prepend_not ? OP_NOT : OP_NULL, 0, (OP*)logop);
+ o = newUNOP(prepend_not ? OP_NOT : OP_NULL,
+ PL_opargs[type] & OA_RETSCALAR ? OPf_WANT_SCALAR : 0,
+ (OP*)logop);
other->op_next = o;
return o;
OP *
Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
{
- dVAR;
LOGOP *range;
OP *flip;
OP *flop;
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
} else if (expr->op_flags & OPf_KIDS) {
const OP * const k1 = ((UNOP*)expr)->op_first;
- const OP * const k2 = k1 ? OP_SIBLING(k1) : NULL;
+ const OP * const k2 = k1 ? OpSIBLING(k1) : NULL;
switch (expr->op_type) {
case OP_NULL:
if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR)
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
} else if (expr->op_flags & OPf_KIDS) {
const OP * const k1 = ((UNOP*)expr)->op_first;
- const OP * const k2 = (k1) ? OP_SIBLING(k1) : NULL;
+ const OP * const k2 = (k1) ? OpSIBLING(k1) : NULL;
switch (expr->op_type) {
case OP_NULL:
if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR)
const UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
LOGOP* const range = (LOGOP*) flip->op_first;
OP* const left = range->op_first;
- OP* const right = OP_SIBLING(left);
+ OP* const right = OpSIBLING(left);
LISTOP* listop;
range->op_flags &= ~OPf_KIDS;
PERL_ARGS_ASSERT_NEWLOOPEX;
- assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
+ assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP
+ || type == OP_CUSTOM);
if (type != OP_GOTO) {
/* "last()" means "last" */
case OP_AND:
{
- OP* sibl = OP_SIBLING(cLOGOPo->op_first);
+ OP* sibl = OpSIBLING(cLOGOPo->op_first);
ASSUME(sibl);
return (
looks_like_bool(cLOGOPo->op_first)
CV *clonee = NULL;
HEK *hek = NULL;
bool reusable = FALSE;
- OP *start;
+ OP *start = NULL;
#ifdef PERL_DEBUG_READONLY_OPS
OPSLAB *slab = NULL;
#endif
o ? SvPV_const(o_is_gv ? (SV *)o : cSVOPo->op_sv, namlen) : NULL;
bool has_name;
bool name_is_utf8 = o && !o_is_gv && SvUTF8(cSVOPo->op_sv);
- OP *start;
+ bool evanescent = FALSE;
+ OP *start = NULL;
#ifdef PERL_DEBUG_READONLY_OPS
OPSLAB *slab = NULL;
- bool special = FALSE;
#endif
if (o_is_gv) {
const_sv = NULL;
else
const_sv =
- S_op_const_sv(aTHX_ start, PL_compcv, CvCLONE(PL_compcv));
+ S_op_const_sv(aTHX_ start, PL_compcv, cBOOL(CvCLONE(PL_compcv)));
if (SvPOK(gv) || (SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVCV)) {
assert (block);
if (PL_parser && PL_parser->error_count)
clear_special_blocks(name, gv, cv);
else
-#ifdef PERL_DEBUG_READONLY_OPS
- special =
-#endif
+ evanescent =
process_special_blocks(floor, name, gv, cv);
}
}
if (PL_parser)
PL_parser->copline = NOLINE;
LEAVE_SCOPE(floor);
+ if (!evanescent) {
#ifdef PERL_DEBUG_READONLY_OPS
- /* Watch out for BEGIN blocks */
- if (!special && slab)
+ if (slab)
Slab_to_ro(slab);
#endif
+ if (cv && name && CvOUTSIDE(cv) && !CvEVAL(CvOUTSIDE(cv)))
+ pad_add_weakref(cv);
+ }
return cv;
}
}
}
+/* Returns true if the sub has been freed. */
STATIC bool
S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,
GV *const gv,
POPSTACK;
LEAVE;
- return TRUE;
+ return !PL_savebegin;
}
else
return FALSE;
DEBUG_x( dump_sub(gv) );
(void)CvGV(cv);
GvCV_set(gv,0); /* cv has been hijacked */
- return TRUE;
+ return FALSE;
}
}
OP *
Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block)
{
- return newUNOP(OP_REFGEN, 0,
+ SV * const cv = MUTABLE_SV(newATTRSUB(floor, 0, proto, attrs, block));
+ OP * anoncode =
newSVOP(OP_ANONCODE, 0,
- MUTABLE_SV(newATTRSUB(floor, 0, proto, attrs, block))));
+ cv);
+ if (CvANONCONST(cv))
+ anoncode = newUNOP(OP_ANONCONST, 0,
+ op_convert_list(OP_ENTERSUB,
+ OPf_STACKED|OPf_WANT_SCALAR,
+ anoncode));
+ return newUNOP(OP_REFGEN, 0, anoncode);
}
OP *
if (o->op_type == OP_PADANY) {
CHANGE_TYPE(o, OP_PADSV);
+ scalar(o);
return o;
}
return newUNOP(OP_RV2SV, 0, scalar(o));
OP *sibl;
PERL_ARGS_ASSERT_CK_BACKTICK;
/* qx and `` have a null pushmark; CORE::readpipe has only one kid. */
- if (o->op_flags & OPf_KIDS && (sibl = OP_SIBLING(cUNOPo->op_first))
+ if (o->op_flags & OPf_KIDS && (sibl = OpSIBLING(cUNOPo->op_first))
&& (gv = gv_override("readpipe",8)))
{
/* detach rest of siblings from o and its first child */
|| o->op_type == OP_BIT_XOR))
{
const OP * const left = cBINOPo->op_first;
- const OP * const right = OP_SIBLING(left);
+ const OP * const right = OpSIBLING(left);
if ((OP_IS_NUMCOMPARE(left->op_type) &&
(left->op_flags & OPf_PARENS) == 0) ||
(OP_IS_NUMCOMPARE(right->op_type) &&
if (kid &&
(
( is_dollar_bracket(aTHX_ kid)
- && OP_SIBLING(kid) && OP_SIBLING(kid)->op_type == OP_CONST
+ && OpSIBLING(kid) && OpSIBLING(kid)->op_type == OP_CONST
)
|| ( kid->op_type == OP_CONST
- && (kid = OP_SIBLING(kid)) && is_dollar_bracket(aTHX_ kid)
+ && (kid = OpSIBLING(kid)) && is_dollar_bracket(aTHX_ kid)
)
)
)
o = modkids(ck_fun(o), type);
kid = cUNOPo->op_first;
kidkid = kUNOP->op_first;
- newop = OP_SIBLING(kidkid);
+ newop = OpSIBLING(kidkid);
if (newop) {
const OPCODE type = newop->op_type;
- if (OP_HAS_SIBLING(newop))
+ if (OpHAS_SIBLING(newop))
return o;
if (o->op_type == OP_REFGEN
&& ( type == OP_RV2CV
&& ( type == OP_RV2AV || type == OP_PADAV
|| type == OP_RV2HV || type == OP_PADHV))))
NOOP; /* OK (allow srefgen for \@a and \%h) */
- else if (!(PL_opargs[type] & OA_RETSCALAR))
+ else if (OP_GIMME(newop,0) != G_SCALAR)
return o;
}
/* excise first sibling */
SVOP * const kid = (SVOP*)cUNOPo->op_first;
assert(kid);
- if (kid->op_type == OP_LINESEQ || kid->op_type == OP_STUB) {
+ if (o->op_type == OP_ENTERTRY) {
LOGOP *enter;
/* cut whole sibling chain free from o */
if (o->op_flags & OPf_STACKED) {
OP *kid;
o = ck_fun(o);
- kid = OP_SIBLING(cUNOPo->op_first);
+ kid = OpSIBLING(cUNOPo->op_first);
if (kid->op_type == OP_RV2GV)
op_null(kid);
}
(kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK))
{
prev_kid = kid;
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
}
if (kid && kid->op_type == OP_COREARGS) {
bool optional = FALSE;
break;
case OA_AVREF:
if ((type == OP_PUSH || type == OP_UNSHIFT)
- && !OP_HAS_SIBLING(kid))
+ && !OpHAS_SIBLING(kid))
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
"Useless use of %s with no values",
PL_op_desc[type]);
&& ( !SvROK(cSVOPx_sv(kid))
|| SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV )
)
- bad_type_pv(numargs, "array", PL_op_desc[type], 0, kid);
+ bad_type_pv(numargs, "array", o, kid);
/* Defer checks to run-time if we have a scalar arg */
if (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV)
op_lvalue(kid, type);
break;
case OA_HVREF:
if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
- bad_type_pv(numargs, "hash", PL_op_desc[type], 0, kid);
+ bad_type_pv(numargs, "hash", o, kid);
op_lvalue(kid, type);
break;
case OA_CVREF:
}
else if (kid->op_type == OP_READLINE) {
/* neophyte patrol: open(<FH>), close(<FH>) etc. */
- bad_type_pv(numargs, "HANDLE", OP_DESC(o), 0, kid);
+ bad_type_pv(numargs, "HANDLE", o, kid);
}
else {
I32 flags = OPf_SPECIAL;
}
oa >>= 4;
prev_kid = kid;
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
}
/* FIXME - should the numargs or-ing move after the too many
* arguments check? */
PERL_ARGS_ASSERT_CK_GLOB;
o = ck_fun(o);
- if ((o->op_flags & OPf_KIDS) && !OP_HAS_SIBLING(cLISTOPo->op_first))
+ if ((o->op_flags & OPf_KIDS) && !OpHAS_SIBLING(cLISTOPo->op_first))
op_append_elem(OP_GLOB, o, newDEFSVOP()); /* glob() => glob($_) */
if (!(o->op_flags & OPf_SPECIAL) && (gv = gv_override("glob", 4)))
OP *
Perl_ck_grep(pTHX_ OP *o)
{
- dVAR;
LOGOP *gwop;
OP *kid;
const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
/* don't allocate gwop here, as we may leak it if PL_parser->error_count > 0 */
if (o->op_flags & OPf_STACKED) {
- kid = cUNOPx(OP_SIBLING(cLISTOPo->op_first))->op_first;
+ kid = cUNOPx(OpSIBLING(cLISTOPo->op_first))->op_first;
if (kid->op_type != OP_SCOPE && kid->op_type != OP_LEAVE)
return no_fh_allowed(o);
o->op_flags &= ~OPf_STACKED;
}
- kid = OP_SIBLING(cLISTOPo->op_first);
+ kid = OpSIBLING(cLISTOPo->op_first);
if (type == OP_MAPWHILE)
list(kid);
else
o = ck_fun(o);
if (PL_parser && PL_parser->error_count)
return o;
- kid = OP_SIBLING(cLISTOPo->op_first);
+ kid = OpSIBLING(cLISTOPo->op_first);
if (kid->op_type != OP_NULL)
Perl_croak(aTHX_ "panic: ck_grep, type=%u", (unsigned) kid->op_type);
kid = kUNOP->op_first;
gwop->op_targ = o->op_targ = offset;
}
- kid = OP_SIBLING(cLISTOPo->op_first);
- for (kid = OP_SIBLING(kid); kid; kid = OP_SIBLING(kid))
+ kid = OpSIBLING(cLISTOPo->op_first);
+ for (kid = OpSIBLING(kid); kid; kid = OpSIBLING(kid))
op_lvalue(kid, OP_GREPSTART);
return (OP*)gwop;
PERL_ARGS_ASSERT_CK_INDEX;
if (o->op_flags & OPf_KIDS) {
- OP *kid = OP_SIBLING(cLISTOPo->op_first); /* get past pushmark */
+ OP *kid = OpSIBLING(cLISTOPo->op_first); /* get past pushmark */
if (kid)
- kid = OP_SIBLING(kid); /* get past "big" */
+ kid = OpSIBLING(kid); /* get past "big" */
if (kid && kid->op_type == OP_CONST) {
const bool save_taint = TAINT_get;
SV *sv = kSVOP->op_sv;
kid = cLISTOPo->op_first;
}
if (kid->op_type == OP_PUSHMARK)
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
if (kid && o->op_flags & OPf_STACKED)
- kid = OP_SIBLING(kid);
- else if (kid && !OP_HAS_SIBLING(kid)) { /* print HANDLE; */
+ kid = OpSIBLING(kid);
+ else if (kid && !OpHAS_SIBLING(kid)) { /* print HANDLE; */
if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE
&& !kid->op_folded) {
o->op_flags |= OPf_STACKED; /* make it a filehandle */
/* replace old const op with new OP_RV2GV parent */
kid = S_op_sibling_newUNOP(aTHX_ o, cLISTOPo->op_first,
OP_RV2GV, OPf_REF);
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
}
}
PERL_ARGS_ASSERT_CK_SMARTMATCH;
if (0 == (o->op_flags & OPf_SPECIAL)) {
OP *first = cBINOPo->op_first;
- OP *second = OP_SIBLING(first);
+ OP *second = OpSIBLING(first);
/* Implicitly take a reference to an array or hash */
static OP *
S_maybe_targlex(pTHX_ OP *o)
{
- dVAR;
OP * const kid = cLISTOPo->op_first;
/* has a disposable target? */
if ((PL_opargs[kid->op_type] & OA_TARGLEX)
&& !(kid->op_private & OPpTARGET_MY)
)
{
- OP * const kkid = OP_SIBLING(kid);
+ OP * const kkid = OpSIBLING(kid);
/* Can just relocate the target. */
if (kkid && kkid->op_type == OP_PADSV
PERL_ARGS_ASSERT_CK_SASSIGN;
- if (OP_HAS_SIBLING(kid)) {
- OP *kkid = OP_SIBLING(kid);
+ if (OpHAS_SIBLING(kid)) {
+ OP *kkid = OpSIBLING(kid);
/* For state variable assignment with attributes, kkid is a list op
whose op_last is a padsv. */
if ((kkid->op_type == OP_PADSV ||
CHANGE_TYPE(condop, OP_ONCE);
other->op_targ = target;
+ nullop->op_flags |= OPf_WANT_SCALAR;
/* Store the initializedness of state vars in a separate
pad entry. */
if ((last->op_type == OP_CONST) && /* The bareword. */
(last->op_private & OPpCONST_BARE) &&
(last->op_private & OPpCONST_STRICT) &&
- (oa = OP_SIBLING(first)) && /* The fh. */
- (oa = OP_SIBLING(oa)) && /* The mode. */
+ (oa = OpSIBLING(first)) && /* The fh. */
+ (oa = OpSIBLING(oa)) && /* The mode. */
(oa->op_type == OP_CONST) &&
SvPOK(((SVOP*)oa)->op_sv) &&
(mode = SvPVX_const(((SVOP*)oa)->op_sv)) &&
mode[0] == '>' && mode[1] == '&' && /* A dup open. */
- (last == OP_SIBLING(oa))) /* The bareword. */
+ (last == OpSIBLING(oa))) /* The bareword. */
last->op_private &= ~OPpCONST_STRICT;
}
return ck_fun(o);
}
OP *
+Perl_ck_prototype(pTHX_ OP *o)
+{
+ PERL_ARGS_ASSERT_CK_PROTOTYPE;
+ if (!(o->op_flags & OPf_KIDS)) {
+ op_free(o);
+ return newUNOP(OP_PROTOTYPE, 0, newDEFSVOP());
+ }
+ return o;
+}
+
+OP *
Perl_ck_refassign(pTHX_ OP *o)
{
OP * const right = cLISTOPo->op_first;
- OP * const left = OP_SIBLING(right);
+ OP * const left = OpSIBLING(right);
OP *varop = cUNOPx(cUNOPx(left)->op_first)->op_first;
bool stacked = 0;
return newop;
}
- return scalar(ck_fun(o));
+ return ck_fun(o);
}
OP *
PERL_ARGS_ASSERT_CK_RETURN;
- kid = OP_SIBLING(cLISTOPo->op_first);
+ kid = OpSIBLING(cLISTOPo->op_first);
if (CvLVALUE(PL_compcv)) {
- for (; kid; kid = OP_SIBLING(kid))
+ for (; kid; kid = OpSIBLING(kid))
op_lvalue(kid, OP_LEAVESUBLV);
}
PERL_ARGS_ASSERT_CK_SELECT;
if (o->op_flags & OPf_KIDS) {
- kid = OP_SIBLING(cLISTOPo->op_first); /* get past pushmark */
- if (kid && OP_HAS_SIBLING(kid)) {
+ kid = OpSIBLING(cLISTOPo->op_first); /* get past pushmark */
+ if (kid && OpHAS_SIBLING(kid)) {
CHANGE_TYPE(o, OP_SSELECT);
o = ck_fun(o);
return fold_constants(op_integerize(op_std_init(o)));
}
}
o = ck_fun(o);
- kid = OP_SIBLING(cLISTOPo->op_first); /* get past pushmark */
+ kid = OpSIBLING(cLISTOPo->op_first); /* get past pushmark */
if (kid && kid->op_type == OP_RV2GV)
kid->op_private &= ~HINT_STRICT_REFS;
return o;
if (o->op_flags & OPf_STACKED)
simplify_sort(o);
- firstkid = OP_SIBLING(cLISTOPo->op_first); /* get past pushmark */
+ firstkid = OpSIBLING(cLISTOPo->op_first); /* get past pushmark */
if ((stacked = o->op_flags & OPf_STACKED)) { /* may have been cleared */
OP *kid = cUNOPx(firstkid)->op_first; /* get past null */
}
}
- firstkid = OP_SIBLING(firstkid);
+ firstkid = OpSIBLING(firstkid);
}
- for (kid = firstkid; kid; kid = OP_SIBLING(kid)) {
+ for (kid = firstkid; kid; kid = OpSIBLING(kid)) {
/* provide list context for arguments */
list(kid);
if (stacked)
STATIC void
S_simplify_sort(pTHX_ OP *o)
{
- OP *kid = OP_SIBLING(cLISTOPo->op_first); /* get past pushmark */
+ OP *kid = OpSIBLING(cLISTOPo->op_first); /* get past pushmark */
OP *k;
int descending;
GV *gv;
: "my",
PadnamePV(name));
}
- } while ((kid = OP_SIBLING(kid)));
+ } while ((kid = OpSIBLING(kid)));
return;
}
kid = kBINOP->op_first; /* get past cmp */
o->op_private |= OPpSORT_NUMERIC;
if (k->op_type == OP_I_NCMP)
o->op_private |= OPpSORT_NUMERIC | OPpSORT_INTEGER;
- kid = OP_SIBLING(cLISTOPo->op_first);
+ kid = OpSIBLING(cLISTOPo->op_first);
/* cut out and delete old block (second sibling) */
op_sibling_splice(o, cLISTOPo->op_first, 1, NULL);
op_free(kid);
Perl_croak(aTHX_ "panic: ck_split, type=%u", (unsigned) kid->op_type);
/* delete leading NULL node, then add a CONST if no other nodes */
op_sibling_splice(o, NULL, 1,
- OP_HAS_SIBLING(kid) ? NULL : newSVOP(OP_CONST, 0, newSVpvs(" ")));
+ OpHAS_SIBLING(kid) ? NULL : newSVOP(OP_CONST, 0, newSVpvs(" ")));
op_free(kid);
kid = cLISTOPo->op_first;
/* remove kid, and replace with new optree */
op_sibling_splice(o, NULL, 1, NULL);
/* OPf_SPECIAL is used to trigger split " " behavior */
- kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, 0, 0);
+ kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, NULL, 0, 0);
op_sibling_splice(o, NULL, 0, kid);
}
CHANGE_TYPE(kid, OP_PUSHRE);
"Use of /g modifier is meaningless in split");
}
- if (!OP_HAS_SIBLING(kid))
+ if (!OpHAS_SIBLING(kid))
op_append_elem(OP_SPLIT, o, newDEFSVOP());
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
assert(kid);
scalar(kid);
- if (!OP_HAS_SIBLING(kid))
+ if (!OpHAS_SIBLING(kid))
{
op_append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
o->op_private |= OPpSPLIT_IMPLIM;
}
- assert(OP_HAS_SIBLING(kid));
+ assert(OpHAS_SIBLING(kid));
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
scalar(kid);
- if (OP_HAS_SIBLING(kid))
+ if (OpHAS_SIBLING(kid))
return too_many_arguments_pv(o,OP_DESC(o), 0);
return o;
OP *
Perl_ck_stringify(pTHX_ OP *o)
{
- OP * const kid = OP_SIBLING(cUNOPo->op_first);
+ OP * const kid = OpSIBLING(cUNOPo->op_first);
PERL_ARGS_ASSERT_CK_STRINGIFY;
if (kid->op_type == OP_JOIN || kid->op_type == OP_QUOTEMETA
|| kid->op_type == OP_LC || kid->op_type == OP_LCFIRST
|| kid->op_type == OP_UC || kid->op_type == OP_UCFIRST)
{
- assert(!OP_HAS_SIBLING(kid));
+ assert(!OpHAS_SIBLING(kid));
op_sibling_splice(o, cUNOPo->op_first, -1, NULL);
op_free(o);
return kid;
OP *
Perl_ck_join(pTHX_ OP *o)
{
- OP * const kid = OP_SIBLING(cLISTOPo->op_first);
+ OP * const kid = OpSIBLING(cLISTOPo->op_first);
PERL_ARGS_ASSERT_CK_JOIN;
|| ( kid->op_type==OP_RV2SV && kUNOP->op_first->op_type == OP_GV
&& !(kid->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))))
{
- const OP * const bairn = OP_SIBLING(kid); /* the list */
- if (bairn && !OP_HAS_SIBLING(bairn) /* single-item list */
- && PL_opargs[bairn->op_type] & OA_RETSCALAR)
+ const OP * const bairn = OpSIBLING(kid); /* the list */
+ if (bairn && !OpHAS_SIBLING(bairn) /* single-item list */
+ && OP_GIMME(bairn,0) == G_SCALAR)
{
OP * const ret = op_convert_list(OP_STRINGIFY, OPf_FOLDED,
op_sibling_splice(o, kid, 1, NULL));
OP *aop;
PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_LIST;
aop = cUNOPx(entersubop)->op_first;
- if (!OP_HAS_SIBLING(aop))
+ if (!OpHAS_SIBLING(aop))
aop = cUNOPx(aop)->op_first;
- for (aop = OP_SIBLING(aop); OP_HAS_SIBLING(aop); aop = OP_SIBLING(aop)) {
+ for (aop = OpSIBLING(aop); OpHAS_SIBLING(aop); aop = OpSIBLING(aop)) {
list(aop);
op_lvalue(aop, OP_ENTERSUB);
}
proto_end = proto + proto_len;
parent = entersubop;
aop = cUNOPx(entersubop)->op_first;
- if (!OP_HAS_SIBLING(aop)) {
+ if (!OpHAS_SIBLING(aop)) {
parent = aop;
aop = cUNOPx(aop)->op_first;
}
prev = aop;
- aop = OP_SIBLING(aop);
- for (cvop = aop; OP_HAS_SIBLING(cvop); cvop = OP_SIBLING(cvop)) ;
+ aop = OpSIBLING(aop);
+ for (cvop = aop; OpHAS_SIBLING(cvop); cvop = OpSIBLING(cvop)) ;
while (aop != cvop) {
OP* o3 = aop;
!= OP_ANONCODE
&& cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
!= OP_RV2CV))
- bad_type_gv(arg,
- arg == 1 ? "block or sub {}" : "sub {}",
- namegv, 0, o3);
+ bad_type_gv(arg, namegv, o3,
+ arg == 1 ? "block or sub {}" : "sub {}");
break;
case '*':
/* '*' allows any scalar type, including bareword */
OP_READ, /* not entersub */
OP_LVALUE_NO_CROAK
)) goto wrapref;
- bad_type_gv(arg, Perl_form(aTHX_ "one of %.*s",
- (int)(end - p), p),
- namegv, 0, o3);
+ bad_type_gv(arg, namegv, o3,
+ Perl_form(aTHX_ "one of %.*s",(int)(end - p), p));
} else
goto oops;
break;
if (o3->op_type == OP_RV2GV)
goto wrapref;
if (!contextclass)
- bad_type_gv(arg, "symbol", namegv, 0, o3);
+ bad_type_gv(arg, namegv, o3, "symbol");
break;
case '&':
if (o3->op_type == OP_ENTERSUB
&& !(o3->op_flags & OPf_STACKED))
goto wrapref;
if (!contextclass)
- bad_type_gv(arg, "subroutine", namegv, 0,
- o3);
+ bad_type_gv(arg, namegv, o3, "subroutine");
break;
case '$':
if (o3->op_type == OP_RV2SV ||
OP_READ, /* not entersub */
OP_LVALUE_NO_CROAK
)) goto wrapref;
- bad_type_gv(arg, "scalar", namegv, 0, o3);
+ bad_type_gv(arg, namegv, o3, "scalar");
}
break;
case '@':
goto wrapref;
}
if (!contextclass)
- bad_type_gv(arg, "array", namegv, 0, o3);
+ bad_type_gv(arg, namegv, o3, "array");
break;
case '%':
if (o3->op_type == OP_RV2HV ||
goto wrapref;
}
if (!contextclass)
- bad_type_gv(arg, "hash", namegv, 0, o3);
+ bad_type_gv(arg, namegv, o3, "hash");
break;
wrapref:
aop = S_op_sibling_newUNOP(aTHX_ parent, prev,
op_lvalue(aop, OP_ENTERSUB);
prev = aop;
- aop = OP_SIBLING(aop);
+ aop = OpSIBLING(aop);
}
if (aop == cvop && *proto == '_') {
/* generate an access to $_ */
if (!opnum) {
OP *cvop;
- if (!OP_HAS_SIBLING(aop))
+ if (!OpHAS_SIBLING(aop))
aop = cUNOPx(aop)->op_first;
- aop = OP_SIBLING(aop);
- for (cvop = aop; OP_SIBLING(cvop); cvop = OP_SIBLING(cvop)) ;
+ aop = OpSIBLING(aop);
+ for (cvop = aop; OpSIBLING(cvop); cvop = OpSIBLING(cvop)) ;
if (aop != cvop)
(void)too_many_arguments_pv(entersubop, GvNAME(namegv), 0);
U32 flags = 0;
parent = entersubop;
- if (!OP_HAS_SIBLING(aop)) {
+ if (!OpHAS_SIBLING(aop)) {
parent = aop;
aop = cUNOPx(aop)->op_first;
}
first = prev = aop;
- aop = OP_SIBLING(aop);
+ aop = OpSIBLING(aop);
/* find last sibling */
for (cvop = aop;
- OP_HAS_SIBLING(cvop);
- prev = cvop, cvop = OP_SIBLING(cvop))
+ OpHAS_SIBLING(cvop);
+ prev = cvop, cvop = OpSIBLING(cvop))
;
if (!(cvop->op_private & OPpENTERSUB_NOPAREN)
- /* Usually, OPf_SPECIAL on a UNOP means that its arg had no
+ /* Usually, OPf_SPECIAL on an op with no args means that it had
* parens, but these have their own meaning for that flag: */
&& opnum != OP_VALUES && opnum != OP_KEYS && opnum != OP_EACH
&& opnum != OP_DELETE && opnum != OP_EXISTS)
}
}
+static void
+S_entersub_alloc_targ(pTHX_ OP * const o)
+{
+ o->op_targ = pad_alloc(OP_ENTERSUB, SVs_PADTMP);
+ o->op_private |= OPpENTERSUB_HASTARG;
+}
+
OP *
Perl_ck_subr(pTHX_ OP *o)
{
PERL_ARGS_ASSERT_CK_SUBR;
aop = cUNOPx(o)->op_first;
- if (!OP_HAS_SIBLING(aop))
+ if (!OpHAS_SIBLING(aop))
aop = cUNOPx(aop)->op_first;
- aop = OP_SIBLING(aop);
- for (cvop = aop; OP_HAS_SIBLING(cvop); cvop = OP_SIBLING(cvop)) ;
+ aop = OpSIBLING(aop);
+ for (cvop = aop; OpHAS_SIBLING(cvop); cvop = OpSIBLING(cvop)) ;
cv = rv2cv_op_cv(cvop, RV2CVOPCV_MARK_EARLY);
namegv = cv ? (GV*)rv2cv_op_cv(cvop, RV2CVOPCV_MAYBE_NAME_GV) : NULL;
o->op_private &= ~1;
- o->op_private |= OPpENTERSUB_HASTARG;
o->op_private |= (PL_hints & HINT_STRICT_REFS);
if (PERLDB_SUB && PL_curstash != PL_debstash)
o->op_private |= OPpENTERSUB_DB;
const_class = &cSVOPx(aop)->op_sv;
}
else if (aop->op_type == OP_LIST) {
- OP * const sib = OP_SIBLING(((UNOP*)aop)->op_first);
+ OP * const sib = OpSIBLING(((UNOP*)aop)->op_first);
if (sib && sib->op_type == OP_CONST) {
sib->op_private &= ~OPpCONST_STRICT;
const_class = &cSVOPx(sib)->op_sv;
}
/* make class name a shared cow string to speedup method calls */
/* constant string might be replaced with object, f.e. bigint */
- if (const_class && !SvROK(*const_class)) {
+ if (const_class && SvPOK(*const_class)) {
STRLEN len;
const char* str = SvPV(*const_class, len);
if (len) {
SV* const shared = newSVpvn_share(
- str, SvUTF8(*const_class) ? -len : len, 0
+ str, SvUTF8(*const_class)
+ ? -(SSize_t)len : (SSize_t)len,
+ 0
);
SvREFCNT_dec(*const_class);
*const_class = shared;
}
if (!cv) {
+ S_entersub_alloc_targ(aTHX_ o);
return ck_entersub_args_list(o);
} else {
Perl_call_checker ckfun;
SV *ckobj;
U8 flags;
S_cv_get_call_checker(cv, &ckfun, &ckobj, &flags);
+ if (CvISXSUB(cv) || !CvROOT(cv))
+ S_entersub_alloc_targ(aTHX_ o);
if (!namegv) {
/* The original call checker API guarantees that a GV will be
be provided with the right name. So, if the old API was
SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_NULL)
- kid = (SVOP*)OP_SIBLING(kid);
+ kid = (SVOP*)OpSIBLING(kid);
if (kid && kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE) &&
!kid->op_folded)
OP *kid = cLISTOPo->op_first;
if (kid->op_type == OP_NULL)
- kid = OP_SIBLING(kid);
+ kid = OpSIBLING(kid);
if (kid)
kid->op_flags |= OPf_MOD;
o = ck_fun(o);
if (o->op_flags & OPf_KIDS) {
OP *kid = cLISTOPo->op_first;
- if (kid->op_type == OP_NULL && OP_HAS_SIBLING(kid)) kid = OP_SIBLING(kid);
+ if (kid->op_type == OP_NULL && OpHAS_SIBLING(kid)) kid = OpSIBLING(kid);
if (kid->op_type == OP_RV2GV) kid->op_private |= OPpALLOW_FAKE;
}
return o;
assert(cUNOPo->op_first->op_type == OP_NULL);
modop_pushmark = cUNOPx(cUNOPo->op_first)->op_first;
assert(modop_pushmark->op_type == OP_PUSHMARK);
- modop = OP_SIBLING(modop_pushmark);
+ modop = OpSIBLING(modop_pushmark);
if (modop->op_type != OP_SORT && modop->op_type != OP_REVERSE)
return;
/* no other operation except sort/reverse */
- if (OP_HAS_SIBLING(modop))
+ if (OpHAS_SIBLING(modop))
return;
assert(cUNOPx(modop)->op_first->op_type == OP_PUSHMARK);
- if (!(oright = OP_SIBLING(cUNOPx(modop)->op_first))) return;
+ if (!(oright = OpSIBLING(cUNOPx(modop)->op_first))) return;
if (modop->op_flags & OPf_STACKED) {
/* skip sort subroutine/block */
assert(oright->op_type == OP_NULL);
- oright = OP_SIBLING(oright);
+ oright = OpSIBLING(oright);
}
- assert(OP_SIBLING(cUNOPo->op_first)->op_type == OP_NULL);
- oleft_pushmark = cUNOPx(OP_SIBLING(cUNOPo->op_first))->op_first;
+ assert(OpSIBLING(cUNOPo->op_first)->op_type == OP_NULL);
+ oleft_pushmark = cUNOPx(OpSIBLING(cUNOPo->op_first))->op_first;
assert(oleft_pushmark->op_type == OP_PUSHMARK);
- oleft = OP_SIBLING(oleft_pushmark);
+ oleft = OpSIBLING(oleft_pushmark);
/* Check the lhs is an array */
if (!oleft ||
(oleft->op_type != OP_RV2AV && oleft->op_type != OP_PADAV)
- || OP_HAS_SIBLING(oleft)
+ || OpHAS_SIBLING(oleft)
|| (oleft->op_private & OPpLVAL_INTRO)
)
return;
/* Only one thing on the rhs */
- if (OP_HAS_SIBLING(oright))
+ if (OpHAS_SIBLING(oright))
return;
/* check the array is the same on both sides */
break;
default:
- assert(0);
+ NOT_REACHED;
return;
}
/* look for another (rv2av/hv; get index;
* aelem/helem/exists/delele) sequence */
- IV iv;
OP *kid;
bool is_deref;
bool ok;
/* rv2av or rv2hv sKR/1 */
- assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
+ ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
|OPf_REF|OPf_MOD|OPf_SPECIAL)));
if (o->op_flags != (OPf_WANT_SCALAR|OPf_KIDS|OPf_REF))
return;
* OPpMAYBE_LVSUB, OPpOUR_INTRO, OPpLVAL_INTRO
* OPpTRUEBOOL, OPpMAYBE_TRUEBOOL (rv2hv only)
*/
- assert(!(o->op_private &
+ ASSUME(!(o->op_private &
~(OPpHINT_STRICT_REFS|OPpARG1_MASK|OPpSLICEWARNING)));
hints = (o->op_private & OPpHINT_STRICT_REFS);
/* make sure the type of the previous /DEREF matches the
* type of the next lookup */
- assert(o->op_type == (next_is_hash ? OP_RV2HV : OP_RV2AV));
+ ASSUME(o->op_type == (next_is_hash ? OP_RV2HV : OP_RV2AV));
top_op = o;
action = next_is_hash
switch (o->op_type) {
case OP_PADSV:
/* it may be a lexical var index */
- assert(!(o->op_flags & ~(OPf_WANT|OPf_PARENS
+ ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_PARENS
|OPf_REF|OPf_MOD|OPf_SPECIAL)));
- assert(!(o->op_private &
+ ASSUME(!(o->op_private &
~(OPpPAD_STATE|OPpDEREF|OPpLVAL_INTRO)));
- if ( o->op_flags == OPf_WANT_SCALAR
+ if ( OP_GIMME(o,0) == G_SCALAR
+ && !(o->op_flags & (OPf_REF|OPf_MOD))
&& o->op_private == 0)
{
if (pass)
UNOP *rop = NULL;
OP * helem_op = o->op_next;
- assert( helem_op->op_type == OP_HELEM
+ ASSUME( helem_op->op_type == OP_HELEM
|| helem_op->op_type == OP_NULL);
if (helem_op->op_type == OP_HELEM) {
rop = (UNOP*)(((BINOP*)helem_op)->op_first);
}
else {
/* it's a constant array index */
+ IV iv;
SV *ix_sv = cSVOPo->op_sv;
- if (UNLIKELY(SvROK(ix_sv) && !SvGAMAGIC(ix_sv)
- && ckWARN(WARN_MISC)))
- Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Use of reference \"%"SVf"\" as array index",
- SVfARG(ix_sv));
+ if (!SvIOK(ix_sv))
+ break;
iv = SvIV(ix_sv);
if ( action_count == 0
case OP_GV:
/* it may be a package var index */
- assert(!(o->op_flags & ~(OPf_WANT)));
- assert(!(o->op_private & ~(OPpEARLY_CV)));
- if ( o->op_flags != OPf_WANT_SCALAR
+ ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_SPECIAL)));
+ ASSUME(!(o->op_private & ~(OPpEARLY_CV)));
+ if ( (o->op_flags &~ OPf_SPECIAL) != OPf_WANT_SCALAR
|| o->op_private != 0
)
break;
if (kid->op_type != OP_RV2SV)
break;
- assert(!(kid->op_flags &
- ~(OPf_WANT|OPf_KIDS|OPf_MOD|OPf_REF|OPf_SPECIAL)));
- assert(!(kid->op_private &
+ ASSUME(!(kid->op_flags &
+ ~(OPf_WANT|OPf_KIDS|OPf_MOD|OPf_REF
+ |OPf_SPECIAL|OPf_PARENS)));
+ ASSUME(!(kid->op_private &
~(OPpARG1_MASK
|OPpHINT_STRICT_REFS|OPpOUR_INTRO
|OPpDEREF|OPpLVAL_INTRO)));
- if( kid->op_flags != (OPf_WANT_SCALAR|OPf_KIDS)
+ if( (kid->op_flags &~ OPf_PARENS)
+ != (OPf_WANT_SCALAR|OPf_KIDS)
|| (kid->op_private & ~(OPpARG1_MASK|HINT_STRICT_REFS))
)
break;
/* if something like arybase (a.k.a $[ ) is in scope,
* abandon optimisation attempt */
- if (o->op_type == OP_AELEM && PL_check[OP_AELEM] != Perl_ck_null)
+ if ( (o->op_type == OP_AELEM || o->op_type == OP_HELEM)
+ && PL_check[o->op_type] != Perl_ck_null)
return;
if ( o->op_type != OP_AELEM
|| (o->op_private & OPpDEREF) == OPpDEREF_HV);
if (is_deref) {
- assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_MOD)));
- assert(!(o->op_private & ~(OPpARG2_MASK|OPpDEREF)));
+ ASSUME(!(o->op_flags &
+ ~(OPf_WANT|OPf_KIDS|OPf_MOD|OPf_PARENS)));
+ ASSUME(!(o->op_private & ~(OPpARG2_MASK|OPpDEREF)));
- ok = o->op_flags == (OPf_WANT_SCALAR|OPf_KIDS|OPf_MOD)
+ ok = (o->op_flags &~ OPf_PARENS)
+ == (OPf_WANT_SCALAR|OPf_KIDS|OPf_MOD)
&& !(o->op_private & ~(OPpDEREF|OPpARG2_MASK));
}
else if (o->op_type == OP_EXISTS) {
- assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
+ ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
|OPf_REF|OPf_MOD|OPf_SPECIAL)));
- assert(!(o->op_private & ~(OPpARG1_MASK|OPpEXISTS_SUB)));
+ ASSUME(!(o->op_private & ~(OPpARG1_MASK|OPpEXISTS_SUB)));
ok = !(o->op_private & ~OPpARG1_MASK);
}
else if (o->op_type == OP_DELETE) {
- assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
+ ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
|OPf_REF|OPf_MOD|OPf_SPECIAL)));
- assert(!(o->op_private &
+ ASSUME(!(o->op_private &
~(OPpARG1_MASK|OPpSLICE|OPpLVAL_INTRO)));
/* don't handle slices or 'local delete'; the latter
* is fairly rare, and has a complex runtime */
ok = (ok && cBOOL(o->op_flags & OPf_SPECIAL));
}
else {
- assert(o->op_type == OP_AELEM || o->op_type == OP_HELEM);
- assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_MOD
+ ASSUME(o->op_type == OP_AELEM || o->op_type == OP_HELEM);
+ ASSUME(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_MOD
|OPf_PARENS|OPf_REF|OPf_SPECIAL)));
- assert(!(o->op_private & ~(OPpARG2_MASK|OPpMAYBE_LVSUB
+ ASSUME(!(o->op_private & ~(OPpARG2_MASK|OPpMAYBE_LVSUB
|OPpLVAL_DEFER|OPpDEREF|OPpLVAL_INTRO)));
ok = (o->op_private & OPpDEREF) != OPpDEREF_SV;
}
* expr->[..]? so we need to save the 'expr' subtree */
if (p->op_type == OP_EXISTS || p->op_type == OP_DELETE)
p = cUNOPx(p)->op_first;
- assert( start->op_type == OP_RV2AV
+ ASSUME( start->op_type == OP_RV2AV
|| start->op_type == OP_RV2HV);
}
else {
)
p = cUNOPx(p)->op_first;
}
- assert(cUNOPx(p)->op_first == start);
+ ASSUME(cUNOPx(p)->op_first == start);
/* detach from main tree, and re-attach under the multideref */
op_sibling_splice(mderef, NULL, 0,
* not aware of, rather than:
* * silently failing to optimise, or
* * silently optimising the flag away.
- * If this assert starts failing, examine what new flag
+ * If this ASSUME starts failing, examine what new flag
* has been added to the op, and decide whether the
* optimisation should still occur with that flag, then
* update the code accordingly. This applies to all the
- * other asserts in the block of code too.
+ * other ASSUMEs in the block of code too.
*/
- assert(!(o2->op_flags & ~(OPf_WANT|OPf_MOD)));
- assert(!(o2->op_private & ~OPpEARLY_CV));
+ ASSUME(!(o2->op_flags & ~(OPf_WANT|OPf_MOD|OPf_SPECIAL)));
+ ASSUME(!(o2->op_private & ~OPpEARLY_CV));
o2 = o2->op_next;
/* at this point we've seen gv,rv2sv, so the only valid
* construct left is $pkg->[] or $pkg->{} */
- assert(!(o2->op_flags & OPf_STACKED));
+ ASSUME(!(o2->op_flags & OPf_STACKED));
if ((o2->op_flags & (OPf_WANT|OPf_REF|OPf_MOD|OPf_SPECIAL))
!= (OPf_WANT_SCALAR|OPf_MOD))
break;
- assert(!(o2->op_private & ~(OPpARG1_MASK|HINT_STRICT_REFS
+ ASSUME(!(o2->op_private & ~(OPpARG1_MASK|HINT_STRICT_REFS
|OPpOUR_INTRO|OPpDEREF|OPpLVAL_INTRO)));
if (o2->op_private & (OPpOUR_INTRO|OPpLVAL_INTRO))
break;
case OP_PADSV:
/* $lex->[...]: padsv[$lex] sM/DREFAV */
- assert(!(o2->op_flags &
+ ASSUME(!(o2->op_flags &
~(OPf_WANT|OPf_PARENS|OPf_REF|OPf_MOD|OPf_SPECIAL)));
if ((o2->op_flags &
(OPf_WANT|OPf_REF|OPf_MOD|OPf_SPECIAL))
!= (OPf_WANT_SCALAR|OPf_MOD))
break;
- assert(!(o2->op_private &
+ ASSUME(!(o2->op_private &
~(OPpPAD_STATE|OPpDEREF|OPpLVAL_INTRO)));
/* skip if state or intro, or not a deref */
if ( o2->op_private != OPpDEREF_AV
case OP_PADHV:
/* $lex[..]: padav[@lex:1,2] sR *
* or $lex{..}: padhv[%lex:1,2] sR */
- assert(!(o2->op_flags & ~(OPf_WANT|OPf_MOD|OPf_PARENS|
+ ASSUME(!(o2->op_flags & ~(OPf_WANT|OPf_MOD|OPf_PARENS|
OPf_REF|OPf_SPECIAL)));
if ((o2->op_flags &
(OPf_WANT|OPf_REF|OPf_MOD|OPf_SPECIAL))
break;
/* OPf_PARENS isn't currently used in this case;
* if that changes, let us know! */
- assert(!(o2->op_flags & OPf_PARENS));
+ ASSUME(!(o2->op_flags & OPf_PARENS));
/* at this point, we wouldn't expect any of the remaining
* possible private flags:
*
* OPpSLICEWARNING shouldn't affect runtime
*/
- assert(!(o2->op_private & ~(OPpSLICEWARNING)));
+ ASSUME(!(o2->op_private & ~(OPpSLICEWARNING)));
action = o2->op_type == OP_PADAV
? MDEREF_AV_padav_aelem
/* (expr)->[...]: rv2av sKR/1;
* (expr)->{...}: rv2hv sKR/1; */
- assert(o2->op_type == OP_RV2AV || o2->op_type == OP_RV2HV);
+ ASSUME(o2->op_type == OP_RV2AV || o2->op_type == OP_RV2HV);
- assert(!(o2->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
+ ASSUME(!(o2->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
|OPf_REF|OPf_MOD|OPf_STACKED|OPf_SPECIAL)));
if (o2->op_flags != (OPf_WANT_SCALAR|OPf_KIDS|OPf_REF))
break;
/* at this point, we wouldn't expect any of these
* possible private flags:
- * OPpMAYBE_LVSUB, OPpOUR_INTRO, OPpLVAL_INTRO
+ * OPpMAYBE_LVSUB, OPpLVAL_INTRO
* OPpTRUEBOOL, OPpMAYBE_TRUEBOOL, (rv2hv only)
*/
- assert(!(o2->op_private &
- ~(OPpHINT_STRICT_REFS|OPpARG1_MASK|OPpSLICEWARNING)));
+ ASSUME(!(o2->op_private &
+ ~(OPpHINT_STRICT_REFS|OPpARG1_MASK|OPpSLICEWARNING
+ |OPpOUR_INTRO)));
hints |= (o2->op_private & OPpHINT_STRICT_REFS);
o2 = o2->op_next;
*/
{
OP *next = o->op_next;
- OP *sibling = OP_SIBLING(o);
+ OP *sibling = OpSIBLING(o);
if ( OP_TYPE_IS(next, OP_PUSHMARK)
&& OP_TYPE_IS(sibling, OP_RETURN)
&& OP_TYPE_IS(sibling->op_next, OP_LINESEQ)
||OP_TYPE_IS(sibling->op_next->op_next,
OP_LEAVESUBLV))
&& cUNOPx(sibling)->op_first == next
- && OP_HAS_SIBLING(next) && OP_SIBLING(next)->op_next
+ && OpHAS_SIBLING(next) && OpSIBLING(next)->op_next
&& next->op_next
) {
/* Look through the PUSHMARK's siblings for one that
* points to the RETURN */
- OP *top = OP_SIBLING(next);
+ OP *top = OpSIBLING(next);
while (top && top->op_next) {
if (top->op_next == sibling) {
top->op_next = sibling->op_next;
o->op_next = next->op_next;
break;
}
- top = OP_SIBLING(top);
+ top = OpSIBLING(top);
}
}
}
/* we assume here that the op_next chain is the same as
* the op_sibling chain */
- assert(OP_SIBLING(o) == pad1);
- assert(OP_SIBLING(pad1) == ns2);
- assert(OP_SIBLING(ns2) == pad2);
- assert(OP_SIBLING(pad2) == ns3);
+ assert(OpSIBLING(o) == pad1);
+ assert(OpSIBLING(pad1) == ns2);
+ assert(OpSIBLING(ns2) == pad2);
+ assert(OpSIBLING(pad2) == ns3);
/* create new listop, with children consisting of:
* a new pushmark, pad1, pad2. */
- OP_SIBLING_set(pad2, NULL);
+ OpSIBLING_set(pad2, NULL);
newop = newLISTOP(OP_LIST, 0, pad1, pad2);
newop->op_flags |= OPf_PARENS;
newop->op_flags = (newop->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
pad2 ->op_next = newop; /* listop */
newop->op_next = ns3;
- OP_SIBLING_set(o, newop);
- OP_SIBLING_set(newop, ns3);
+ OpSIBLING_set(o, newop);
+ OpSIBLING_set(newop, ns3);
newop->op_lastsib = 0;
newop->op_flags = (newop->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
op_free(cBINOPo->op_last );
o->op_flags &=~ OPf_KIDS;
/* stub is a baseop; repeat is a binop */
- assert(sizeof(OP) <= sizeof(BINOP));
+ STATIC_ASSERT_STMT(sizeof(OP) <= sizeof(BINOP));
CHANGE_TYPE(o, OP_STUB);
o->op_private = 0;
break;
U8 count = 0;
U8 intro = 0;
PADOFFSET base = 0; /* init only to stop compiler whining */
- U8 gimme = 0; /* init only to stop compiler whining */
+ bool gvoid = 0; /* init only to stop compiler whining */
bool defav = 0; /* seen (...) = @_ */
bool reuse = 0; /* reuse an existing padrange op */
if (count == 0) {
intro = (p->op_private & OPpLVAL_INTRO);
base = p->op_targ;
- gimme = (p->op_flags & OPf_WANT);
+ gvoid = OP_GIMME(p,0) == G_VOID;
}
else {
if ((p->op_private & OPpLVAL_INTRO) != intro)
if (p->op_targ != base + count)
break;
assert(p->op_targ == base + count);
- /* all the padops should be in the same context */
- if (gimme != (p->op_flags & OPf_WANT))
+ /* Either all the padops or none of the padops should
+ be in void context. Since we only do the optimisa-
+ tion for av/hv when the aggregate itself is pushed
+ on to the stack (one item), there is no need to dis-
+ tinguish list from scalar context. */
+ if (gvoid != (OP_GIMME(p,0) == G_VOID))
break;
}
/* for AV, HV, only when we're not flattening */
if ( p->op_type != OP_PADSV
- && gimme != OPf_WANT_VOID
+ && !gvoid
&& !(p->op_flags & OPf_REF)
)
break;
* the stack) makes no difference in void context.
*/
assert(followop);
- if (gimme == OPf_WANT_VOID) {
+ if (gvoid) {
if (followop->op_type == OP_LIST
- && gimme == (followop->op_flags & OPf_WANT)
+ && OP_GIMME(followop,0) == G_VOID
)
{
followop = followop->op_next; /* skip OP_LIST */
/* bit 7: INTRO; bit 6..0: count */
o->op_private = (intro | count);
o->op_flags = ((o->op_flags & ~(OPf_WANT|OPf_SPECIAL))
- | gimme | (defav ? OPf_SPECIAL : 0));
+ | gvoid * OPf_WANT_VOID
+ | (defav ? OPf_SPECIAL : 0));
}
break;
}
case OP_OR:
case OP_DOR:
fop = cLOGOP->op_first;
- sop = OP_SIBLING(fop);
+ sop = OpSIBLING(fop);
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
while (o->op_next && ( o->op_type == o->op_next->op_type
if (o->op_flags & OPf_SPECIAL) {
/* first arg is a code block */
- OP * const nullop = OP_SIBLING(cLISTOP->op_first);
+ OP * const nullop = OpSIBLING(cLISTOP->op_first);
OP * kid = cUNOPx(nullop)->op_first;
assert(nullop->op_type == OP_NULL);
break;
/* reverse sort ... can be optimised. */
- if (!OP_HAS_SIBLING(cUNOPo)) {
+ if (!OpHAS_SIBLING(cUNOPo)) {
/* Nothing follows us on the list. */
OP * const reverse = o->op_next;
(reverse->op_flags & OPf_WANT) == OPf_WANT_LIST) {
OP * const pushmark = cUNOPx(reverse)->op_first;
if (pushmark && (pushmark->op_type == OP_PUSHMARK)
- && (OP_SIBLING(cUNOPx(pushmark)) == o)) {
+ && (OpSIBLING(cUNOPx(pushmark)) == o)) {
/* reverse -> pushmark -> sort */
o->op_private |= OPpSORT_REVERSE;
op_null(reverse);
|| expushmark->op_targ != OP_PUSHMARK)
break;
- exlist = (LISTOP *) OP_SIBLING(expushmark);
+ exlist = (LISTOP *) OpSIBLING(expushmark);
if (!exlist || exlist->op_type != OP_NULL
|| exlist->op_targ != OP_LIST)
break;
if (!theirmark || theirmark->op_type != OP_PUSHMARK)
break;
- if (OP_SIBLING(theirmark) != o) {
+ if (OpSIBLING(theirmark) != o) {
/* There's something between the mark and the reverse, eg
for (1, reverse (...))
so no go. */
if (!ourlast || ourlast->op_next != o)
break;
- rv2av = OP_SIBLING(ourmark);
- if (rv2av && rv2av->op_type == OP_RV2AV && !OP_HAS_SIBLING(rv2av)
+ rv2av = OpSIBLING(ourmark);
+ if (rv2av && rv2av->op_type == OP_RV2AV && !OpHAS_SIBLING(rv2av)
&& rv2av->op_flags == (OPf_WANT_LIST | OPf_KIDS)
&& enter->op_flags == (OPf_WANT_LIST | OPf_KIDS)) {
/* We're just reversing a single array. */
* arg2
* ...
*/
- OP *left = OP_SIBLING(right);
+ OP *left = OpSIBLING(right);
if (left->op_type == OP_SUBSTR
&& (left->op_private & 7) < 4) {
op_null(o);
(as formerly), so that all lexical vars that get aliased are
marked as such before we do the check. */
/* There can’t be common vars if the lhs is a stub. */
- if (OP_SIBLING(cLISTOPx(cBINOPo->op_last)->op_first)
+ if (OpSIBLING(cLISTOPx(cBINOPo->op_last)->op_first)
== cLISTOPx(cBINOPo->op_last)->op_last
&& cLISTOPx(cBINOPo->op_last)->op_last->op_type == OP_STUB)
{
https://perl5.git.perl.org / perl5.git / blobdiff