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
*/
while (--del_count && OpHAS_SIBLING(last_del))
last_del = OpSIBLING(last_del);
rest = OpSIBLING(last_del);
- OpSIBLING_set(last_del, NULL);
- last_del->op_moresib = 0;
+ OpLASTSIB_set(last_del, NULL);
}
else
rest = first;
last_ins = insert;
while (OpHAS_SIBLING(last_ins))
last_ins = OpSIBLING(last_ins);
- OpSIBLING_set(last_ins, rest);
- last_ins->op_moresib = rest ? 1 : 0;
+ OpMAYBESIB_set(last_ins, rest, NULL);
}
else
insert = rest;
if (start) {
- OpSIBLING_set(start, insert);
- start->op_moresib = insert ? 1 : 0;
+ OpMAYBESIB_set(start, insert, NULL);
}
else {
if (!parent)
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_NULL)
- type = parent->op_targ;
- type = PL_opargs[type] & OA_CLASS_MASK;
+ 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_moresib = 0;
-#ifdef PERL_OP_PARENT
- lastop->op_sibparent = parent;
-#endif
- }
+ if (lastop)
+ OpLASTSIB_set(lastop, parent);
}
return last_del ? first : NULL;
}
+#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 (OpHAS_SIBLING(o))
o = OpSIBLING(o);
return o->op_sibparent;
-#else
- PERL_UNUSED_ARG(o);
- return NULL;
-#endif
}
+#endif
+
/* replace the sibling following start with a new UNOP, which becomes
* the parent of the original sibling; e.g.
logop->op_flags = OPf_KIDS;
while (kid && OpHAS_SIBLING(kid))
kid = OpSIBLING(kid);
- if (kid) {
- kid->op_moresib = 0;
-#ifdef PERL_OP_PARENT
- kid->op_sibparent = (OP*)logop;
-#endif
- }
+ if (kid)
+ OpLASTSIB_set(kid, (OP*)logop);
return logop;
}
if (last->op_type != (unsigned)type)
return op_append_elem(type, first, last);
- ((LISTOP*)first)->op_last->op_moresib = 1;
- OpSIBLING_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_moresib = 0;
-#ifdef PERL_OP_PARENT
- ((LISTOP*)first)->op_last->op_sibparent = 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) {
/* manually detach any siblings then add them back later */
rest = OpSIBLING(o);
- OpSIBLING_set(o, NULL);
- o->op_moresib = 0;
+ OpLASTSIB_set(o, NULL);
}
o = newLISTOP(OP_LIST, 0, o, NULL);
if (rest)
else if (!first && last)
first = last;
else if (first)
- OpSIBLING_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_moresib = 1;
- OpSIBLING_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_moresib = 1;
- if (listop->op_last) {
- listop->op_last->op_moresib = 0;
-#ifdef PERL_OP_PARENT
- listop->op_last->op_sibparent = (OP*)listop;
-#endif
- }
+ if (listop->op_last)
+ OpLASTSIB_set(listop->op_last, (OP*)listop);
return CHECKOP(type, listop);
}
unop->op_flags = (U8)(flags | OPf_KIDS);
unop->op_private = (U8)(1 | (flags >> 8));
-#ifdef PERL_OP_PARENT
if (!OpHAS_SIBLING(first)) /* true unless weird syntax error */
- first->op_sibparent = (OP*)unop;
-#endif
+ OpLASTSIB_set(first, (OP*)unop);
unop = (UNOP*) CHECKOP(type, unop);
if (unop->op_next)
unop->op_private = (U8)((first ? 1 : 0) | (flags >> 8));
unop->op_aux = aux;
-#ifdef PERL_OP_PARENT
if (first && !OpHAS_SIBLING(first)) /* true unless weird syntax error */
- first->op_sibparent = (OP*)unop;
-#endif
+ OpLASTSIB_set(first, (OP*)unop);
unop = (UNOP_AUX*) CHECKOP(type, unop);
methop->op_u.op_first = dynamic_meth;
methop->op_private = (U8)(1 | (flags >> 8));
-#ifdef PERL_OP_PARENT
if (!OpHAS_SIBLING(dynamic_meth))
- dynamic_meth->op_sibparent = (OP*)methop;
-#endif
+ OpLASTSIB_set(dynamic_meth, (OP*)methop);
}
else {
assert(const_meth);
}
else {
binop->op_private = (U8)(2 | (flags >> 8));
- OpSIBLING_set(first, last);
- first->op_moresib = 1;
+ OpMORESIB_set(first, last);
}
-#ifdef PERL_OP_PARENT
if (!OpHAS_SIBLING(last)) /* true unless weird syntax error */
- last->op_sibparent = (OP*)binop;
-#endif
+ OpLASTSIB_set(last, (OP*)binop);
binop->op_last = OpSIBLING(binop->op_first);
-#ifdef PERL_OP_PARENT
if (binop->op_last)
- binop->op_last->op_sibparent = (OP*)binop;
-#endif
+ OpLASTSIB_set(binop->op_last, (OP*)binop);
binop = (BINOP*)CHECKOP(type, binop);
if (binop->op_next || binop->op_type != (OPCODE)type)
Copy(loop,tmp,1,LISTOP);
#ifdef PERL_OP_PARENT
assert(loop->op_last->op_sibparent == (OP*)loop);
- loop->op_last->op_sibparent = (OP*)tmp; /*point back to new parent */
+ 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_sibparent = (OP *)loop;
+ OpLASTSIB_set(loop->op_last, (OP*)loop);
#endif
}
loop->op_targ = padoff;
{
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(!OpHAS_SIBLING(kid));
op_sibling_splice(o, cUNOPo->op_first, -1, NULL);
op_free(o);
return kid;
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
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. */
- OpSIBLING_set(pad2, NULL);
newop = newLISTOP(OP_LIST, 0, pad1, pad2);
newop->op_flags |= OPf_PARENS;
newop->op_flags = (newop->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
- 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;
- OpSIBLING_set(o, newop);
- OpSIBLING_set(newop, ns3);
- newop->op_moresib = 1;
-
- 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;
https://perl5.git.perl.org / perl5.git / blobdiff