Pluggable optimizer

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

p4raw-id: //depot/perl@11541

8 files changed, 24 insertions, 7 deletions

diff --git a/embedvar.h b/embedvar.h
index 34d781fb72..f6d6aac4ca 100644
--- 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 3d5d92b7d2..895c967cb4 100644
--- 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 91efa0f5af..d6d261eb42 100644
--- 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 8e975f1ba0..c68faecc0f 100644
--- 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 49e6eed064..71384aca7e 100644
--- 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 b8468a51ea..b08c608728 100644
--- 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 a739ecd7d6..8e999fc62e 100644
--- 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 a88c25dcbd..b615556473 100644
--- 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);