ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Faster/Faster.pm
Revision: 1.35
Committed: Sat Feb 21 05:55:52 2009 UTC (15 years, 4 months ago) by root
Branch: MAIN
Changes since 1.34: +5 -3 lines
Log Message:
*** empty log message ***

File Contents

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