This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add extra optimization phase
authorDavid Mitchell <davem@iabyn.com>
Wed, 20 Sep 2017 15:02:55 +0000 (16:02 +0100)
committerDavid Mitchell <davem@iabyn.com>
Tue, 31 Oct 2017 15:31:26 +0000 (15:31 +0000)
Add the function optimize_optree(). Optree optimization/finalization is
now done in three main phases:

    1) optimize_optree(optree);
    2) CALL_PEEP(*startp);
    3) finalize_optree(optree);

(1) and (3) are done in top-down order, while (2) is done in execution
order.

Note that this function doesn't actually optimize anything yet; this
commit is just adding the necessary infrastructure.

Adding this extra top-down phase allows certain combinations of ops
to be recognised in ways that the peephole optimizer would find hard.

For example in

    $a = expression1 . expression2 . expression3 . expression4

the top-down tree looks like

    sassign
        concat
            concat
                concat
                    expression1
                        ...
                    expression2
                        ...
                expression3
                    ...
            expression4
                ...
        padsv[$a]

so its easy to see the nested concats, while execution order looks like

    ... lots of ops for expression1 ...
    ... lots of ops for expression2 ...
    concat
    ... lots of ops for expression3 ...
    concat
    ... lots of ops for expression4 ...
    concat
    padsv[$a]
    sassign

where its not at all obvious that there is a chain of nested concats.

Similarly, trying to do this in finalize_optree() is hard because the
peephole optimizer will have messed things up. Also it will be too
late to remove nulled-out ops from the execution path.

embed.fnc
embed.h
op.c
proto.h

index 16b678c..fdc3eca 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1046,7 +1046,9 @@ Apn       |void   |mini_mktime    |NN struct tm *ptm
 AMmd   |OP*    |op_lvalue      |NULLOK OP* o|I32 type
 poX    |OP*    |op_lvalue_flags|NULLOK OP* o|I32 type|U32 flags
 p      |void   |finalize_optree                |NN OP* o
+p      |void   |optimize_optree|NN OP* o
 #if defined(PERL_IN_OP_C)
+s      |void   |optimize_op    |NN OP* o
 s      |void   |finalize_op    |NN OP* o
 s      |void   |move_proto_attr|NN OP **proto|NN OP **attrs \
                                |NN const GV *name|bool curstash
diff --git a/embed.h b/embed.h
index 34dd4fa..39f579a 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define oopsAV(a)              Perl_oopsAV(aTHX_ a)
 #define oopsHV(a)              Perl_oopsHV(aTHX_ a)
 #define op_unscope(a)          Perl_op_unscope(aTHX_ a)
+#define optimize_optree(a)     Perl_optimize_optree(aTHX_ a)
 #define package(a)             Perl_package(aTHX_ a)
 #define package_version(a)     Perl_package_version(aTHX_ a)
 #define pad_add_weakref(a)     Perl_pad_add_weakref(aTHX_ a)
 #define no_fh_allowed(a)       S_no_fh_allowed(aTHX_ a)
 #define op_integerize(a)       S_op_integerize(aTHX_ a)
 #define op_std_init(a)         S_op_std_init(aTHX_ a)
+#define optimize_op(a)         S_optimize_op(aTHX_ a)
 #define pmtrans(a,b,c)         S_pmtrans(aTHX_ a,b,c)
 #define process_special_blocks(a,b,c,d)        S_process_special_blocks(aTHX_ a,b,c,d)
 #define ref_array_or_hash(a)   S_ref_array_or_hash(aTHX_ a)
diff --git a/op.c b/op.c
index c88a8f8..416ac2d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2492,6 +2492,7 @@ S_process_optree(pTHX_ CV *cv, OP *optree, OP* start)
     *startp = start;
     optree->op_private |= OPpREFCOUNTED;
     OpREFCNT_set(optree, 1);
+    optimize_optree(optree);
     CALL_PEEP(*startp);
     finalize_optree(optree);
     S_prune_chain_head(startp);
@@ -2505,6 +2506,67 @@ S_process_optree(pTHX_ CV *cv, OP *optree, OP* start)
 
 
 /*
+=for apidoc optimize_optree
+
+This function applies some optimisations to the optree in top-down order.
+It is called before the peephole optimizer, which processes ops in
+execution order. Note that finalize_optree() also does a top-down scan,
+but is called *after* the peephole optimizer.
+
+=cut
+*/
+
+void
+Perl_optimize_optree(pTHX_ OP* o)
+{
+    PERL_ARGS_ASSERT_OPTIMIZE_OPTREE;
+
+    ENTER;
+    SAVEVPTR(PL_curcop);
+
+    optimize_op(o);
+
+    LEAVE;
+}
+
+
+/* helper for optimize_optree() which optimises on op then recurses
+ * to optimise any children.
+ */
+
+STATIC void
+S_optimize_op(pTHX_ OP* o)
+{
+    OP *kid;
+
+    PERL_ARGS_ASSERT_OPTIMIZE_OP;
+    assert(o->op_type != OP_FREED);
+
+    switch (o->op_type) {
+    case OP_NEXTSTATE:
+    case OP_DBSTATE:
+       PL_curcop = ((COP*)o);          /* for warnings */
+       break;
+
+
+    case OP_SUBST:
+       if (cPMOPo->op_pmreplrootu.op_pmreplroot)
+           optimize_op(cPMOPo->op_pmreplrootu.op_pmreplroot);
+       break;
+
+    default:
+       break;
+    }
+
+    if (!(o->op_flags & OPf_KIDS))
+        return;
+
+    for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
+        optimize_op(kid);
+}
+
+
+/*
 =for apidoc finalize_optree
 
 This function finalizes the optree.  Should be called directly after
@@ -5845,6 +5907,11 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
                scope->op_next = NULL; /* stop on last op */
                op_null(scope);
            }
+
+           if (is_compiletime)
+               /* runtime finalizes as part of finalizing whole tree */
+                optimize_optree(o);
+
            /* have to peep the DOs individually as we've removed it from
             * the op_next chain */
            CALL_PEEP(o);
diff --git a/proto.h b/proto.h
index 4459d10..9efca65 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2435,6 +2435,9 @@ PERL_CALLCONV void        Perl_op_refcnt_unlock(pTHX);
 PERL_CALLCONV OP*      Perl_op_scope(pTHX_ OP* o);
 PERL_CALLCONV OP*      Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert);
 PERL_CALLCONV OP*      Perl_op_unscope(pTHX_ OP* o);
+PERL_CALLCONV void     Perl_optimize_optree(pTHX_ OP* o);
+#define PERL_ARGS_ASSERT_OPTIMIZE_OPTREE       \
+       assert(o)
 PERL_CALLCONV void     Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist, SV ***next_in_list, U32 flags);
 #define PERL_ARGS_ASSERT_PACK_CAT      \
        assert(cat); assert(pat); assert(patend); assert(beglist); assert(endlist); assert(next_in_list)
@@ -4750,6 +4753,9 @@ PERL_STATIC_INLINE OP*    S_op_std_init(pTHX_ OP *o);
 #define PERL_ARGS_ASSERT_OP_STD_INIT   \
        assert(o)
 #endif
+STATIC void    S_optimize_op(pTHX_ OP* o);
+#define PERL_ARGS_ASSERT_OPTIMIZE_OP   \
+       assert(o)
 STATIC OP*     S_pmtrans(pTHX_ OP* o, OP* expr, OP* repl);
 #define PERL_ARGS_ASSERT_PMTRANS       \
        assert(o); assert(expr); assert(repl)