DEBUG_S_warn((aTHX_ "allocating op at %p, slab %p", (void*)o, (void*)slab));
gotit:
- /* lastsib == 1, op_sibling == 0 implies a solitary unattached op */
- o->op_lastsib = 1;
- assert(!o->op_sibling);
+#ifdef PERL_OP_PARENT
+ /* moresib == 0, op_sibling == 0 implies a solitary unattached op */
+ assert(!o->op_moresib);
+ assert(!o->op_sibparent);
+#endif
return (void *)o;
}
PERL_UNUSED_CONTEXT;
DEBUG_S_warn((aTHX_ "freeing slab %p", (void*)slab));
assert(slab->opslab_refcnt == 1);
- for (; slab; slab = slab2) {
+ do {
slab2 = slab->opslab_next;
#ifdef DEBUGGING
slab->opslab_refcnt = ~(size_t)0;
#else
PerlMemShared_free(slab);
#endif
- }
+ slab = slab2;
+ } while (slab);
}
void
#define RETURN_UNLIMITED_NUMBER (PERL_INT_MAX / 2)
-#define CHANGE_TYPE(o,type) \
+#define OpTYPE_set(o,type) \
STMT_START { \
o->op_type = (OPCODE)type; \
o->op_ppaddr = PL_ppaddr[type]; \
}
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);
}
}
}
return;
op_clear(o);
o->op_targ = o->op_type;
- CHANGE_TYPE(o, OP_NULL);
+ OpTYPE_set(o, OP_NULL);
}
void
more different nodes. Performs the necessary op_first/op_last
housekeeping on the parent node and op_sibling manipulation on the
children. The last deleted node will be marked as as the last node by
-updating the op_sibling or op_lastsib field as appropriate.
+updating the op_sibling/op_sibparent or op_moresib field as appropriate.
Note that op_next is not manipulated, and nodes are not freed; that is the
responsibility of the caller. It also won't create a new list op for an
empty list etc; use higher-level functions like op_append_elem() for that.
-parent is the parent node of the sibling chain.
+parent is the parent node of the sibling chain. It may passed as NULL if
+the splicing doesn't affect the first or last op in the chain.
start is the node preceding the first node to be spliced. Node(s)
following it will be deleted, and ops will be inserted after it. If it is
splice(P, B, 0, X-Y) | | NULL
A-B-C-D A-B-X-Y-C-D
+
+For lower-level direct manipulation of C<op_sibparent> and C<op_moresib>,
+see C<OpMORESIB_set>, C<OpLASTSIB_set>, C<OpMAYBESIB_set>.
+
=cut
*/
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;
OP *rest;
OP *last_del = NULL;
OP *last_ins = NULL;
- PERL_ARGS_ASSERT_OP_SIBLING_SPLICE;
+ if (start)
+ first = OpSIBLING(start);
+ else if (!parent)
+ goto no_parent;
+ else
+ first = cLISTOPx(parent)->op_first;
assert(del_count >= -1);
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);
- last_del->op_lastsib = 1;
+ while (--del_count && OpHAS_SIBLING(last_del))
+ last_del = OpSIBLING(last_del);
+ rest = OpSIBLING(last_del);
+ OpLASTSIB_set(last_del, NULL);
}
else
rest = first;
if (insert) {
last_ins = insert;
- while (OP_HAS_SIBLING(last_ins))
- last_ins = OP_SIBLING(last_ins);
- OP_SIBLING_set(last_ins, rest);
- last_ins->op_lastsib = rest ? 0 : 1;
+ while (OpHAS_SIBLING(last_ins))
+ last_ins = OpSIBLING(last_ins);
+ OpMAYBESIB_set(last_ins, rest, NULL);
}
else
insert = rest;
if (start) {
- OP_SIBLING_set(start, insert);
- start->op_lastsib = insert ? 0 : 1;
+ OpMAYBESIB_set(start, insert, NULL);
}
else {
+ if (!parent)
+ goto no_parent;
cLISTOPx(parent)->op_first = insert;
if (insert)
parent->op_flags |= OPf_KIDS;
if (!rest) {
/* update op_last etc */
- U32 type = parent->op_type;
+ U32 type;
OP *lastop;
- if (type == OP_NULL)
- type = parent->op_targ;
- type = PL_opargs[type] & OA_CLASS_MASK;
+ if (!parent)
+ goto no_parent;
+
+ /* ought to use OP_CLASS(parent) here, but that can't handle
+ * ex-foo OP_NULL ops. Also note that XopENTRYCUSTOM() can't
+ * either */
+ type = parent->op_type;
+ if (type == OP_CUSTOM) {
+ dTHX;
+ type = XopENTRYCUSTOM(parent, xop_class);
+ }
+ else {
+ if (type == OP_NULL)
+ type = parent->op_targ;
+ type = PL_opargs[type] & OA_CLASS_MASK;
+ }
lastop = last_ins ? last_ins : start ? start : NULL;
if ( type == OA_BINOP
)
cLISTOPx(parent)->op_last = lastop;
- if (lastop) {
- lastop->op_lastsib = 1;
-#ifdef PERL_OP_PARENT
- lastop->op_sibling = parent;
-#endif
- }
+ if (lastop)
+ OpLASTSIB_set(lastop, parent);
}
return last_del ? first : NULL;
+
+ no_parent:
+ Perl_croak_nocontext("panic: op_sibling_splice(): NULL parent");
}
+
+#ifdef PERL_OP_PARENT
+
/*
=for apidoc op_parent
-returns the parent OP of o, if it has a parent. Returns NULL otherwise.
-(Currently perl must be built with C<-DPERL_OP_PARENT> for this feature to
-work.
+Returns the parent OP of o, if it has a parent. Returns NULL otherwise.
+This function is only available on perls built with C<-DPERL_OP_PARENT>.
=cut
*/
Perl_op_parent(OP *o)
{
PERL_ARGS_ASSERT_OP_PARENT;
-#ifdef PERL_OP_PARENT
- while (OP_HAS_SIBLING(o))
- o = OP_SIBLING(o);
- return o->op_sibling;
-#else
- PERL_UNUSED_ARG(o);
- return NULL;
-#endif
+ while (OpHAS_SIBLING(o))
+ o = OpSIBLING(o);
+ return o->op_sibparent;
}
+#endif
+
/* replace the sibling following start with a new UNOP, which becomes
* the parent of the original sibling; e.g.
LOGOP *logop;
OP *kid = first;
NewOp(1101, logop, 1, LOGOP);
- CHANGE_TYPE(logop, type);
+ OpTYPE_set(logop, type);
logop->op_first = first;
logop->op_other = other;
logop->op_flags = OPf_KIDS;
- while (kid && OP_HAS_SIBLING(kid))
- kid = OP_SIBLING(kid);
- if (kid) {
- kid->op_lastsib = 1;
-#ifdef PERL_OP_PARENT
- kid->op_sibling = (OP*)logop;
-#endif
- }
+ while (kid && OpHAS_SIBLING(kid))
+ kid = OpSIBLING(kid);
+ if (kid)
+ OpLASTSIB_set(kid, (OP*)logop);
return logop;
}
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:
case OP_LOCALTIME:
case OP_GMTIME:
case OP_ENTEREVAL:
- case OP_REACH:
- case OP_RKEYS:
- case OP_RVALUES:
return;
}
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;
break;
case OP_POSTINC:
- CHANGE_TYPE(o, OP_PREINC); /* pre-increment is faster */
+ OpTYPE_set(o, OP_PREINC); /* pre-increment is faster */
break;
case OP_POSTDEC:
- CHANGE_TYPE(o, OP_PREDEC); /* pre-decrement is faster */
+ OpTYPE_set(o, OP_PREDEC); /* pre-decrement is faster */
break;
case OP_I_POSTINC:
- CHANGE_TYPE(o, OP_I_PREINC); /* pre-increment is faster */
+ OpTYPE_set(o, OP_I_PREINC); /* pre-increment is faster */
break;
case OP_I_POSTDEC:
- CHANGE_TYPE(o, OP_I_PREDEC); /* pre-decrement is faster */
+ OpTYPE_set(o, OP_I_PREDEC); /* pre-decrement is faster */
break;
case OP_SASSIGN: {
if (kid->op_type == OP_NOT
&& (kid->op_flags & OPf_KIDS)) {
if (o->op_type == OP_AND) {
- CHANGE_TYPE(o, OP_OR);
+ OpTYPE_set(o, OP_OR);
} else {
- CHANGE_TYPE(o, OP_AND);
+ OpTYPE_set(o, OP_AND);
}
op_null(kid);
}
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;
#ifdef DEBUGGING
/* check that op_last points to the last sibling, and that
- * the last op_sibling field points back to the parent, and
- * that the only ops with KIDS are those which are entitled to
- * them */
+ * the last op_sibling/op_sibparent field points back to the
+ * parent, and that the only ops with KIDS are those which are
+ * entitled to them */
U32 type = o->op_type;
U32 family;
bool has_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);
+ assert(kid->op_sibparent == o);
}
# else
- if (OP_HAS_SIBLING(kid)) {
- assert(!kid->op_lastsib);
- }
- else {
- assert(kid->op_lastsib);
- if (has_last)
- assert(kid == cLISTOPo->op_last);
- }
+ if (has_last && !OpHAS_SIBLING(kid))
+ assert(kid == cLISTOPo->op_last);
# endif
}
#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:
return;
}
slurpy:
- CHANGE_TYPE(o, OP_LVAVREF);
+ OpTYPE_set(o, OP_LVAVREF);
o->op_private &= OPpLVAL_INTRO|OPpPAD_STATE;
o->op_flags |= OPf_MOD|OPf_REF;
return;
case OP_RV2CV:
kid = cUNOPo->op_first;
if (kid->op_type == OP_NULL)
- kid = cUNOPx(kUNOP->op_first->op_sibling)
+ kid = cUNOPx(OpSIBLING(kUNOP->op_first))
->op_first;
o->op_private = OPpLVREF_CV;
if (kid->op_type == OP_GV)
break;
case OP_ASLICE:
case OP_HSLICE:
- CHANGE_TYPE(o, OP_LVREFSLICE);
+ OpTYPE_set(o, OP_LVREFSLICE);
o->op_private &= OPpLVAL_INTRO|OPpLVREF_ELEM;
return;
case OP_NULL:
}
/* 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);
}
? "do block"
: OP_DESC(o),
PL_op_desc[type]));
- return;
}
- CHANGE_TYPE(o, OP_LVREF);
+ OpTYPE_set(o, OP_LVREF);
o->op_private &=
OPpLVAL_INTRO|OPpLVREF_ELEM|OPpLVREF_TYPE|OPpPAD_STATE;
if (type == OP_ENTERLOOP)
case OP_ENTERSUB:
if ((type == OP_UNDEF || type == OP_REFGEN || type == OP_LOCK) &&
!(o->op_flags & OPf_STACKED)) {
- CHANGE_TYPE(o, OP_RV2CV); /* entersub => rv2cv */
+ OpTYPE_set(o, OP_RV2CV); /* entersub => rv2cv */
assert(cUNOPo->op_first->op_type == OP_NULL);
op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
break;
(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;
break;
case OP_KEYS:
- case OP_RKEYS:
if (type != OP_SASSIGN && type != OP_LEAVESUBLV)
goto nomod;
goto lvalue_func;
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;
PERL_ARGS_ASSERT_DOREF;
- if (!o || (PL_parser && PL_parser->error_count))
+ if (PL_parser && PL_parser->error_count)
return o;
switch (o->op_type) {
case OP_ENTERSUB:
if ((type == OP_EXISTS || type == OP_DEFINED) &&
!(o->op_flags & OPf_STACKED)) {
- CHANGE_TYPE(o, OP_RV2CV); /* entersub => rv2cv */
+ OpTYPE_set(o, OP_RV2CV); /* entersub => rv2cv */
assert(cUNOPo->op_first->op_type == OP_NULL);
op_null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
o->op_flags |= OPf_SPECIAL;
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,
STATIC void
S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
{
- SV * const stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
-
PERL_ARGS_ASSERT_APPLY_ATTRS;
+ {
+ SV * const stashsv = newSVhek(HvNAME_HEK(stash));
- /* fake up C<use attributes $pkg,$rv,@attrs> */
+ /* fake up C<use attributes $pkg,$rv,@attrs> */
#define ATTRSMODULE "attributes"
#define ATTRSMODULE_PM "attributes.pm"
- Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
- newSVpvs(ATTRSMODULE),
- NULL,
- op_prepend_elem(OP_LIST,
- newSVOP(OP_CONST, 0, stashsv),
- op_prepend_elem(OP_LIST,
- newSVOP(OP_CONST, 0,
- newRV(target)),
- dup_attrlist(attrs))));
+ Perl_load_module(
+ aTHX_ PERL_LOADMOD_IMPORT_OPS,
+ newSVpvs(ATTRSMODULE),
+ NULL,
+ op_prepend_elem(OP_LIST,
+ newSVOP(OP_CONST, 0, stashsv),
+ op_prepend_elem(OP_LIST,
+ newSVOP(OP_CONST, 0,
+ newRV(target)),
+ dup_attrlist(attrs))));
+ }
}
STATIC void
pack = newSVOP(OP_CONST, 0, newSVpvs(ATTRSMODULE));
/* Build up the real arg-list. */
- stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
+ stashsv = newSVhek(HvNAME_HEK(stash));
arg = newOP(OP_PADSV, 0);
arg->op_targ = target->op_targ;
newSVOP(OP_CONST, 0, stashsv),
op_prepend_elem(OP_LIST,
newUNOP(OP_REFGEN, 0,
- op_lvalue(arg, OP_REFGEN)),
+ arg),
dup_attrlist(attrs)));
/* Fake up a method call to import */
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 *
if (o) {
if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) {
o = op_prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
- CHANGE_TYPE(o, OP_LEAVE);
+ OpTYPE_set(o, OP_LEAVE);
}
else if (o->op_type == OP_LINESEQ) {
OP *kid;
- CHANGE_TYPE(o, OP_SCOPE);
+ OpTYPE_set(o, OP_SCOPE);
kid = ((LISTOP*)o)->op_first;
if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
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);
Perl_pp_anonlist(aTHX);
PL_tmps_floor = oldtmps_floor;
- CHANGE_TYPE(o, OP_RV2AV);
+ OpTYPE_set(o, OP_RV2AV);
o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */
o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
o->op_opt = 0; /* needs to be revisited in rpeep() */
if (last->op_type != (unsigned)type)
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);
+ OpMORESIB_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
- ((LISTOP*)first)->op_last->op_sibling = first;
-#endif
+ OpLASTSIB_set(((LISTOP*)first)->op_last, first);
first->op_flags |= (last->op_flags & OPf_KIDS);
-
S_op_destroy(aTHX_ last);
return first;
if (!o || o->op_type != OP_LIST)
o = force_list(o, 0);
else
+ {
o->op_flags &= ~OPf_WANT;
+ o->op_private &= ~OPpLVAL_INTRO;
+ }
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;
}
}
- CHANGE_TYPE(o, type);
+ OpTYPE_set(o, type);
o->op_flags |= flags;
if (flags & OPf_FOLDED)
o->op_folded = 1;
OP *rest = NULL;
if (o) {
/* manually detach any siblings then add them back later */
- rest = OP_SIBLING(o);
- OP_SIBLING_set(o, NULL);
- o->op_lastsib = 1;
+ rest = OpSIBLING(o);
+ OpLASTSIB_set(o, NULL);
}
o = newLISTOP(OP_LIST, 0, o, NULL);
if (rest)
consumed by this function and become part of the constructed op tree.
For most list operators, the check function expects all the kid ops to be
-present already, so calling C<newLISTOP(OP_JOIN, ...)> (e.g.,) is not
+present already, so calling C<newLISTOP(OP_JOIN, ...)> (e.g.) is not
appropriate. What you want to do in that case is create an op of type
OP_LIST, append more children to it, and then call L</op_convert_list>.
See L</op_convert_list> for more information.
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);
- CHANGE_TYPE(listop, type);
+ OpTYPE_set(listop, type);
if (first || last)
flags |= OPf_KIDS;
listop->op_flags = (U8)flags;
else if (!first && last)
first = last;
else if (first)
- OP_SIBLING_set(first, last);
+ OpMORESIB_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);
+ OpMORESIB_set(pushop, first);
listop->op_first = pushop;
listop->op_flags |= OPf_KIDS;
if (!last)
listop->op_last = pushop;
}
- if (first)
- first->op_lastsib = 0;
- if (listop->op_last) {
- listop->op_last->op_lastsib = 1;
-#ifdef PERL_OP_PARENT
- listop->op_last->op_sibling = (OP*)listop;
-#endif
- }
+ if (listop->op_last)
+ OpLASTSIB_set(listop->op_last, (OP*)listop);
return CHECKOP(type, listop);
}
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
NewOp(1101, o, 1, OP);
- CHANGE_TYPE(o, type);
+ OpTYPE_set(o, type);
o->op_flags = (U8)flags;
o->op_next = o;
|| (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP
|| type == OP_SASSIGN
|| type == OP_ENTERTRY
+ || type == OP_CUSTOM
|| type == OP_NULL );
if (!first)
first = force_list(first, 1);
NewOp(1101, unop, 1, UNOP);
- CHANGE_TYPE(unop, type);
+ OpTYPE_set(unop, type);
unop->op_first = first;
unop->op_flags = (U8)(flags | OPf_KIDS);
unop->op_private = (U8)(1 | (flags >> 8));
-#ifdef PERL_OP_PARENT
- if (!OP_HAS_SIBLING(first)) /* true unless weird syntax error */
- first->op_sibling = (OP*)unop;
-#endif
+ if (!OpHAS_SIBLING(first)) /* true unless weird syntax error */
+ OpLASTSIB_set(first, (OP*)unop);
unop = (UNOP*) CHECKOP(type, unop);
if (unop->op_next)
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_private = (U8)((first ? 1 : 0) | (flags >> 8));
unop->op_aux = aux;
-#ifdef PERL_OP_PARENT
- if (first && !OP_HAS_SIBLING(first)) /* true unless weird syntax error */
- first->op_sibling = (OP*)unop;
-#endif
+ if (first && !OpHAS_SIBLING(first)) /* true unless weird syntax error */
+ OpLASTSIB_set(first, (OP*)unop);
unop = (UNOP_AUX*) CHECKOP(type, unop);
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_u.op_first = dynamic_meth;
methop->op_private = (U8)(1 | (flags >> 8));
-#ifdef PERL_OP_PARENT
- if (!OP_HAS_SIBLING(dynamic_meth))
- dynamic_meth->op_sibling = (OP*)methop;
-#endif
+ if (!OpHAS_SIBLING(dynamic_meth))
+ OpLASTSIB_set(dynamic_meth, (OP*)methop);
}
else {
assert(const_meth);
methop->op_rclass_sv = NULL;
#endif
- CHANGE_TYPE(methop, type);
- methop = (METHOP*) CHECKOP(type, methop);
-
- return fold_constants(op_integerize(op_std_init((OP *) methop)));
+ OpTYPE_set(methop, type);
+ return CHECKOP(type, methop);
}
OP *
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);
if (!first)
first = newOP(OP_NULL, 0);
- CHANGE_TYPE(binop, type);
+ OpTYPE_set(binop, type);
binop->op_first = first;
binop->op_flags = (U8)(flags | OPf_KIDS);
if (!last) {
}
else {
binop->op_private = (U8)(2 | (flags >> 8));
- OP_SIBLING_set(first, last);
- first->op_lastsib = 0;
+ OpMORESIB_set(first, last);
}
-#ifdef PERL_OP_PARENT
- if (!OP_HAS_SIBLING(last)) /* true unless weird syntax error */
- last->op_sibling = (OP*)binop;
-#endif
+ if (!OpHAS_SIBLING(last)) /* true unless weird syntax error */
+ OpLASTSIB_set(last, (OP*)binop);
- binop->op_last = OP_SIBLING(binop->op_first);
-#ifdef PERL_OP_PARENT
+ binop->op_last = OpSIBLING(binop->op_first);
if (binop->op_last)
- binop->op_last->op_sibling = (OP*)binop;
-#endif
+ OpLASTSIB_set(binop->op_last, (OP*)binop);
binop = (BINOP*)CHECKOP(type, binop);
if (binop->op_next || binop->op_type != (OPCODE)type)
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);
+ OpTYPE_set(pmop, type);
pmop->op_flags = (U8)flags;
pmop->op_private = (U8)(0 | (flags >> 8));
+ if (PL_opargs[type] & OA_RETSCALAR)
+ scalar((OP *)pmop);
if (PL_hints & HINT_RE_TAINT)
pmop->op_pmflags |= PMf_RETAINT;
* 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);
+ OpTYPE_set(svop, type);
svop->op_sv = sv;
svop->op_next = (OP*)svop;
svop->op_flags = (U8)flags;
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);
+ OpTYPE_set(padop, type);
padop->op_padix =
pad_alloc(type, isGV(sv) ? SVf_READONLY : SVs_PADTMP);
SvREFCNT_dec(PAD_SVl(padop->op_padix));
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);
- CHANGE_TYPE(pvop, type);
+ OpTYPE_set(pvop, type);
pvop->op_pv = pv;
pvop->op_next = (OP*)pvop;
pvop->op_flags = (U8)flags;
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)
NewOp(1101, cop, 1, COP);
if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) {
- CHANGE_TYPE(cop, OP_DBSTATE);
+ OpTYPE_set(cop, OP_DBSTATE);
}
else {
- CHANGE_TYPE(cop, OP_NEXTSTATE);
+ OpTYPE_set(cop, OP_NEXTSTATE);
}
cop->op_flags = (U8)flags;
CopHINTS_set(cop, PL_hints);
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)
if (!loop) {
NewOp(1101,loop,1,LOOP);
- CHANGE_TYPE(loop, OP_ENTERLOOP);
+ OpTYPE_set(loop, OP_ENTERLOOP);
loop->op_private = 0;
loop->op_next = (OP*)loop;
}
if (sv) {
if (sv->op_type == OP_RV2SV) { /* symbol table variable */
iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */
- CHANGE_TYPE(sv, OP_RV2GV);
+ OpTYPE_set(sv, OP_RV2GV);
/* The op_type check is needed to prevent a possible segfault
* if the loop variable is undeclared and 'strict vars' is in
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;
expr = op_lvalue(force_list(expr, 1), OP_GREPSTART);
}
- loop = (LOOP*)list(op_convert_list(OP_ENTERITER, iterflags,
- op_append_elem(OP_LIST, expr, scalar(sv))));
+ loop = (LOOP*)op_convert_list(OP_ENTERITER, iterflags,
+ op_append_elem(OP_LIST, list(expr),
+ scalar(sv)));
assert(!loop->op_next);
/* for my $x () sets OPpLVAL_INTRO;
* for our $x () sets OPpOUR_INTRO */
NewOp(1234,tmp,1,LOOP);
Copy(loop,tmp,1,LISTOP);
#ifdef PERL_OP_PARENT
- assert(loop->op_last->op_sibling == (OP*)loop);
- loop->op_last->op_sibling = (OP*)tmp; /*point back to new parent */
+ assert(loop->op_last->op_sibparent == (OP*)loop);
+ OpLASTSIB_set(loop->op_last, (OP*)tmp); /*point back to new parent */
#endif
S_op_destroy(aTHX_ (OP*)loop);
loop = tmp;
{
loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP));
#ifdef PERL_OP_PARENT
- loop->op_last->op_sibling = (OP *)loop;
+ OpLASTSIB_set(loop->op_last, (OP*)loop);
#endif
}
loop->op_targ = padoff;
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" */
/* anonlist now needs a list from this op, was previously used in
* scalar context */
- cond->op_flags |= ~(OPf_WANT_SCALAR | OPf_REF);
+ cond->op_flags &= ~(OPf_WANT_SCALAR | OPf_REF);
cond->op_flags |= OPf_WANT_LIST;
return newANONLIST(op_lvalue(cond, OP_ANONLIST));
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
: newUNOP(OP_LEAVESUB, 0, scalarseq(block));
start = LINKLIST(block);
block->op_next = 0;
+ if (ps && !*ps && !attrs && !CvLVALUE(compcv))
+ const_sv = S_op_const_sv(aTHX_ start, compcv, FALSE);
+ else
+ const_sv = NULL;
}
-
- if (!block || !ps || *ps || attrs
- || CvLVALUE(compcv)
- )
- const_sv = NULL;
else
- const_sv = S_op_const_sv(aTHX_ start, compcv, FALSE);
+ const_sv = NULL;
if (cv) {
const bool exists = CvROOT(cv) || CvXSUB(cv);
if (slab)
Slab_to_ro(slab);
#endif
- if (o) op_free(o);
+ op_free(o);
return cv;
}
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) {
gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV);
has_name = FALSE;
}
- if (!ec)
- move_proto_attr(&proto, &attrs,
- isGV(gv) ? gv : (GV *)cSVOPo->op_sv);
+ if (!ec) {
+ if (isGV(gv)) {
+ move_proto_attr(&proto, &attrs, gv);
+ } else {
+ assert(cSVOPo);
+ move_proto_attr(&proto, &attrs, (GV *)cSVOPo->op_sv);
+ }
+ }
if (proto) {
assert(proto->op_type == OP_CONST);
: newUNOP(OP_LEAVESUB, 0, scalarseq(block));
start = LINKLIST(block);
block->op_next = 0;
+ if (ps && !*ps && !attrs && !CvLVALUE(PL_compcv))
+ const_sv =
+ S_op_const_sv(aTHX_ start, PL_compcv, CvCLONE(PL_compcv));
+ else
+ const_sv = NULL;
}
-
- if (!block || !ps || *ps || attrs
- || CvLVALUE(PL_compcv)
- )
- const_sv = NULL;
else
- const_sv =
- S_op_const_sv(aTHX_ start, PL_compcv, CvCLONE(PL_compcv));
+ const_sv = NULL;
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;
}
}
{
PERL_ARGS_ASSERT_NEWXS_DEFFILE;
return newXS_len_flags(
- name, name ? strlen(name) : 0, subaddr, NULL, NULL, NULL, 0
+ name, strlen(name), subaddr, NULL, NULL, NULL, 0
);
}
bool interleave = FALSE;
PERL_ARGS_ASSERT_NEWXS_LEN_FLAGS;
- if (!subaddr)
- Perl_croak_nocontext("panic: no address for '%s' in '%s'",
- name, filename ? filename : PL_xsubfilename);
+
{
GV * const gv = gv_fetchpvn(
name ? name : PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
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 *
switch (o->op_type) {
case OP_PADSV:
case OP_PADHV:
- CHANGE_TYPE(o, OP_PADAV);
+ OpTYPE_set(o, OP_PADAV);
return ref(o, OP_RV2AV);
case OP_RV2SV:
case OP_RV2HV:
- CHANGE_TYPE(o, OP_RV2AV);
+ OpTYPE_set(o, OP_RV2AV);
ref(o, OP_RV2AV);
break;
switch (o->op_type) {
case OP_PADSV:
case OP_PADAV:
- CHANGE_TYPE(o, OP_PADHV);
+ OpTYPE_set(o, OP_PADHV);
return ref(o, OP_RV2HV);
case OP_RV2SV:
case OP_RV2AV:
- CHANGE_TYPE(o, OP_RV2HV);
+ OpTYPE_set(o, OP_RV2HV);
ref(o, OP_RV2HV);
break;
PERL_ARGS_ASSERT_NEWAVREF;
if (o->op_type == OP_PADANY) {
- CHANGE_TYPE(o, OP_PADAV);
+ OpTYPE_set(o, OP_PADAV);
return o;
}
else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)) {
PERL_ARGS_ASSERT_NEWHVREF;
if (o->op_type == OP_PADANY) {
- CHANGE_TYPE(o, OP_PADHV);
+ OpTYPE_set(o, OP_PADHV);
return o;
}
else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)) {
{
if (o->op_type == OP_PADANY) {
dVAR;
- CHANGE_TYPE(o, OP_PADCV);
+ OpTYPE_set(o, OP_PADCV);
}
return newUNOP(OP_RV2CV, flags, scalar(o));
}
PERL_ARGS_ASSERT_NEWSVREF;
if (o->op_type == OP_PADANY) {
- CHANGE_TYPE(o, OP_PADSV);
+ OpTYPE_set(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 */
PERL_ARGS_ASSERT_CK_BITOP;
o->op_private = (U8)(PL_hints & HINT_INTEGER);
+
+ if (o->op_type == OP_NBIT_OR || o->op_type == OP_SBIT_OR
+ || o->op_type == OP_NBIT_XOR || o->op_type == OP_SBIT_XOR
+ || o->op_type == OP_NBIT_AND || o->op_type == OP_SBIT_AND
+ || o->op_type == OP_NCOMPLEMENT || o->op_type == OP_SCOMPLEMENT)
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__BITWISE),
+ "The bitwise feature is experimental");
if (!(o->op_flags & OPf_STACKED) /* Not an assignment */
- && (o->op_type == OP_BIT_OR
- || o->op_type == OP_BIT_AND
- || o->op_type == OP_BIT_XOR))
+ && OP_IS_INFIX_BIT(o->op_type))
{
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) &&
(right->op_flags & OPf_PARENS) == 0))
Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE),
- "Possible precedence problem on bitwise %c operator",
- o->op_type == OP_BIT_OR ? '|'
- : o->op_type == OP_BIT_AND ? '&' : '^'
+ "Possible precedence problem on bitwise %s operator",
+ o->op_type == OP_BIT_OR
+ ||o->op_type == OP_NBIT_OR ? "|"
+ : o->op_type == OP_BIT_AND
+ ||o->op_type == OP_NBIT_AND ? "&"
+ : o->op_type == OP_BIT_XOR
+ ||o->op_type == OP_NBIT_XOR ? "^"
+ : o->op_type == OP_SBIT_OR ? "|."
+ : o->op_type == OP_SBIT_AND ? "&." : "^."
);
}
return o;
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 */
enter->op_next = (OP*)enter;
o = op_prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
- CHANGE_TYPE(o, OP_LEAVETRY);
+ OpTYPE_set(o, OP_LEAVETRY);
enter->op_other = o;
return 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);
}
&& SvTYPE(SvRV(gv)) != SVt_PVCV)
gv_fetchsv(kidsv, GV_ADDMULTI, SVt_PVCV);
}
- CHANGE_TYPE(kid, OP_GV);
+ OpTYPE_set(kid, OP_GV);
SvREFCNT_dec(kid->op_sv);
#ifdef USE_ITHREADS
/* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
}
if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type))
o->op_private |= OPpFT_ACCESS;
- if (PL_check[kidtype] == Perl_ck_ftst
- && kidtype != OP_STAT && kidtype != OP_LSTAT) {
+ if (type != OP_STAT && type != OP_LSTAT
+ && PL_check[kidtype] == Perl_ck_ftst
+ && kidtype != OP_STAT && kidtype != OP_LSTAT
+ ) {
o->op_private |= OPpFT_STACKED;
kid->op_private |= OPpFT_STACKING;
if (kidtype == OP_FTTTY && (
(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);
- /* 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);
- else {
- scalar(kid);
- /* diag_listed_as: push on reference is experimental */
- Perl_ck_warner_d(aTHX_
- packWARN(WARN_EXPERIMENTAL__AUTODEREF),
- "%s on reference is experimental",
- PL_op_desc[type]);
+ bad_type_pv(numargs, "array", o, kid);
+ else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV) {
+ yyerror_pv(Perl_form(aTHX_ "Experimental %s on scalar is now forbidden",
+ PL_op_desc[type]), 0);
}
+ else {
+ 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;
}
else {
OP * const newop
- = newUNOP(OP_READLINE, o->op_flags | OPf_SPECIAL, newGVOP(OP_GV, 0, PL_argvgv));
+ = newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, PL_argvgv));
op_free(o);
return newop;
}
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 */
/* Implicitly take a reference to a regular expression */
if (first->op_type == OP_MATCH) {
- CHANGE_TYPE(first, OP_QR);
+ OpTYPE_set(first, OP_QR);
}
if (second->op_type == OP_MATCH) {
- CHANGE_TYPE(second, OP_QR);
+ OpTYPE_set(second, OP_QR);
}
}
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 ||
| ((kkid->op_private & ~OPpLVAL_INTRO) << 8));
OP *const first = newOP(OP_NULL, 0);
OP *const nullop =
+ newCONDOP(0, first, o, other);
+ /* XXX targlex disabled for now; see ticket #124160
newCONDOP(0, first, S_maybe_targlex(aTHX_ o), other);
+ */
OP *const condop = first->op_next;
- CHANGE_TYPE(condop, OP_ONCE);
+ OpTYPE_set(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;
case OP_RV2AV:
o->op_private |= OPpLVREF_AV;
goto checkgv;
+ NOT_REACHED; /* NOTREACHED */
case OP_RV2HV:
o->op_private |= OPpLVREF_HV;
+ /* FALLTHROUGH */
case OP_RV2SV:
checkgv:
if (cUNOPx(varop)->op_first->op_type != OP_GV) goto bad;
break;
case OP_RV2CV: {
OP * const kidparent =
- cUNOPx(cUNOPx(varop)->op_first)->op_first->op_sibling;
+ OpSIBLING(cUNOPx(cUNOPx(varop)->op_first)->op_first);
OP * const kid = cUNOPx(kidparent)->op_first;
o->op_private |= OPpLVREF_CV;
if (kid->op_type == OP_GV) {
unshare_hek(hek);
SvFLAGS(sv) |= was_readonly;
}
- else if (SvPOK(sv) && !SvNIOK(sv) && !SvGMAGICAL(sv)) {
+ else if (SvPOK(sv) && !SvNIOK(sv) && !SvGMAGICAL(sv)
+ && !SvVOK(sv)) {
s = SvPV(sv, len);
if (SvREFCNT(sv) > 1) {
kid->op_sv = newSVpvn_share(
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)) {
- CHANGE_TYPE(o, OP_SSELECT);
+ kid = OpSIBLING(cLISTOPo->op_first); /* get past pushmark */
+ if (kid && OpHAS_SIBLING(kid)) {
+ OpTYPE_set(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 */
else {
OP * const padop = newOP(OP_PADCV, 0);
padop->op_targ = off;
- cUNOPx(firstkid)->op_first = padop;
-#ifdef PERL_OP_PARENT
- padop->op_sibling = firstkid;
-#endif
+ /* replace the const op with the pad op */
+ op_sibling_splice(firstkid, NULL, 1, padop);
op_free(kid);
}
}
}
- 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);
+ OpTYPE_set(kid, OP_PUSHRE);
+ /* target implies @ary=..., so wipe it */
+ kid->op_targ = 0;
scalar(kid);
if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL) {
Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP),
"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)
+ 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)
+ && !OpHAS_SIBLING(kid)) /* syntax errs can leave extra children */
{
- assert(!OP_HAS_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));
CV *compcv = PL_compcv;
while (PadnameOUTER(name)) {
assert(PARENT_PAD_INDEX(name));
- compcv = CvOUTSIDE(PL_compcv);
+ compcv = CvOUTSIDE(compcv);
name = PadlistNAMESARRAY(CvPADLIST(compcv))
[off = PARENT_PAD_INDEX(name)];
}
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;
case '&':
proto++;
arg++;
- if (o3->op_type != OP_SREFGEN
- || ( cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
- != 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);
+ if ( o3->op_type != OP_UNDEF
+ && (o3->op_type != OP_SREFGEN
+ || ( cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
+ != OP_ANONCODE
+ && cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
+ != OP_RV2CV)))
+ 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);
)
);
}
- NOT_REACHED;
+ NOT_REACHED; /* NOTREACHED */
}
else {
OP *prev, *cvop, *first, *parent;
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)
return op_convert_list(opnum,0,aop);
}
}
- NOT_REACHED;
+ NOT_REACHED; /* NOTREACHED */
return entersubop;
}
argument for it is returned in I<*ckobj_p>. The function is intended
to be called in this manner:
- entersubop = (*ckfun_p)(aTHX_ entersubop, namegv, (*ckobj_p));
+ entersubop = (*ckfun_p)(aTHX_ entersubop, namegv, (*ckobj_p));
In this call, I<entersubop> is a pointer to the C<entersub> op,
which may be replaced by the check function, and I<namegv> is a GV
}
}
+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
);
+ if (SvREADONLY(*const_class))
+ SvREADONLY_on(shared);
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
SV * const sv = cSVOPo->op_sv;
PERL_ARGS_ASSERT_CK_SVCONST;
PERL_UNUSED_CONTEXT;
-#ifdef PERL_OLD_COPY_ON_WRITE
- if (SvIsCOW(sv)) sv_force_normal(sv);
-#elif defined(PERL_NEW_COPY_ON_WRITE)
+#ifdef PERL_COPY_ON_WRITE
/* Since the read-only flag may be used to protect a string buffer, we
cannot do copy-on-write with existing read-only scalars that are not
already copy-on-write scalars. To allow $_ = "hello" to do COW with
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;
dVAR;
OP *kid = o->op_flags & OPf_KIDS ? cUNOPo->op_first : NULL;
const unsigned orig_type = o->op_type;
- const unsigned array_type = orig_type == OP_EACH ? OP_AEACH
- : orig_type == OP_KEYS ? OP_AKEYS : OP_AVALUES;
- const unsigned ref_type = orig_type == OP_EACH ? OP_REACH
- : orig_type == OP_KEYS ? OP_RKEYS : OP_RVALUES;
PERL_ARGS_ASSERT_CK_EACH;
break;
case OP_PADAV:
case OP_RV2AV:
- CHANGE_TYPE(o, array_type);
+ OpTYPE_set(o, orig_type == OP_EACH ? OP_AEACH
+ : orig_type == OP_KEYS ? OP_AKEYS
+ : OP_AVALUES);
break;
case OP_CONST:
if (kid->op_private == OPpCONST_BARE
/* we let ck_fun handle it */
break;
default:
- CHANGE_TYPE(o, ref_type);
- scalar(kid);
+ Perl_croak_nocontext(
+ "Experimental %s on scalar is now forbidden",
+ PL_op_desc[orig_type]);
+ break;
}
}
- /* if treating as a reference, defer additional checks to runtime */
- if (o->op_type == ref_type) {
- /* diag_listed_as: keys on reference is experimental */
- Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__AUTODEREF),
- "%s is experimental", PL_op_desc[ref_type]);
- return o;
- }
return ck_fun(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 */
* determines whether the op chain is convertible and calculates the
* buffer size; the second pass populates the buffer and makes any
* changes necessary to ops (such as moving consts to the pad on
- * threaded builds)
+ * threaded builds).
+ *
+ * NB: for things like Coverity, note that both passes take the same
+ * path through the logic tree (except for 'if (pass)' bits), since
+ * both passes are following the same op_next chain; and in
+ * particular, if it would return early on the second pass, it would
+ * already have returned early on the first pass.
*/
for (pass = 0; pass < 2; pass++) {
OP *o = orig_o;
break;
default:
- assert(0);
+ NOT_REACHED; /* NOTREACHED */
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;
}
if (pass) {
OP *mderef;
- OP *p;
+ OP *p, *q;
mderef = newUNOP_AUX(OP_MULTIDEREF, 0, NULL, arg_buf);
if (index_skip == -1) {
* 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,
/* excise and free the original tree, and replace with
* the multideref op */
- op_free(op_sibling_splice(top_op, NULL, -1, mderef));
+ p = op_sibling_splice(top_op, NULL, -1, mderef);
+ while (p) {
+ q = OpSIBLING(p);
+ op_free(p);
+ p = q;
+ }
op_null(top_op);
}
else {
* 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_PARENS|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);
+
+ /* excise and delete ns2 */
+ op_sibling_splice(NULL, pad1, 1, NULL);
+ op_free(ns2);
+
+ /* excise pad1 and pad2 */
+ op_sibling_splice(NULL, o, 2, NULL);
/* create new listop, with children consisting of:
* a new pushmark, pad1, pad2. */
- OP_SIBLING_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;
- newpm = cUNOPx(newop)->op_first; /* pushmark */
- /* Kill nextstate2 between padop1/padop2 */
- op_free(ns2);
+ /* insert newop between o and ns3 */
+ op_sibling_splice(NULL, o, 0, newop);
+ /*fixup op_next chain */
+ newpm = cUNOPx(newop)->op_first; /* pushmark */
o ->op_next = newpm;
newpm->op_next = pad1;
pad1 ->op_next = pad2;
pad2 ->op_next = newop; /* listop */
newop->op_next = ns3;
- OP_SIBLING_set(o, newop);
- OP_SIBLING_set(newop, ns3);
- newop->op_lastsib = 0;
-
- newop->op_flags = (newop->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
-
/* Ensure pushmark has this flag if padops do */
if (pad1->op_flags & OPf_MOD && pad2->op_flags & OPf_MOD) {
- o->op_next->op_flags |= OPf_MOD;
+ newpm->op_flags |= OPf_MOD;
}
break;
op_free(cBINOPo->op_last );
o->op_flags &=~ OPf_KIDS;
/* stub is a baseop; repeat is a binop */
- assert(sizeof(OP) <= sizeof(BINOP));
- CHANGE_TYPE(o, OP_STUB);
+ STATIC_ASSERT_STMT(sizeof(OP) <= sizeof(BINOP));
+ OpTYPE_set(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 */
* *always* formerly a pushmark */
assert(o->op_type == OP_PUSHMARK);
o->op_next = followop;
- CHANGE_TYPE(o, OP_PADRANGE);
+ OpTYPE_set(o, OP_PADRANGE);
o->op_targ = base;
/* 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;
}
o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
| OPpOUR_INTRO);
o->op_next = o->op_next->op_next;
- CHANGE_TYPE(o, OP_GVSV);
+ OpTYPE_set(o, OP_GVSV);
}
}
else if (o->op_next->op_type == OP_READLINE
&& (o->op_next->op_next->op_flags & OPf_STACKED))
{
/* Turn "$a .= <FH>" into an OP_RCATLINE. AMS 20010917 */
- CHANGE_TYPE(o, OP_RCATLINE);
+ OpTYPE_set(o, OP_RCATLINE);
o->op_flags |= OPf_STACKED;
op_null(o->op_next->op_next);
op_null(o->op_next);
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->op_flags == (OPf_WANT_LIST | OPf_KIDS)
- && enter->op_flags == (OPf_WANT_LIST | OPf_KIDS)) {
+ rv2av = OpSIBLING(ourmark);
+ if (rv2av && rv2av->op_type == OP_RV2AV && !OpHAS_SIBLING(rv2av)
+ && rv2av->op_flags == (OPf_WANT_LIST | OPf_KIDS)) {
/* We're just reversing a single array. */
rv2av->op_flags = OPf_WANT_SCALAR | OPf_KIDS | OPf_REF;
enter->op_flags |= OPf_STACKED;
sv_rvweaken(sv);
SvREADONLY_on(sv);
}
- CHANGE_TYPE(o, OP_CONST);
+ OpTYPE_set(o, OP_CONST);
o->op_flags |= OPf_SPECIAL;
cSVOPo->op_sv = sv;
}
* 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)
{
any.xop_peep = xop->xop_peep;
break;
default:
- NOT_REACHED;
+ NOT_REACHED; /* NOTREACHED */
break;
}
} else {
any.xop_peep = XOPd_xop_peep;
break;
default:
- NOT_REACHED;
+ NOT_REACHED; /* NOTREACHED */
break;
}
}
case KEY_x : case KEY_xor :
if (!opnum) return NULL; nullret = TRUE; goto findopnum;
case KEY_glob: retsetpvs("_;", OP_GLOB);
- case KEY_keys: retsetpvs("+", OP_KEYS);
- case KEY_values: retsetpvs("+", OP_VALUES);
- case KEY_each: retsetpvs("+", OP_EACH);
- case KEY_push: retsetpvs("+@", OP_PUSH);
- case KEY_unshift: retsetpvs("+@", OP_UNSHIFT);
- case KEY_pop: retsetpvs(";+", OP_POP);
- case KEY_shift: retsetpvs(";+", OP_SHIFT);
+ case KEY_keys: retsetpvs("\\[%@]", OP_KEYS);
+ case KEY_values: retsetpvs("\\[%@]", OP_VALUES);
+ case KEY_each: retsetpvs("\\[%@]", OP_EACH);
+ case KEY_push: retsetpvs("\\@@", OP_PUSH);
+ case KEY_unshift: retsetpvs("\\@@", OP_UNSHIFT);
+ case KEY_pop: retsetpvs(";\\@", OP_POP);
+ case KEY_shift: retsetpvs(";\\@", OP_SHIFT);
case KEY_pos: retsetpvs(";\\[$*]", OP_POS);
case KEY_splice:
- retsetpvs("+;$$@", OP_SPLICE);
+ retsetpvs("\\@;$$@", OP_SPLICE);
case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
retsetpvs("", 0);
case KEY_evalbytes:
}
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/