B-C
view release on metacpan or search on metacpan
ByteLoader/ppport.h view on Meta::CPAN
PERL_MAGIC_qr|5.007002||p
PERL_MAGIC_regdata|5.007002||p
PERL_MAGIC_regdatum|5.007002||p
PERL_MAGIC_regex_global|5.007002||p
PERL_MAGIC_shared_scalar|5.007003||p
PERL_MAGIC_shared|5.007003||p
PERL_MAGIC_sigelem|5.007002||p
PERL_MAGIC_sig|5.007002||p
PERL_MAGIC_substr|5.007002||p
PERL_MAGIC_sv|5.007002||p
PERL_MAGIC_taint|5.007002||p
PERL_MAGIC_tiedelem|5.007002||p
PERL_MAGIC_tiedscalar|5.007002||p
PERL_MAGIC_tied|5.007002||p
PERL_MAGIC_utf8|5.008001||p
PERL_MAGIC_uvar_elem|5.007003||p
PERL_MAGIC_uvar|5.007002||p
PERL_MAGIC_vec|5.007002||p
PERL_MAGIC_vstring|5.008001||p
PERL_PV_ESCAPE_ALL|5.009004||p
PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
ByteLoader/ppport.h view on Meta::CPAN
PL_rs|||n
PL_signals|5.008001||p
PL_stack_base|5.004050||p
PL_stack_sp|5.004050||p
PL_statcache|5.005000||p
PL_stdingv|5.004050||p
PL_sv_arenaroot|5.004050||p
PL_sv_no|5.004050||pn
PL_sv_undef|5.004050||pn
PL_sv_yes|5.004050||pn
PL_tainted|5.004050||p
PL_tainting|5.004050||p
PL_tokenbuf|5.024000||p
POP_MULTICALL||5.024000|
POPi|||n
POPl|||n
POPn|||n
POPpbytex||5.007001|n
POPpx||5.005030|n
POPp|||n
POPs|||n
POPul||5.006000|n
ByteLoader/ppport.h view on Meta::CPAN
do_trans_simple|||
do_trans|||
do_vecget|||
do_vecset|||
do_vop|||
docatch|||
doeval_compile|||
dofile|||
dofindlabel|||
doform|||
doing_taint||5.008001|n
dooneliner|||
doopen_pm|||
doparseform|||
dopoptoeval|||
dopoptogivenfor|||
dopoptolabel|||
dopoptoloop|||
dopoptosub_at|||
dopoptowhen|||
doref||5.009003|
ByteLoader/ppport.h view on Meta::CPAN
magic_freearylen_p|||
magic_freeovrld|||
magic_getarylen|||
magic_getdebugvar|||
magic_getdefelem|||
magic_getnkeys|||
magic_getpack|||
magic_getpos|||
magic_getsig|||
magic_getsubstr|||
magic_gettaint|||
magic_getuvar|||
magic_getvec|||
magic_get|||
magic_killbackrefs|||
magic_methcall1|||
magic_methcall|||v
magic_methpack|||
magic_nextpack|||
magic_regdata_cnt|||
magic_regdatum_get|||
ByteLoader/ppport.h view on Meta::CPAN
magic_sethint|||
magic_setisa|||
magic_setlvref|||
magic_setmglob|||
magic_setnkeys|||
magic_setpack|||
magic_setpos|||
magic_setregexp|||
magic_setsig|||
magic_setsubstr|||
magic_settaint|||
magic_setutf8|||
magic_setuvar|||
magic_setvec|||
magic_set|||
magic_sizepack|||
magic_wipepack|||
make_matcher|||
make_trie|||
malloc_good_size|||n
malloced_size|||n
ByteLoader/ppport.h view on Meta::CPAN
sv_magic|||
sv_mortalcopy_flags|||
sv_mortalcopy|||
sv_ncmp|||
sv_newmortal|||
sv_newref|||
sv_nolocking||5.007003|
sv_nosharing||5.007003|
sv_nounlocking|||
sv_nv||5.005000|
sv_only_taint_gmagic|||n
sv_or_pv_pos_u2b|||
sv_peek||5.005000|
sv_pos_b2u_flags||5.019003|
sv_pos_b2u_midway|||
sv_pos_b2u||5.006000|
sv_pos_u2b_cached|||
sv_pos_u2b_flags||5.011005|
sv_pos_u2b_forwards|||n
sv_pos_u2b_midway|||n
sv_pos_u2b||5.006000|
ByteLoader/ppport.h view on Meta::CPAN
sv_setref_pvs||5.024000|
sv_setref_pv|||
sv_setref_uv||5.007001|
sv_setsv_cow|||
sv_setsv_flags||5.007002|
sv_setsv_mg|5.004050||p
sv_setsv_nomg|5.007002||p
sv_setsv|||
sv_setuv_mg|5.004050||p
sv_setuv|5.004000||p
sv_tainted||5.004000|
sv_taint||5.004000|
sv_true||5.005000|
sv_unglob|||
sv_uni_display||5.007003|
sv_unmagicext|5.013008||p
sv_unmagic|||
sv_unref_flags||5.007001|
sv_unref|||
sv_untaint||5.004000|
sv_upgrade|||
sv_usepvn_flags||5.009004|
sv_usepvn_mg|5.004050||p
sv_usepvn|||
sv_utf8_decode||5.006000|
sv_utf8_downgrade||5.006000|
sv_utf8_encode||5.006000|
sv_utf8_upgrade_flags_grow||5.011000|
sv_utf8_upgrade_flags||5.007002|
sv_utf8_upgrade_nomg||5.007002|
ByteLoader/ppport.h view on Meta::CPAN
swash_init||5.006000|
swash_scan_list_line|||
swatch_get|||
sync_locale||5.021004|
sys_init3||5.010000|n
sys_init||5.010000|n
sys_intern_clear|||
sys_intern_dup|||
sys_intern_init|||
sys_term||5.010000|n
taint_env|||
taint_proper|||
tied_method|||v
tmps_grow_p|||
toFOLD_uni|||
toFOLD_utf8||5.019001|
toFOLD_uvchr||5.023009|
toFOLD||5.019001|
toLOWER_L1||5.019001|
toLOWER_LC||5.004000|
toLOWER_utf8||5.015007|
toLOWER_uvchr||5.023009|
ByteLoader/ppport.h view on Meta::CPAN
# define PL_rsfp_filters rsfp_filters
# define PL_rsfp rsfp
# define PL_stack_base stack_base
# define PL_stack_sp stack_sp
# define PL_statcache statcache
# define PL_stdingv stdingv
# define PL_sv_arenaroot sv_arenaroot
# define PL_sv_no sv_no
# define PL_sv_undef sv_undef
# define PL_sv_yes sv_yes
# define PL_tainted tainted
# define PL_tainting tainting
# define PL_tokenbuf tokenbuf
/* Replace: 0 */
#endif
/* Warning: PL_parser
* For perl versions earlier than 5.9.5, this is an always
* non-NULL dummy. Also, it cannot be dereferenced. Don't
* use it if you can avoid is and unless you absolutely know
* what you're doing.
* If you always check that PL_parser is non-NULL, you can
ByteLoader/ppport.h view on Meta::CPAN
#endif
#ifndef PERL_MAGIC_sig
# define PERL_MAGIC_sig 'S'
#endif
#ifndef PERL_MAGIC_sigelem
# define PERL_MAGIC_sigelem 's'
#endif
#ifndef PERL_MAGIC_taint
# define PERL_MAGIC_taint 't'
#endif
#ifndef PERL_MAGIC_uvar
# define PERL_MAGIC_uvar 'U'
#endif
#ifndef PERL_MAGIC_uvar_elem
# define PERL_MAGIC_uvar_elem 'u'
#endif
improved --version
added --perlopts to handle -DALLOW_PERL_OPTIONS
* perlcc (2.16): changed output name rules:
Without given output file name we use the name of the input file (in the subdir)
or with -e a.out resp. a.exe and a randomized intermediate C filename.
If the input file is an absolute path on non-windows systems use the basename.
* CC (1.13): Use the B::C integer and double precision logic (ivx, nvx).
Fixed double precision to 16 digits. The nbody shootout is now 2x faster than perl.
Added optimizations: -fno-magic, -fno-autovivify, -faelem
Detect "no autovivification;" pragma.
New -fno-taint, -fomit_taint is deprecated
Fix amagic_generation which was removed with 5.17
Use new perl6 type names: int, num, str. double and string are deprecated.
* Bytecode (1.14): fixed require and op_first, issue 97
Fixed regex_pad offset in threaded perls >= 5.11, issue 68.
New type B::PAD isa B::AV (PADLIST for 5.17.5),
New bytecodes newpadlx, padl_name, padl_sym (PADLIST for 5.17.5)
Fixed CvGV_set causing Attempt to free unreferenced scalar in push_begin (42,43)
Fixed -Do (peek ops)
Renamed option -f to -F for files.
Fixed READONLY magic and restricted hashes, issue 98
new option -D for debugging.
omit PerlIO::Layer.
added pod
* Disassembler (1.08): 5.6: fix ldop comments.
add op_type names, add @svnames, add indices, add ldspecsvx type.
* Assembler (0.10): print more flags (as hex) and indices.
better limcheck diagnostics (op,sv,pv).
* cc_runtime514.h: removed from CORE with 5.13.9. [RT#65628]
If so, cp it back. You might need sudo cp. (unchecked)
Renamed not to pollute tests with older perls.
Expanded PERL_MAGIC_taint 't' for 5.6.
* C.xs: added experimental method_cv for the hash-only case, untested.
* t/modules.t: try --staticxs first, try crosscheck without perlcc.
* t/issue24.t: added.
* t/issue45.t: fixed and added 3 more tests.
* t/e_perlcc.t: added to test the new option handling.
* t/testc.sh, t/TESTS: fixed wrong test 39 for 5.8, added 47, 104 (reset), 105 (type-attr).
* t/testplc.sh: added 47.
* t/stash.t: rewritten. allow 5.6, use Test::More, more stable
* t/todomod.pl: added. interactive tool to check log.modules reports and fix TODOs
* status_upd: recommend and fix ./status_upd -f -q -d
These two not in CC yet.
]
freetmps-each-bblock Delays FREETMPS from the end of each
statement to the end of the each basic
block.
freetmps-each-loop Delays FREETMPS from the end of each
statement to the end of the group of
basic blocks forming a loop. At most
one of the freetmps-each-* options can
be used.
omit-taint Omits generating code for handling
perl's tainting mechanism.
-On Optimisation level (n = 0, 1, 2, ...). -O means -O1.
Currently, -O1 sets -ffreetmps-each-bblock and -O2
sets -ffreetmps-each-loop.
Example
perl -MO=CC,-O2,-ofoo.c foo.pl
perl cc_harness -o foo foo.c
perl -MO=CC,-mFoo,-oFoo.c Foo.pm
perl cc_harness -shared -c -o Foo.so Foo.c
op/splice.t
op/split.t
op/sprintf.t
op/stat.t
op/study.t
op/subst.t
op/substr.t
op/subst_amp.t
op/subst_wamp.t
op/sysio.t
op/taint.t
op/tie.t
op/do.t OK ok OK
op/each.t OK ok OK
op/eval.t OK ok ok 1-6 of 16 then exits
op/exec.t OK ok OK
op/exp.t OK ok OK
op/flip.t OK ok OK
op/fork.t OK ok OK
op/glob.t OK ok OK
op/regexp.t OK ok ok (trivially all eval'd)
op/repeat.t OK ok ok
op/sleep.t OK ok ok
op/sort.t OK ok 1..10, ok 1, Out of memory!
op/split.t OK ok ok
op/sprintf.t OK ok ok
op/stat.t OK ok ok
op/study.t OK ok ok
op/subst.t OK ok ok
op/substr.t OK ok ok1-22 except 7-9,11 (all $[)
op/taint.t
op/tie.t
op/tiearray.t
op/tiehandle.t
op/time.t OK ok ok
op/tr.t
op/undef.t omit 21 ok ok
op/universal.t
op/unshift.t OK ok ok
op/utf8decode.t
op/vec.t OK ok ok
cc_runtime.h view on Meta::CPAN
if (g != G_ARRAY) { \
if (++MARK <= SP) \
*MARK = *SP; \
else \
*MARK = &PL_sv_undef; \
SP = MARK; \
} \
} while (0)
#define MAYBE_TAINT_SASSIGN_SRC(sv) \
if (PL_tainting && PL_tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) || \
!((mg=mg_find(left, 't')) && mg->mg_len & 1)))\
TAINT_NOT
#define PP_PREINC(sv) do { \
if (SvIOK(sv)) { \
++SvIVX(sv); \
SvFLAGS(sv) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK); \
} \
else \
sv_inc(sv); \
sub save_context {
# forbid run-time extends of curpad syms, names and INC
warn "save context:\n" if $verbose;
my $warner = $SIG{__WARN__};
save_sig($warner) if $B::C::save_sig;
# honour -w and %^H
$init->add( "/* honor -w */",
sprintf "PL_dowarn = ( %s ) ? G_WARN_ON : G_WARN_OFF;", $^W );
if ($^{TAINT}) {
$init->add( "/* honor -Tt */",
"PL_tainting = TRUE;",
# -T -1 false, -t 1 true
"PL_taint_warn = ".($^{TAINT} < 0 ? "FALSE" : "TRUE").";");
}
if ($PERL510) {
# need to mark assign c3 to %main::. no need to assign the default dfs
if (is_using_mro() && mro::get_mro("main") eq 'c3') {
make_c3('main');
}
# Tie::Hash::NamedCapture is added for *+ *-, Errno for *!
#no strict 'refs';
#if ( defined(objsym(svref_2object(\*{'main::+'}))) or defined(objsym(svref_2object(\*{'main::-'}))) ) {
lib/B/CC.pm view on Meta::CPAN
optimize_warn_sv save_data_fh av-init2|av_init save_sig destruct
pv_copy_on_grow
B<-O1> sets B<-ffreetmps-each-bblock>.
B<-O2> adds B<-ffreetmps-each-loop>, C<-faelem> and B<-fno-destruct> from L<B::C>.
The following options must be set explicitly:
B<-fno-taint> or B<-fomit-taint>,
B<-fslow-signals>,
B<-no-autovivify>,
B<-fno-magic>.
=item B<-f>C<OPTIM>
Force optimisations on or off one at a time.
lib/B/CC.pm view on Meta::CPAN
pp_enter pp_reset pp_regcreset pp_stringify
TODO with -finline-ops:
pp_anoncode pp_wantarray pp_srefgen pp_refgen pp_ref pp_trans pp_schop pp_chop
pp_schomp pp_chomp pp_not pp_sprintf pp_anonlist pp_shift pp_once pp_lock
pp_rcatline pp_close pp_time pp_alarm pp_av2arylen: no lvalue, pp_length: no
magic
=item B<-fomit-taint>
Omits generating code for handling perl's tainting mechanism.
=item B<-fslow-signals>
Add PERL_ASYNC_CHECK after every op as in the old Perl runloop before 5.13.
perl "Safe signals" check the state of incoming signals after every op.
See L<http://perldoc.perl.org/perlipc.html#Deferred-Signals-(Safe-Signals)>
We trade safety for more speed and delay the execution of non-IO signals
(IO signals are already handled in PerlIO) from after every single Perl op
to the same ops as used in 5.14.
lib/B/CC.pm view on Meta::CPAN
my %lexstate; # state of padsvs at the start of a bblock
my ( $verbose, $check );
my ( $entertry_defined, $vivify_ref_defined );
my ( $init_name, %debug, $strict );
# Optimisation options. On the command line, use hyphens instead of
# underscores for compatibility with gcc-style options. We use
# underscores here because they are OK in (strict) barewords.
# Disable with -fno-
my ( $freetmps_each_bblock, $freetmps_each_loop, $inline_ops, $opt_taint, $opt_omit_taint,
$opt_slow_signals, $opt_name_magic, $opt_type_attr, $opt_autovivify, $opt_magic,
$opt_aelem, %c_optimise );
$inline_ops = 1 unless $^O eq 'MSWin32'; # Win32 cannot link to unexported pp_op() XXX
$opt_name_magic = 1;
my %optimise = (
freetmps_each_bblock => \$freetmps_each_bblock, # -O1
freetmps_each_loop => \$freetmps_each_loop, # -O2
aelem => \$opt_aelem, # -O2
inline_ops => \$inline_ops, # not on Win32
omit_taint => \$opt_omit_taint,
taint => \$opt_taint,
slow_signals => \$opt_slow_signals,
name_magic => \$opt_name_magic,
type_attr => \$opt_type_attr,
autovivify => \$opt_autovivify,
magic => \$opt_magic,
);
my %async_signals = map { $_ => 1 } # 5.14 ops which do PERL_ASYNC_CHECK
qw(wait waitpid nextstate and cond_expr unstack or subst dorassign);
$async_signals{$_} = 1 for # more 5.16 ops which do PERL_ASYNC_CHECK
qw(substcont next redo goto leavewhen);
lib/B/CC.pm view on Meta::CPAN
} elsif ($] >= 5.016 and $] <= 5.017) {
runtime("CopSTASHPV_set((COP*)PL_op, NULL, 0);");
} else {
runtime("CopSTASHPV_set((COP*)PL_op, NULL);");
}
runtime("#endif");
}
@stack = ();
debug( sprintf( "%s:%d\n", $op->file, $op->line ) ) if $debug{lineno};
debug( sprintf( "CopLABEL %s\n", $op->label ) ) if $op->label and $debug{cxstack};
runtime("TAINT_NOT;") if $opt_taint; # TODO Not always needed (resets PL_taint = 0)
runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;"); # TODO reset sp not needed always
if ( $freetmps_each_bblock || $freetmps_each_loop ) {
$need_freetmps = 1;
}
else {
runtime("FREETMPS;"); # TODO Not always needed
}
return $op->next;
}
lib/B/CC.pm view on Meta::CPAN
}
}
# coverage: 20
sub pp_regcreset {
if ($inline_ops) {
my $op = shift;
warn "inlining regcreset\n" if $debug{op};
$curcop->write_back if $curcop;
runtime 'PL_reginterp_cnt = 0; /* pp_regcreset */';
runtime 'TAINT_NOT;' if $opt_taint;
return $op->next;
} else {
default_pp(@_);
}
}
# coverage: 103
sub pp_stringify {
if ($inline_ops and $] >= 5.008) {
my $op = shift;
lib/B/CC.pm view on Meta::CPAN
}
else {
$dst->set_sv( $src->as_sv );
}
push( @stack, $dst );
}
elsif ( @stack == 1 ) {
if ($backwards) {
my $src = pop @stack;
my $type = $src->{type};
runtime("if (PL_tainting && PL_tainted) TAINT_NOT;") if $opt_taint;
if ( $type == T_INT ) {
if ( $src->{flags} & VALID_UNSIGNED ) {
runtime sprintf( "sv_setuv(TOPs, %s);", $src->as_int );
}
else {
runtime sprintf( "sv_setiv(TOPs, %s);", $src->as_int );
}
}
elsif ( $type == T_NUM ) {
runtime sprintf( "sv_setnv(TOPs, %s);", $src->as_double );
}
else {
runtime sprintf( "sv_setsv(TOPs, %s);", $src->as_sv );
}
runtime("SvSETMAGIC(TOPs);") if $opt_magic;
}
else {
my $dst = $stack[-1];
my $type = $dst->{type};
runtime("sv = POPs;");
runtime("MAYBE_TAINT_SASSIGN_SRC(sv);") if $opt_taint;
if ( $type == T_INT ) {
$dst->set_int("SvIV(sv)");
}
elsif ( $type == T_NUM ) {
$dst->set_double("SvNV(sv)");
}
else {
$opt_magic
? runtime("SvSetMagicSV($dst->{sv}, sv);")
: runtime("SvSetSV($dst->{sv}, sv);");
lib/B/CC.pm view on Meta::CPAN
}
else {
# empty perl stack, both at run-time
if ($backwards) {
runtime("src = POPs; dst = TOPs;");
}
else {
runtime("dst = POPs; src = TOPs;");
}
runtime(
$opt_taint ? "MAYBE_TAINT_SASSIGN_SRC(src);" : "",
"SvSetSV(dst, src);",
$opt_magic ? "SvSETMAGIC(dst);" : "",
"SETs(dst);"
);
}
return $op->next;
}
# coverage: ny
sub pp_preinc {
lib/B/CC.pm view on Meta::CPAN
# Allow debugging in CHECK blocks without Od
$DB::single = 1 if defined &DB::DB;
my ( $option, $opt, $arg );
# init with -O0
foreach my $ref ( values %optimise ) {
$$ref = 0;
}
$B::C::fold = 0 if $] >= 5.013009; # utf8::Cased tables
$B::C::warnings = 0 if $] >= 5.013005; # Carp warnings categories and B
$B::C::destruct = 0 unless $] < 5.008; # fast_destruct
$opt_taint = 1;
$opt_magic = 1; # only makes sense with -fno-magic
$opt_autovivify = 1; # only makes sense with -fno-autovivify
OPTION:
while ( $option = shift @options ) {
if ( $option =~ /^-(cross)=(.*)/ ) {
$opt = $1;
$arg = $2;
}
elsif ( $option =~ /^-(.)(.*)/ ) {
$opt = $1;
lib/B/CC.pm view on Meta::CPAN
$B::C::verbose++;
$B::C::debug{ $B::C::debug_map{$arg} }++;
}
else {
warn qq(Warning: ignoring unknown -D option "$arg"\n);
}
}
}
}
$strict++ if !$strict and $Config{ccflags} !~ m/-DDEBUGGING/;
if ($opt_omit_taint) {
$opt_taint = 0;
warn "Warning: -fomit_taint is deprecated. Use -fno-taint instead.\n";
}
# rgs didn't want opcodes to be added to Opcode. So I had to add it to a
# seperate Opcodes package.
eval { require Opcodes; };
if (!$@ and $Opcodes::VERSION) {
my $MAXO = Opcodes::opcodes();
for (0..$MAXO-1) {
no strict 'refs';
my $ppname = "pp_".Opcodes::opname($_);
perlcompile.pod view on Meta::CPAN
cog Copy-on-grow: PVs declared and initialised statically
freetmps-each-bblock Delays FREETMPS from the end of each
statement to the end of the each basic
block.
freetmps-each-loop Delays FREETMPS from the end of each
statement to the end of the group of
basic blocks forming a loop. At most
one of the freetmps-each-* options can
be used.
no-inline-ops Turn off aggressive inlining of ops
omit-taint Omits generating code for handling
perl's tainting mechanism.
-On Optimisation level (n = 0, 1, 2, ...). -O means -O1.
-O1 -ffreetmps-each-bblock
-O2 -O1 -ffreetmps-each-loop
All B::C -O3 optimisations are automatically used.
=head3 CC Invocation Example
perl -MO=CC,-O2,-ofoo.c foo.pl
perl cc_harness -o foo foo.c
ramblings/blogs-optimizing-4.md view on Meta::CPAN
PUSHs(AvARRAY(MUTABLE_AV(PL_curpad[5]))[0]); /* no autovivification */
sv = POPs;
MAYBE_TAINT_SASSIGN_SRC(sv); /* not needed */
SvSetMagicSV(PL_curpad[4], sv); /* i.e. PL_curpad[4] = sv; */
...
We can study the expanded macros with:
cc_harness -DOPT -E -O2 -onbody.perl-2.perl-1.i nbody.perl-2.perl.c
`TAINT_NOT` does `(PL_tainted = (0))`. It is needed only once, because nobody
changes `PL_tainted`. We can also ignore taint checks generally by setting `-fomit_taint`.
perl -MO=Concise,offset_momentum nbody.perl-2a.perl
main::offset_momentum:
42 <1> leavesub[1 ref] K/REFC,1 ->(end)
- <@> lineseq KP ->42
1 <;> nextstate(main 141 (eval 5):4) v ->2
4 <2> sassign vKS/2 ->5
2 <$> const(NV 0) s ->3
3 <0> padsv[$px:141,145] sRM*/LVINTRO ->4
ramblings/blogs-optimizing-4.md view on Meta::CPAN
`FREETMPS` is also part of `nextstate`, and calling it after each basic
block is optimized by -O1, and -O2 would free the temps after each
loop. If FREETMPS is needed at all, i.e. if locals are used in the
function at all, is not checked yet.
`SAVECLEARSV(PL_curpad[1-4])` is part of `padsv /LVINTRO`, but here unneeded, since
it is in the context of sassign. So the value of the lexical does not need to be cleared
before it is set. And btw. the setter of the lexical is already optimized to a temporary.
`MAYBE_TAINT_SASSIGN_SRC(sv)` is part of `sassign` and can be omitted with `-fomit_taint`,
and since we are at `TAINT_NOT` we can leave it out.
`SvSetMagicSV(PL_curpad[4], sv)` is also part of the optimized `sassign` op, just not
yet optimized enough, since sv cannot have any magic. A type declaration for the `padsv`
would have used the faster equivalent `SvNV(PL_curpad[4]) = SvNV(sv);` put on the stack.
We can easily test this out by NOP'ing these code sections and see the costs.
With **4m53.073s**, without **4m23.265s**. 30 seconds or ~10% faster. This is now in the typical
range of p5p micro-optimizations and not considered high-priority for now.
ramblings/magic view on Meta::CPAN
pp_match()
m//g gets 'g' magic with obj = name = namlen = 0.
pp_sys.c
pp_tie()
sv gets magic with obj = sv and name = namlen = 0.
If an HV or an AV, it gets 'P' magic, otherwise 'q' magic.
pp_dbmopen()
'P' magic for the HV just as with pp_tie().
pp_sysread()
If tainting, the buffer SV gets 't' magic with
obj = name = namlen = 0.
sv.c
ref loops:
For certain magics the sv == obj - a "magic reference loop":
arylen, symtab, tiedscalar, .... There the obj refcount is
not incremented.
sv_setsv()
Doing sv_setsv(dstr, gv) gives '*' magic to dstr with
obj = dstr, name = GvNAME, namlen = GvNAMELEN.
ramblings/more-opts.md view on Meta::CPAN
shared objects, created at build-time (as Encode does)
implement exists symbol as op (lexical or global)
symbols should not be created when asking if a symbol exists.
implement last out of grep/map
tail recursion
implement the taint flag bit for HEKs
implement the run-time part for oplines
search for the upper cop in case of warnings/errors for the filename
script/perlcc.PL view on Meta::CPAN
sub compile_cstyle {
my $stash = opt('stash') ? grab_stash() : "";
$stash .= "," if $stash; #stash can be empty
$stash .= "-u$_," for @{$Options->{u}};
$stash .= "-U$_," for @{$Options->{U}};
#if ($ENV{PERL_CORE} and ($Config{ccflags} =~ /-m32/ or $Config{cc} =~ / -m32/)) {
# die "perlcc with -m32 cross compilation is not supported\n";
#}
my $taint = opt('T') ? ' -T' :
opt('t') ? ' -t' : '';
# What are we going to call our output C file?
my $lose = 0;
my ($cfh);
my $testsuite = '';
my $addoptions = '';
if (@_) {
$addoptions = join(",",@_);
}
script/perlcc.PL view on Meta::CPAN
my $max_line_len = '';
if (is_msvc) {
$max_line_len = '-l2000,';
}
my $options = "$addoptions$testsuite$max_line_len$staticxs$stash";
$options .= "-o$cfile" unless opt('check');
$options = substr($options,0,-1) if substr($options,-1,1) eq ",";
# This has to do the write itself, so we can't keep a lock. Life sucks.
my $command = "$BinPerl$taint -MO=$Backend,$options $Input";
vprint 5, "Compiling...";
vprint 0, "Calling $command";
my $t0 = [gettimeofday] if opt('time');
my ($output_r, $error_r, $errcode) = spawnit($command);
my $elapsed = tv_interval ( $t0 ) if opt('time');
my @output = @$output_r;
my @error = @$error_r;
if (@error && $errcode != 0) {
script/perlcc.PL view on Meta::CPAN
return $command;
}
# Use B::Stash to find additional modules and stuff.
{
my $_stash;
sub grab_stash {
warn "already called grab_stash once" if $_stash;
my $taint = opt('T') ? ' -T' :
opt('t') ? ' -t' : '';
my $command = "$BinPerl$taint -MB::Stash -c $Input";
# Filename here is perfectly sanitised.
vprint 3, "Calling $command\n";
my ($stash_r, $error_r, $errcode) = spawnit($command);
my @stash = @$stash_r;
my @error = @$error_r;
if (@error && $errcode != 0) {
_die("$Input did not compile $errcode:\n@error\n");
}
t/TestBC.pm view on Meta::CPAN
print STDERR "# $runperldisplay\n";
}
return $runperl;
}
sub runperl {
die "test.pl:runperl() does not take a hashref"
if ref $_[0] and ref $_[0] eq 'HASH';
my $runperl = &_create_runperl;
# ${^TAINT} is invalid in perl5.00505
my $tainted;
eval '$tainted = ${^TAINT};' if $] >= 5.006;
my %args = @_;
exists $args{switches} && grep m/^-T$/, @{$args{switches}} and $tainted = $tainted + 1;
if ($tainted) {
# We will assume that if you're running under -T, you really mean to
# run a fresh perl, so we'll brute force launder everything for you
my $sep;
eval "require Config; Config->import";
if ($@) {
warn "test.pl had problems loading Config: $@";
$sep = ':';
} else {
$sep = $Config{path_sep};
}
my @keys = grep {exists $ENV{$_}} qw(CDPATH IFS ENV BASH_ENV);
local @ENV{@keys} = ();
# Untaint, plus take out . and empty string:
local $ENV{'DCL$PATH'} = $1 if $is_vms && ($ENV{'DCL$PATH'} =~ /(.*)/s);
$ENV{PATH} =~ /(.*)/s;
local $ENV{PATH} =
join $sep, grep { $_ ne "" and $_ ne "." and -d $_ and
($is_mswin or $is_vms or !(stat && (stat _)[2]&0022)) }
split quotemeta ($sep), $1;
$ENV{PATH} .= "$sep/bin" if $is_cygwin; # Must have /bin under Cygwin
$runperl =~ /(.*)/s;
$runperl = $1;
( run in 0.696 second using v1.01-cache-2.11-cpan-4e96b696675 )