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.25 by root, Sat Mar 11 04:58:53 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
10 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 lots 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.
33
11=over 4 34=over 4
12 35
13=cut 36=cut
14 37
15package Faster; 38package Faster;
39
40no warnings;
16 41
17use strict; 42use strict;
18use Config; 43use Config;
19use B (); 44use B ();
20use Digest::MD5 (); 45#use Digest::MD5 ();
21use DynaLoader (); 46use DynaLoader ();
47use File::Temp ();
22 48
23BEGIN { 49BEGIN {
24 our $VERSION = '0.01'; 50 our $VERSION = '0.01';
25 51
26 require XSLoader; 52 require XSLoader;
… …
35 61
36# we don't need no steenking PIC on x86 62# we don't need no steenking PIC on x86
37$COMPILE =~ s/-f(?:PIC|pic)//g 63$COMPILE =~ s/-f(?:PIC|pic)//g
38 if $Config{archname} =~ /^(i[3456]86)-/; 64 if $Config{archname} =~ /^(i[3456]86)-/;
39 65
40my $opt_assert = 1; 66my $opt_assert = $ENV{FASTER_DEBUG};
67my $verbose = $ENV{FASTER_VERBOSE}+0;
41 68
42our $source; 69our $source;
43 70
44my @ops; 71our @ops;
45my $op; 72our $insn;
73our $op;
46my $op_name; 74our $op_name;
47my @loop; 75our @op_loop;
76our %op_regcomp;
48 77
49my %flag; 78# ops that cause immediate return to the interpreter
79my %f_unsafe = map +($_ => undef), qw(
80 leavesub leavesublv return
81 goto last redo next
82 eval flip leaveeval entertry
83 formline grepstart mapstart
84 substcont entereval require
85);
50 86
51# complex flag steting is no longer required, rewrite this ugly code 87# ops with known stack extend behaviour
52for (split /\n/, <<EOF) { 88# the values given are maximum values
53 leavesub unsafe 89my %extend = (
54 leavesublv unsafe 90 pushmark => 0,
55 return unsafe 91 nextstate => 0, # might reduce the stack
56 flip unsafe 92 unstack => 0,
57 goto unsafe 93 enter => 0,
58 last unsafe
59 redo unsafe
60 next unsafe
61 eval unsafe
62 leaveeval unsafe
63 entertry unsafe
64 formline unsafe
65 grepstart unsafe
66 mapstart unsafe
67 substcont unsafe
68 entereval unsafe noasync todo
69 require unsafe
70 94
71 mapstart noasync 95 stringify => 0,
72 grepstart noasync 96 not => 0,
73 match noasync 97 and => 0,
98 or => 0,
99 gvsv => 0,
100 rv2gv => 0,
101 preinc => 0,
102 predec => 0,
103 postinc => 0,
104 postdec => 0,
105 aelem => 0,
106 helem => 0,
107 qr => 1, #???
108 pushre => 1,
109 gv => 1,
110 aelemfast => 1,
111 aelem => 0,
112 padsv => 1,
113 const => 1,
114 pop => 1,
115 shift => 1,
116 eq => -1,
117 ne => -1,
118 gt => -1,
119 lt => -1,
120 ge => -1,
121 lt => -1,
122 cond_expr => -1,
123 add => -1,
124 subtract => -1,
125 multiply => -1,
126 divide => -1,
127 aassign => 0,
128 sassign => -2,
129 method => 0,
130 method_named => 1,
131);
74 132
75 last noasync 133# ops that do not need an ASYNC_CHECK
76 next noasync 134my %f_noasync = map +($_ => undef), qw(
77 redo noasync 135 mapstart grepstart match entereval
78 seq noasync 136 enteriter entersub leaveloop
79 pushmark noasync extend=0
80 padsv noasync extend=1
81 padav noasync extend=1
82 padhv noasync extend=1
83 padany noasync extend=1
84 entersub noasync
85 aassign noasync
86 sassign noasync
87 rv2av noasync
88 rv2cv noasync
89 rv2gv noasync
90 rv2hv noasync
91 refgen noasync
92 nextstate noasync
93 gv noasync
94 gvsv noasync
95 add noasync
96 subtract noasync
97 multiply noasync
98 divide noasync
99 complement noasync
100 cond_expr noasync
101 and noasync
102 or noasync
103 not noasync
104 defined noasync
105 method_named noasync
106 preinc noasync
107 postinc noasync
108 predec noasync
109 postdec noasync
110 stub noasync
111 unstack noasync
112 leaveloop noasync
113 aelem noasync
114 aelemfast noasync
115 helem noasync
116 pushre noasync
117 subst noasync
118 const noasync extend=1
119 list noasync
120 join noasync
121 split noasync
122 concat noasync
123 push noasync
124 pop noasync
125 shift noasync
126 unshift noasync
127 length noasync
128 substr noasync
129 stringify noasync
130 eq noasync
131 ne noasync
132 gt noasync
133 lt noasync
134 ge noasync
135 le noasync
136 enteriter noasync
137 ord noasync
138 137
139 iter async 138 pushmark nextstate
140EOF
141 my (undef, $op, @flags) = split /\s+/;
142 139
143 undef $flag{$_}{$op} 140 const stub unstack
144 for ("known", @flags); 141 last next redo seq
145} 142 padsv padav padhv padany
143 aassign sassign orassign
144 rv2av rv2cv rv2gv rv2hv refgen
145 gv gvsv
146 add subtract multiply divide
147 complement cond_expr and or not
148 defined
149 method method_named bless
150 preinc postinc predec postdec
151 aelem aelemfast helem delete exists
152 pushre subst list join split concat
153 length substr stringify ord
154 push pop shift unshift
155 eq ne gt lt ge le
156 regcomp regcreset regcmaybe
157);
146 158
147my %callop = ( 159my %callop = (
148 entersub => "(PL_ppaddr [OP_ENTERSUB]) (aTHX)", 160 entersub => "(PL_ppaddr [OP_ENTERSUB]) (aTHX)",
149 mapstart => "Perl_pp_grepstart (aTHX)", 161 mapstart => "Perl_pp_grepstart (aTHX)",
150); 162);
… …
161sub out_callop { 173sub out_callop {
162 assert "nextop == (OP *)$$op"; 174 assert "nextop == (OP *)$$op";
163 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 175 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
164} 176}
165 177
178sub out_cond_jump {
179 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
180}
181
166sub out_jump_next { 182sub out_jump_next {
183 out_cond_jump $op_regcomp{$$op}
184 if $op_regcomp{$$op};
185
167 assert "nextop == (OP *)${$op->next}"; 186 assert "nextop == (OP *)${$op->next}";
168 $source .= " goto op_${$op->next};\n"; 187 $source .= " goto op_${$op->next};\n";
169} 188}
170 189
171sub out_next { 190sub out_next {
… …
175} 194}
176 195
177sub out_linear { 196sub out_linear {
178 out_callop; 197 out_callop;
179 out_jump_next; 198 out_jump_next;
180}
181
182sub out_cond_jump {
183 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
184} 199}
185 200
186sub op_entersub { 201sub op_entersub {
187 out_callop; 202 out_callop;
188 $source .= " RUNOPS_TILL ((OP *)${$op->next}L);\n"; 203 $source .= " RUNOPS_TILL ((OP *)${$op->next}L);\n";
… …
207 222
208if ($Config{useithreads} ne "define") { 223if ($Config{useithreads} ne "define") {
209 # disable optimisations on ithreads 224 # disable optimisations on ithreads
210 225
211 *op_const = sub { 226 *op_const = sub {
212 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; 227 $source .= " { dSP; PUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
213 228
214 out_next; 229 out_next;
215 }; 230 };
216 231
217 *op_gv = \&op_const; 232 *op_gv = \&op_const;
… …
237 if (!($op->flags & B::OPf_MOD)) { 252 if (!($op->flags & B::OPf_MOD)) {
238 $source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n"; 253 $source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
239 } 254 }
240 255
241 $source .= " dSP;\n"; 256 $source .= " dSP;\n";
242 $source .= " XPUSHs (sv);\n"; 257 $source .= " PUSHs (sv);\n";
243 $source .= " PUTBACK;\n"; 258 $source .= " PUTBACK;\n";
244 $source .= " }\n"; 259 $source .= " }\n";
245 260
246 out_next; 261 out_next;
247 }; 262 };
248 263
249 *op_gvsv = sub { 264 *op_gvsv = sub {
250 $source .= " {\n"; 265 $source .= " {\n";
251 $source .= " dSP;\n"; 266 $source .= " dSP;\n";
252 $source .= " EXTEND (SP, 1);\n";
253 267
254 if ($op->private & B::OPpLVAL_INTRO) { 268 if ($op->private & B::OPpLVAL_INTRO) {
255 $source .= " PUSHs (save_scalar ((GV *)${$op->sv}L));\n"; 269 $source .= " PUSHs (save_scalar ((GV *)${$op->sv}L));\n";
256 } else { 270 } else {
257 $source .= " PUSHs (GvSV ((GV *)${$op->sv}L));\n"; 271 $source .= " PUSHs (GvSV ((GV *)${$op->sv}L));\n";
… …
317 out_next; 331 out_next;
318} 332}
319 333
320sub op_padsv { 334sub op_padsv {
321 my $flags = $op->flags; 335 my $flags = $op->flags;
322 my $target = $op->targ; 336 my $padofs = "(PADOFFSET)" . $op->targ;
337
338 #d#TODO: why does our version break
339 # breaks gce with can't coerce array....
340 if (($flags & B::OPf_MOD) && ($op->private & B::OPpDEREF)) {#d#
341 return out_linear;#d#
342 }#d#
323 343
324 $source .= <<EOF; 344 $source .= <<EOF;
325 { 345 {
326 dSP; 346 dSP;
327 XPUSHs (PAD_SV ((PADOFFSET)$target)); 347 SV *sv = PAD_SVl ($padofs);
348EOF
349
350 if (($flags & B::OPf_MOD) && ($op->private & B::OPpLVAL_INTRO)) {
351 $source .= " SAVECLEARSV (PAD_SVl ($padofs));\n";
352 $ops[0]{pre_padsv_lval_intro}++ if @ops;#d#
353 }
354
355 $source .= <<EOF;
356 PUSHs (sv);
328 PUTBACK; 357 PUTBACK;
329EOF 358EOF
330 if ($op->flags & B::OPf_MOD) { 359
331 if ($op->private & B::OPpLVAL_INTRO) { 360 if (($flags & B::OPf_MOD) && ($op->private & B::OPpDEREF)) {
332 $source .= " SAVECLEARSV (PAD_SVl ((PADOFFSET)$target));\n"; 361 $source .= " vivify_ref (sv, $flags & OPpDEREF);\n";
333 } elsif ($op->private & B::OPpDEREF) {
334 my $deref = $op->private & B::OPpDEREF;
335 $source .= " Perl_vivify_ref (PAD_SVl ((PADOFFSET)$target), $deref);\n";
336 }
337 } 362 }
363 $source .= " }\n";
364
365 out_next;
366}
367
368sub op_sassign {
369 $source .= <<EOF;
370 {
371 dSP;
372 dPOPTOPssrl;
373EOF
374 $source .= " SV *temp = left; left = right; right = temp;\n"
375 if $op->private & B::OPpASSIGN_BACKWARDS;
376
377 if ($insn->{pre_padsv_lval_intro} && !($op->private & B::OPpASSIGN_BACKWARDS)) {
378 # simple assignment - the target exists, but is basically undef
379 $source .= " SvSetSV (right, left);\n";
380 } else {
381 $source .= " SvSetMagicSV (right, left);\n";
382 }
383
338 $source .= <<EOF; 384 $source .= <<EOF;
385 SETs (right);
386 PUTBACK;
339 } 387 }
340EOF 388EOF
341 389
342 out_next; 390 out_next;
343} 391}
344 392
345# pattern const+ (or general push1) 393# pattern const+ (or general push1)
346# pattern pushmark return(?) 394# pattern pushmark return(?)
347# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign 395# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign
… …
363 411
364 /* simple "polymorphic" inline cache */ 412 /* simple "polymorphic" inline cache */
365 if (stash == last_stash 413 if (stash == last_stash
366 && PL_sub_generation == last_sub_generation) 414 && PL_sub_generation == last_sub_generation)
367 { 415 {
368 XPUSHs (last_cv); 416 PUSHs (last_cv);
369 PUTBACK; 417 PUTBACK;
370 } 418 }
371 else 419 else
372 { 420 {
373 PL_op = nextop; nextop = Perl_pp_method_named (aTHX); 421 PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
… …
409 my ($idx) = @_; 457 my ($idx) = @_;
410 458
411 out_callop; 459 out_callop;
412 460
413 out_cond_jump $_->[$idx] 461 out_cond_jump $_->[$idx]
414 for reverse @loop; 462 for reverse @op_loop;
415 463
416 $source .= " return nextop;\n"; 464 $source .= " return nextop;\n";
417} 465}
418 466
419sub xop_next { 467sub xop_next {
… …
429} 477}
430 478
431sub cv2c { 479sub cv2c {
432 my ($cv) = @_; 480 my ($cv) = @_;
433 481
434 @loop = (); 482 local @ops;
483 local @op_loop;
484 local %op_regcomp;
435 485
436 my %opsseen; 486 my %opsseen;
437 my @todo = $cv->START; 487 my @todo = $cv->START;
488 my %op_target;
438 489
439 while (my $op = shift @todo) { 490 while (my $op = shift @todo) {
440 for (; $$op; $op = $op->next) { 491 for (; $$op; $op = $op->next) {
441 last if $opsseen{$$op}++; 492 last if $opsseen{$$op}++;
442 push @ops, $op;
443 493
444 my $name = $op->name; 494 my $name = $op->name;
445 my $class = B::class $op; 495 my $class = B::class $op;
446 496
497 my $insn = { op => $op };
498
499 push @ops, $insn;
500
501 if (exists $extend{$name}) {
502 my $extend = $extend{$name};
503 $extend = $extend->($op) if ref $extend;
504 $insn->{extend} = $extend if defined $extend;
505 }
506
507 push @todo, $op->next;
508
447 if ($class eq "LOGOP") { 509 if ($class eq "LOGOP") {
448 unshift @todo, $op->other; # unshift vs. push saves jumps 510 push @todo, $op->other;
511 $op_target{${$op->other}}++;
512
513 # regcomp/o patches ops at runtime, lets expect that
514 if ($name eq "regcomp" && $op->other->pmflags & B::PMf_KEEP) {
515 $op_target{${$op->first}}++;
516 $op_regcomp{${$op->first}} = $op->next;
517 }
518
449 } elsif ($class eq "PMOP") { 519 } elsif ($class eq "PMOP") {
520 if (${$op->pmreplstart}) {
450 unshift @todo, $op->pmreplstart if ${$op->pmreplstart}; 521 unshift @todo, $op->pmreplstart;
522 $op_target{${$op->pmreplstart}}++;
523 }
524
451 } elsif ($class eq "LOOP") { 525 } elsif ($class eq "LOOP") {
452 push @loop, [$op->nextop, $op->lastop->next, $op->redoop->next]; 526 my @targ = ($op->nextop, $op->lastop->next, $op->redoop->next);
527
528 push @op_loop, \@targ;
529 push @todo, @targ;
530
531 $op_target{$$_}++ for @targ;
532 } elsif ($class eq "COP") {
533 $insn->{bblock}++ if defined $op->label;
453 } 534 }
454 } 535 }
455 } 536 }
537
538 $_->{bblock}++ for grep $op_target{${$_->{op}}}, @ops;
456 539
457 local $source = <<EOF; 540 local $source = <<EOF;
458OP *%%%FUNC%%% (pTHX) 541OP *%%%FUNC%%% (pTHX)
459{ 542{
460 register OP *nextop = (OP *)${$ops[0]}L; 543 register OP *nextop = (OP *)${$ops[0]->{op}}L;
461EOF 544EOF
462 545
463 while (@ops) { 546 while (@ops) {
464 $op = shift @ops; 547 $insn = shift @ops;
548
549 $op = $insn->{op};
465 $op_name = $op->name; 550 $op_name = $op->name;
466 551
552 my $class = B::class $op;
553
554 $source .= "\n/* start basic block */\n" if exists $insn->{bblock};#d#
467 $source .= "op_$$op: /* $op_name */\n"; 555 $source .= "op_$$op: /* $op_name */\n";
468 #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d# 556 #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d#
469 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d# 557 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
470 558
471 $source .= " PERL_ASYNC_CHECK ();\n" 559 $source .= " PERL_ASYNC_CHECK ();\n"
472 unless exists $flag{noasync}{$op_name}; 560 unless exists $f_noasync{$op_name};
473 561
474 if (my $can = __PACKAGE__->can ("op_$op_name")) { 562 if (my $can = __PACKAGE__->can ("op_$op_name")) {
475 # handcrafted replacement 563 # handcrafted replacement
564
565 if ($insn->{extend} > 0) {
566 # coalesce EXTENDs
567 # TODO: properly take negative preceeding and following EXTENDs into account
568 for my $i (@ops) {
569 last if exists $i->{bblock};
570 last unless exists $i->{extend};
571 my $extend = delete $i->{extend};
572 $insn->{extend} += $extend if $extend > 0;
573 }
574
575 $source .= " { dSP; EXTEND (SP, $insn->{extend}); PUTBACK; }\n"
576 if $insn->{extend} > 0;
577 }
578
476 $can->($op); 579 $can->($op);
477 580
478 } elsif (exists $flag{unsafe}{$op_name}) { 581 } elsif (exists $f_unsafe{$op_name}) {
479 # unsafe, return to interpreter 582 # unsafe, return to interpreter
480 assert "nextop == (OP *)$$op"; 583 assert "nextop == (OP *)$$op";
481 $source .= " return nextop;\n"; 584 $source .= " return nextop;\n";
482 585
483 } elsif ("LOGOP" eq B::class $op) { 586 } elsif ("LOGOP" eq $class) {
484 # logical operation with optionaö branch 587 # logical operation with optional branch
485 out_callop; 588 out_callop;
486 out_cond_jump $op->other; 589 out_cond_jump $op->other;
487 out_jump_next; 590 out_jump_next;
488 591
489 } elsif ("PMOP" eq B::class $op) { 592 } elsif ("PMOP" eq $class) {
490 # regex-thingy 593 # regex-thingy
491 out_callop; 594 out_callop;
492 out_cond_jump $op->pmreplroot if ${$op->pmreplroot}; 595 out_cond_jump $op->pmreplroot if $op_name ne "pushre" && ${$op->pmreplroot};
493 out_jump_next; 596 out_jump_next;
494 597
495 } else { 598 } else {
496 # normal operator, linear execution 599 # normal operator, linear execution
497 out_linear; 600 out_linear;
… …
508 #warn $source; 611 #warn $source;
509 612
510 $source 613 $source
511} 614}
512 615
616my $uid = "aaaaaaa0";
617
513sub source2ptr { 618sub source2ptr {
514 my ($source) = @_; 619 my (@source) = @_;
515 620
516 my $md5 = Digest::MD5::md5_hex $source; 621 my $stem = "/tmp/Faster-$$-" . $uid++;
517 $source =~ s/%%%FUNC%%%/Faster_$md5/;
518 622
519 my $stem = "/tmp/$md5";
520
521 unless (-e "$stem$_so") {
522 open FILE, ">:raw", "$stem.c"; 623 open FILE, ">:raw", "$stem.c";
523 print FILE <<EOF; 624 print FILE <<EOF;
524#define PERL_NO_GET_CONTEXT 625#define PERL_NO_GET_CONTEXT
626#define PERL_CORE
525 627
526#include <assert.h> 628#include <assert.h>
527 629
528#include "EXTERN.h" 630#include "EXTERN.h"
529#include "perl.h" 631#include "perl.h"
530#include "XSUB.h" 632#include "XSUB.h"
531 633
532#define RUNOPS_TILL(op) \\ 634#define RUNOPS_TILL(op) \\
533 while (nextop != (op)) \\ 635while (nextop != (op)) \\
534 { \\ 636 { \\
535 PERL_ASYNC_CHECK (); \\ 637 PERL_ASYNC_CHECK (); \\
536 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\ 638 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\
537 } 639 }
538 640
539EOF 641EOF
642 for (@source) {
643 my $func = $uid++;
644 $_ =~ s/%%%FUNC%%%/$func/g;
540 print FILE $source; 645 print FILE $_;
541 close FILE; 646 $_ = $func;
542 system "$COMPILE -o $stem$_o $stem.c";
543 system "$LINK -o $stem$_so $stem$_o $LIBS";
544 } 647 }
545 648
546# warn $source; 649 close FILE;
650 system "$COMPILE -o $stem$_o $stem.c";
651 #d#unlink "$stem.c";
652 system "$LINK -o $stem$_so $stem$_o $LIBS";
653 unlink "$stem$_o";
654
547 my $so = DynaLoader::dl_load_file "$stem$_so" 655 my $so = DynaLoader::dl_load_file "$stem$_so"
548 or die "$stem$_so: $!"; 656 or die "$stem$_so: $!";
549 657
550 DynaLoader::dl_find_symbol $so, "Faster_$md5" 658 #unlink "$stem$_so";
551 or die "Faster_$md5: $!" 659
660 map +(DynaLoader::dl_find_symbol $so, $_), @source
552} 661}
662
663my %ignore;
553 664
554sub entersub { 665sub entersub {
555 my ($cv) = @_; 666 my ($cv) = @_;
556 667
557 # always compile the whole stash 668 my $pkg = $cv->STASH->NAME;
558# my @stash = $cv->STASH->ARRAY; 669
559# warn join ":", @stash; 670 return if $ignore{$pkg};
560# exit; 671
672 warn "compiling ", $cv->STASH->NAME, "\n"
673 if $verbose;
561 674
562 eval { 675 eval {
563 my $source = cv2c $cv; 676 my @cv;
677 my @cv_source;
564 678
679 # always compile the whole stash
680 my %stash = $cv->STASH->ARRAY;
681 while (my ($k, $v) = each %stash) {
682 $v->isa (B::GV::)
683 or next;
684
685 my $cv = $v->CV;
686
687 if ($cv->isa (B::CV::)
688 && ${$cv->START}
689 && $cv->START->name ne "null") {
690 push @cv, $cv;
691 push @cv_source, cv2c $cv;
692 }
693 }
694
565 my $ptr = source2ptr $source; 695 my @ptr = source2ptr @cv_source;
566 696
697 for (0 .. $#cv) {
567 patch_cv $cv, $ptr; 698 patch_cv $cv[$_], $ptr[$_];
699 }
568 }; 700 };
569 701
570 warn $@ if $@; 702 if ($@) {
703 $ignore{$pkg}++;
704 warn $@;
705 }
571} 706}
572 707
573hook_entersub; 708hook_entersub;
574 709
5751; 7101;
711
712=back
713
714=head1 ENVIRONMENT VARIABLES
715
716The following environment variables influence the behaviour of Faster:
717
718=over 4
719
720=item FASTER_VERBOSE
721
722Faster will output more informational messages when set to values higher
723than C<0>. Currently, C<1> outputs which packages are being compiled.
724
725=item FASTER_DEBUG
726
727Add debugging code when set to values higher than C<0>. Currently, this
728adds 1-3 C<assert>'s per perl op, to ensure that opcode order and C
729execution order are compatible.
730
731=item FASTER_CACHE
732
733NOT YET IMPLEMENTED
734
735Set a persistent cache directory that caches compiled code
736fragments. Normally, code compiled by Faster will be deleted immediately,
737and every restart will recompile everything. Setting this variable to a
738directory makes Faster cache the generated files for re-use.
739
740This directory will always grow in contents, so you might need to erase it
741from time to time.
576 742
577=back 743=back
578 744
579=head1 BUGS/LIMITATIONS 745=head1 BUGS/LIMITATIONS
580 746
581Perl will check much less often for asynchronous signals in 747Perl will check much less often for asynchronous signals in
582Faster-compiled code. It tries to check on every function call, loop 748Faster-compiled code. It tries to check on every function call, loop
583iteration and every I/O operator, though. 749iteration and every I/O operator, though.
584 750
585The following things will disable Faster. If you manage to enable them at 751The following things will disable Faster. If you manage to enable them at
586runtime, bad things will happen. 752runtime, bad things will happen. Enabling them at startup will be fine,
753though.
587 754
588 enabled tainting 755 enabled tainting
589 enabled debugging 756 enabled debugging
590 757
591This will dramatically reduce Faster's performance: 758Thread-enabled builds of perl will dramatically reduce Faster's
759performance, but you don't care about speed if you enable threads anyway.
592 760
593 threads (but you don't care about speed if you use threads anyway)
594
595These constructs will force the use of the interpreter as soon as they are 761These constructs will force the use of the interpreter for the currently
596being executed, for the rest of the currently executed: 762executed function as soon as they are being encountered during execution.
597 763
598 .., ... (flipflop operators)
599 goto 764 goto
600 next, redo (but not well-behaved last's) 765 next, redo (but not well-behaved last's)
601 eval 766 eval
602 require 767 require
603 any use of formats 768 any use of formats
769 .., ... (flipflop operators)
604 770
605=head1 AUTHOR 771=head1 AUTHOR
606 772
607 Marc Lehmann <schmorp@schmorp.de> 773 Marc Lehmann <schmorp@schmorp.de>
608 http://home.schmorp.de/ 774 http://home.schmorp.de/

Diff Legend

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