From: Simon Cozens Date: Wed, 1 Aug 2001 13:57:02 +0000 (-0700) Subject: Pluggable optimizer X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a2efc82216efc10377cf26fd4aff1aa5e66c6687;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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);