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

Comparing Faster/Faster.pm (file contents):
Revision 1.28 by root, Sun Mar 12 17:03:39 2006 UTC vs.
Revision 1.29 by root, Sun Mar 12 21:36:00 2006 UTC

… …
26 26
27Usage is very easy, just C<use Faster> and every function called from then 27Usage is very easy, just C<use Faster> and every function called from then
28on will be compiled. 28on will be compiled.
29 29
30Right now, Faster will leave lots of F<*.c>, F<*.o> and F<*.so> files in 30Right now, Faster will leave lots of F<*.c>, F<*.o> and F<*.so> files in
31your F<$FASTER_CACHEDIR> (by default F<$HOME/.perl-faster-cache>), and it
31F</tmp>, and it will even create those temporary files in an insecure 32will even create those temporary files in an insecure manner, so watch
32manner, so watch out. 33out.
33 34
34=over 4 35=over 4
35 36
36=cut 37=cut
37 38
… …
40no warnings; 41no warnings;
41 42
42use strict; 43use strict;
43use Config; 44use Config;
44use B (); 45use B ();
45#use Digest::MD5 ();
46use DynaLoader (); 46use DynaLoader ();
47use Digest::MD5 (); 47use Digest::MD5 ();
48use Storable (); 48use Storable ();
49use Fcntl ();
49 50
50BEGIN { 51BEGIN {
51 our $VERSION = '0.01'; 52 our $VERSION = '0.01';
52 53
53 require XSLoader; 54 require XSLoader;
54 XSLoader::load __PACKAGE__, $VERSION; 55 XSLoader::load __PACKAGE__, $VERSION;
55} 56}
56 57
57my $CACHEDIR = $ENV{FASTER_CACHE} || do { 58my $CACHEDIR =
59 $ENV{FASTER_CACHE}
60 || (exists $ENV{HOME} && "$ENV{HOME}/.perl-faster-cache")
61 || do {
58 require File::Temp; 62 require File::Temp;
59 File::Temp::tempdir (CLEANUP => 1) 63 File::Temp::tempdir (CLEANUP => 1)
60}; 64 };
61 65
62my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}"; 66my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}";
63my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}"; 67my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
64my $LIBS = "$Config{libs}"; 68my $LIBS = "$Config{libs}";
65my $_o = $Config{_o}; 69my $_o = $Config{_o};
… …
69$COMPILE =~ s/-f(?:PIC|pic)//g 73$COMPILE =~ s/-f(?:PIC|pic)//g
70 if $Config{archname} =~ /^(i[3456]86)-/; 74 if $Config{archname} =~ /^(i[3456]86)-/;
71 75
72my $opt_assert = $ENV{FASTER_DEBUG}; 76my $opt_assert = $ENV{FASTER_DEBUG};
73my $verbose = $ENV{FASTER_VERBOSE}+0; 77my $verbose = $ENV{FASTER_VERBOSE}+0;
78
79warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2;
74 80
75our $source; 81our $source;
76 82
77our @ops; 83our @ops;
78our $insn; 84our $insn;
… …
643 649
644sub func2ptr { 650sub func2ptr {
645 my (@func) = @_; 651 my (@func) = @_;
646 652
647 #LOCK 653 #LOCK
654 mkdir $CACHEDIR, 0777;
655 sysopen my $meta_fh, "$CACHEDIR/meta", &Fcntl::O_RDWR | &Fcntl::O_CREAT, 0666
656 or die "$$CACHEDIR/meta: $!";
657 binmode $meta_fh, ":raw:perlio";
658 fcntl_lock fileno $meta_fh
659 or die "$CACHEDIR/meta: $!";
660
648 my $meta = eval { Storable::retrieve "$CACHEDIR/meta" } || { version => 1 }; 661 my $meta = eval { Storable::fd_retrieve $meta_fh } || { version => 1 };
649 662
650 for my $f (@func) { 663 for my $f (@func) {
651 $f->{func} = "F" . Digest::MD5::md5_hex ($f->{source}); 664 $f->{func} = "F" . Digest::MD5::md5_hex ($f->{source});
652 $f->{so} = $meta->{$f->{func}}; 665 $f->{so} = $meta->{$f->{func}};
653 } 666 }
… …
688 $meta->{$f->{func}} = $f->{so} = $stem; 701 $meta->{$f->{func}} = $f->{so} = $stem;
689 } 702 }
690 703
691 close $fh; 704 close $fh;
692 system "$COMPILE -o $stem$_o $stem.c"; 705 system "$COMPILE -o $stem$_o $stem.c";
693 #d#unlink "$stem.c"; 706 unlink "$stem.c";
694 system "$LINK -o $stem$_so $stem$_o $LIBS"; 707 system "$LINK -o $stem$_so $stem$_o $LIBS";
695 unlink "$stem$_o"; 708 unlink "$stem$_o";
696 } 709 }
697 710
698 for my $f (@func) { 711 for my $f (@func) {
… …
705 718
706 $f->{ptr} = DynaLoader::dl_find_symbol $so, $f->{func} 719 $f->{ptr} = DynaLoader::dl_find_symbol $so, $f->{func}
707 or die "$f->{func} not found in $stem$_so: $!"; 720 or die "$f->{func} not found in $stem$_so: $!";
708 } 721 }
709 722
723 seek $meta_fh, 0, 0 or die "$CACHEDIR/meta: $!";
710 Storable::nstore $meta, "$CACHEDIR/meta"; 724 Storable::nstore_fd $meta, $meta_fh;
711 # UNLOCK 725 truncate $meta_fh, tell $meta_fh;
726
727 # UNLOCK (by closing $meta_fh)
712} 728}
713 729
714my %ignore; 730my %ignore;
715 731
716sub entersub { 732sub entersub {
… …
778=over 4 794=over 4
779 795
780=item FASTER_VERBOSE 796=item FASTER_VERBOSE
781 797
782Faster will output more informational messages when set to values higher 798Faster will output more informational messages when set to values higher
783than C<0>. Currently, C<1> outputs which packages are being compiled. 799than C<0>. Currently, C<1> outputs which packages are being compiled, C<3>
800outputs the cache directory and C<10> outputs information on which perl
801function is compiled into which shared object.
784 802
785=item FASTER_DEBUG 803=item FASTER_DEBUG
786 804
787Add debugging code when set to values higher than C<0>. Currently, this 805Add debugging code when set to values higher than C<0>. Currently, this
788adds 1-3 C<assert>'s per perl op, to ensure that opcode order and C 806adds 1-3 C<assert>'s per perl op, to ensure that opcode order and C
789execution order are compatible. 807execution order are compatible.
790 808
791=item FASTER_CACHE 809=item FASTER_CACHE
792 810
793NOT YET IMPLEMENTED CORRECTLY, SHARING BEETWEEN INSTANCES IS IMPOSSIBLE
794
795Set a persistent cache directory that caches compiled code 811Set a persistent cache directory that caches compiled code fragments. The
796fragments. Normally, code compiled by Faster will be deleted immediately, 812default is C<$HOME/.perl-faster-cache> if C<HOME> is set and a temporary
797and every restart will recompile everything. Setting this variable to a 813directory otherwise.
798directory makes Faster cache the generated files for re-use.
799 814
800This directory will always grow in contents, so you might need to erase it 815This directory will always grow in size, so you might need to erase it
801from time to time. 816from time to time.
802 817
803=back 818=back
804 819
805=head1 BUGS/LIMITATIONS 820=head1 BUGS/LIMITATIONS

Diff Legend

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