make recursive part of peephole optimiser hookable

New variable PL_rpeepp makes it possible for extensions to hook
the per-op-chain part of the peephole optimiser (which recurses into
side chains).  The existing variable PL_peepp still allows hooking the
per-sub part of the peephole optimiser, maintaining perfect backward
compatibility.

diff --git a/embed.fnc b/embed.fnc
index 63bbcd8..47ca611 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -887,8 +887,9 @@ sd  |void   |pad_reset
 #endif
 : Used in op.c
 pd     |void   |pad_swipe      |PADOFFSET po|bool refadjust
-: FIXME
+: peephole optimiser
 p      |void   |peep           |NULLOK OP* o
+p      |void   |rpeep          |NULLOK OP* o
 : Defined in doio.c, used only in pp_hot.c
 dopM   |PerlIO*|start_glob     |NN SV *tmpglob|NN IO *io
 #if defined(USE_REENTRANT_API)

diff --git a/embed.h b/embed.h
index 9cde4db..ae8478b 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -706,6 +706,7 @@
 #ifdef PERL_CORE
 #define pad_swipe              Perl_pad_swipe
 #define peep                   Perl_peep
+#define rpeep                  Perl_rpeep
 #endif
 #if defined(USE_REENTRANT_API)
 #define reentrant_size         Perl_reentrant_size
@@ -3152,6 +3153,7 @@
 #ifdef PERL_CORE
 #define pad_swipe(a,b)         Perl_pad_swipe(aTHX_ a,b)
 #define peep(a)                        Perl_peep(aTHX_ a)
+#define rpeep(a)               Perl_rpeep(aTHX_ a)
 #endif
 #if defined(USE_REENTRANT_API)
 #define reentrant_size()       Perl_reentrant_size(aTHX)

diff --git a/embedvar.h b/embedvar.h
index 587bc94..e57eed9 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -258,6 +258,7 @@
 #define PL_replgv              (vTHX->Ireplgv)
 #define PL_restartjmpenv       (vTHX->Irestartjmpenv)
 #define PL_restartop           (vTHX->Irestartop)
+#define PL_rpeepp              (vTHX->Irpeepp)
 #define PL_rs                  (vTHX->Irs)
 #define PL_runops              (vTHX->Irunops)
 #define PL_savebegin           (vTHX->Isavebegin)
@@ -589,6 +590,7 @@
 #define PL_Ireplgv             PL_replgv
 #define PL_Irestartjmpenv      PL_restartjmpenv
 #define PL_Irestartop          PL_restartop
+#define PL_Irpeepp             PL_rpeepp
 #define PL_Irs                 PL_rs
 #define PL_Irunops             PL_runops
 #define PL_Isavebegin          PL_savebegin

diff --git a/intrpvar.h b/intrpvar.h
index 21fb933..503d9d6 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -172,7 +172,9 @@ PERLVARI(Irehash_seed_set, bool, FALSE)     /* 582 hash initialized? */
 PERLVARA(Icolors,6,    char *)         /* from regcomp.c */
 
 PERLVARI(Ipeepp,       peep_t, MEMBER_TO_FPTR(Perl_peep))
-                                       /* Pointer to peephole optimizer */
+                               /* Pointer to per-sub peephole optimizer */
+PERLVARI(Irpeepp,      peep_t, MEMBER_TO_FPTR(Perl_rpeep))
+                               /* Pointer to recursive peephole optimizer */
 
 /*
 =for apidoc Amn|Perl_ophook_t|PL_opfreehook

diff --git a/op.c b/op.c
index 0979fc1..3699674 100644 (file)
--- a/op.c
+++ b/op.c
@@ -104,6 +104,7 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
 #include "keywords.h"
 
 #define CALL_PEEP(o) PL_peepp(aTHX_ o)
+#define CALL_RPEEP(o) PL_rpeepp(aTHX_ o)
 #define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o)
 
 #if defined(PL_OP_SLAB_ALLOC)
@@ -2668,7 +2669,7 @@ S_gen_constant_list(pTHX_ register OP *o)
     o->op_ppaddr = PL_ppaddr[OP_RV2AV];
     o->op_flags &= ~OPf_REF;   /* treat \(1..2) like an ordinary list */
     o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
-    o->op_opt = 0;             /* needs to be revisited in peep() */
+    o->op_opt = 0;             /* needs to be revisited in rpeep() */
     curop = ((UNOP*)o)->op_first;
     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(*PL_stack_sp--));
 #ifdef PERL_MAD
@@ -8843,7 +8844,7 @@ S_is_inplace_av(pTHX_ OP *o, OP *oright) {
  * peep() is called */
 
 void
-Perl_peep(pTHX_ register OP *o)
+Perl_rpeep(pTHX_ register OP *o)
 {
     dVAR;
     register OP* oldop = NULL;
@@ -8936,7 +8937,7 @@ Perl_peep(pTHX_ register OP *o)
                PL_curcop = ((COP*)o);
            }
            /* XXX: We avoid setting op_seq here to prevent later calls
-              to peep() from mistakenly concluding that optimisation
+              to rpeep() from mistakenly concluding that optimisation
               has already occurred. This doesn't fix the real problem,
               though (See 20010220.007). AMS 20010719 */
            /* op_seq functionality is now replaced by op_opt */
@@ -9042,7 +9043,7 @@ Perl_peep(pTHX_ register OP *o)
             sop = fop->op_sibling;
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
-           peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
+           CALL_RPEEP(cLOGOP->op_other);
           
           stitch_keys:     
            o->op_opt = 1;
@@ -9093,20 +9094,20 @@ Perl_peep(pTHX_ register OP *o)
        case OP_ONCE:
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
-           peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
+           CALL_RPEEP(cLOGOP->op_other);
            break;
 
        case OP_ENTERLOOP:
        case OP_ENTERITER:
            while (cLOOP->op_redoop->op_type == OP_NULL)
                cLOOP->op_redoop = cLOOP->op_redoop->op_next;
-           peep(cLOOP->op_redoop);
+           CALL_RPEEP(cLOOP->op_redoop);
            while (cLOOP->op_nextop->op_type == OP_NULL)
                cLOOP->op_nextop = cLOOP->op_nextop->op_next;
-           peep(cLOOP->op_nextop);
+           CALL_RPEEP(cLOOP->op_nextop);
            while (cLOOP->op_lastop->op_type == OP_NULL)
                cLOOP->op_lastop = cLOOP->op_lastop->op_next;
-           peep(cLOOP->op_lastop);
+           CALL_RPEEP(cLOOP->op_lastop);
            break;
 
        case OP_SUBST:
@@ -9115,7 +9116,7 @@ Perl_peep(pTHX_ register OP *o)
                   cPMOP->op_pmstashstartu.op_pmreplstart->op_type == OP_NULL)
                cPMOP->op_pmstashstartu.op_pmreplstart
                    = cPMOP->op_pmstashstartu.op_pmreplstart->op_next;
-           peep(cPMOP->op_pmstashstartu.op_pmreplstart);
+           CALL_RPEEP(cPMOP->op_pmstashstartu.op_pmreplstart);
            break;
 
        case OP_EXEC:
@@ -9491,6 +9492,12 @@ Perl_peep(pTHX_ register OP *o)
     LEAVE;
 }
 
+void
+Perl_peep(pTHX_ register OP *o)
+{
+    CALL_RPEEP(o);
+}
+
 const char*
 Perl_custom_op_name(pTHX_ const OP* o)
 {

diff --git a/perlapi.h b/perlapi.h
index 869d512..cb0aa05 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -552,6 +552,8 @@ END_EXTERN_C
 #define PL_restartjmpenv       (*Perl_Irestartjmpenv_ptr(aTHX))
 #undef  PL_restartop
 #define PL_restartop           (*Perl_Irestartop_ptr(aTHX))
+#undef  PL_rpeepp
+#define PL_rpeepp              (*Perl_Irpeepp_ptr(aTHX))
 #undef  PL_rs
 #define PL_rs                  (*Perl_Irs_ptr(aTHX))
 #undef  PL_runops

diff --git a/proto.h b/proto.h
index 034f673..2c5df53 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2572,6 +2572,7 @@ STATIC void       S_pad_reset(pTHX);
 #endif
 PERL_CALLCONV void     Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust);
 PERL_CALLCONV void     Perl_peep(pTHX_ OP* o);
+PERL_CALLCONV void     Perl_rpeep(pTHX_ OP* o);
 PERL_CALLCONV PerlIO*  Perl_start_glob(pTHX_ SV *tmpglob, IO *io)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);

diff --git a/sv.c b/sv.c
index 56bf8b1..3a0cf89 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12740,6 +12740,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* Pluggable optimizer */
     PL_peepp           = proto_perl->Ipeepp;
+    PL_rpeepp          = proto_perl->Irpeepp;
     /* op_free() hook */
     PL_opfreehook      = proto_perl->Iopfreehook;