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

Comparing Faster/Faster.pm (file contents):
Revision 1.25 by root, Sat Mar 11 04:58:53 2006 UTC vs.
Revision 1.34 by root, Wed Mar 15 02:32:27 2006 UTC

… …
8 8
9 perl -MFaster ... 9 perl -MFaster ...
10 10
11=head1 DESCRIPTION 11=head1 DESCRIPTION
12 12
13This module implements a very simple-minded JIT. It works by more or less 13This module implements a very simple-minded "JIT" (or actually AIT, ahead
14translating every function it sees into a C program, compiling it and then 14of time compiler). It works by more or less translating every function it
15replacing the function by the compiled code. 15sees into a C program, compiling it and then replacing the function by the
16compiled code.
16 17
17As a result, startup times are immense, as every function might lead to a 18As a result, startup times are immense, as every function might lead to a
18full-blown compilation. 19full-blown compilation.
19 20
20The speed improvements are also not great, you can expect 20% or so on 21The speed improvements are also not great, you can expect 20% or so on
21average, for code that runs very often. 22average, for code that runs very often. The reason for this is that data
23handling is mostly being done by the same old code, it just gets called
24a bit faster. Regexes and string operations won't get faster. Airhtmetic
25doresn't become any faster. Just the operands and other stuff is put on
26the stack faster, and the opcodes themselves have a bit less overhead.
22 27
23Faster is in the early stages of development. Due to its design its 28Faster 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 29relatively safe to use (it will either work or simply slowdown the program
25immensely, but rarely cause bugs). 30immensely, but rarely cause bugs).
26 31
32More intelligent algorithms (loop optimisation, type inference) could
33improve that easily, but requires a much more elaborate presentation and
34optimiser than what is in place. There are no plans to improve Faster in
35this way, yet, but it would provide a reasonably good place to start.
36
27Usage is very easy, just C<use Faster> and every function called from then 37Usage is very easy, just C<use Faster> and every function called from then
28on will be compiled. 38on will be compiled.
29 39
30Right now, Faster will leave lots of F<*.c>, F<*.o> and F<*.so> files in 40Right now, Faster can leave lots of F<*.c> and F<*.so> files in your
31F</tmp>, and it will even create those temporary files in an insecure 41F<$FASTER_CACHEDIR> (by default F<$HOME/.perl-faster-cache>), and it will
32manner, so watch out. 42even create those temporary files in an insecure manner, so watch out.
33 43
34=over 4 44=over 4
35 45
36=cut 46=cut
37 47
… …
40no warnings; 50no warnings;
41 51
42use strict; 52use strict;
43use Config; 53use Config;
44use B (); 54use B ();
45#use Digest::MD5 ();
46use DynaLoader (); 55use DynaLoader ();
47use File::Temp (); 56use Digest::MD5 ();
57use Storable ();
58use Fcntl ();
48 59
49BEGIN { 60BEGIN {
50 our $VERSION = '0.01'; 61 our $VERSION = '0.01';
51 62
52 require XSLoader; 63 require XSLoader;
53 XSLoader::load __PACKAGE__, $VERSION; 64 XSLoader::load __PACKAGE__, $VERSION;
54} 65}
55 66
67my $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
56my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}"; 75my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}";
57my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}"; 76my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
58my $LIBS = "$Config{libs}"; 77my $LIBS = "";
59my $_o = $Config{_o}; 78my $_o = $Config{_o};
60my $_so = ".so"; 79my $_so = ".so";
61 80
62# we don't need no steenking PIC on x86 81# we don't need no steenking PIC on x86
63$COMPILE =~ s/-f(?:PIC|pic)//g 82$COMPILE =~ s/-f(?:PIC|pic)//g
64 if $Config{archname} =~ /^(i[3456]86)-/; 83 if $Config{archname} =~ /^(i[3456]86)-/;
65 84
66my $opt_assert = $ENV{FASTER_DEBUG}; 85my $opt_assert = $ENV{FASTER_DEBUG} & 2;
67my $verbose = $ENV{FASTER_VERBOSE}+0; 86my $verbose = $ENV{FASTER_VERBOSE}+0;
87
88warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2;
68 89
69our $source; 90our $source;
70 91
71our @ops; 92our @ops;
72our $insn; 93our $insn;
73our $op; 94our $op;
74our $op_name; 95our $op_name;
75our @op_loop;
76our %op_regcomp; 96our %op_regcomp;
77 97
78# ops that cause immediate return to the interpreter 98# ops that cause immediate return to the interpreter
79my %f_unsafe = map +($_ => undef), qw( 99my %f_unsafe = map +($_ => undef), qw(
80 leavesub leavesublv return 100 leavesub leavesublv return
… …
133# ops that do not need an ASYNC_CHECK 153# ops that do not need an ASYNC_CHECK
134my %f_noasync = map +($_ => undef), qw( 154my %f_noasync = map +($_ => undef), qw(
135 mapstart grepstart match entereval 155 mapstart grepstart match entereval
136 enteriter entersub leaveloop 156 enteriter entersub leaveloop
137 157
138 pushmark nextstate 158 pushmark nextstate caller
139 159
140 const stub unstack 160 const stub unstack
141 last next redo seq 161 last next redo goto seq
142 padsv padav padhv padany 162 padsv padav padhv padany
143 aassign sassign orassign 163 aassign sassign orassign
144 rv2av rv2cv rv2gv rv2hv refgen 164 rv2av rv2cv rv2gv rv2hv refgen
145 gv gvsv 165 gv gvsv
146 add subtract multiply divide 166 add subtract multiply divide
147 complement cond_expr and or not 167 complement cond_expr and or not
168 bit_and bit_or bit_xor
148 defined 169 defined
149 method method_named bless 170 method method_named bless
150 preinc postinc predec postdec 171 preinc postinc predec postdec
151 aelem aelemfast helem delete exists 172 aelem aelemfast helem delete exists
152 pushre subst list join split concat 173 pushre subst list lslice join split concat
153 length substr stringify ord 174 length substr stringify ord
154 push pop shift unshift 175 push pop shift unshift
155 eq ne gt lt ge le 176 eq ne gt lt ge le
156 regcomp regcreset regcmaybe 177 regcomp regcreset regcmaybe
157); 178);
158 179
159my %callop = ( 180my %callop = (
160 entersub => "(PL_ppaddr [OP_ENTERSUB]) (aTHX)", 181 entersub => "(PL_op->op_ppaddr) (aTHX)",
161 mapstart => "Perl_pp_grepstart (aTHX)", 182 mapstart => "Perl_pp_grepstart (aTHX)",
162); 183);
163 184
164sub callop { 185sub callop {
165 $callop{$op_name} || "Perl_pp_$op_name (aTHX)" 186 $callop{$op_name} || "Perl_pp_$op_name (aTHX)"
… …
171} 192}
172 193
173sub out_callop { 194sub out_callop {
174 assert "nextop == (OP *)$$op"; 195 assert "nextop == (OP *)$$op";
175 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 196 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
197}
198
199sub out_jump {
200 assert "nextop == (OP *)${$_[0]}L";
201 $source .= " goto op_${$_[0]};\n";
176} 202}
177 203
178sub out_cond_jump { 204sub out_cond_jump {
179 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n"; 205 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
180} 206}
… …
213 239
214 out_next; 240 out_next;
215} 241}
216 242
217sub op_pushmark { 243sub op_pushmark {
218 $source .= " PUSHMARK (PL_stack_sp);\n"; 244 $source .= " faster_PUSHMARK (PL_stack_sp);\n";
219 245
220 out_next; 246 out_next;
221} 247}
222 248
223if ($Config{useithreads} ne "define") { 249if ($Config{useithreads} ne "define") {
224 # disable optimisations on ithreads 250 # disable optimisations on ithreads
225 251
226 *op_const = sub { 252 *op_const = sub {
227 $source .= " { dSP; PUSHs ((SV *)${$op->sv}L); PUTBACK; }\n"; 253 $source .= " { dSP; PUSHs ((SV *)${$op->sv}L); PUTBACK; }\n";
254
255 $ops[0]{follows_const}++ if @ops;#d#
228 256
229 out_next; 257 out_next;
230 }; 258 };
231 259
232 *op_gv = \&op_const; 260 *op_gv = \&op_const;
… …
333 361
334sub op_padsv { 362sub op_padsv {
335 my $flags = $op->flags; 363 my $flags = $op->flags;
336 my $padofs = "(PADOFFSET)" . $op->targ; 364 my $padofs = "(PADOFFSET)" . $op->targ;
337 365
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#
343
344 $source .= <<EOF; 366 $source .= <<EOF;
345 { 367 {
346 dSP; 368 dSP;
347 SV *sv = PAD_SVl ($padofs); 369 SV *sv = PAD_SVl ($padofs);
348EOF 370EOF
349 371
350 if (($flags & B::OPf_MOD) && ($op->private & B::OPpLVAL_INTRO)) { 372 if (($flags & B::OPf_MOD) && ($op->private & B::OPpLVAL_INTRO)) {
351 $source .= " SAVECLEARSV (PAD_SVl ($padofs));\n"; 373 $source .= " SAVECLEARSV (PAD_SVl ($padofs));\n";
352 $ops[0]{pre_padsv_lval_intro}++ if @ops;#d# 374 $ops[0]{follows_padsv_lval_intro}++ if @ops;#d#
353 } 375 }
354 376
355 $source .= <<EOF; 377 $source .= <<EOF;
356 PUSHs (sv); 378 PUSHs (sv);
357 PUTBACK; 379 PUTBACK;
358EOF 380EOF
359 381
360 if (($flags & B::OPf_MOD) && ($op->private & B::OPpDEREF)) { 382 if (($flags & B::OPf_MOD) && ($op->private & B::OPpDEREF)) {
361 $source .= " vivify_ref (sv, $flags & OPpDEREF);\n"; 383 $source .= " if (!SvROK (sv)) vivify_ref (sv, " . $op->private . " & OPpDEREF);\n";
362 } 384 }
363 $source .= " }\n"; 385 $source .= " }\n";
364 386
365 out_next; 387 out_next;
366} 388}
… …
372 dPOPTOPssrl; 394 dPOPTOPssrl;
373EOF 395EOF
374 $source .= " SV *temp = left; left = right; right = temp;\n" 396 $source .= " SV *temp = left; left = right; right = temp;\n"
375 if $op->private & B::OPpASSIGN_BACKWARDS; 397 if $op->private & B::OPpASSIGN_BACKWARDS;
376 398
377 if ($insn->{pre_padsv_lval_intro} && !($op->private & B::OPpASSIGN_BACKWARDS)) { 399 if ($insn->{follows_padsv_lval_intro} && !($op->private & B::OPpASSIGN_BACKWARDS)) {
378 # simple assignment - the target exists, but is basically undef 400 # simple assignment - the target exists, but is basically undef
379 $source .= " SvSetSV (right, left);\n"; 401 $source .= " SvSetSV (right, left);\n";
380 } else { 402 } else {
381 $source .= " SvSetMagicSV (right, left);\n"; 403 $source .= " SvSetMagicSV (right, left);\n";
382 } 404 }
… …
389 411
390 out_next; 412 out_next;
391} 413}
392 414
393# pattern const+ (or general push1) 415# pattern const+ (or general push1)
394# pattern pushmark return(?)
395# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign 416# pattern pushmark gv rv2av pushmark padsv+o.ä. aassign
396 417
397# pattern const method_named
398sub op_method_named { 418sub op_method_named {
419 if ($insn->{follows_const}) {
399 $source .= <<EOF; 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 }
441EOF
442 } else {
443 $source .= <<EOF;
400 { 444 {
401 static HV *last_stash; 445 static HV *last_stash;
402 static SV *last_cv; 446 static SV *last_cv;
403 static U32 last_sub_generation; 447 static U32 last_sub_generation;
404 448
… …
431 /* error case usually */ 475 /* error case usually */
432 PL_op = nextop; nextop = Perl_pp_method_named (aTHX); 476 PL_op = nextop; nextop = Perl_pp_method_named (aTHX);
433 } 477 }
434 } 478 }
435EOF 479EOF
480 }
436 481
437 out_next; 482 out_next;
438} 483}
439 484
440sub op_grepstart { 485sub op_grepstart {
… …
454} 499}
455 500
456sub out_break_op { 501sub out_break_op {
457 my ($idx) = @_; 502 my ($idx) = @_;
458 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];
459 out_callop; 507 out_callop;
460 508 out_jump $next;
461 out_cond_jump $_->[$idx] 509 } elsif (my $loop = $insn->{loop}) {
462 for reverse @op_loop; 510 # less common case: maybe break to some outer loop
463
464 $source .= " return nextop;\n"; 511 $source .= " return nextop;\n";
512 # todo: walk stack up
513 } else {
514 $source .= " return nextop;\n";
515 }
465} 516}
466 517
467sub xop_next { 518sub op_next {
468 out_break_op 0; 519 out_break_op 0;
469} 520}
470 521
471sub op_last { 522sub op_last {
472 out_break_op 1; 523 out_break_op 1;
… …
478 529
479sub cv2c { 530sub cv2c {
480 my ($cv) = @_; 531 my ($cv) = @_;
481 532
482 local @ops; 533 local @ops;
483 local @op_loop;
484 local %op_regcomp; 534 local %op_regcomp;
485 535
486 my %opsseen; 536 my $curloop;
487 my @todo = $cv->START; 537 my @todo = $cv->START;
488 my %op_target; 538 my %op_target;
539 my $numpushmark;
540 my $scope;
489 541
542 my %op_seen;
490 while (my $op = shift @todo) { 543 while (my $op = shift @todo) {
544 my $next;
491 for (; $$op; $op = $op->next) { 545 for (; $$op; $op = $next) {
492 last if $opsseen{$$op}++; 546 last if $op_seen{$$op}++;
547
548 $next = $op->next;
493 549
494 my $name = $op->name; 550 my $name = $op->name;
495 my $class = B::class $op; 551 my $class = B::class $op;
496 552
497 my $insn = { op => $op }; 553 my $insn = { op => $op };
554
555 # end of loop reached?
556 $curloop = $curloop->{loop} if $curloop && $$op == ${$curloop->{loop_targ}[1]};
557
558 # remember enclosing loop
559 $insn->{loop} = $curloop if $curloop;
498 560
499 push @ops, $insn; 561 push @ops, $insn;
500 562
501 if (exists $extend{$name}) { 563 if (exists $extend{$name}) {
502 my $extend = $extend{$name}; 564 my $extend = $extend{$name};
503 $extend = $extend->($op) if ref $extend; 565 $extend = $extend->($op) if ref $extend;
504 $insn->{extend} = $extend if defined $extend; 566 $insn->{extend} = $extend if defined $extend;
505 } 567 }
506 568
507 push @todo, $op->next; 569 # TODO: mark scopes similar to loops, make them comparable
508 570 # static cxstack(?)
509 if ($class eq "LOGOP") { 571 if ($class eq "LOGOP") {
510 push @todo, $op->other; 572 push @todo, $op->other;
511 $op_target{${$op->other}}++; 573 $op_target{${$op->other}}++;
512 574
513 # regcomp/o patches ops at runtime, lets expect that 575 # regcomp/o patches ops at runtime, lets expect that
… …
521 unshift @todo, $op->pmreplstart; 583 unshift @todo, $op->pmreplstart;
522 $op_target{${$op->pmreplstart}}++; 584 $op_target{${$op->pmreplstart}}++;
523 } 585 }
524 586
525 } elsif ($class eq "LOOP") { 587 } elsif ($class eq "LOOP") {
526 my @targ = ($op->nextop, $op->lastop->next, $op->redoop->next); 588 my @targ = ($op->nextop, $op->lastop->next, $op->redoop);
527 589
528 push @op_loop, \@targ; 590 unshift @todo, $next, $op->redoop, $op->nextop, $op->lastop;
529 push @todo, @targ; 591 $next = $op->redoop;
530 592
531 $op_target{$$_}++ for @targ; 593 $op_target{$$_}++ for @targ;
594
595 $insn->{loop_targ} = \@targ;
596 $curloop = $insn;
597
532 } elsif ($class eq "COP") { 598 } elsif ($class eq "COP") {
533 $insn->{bblock}++ if defined $op->label; 599 if (defined $op->label) {
600 $insn->{bblock}++;
601 $curloop->{contains_label}{$op->label}++ if $curloop; #TODO: should be within loop
602 }
603
604 } else {
605 if ($name eq "pushmark") {
606 $numpushmark++;
607 }
534 } 608 }
535 } 609 }
536 } 610 }
537 611
538 $_->{bblock}++ for grep $op_target{${$_->{op}}}, @ops; 612 $_->{bblock}++ for grep $op_target{${$_->{op}}}, @ops;
… …
540 local $source = <<EOF; 614 local $source = <<EOF;
541OP *%%%FUNC%%% (pTHX) 615OP *%%%FUNC%%% (pTHX)
542{ 616{
543 register OP *nextop = (OP *)${$ops[0]->{op}}L; 617 register OP *nextop = (OP *)${$ops[0]->{op}}L;
544EOF 618EOF
619
620 $source .= " faster_PUSHMARK_PREALLOC ($numpushmark);\n"
621 if $numpushmark;
545 622
546 while (@ops) { 623 while (@ops) {
547 $insn = shift @ops; 624 $insn = shift @ops;
548 625
549 $op = $insn->{op}; 626 $op = $insn->{op};
… …
612 689
613 $source 690 $source
614} 691}
615 692
616my $uid = "aaaaaaa0"; 693my $uid = "aaaaaaa0";
694my %so;
617 695
618sub source2ptr { 696sub func2ptr {
619 my (@source) = @_; 697 my (@func) = @_;
620 698
621 my $stem = "/tmp/Faster-$$-" . $uid++; 699 #LOCK
700 mkdir $CACHEDIR, 0777;
701 sysopen my $meta_fh, "$CACHEDIR/meta", &Fcntl::O_RDWR | &Fcntl::O_CREAT, 0666
702 or die "$$CACHEDIR/meta: $!";
703 binmode $meta_fh, ":raw:perlio";
704 fcntl_lock fileno $meta_fh
705 or die "$CACHEDIR/meta: $!";
622 706
707 my $meta = eval { Storable::fd_retrieve $meta_fh } || { version => 1 };
708
709 for my $f (@func) {
710 $f->{func} = "F" . Digest::MD5::md5_hex ($f->{source});
711 $f->{so} = $meta->{$f->{func}};
712 }
713
714 if (grep !$_->{so}, @func) {
715 my $stem;
716
717 do {
718 $stem = "$CACHEDIR/$$-" . $uid++;
719 } while -e "$stem$_so";
720
623 open FILE, ">:raw", "$stem.c"; 721 open my $fh, ">:raw", "$stem.c";
624 print FILE <<EOF; 722 print $fh <<EOF;
625#define PERL_NO_GET_CONTEXT 723#define PERL_NO_GET_CONTEXT
626#define PERL_CORE 724#define PERL_CORE
627 725
628#include <assert.h> 726#include <assert.h>
629 727
630#include "EXTERN.h" 728#include "EXTERN.h"
631#include "perl.h" 729#include "perl.h"
632#include "XSUB.h" 730#include "XSUB.h"
633 731
732#if 1
733# define faster_PUSHMARK_PREALLOC(count) while (PL_markstack_ptr + (count) >= PL_markstack_max) markstack_grow ()
734# define faster_PUSHMARK(p) *++PL_markstack_ptr = (p) - PL_stack_base
735#else
736# define faster_PUSHMARK_PREALLOC(count) 1
737# define faster_PUSHMARK(p) PUSHMARK(p)
738#endif
739
634#define RUNOPS_TILL(op) \\ 740#define RUNOPS_TILL(op) \\
635while (nextop != (op)) \\ 741 while (nextop != (op)) \\
636 { \\ 742 { \\
637 PERL_ASYNC_CHECK (); \\ 743 PERL_ASYNC_CHECK (); \\
638 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\ 744 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\
639 }
640
641EOF
642 for (@source) {
643 my $func = $uid++;
644 $_ =~ s/%%%FUNC%%%/$func/g;
645 print FILE $_;
646 $_ = $func;
647 } 745 }
648 746
649 close FILE; 747EOF
748 for my $f (grep !$_->{so}, @func) {
749 next if $f->{so} = $meta->{$f->{func}}; # some cv's alias others
750
751 warn "compiling $f->{name} to $stem$_so:$f->{func}\n" if $verbose > 1;
752 my $source = $f->{source};
753 $source =~ s/%%%FUNC%%%/$f->{func}/g;
754 print $fh $source;
755 $meta->{$f->{func}} = $f->{so} = $stem;
756 }
757
758 close $fh;
650 system "$COMPILE -o $stem$_o $stem.c"; 759 system "$COMPILE -o $stem$_o $stem.c";
651 #d#unlink "$stem.c"; 760 unlink "$stem.c" unless $ENV{FASTER_DEBUG} & 1;
652 system "$LINK -o $stem$_so $stem$_o $LIBS"; 761 system "$LINK -o $stem$_so $stem$_o $LIBS";
653 unlink "$stem$_o"; 762 unlink "$stem$_o";
763 }
654 764
765 for my $f (@func) {
766 my $stem = $f->{so};
767
655 my $so = DynaLoader::dl_load_file "$stem$_so" 768 my $so = ($so{$stem} ||= DynaLoader::dl_load_file "$stem$_so")
656 or die "$stem$_so: $!"; 769 or die "$stem$_so: $!";
657 770
658 #unlink "$stem$_so"; 771 #unlink "$stem$_so";
659 772
660 map +(DynaLoader::dl_find_symbol $so, $_), @source 773 $f->{ptr} = DynaLoader::dl_find_symbol $so, $f->{func}
774 or die "$f->{func} not found in $stem$_so: $!";
775 }
776
777 seek $meta_fh, 0, 0 or die "$CACHEDIR/meta: $!";
778 Storable::nstore_fd $meta, $meta_fh;
779 truncate $meta_fh, tell $meta_fh;
780
781 # UNLOCK (by closing $meta_fh)
661} 782}
662 783
663my %ignore; 784my %ignore;
664 785
665sub entersub { 786sub entersub {
… …
667 788
668 my $pkg = $cv->STASH->NAME; 789 my $pkg = $cv->STASH->NAME;
669 790
670 return if $ignore{$pkg}; 791 return if $ignore{$pkg};
671 792
672 warn "compiling ", $cv->STASH->NAME, "\n" 793 warn "optimising ", $cv->STASH->NAME, "\n"
673 if $verbose; 794 if $verbose;
674 795
675 eval { 796 eval {
676 my @cv; 797 my @func;
677 my @cv_source; 798
799 push @func, {
800 cv => $cv,
801 name => "<>",
802 source => cv2c $cv,
803 };
678 804
679 # always compile the whole stash 805 # always compile the whole stash
680 my %stash = $cv->STASH->ARRAY; 806 my %stash = $cv->STASH->ARRAY;
681 while (my ($k, $v) = each %stash) { 807 while (my ($k, $v) = each %stash) {
682 $v->isa (B::GV::) 808 $v->isa (B::GV::)
… …
685 my $cv = $v->CV; 811 my $cv = $v->CV;
686 812
687 if ($cv->isa (B::CV::) 813 if ($cv->isa (B::CV::)
688 && ${$cv->START} 814 && ${$cv->START}
689 && $cv->START->name ne "null") { 815 && $cv->START->name ne "null") {
816
690 push @cv, $cv; 817 push @func, {
818 cv => $cv,
819 name => $k,
691 push @cv_source, cv2c $cv; 820 source => cv2c $cv,
821 };
692 } 822 }
693 } 823 }
694 824
695 my @ptr = source2ptr @cv_source; 825 func2ptr @func;
696 826
697 for (0 .. $#cv) { 827 for my $f (@func) {
698 patch_cv $cv[$_], $ptr[$_]; 828 patch_cv $f->{cv}, $f->{ptr};
699 } 829 }
700 }; 830 };
701 831
702 if ($@) { 832 if ($@) {
703 $ignore{$pkg}++; 833 $ignore{$pkg}++;
… …
718=over 4 848=over 4
719 849
720=item FASTER_VERBOSE 850=item FASTER_VERBOSE
721 851
722Faster will output more informational messages when set to values higher 852Faster will output more informational messages when set to values higher
723than C<0>. Currently, C<1> outputs which packages are being compiled. 853than C<0>. Currently, C<1> outputs which packages are being compiled, C<3>
854outputs the cache directory and C<10> outputs information on which perl
855function is compiled into which shared object.
724 856
725=item FASTER_DEBUG 857=item FASTER_DEBUG
726 858
727Add debugging code when set to values higher than C<0>. Currently, this 859Add 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 860adds 1-3 C<assert>'s per perl op (FASTER_DEBUG > 1), to ensure that opcode
729execution order are compatible. 861order and C execution order are compatible.
730 862
731=item FASTER_CACHE 863=item FASTER_CACHE
732 864
733NOT YET IMPLEMENTED
734
735Set a persistent cache directory that caches compiled code 865Set a persistent cache directory that caches compiled code fragments. The
736fragments. Normally, code compiled by Faster will be deleted immediately, 866default is C<$HOME/.perl-faster-cache> if C<HOME> is set and a temporary
737and every restart will recompile everything. Setting this variable to a 867directory otherwise.
738directory makes Faster cache the generated files for re-use.
739 868
740This directory will always grow in contents, so you might need to erase it 869This directory will always grow in size, so you might need to erase it
741from time to time. 870from time to time.
742 871
743=back 872=back
744 873
745=head1 BUGS/LIMITATIONS 874=head1 BUGS/LIMITATIONS
… …
761These constructs will force the use of the interpreter for the currently 890These constructs will force the use of the interpreter for the currently
762executed function as soon as they are being encountered during execution. 891executed function as soon as they are being encountered during execution.
763 892
764 goto 893 goto
765 next, redo (but not well-behaved last's) 894 next, redo (but not well-behaved last's)
895 labels, if used
766 eval 896 eval
767 require 897 require
768 any use of formats 898 any use of formats
769 .., ... (flipflop operators) 899 .., ... (flipflop operators)
770 900

Diff Legend

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