--- Faster/Faster.pm 2006/03/10 18:53:49 1.13 +++ Faster/Faster.pm 2006/03/10 22:39:11 1.21 @@ -6,8 +6,31 @@ use Faster; + perl -MFaster ... + =head1 DESCRIPTION +This module implements a very simple-minded JIT. It works by more or less +translating every function it sees into a C program, compiling it and then +replacing the function by the compiled code. + +As a result, startup times are immense, as every function might lead to a +full-blown compilation. + +The speed improvements are also not great, you can expect 20% or so on +average, for code that runs very often. + +Faster is in the early stages of development. Due to its design its +relatively safe to use (it will either work or simply slowdown the program +immensely, but rarely cause bugs). + +Usage is very easy, just C and every function called from then +on will be compiled. + +Right now, Faster will leave lots of F<*.c>, F<*.o> and F<*.so> files in +F, and it will even create those temporary files in an insecure +manner, so watch out. + =over 4 =cut @@ -17,7 +40,7 @@ use strict; use Config; use B (); -use Digest::MD5 (); +#use Digest::MD5 (); use DynaLoader (); BEGIN { @@ -37,112 +60,56 @@ $COMPILE =~ s/-f(?:PIC|pic)//g if $Config{archname} =~ /^(i[3456]86)-/; -my $opt_assert = 1; +my $opt_assert = $ENV{FASTER_DEBUG}; +my $verbose = $ENV{FASTER_VERBOSE}+0; our $source; -my @ops; -my $op; -my $op_name; -my @loop; - -my %flag; - -# complex flag steting is no longer required, rewrite this ugly code -for (split /\n/, < undef), qw( + leavesub leavesublv return + goto last redo next + eval flip leaveeval entertry + formline grepstart mapstart + substcont entereval require +); - undef $flag{$_}{$op} - for ("known", @flags); -} +# pushmark extend=0 +# padsv extend=1 +# padav extend=1 +# padhv extend=1 +# padany extend=1 +# const extend=1 + +my %f_noasync = map +($_ => undef), qw( + mapstart grepstart match entereval + enteriter entersub leaveloop + + pushmark nextstate + + const stub unstack + last next redo seq + padsv padav padhv padany + aassign sassign orassign + rv2av rv2cv rv2gv rv2hv refgen + gv gvsv + add subtract multiply divide + complement cond_expr and or not + defined + method_named + preinc postinc predec postdec + aelem aelemfast helem delete exists + pushre subst list join split concat + length substr stringify ord + push pop shift unshift + eq ne gt lt ge le + regcomp regcreset regcmaybe +); my %callop = ( entersub => "(PL_ppaddr [OP_ENTERSUB]) (aTHX)", @@ -163,7 +130,14 @@ $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; } +sub out_cond_jump { + $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n"; +} + sub out_jump_next { + out_cond_jump $op_regcomp{$$op} + if $op_regcomp{$$op}; + assert "nextop == (OP *)${$op->next}"; $source .= " goto op_${$op->next};\n"; } @@ -179,10 +153,6 @@ out_jump_next; } -sub out_cond_jump { - $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n"; -} - sub op_entersub { out_callop; $source .= " RUNOPS_TILL ((OP *)${$op->next}L);\n"; @@ -319,20 +289,20 @@ sub op_padsv { my $flags = $op->flags; - my $target = $op->targ; + my $targ = $op->targ; $source .= <flags & B::OPf_MOD) { if ($op->private & B::OPpLVAL_INTRO) { - $source .= " SAVECLEARSV (PAD_SVl ((PADOFFSET)$target));\n"; + $source .= " SAVECLEARSV (PAD_SVl ((PADOFFSET)$targ));\n"; } elsif ($op->private & B::OPpDEREF) { my $deref = $op->private & B::OPpDEREF; - $source .= " Perl_vivify_ref (PAD_SVl ((PADOFFSET)$target), $deref);\n"; + $source .= " Perl_vivify_ref (PAD_SVl ((PADOFFSET)$targ), $deref);\n"; } } $source .= <next->other; + $op = $op->next; + out_cond_jump $op->other; out_jump_next; } @@ -410,7 +381,7 @@ out_callop; out_cond_jump $_->[$idx] - for reverse @loop; + for reverse @op_loop; $source .= " return nextop;\n"; } @@ -430,7 +401,9 @@ sub cv2c { my ($cv) = @_; - @loop = (); + local @ops; + local @op_loop; + local %op_regcomp; my %opsseen; my @todo = $cv->START; @@ -445,10 +418,17 @@ if ($class eq "LOGOP") { unshift @todo, $op->other; # unshift vs. push saves jumps + + # regcomp/o patches ops at runtime, lets expect that + $op_regcomp{${$op->first}} = $op->next + if $name eq "regcomp" && $op->other->pmflags & B::PMf_KEEP; + } elsif ($class eq "PMOP") { unshift @todo, $op->pmreplstart if ${$op->pmreplstart}; + } elsif ($class eq "LOOP") { - push @loop, [$op->nextop, $op->lastop->next, $op->redoop->next]; + push @op_loop, [$op->nextop, $op->lastop->next, $op->redoop->next]; + push @todo, $op->nextop, $op->lastop->next, $op->redoop->next; } } } @@ -468,13 +448,13 @@ #$source .= "{ dSP; sv_dump (TOPs); }\n";#d# $source .= " PERL_ASYNC_CHECK ();\n" - unless exists $flag{noasync}{$op_name}; + unless exists $f_noasync{$op_name}; if (my $can = __PACKAGE__->can ("op_$op_name")) { # handcrafted replacement $can->($op); - } elsif (exists $flag{unsafe}{$op_name}) { + } elsif (exists $f_unsafe{$op_name}) { # unsafe, return to interpreter assert "nextop == (OP *)$$op"; $source .= " return nextop;\n"; @@ -509,17 +489,15 @@ $source } -sub source2ptr { - my ($source) = @_; +my $uid = "aaaaaaa0"; - my $md5 = Digest::MD5::md5_hex $source; - $source =~ s/%%%FUNC%%%/Faster_$md5/; +sub source2ptr { + my (@source) = @_; - my $stem = "/tmp/$md5"; + my $stem = "/tmp/Faster-$$-" . $uid++; - unless (-e "$stem$_so") { - open FILE, ">:raw", "$stem.c"; - print FILE <:raw", "$stem.c"; + print FILE < @@ -529,44 +507,77 @@ #include "XSUB.h" #define RUNOPS_TILL(op) \\ - while (nextop != (op)) \\ - { \\ - PERL_ASYNC_CHECK (); \\ - PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\ - } +while (nextop != (op)) \\ + { \\ + PERL_ASYNC_CHECK (); \\ + PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\ + } EOF - print FILE $source; - close FILE; - system "$COMPILE -o $stem$_o $stem.c"; - system "$LINK -o $stem$_so $stem$_o $LIBS"; + for (@source) { + my $func = $uid++; + $_ =~ s/%%%FUNC%%%/$func/g; + print FILE $_; + $_ = $func; } -# warn $source; + close FILE; + system "$COMPILE -o $stem$_o $stem.c"; + #d#unlink "$stem.c"; + system "$LINK -o $stem$_so $stem$_o $LIBS"; + unlink "$stem$_o"; + my $so = DynaLoader::dl_load_file "$stem$_so" or die "$stem$_so: $!"; - DynaLoader::dl_find_symbol $so, "Faster_$md5" - or die "Faster_$md5: $!" + #unlink "$stem$_so"; + + map +(DynaLoader::dl_find_symbol $so, $_), @source } +my %ignore; + sub entersub { my ($cv) = @_; - # always compile the whole stash -# my @stash = $cv->STASH->ARRAY; -# warn join ":", @stash; -# exit; + my $pkg = $cv->STASH->NAME; + + return if $ignore{$pkg}; + + warn "compiling ", $cv->STASH->NAME, "\n" + if $verbose; eval { - my $source = cv2c $cv; + my @cv; + my @cv_source; + + # always compile the whole stash + my %stash = $cv->STASH->ARRAY; + while (my ($k, $v) = each %stash) { + $v->isa (B::GV::) + or next; + + my $cv = $v->CV; + + if ($cv->isa (B::CV::) + && ${$cv->START} + && $cv->START->name ne "null") { + push @cv, $cv; + push @cv_source, cv2c $cv; + } + } - my $ptr = source2ptr $source; + my @ptr = source2ptr @cv_source; - patch_cv $cv, $ptr; + for (0 .. $#cv) { + patch_cv $cv[$_], $ptr[$_]; + } }; - warn $@ if $@; + if ($@) { + $ignore{$pkg}++; + warn $@; + } } hook_entersub; @@ -575,6 +586,37 @@ =back +=head1 ENVIRONMENT VARIABLES + +The following environment variables influence the behaviour of Faster: + +=over 4 + +=item FASTER_VERBOSE + +Faster will output more informational messages when set to values higher +than C<0>. Currently, C<1> outputs which packages are being compiled. + +=item FASTER_DEBUG + +Add debugging code when set to values higher than C<0>. Currently, this +adds 1-3 C's per perl op, to ensure that opcode order and C +execution order are compatible. + +=item FASTER_CACHE + +NOT YET IMPLEMENTED + +Set a persistent cache directory that caches compiled code +fragments. Normally, code compiled by Faster will be deleted immediately, +and every restart will recompile everything. Setting this variable to a +directory makes Faster cache the generated files for re-use. + +This directory will always grow in contents, so you might need to erase it +from time to time. + +=back + =head1 BUGS/LIMITATIONS Perl will check much less often for asynchronous signals in @@ -582,24 +624,24 @@ iteration and every I/O operator, though. The following things will disable Faster. If you manage to enable them at -runtime, bad things will happen. +runtime, bad things will happen. Enabling them at startup will be fine, +though. enabled tainting enabled debugging -This will dramatically reduce Faster's performance: +Thread-enabled builds of perl will dramatically reduce Faster's +performance, but you don't care about speed if you enable threads anyway. - threads (but you don't care about speed if you use threads anyway) +These constructs will force the use of the interpreter for the currently +executed function as soon as they are being encountered during execution. -These constructs will force the use of the interpreter as soon as they are -being executed, for the rest of the currently executed: - - .., ... (flipflop operators) goto next, redo (but not well-behaved last's) eval require any use of formats + .., ... (flipflop operators) =head1 AUTHOR