ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.pm
(Generate patch)

Comparing Faster/Faster.pm (file contents):
Revision 1.27 by root, Sat Mar 11 23:06:59 2006 UTC vs.
Revision 1.34 by root, Wed Mar 15 02:32:27 2006 UTC

… …
8 8
9 perl -MFaster ... 9 perl -MFaster ...
10 10
11=head1 DESCRIPTION 11=head1 DESCRIPTION
12 12
13This module implements a very simple-minded JIT. It works by more or less 13This module implements a very simple-minded "JIT" (or actually AIT, ahead
14translating every function it sees into a C program, compiling it and then 14of time compiler). It works by more or less translating every function it
15replacing the function by the compiled code. 15sees into a C program, compiling it and then replacing the function by the
16compiled code.
16 17
17As a result, startup times are immense, as every function might lead to a 18As a result, startup times are immense, as every function might lead to a
18full-blown compilation. 19full-blown compilation.
19 20
20The speed improvements are also not great, you can expect 20% or so on 21The speed improvements are also not great, you can expect 20% or so on
21average, for code that runs very often. 22average, for code that runs very often. The reason for this is that data
23handling is mostly being done by the same old code, it just gets called
24a bit faster. Regexes and string operations won't get faster. Airhtmetic
25doresn't become any faster. Just the operands and other stuff is put on
26the stack faster, and the opcodes themselves have a bit less overhead.
22 27
23Faster is in the early stages of development. Due to its design its 28Faster is in the early stages of development. Due to its design its
24relatively safe to use (it will either work or simply slowdown the program 29relatively safe to use (it will either work or simply slowdown the program
25immensely, but rarely cause bugs). 30immensely, but rarely cause bugs).
26 31
32More intelligent algorithms (loop optimisation, type inference) could
33improve that easily, but requires a much more elaborate presentation and
34optimiser than what is in place. There are no plans to improve Faster in
35this way, yet, but it would provide a reasonably good place to start.
36
27Usage is very easy, just C<use Faster> and every function called from then 37Usage is very easy, just C<use Faster> and every function called from then
28on will be compiled. 38on will be compiled.
29 39
30Right now, Faster will leave lots of F<*.c>, F<*.o> and F<*.so> files in 40Right now, Faster can leave lots of F<*.c> and F<*.so> files in your
31F</tmp>, and it will even create those temporary files in an insecure 41F<$FASTER_CACHEDIR> (by default F<$HOME/.perl-faster-cache>), and it will
32manner, so watch out. 42even create those temporary files in an insecure manner, so watch out.
33 43
34=over 4 44=over 4
35 45
36=cut 46=cut
37 47
… …
40no warnings; 50no warnings;
41 51
42use strict; 52use strict;
43use Config; 53use Config;
44use B (); 54use B ();
45#use Digest::MD5 ();
46use DynaLoader (); 55use DynaLoader ();
47use Digest::MD5 (); 56use Digest::MD5 ();
48use Storable (); 57use Storable ();
58use Fcntl ();
49 59
50BEGIN { 60BEGIN {
51 our $VERSION = '0.01'; 61 our $VERSION = '0.01';
52 62
53 require XSLoader; 63 require XSLoader;
54 XSLoader::load __PACKAGE__, $VERSION; 64 XSLoader::load __PACKAGE__, $VERSION;
55} 65}
56 66
57my $CACHEDIR = $ENV{FASTER_CACHE} || do { 67my $CACHEDIR =
68 $ENV{FASTER_CACHE}
69 || (exists $ENV{HOME} && "$ENV{HOME}/.perl-faster-cache")
70 || do {
58 require File::Temp; 71 require File::Temp;
59 File::Temp::tempdir (CLEANUP => 1) 72 File::Temp::tempdir (CLEANUP => 1)
60}; 73 };
61 74
62my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}"; 75my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}";
63my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}"; 76my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
64my $LIBS = "$Config{libs}"; 77my $LIBS = "";
65my $_o = $Config{_o}; 78my $_o = $Config{_o};
66my $_so = ".so"; 79my $_so = ".so";
67 80
68# we don't need no steenking PIC on x86 81# we don't need no steenking PIC on x86
69$COMPILE =~ s/-f(?:PIC|pic)//g 82$COMPILE =~ s/-f(?:PIC|pic)//g
70 if $Config{archname} =~ /^(i[3456]86)-/; 83 if $Config{archname} =~ /^(i[3456]86)-/;
71 84
72my $opt_assert = $ENV{FASTER_DEBUG}; 85my $opt_assert = $ENV{FASTER_DEBUG} & 2;
73my $verbose = $ENV{FASTER_VERBOSE}+0; 86my $verbose = $ENV{FASTER_VERBOSE}+0;
87
88warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2;
74 89
75our $source; 90our $source;
76 91
77our @ops; 92our @ops;
78our $insn; 93our $insn;
79our $op; 94our $op;
80our $op_name; 95our $op_name;
81our @op_loop;
82our %op_regcomp; 96our %op_regcomp;
83 97
84# ops that cause immediate return to the interpreter 98# ops that cause immediate return to the interpreter
85my %f_unsafe = map +($_ => undef), qw( 99my %f_unsafe = map +($_ => undef), qw(
86 leavesub leavesublv return 100 leavesub leavesublv return
… …
139# ops that do not need an ASYNC_CHECK 153# ops that do not need an ASYNC_CHECK
140my %f_noasync = map +($_ => undef), qw( 154my %f_noasync = map +($_ => undef), qw(
141 mapstart grepstart match entereval 155 mapstart grepstart match entereval
142 enteriter entersub leaveloop 156 enteriter entersub leaveloop
143 157
144 pushmark nextstate 158 pushmark nextstate caller
145 159
146 const stub unstack 160 const stub unstack
147 last next redo seq 161 last next redo goto seq
148 padsv padav padhv padany 162 padsv padav padhv padany
149 aassign sassign orassign 163 aassign sassign orassign
150 rv2av rv2cv rv2gv rv2hv refgen 164 rv2av rv2cv rv2gv rv2hv refgen
151 gv gvsv 165 gv gvsv
152 add subtract multiply divide 166 add subtract multiply divide
153 complement cond_expr and or not 167 complement cond_expr and or not
168 bit_and bit_or bit_xor
154 defined 169 defined
155 method method_named bless 170 method method_named bless
156 preinc postinc predec postdec 171 preinc postinc predec postdec
157 aelem aelemfast helem delete exists 172 aelem aelemfast helem delete exists
158 pushre subst list join split concat 173 pushre subst list lslice join split concat
159 length substr stringify ord 174 length substr stringify ord
160 push pop shift unshift 175 push pop shift unshift
161 eq ne gt lt ge le 176 eq ne gt lt ge le
162 regcomp regcreset regcmaybe 177 regcomp regcreset regcmaybe
163); 178);
… …
179sub out_callop { 194sub out_callop {
180 assert "nextop == (OP *)$$op"; 195 assert "nextop == (OP *)$$op";
181 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 196 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
182} 197}
183 198
199sub out_jump {
200 assert "nextop == (OP *)${$_[0]}L";
201 $source .= " goto op_${$_[0]};\n";
202}
203
184sub out_cond_jump { 204sub out_cond_jump {
185 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n"; 205 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
186} 206}
187 207
188sub out_jump_next { 208sub out_jump_next {
… …
219 239
220 out_next; 240 out_next;
221} 241}
222 242
223sub op_pushmark { 243sub op_pushmark {
224 $source .= " PUSHMARK (PL_stack_sp);\n"; 244 $source .= " faster_PUSHMARK (PL_stack_sp);\n";
225 245
226 out_next; 246 out_next;
227} 247}
228 248
229if ($Config{useithreads} ne "define") { 249if ($Config{useithreads} ne "define") {
… …
479} 499}
480 500
481sub out_break_op { 501sub out_break_op {
482 my ($idx) = @_; 502 my ($idx) = @_;
483 503
504 if ($op->flags & B::OPf_SPECIAL && $insn->{loop}) {
505 # common case: no label, innermost loop only
506 my $next = $insn->{loop}{loop_targ}[$idx];
484 out_callop; 507 out_callop;
485 508 out_jump $next;
486 out_cond_jump $_->[$idx] 509 } elsif (my $loop = $insn->{loop}) {
487 for reverse @op_loop; 510 # less common case: maybe break to some outer loop
488
489 $source .= " return nextop;\n"; 511 $source .= " return nextop;\n";
512 # todo: walk stack up
513 } else {
514 $source .= " return nextop;\n";
515 }
490} 516}
491 517
492sub xop_next { 518sub op_next {
493 out_break_op 0; 519 out_break_op 0;
494} 520}
495 521
496sub op_last { 522sub op_last {
497 out_break_op 1; 523 out_break_op 1;
… …
503 529
504sub cv2c { 530sub cv2c {
505 my ($cv) = @_; 531 my ($cv) = @_;
506 532
507 local @ops; 533 local @ops;
508 local @op_loop;
509 local %op_regcomp; 534 local %op_regcomp;
510 535
511 my %opsseen; 536 my $curloop;
512 my @todo = $cv->START; 537 my @todo = $cv->START;
513 my %op_target; 538 my %op_target;
539 my $numpushmark;
540 my $scope;
514 541
542 my %op_seen;
515 while (my $op = shift @todo) { 543 while (my $op = shift @todo) {
544 my $next;
516 for (; $$op; $op = $op->next) { 545 for (; $$op; $op = $next) {
517 last if $opsseen{$$op}++; 546 last if $op_seen{$$op}++;
547
548 $next = $op->next;
518 549
519 my $name = $op->name; 550 my $name = $op->name;
520 my $class = B::class $op; 551 my $class = B::class $op;
521 552
522 my $insn = { op => $op }; 553 my $insn = { op => $op };
554
555 # end of loop reached?
556 $curloop = $curloop->{loop} if $curloop && $$op == ${$curloop->{loop_targ}[1]};
557
558 # remember enclosing loop
559 $insn->{loop} = $curloop if $curloop;
523 560
524 push @ops, $insn; 561 push @ops, $insn;
525 562
526 if (exists $extend{$name}) { 563 if (exists $extend{$name}) {
527 my $extend = $extend{$name}; 564 my $extend = $extend{$name};
528 $extend = $extend->($op) if ref $extend; 565 $extend = $extend->($op) if ref $extend;
529 $insn->{extend} = $extend if defined $extend; 566 $insn->{extend} = $extend if defined $extend;
530 } 567 }
531 568
532 push @todo, $op->next; 569 # TODO: mark scopes similar to loops, make them comparable
533 570 # static cxstack(?)
534 if ($class eq "LOGOP") { 571 if ($class eq "LOGOP") {
535 push @todo, $op->other; 572 push @todo, $op->other;
536 $op_target{${$op->other}}++; 573 $op_target{${$op->other}}++;
537 574
538 # regcomp/o patches ops at runtime, lets expect that 575 # regcomp/o patches ops at runtime, lets expect that
… …
546 unshift @todo, $op->pmreplstart; 583 unshift @todo, $op->pmreplstart;
547 $op_target{${$op->pmreplstart}}++; 584 $op_target{${$op->pmreplstart}}++;
548 } 585 }
549 586
550 } elsif ($class eq "LOOP") { 587 } elsif ($class eq "LOOP") {
551 my @targ = ($op->nextop, $op->lastop->next, $op->redoop->next); 588 my @targ = ($op->nextop, $op->lastop->next, $op->redoop);
552 589
553 push @op_loop, \@targ; 590 unshift @todo, $next, $op->redoop, $op->nextop, $op->lastop;
554 push @todo, @targ; 591 $next = $op->redoop;
555 592
556 $op_target{$$_}++ for @targ; 593 $op_target{$$_}++ for @targ;
594
595 $insn->{loop_targ} = \@targ;
596 $curloop = $insn;
597
557 } elsif ($class eq "COP") { 598 } elsif ($class eq "COP") {
558 $insn->{bblock}++ if defined $op->label; 599 if (defined $op->label) {
600 $insn->{bblock}++;
601 $curloop->{contains_label}{$op->label}++ if $curloop; #TODO: should be within loop
602 }
603
604 } else {
605 if ($name eq "pushmark") {
606 $numpushmark++;
607 }
559 } 608 }
560 } 609 }
561 } 610 }
562 611
563 $_->{bblock}++ for grep $op_target{${$_->{op}}}, @ops; 612 $_->{bblock}++ for grep $op_target{${$_->{op}}}, @ops;
… …
565 local $source = <<EOF; 614 local $source = <<EOF;
566OP *%%%FUNC%%% (pTHX) 615OP *%%%FUNC%%% (pTHX)
567{ 616{
568 register OP *nextop = (OP *)${$ops[0]->{op}}L; 617 register OP *nextop = (OP *)${$ops[0]->{op}}L;
569EOF 618EOF
619
620 $source .= " faster_PUSHMARK_PREALLOC ($numpushmark);\n"
621 if $numpushmark;
570 622
571 while (@ops) { 623 while (@ops) {
572 $insn = shift @ops; 624 $insn = shift @ops;
573 625
574 $op = $insn->{op}; 626 $op = $insn->{op};
… …
643 695
644sub func2ptr { 696sub func2ptr {
645 my (@func) = @_; 697 my (@func) = @_;
646 698
647 #LOCK 699 #LOCK
700 mkdir $CACHEDIR, 0777;
701 sysopen my $meta_fh, "$CACHEDIR/meta", &Fcntl::O_RDWR | &Fcntl::O_CREAT, 0666
702 or die "$$CACHEDIR/meta: $!";
703 binmode $meta_fh, ":raw:perlio";
704 fcntl_lock fileno $meta_fh
705 or die "$CACHEDIR/meta: $!";
706
648 my $meta = eval { Storable::retrieve "$CACHEDIR/meta" } || { version => 1 }; 707 my $meta = eval { Storable::fd_retrieve $meta_fh } || { version => 1 };
649 708
650 for my $f (@func) { 709 for my $f (@func) {
651 $f->{func} = "F" . Digest::MD5::md5_hex ($f->{source}); 710 $f->{func} = "F" . Digest::MD5::md5_hex ($f->{source});
652 $f->{so} = $meta->{$f->{func}}; 711 $f->{so} = $meta->{$f->{func}};
653 } 712 }
… …
668 727
669#include "EXTERN.h" 728#include "EXTERN.h"
670#include "perl.h" 729#include "perl.h"
671#include "XSUB.h" 730#include "XSUB.h"
672 731
732#if 1
733# define faster_PUSHMARK_PREALLOC(count) while (PL_markstack_ptr + (count) >= PL_markstack_max) markstack_grow ()
734# define faster_PUSHMARK(p) *++PL_markstack_ptr = (p) - PL_stack_base
735#else
736# define faster_PUSHMARK_PREALLOC(count) 1
737# define faster_PUSHMARK(p) PUSHMARK(p)
738#endif
739
673#define RUNOPS_TILL(op) \\ 740#define RUNOPS_TILL(op) \\
674 while (nextop != (op)) \\ 741 while (nextop != (op)) \\
675 { \\ 742 { \\
676 PERL_ASYNC_CHECK (); \\ 743 PERL_ASYNC_CHECK (); \\
677 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\ 744 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\
… …
688 $meta->{$f->{func}} = $f->{so} = $stem; 755 $meta->{$f->{func}} = $f->{so} = $stem;
689 } 756 }
690 757
691 close $fh; 758 close $fh;
692 system "$COMPILE -o $stem$_o $stem.c"; 759 system "$COMPILE -o $stem$_o $stem.c";
693 #d#unlink "$stem.c"; 760 unlink "$stem.c" unless $ENV{FASTER_DEBUG} & 1;
694 system "$LINK -o $stem$_so $stem$_o $LIBS"; 761 system "$LINK -o $stem$_so $stem$_o $LIBS";
695 unlink "$stem$_o"; 762 unlink "$stem$_o";
696 } 763 }
697 764
698 for my $f (@func) { 765 for my $f (@func) {
… …
705 772
706 $f->{ptr} = DynaLoader::dl_find_symbol $so, $f->{func} 773 $f->{ptr} = DynaLoader::dl_find_symbol $so, $f->{func}
707 or die "$f->{func} not found in $stem$_so: $!"; 774 or die "$f->{func} not found in $stem$_so: $!";
708 } 775 }
709 776
777 seek $meta_fh, 0, 0 or die "$CACHEDIR/meta: $!";
710 Storable::nstore $meta, "$CACHEDIR/meta"; 778 Storable::nstore_fd $meta, $meta_fh;
711 # UNLOCK 779 truncate $meta_fh, tell $meta_fh;
780
781 # UNLOCK (by closing $meta_fh)
712} 782}
713 783
714my %ignore; 784my %ignore;
715 785
716sub entersub { 786sub entersub {
… …
723 warn "optimising ", $cv->STASH->NAME, "\n" 793 warn "optimising ", $cv->STASH->NAME, "\n"
724 if $verbose; 794 if $verbose;
725 795
726 eval { 796 eval {
727 my @func; 797 my @func;
798
799 push @func, {
800 cv => $cv,
801 name => "<>",
802 source => cv2c $cv,
803 };
728 804
729 # always compile the whole stash 805 # always compile the whole stash
730 my %stash = $cv->STASH->ARRAY; 806 my %stash = $cv->STASH->ARRAY;
731 while (my ($k, $v) = each %stash) { 807 while (my ($k, $v) = each %stash) {
732 $v->isa (B::GV::) 808 $v->isa (B::GV::)
… …
772=over 4 848=over 4
773 849
774=item FASTER_VERBOSE 850=item FASTER_VERBOSE
775 851
776Faster will output more informational messages when set to values higher 852Faster will output more informational messages when set to values higher
777than C<0>. Currently, C<1> outputs which packages are being compiled. 853than C<0>. Currently, C<1> outputs which packages are being compiled, C<3>
854outputs the cache directory and C<10> outputs information on which perl
855function is compiled into which shared object.
778 856
779=item FASTER_DEBUG 857=item FASTER_DEBUG
780 858
781Add debugging code when set to values higher than C<0>. Currently, this 859Add debugging code when set to values higher than C<0>. Currently, this
782adds 1-3 C<assert>'s per perl op, to ensure that opcode order and C 860adds 1-3 C<assert>'s per perl op (FASTER_DEBUG > 1), to ensure that opcode
783execution order are compatible. 861order and C execution order are compatible.
784 862
785=item FASTER_CACHE 863=item FASTER_CACHE
786 864
787NOT YET IMPLEMENTED CORRECTLY, SHARING BEETWEEN INSTANCES IS IMPOSSIBLE
788
789Set a persistent cache directory that caches compiled code 865Set a persistent cache directory that caches compiled code fragments. The
790fragments. Normally, code compiled by Faster will be deleted immediately, 866default is C<$HOME/.perl-faster-cache> if C<HOME> is set and a temporary
791and every restart will recompile everything. Setting this variable to a 867directory otherwise.
792directory makes Faster cache the generated files for re-use.
793 868
794This directory will always grow in contents, so you might need to erase it 869This directory will always grow in size, so you might need to erase it
795from time to time. 870from time to time.
796 871
797=back 872=back
798 873
799=head1 BUGS/LIMITATIONS 874=head1 BUGS/LIMITATIONS
… …
815These constructs will force the use of the interpreter for the currently 890These constructs will force the use of the interpreter for the currently
816executed function as soon as they are being encountered during execution. 891executed function as soon as they are being encountered during execution.
817 892
818 goto 893 goto
819 next, redo (but not well-behaved last's) 894 next, redo (but not well-behaved last's)
895 labels, if used
820 eval 896 eval
821 require 897 require
822 any use of formats 898 any use of formats
823 .., ... (flipflop operators) 899 .., ... (flipflop operators)
824 900

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines