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

Comparing Faster/Faster.pm (file contents):
Revision 1.16 by root, Fri Mar 10 18:58:31 2006 UTC vs.
Revision 1.18 by root, Fri Mar 10 19:52:07 2006 UTC

… …
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use Faster; 7 use Faster;
8 8
9 perl -MFaster ...
10
9=head1 DESCRIPTION 11=head1 DESCRIPTION
12
13This module implements a very simple-minded JIT. It works by more or less
14translating every function it sees into a C program, compiling it and then
15replacing the function by the compiled code.
16
17As a result, startup times are immense, as every function might lead to a
18full-blown compilation.
19
20The speed improvements are also not great, you can expect 20% or so on
21average, for code that runs very often.
22
23Faster 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
25immensely, but rarely cause bugs).
26
27Usage is very easy, just C<use Faster> and every function called from then
28on will be compiled.
29
30Right now, Faster will leave ltos of F<*.c>, F<*.o> and F<*.so> files in
31F</tmp>, and it will even create those temporary files in an insecure
32manner, so watch out.
10 33
11=over 4 34=over 4
12 35
13=cut 36=cut
14 37
… …
39 62
40my $opt_assert = 1; 63my $opt_assert = 1;
41 64
42our $source; 65our $source;
43 66
44my @ops; 67our @ops;
45my $op; 68our $op;
46my $op_name; 69our $op_name;
47my @loop; 70our @op_loop;
71our %op_regcomp;
48 72
49my %flag; 73my %flag;
50 74
51# complex flag steting is no longer required, rewrite this ugly code 75# complex flag steting is no longer required, rewrite this ugly code
52for (split /\n/, <<EOF) { 76for (split /\n/, <<EOF) {
… …
133 lt noasync 157 lt noasync
134 ge noasync 158 ge noasync
135 le noasync 159 le noasync
136 enteriter noasync 160 enteriter noasync
137 ord noasync 161 ord noasync
162 orassign noasync
163 regcomp noasync
164 regcreset noasync
165 regcmaybe noasync
138 166
139 iter async 167 iter async
140EOF 168EOF
141 my (undef, $op, @flags) = split /\s+/; 169 my (undef, $op, @flags) = split /\s+/;
142 170
… …
161sub out_callop { 189sub out_callop {
162 assert "nextop == (OP *)$$op"; 190 assert "nextop == (OP *)$$op";
163 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 191 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
164} 192}
165 193
194sub out_cond_jump {
195 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
196}
197
166sub out_jump_next { 198sub out_jump_next {
199 out_cond_jump $op_regcomp{$$op}
200 if $op_regcomp{$$op};
201
167 assert "nextop == (OP *)${$op->next}"; 202 assert "nextop == (OP *)${$op->next}";
168 $source .= " goto op_${$op->next};\n"; 203 $source .= " goto op_${$op->next};\n";
169} 204}
170 205
171sub out_next { 206sub out_next {
… …
175} 210}
176 211
177sub out_linear { 212sub out_linear {
178 out_callop; 213 out_callop;
179 out_jump_next; 214 out_jump_next;
180}
181
182sub out_cond_jump {
183 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
184} 215}
185 216
186sub op_entersub { 217sub op_entersub {
187 out_callop; 218 out_callop;
188 $source .= " RUNOPS_TILL ((OP *)${$op->next}L);\n"; 219 $source .= " RUNOPS_TILL ((OP *)${$op->next}L);\n";
… …
409 my ($idx) = @_; 440 my ($idx) = @_;
410 441
411 out_callop; 442 out_callop;
412 443
413 out_cond_jump $_->[$idx] 444 out_cond_jump $_->[$idx]
414 for reverse @loop; 445 for reverse @op_loop;
415 446
416 $source .= " return nextop;\n"; 447 $source .= " return nextop;\n";
417} 448}
418 449
419sub xop_next { 450sub xop_next {
… …
429} 460}
430 461
431sub cv2c { 462sub cv2c {
432 my ($cv) = @_; 463 my ($cv) = @_;
433 464
434 @loop = (); 465 local @ops;
466 local @op_loop;
467 local %op_regcomp;
435 468
436 my %opsseen; 469 my %opsseen;
437 my @todo = $cv->START; 470 my @todo = $cv->START;
438 471
439 while (my $op = shift @todo) { 472 while (my $op = shift @todo) {
… …
444 my $name = $op->name; 477 my $name = $op->name;
445 my $class = B::class $op; 478 my $class = B::class $op;
446 479
447 if ($class eq "LOGOP") { 480 if ($class eq "LOGOP") {
448 unshift @todo, $op->other; # unshift vs. push saves jumps 481 unshift @todo, $op->other; # unshift vs. push saves jumps
482
483 # regcomp/o patches ops at runtime, lets expect that
484 $op_regcomp{${$op->first}} = $op->next
485 if $name eq "regcomp" && $op->other->pmflags & B::PMf_KEEP;
486
449 } elsif ($class eq "PMOP") { 487 } elsif ($class eq "PMOP") {
450 unshift @todo, $op->pmreplstart if ${$op->pmreplstart}; 488 unshift @todo, $op->pmreplstart if ${$op->pmreplstart};
489
451 } elsif ($class eq "LOOP") { 490 } elsif ($class eq "LOOP") {
452 push @loop, [$op->nextop, $op->lastop->next, $op->redoop->next]; 491 push @op_loop, [$op->nextop, $op->lastop->next, $op->redoop->next];
492 push @todo, $op->nextop, $op->lastop->next, $op->redoop->next;
453 } 493 }
454 } 494 }
455 } 495 }
456 496
457 local $source = <<EOF; 497 local $source = <<EOF;

Diff Legend

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