| … | |
… | |
| 8 | |
8 | |
| 9 | perl -MFaster ... |
9 | perl -MFaster ... |
| 10 | |
10 | |
| 11 | =head1 DESCRIPTION |
11 | =head1 DESCRIPTION |
| 12 | |
12 | |
| 13 | This module implements a very simple-minded JIT. It works by more or less |
13 | This module implements a very simple-minded "JIT" (or actually AIT, ahead |
| 14 | translating every function it sees into a C program, compiling it and then |
14 | of time compiler). It works by more or less translating every function it |
| 15 | replacing the function by the compiled code. |
15 | sees into a C program, compiling it and then replacing the function by the |
|
|
16 | compiled code. |
| 16 | |
17 | |
| 17 | As a result, startup times are immense, as every function might lead to a |
18 | As a result, startup times are immense, as every function might lead to a |
| 18 | full-blown compilation. |
19 | full-blown compilation. |
| 19 | |
20 | |
| 20 | The speed improvements are also not great, you can expect 20% or so on |
21 | The speed improvements are also not great, you can expect 20% or so on |
| 21 | average, for code that runs very often. |
22 | average, for code that runs very often. The reason for this is that data |
|
|
23 | handling is mostly being done by the same old code, it just gets called |
|
|
24 | a bit faster. Regexes and string operations won't get faster. Airhtmetic |
|
|
25 | doresn't become any faster. Just the operands and other stuff is put on |
|
|
26 | the stack faster, and the opcodes themselves have a bit less overhead. |
| 22 | |
27 | |
| 23 | Faster is in the early stages of development. Due to its design its |
28 | Faster is in the early stages of development. Due to its design its |
| 24 | relatively safe to use (it will either work or simply slowdown the program |
29 | relatively safe to use (it will either work or simply slowdown the program |
| 25 | immensely, but rarely cause bugs). |
30 | immensely, but rarely cause bugs). |
| 26 | |
31 | |
|
|
32 | More intelligent algorithms (loop optimisation, type inference) could |
|
|
33 | improve that easily, but requires a much more elaborate presentation and |
|
|
34 | optimiser than what is in place. There are no plans to improve Faster in |
|
|
35 | this way, yet, but it would provide a reasonably good place to start. |
|
|
36 | |
| 27 | Usage is very easy, just C<use Faster> and every function called from then |
37 | Usage is very easy, just C<use Faster> and every function called from then |
| 28 | on will be compiled. |
38 | on will be compiled. |
| 29 | |
39 | |
| 30 | Right now, Faster will leave lots of F<*.c>, F<*.o> and F<*.so> files in |
40 | Right now, Faster can leave lots of F<*.c> and F<*.so> files in your |
| 31 | your F<$FASTER_CACHEDIR> (by default F<$HOME/.perl-faster-cache>), and it |
41 | F<$FASTER_CACHEDIR> (by default F<$HOME/.perl-faster-cache>), and it will |
| 32 | will even create those temporary files in an insecure manner, so watch |
42 | even create those temporary files in an insecure manner, so watch out. |
| 33 | out. |
|
|
| 34 | |
43 | |
| 35 | =over 4 |
44 | =over 4 |
| 36 | |
45 | |
| 37 | =cut |
46 | =cut |
| 38 | |
47 | |
| … | |
… | |
| 47 | use Digest::MD5 (); |
56 | use Digest::MD5 (); |
| 48 | use Storable (); |
57 | use Storable (); |
| 49 | use Fcntl (); |
58 | use Fcntl (); |
| 50 | |
59 | |
| 51 | BEGIN { |
60 | BEGIN { |
| 52 | our $VERSION = '0.01'; |
61 | our $VERSION = '0.1'; |
| 53 | |
62 | |
| 54 | require XSLoader; |
63 | require XSLoader; |
| 55 | XSLoader::load __PACKAGE__, $VERSION; |
64 | XSLoader::load __PACKAGE__, $VERSION; |
| 56 | } |
65 | } |
| 57 | |
66 | |
| … | |
… | |
| 63 | File::Temp::tempdir (CLEANUP => 1) |
72 | File::Temp::tempdir (CLEANUP => 1) |
| 64 | }; |
73 | }; |
| 65 | |
74 | |
| 66 | my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}"; |
75 | my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}"; |
| 67 | my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}"; |
76 | my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}"; |
| 68 | my $LIBS = "$Config{libs}"; |
77 | my $LIBS = ""; |
| 69 | my $_o = $Config{_o}; |
78 | my $_o = $Config{_o}; |
| 70 | my $_so = ".so"; |
79 | my $_so = ".so"; |
| 71 | |
80 | |
| 72 | # we don't need no steenking PIC on x86 |
81 | # we don't need no steenking PIC on x86 |
| 73 | $COMPILE =~ s/-f(?:PIC|pic)//g |
82 | $COMPILE =~ s/-f(?:PIC|pic)//g |
| 74 | if $Config{archname} =~ /^(i[3456]86)-/; |
83 | if $Config{archname} =~ /^(i[3456]86)-/; |
| 75 | |
84 | |
| 76 | my $opt_assert = $ENV{FASTER_DEBUG} > 1; |
85 | my $opt_assert = $ENV{FASTER_DEBUG} & 2; |
| 77 | my $verbose = $ENV{FASTER_VERBOSE}+0; |
86 | my $verbose = $ENV{FASTER_VERBOSE}+0; |
| 78 | |
87 | |
| 79 | warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2; |
88 | warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2; |
| 80 | |
89 | |
| 81 | our $source; |
90 | our $source; |
| 82 | |
91 | |
| 83 | our @ops; |
92 | our @ops; |
| 84 | our $insn; |
93 | our $insn; |
| 85 | our $op; |
94 | our $op; |
| 86 | our $op_name; |
95 | our $op_name; |
| 87 | our @op_loop; |
|
|
| 88 | our %op_regcomp; |
96 | our %op_regcomp; |
| 89 | |
97 | |
| 90 | # ops that cause immediate return to the interpreter |
98 | # ops that cause immediate return to the interpreter |
| 91 | my %f_unsafe = map +($_ => undef), qw( |
99 | my %f_unsafe = map +($_ => undef), qw( |
| 92 | leavesub leavesublv return |
100 | leavesub leavesublv return |
| … | |
… | |
| 154 | padsv padav padhv padany |
162 | padsv padav padhv padany |
| 155 | aassign sassign orassign |
163 | aassign sassign orassign |
| 156 | rv2av rv2cv rv2gv rv2hv refgen |
164 | rv2av rv2cv rv2gv rv2hv refgen |
| 157 | gv gvsv |
165 | gv gvsv |
| 158 | add subtract multiply divide |
166 | add subtract multiply divide |
| 159 | complement cond_expr and or not bit_and bit_or bit_xor |
167 | complement cond_expr and or not |
|
|
168 | bit_and bit_or bit_xor |
| 160 | defined |
169 | defined |
| 161 | method method_named bless |
170 | method method_named bless |
| 162 | preinc postinc predec postdec |
171 | preinc postinc predec postdec |
| 163 | aelem aelemfast helem delete exists |
172 | aelem aelemfast helem delete exists |
| 164 | pushre subst list lslice join split concat |
173 | pushre subst list lslice join split concat |
| … | |
… | |
| 185 | sub out_callop { |
194 | sub out_callop { |
| 186 | assert "nextop == (OP *)$$op"; |
195 | assert "nextop == (OP *)$$op"; |
| 187 | $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; |
196 | $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; |
| 188 | } |
197 | } |
| 189 | |
198 | |
|
|
199 | sub out_jump { |
|
|
200 | assert "nextop == (OP *)${$_[0]}L"; |
|
|
201 | $source .= " goto op_${$_[0]};\n"; |
|
|
202 | } |
|
|
203 | |
| 190 | sub out_cond_jump { |
204 | sub out_cond_jump { |
| 191 | $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n"; |
205 | $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n"; |
| 192 | } |
206 | } |
| 193 | |
207 | |
| 194 | sub out_jump_next { |
208 | sub out_jump_next { |
| … | |
… | |
| 485 | } |
499 | } |
| 486 | |
500 | |
| 487 | sub out_break_op { |
501 | sub out_break_op { |
| 488 | my ($idx) = @_; |
502 | my ($idx) = @_; |
| 489 | |
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]; |
| 490 | out_callop; |
507 | out_callop; |
| 491 | |
508 | out_jump $next; |
| 492 | out_cond_jump $_->[$idx] |
509 | } elsif (my $loop = $insn->{loop}) { |
| 493 | for reverse @op_loop; |
510 | # less common case: maybe break to some outer loop |
| 494 | |
|
|
| 495 | $source .= " return nextop;\n"; |
511 | $source .= " return nextop;\n"; |
|
|
512 | # todo: walk stack up |
|
|
513 | } else { |
|
|
514 | # fuck yourself for writing such hacks |
|
|
515 | $source .= " return nextop;\n"; |
|
|
516 | } |
| 496 | } |
517 | } |
| 497 | |
518 | |
| 498 | sub xop_next { |
519 | sub op_next { |
| 499 | out_break_op 0; |
520 | out_break_op 0; |
| 500 | } |
521 | } |
| 501 | |
522 | |
| 502 | sub op_last { |
523 | sub op_last { |
| 503 | out_break_op 1; |
524 | out_break_op 1; |
| 504 | } |
525 | } |
| 505 | |
526 | |
|
|
527 | # TODO: does not seem to work |
| 506 | sub xop_redo { |
528 | #sub op_redo { |
| 507 | out_break_op 2; |
529 | # out_break_op 2; |
| 508 | } |
530 | #} |
| 509 | |
531 | |
| 510 | sub cv2c { |
532 | sub cv2c { |
| 511 | my ($cv) = @_; |
533 | my ($cv) = @_; |
| 512 | |
534 | |
| 513 | local @ops; |
535 | local @ops; |
| 514 | local @op_loop; |
|
|
| 515 | local %op_regcomp; |
536 | local %op_regcomp; |
| 516 | |
537 | |
| 517 | my %opsseen; |
538 | my $curloop; |
| 518 | my @todo = $cv->START; |
539 | my @todo = $cv->START; |
| 519 | my %op_target; |
540 | my %op_target; |
| 520 | my $numpushmark; |
541 | my $numpushmark; |
|
|
542 | my $scope; |
| 521 | |
543 | |
|
|
544 | my %op_seen; |
| 522 | while (my $op = shift @todo) { |
545 | while (my $op = shift @todo) { |
|
|
546 | my $next; |
| 523 | for (; $$op; $op = $op->next) { |
547 | for (; $$op; $op = $next) { |
| 524 | last if $opsseen{$$op}++; |
548 | last if $op_seen{$$op}++; |
|
|
549 | |
|
|
550 | $next = $op->next; |
| 525 | |
551 | |
| 526 | my $name = $op->name; |
552 | my $name = $op->name; |
| 527 | my $class = B::class $op; |
553 | my $class = B::class $op; |
| 528 | |
554 | |
| 529 | my $insn = { op => $op }; |
555 | my $insn = { op => $op }; |
|
|
556 | |
|
|
557 | # end of loop reached? |
|
|
558 | $curloop = $curloop->{loop} if $curloop && $$op == ${$curloop->{loop_targ}[1]}; |
|
|
559 | |
|
|
560 | # remember enclosing loop |
|
|
561 | $insn->{loop} = $curloop if $curloop; |
| 530 | |
562 | |
| 531 | push @ops, $insn; |
563 | push @ops, $insn; |
| 532 | |
564 | |
| 533 | if (exists $extend{$name}) { |
565 | if (exists $extend{$name}) { |
| 534 | my $extend = $extend{$name}; |
566 | my $extend = $extend{$name}; |
| 535 | $extend = $extend->($op) if ref $extend; |
567 | $extend = $extend->($op) if ref $extend; |
| 536 | $insn->{extend} = $extend if defined $extend; |
568 | $insn->{extend} = $extend if defined $extend; |
| 537 | } |
569 | } |
| 538 | |
570 | |
| 539 | push @todo, $op->next; |
571 | # TODO: mark scopes similar to loops, make them comparable |
| 540 | |
572 | # static cxstack(?) |
| 541 | if ($class eq "LOGOP") { |
573 | if ($class eq "LOGOP") { |
| 542 | push @todo, $op->other; |
574 | push @todo, $op->other; |
| 543 | $op_target{${$op->other}}++; |
575 | $op_target{${$op->other}}++; |
| 544 | |
576 | |
| 545 | # regcomp/o patches ops at runtime, lets expect that |
577 | # regcomp/o patches ops at runtime, lets expect that |
| … | |
… | |
| 553 | unshift @todo, $op->pmreplstart; |
585 | unshift @todo, $op->pmreplstart; |
| 554 | $op_target{${$op->pmreplstart}}++; |
586 | $op_target{${$op->pmreplstart}}++; |
| 555 | } |
587 | } |
| 556 | |
588 | |
| 557 | } elsif ($class eq "LOOP") { |
589 | } elsif ($class eq "LOOP") { |
| 558 | my @targ = ($op->nextop, $op->lastop->next, $op->redoop->next); |
590 | my @targ = ($op->nextop, $op->lastop->next, $op->redoop); |
| 559 | |
591 | |
| 560 | push @op_loop, \@targ; |
592 | unshift @todo, $next, $op->redoop, $op->nextop, $op->lastop; |
| 561 | push @todo, @targ; |
593 | $next = $op->redoop; |
| 562 | |
594 | |
| 563 | $op_target{$$_}++ for @targ; |
595 | $op_target{$$_}++ for @targ; |
| 564 | |
596 | |
|
|
597 | $insn->{loop_targ} = \@targ; |
|
|
598 | $curloop = $insn; |
|
|
599 | |
| 565 | } elsif ($class eq "COP") { |
600 | } elsif ($class eq "COP") { |
| 566 | $insn->{bblock}++ if defined $op->label; |
601 | if (defined $op->label) { |
|
|
602 | $insn->{bblock}++; |
|
|
603 | $curloop->{contains_label}{$op->label}++ if $curloop; #TODO: should be within loop |
|
|
604 | } |
| 567 | |
605 | |
| 568 | } else { |
606 | } else { |
| 569 | if ($name eq "pushmark") { |
607 | if ($name eq "pushmark") { |
| 570 | $numpushmark++; |
608 | $numpushmark++; |
| 571 | } |
609 | } |
| … | |
… | |
| 719 | $meta->{$f->{func}} = $f->{so} = $stem; |
757 | $meta->{$f->{func}} = $f->{so} = $stem; |
| 720 | } |
758 | } |
| 721 | |
759 | |
| 722 | close $fh; |
760 | close $fh; |
| 723 | system "$COMPILE -o $stem$_o $stem.c"; |
761 | system "$COMPILE -o $stem$_o $stem.c"; |
| 724 | unlink "$stem.c" unless $ENV{FASTER_DEBUG} > 0; |
762 | unlink "$stem.c" unless $ENV{FASTER_DEBUG} & 1; |
| 725 | system "$LINK -o $stem$_so $stem$_o $LIBS"; |
763 | system "$LINK -o $stem$_so $stem$_o $LIBS"; |
| 726 | unlink "$stem$_o"; |
764 | unlink "$stem$_o"; |
| 727 | } |
765 | } |
| 728 | |
766 | |
| 729 | for my $f (@func) { |
767 | for my $f (@func) { |
| … | |
… | |
| 854 | These constructs will force the use of the interpreter for the currently |
892 | These constructs will force the use of the interpreter for the currently |
| 855 | executed function as soon as they are being encountered during execution. |
893 | executed function as soon as they are being encountered during execution. |
| 856 | |
894 | |
| 857 | goto |
895 | goto |
| 858 | next, redo (but not well-behaved last's) |
896 | next, redo (but not well-behaved last's) |
|
|
897 | labels, if used |
| 859 | eval |
898 | eval |
| 860 | require |
899 | require |
| 861 | any use of formats |
900 | any use of formats |
| 862 | .., ... (flipflop operators) |
901 | .., ... (flipflop operators) |
| 863 | |
902 | |
