Pluggable optimizer

Message-ID: <20010801135702.I10442@netthink.co.uk>

p4raw-id: //depot/perl@11541

diff --git a/embedvar.h b/embedvar.h
index 34d781f..f6d6aac 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -73,6 +73,7 @@
 #define PL_ofs_sv              (vTHX->Tofs_sv)
 #define PL_op                  (vTHX->Top)
 #define PL_opsave              (vTHX->Topsave)
+#define PL_peepp               (vTHX->Tpeepp)
 #define PL_protect             (vTHX->Tprotect)
 #define PL_reg_call_cc         (vTHX->Treg_call_cc)
 #define PL_reg_curpm           (vTHX->Treg_curpm)
@@ -788,6 +789,7 @@
 #define PL_ofs_sv              (aTHXo->interp.Tofs_sv)
 #define PL_op                  (aTHXo->interp.Top)
 #define PL_opsave              (aTHXo->interp.Topsave)
+#define PL_peepp               (aTHXo->interp.Tpeepp)
 #define PL_protect             (aTHXo->interp.Tprotect)
 #define PL_reg_call_cc         (aTHXo->interp.Treg_call_cc)
 #define PL_reg_curpm           (aTHXo->interp.Treg_curpm)
@@ -1492,6 +1494,7 @@
 #define PL_ofs_sv              (aTHX->Tofs_sv)
 #define PL_op                  (aTHX->Top)
 #define PL_opsave              (aTHX->Topsave)
+#define PL_peepp               (aTHX->Tpeepp)
 #define PL_protect             (aTHX->Tprotect)
 #define PL_reg_call_cc         (aTHX->Treg_call_cc)
 #define PL_reg_curpm           (aTHX->Treg_curpm)
@@ -1629,6 +1632,7 @@
 #define PL_Tofs_sv             PL_ofs_sv
 #define PL_Top                 PL_op
 #define PL_Topsave             PL_opsave
+#define PL_Tpeepp              PL_peepp
 #define PL_Tprotect            PL_protect
 #define PL_Treg_call_cc                PL_reg_call_cc
 #define PL_Treg_curpm          PL_reg_curpm

diff --git a/op.c b/op.c
index 3d5d92b..895c967 100644 (file)
--- a/op.c
+++ b/op.c
@@ -20,6 +20,8 @@
 #include "perl.h"
 #include "keywords.h"
 
+#define CALL_PEEP(o) CALL_FPTR(PL_peepp)(o)
+
 /* #define PL_OP_SLAB_ALLOC */
 
 #ifdef PL_OP_SLAB_ALLOC
@@ -2174,7 +2176,7 @@ Perl_newPROG(pTHX_ OP *o)
        PL_eval_root->op_private |= OPpREFCOUNTED;
        OpREFCNT_set(PL_eval_root, 1);
        PL_eval_root->op_next = 0;
-       peep(PL_eval_start);
+       CALL_PEEP(PL_eval_start);
     }
     else {
        if (!o)
@@ -2185,7 +2187,7 @@ Perl_newPROG(pTHX_ OP *o)
        PL_main_root->op_private |= OPpREFCOUNTED;
        OpREFCNT_set(PL_main_root, 1);
        PL_main_root->op_next = 0;
-       peep(PL_main_start);
+       CALL_PEEP(PL_main_start);
        PL_compcv = 0;
 
        /* Register with debugger */
@@ -2369,7 +2371,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
 
     PL_op = curop = LINKLIST(o);
     o->op_next = 0;
-    peep(curop);
+    CALL_PEEP(curop);
     pp_pushmark();
     CALLRUNOPS(aTHX);
     PL_op = curop;
@@ -4829,7 +4831,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     OpREFCNT_set(CvROOT(cv), 1);
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
-    peep(CvSTART(cv));
+    CALL_PEEP(CvSTART(cv));
 
     /* now that optimizer has done its work, adjust pad values */
     if (CvCLONE(cv)) {
@@ -5170,7 +5172,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     OpREFCNT_set(CvROOT(cv), 1);
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
-    peep(CvSTART(cv));
+    CALL_PEEP(CvSTART(cv));
     op_free(o);
     PL_copline = NOLINE;
     LEAVE_SCOPE(floor);
@@ -6343,7 +6345,7 @@ Perl_ck_sort(pTHX_ OP *o)
                    kid->op_next = 0;           /* just disconnect the leave */
                k = kLISTOP->op_first;
            }
-           peep(k);
+           CALL_PEEP(k);
 
            kid = firstkid;
            if (o->op_type == OP_SORT) {
@@ -6881,7 +6883,7 @@ Perl_peep(pTHX_ register OP *o)
            o->op_seq = PL_op_seqmax++;
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
-           peep(cLOGOP->op_other);
+           peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
            break;
 
        case OP_ENTERLOOP:

diff --git a/perl.c b/perl.c
index 91efa0f..d6d261e 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3782,6 +3782,7 @@ S_init_main_thread(pTHX)
     (void) find_threadsv("@"); /* Ensure $@ is initialised early */
 
     PL_maxscream = -1;
+    PL_peepp = MEMBER_TO_FPTR(Perl_peep);
     PL_regcompp = MEMBER_TO_FPTR(Perl_pregcomp);
     PL_regexecp = MEMBER_TO_FPTR(Perl_regexec_flags);
     PL_regint_start = MEMBER_TO_FPTR(Perl_re_intuit_start);

diff --git a/perl.h b/perl.h
index 8e975f1..c68faec 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3019,6 +3019,7 @@ enum {            /* pass one of these to get_vtbl */
 #define RsRECORD(sv)  (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
 
 /* Enable variables which are pointers to functions */
+typedef void (CPERLscope(*peep_t))(pTHX_ OP* o);
 typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm);
 typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg,
                                      char* strend, char* strbeg, I32 minend,

diff --git a/perlapi.h b/perlapi.h
index 49e6eed..71384ac 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -728,6 +728,8 @@ START_EXTERN_C
 #define PL_op                  (*Perl_Top_ptr(aTHXo))
 #undef  PL_opsave
 #define PL_opsave              (*Perl_Topsave_ptr(aTHXo))
+#undef  PL_peepp
+#define PL_peepp               (*Perl_Tpeepp_ptr(aTHXo))
 #undef  PL_protect
 #define PL_protect             (*Perl_Tprotect_ptr(aTHXo))
 #undef  PL_reg_call_cc

diff --git a/sv.c b/sv.c
index b8468a5..b08c608 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10268,6 +10268,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_reginterp_cnt   = 0;
     PL_reg_starttry    = 0;
 
+    /* Pluggable optimizer */
+    PL_peepp           = proto_perl->Tpeepp;
+
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;

diff --git a/thrdvar.h b/thrdvar.h
index a739ecd..8e999fc 100644 (file)
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -211,6 +211,8 @@ PERLVAR(Treg_leftiter,      I32)            /* wait until caching pos */
 PERLVARI(Treg_poscache, char *, Nullch)        /* cache of pos of WHILEM */
 PERLVAR(Treg_poscache_size, STRLEN)    /* size of pos cache of WHILEM */
 
+PERLVARI(Tpeepp,       peep_t, MEMBER_TO_FPTR(Perl_peep))
+                                       /* Pointer to peephole optimizer */
 PERLVARI(Tregcompp,    regcomp_t, MEMBER_TO_FPTR(Perl_pregcomp))
                                        /* Pointer to REx compiler */
 PERLVARI(Tregexecp,    regexec_t, MEMBER_TO_FPTR(Perl_regexec_flags))

diff --git a/util.c b/util.c
index a88c25d..b615556 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3037,6 +3037,8 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     PL_reg_start_tmpl = 0;
     PL_reg_poscache = Nullch;
 
+    PL_peepp = MEMBER_TO_FPTR(Perl_peep);
+
     /* parent thread's data needs to be locked while we make copy */
     MUTEX_LOCK(&t->mutex);