ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.pm
Revision: 1.27
Committed: Sat Mar 11 23:06:59 2006 UTC (18 years, 3 months ago) by root
Branch: MAIN
Changes since 1.26: +72 -37 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 =head1 NAME
2    
3     Faster - do some things faster
4    
5     =head1 SYNOPSIS
6    
7     use Faster;
8    
9 root 1.18 perl -MFaster ...
10    
11 root 1.1 =head1 DESCRIPTION
12    
13 root 1.18 This module implements a very simple-minded JIT. It works by more or less
14     translating every function it sees into a C program, compiling it and then
15     replacing the function by the compiled code.
16    
17     As a result, startup times are immense, as every function might lead to a
18     full-blown compilation.
19    
20     The speed improvements are also not great, you can expect 20% or so on
21     average, for code that runs very often.
22    
23     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
25     immensely, but rarely cause bugs).
26    
27     Usage is very easy, just C<use Faster> and every function called from then
28     on will be compiled.
29    
30 root 1.19 Right now, Faster will leave lots of F<*.c>, F<*.o> and F<*.so> files in
31 root 1.18 F</tmp>, and it will even create those temporary files in an insecure
32     manner, so watch out.
33    
34 root 1.1 =over 4
35    
36     =cut
37    
38     package Faster;
39    
40 root 1.24 no warnings;
41    
42 root 1.1 use strict;
43 root 1.4 use Config;
44     use B ();
45 root 1.19 #use Digest::MD5 ();
46 root 1.4 use DynaLoader ();
47 root 1.27 use Digest::MD5 ();
48     use Storable ();
49 root 1.1
50     BEGIN {
51     our $VERSION = '0.01';
52    
53     require XSLoader;
54     XSLoader::load __PACKAGE__, $VERSION;
55     }
56    
57 root 1.27 my $CACHEDIR = $ENV{FASTER_CACHE} || do {
58     require File::Temp;
59     File::Temp::tempdir (CLEANUP => 1)
60     };
61    
62 root 1.4 my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}";
63     my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
64     my $LIBS = "$Config{libs}";
65     my $_o = $Config{_o};
66     my $_so = ".so";
67 root 1.1
68 root 1.13 # we don't need no steenking PIC on x86
69     $COMPILE =~ s/-f(?:PIC|pic)//g
70     if $Config{archname} =~ /^(i[3456]86)-/;
71    
72 root 1.21 my $opt_assert = $ENV{FASTER_DEBUG};
73     my $verbose = $ENV{FASTER_VERBOSE}+0;
74 root 1.11
75 root 1.1 our $source;
76    
77 root 1.18 our @ops;
78 root 1.24 our $insn;
79 root 1.18 our $op;
80     our $op_name;
81     our @op_loop;
82     our %op_regcomp;
83 root 1.8
84 root 1.24 # ops that cause immediate return to the interpreter
85 root 1.20 my %f_unsafe = map +($_ => undef), qw(
86     leavesub leavesublv return
87     goto last redo next
88     eval flip leaveeval entertry
89     formline grepstart mapstart
90     substcont entereval require
91     );
92 root 1.2
93 root 1.24 # ops with known stack extend behaviour
94     # the values given are maximum values
95     my %extend = (
96     pushmark => 0,
97     nextstate => 0, # might reduce the stack
98     unstack => 0,
99     enter => 0,
100    
101     stringify => 0,
102     not => 0,
103     and => 0,
104     or => 0,
105     gvsv => 0,
106     rv2gv => 0,
107     preinc => 0,
108     predec => 0,
109     postinc => 0,
110     postdec => 0,
111     aelem => 0,
112     helem => 0,
113     qr => 1, #???
114     pushre => 1,
115     gv => 1,
116     aelemfast => 1,
117     aelem => 0,
118     padsv => 1,
119     const => 1,
120     pop => 1,
121     shift => 1,
122     eq => -1,
123     ne => -1,
124     gt => -1,
125     lt => -1,
126     ge => -1,
127     lt => -1,
128     cond_expr => -1,
129     add => -1,
130     subtract => -1,
131     multiply => -1,
132     divide => -1,
133     aassign => 0,
134     sassign => -2,
135     method => 0,
136     method_named => 1,
137     );
138 root 1.20
139 root 1.24 # ops that do not need an ASYNC_CHECK
140 root 1.20 my %f_noasync = map +($_ => undef), qw(
141     mapstart grepstart match entereval
142     enteriter entersub leaveloop
143    
144     pushmark nextstate
145    
146     const stub unstack
147     last next redo seq
148     padsv padav padhv padany
149     aassign sassign orassign
150     rv2av rv2cv rv2gv rv2hv refgen
151     gv gvsv
152     add subtract multiply divide
153     complement cond_expr and or not
154     defined
155 root 1.24 method method_named bless
156 root 1.20 preinc postinc predec postdec
157     aelem aelemfast helem delete exists
158     pushre subst list join split concat
159     length substr stringify ord
160     push pop shift unshift
161     eq ne gt lt ge le
162     regcomp regcreset regcmaybe
163     );
164 root 1.2
165 root 1.11 my %callop = (
166 root 1.26 entersub => "(PL_op->op_ppaddr) (aTHX)",
167 root 1.11 mapstart => "Perl_pp_grepstart (aTHX)",
168     );
169    
170 root 1.8 sub callop {
171 root 1.11 $callop{$op_name} || "Perl_pp_$op_name (aTHX)"
172     }
173    
174     sub assert {
175     return unless $opt_assert;
176     $source .= " assert ((\"$op_name\", ($_[0])));\n";
177     }
178    
179     sub out_callop {
180     assert "nextop == (OP *)$$op";
181     $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
182 root 1.8 }
183    
184 root 1.18 sub out_cond_jump {
185     $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
186     }
187    
188 root 1.11 sub out_jump_next {
189 root 1.18 out_cond_jump $op_regcomp{$$op}
190     if $op_regcomp{$$op};
191    
192 root 1.11 assert "nextop == (OP *)${$op->next}";
193     $source .= " goto op_${$op->next};\n";
194 root 1.2 }
195    
196 root 1.9 sub out_next {
197     $source .= " nextop = (OP *)${$op->next}L;\n";
198    
199 root 1.11 out_jump_next;
200 root 1.9 }
201    
202 root 1.8 sub out_linear {
203 root 1.11 out_callop;
204     out_jump_next;
205     }
206    
207     sub op_entersub {
208     out_callop;
209     $source .= " RUNOPS_TILL ((OP *)${$op->next}L);\n";
210     out_jump_next;
211 root 1.4 }
212    
213 root 1.11 *op_require = \&op_entersub;
214    
215 root 1.2 sub op_nextstate {
216 root 1.4 $source .= " PL_curcop = (COP *)nextop;\n";
217 root 1.2 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n";
218     $source .= " FREETMPS;\n";
219    
220 root 1.8 out_next;
221 root 1.2 }
222    
223 root 1.3 sub op_pushmark {
224     $source .= " PUSHMARK (PL_stack_sp);\n";
225    
226 root 1.8 out_next;
227 root 1.3 }
228    
229 root 1.13 if ($Config{useithreads} ne "define") {
230 root 1.8 # disable optimisations on ithreads
231    
232     *op_const = sub {
233 root 1.24 $source .= " { dSP; PUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
234 root 1.8
235 root 1.26 $ops[0]{follows_const}++ if @ops;#d#
236    
237 root 1.8 out_next;
238     };
239    
240     *op_gv = \&op_const;
241    
242     *op_aelemfast = sub {
243     my $targ = $op->targ;
244     my $private = $op->private;
245    
246     $source .= " {\n";
247    
248     if ($op->flags & B::OPf_SPECIAL) {
249     $source .= " AV *av = (AV*)PAD_SV((PADOFFSET)$targ);\n";
250     } else {
251     $source .= " AV *av = GvAV ((GV *)${$op->sv}L);\n";
252     }
253    
254     if ($op->flags & B::OPf_MOD) {
255     $source .= " SV *sv = *av_fetch (av, $private, 1);\n";
256     } else {
257     $source .= " SV **svp = av_fetch (av, $private, 0); SV *sv = svp ? *svp : &PL_sv_undef;\n";
258     }
259    
260     if (!($op->flags & B::OPf_MOD)) {
261     $source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
262     }
263    
264     $source .= " dSP;\n";
265 root 1.24 $source .= " PUSHs (sv);\n";
266 root 1.8 $source .= " PUTBACK;\n";
267     $source .= " }\n";
268    
269     out_next;
270     };
271 root 1.2
272 root 1.8 *op_gvsv = sub {
273     $source .= " {\n";
274     $source .= " dSP;\n";
275 root 1.2
276 root 1.8 if ($op->private & B::OPpLVAL_INTRO) {
277     $source .= " PUSHs (save_scalar ((GV *)${$op->sv}L));\n";
278     } else {
279     $source .= " PUSHs (GvSV ((GV *)${$op->sv}L));\n";
280     }
281    
282     $source .= " PUTBACK;\n";
283     $source .= " }\n";
284    
285     out_next;
286     };
287 root 1.2 }
288    
289 root 1.12 # does kill Crossfire/res2pm
290     sub op_stringify {
291     my $targ = $op->targ;
292    
293     $source .= <<EOF;
294     {
295     dSP;
296     SV *targ = PAD_SV ((PADOFFSET)$targ);
297     sv_copypv (TARG, TOPs);
298     SETTARG;
299     PUTBACK;
300     }
301     EOF
302 root 1.3
303 root 1.8 out_next;
304 root 1.3 }
305    
306 root 1.4 sub op_and {
307     $source .= <<EOF;
308     {
309     dSP;
310 root 1.5
311 root 1.4 if (SvTRUE (TOPs))
312     {
313     --SP;
314     PUTBACK;
315     nextop = (OP *)${$op->other}L;
316     goto op_${$op->other};
317     }
318     }
319     EOF
320 root 1.5
321 root 1.8 out_next;
322 root 1.4 }
323    
324 root 1.7 sub op_or {
325     $source .= <<EOF;
326     {
327     dSP;
328    
329     if (!SvTRUE (TOPs))
330     {
331     --SP;
332     PUTBACK;
333     nextop = (OP *)${$op->other}L;
334     goto op_${$op->other};
335     }
336     }
337     EOF
338    
339 root 1.8 out_next;
340 root 1.7 }
341    
342 root 1.4 sub op_padsv {
343     my $flags = $op->flags;
344 root 1.24 my $padofs = "(PADOFFSET)" . $op->targ;
345    
346 root 1.4 $source .= <<EOF;
347     {
348     dSP;
349 root 1.24 SV *sv = PAD_SVl ($padofs);
350     EOF
351    
352     if (($flags & B::OPf_MOD) && ($op->private & B::OPpLVAL_INTRO)) {
353     $source .= " SAVECLEARSV (PAD_SVl ($padofs));\n";
354 root 1.26 $ops[0]{follows_padsv_lval_intro}++ if @ops;#d#
355 root 1.24 }
356    
357     $source .= <<EOF;
358     PUSHs (sv);
359 root 1.4 PUTBACK;
360     EOF
361 root 1.24
362     if (($flags & B::OPf_MOD) && ($op->private & B::OPpDEREF)) {
363 root 1.27 $source .= " if (!SvROK (sv)) vivify_ref (sv, " . $op->private . " & OPpDEREF);\n";
364 root 1.24 }
365     $source .= " }\n";
366    
367     out_next;
368     }
369    
370     sub op_sassign {
371     $source .= <<EOF;
372     {
373     dSP;
374     dPOPTOPssrl;
375     EOF
376     $source .= " SV *temp = left; left = right; right = temp;\n"
377     if $op->private & B::OPpASSIGN_BACKWARDS;
378    
379 root 1.26 if ($insn->{follows_padsv_lval_intro} && !($op->private & B::OPpASSIGN_BACKWARDS)) {
380 root 1.24 # simple assignment - the target exists, but is basically undef
381     $source .= " SvSetSV (right, left);\n";
382     } else {
383     $source .= " SvSetMagicSV (right, left);\n";
384 root 1.4 }
385 root 1.24
386 root 1.4 $source .= <<EOF;
387 root 1.24 SETs (right);
388     PUTBACK;
389 root 1.4 }
390     EOF
391    
392 root 1.24 out_next;
393 root 1.6 }
394    
395 root 1.3 # pattern const+ (or general push1)
396     # pattern pushmark gv rv2av pushmark padsv+o.รค. aassign
397    
398 root 1.12 sub op_method_named {
399 root 1.26 if ($insn->{follows_const}) {
400     $source .= <<EOF;
401     {
402     dSP;
403     static SV *last_cv;
404     static U32 last_sub_generation;
405    
406     /* simple "polymorphic" inline cache */
407     if (PL_sub_generation == last_sub_generation)
408     {
409     PUSHs (last_cv);
410     PUTBACK;
411     }
412     else
413     {
414     PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
415    
416     SPAGAIN;
417     last_sub_generation = PL_sub_generation;
418     last_cv = TOPs;
419     }
420     }
421     EOF
422     } else {
423     $source .= <<EOF;
424 root 1.3 {
425 root 1.4 static HV *last_stash;
426 root 1.11 static SV *last_cv;
427     static U32 last_sub_generation;
428 root 1.4
429     SV *obj = *(PL_stack_base + TOPMARK + 1);
430 root 1.3
431 root 1.11 if (!SvGMAGICAL (obj) && SvROK (obj) && SvOBJECT (SvRV (obj)))
432 root 1.3 {
433 root 1.4 dSP;
434     HV *stash = SvSTASH (SvRV (obj));
435 root 1.3
436 root 1.4 /* simple "polymorphic" inline cache */
437 root 1.11 if (stash == last_stash
438     && PL_sub_generation == last_sub_generation)
439 root 1.3 {
440 root 1.24 PUSHs (last_cv);
441 root 1.4 PUTBACK;
442 root 1.3 }
443     else
444     {
445 root 1.11 PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
446 root 1.4
447 root 1.3 SPAGAIN;
448 root 1.11 last_sub_generation = PL_sub_generation;
449     last_stash = stash;
450     last_cv = TOPs;
451 root 1.3 }
452     }
453 root 1.4 else
454     {
455     /* error case usually */
456 root 1.11 PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
457 root 1.4 }
458 root 1.3 }
459     EOF
460 root 1.26 }
461 root 1.3
462 root 1.8 out_next;
463 root 1.3 }
464    
465 root 1.11 sub op_grepstart {
466     out_callop;
467 root 1.14 $op = $op->next;
468     out_cond_jump $op->other;
469 root 1.11 out_jump_next;
470     }
471    
472     *op_mapstart = \&op_grepstart;
473    
474     sub op_substcont {
475     out_callop;
476     out_cond_jump $op->other->pmreplstart;
477     assert "nextop == (OP *)${$op->other->next}L";
478     $source .= " goto op_${$op->other->next};\n";
479     }
480    
481     sub out_break_op {
482     my ($idx) = @_;
483    
484     out_callop;
485    
486     out_cond_jump $_->[$idx]
487 root 1.18 for reverse @op_loop;
488 root 1.11
489     $source .= " return nextop;\n";
490     }
491    
492     sub xop_next {
493     out_break_op 0;
494     }
495    
496     sub op_last {
497     out_break_op 1;
498     }
499    
500     sub xop_redo {
501     out_break_op 2;
502     }
503    
504 root 1.4 sub cv2c {
505 root 1.1 my ($cv) = @_;
506    
507 root 1.18 local @ops;
508     local @op_loop;
509     local %op_regcomp;
510 root 1.11
511 root 1.1 my %opsseen;
512     my @todo = $cv->START;
513 root 1.24 my %op_target;
514 root 1.1
515     while (my $op = shift @todo) {
516     for (; $$op; $op = $op->next) {
517     last if $opsseen{$$op}++;
518 root 1.11
519 root 1.1 my $name = $op->name;
520 root 1.11 my $class = B::class $op;
521    
522 root 1.24 my $insn = { op => $op };
523    
524     push @ops, $insn;
525    
526     if (exists $extend{$name}) {
527     my $extend = $extend{$name};
528     $extend = $extend->($op) if ref $extend;
529     $insn->{extend} = $extend if defined $extend;
530     }
531    
532     push @todo, $op->next;
533    
534 root 1.11 if ($class eq "LOGOP") {
535 root 1.24 push @todo, $op->other;
536     $op_target{${$op->other}}++;
537 root 1.18
538     # regcomp/o patches ops at runtime, lets expect that
539 root 1.24 if ($name eq "regcomp" && $op->other->pmflags & B::PMf_KEEP) {
540     $op_target{${$op->first}}++;
541     $op_regcomp{${$op->first}} = $op->next;
542     }
543 root 1.18
544 root 1.11 } elsif ($class eq "PMOP") {
545 root 1.24 if (${$op->pmreplstart}) {
546     unshift @todo, $op->pmreplstart;
547     $op_target{${$op->pmreplstart}}++;
548     }
549 root 1.18
550 root 1.11 } elsif ($class eq "LOOP") {
551 root 1.24 my @targ = ($op->nextop, $op->lastop->next, $op->redoop->next);
552    
553     push @op_loop, \@targ;
554     push @todo, @targ;
555    
556     $op_target{$$_}++ for @targ;
557     } elsif ($class eq "COP") {
558     $insn->{bblock}++ if defined $op->label;
559 root 1.1 }
560     }
561     }
562    
563 root 1.24 $_->{bblock}++ for grep $op_target{${$_->{op}}}, @ops;
564    
565 root 1.4 local $source = <<EOF;
566     OP *%%%FUNC%%% (pTHX)
567     {
568 root 1.24 register OP *nextop = (OP *)${$ops[0]->{op}}L;
569 root 1.4 EOF
570 root 1.2
571 root 1.8 while (@ops) {
572 root 1.24 $insn = shift @ops;
573    
574     $op = $insn->{op};
575 root 1.8 $op_name = $op->name;
576 root 1.2
577 root 1.23 my $class = B::class $op;
578    
579 root 1.24 $source .= "\n/* start basic block */\n" if exists $insn->{bblock};#d#
580 root 1.8 $source .= "op_$$op: /* $op_name */\n";
581     #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d#
582 root 1.4 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
583    
584 root 1.11 $source .= " PERL_ASYNC_CHECK ();\n"
585 root 1.20 unless exists $f_noasync{$op_name};
586 root 1.2
587 root 1.8 if (my $can = __PACKAGE__->can ("op_$op_name")) {
588 root 1.11 # handcrafted replacement
589 root 1.24
590     if ($insn->{extend} > 0) {
591     # coalesce EXTENDs
592     # TODO: properly take negative preceeding and following EXTENDs into account
593     for my $i (@ops) {
594     last if exists $i->{bblock};
595     last unless exists $i->{extend};
596     my $extend = delete $i->{extend};
597     $insn->{extend} += $extend if $extend > 0;
598     }
599    
600     $source .= " { dSP; EXTEND (SP, $insn->{extend}); PUTBACK; }\n"
601     if $insn->{extend} > 0;
602     }
603    
604 root 1.2 $can->($op);
605 root 1.11
606 root 1.20 } elsif (exists $f_unsafe{$op_name}) {
607 root 1.11 # unsafe, return to interpreter
608     assert "nextop == (OP *)$$op";
609 root 1.9 $source .= " return nextop;\n";
610 root 1.11
611 root 1.23 } elsif ("LOGOP" eq $class) {
612     # logical operation with optional branch
613 root 1.11 out_callop;
614     out_cond_jump $op->other;
615     out_jump_next;
616    
617 root 1.23 } elsif ("PMOP" eq $class) {
618 root 1.11 # regex-thingy
619     out_callop;
620 root 1.23 out_cond_jump $op->pmreplroot if $op_name ne "pushre" && ${$op->pmreplroot};
621 root 1.11 out_jump_next;
622    
623 root 1.2 } else {
624 root 1.11 # normal operator, linear execution
625 root 1.8 out_linear;
626 root 1.2 }
627 root 1.1 }
628 root 1.2
629 root 1.11 $op_name = "func exit"; assert (0);
630    
631     $source .= <<EOF;
632     op_0:
633     return 0;
634     }
635     EOF
636 root 1.4 #warn $source;
637 root 1.2
638 root 1.4 $source
639     }
640    
641 root 1.19 my $uid = "aaaaaaa0";
642 root 1.27 my %so;
643    
644     sub func2ptr {
645     my (@func) = @_;
646 root 1.19
647 root 1.27 #LOCK
648     my $meta = eval { Storable::retrieve "$CACHEDIR/meta" } || { version => 1 };
649 root 1.4
650 root 1.27 for my $f (@func) {
651     $f->{func} = "F" . Digest::MD5::md5_hex ($f->{source});
652     $f->{so} = $meta->{$f->{func}};
653     }
654 root 1.4
655 root 1.27 if (grep !$_->{so}, @func) {
656     my $stem;
657    
658     do {
659     $stem = "$CACHEDIR/$$-" . $uid++;
660     } while -e "$stem$_so";
661    
662     open my $fh, ">:raw", "$stem.c";
663     print $fh <<EOF;
664 root 1.11 #define PERL_NO_GET_CONTEXT
665 root 1.24 #define PERL_CORE
666 root 1.11
667     #include <assert.h>
668    
669     #include "EXTERN.h"
670     #include "perl.h"
671     #include "XSUB.h"
672    
673     #define RUNOPS_TILL(op) \\
674 root 1.27 while (nextop != (op)) \\
675     { \\
676     PERL_ASYNC_CHECK (); \\
677     PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\
678     }
679    
680     EOF
681     for my $f (grep !$_->{so}, @func) {
682     next if $f->{so} = $meta->{$f->{func}}; # some cv's alias others
683    
684     warn "compiling $f->{name} to $stem$_so:$f->{func}\n" if $verbose > 1;
685     my $source = $f->{source};
686     $source =~ s/%%%FUNC%%%/$f->{func}/g;
687     print $fh $source;
688     $meta->{$f->{func}} = $f->{so} = $stem;
689     }
690    
691     close $fh;
692     system "$COMPILE -o $stem$_o $stem.c";
693     #d#unlink "$stem.c";
694     system "$LINK -o $stem$_so $stem$_o $LIBS";
695     unlink "$stem$_o";
696     }
697 root 1.11
698 root 1.27 for my $f (@func) {
699     my $stem = $f->{so};
700 root 1.4
701 root 1.27 my $so = ($so{$stem} ||= DynaLoader::dl_load_file "$stem$_so")
702     or die "$stem$_so: $!";
703 root 1.19
704 root 1.27 #unlink "$stem$_so";
705 root 1.4
706 root 1.27 $f->{ptr} = DynaLoader::dl_find_symbol $so, $f->{func}
707     or die "$f->{func} not found in $stem$_so: $!";
708     }
709 root 1.19
710 root 1.27 Storable::nstore $meta, "$CACHEDIR/meta";
711     # UNLOCK
712 root 1.4 }
713    
714 root 1.19 my %ignore;
715    
716 root 1.4 sub entersub {
717     my ($cv) = @_;
718    
719 root 1.19 my $pkg = $cv->STASH->NAME;
720    
721     return if $ignore{$pkg};
722    
723 root 1.27 warn "optimising ", $cv->STASH->NAME, "\n"
724 root 1.21 if $verbose;
725 root 1.11
726 root 1.4 eval {
727 root 1.27 my @func;
728 root 1.4
729 root 1.19 # always compile the whole stash
730     my %stash = $cv->STASH->ARRAY;
731     while (my ($k, $v) = each %stash) {
732     $v->isa (B::GV::)
733     or next;
734    
735     my $cv = $v->CV;
736    
737     if ($cv->isa (B::CV::)
738     && ${$cv->START}
739     && $cv->START->name ne "null") {
740 root 1.27
741     push @func, {
742     cv => $cv,
743     name => $k,
744     source => cv2c $cv,
745     };
746 root 1.19 }
747     }
748    
749 root 1.27 func2ptr @func;
750 root 1.4
751 root 1.27 for my $f (@func) {
752     patch_cv $f->{cv}, $f->{ptr};
753 root 1.19 }
754 root 1.4 };
755    
756 root 1.19 if ($@) {
757     $ignore{$pkg}++;
758     warn $@;
759     }
760 root 1.1 }
761    
762     hook_entersub;
763    
764     1;
765    
766     =back
767    
768 root 1.21 =head1 ENVIRONMENT VARIABLES
769    
770     The following environment variables influence the behaviour of Faster:
771    
772     =over 4
773    
774     =item FASTER_VERBOSE
775    
776     Faster will output more informational messages when set to values higher
777     than C<0>. Currently, C<1> outputs which packages are being compiled.
778    
779     =item FASTER_DEBUG
780    
781     Add debugging code when set to values higher than C<0>. Currently, this
782     adds 1-3 C<assert>'s per perl op, to ensure that opcode order and C
783     execution order are compatible.
784    
785     =item FASTER_CACHE
786    
787 root 1.27 NOT YET IMPLEMENTED CORRECTLY, SHARING BEETWEEN INSTANCES IS IMPOSSIBLE
788 root 1.21
789     Set a persistent cache directory that caches compiled code
790     fragments. Normally, code compiled by Faster will be deleted immediately,
791     and every restart will recompile everything. Setting this variable to a
792     directory makes Faster cache the generated files for re-use.
793    
794     This directory will always grow in contents, so you might need to erase it
795     from time to time.
796    
797     =back
798    
799 root 1.11 =head1 BUGS/LIMITATIONS
800    
801     Perl will check much less often for asynchronous signals in
802     Faster-compiled code. It tries to check on every function call, loop
803     iteration and every I/O operator, though.
804    
805     The following things will disable Faster. If you manage to enable them at
806 root 1.19 runtime, bad things will happen. Enabling them at startup will be fine,
807     though.
808 root 1.11
809     enabled tainting
810     enabled debugging
811    
812 root 1.19 Thread-enabled builds of perl will dramatically reduce Faster's
813     performance, but you don't care about speed if you enable threads anyway.
814 root 1.11
815 root 1.19 These constructs will force the use of the interpreter for the currently
816     executed function as soon as they are being encountered during execution.
817 root 1.11
818     goto
819     next, redo (but not well-behaved last's)
820     eval
821     require
822     any use of formats
823 root 1.19 .., ... (flipflop operators)
824 root 1.2
825 root 1.1 =head1 AUTHOR
826    
827     Marc Lehmann <schmorp@schmorp.de>
828     http://home.schmorp.de/
829    
830     =cut
831