ext/XS-APItest/t/my_exit.t XS::APItest: test my_exit
ext/XS-APItest/t/Null.pm Helper for ./blockhooks.t
ext/XS-APItest/t/op.t XS::APItest: tests for OP related APIs
-ext/XS-APItest/t/peep.t Test hooking PL_peepp
ext/XS-APItest/t/pmflag.t Test removal of Perl_pmflag()
ext/XS-APItest/t/printf.t XS::APItest extension
ext/XS-APItest/t/ptr_table.t Test ptr_table_* APIs
: Used in op.c
pd |void |pad_swipe |PADOFFSET po|bool refadjust
: FIXME
-p |void |peep |NULLOK OP* o|NN peep_next_t *next_peep
+p |void |peep |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)
#endif
#ifdef PERL_CORE
#define pad_swipe(a,b) Perl_pad_swipe(aTHX_ a,b)
-#define peep(a,b) Perl_peep(aTHX_ a,b)
+#define peep(a) Perl_peep(aTHX_ a)
#endif
#if defined(USE_REENTRANT_API)
#define reentrant_size() Perl_reentrant_size(aTHX)
AV *cscav;
AV *bhkav;
bool bhk_record;
- peep_t orig_peep;
- AV *peep_record;
} my_cxt_t;
START_MY_CXT
STATIC BHK bhk_csc, bhk_test;
-STATIC void
-my_peep (pTHX_ OP *o, peep_next_t *next_peep)
-{
- dMY_CXT;
-
- if (!o)
- return;
-
- CALL_FPTR(MY_CXT.orig_peep)(aTHX_ o, next_peep);
-
- for (; o; o = o->op_next) {
- if (o->op_type == OP_CONST && cSVOPx_sv(o) && SvPOK(cSVOPx_sv(o))) {
- av_push(MY_CXT.peep_record, newSVsv(cSVOPx_sv(o)));
- }
- }
-}
-
#include "const-c.inc"
MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash
BhkENTRY_set(&bhk_csc, start, blockhook_csc_start);
BhkENTRY_set(&bhk_csc, pre_end, blockhook_csc_pre_end);
Perl_blockhook_register(aTHX_ &bhk_csc);
-
- MY_CXT.peep_record = newAV();
}
void
MY_CXT.cscav = NULL;
MY_CXT.bhkav = get_av("XS::APItest::bhkav", GV_ADDMULTI);
MY_CXT.bhk_record = 0;
- MY_CXT.peep_record = newAV();
void
print_double(val)
if (on)
av_clear(MY_CXT.bhkav);
-void
-peep_enable ()
- PREINIT:
- dMY_CXT;
- CODE:
- av_clear(MY_CXT.peep_record);
- MY_CXT.orig_peep = PL_peepp;
- PL_peepp = my_peep;
-
-AV *
-peep_record ()
- PREINIT:
- dMY_CXT;
- CODE:
- RETVAL = MY_CXT.peep_record;
- OUTPUT:
- RETVAL
-
-void
-peep_record_clear ()
- PREINIT:
- dMY_CXT;
- CODE:
- av_clear(MY_CXT.peep_record);
-
BOOT:
{
HV* stash;
+++ /dev/null
-#!perl -w
-
-BEGIN {
- push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
- require Config; import Config;
- if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
- # Look, I'm using this fully-qualified variable more than once!
- my $arch = $MacPerl::Architecture;
- print "1..0 # Skip: XS::APItest was not built\n";
- exit 0;
- }
-}
-
-use strict;
-use warnings;
-
-BEGIN {
- require '../../t/test.pl';
- plan(6);
- use_ok('XS::APItest')
-};
-
-my $record = XS::APItest::peep_record;
-
-XS::APItest::peep_enable;
-
-# our peep got called and remembered the string constant
-eval q[my $foo = q/affe/];
-is(scalar @{ $record }, 1);
-is($record->[0], 'affe');
-
-XS::APItest::peep_record_clear;
-
-# peep got called for each root op of the branch
-$::moo = $::moo = 0;
-eval q[my $foo = $::moo ? q/x/ : q/y/];
-is(scalar @{ $record }, 2);
-is($record->[0], 'x');
-is($record->[1], 'y');
#include "perl.h"
#include "keywords.h"
-#define CALL_A_PEEP(peep, o) CALL_FPTR((peep)->fn)(aTHX_ o, peep)
-
-#define CALL_PEEP(o) \
- STMT_START { \
- peep_next_t _next_peep; \
- _next_peep.fn = PL_peepp; \
- _next_peep.user_data = NULL; \
- CALL_A_PEEP(&_next_peep, o); \
- } STMT_END
-
+#define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o)
#define CALL_OPFREEHOOK(o) if (PL_opfreehook) CALL_FPTR(PL_opfreehook)(aTHX_ o)
#if defined(PL_OP_SLAB_ALLOC)
* peep() is called */
void
-Perl_peep(pTHX_ register OP *o, peep_next_t *next_peep)
+Perl_peep(pTHX_ register OP *o)
{
dVAR;
register OP* oldop = NULL;
- PERL_ARGS_ASSERT_PEEP;
-
if (!o || o->op_opt)
return;
ENTER;
sop = fop->op_sibling;
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
- CALL_A_PEEP(next_peep, cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
+ peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
stitch_keys:
o->op_opt = 1;
case OP_ONCE:
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
- CALL_A_PEEP(next_peep, cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
+ peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
break;
case OP_ENTERLOOP:
case OP_ENTERITER:
while (cLOOP->op_redoop->op_type == OP_NULL)
cLOOP->op_redoop = cLOOP->op_redoop->op_next;
- CALL_A_PEEP(next_peep, cLOOP->op_redoop);
+ peep(cLOOP->op_redoop);
while (cLOOP->op_nextop->op_type == OP_NULL)
cLOOP->op_nextop = cLOOP->op_nextop->op_next;
- CALL_A_PEEP(next_peep, cLOOP->op_nextop);
+ peep(cLOOP->op_nextop);
while (cLOOP->op_lastop->op_type == OP_NULL)
cLOOP->op_lastop = cLOOP->op_lastop->op_next;
- CALL_A_PEEP(next_peep, cLOOP->op_lastop);
+ peep(cLOOP->op_lastop);
break;
case OP_SUBST:
cPMOP->op_pmstashstartu.op_pmreplstart->op_type == OP_NULL)
cPMOP->op_pmstashstartu.op_pmreplstart
= cPMOP->op_pmstashstartu.op_pmreplstart->op_next;
- CALL_A_PEEP(next_peep, cPMOP->op_pmstashstartu.op_pmreplstart);
+ peep(cPMOP->op_pmstashstartu.op_pmreplstart);
break;
case OP_EXEC:
PERL_DEBUG_PAD(i))
/* Enable variables which are pointers to functions */
-struct peep_next;
-typedef void (CPERLscope(*peep_t))(pTHX_ OP* o, struct peep_next *next);
-typedef struct peep_next {
- peep_t fn;
- void *user_data;
-} peep_next_t;
-
+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,
This can be used for modules that have not been upgraded to 5.6 naming
conventions (and really should be completely obsolete by now).
-=item Make extending the peephole optimizer easier
-
-As of version 5.8, extension authors were allowed to replace perl's peephole
-optimizer function. However, this was B<very> hard to do, as there was no way to
-add new optimizations without having to copy large parts of perl's original
-optimizer. This problem is now solved by a rework of the optimizer extension
-API. See L<perlguts/"Compile pass 3: peephole optimization"> for details.
-
=item C<Perl_grok_bslash_o> and C<Perl_grok_bslash_c> may change in future
The functions C<Perl_grok_bslash_o> and C<Perl_grok_bslash_c>, which are public
After the compile tree for a subroutine (or for an C<eval> or a file)
is created, an additional pass over the code is performed. This pass
is neither top-down or bottom-up, but in the execution order (with
-additional complications for conditionals). Optimizations performed
-at this stage are subject to the same restrictions as in the pass 2.
-
-Peephole optimizations are done by calling the function pointed to by
-the global variable C<PL_peepp>. By default, C<PL_peepp> points to the
-function C<Perl_peep>. However, extensions may provide their own
-peephole optimizers, like this:
-
- peep_t original_peep;
-
- void my_peep (pTHX_ OP *o, peep_next_t *next_peep)
- {
- /* Delegate perl's original optimizer. The function pointer
- * in next_peep->fn will point to the optimizer function
- * initially invoked, so when perl's peep recurses into some
- * branch of the optree, it'll call back to my_peep.
- */
- CALL_FPTR(original_peep)(aTHX_ o, next_peep);
-
- if (!o)
- return;
-
- for (; o; o = o->op_next) {
- /* custom optimisations */
- }
- }
-
- /* later, for example in a BOOT section */
- original_peep = PL_peepp;
- PL_peepp = my_peep;
-
-Do note that the peephole optimizer is called for each root of an
-optree. It has to traverse that optree itself, if necessary.
-
-However, it is not normally necessary for peep extensions to walk into
-branches of conditions. Perl's original optimizer, which extensions should
-always delegate to, already implements that and will call the optimizer
-pointed to by C<next_peep> for each root OP of branches. By default,
-C<next_peep> points to whatever is in C<PL_peepp>, but it is also possible
-to make the default optimizer call back to different optimizers:
-
- void my_peep (pTHX_ OP *o, peep_next_t *next_peep)
- {
- peep_next_t other_peep = { my_other_peep, NULL };
-
- /* call the original peep, and have it call my_other_peep when
- * recursing into branches */
- CALL_FPTR(original_peep)(aTHX_ o, &other_peep);
- }
-
-The second member of C<peep_next_t>, C<user_data>, which is just set to
-C<NULL> in the above example, may be used to pass along arbitrary data to
-later invocations of peep functions.
-
-Also note that, under some conditions, the peephole optimizer will be
-called with a C<NULL> opcode. That is perfectly normal and optimizer
-functions need to accomodate for that.
+additional complications for conditionals). These optimizations are
+done in the subroutine peep(). Optimizations performed at this stage
+are subject to the same restrictions as in the pass 2.
=head2 Pluggable runops
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, peep_next_t *next_peep)
- __attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_PEEP \
- assert(next_peep)
-
+PERL_CALLCONV void Perl_peep(pTHX_ OP* o);
PERL_CALLCONV PerlIO* Perl_start_glob(pTHX_ SV *tmpglob, IO *io)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
https://perl5.git.perl.org / perl5.git / commitdiff