develooper Front page | perl.perl5.porters | Postings from February 2017

more process_optree

Thread Next
From:
Jim Cromie
Date:
February 12, 2017 21:41
Subject:
more process_optree
Message ID:
CAJfuBxxmZSK8mW_evYOAurU3o00RMT_AM4fJuPgtS46oFBhUWw@mail.gmail.com
Subject: [PATCH 1/2] call S_process_optree from S_gen_constant_list

S_gen_constant_list was recently changed by commit b369834, which
wrapped a CALL_PEEP with an OP_NULL -> OP_CUSTOM temporary swap.

At near the same time, commit 2790f0ae4da added S_process_optree() to
package up almost all the uses of S_finalize_optree, CALL_PEEP,
S_prune_chain_head, and various other tricky details.  It noted in
logmsg that a few other candidate cleanups were skipped for
simplicity.

This patch attempts to address one of those cleanups, calling
S_process_optree from S_gen_constant_list.  To do this, we have to
move the new wrapper added by 1st commit into S_process_optree, and
add a boolean parameter to do that wrapping for the new user, but not
for any other caller.

no-bisect: new call to finalize_optree is breaking an assertion in
Perl_op_free.

miniperl: op.c:792:
Perl_op_free: Assertion `!(o->op_private & ~PL_op_private_valid[type])' failed.

Since this is a totally new callsite, the existing asserts may be
correct, or too strict; TBD.
---
 op.c | 32 ++++++++++++++++++--------------
 1 file changed, 18 insertions(+), 14 deletions(-)

diff --git a/op.c b/op.c
index 54993b5..75ec0d0 100644
--- a/op.c
+++ b/op.c
@@ -2456,7 +2456,7 @@ S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_
op)
  */

 static void
-S_process_optree(pTHX_ CV *cv, OP *optree, OP* start)
+S_process_optree(pTHX_ CV *cv, OP *optree, OP* start, bool wrap)
 {
     OP **startp;

@@ -2472,7 +2472,16 @@ S_process_optree(pTHX_ CV *cv, OP *optree, OP* start)
     *startp = start;
     optree->op_private |= OPpREFCOUNTED;
     OpREFCNT_set(optree, 1);
-    CALL_PEEP(*startp);
+    if (!wrap)
+        CALL_PEEP(*startp);
+    else {
+        bool op_was_null = optree->op_type == OP_NULL;
+        if (op_was_null)
+            optree->op_type = OP_CUSTOM;
+        CALL_PEEP(*startp);
+        if (op_was_null)
+            optree->op_type = OP_NULL;
+    }
     finalize_optree(optree);
     S_prune_chain_head(startp);

@@ -4259,7 +4268,7 @@ Perl_newPROG(pTHX_ OP *o)
  i = PL_savestack_ix;
  SAVEFREEOP(o);
  ENTER;
-        S_process_optree(aTHX_ NULL, PL_eval_root, start);
+        S_process_optree(aTHX_ NULL, PL_eval_root, start, 0);
  LEAVE;
  PL_savestack_ix = i;
     }
@@ -4300,7 +4309,7 @@ Perl_newPROG(pTHX_ OP *o)
  PL_curcop = &PL_compiling;
         start = LINKLIST(PL_main_root);
  PL_main_root->op_next = 0;
-        S_process_optree(aTHX_ NULL, PL_main_root, start);
+        S_process_optree(aTHX_ NULL, PL_main_root, start, 0);
  cv_forget_slab(PL_compcv);
  PL_compcv = 0;

@@ -4532,6 +4541,7 @@ S_fold_constants(pTHX_ OP *const o)
     curop = LINKLIST(o);
     old_next = o->op_next;
     o->op_next = 0;
+    S_process_optree(aTHX_ NULL, o, curop, 0);
     PL_op = curop;

     old_cxix = cxstack_ix;
@@ -4641,13 +4651,7 @@ S_gen_constant_list(pTHX_ OP *o)
     curop = LINKLIST(o);
     old_next = o->op_next;
     o->op_next = 0;
-    op_was_null = o->op_type == OP_NULL;
-    if (op_was_null)
- o->op_type = OP_CUSTOM;
-    CALL_PEEP(curop);
-    if (op_was_null)
- o->op_type = OP_NULL;
-    S_prune_chain_head(&curop);
+    S_process_optree(aTHX_ NULL, o, curop, 1);
     PL_op = curop;

     old_cxix = cxstack_ix;
@@ -8446,7 +8450,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs
, OP *block)
 #ifdef PERL_DEBUG_READONLY_OPS
         slab = (OPSLAB *)CvSTART(cv);
 #endif
-        S_process_optree(aTHX_ cv, block, start);
+        S_process_optree(aTHX_ cv, block, start, 0);
     }

   attrs:
@@ -8930,7 +8934,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *a
ttrs,
 #ifdef PERL_DEBUG_READONLY_OPS
         slab = (OPSLAB *)CvSTART(cv);
 #endif
-        S_process_optree(aTHX_ cv, block, start);
+        S_process_optree(aTHX_ cv, block, start, 0);
     }

   attrs:
@@ -9377,7 +9381,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     CvROOT(cv) = root;
     start = LINKLIST(root);
     root->op_next = 0;
-    S_process_optree(aTHX_ cv, root, start);
+    S_process_optree(aTHX_ cv, root, start, 0);
     cv_forget_slab(cv);

   finish:
-- 
2.9.3

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About