(perl #108276) eliminate recursion from finalize_op()

whitespace in next commit

diff --git a/embed.fnc b/embed.fnc
index bdb29f7..d311ca7 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -563,6 +563,7 @@ i   |OP*    |newMETHOP_internal     |I32 type|I32 flags|NULLOK OP* dynamic_meth \
                                        |NULLOK SV* const_meth
 : FIXME
 s      |OP*    |fold_constants |NN OP * const o
+s      |OP*    |traverse_op_tree|NN OP* top|NN OP* o
 #endif
 Afpd   |char*  |form           |NN const char* pat|...
 Ap     |char*  |vform          |NN const char* pat|NULLOK va_list* args

diff --git a/embed.h b/embed.h
index a945838..f3b95ea 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1886,6 +1886,7 @@
 #define simplify_sort(a)       S_simplify_sort(aTHX_ a)
 #define too_few_arguments_pv(a,b,c)    S_too_few_arguments_pv(aTHX_ a,b,c)
 #define too_many_arguments_pv(a,b,c)   S_too_many_arguments_pv(aTHX_ a,b,c)
+#define traverse_op_tree(a,b)  S_traverse_op_tree(aTHX_ a,b)
 #    if defined(USE_ITHREADS)
 #define op_relocate_sv(a,b)    S_op_relocate_sv(aTHX_ a,b)
 #    endif

diff --git a/op.c b/op.c
index d966848..41067e7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3537,12 +3537,52 @@ S_op_relocate_sv(pTHX_ SV** svp, PADOFFSET* targp)
 }
 #endif
 
+/*
+=for apidoc s|OP*|traverse_op_tree|OP* top|OP* o
+
+Return the next op in a depth-first traversal of the op tree,
+returning NULL when the traversal is complete.
+
+The initial call must supply the root of the tree as both top and o.
+
+For now it's static, but it may be exposed to the API in the future.
+
+=cut
+*/
+
+STATIC OP*
+S_traverse_op_tree(OP *top, OP *o) {
+    OP *sib;
+
+    PERL_ARGS_ASSERT_TRAVERSE_OP_TREE;
+
+    if ((o->op_flags & OPf_KIDS) && cUNOPo->op_first) {
+        return cUNOPo->op_first;
+    }
+    else if ((sib = OpSIBLING(o))) {
+        return sib;
+    }
+    else {
+        OP *parent = o->op_sibparent;
+        assert(!(o->op_moresib));
+        while (parent && parent != top) {
+            OP *sib = OpSIBLING(parent);
+            if (sib)
+                return sib;
+            parent = parent->op_sibparent;
+        }
+
+        return NULL;
+    }
+}
 
 STATIC void
 S_finalize_op(pTHX_ OP* o)
 {
+    OP * const top = o;
     PERL_ARGS_ASSERT_FINALIZE_OP;
 
+    do {
     assert(o->op_type != OP_FREED);
 
     switch (o->op_type) {
@@ -3659,10 +3699,10 @@ S_finalize_op(pTHX_ OP* o)
        break;
     }
 
+#ifdef DEBUGGING
     if (o->op_flags & OPf_KIDS) {
        OP *kid;
 
-#ifdef DEBUGGING
         /* check that op_last points to the last sibling, and that
          * the last op_sibling/op_sibparent field points back to the
          * parent, and that the only ops with KIDS are those which are
@@ -3705,11 +3745,9 @@ S_finalize_op(pTHX_ OP* o)
                 assert(kid->op_sibparent == o);
             }
         }
-#endif
-
-       for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
-           finalize_op(kid);
     }
+#endif
+    } while (( o = traverse_op_tree(top, o)) != NULL);
 }
 
 /*

diff --git a/proto.h b/proto.h
index 36a61db..daf3387 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5115,6 +5115,9 @@ STATIC OP*        S_too_few_arguments_pv(pTHX_ OP *o, const char* name, U32 flags)
 STATIC OP*     S_too_many_arguments_pv(pTHX_ OP *o, const char* name, U32 flags);
 #define PERL_ARGS_ASSERT_TOO_MANY_ARGUMENTS_PV \
        assert(o); assert(name)
+STATIC OP*     S_traverse_op_tree(pTHX_ OP* top, OP* o);
+#define PERL_ARGS_ASSERT_TRAVERSE_OP_TREE      \
+       assert(top); assert(o)
 #  if defined(USE_ITHREADS)
 #ifndef PERL_NO_INLINE_FUNCTIONS
 PERL_STATIC_INLINE void        S_op_relocate_sv(pTHX_ SV** svp, PADOFFSET* targp);