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

Comparing Faster/Faster.pm (file contents):
Revision 1.13 by root, Fri Mar 10 18:53:49 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";
… …
389 out_next; 420 out_next;
390} 421}
391 422
392sub op_grepstart { 423sub op_grepstart {
393 out_callop; 424 out_callop;
425 $op = $op->next;
394 out_cond_jump $op->next->other; 426 out_cond_jump $op->other;
395 out_jump_next; 427 out_jump_next;
396} 428}
397 429
398*op_mapstart = \&op_grepstart; 430*op_mapstart = \&op_grepstart;
399 431
… …
408 my ($idx) = @_; 440 my ($idx) = @_;
409 441
410 out_callop; 442 out_callop;
411 443
412 out_cond_jump $_->[$idx] 444 out_cond_jump $_->[$idx]
413 for reverse @loop; 445 for reverse @op_loop;
414 446
415 $source .= " return nextop;\n"; 447 $source .= " return nextop;\n";
416} 448}
417 449
418sub xop_next { 450sub xop_next {
… …
428} 460}
429 461
430sub cv2c { 462sub cv2c {
431 my ($cv) = @_; 463 my ($cv) = @_;
432 464
433 @loop = (); 465 local @ops;
466 local @op_loop;
467 local %op_regcomp;
434 468
435 my %opsseen; 469 my %opsseen;
436 my @todo = $cv->START; 470 my @todo = $cv->START;
437 471
438 while (my $op = shift @todo) { 472 while (my $op = shift @todo) {
… …
443 my $name = $op->name; 477 my $name = $op->name;
444 my $class = B::class $op; 478 my $class = B::class $op;
445 479
446 if ($class eq "LOGOP") { 480 if ($class eq "LOGOP") {
447 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
448 } elsif ($class eq "PMOP") { 487 } elsif ($class eq "PMOP") {
449 unshift @todo, $op->pmreplstart if ${$op->pmreplstart}; 488 unshift @todo, $op->pmreplstart if ${$op->pmreplstart};
489
450 } elsif ($class eq "LOOP") { 490 } elsif ($class eq "LOOP") {
451 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;
452 } 493 }
453 } 494 }
454 } 495 }
455 496
456 local $source = <<EOF; 497 local $source = <<EOF;

Diff Legend

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