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

Comparing Faster/Faster.pm (file contents):
Revision 1.4 by root, Thu Mar 9 22:32:17 2006 UTC vs.
Revision 1.21 by root, Fri Mar 10 22:39:11 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 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.
10 33
11=over 4 34=over 4
12 35
13=cut 36=cut
14 37
15package Faster; 38package Faster;
16 39
17use strict; 40use strict;
18use Config; 41use Config;
19use B (); 42use B ();
20use Digest::MD5 (); 43#use Digest::MD5 ();
21use DynaLoader (); 44use DynaLoader ();
22 45
23BEGIN { 46BEGIN {
24 our $VERSION = '0.01'; 47 our $VERSION = '0.01';
25 48
… …
31my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}"; 54my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
32my $LIBS = "$Config{libs}"; 55my $LIBS = "$Config{libs}";
33my $_o = $Config{_o}; 56my $_o = $Config{_o};
34my $_so = ".so"; 57my $_so = ".so";
35 58
59# we don't need no steenking PIC on x86
60$COMPILE =~ s/-f(?:PIC|pic)//g
61 if $Config{archname} =~ /^(i[3456]86)-/;
62
63my $opt_assert = $ENV{FASTER_DEBUG};
64my $verbose = $ENV{FASTER_VERBOSE}+0;
65
36our $source; 66our $source;
37our $label_next;
38our $label_last;
39our $label_redo;
40 67
41my %flag; 68our @ops;
69our $op;
70our $op_name;
71our @op_loop;
72our %op_regcomp;
42 73
43for (split /\n/, <<EOF) { 74my %f_unsafe = map +($_ => undef), qw(
44 leavesub unsafe 75 leavesub leavesublv return
45 leavesublv unsafe 76 goto last redo next
46 return unsafe 77 eval flip leaveeval entertry
47 flip unsafe 78 formline grepstart mapstart
48 goto unsafe 79 substcont entereval require
49 last unsafe 80);
50 redo unsafe
51 next unsafe
52 eval unsafe
53 leaveeval unsafe
54 entertry unsafe
55 substconst unsafe
56 formline unsafe
57 grepstart unsafe
58 require unsafe
59 81
60 pushmark noasync 82# pushmark extend=0
61 padsv noasync 83# padsv extend=1
62 entersub noasync 84# padav extend=1
63 aassign noasync 85# padhv extend=1
64 sassign noasync 86# padany extend=1
65 rv2av noasync 87# const extend=1
66 nextstate noasync 88
67 gv noasync 89my %f_noasync = map +($_ => undef), qw(
68 gvsv noasync 90 mapstart grepstart match entereval
69 add noasync 91 enteriter entersub leaveloop
70 subtract noasync 92
71 multiply noasync 93 pushmark nextstate
72 divide noasync 94
73 complement noasync 95 const stub unstack
74 cond_expr noasync 96 last next redo seq
75 and noasync 97 padsv padav padhv padany
76 or noasync 98 aassign sassign orassign
77 not noasync 99 rv2av rv2cv rv2gv rv2hv refgen
100 gv gvsv
101 add subtract multiply divide
102 complement cond_expr and or not
103 defined
78 method_named noasync 104 method_named
79 preinc noasync 105 preinc postinc predec postdec
80 postinc noasync 106 aelem aelemfast helem delete exists
81 predec noasync 107 pushre subst list join split concat
82 postdec noasync 108 length substr stringify ord
83 stub noasync 109 push pop shift unshift
84 unstack noasync 110 eq ne gt lt ge le
85 leaveloop noasync 111 regcomp regcreset regcmaybe
86 shift noasync 112);
87 aelemA noasync
88 aelemfast noasync
89EOF
90 my (undef, $op, @flags) = split /\s+/;
91 113
92 undef $flag{$_}{$op} 114my %callop = (
93 for ("known", @flags); 115 entersub => "(PL_ppaddr [OP_ENTERSUB]) (aTHX)",
116 mapstart => "Perl_pp_grepstart (aTHX)",
117);
118
119sub callop {
120 $callop{$op_name} || "Perl_pp_$op_name (aTHX)"
121}
122
123sub assert {
124 return unless $opt_assert;
125 $source .= " assert ((\"$op_name\", ($_[0])));\n";
126}
127
128sub out_callop {
129 assert "nextop == (OP *)$$op";
130 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
131}
132
133sub out_cond_jump {
134 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
135}
136
137sub out_jump_next {
138 out_cond_jump $op_regcomp{$$op}
139 if $op_regcomp{$$op};
140
141 assert "nextop == (OP *)${$op->next}";
142 $source .= " goto op_${$op->next};\n";
94} 143}
95 144
96sub out_next { 145sub out_next {
97 my ($op) = @_;
98
99 $source .= " nextop = (OP *)${$op->next}L;\n"; 146 $source .= " nextop = (OP *)${$op->next}L;\n";
100 $source .= " goto op_${$op->next};\n";
101}
102 147
103sub callop { 148 out_jump_next;
104 my ($op) = @_;
105
106 my $name = $op->name;
107
108 $name eq "entersub"
109 ? "(PL_ppaddr [OP_ENTERSUB]) (aTHX)"
110 : "Perl_pp_$name (aTHX)"
111} 149}
150
151sub out_linear {
152 out_callop;
153 out_jump_next;
154}
155
156sub op_entersub {
157 out_callop;
158 $source .= " RUNOPS_TILL ((OP *)${$op->next}L);\n";
159 out_jump_next;
160}
161
162*op_require = \&op_entersub;
112 163
113sub op_nextstate { 164sub op_nextstate {
114 my ($op) = @_;
115
116 $source .= " PL_curcop = (COP *)nextop;\n"; 165 $source .= " PL_curcop = (COP *)nextop;\n";
117 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n"; 166 $source .= " PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;\n";
118 $source .= " FREETMPS;\n"; 167 $source .= " FREETMPS;\n";
119 168
120 out_next $op; 169 out_next;
121} 170}
122 171
123sub op_pushmark { 172sub op_pushmark {
124 my ($op) = @_;
125
126 $source .= " PUSHMARK (PL_stack_sp);\n"; 173 $source .= " PUSHMARK (PL_stack_sp);\n";
127 174
128 out_next $op; 175 out_next;
129} 176}
130 177
131sub op_const { 178if ($Config{useithreads} ne "define") {
132 my ($op) = @_; 179 # disable optimisations on ithreads
133 180
181 *op_const = sub {
134 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; 182 $source .= " { dSP; XPUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
135 183
136 out_next $op; 184 out_next;
137} 185 };
138 186
139*op_gv = \&op_const; 187 *op_gv = \&op_const;
140 188
189 *op_aelemfast = sub {
190 my $targ = $op->targ;
191 my $private = $op->private;
192
193 $source .= " {\n";
194
195 if ($op->flags & B::OPf_SPECIAL) {
196 $source .= " AV *av = (AV*)PAD_SV((PADOFFSET)$targ);\n";
197 } else {
198 $source .= " AV *av = GvAV ((GV *)${$op->sv}L);\n";
199 }
200
201 if ($op->flags & B::OPf_MOD) {
202 $source .= " SV *sv = *av_fetch (av, $private, 1);\n";
203 } else {
204 $source .= " SV **svp = av_fetch (av, $private, 0); SV *sv = svp ? *svp : &PL_sv_undef;\n";
205 }
206
207 if (!($op->flags & B::OPf_MOD)) {
208 $source .= " if (SvGMAGICAL (sv)) sv = sv_mortalcopy (sv);\n";
209 }
210
211 $source .= " dSP;\n";
212 $source .= " XPUSHs (sv);\n";
213 $source .= " PUTBACK;\n";
214 $source .= " }\n";
215
216 out_next;
217 };
218
219 *op_gvsv = sub {
220 $source .= " {\n";
221 $source .= " dSP;\n";
222 $source .= " EXTEND (SP, 1);\n";
223
224 if ($op->private & B::OPpLVAL_INTRO) {
225 $source .= " PUSHs (save_scalar ((GV *)${$op->sv}L));\n";
226 } else {
227 $source .= " PUSHs (GvSV ((GV *)${$op->sv}L));\n";
228 }
229
230 $source .= " PUTBACK;\n";
231 $source .= " }\n";
232
233 out_next;
234 };
235}
236
237# does kill Crossfire/res2pm
141sub op_stringify { 238sub op_stringify {
142 my ($op) = @_; 239 my $targ = $op->targ;
143
144 $source .= " { dSP; dTARGET; sv_copypv (TARG, TOPs); SETTARG; }\n";
145
146 out_next $op;
147}
148
149sub op_and {
150 my ($op) = @_;
151 240
152 $source .= <<EOF; 241 $source .= <<EOF;
153 { 242 {
154 dSP; 243 dSP;
244 SV *targ = PAD_SV ((PADOFFSET)$targ);
245 sv_copypv (TARG, TOPs);
246 SETTARG;
247 PUTBACK;
248 }
249EOF
250
251 out_next;
252}
253
254sub op_and {
255 $source .= <<EOF;
256 {
257 dSP;
258
155 if (SvTRUE (TOPs)) 259 if (SvTRUE (TOPs))
156 { 260 {
157 --SP; 261 --SP;
158 PUTBACK; 262 PUTBACK;
159 nextop = (OP *)${$op->other}L; 263 nextop = (OP *)${$op->other}L;
160 goto op_${$op->other}; 264 goto op_${$op->other};
161 } 265 }
162
163 nextop = (OP *)${$op->next}L;
164 goto op_${$op->next};
165 } 266 }
166EOF 267EOF
167}
168 268
169sub op_padsv { 269 out_next;
170 my ($op) = @_; 270}
171 271
172 my $flags = $op->flags; 272sub op_or {
173 my $target = $op->targ;
174
175 $source .= <<EOF; 273 $source .= <<EOF;
176 { 274 {
177 dSP; 275 dSP;
276
277 if (!SvTRUE (TOPs))
278 {
279 --SP;
280 PUTBACK;
281 nextop = (OP *)${$op->other}L;
282 goto op_${$op->other};
283 }
284 }
285EOF
286
287 out_next;
288}
289
290sub op_padsv {
291 my $flags = $op->flags;
292 my $targ = $op->targ;
293
294 $source .= <<EOF;
295 {
296 dSP;
178 XPUSHs (PAD_SV ((PADOFFSET)$target)); 297 XPUSHs (PAD_SV ((PADOFFSET)$targ));
179 PUTBACK; 298 PUTBACK;
180EOF 299EOF
181 if ($op->flags & B::OPf_MOD) { 300 if ($op->flags & B::OPf_MOD) {
182 if ($op->private & B::OPpLVAL_INTRO) { 301 if ($op->private & B::OPpLVAL_INTRO) {
183 $source .= " SAVECLEARSV (PAD_SVl ((PADOFFSET)$target));\n"; 302 $source .= " SAVECLEARSV (PAD_SVl ((PADOFFSET)$targ));\n";
184 } elsif ($op->private & B::OPpDEREF) { 303 } elsif ($op->private & B::OPpDEREF) {
185 my $deref = $op->private & B::OPpDEREF; 304 my $deref = $op->private & B::OPpDEREF;
186 $source .= " Perl_vivify_ref (PAD_SVl ((PADOFFSET)$target), $deref);\n"; 305 $source .= " Perl_vivify_ref (PAD_SVl ((PADOFFSET)$targ), $deref);\n";
187 } 306 }
188 } 307 }
189 $source .= <<EOF; 308 $source .= <<EOF;
190 } 309 }
191EOF 310EOF
192 311
193 out_next $op; 312 out_next;
194} 313}
195 314
196# pattern const+ (or general push1) 315# pattern const+ (or general push1)
197# pattern pushmark return(?) 316# pattern pushmark return(?)
198# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign 317# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign
199 318
200# pattern const method_named 319# pattern const method_named
201sub op_method_named { 320sub op_method_named {
202 my ($op) = @_;
203
204 $source .= <<EOF; 321 $source .= <<EOF;
205 { 322 {
206 static HV *last_stash; 323 static HV *last_stash;
207 static SV *last_res; 324 static SV *last_cv;
325 static U32 last_sub_generation;
208 326
209 SV *obj = *(PL_stack_base + TOPMARK + 1); 327 SV *obj = *(PL_stack_base + TOPMARK + 1);
210 328
211 if (SvROK (obj) && SvOBJECT (SvRV (obj))) 329 if (!SvGMAGICAL (obj) && SvROK (obj) && SvOBJECT (SvRV (obj)))
212 { 330 {
213 dSP; 331 dSP;
214 HV *stash = SvSTASH (SvRV (obj)); 332 HV *stash = SvSTASH (SvRV (obj));
215 333
216 /* simple "polymorphic" inline cache */ 334 /* simple "polymorphic" inline cache */
217 if (stash == last_stash) 335 if (stash == last_stash
336 && PL_sub_generation == last_sub_generation)
218 { 337 {
219 XPUSHs (last_res); 338 XPUSHs (last_cv);
220 PUTBACK; 339 PUTBACK;
221 } 340 }
222 else 341 else
223 { 342 {
224 PL_op = nextop;
225 nextop = Perl_pp_method_named (aTHX); 343 PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
226 344
227 SPAGAIN; 345 SPAGAIN;
346 last_sub_generation = PL_sub_generation;
228 last_stash = stash; 347 last_stash = stash;
229 last_res = TOPs; 348 last_cv = TOPs;
230 } 349 }
231 } 350 }
232 else 351 else
233 { 352 {
234 /* error case usually */ 353 /* error case usually */
235 PL_op = nextop;
236 nextop = Perl_pp_method_named (aTHX); 354 PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
237 } 355 }
238 } 356 }
239EOF 357EOF
240 358
241 out_next $op; 359 out_next;
360}
361
362sub op_grepstart {
363 out_callop;
364 $op = $op->next;
365 out_cond_jump $op->other;
366 out_jump_next;
367}
368
369*op_mapstart = \&op_grepstart;
370
371sub op_substcont {
372 out_callop;
373 out_cond_jump $op->other->pmreplstart;
374 assert "nextop == (OP *)${$op->other->next}L";
375 $source .= " goto op_${$op->other->next};\n";
376}
377
378sub out_break_op {
379 my ($idx) = @_;
380
381 out_callop;
382
383 out_cond_jump $_->[$idx]
384 for reverse @op_loop;
385
386 $source .= " return nextop;\n";
387}
388
389sub xop_next {
390 out_break_op 0;
391}
392
393sub op_last {
394 out_break_op 1;
395}
396
397sub xop_redo {
398 out_break_op 2;
242} 399}
243 400
244sub cv2c { 401sub cv2c {
245 my ($cv) = @_; 402 my ($cv) = @_;
246 403
404 local @ops;
405 local @op_loop;
406 local %op_regcomp;
407
247 my %opsseen; 408 my %opsseen;
248 my @ops;
249 my @todo = $cv->START; 409 my @todo = $cv->START;
250 410
251 while (my $op = shift @todo) { 411 while (my $op = shift @todo) {
252 for (; $$op; $op = $op->next) { 412 for (; $$op; $op = $op->next) {
253 last if $opsseen{$$op}++; 413 last if $opsseen{$$op}++;
254 push @ops, $op; 414 push @ops, $op;
415
255 my $name = $op->name; 416 my $name = $op->name;
417 my $class = B::class $op;
418
256 if (B::class($op) eq "LOGOP") { 419 if ($class eq "LOGOP") {
257 push @todo, $op->other; 420 unshift @todo, $op->other; # unshift vs. push saves jumps
258 } elsif ($name eq "subst" and ${ $op->pmreplstart }) { 421
259 push @todo, $op->pmreplstart; 422 # regcomp/o patches ops at runtime, lets expect that
260 } elsif ($name =~ /^enter(loop|iter)$/) { 423 $op_regcomp{${$op->first}} = $op->next
261# if ($] > 5.009) { 424 if $name eq "regcomp" && $op->other->pmflags & B::PMf_KEEP;
262# $labels{${$op->nextop}} = "NEXT"; 425
263# $labels{${$op->lastop}} = "LAST"; 426 } elsif ($class eq "PMOP") {
264# $labels{${$op->redoop}} = "REDO"; 427 unshift @todo, $op->pmreplstart if ${$op->pmreplstart};
265# } else { 428
266# $labels{$op->nextop->seq} = "NEXT"; 429 } elsif ($class eq "LOOP") {
267# $labels{$op->lastop->seq} = "LAST"; 430 push @op_loop, [$op->nextop, $op->lastop->next, $op->redoop->next];
268# $labels{$op->redoop->seq} = "REDO"; 431 push @todo, $op->nextop, $op->lastop->next, $op->redoop->next;
269# }
270 } 432 }
271 } 433 }
272 } 434 }
273 435
274 local $source = <<EOF; 436 local $source = <<EOF;
437OP *%%%FUNC%%% (pTHX)
438{
439 register OP *nextop = (OP *)${$ops[0]}L;
440EOF
441
442 while (@ops) {
443 $op = shift @ops;
444 $op_name = $op->name;
445
446 $source .= "op_$$op: /* $op_name */\n";
447 #$source .= "fprintf (stderr, \"$$op in op $op_name\\n\");\n";#d#
448 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
449
450 $source .= " PERL_ASYNC_CHECK ();\n"
451 unless exists $f_noasync{$op_name};
452
453 if (my $can = __PACKAGE__->can ("op_$op_name")) {
454 # handcrafted replacement
455 $can->($op);
456
457 } elsif (exists $f_unsafe{$op_name}) {
458 # unsafe, return to interpreter
459 assert "nextop == (OP *)$$op";
460 $source .= " return nextop;\n";
461
462 } elsif ("LOGOP" eq B::class $op) {
463 # logical operation with optionaö branch
464 out_callop;
465 out_cond_jump $op->other;
466 out_jump_next;
467
468 } elsif ("PMOP" eq B::class $op) {
469 # regex-thingy
470 out_callop;
471 out_cond_jump $op->pmreplroot if ${$op->pmreplroot};
472 out_jump_next;
473
474 } else {
475 # normal operator, linear execution
476 out_linear;
477 }
478 }
479
480 $op_name = "func exit"; assert (0);
481
482 $source .= <<EOF;
483op_0:
484 return 0;
485}
486EOF
487 #warn $source;
488
489 $source
490}
491
492my $uid = "aaaaaaa0";
493
494sub source2ptr {
495 my (@source) = @_;
496
497 my $stem = "/tmp/Faster-$$-" . $uid++;
498
499 open FILE, ">:raw", "$stem.c";
500 print FILE <<EOF;
275#define PERL_NO_GET_CONTEXT 501#define PERL_NO_GET_CONTEXT
276 502
277#include <assert.h> 503#include <assert.h>
278 504
279#include "EXTERN.h" 505#include "EXTERN.h"
280#include "perl.h" 506#include "perl.h"
281#include "XSUB.h" 507#include "XSUB.h"
282 508
283/*typedef OP *(*PPFUNC)(pTHX);*/ 509#define RUNOPS_TILL(op) \\
284 510while (nextop != (op)) \\
285OP *%%%FUNC%%% (pTHX) 511 { \\
286{
287 register OP *nextop = (OP *)${$ops[0]}L;
288EOF
289
290 for my $op (@ops) {
291 my $name = $op->name;
292 my $ppaddr = ppaddr $op->type;
293
294 $source .= "op_$$op: /* $name */\n";
295 #$source .= "fprintf (stderr, \"$$op in op $name\\n\");\n";#d#
296 #$source .= "{ dSP; sv_dump (TOPs); }\n";#d#
297
298 unless (exists $flag{noasync}{$name}) {
299 $source .= " PERL_ASYNC_CHECK ();\n";
300 }
301
302 if (my $can = __PACKAGE__->can ("op_$name")) {
303 $can->($op);
304 } elsif ("LOGOP" eq B::class $op or exists $flag{otherop}{$name}) {
305 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
306 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
307 $source .= " if (nextop == (OP *)${$op->other}L) goto op_${$op->other};\n";
308 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d#
309 $source .= " goto op_${$op->next};\n";
310 } elsif (exists $flag{unsafe}{$name}) {
311 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
312 $source .= " PL_op = nextop; return " . (callop $op) . ";\n";
313 } else {
314 $source .= " assert ((\"$name\", nextop == (OP *)$$op));\n";#d#
315 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
316 if ($name eq "entersub") {
317 $source .= <<EOF;
318while (nextop != (OP *)${$op->next})
319 {
320 PERL_ASYNC_CHECK (); 512 PERL_ASYNC_CHECK (); \\
321 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); 513 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\
322 } 514 }
515
323EOF 516EOF
324 } 517 for (@source) {
325 $source .= " assert ((\"$name\", nextop == (OP *)${$op->next}));\n";#d# 518 my $func = $uid++;
326 $source .= " goto op_${$op->next};\n"; 519 $_ =~ s/%%%FUNC%%%/$func/g;
327 } 520 print FILE $_;
521 $_ = $func;
328 } 522 }
329 523
330 $source .= "}\n";
331 #warn $source;
332
333 $source
334}
335
336sub source2ptr {
337 my ($source) = @_;
338
339 my $md5 = Digest::MD5::md5_hex $source;
340 $source =~ s/%%%FUNC%%%/Faster_$md5/;
341
342 my $stem = "/tmp/$md5";
343
344 unless (-e "$stem$_so") {
345 open FILE, ">:raw", "$stem.c";
346 print FILE $source;
347 close FILE; 524 close FILE;
348 system "$COMPILE -o $stem$_o $stem.c"; 525 system "$COMPILE -o $stem$_o $stem.c";
526 #d#unlink "$stem.c";
349 system "$LINK -o $stem$_so $stem$_o $LIBS"; 527 system "$LINK -o $stem$_so $stem$_o $LIBS";
350 } 528 unlink "$stem$_o";
351 529
352# warn $source;
353 my $so = DynaLoader::dl_load_file "$stem$_so" 530 my $so = DynaLoader::dl_load_file "$stem$_so"
354 or die "$stem$_so: $!"; 531 or die "$stem$_so: $!";
355 532
356 DynaLoader::dl_find_symbol $so, "Faster_$md5" 533 #unlink "$stem$_so";
357 or die "Faster_$md5: $!" 534
535 map +(DynaLoader::dl_find_symbol $so, $_), @source
358} 536}
537
538my %ignore;
359 539
360sub entersub { 540sub entersub {
361 my ($cv) = @_; 541 my ($cv) = @_;
362 542
543 my $pkg = $cv->STASH->NAME;
544
545 return if $ignore{$pkg};
546
547 warn "compiling ", $cv->STASH->NAME, "\n"
548 if $verbose;
549
363 eval { 550 eval {
364 my $source = cv2c $cv; 551 my @cv;
552 my @cv_source;
365 553
554 # always compile the whole stash
555 my %stash = $cv->STASH->ARRAY;
556 while (my ($k, $v) = each %stash) {
557 $v->isa (B::GV::)
558 or next;
559
560 my $cv = $v->CV;
561
562 if ($cv->isa (B::CV::)
563 && ${$cv->START}
564 && $cv->START->name ne "null") {
565 push @cv, $cv;
566 push @cv_source, cv2c $cv;
567 }
568 }
569
366 my $ptr = source2ptr $source; 570 my @ptr = source2ptr @cv_source;
367 571
572 for (0 .. $#cv) {
368 patch_cv $cv, $ptr; 573 patch_cv $cv[$_], $ptr[$_];
574 }
369 }; 575 };
370 576
371 warn $@ if $@; 577 if ($@) {
578 $ignore{$pkg}++;
579 warn $@;
580 }
372} 581}
373 582
374hook_entersub; 583hook_entersub;
375 584
3761; 5851;
377 586
378=back 587=back
379 588
589=head1 ENVIRONMENT VARIABLES
590
591The following environment variables influence the behaviour of Faster:
592
593=over 4
594
595=item FASTER_VERBOSE
596
597Faster will output more informational messages when set to values higher
598than C<0>. Currently, C<1> outputs which packages are being compiled.
599
600=item FASTER_DEBUG
601
602Add debugging code when set to values higher than C<0>. Currently, this
603adds 1-3 C<assert>'s per perl op, to ensure that opcode order and C
604execution order are compatible.
605
606=item FASTER_CACHE
607
608NOT YET IMPLEMENTED
609
610Set a persistent cache directory that caches compiled code
611fragments. Normally, code compiled by Faster will be deleted immediately,
612and every restart will recompile everything. Setting this variable to a
613directory makes Faster cache the generated files for re-use.
614
615This directory will always grow in contents, so you might need to erase it
616from time to time.
617
618=back
619
380=head1 LIMITATIONS 620=head1 BUGS/LIMITATIONS
381 621
382Tainting and debugging will disable Faster. 622Perl will check much less often for asynchronous signals in
623Faster-compiled code. It tries to check on every function call, loop
624iteration and every I/O operator, though.
625
626The following things will disable Faster. If you manage to enable them at
627runtime, bad things will happen. Enabling them at startup will be fine,
628though.
629
630 enabled tainting
631 enabled debugging
632
633Thread-enabled builds of perl will dramatically reduce Faster's
634performance, but you don't care about speed if you enable threads anyway.
635
636These constructs will force the use of the interpreter for the currently
637executed function as soon as they are being encountered during execution.
638
639 goto
640 next, redo (but not well-behaved last's)
641 eval
642 require
643 any use of formats
644 .., ... (flipflop operators)
383 645
384=head1 AUTHOR 646=head1 AUTHOR
385 647
386 Marc Lehmann <schmorp@schmorp.de> 648 Marc Lehmann <schmorp@schmorp.de>
387 http://home.schmorp.de/ 649 http://home.schmorp.de/

Diff Legend

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