diff options
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 2 | ||||
| -rw-r--r-- | op.c | 40 | ||||
| -rw-r--r-- | op.h | 15 | ||||
| -rw-r--r-- | pod/perlguts.pod | 18 | ||||
| -rw-r--r-- | pod/perlhacktips.pod | 2 |
5 files changed, 44 insertions, 33 deletions
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 6171e9b3a5..c78dc7b50a 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -3677,7 +3677,7 @@ CODE: CvROOT(PL_compcv) = (OP *)1; o = newFOROP(0, 0, newOP(OP_PUSHMARK, 0), 0, 0); #ifdef PERL_OP_PARENT - if (cLOOPx(cUNOPo->op_first)->op_last->op_sibling + if (cLOOPx(cUNOPo->op_first)->op_last->op_sibparent != cUNOPo->op_first) { Perl_warn(aTHX_ "Op parent pointer is stale"); @@ -297,10 +297,10 @@ Perl_Slab_Alloc(pTHX_ size_t sz) 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 */ + /* lastsib == 1, op_sibparent == 0 implies a solitary unattached op */ o->op_lastsib = 1; #ifdef PERL_OP_PARENT - assert(!o->op_sibling); + assert(!o->op_sibparent); #endif return (void *)o; @@ -1216,7 +1216,7 @@ you to delete zero or more sequential nodes, replacing them with zero or 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_lastsib 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 @@ -1328,7 +1328,7 @@ Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert) if (lastop) { lastop->op_lastsib = 1; #ifdef PERL_OP_PARENT - lastop->op_sibling = parent; + lastop->op_sibparent = parent; #endif } } @@ -1352,7 +1352,7 @@ Perl_op_parent(OP *o) #ifdef PERL_OP_PARENT while (OpHAS_SIBLING(o)) o = OpSIBLING(o); - return o->op_sibling; + return o->op_sibparent; #else PERL_UNUSED_ARG(o); return NULL; @@ -1413,7 +1413,7 @@ S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other) if (kid) { kid->op_lastsib = 1; #ifdef PERL_OP_PARENT - kid->op_sibling = (OP*)logop; + kid->op_sibparent = (OP*)logop; #endif } return logop; @@ -2512,9 +2512,9 @@ S_finalize_op(pTHX_ OP* o) #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; @@ -2553,7 +2553,7 @@ S_finalize_op(pTHX_ OP* o) if (!OpHAS_SIBLING(kid)) { if (has_last) assert(kid == cLISTOPo->op_last); - assert(kid->op_sibling == o); + assert(kid->op_sibparent == o); } # else if (has_last && !OpHAS_SIBLING(kid)) @@ -4503,7 +4503,7 @@ Perl_op_append_list(pTHX_ I32 type, OP *first, OP *last) ((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; + ((LISTOP*)first)->op_last->op_sibparent = first; #endif first->op_flags |= (last->op_flags & OPf_KIDS); @@ -4710,7 +4710,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) if (listop->op_last) { listop->op_last->op_lastsib = 1; #ifdef PERL_OP_PARENT - listop->op_last->op_sibling = (OP*)listop; + listop->op_last->op_sibparent = (OP*)listop; #endif } @@ -4804,7 +4804,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first) #ifdef PERL_OP_PARENT if (!OpHAS_SIBLING(first)) /* true unless weird syntax error */ - first->op_sibling = (OP*)unop; + first->op_sibparent = (OP*)unop; #endif unop = (UNOP*) CHECKOP(type, unop); @@ -4842,7 +4842,7 @@ Perl_newUNOP_AUX(pTHX_ I32 type, I32 flags, OP *first, UNOP_AUX_item *aux) #ifdef PERL_OP_PARENT if (first && !OpHAS_SIBLING(first)) /* true unless weird syntax error */ - first->op_sibling = (OP*)unop; + first->op_sibparent = (OP*)unop; #endif unop = (UNOP_AUX*) CHECKOP(type, unop); @@ -4882,7 +4882,7 @@ S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth #ifdef PERL_OP_PARENT if (!OpHAS_SIBLING(dynamic_meth)) - dynamic_meth->op_sibling = (OP*)methop; + dynamic_meth->op_sibparent = (OP*)methop; #endif } else { @@ -4971,13 +4971,13 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) #ifdef PERL_OP_PARENT if (!OpHAS_SIBLING(last)) /* true unless weird syntax error */ - last->op_sibling = (OP*)binop; + last->op_sibparent = (OP*)binop; #endif binop->op_last = OpSIBLING(binop->op_first); #ifdef PERL_OP_PARENT if (binop->op_last) - binop->op_last->op_sibling = (OP*)binop; + binop->op_last->op_sibparent = (OP*)binop; #endif binop = (BINOP*)CHECKOP(type, binop); @@ -7516,8 +7516,8 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) 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); + loop->op_last->op_sibparent = (OP*)tmp; /*point back to new parent */ #endif S_op_destroy(aTHX_ (OP*)loop); loop = tmp; @@ -7526,7 +7526,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) { loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP)); #ifdef PERL_OP_PARENT - loop->op_last->op_sibling = (OP *)loop; + loop->op_last->op_sibparent = (OP *)loop; #endif } loop->op_targ = padoff; @@ -38,12 +38,21 @@ typedef PERL_BITFIELD16 Optype; +/* this field now either points to the next sibling or to the parent, + * depending on op_lastsib. So rename it from op_sibling to op_sibparent. + */ +#ifdef PERL_OP_PARENT +# define _OP_SIBPARENT_FIELDNAME op_sibparent +#else +# define _OP_SIBPARENT_FIELDNAME op_sibling +#endif + #ifdef BASEOP_DEFINITION #define BASEOP BASEOP_DEFINITION #else #define BASEOP \ OP* op_next; \ - OP* op_sibling; \ + OP* _OP_SIBPARENT_FIELDNAME;\ OP* (*op_ppaddr)(pTHX); \ PADOFFSET op_targ; \ PERL_BITFIELD16 op_type:9; \ @@ -973,8 +982,8 @@ Sets the sibling of o to sib #ifdef PERL_OP_PARENT # define OpHAS_SIBLING(o) (!cBOOL((o)->op_lastsib)) -# define OpSIBLING(o) (0 + (o)->op_lastsib ? NULL : (o)->op_sibling) -# define OpSIBLING_set(o, sib) ((o)->op_sibling = (sib)) +# define OpSIBLING(o) (0 + (o)->op_lastsib ? NULL : (o)->op_sibparent) +# define OpSIBLING_set(o, sib) ((o)->op_sibparent = (sib)) #else # define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling)) # define OpSIBLING(o) (0 + (o)->op_sibling) diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 5e38692c89..4266cfa4d9 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1980,7 +1980,7 @@ C<op_first> field but also an C<op_last> field. The most complex type of op is a C<LISTOP>, which has any number of children. In this case, the first child is pointed to by C<op_first> and the last child by C<op_last>. The children in between can be found by iteratively -following the C<op_sibling> pointer from the first child to the last (but +following the C<OpSIBLING> pointer from the first child to the last (but see below). There are also some other op types: a C<PMOP> holds a regular expression, @@ -1992,7 +1992,7 @@ have children in accordance with its former type. Finally, there is a C<LOGOP>, or logic op. Like a C<LISTOP>, this has one or more children, but it doesn't have an C<op_last> field: so you have to -follow C<op_first> and then the C<op_sibling> chain itself to find the +follow C<op_first> and then the C<OpSIBLING> chain itself to find the last child. Instead it has an C<op_other> field, which is comparable to the C<op_next> field described below, and represents an alternate execution path. Operators like C<and>, C<or> and C<?> are C<LOGOP>s. Note @@ -2002,12 +2002,14 @@ of the C<LOGOP>. Starting in version 5.21.2, perls built with the experimental define C<-DPERL_OP_PARENT> add an extra boolean flag for each op, C<op_lastsib>. When set, this indicates that this is the last op in an -C<op_sibling> chain. This frees up the C<op_sibling> field on the last -sibling to point back to the parent op. The macro C<OpSIBLING(o)> wraps -this special behaviour, and always returns NULL on the last sibling. -With this build the C<op_parent(o)> function can be used to find the -parent of any op. Thus for forward compatibility, you should always use -the C<OpSIBLING(o)> macro rather than accessing C<op_sibling> directly. +C<OpSIBLING> chain. This frees up the C<op_sibling> field on the last +sibling to point back to the parent op. Under this build, that field is +also renamed C<op_sibparent> to reflect its joint role. The macro +C<OpSIBLING(o)> wraps this special behaviour, and always returns NULL on +the last sibling. With this build the C<op_parent(o)> function can be +used to find the parent of any op. Thus for forward compatibility, you +should always use the C<OpSIBLING(o)> macro rather than accessing +C<op_sibling> directly. Another way to examine the tree is to use a compiler back-end module, such as L<B::Concise>. diff --git a/pod/perlhacktips.pod b/pod/perlhacktips.pod index 834c8c8766..6d7a098a60 100644 --- a/pod/perlhacktips.pod +++ b/pod/perlhacktips.pod @@ -803,7 +803,7 @@ Prints the C definition of the argument given. (gdb) ptype PL_op type = struct op { OP *op_next; - OP *op_sibling; + OP *op_sibparent; OP *(*op_ppaddr)(void); PADOFFSET op_targ; unsigned int op_type : 9; |