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

Comparing Faster/Faster.pm (file contents):
Revision 1.26 by root, Sat Mar 11 18:13:35 2006 UTC vs.
Revision 1.27 by root, Sat Mar 11 23:06:59 2006 UTC

… …
42use strict; 42use strict;
43use Config; 43use Config;
44use B (); 44use B ();
45#use Digest::MD5 (); 45#use Digest::MD5 ();
46use DynaLoader (); 46use DynaLoader ();
47use File::Temp (); 47use Digest::MD5 ();
48use Storable ();
48 49
49BEGIN { 50BEGIN {
50 our $VERSION = '0.01'; 51 our $VERSION = '0.01';
51 52
52 require XSLoader; 53 require XSLoader;
53 XSLoader::load __PACKAGE__, $VERSION; 54 XSLoader::load __PACKAGE__, $VERSION;
54} 55}
56
57my $CACHEDIR = $ENV{FASTER_CACHE} || do {
58 require File::Temp;
59 File::Temp::tempdir (CLEANUP => 1)
60};
55 61
56my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}"; 62my $COMPILE = "$Config{cc} -c -I$Config{archlibexp}/CORE $Config{optimize} $Config{ccflags} $Config{cccdlflags}";
57my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}"; 63my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
58my $LIBS = "$Config{libs}"; 64my $LIBS = "$Config{libs}";
59my $_o = $Config{_o}; 65my $_o = $Config{_o};
… …
352 PUSHs (sv); 358 PUSHs (sv);
353 PUTBACK; 359 PUTBACK;
354EOF 360EOF
355 361
356 if (($flags & B::OPf_MOD) && ($op->private & B::OPpDEREF)) { 362 if (($flags & B::OPf_MOD) && ($op->private & B::OPpDEREF)) {
357 $source .= " vivify_ref (sv, " . $op->private . " & OPpDEREF);\n"; 363 $source .= " if (!SvROK (sv)) vivify_ref (sv, " . $op->private . " & OPpDEREF);\n";
358 } 364 }
359 $source .= " }\n"; 365 $source .= " }\n";
360 366
361 out_next; 367 out_next;
362} 368}
… …
631 637
632 $source 638 $source
633} 639}
634 640
635my $uid = "aaaaaaa0"; 641my $uid = "aaaaaaa0";
642my %so;
636 643
637sub source2ptr { 644sub func2ptr {
638 my (@source) = @_; 645 my (@func) = @_;
639 646
640 my $stem = "/tmp/Faster-$$-" . $uid++; 647 #LOCK
648 my $meta = eval { Storable::retrieve "$CACHEDIR/meta" } || { version => 1 };
641 649
650 for my $f (@func) {
651 $f->{func} = "F" . Digest::MD5::md5_hex ($f->{source});
652 $f->{so} = $meta->{$f->{func}};
653 }
654
655 if (grep !$_->{so}, @func) {
656 my $stem;
657
658 do {
659 $stem = "$CACHEDIR/$$-" . $uid++;
660 } while -e "$stem$_so";
661
642 open FILE, ">:raw", "$stem.c"; 662 open my $fh, ">:raw", "$stem.c";
643 print FILE <<EOF; 663 print $fh <<EOF;
644#define PERL_NO_GET_CONTEXT 664#define PERL_NO_GET_CONTEXT
645#define PERL_CORE 665#define PERL_CORE
646 666
647#include <assert.h> 667#include <assert.h>
648 668
649#include "EXTERN.h" 669#include "EXTERN.h"
650#include "perl.h" 670#include "perl.h"
651#include "XSUB.h" 671#include "XSUB.h"
652 672
653#define RUNOPS_TILL(op) \\ 673#define RUNOPS_TILL(op) \\
654while (nextop != (op)) \\ 674 while (nextop != (op)) \\
655 { \\ 675 { \\
656 PERL_ASYNC_CHECK (); \\ 676 PERL_ASYNC_CHECK (); \\
657 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\ 677 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\
658 }
659
660EOF
661 for (@source) {
662 my $func = $uid++;
663 $_ =~ s/%%%FUNC%%%/$func/g;
664 print FILE $_;
665 $_ = $func;
666 } 678 }
667 679
668 close FILE; 680EOF
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;
669 system "$COMPILE -o $stem$_o $stem.c"; 692 system "$COMPILE -o $stem$_o $stem.c";
670 #d#unlink "$stem.c"; 693 #d#unlink "$stem.c";
671 system "$LINK -o $stem$_so $stem$_o $LIBS"; 694 system "$LINK -o $stem$_so $stem$_o $LIBS";
672 unlink "$stem$_o"; 695 unlink "$stem$_o";
696 }
673 697
698 for my $f (@func) {
699 my $stem = $f->{so};
700
674 my $so = DynaLoader::dl_load_file "$stem$_so" 701 my $so = ($so{$stem} ||= DynaLoader::dl_load_file "$stem$_so")
675 or die "$stem$_so: $!"; 702 or die "$stem$_so: $!";
676 703
677 #unlink "$stem$_so"; 704 #unlink "$stem$_so";
678 705
679 map +(DynaLoader::dl_find_symbol $so, $_), @source 706 $f->{ptr} = DynaLoader::dl_find_symbol $so, $f->{func}
707 or die "$f->{func} not found in $stem$_so: $!";
708 }
709
710 Storable::nstore $meta, "$CACHEDIR/meta";
711 # UNLOCK
680} 712}
681 713
682my %ignore; 714my %ignore;
683 715
684sub entersub { 716sub entersub {
… …
686 718
687 my $pkg = $cv->STASH->NAME; 719 my $pkg = $cv->STASH->NAME;
688 720
689 return if $ignore{$pkg}; 721 return if $ignore{$pkg};
690 722
691 warn "compiling ", $cv->STASH->NAME, "\n" 723 warn "optimising ", $cv->STASH->NAME, "\n"
692 if $verbose; 724 if $verbose;
693 725
694 eval { 726 eval {
695 my @cv; 727 my @func;
696 my @cv_source;
697 728
698 # always compile the whole stash 729 # always compile the whole stash
699 my %stash = $cv->STASH->ARRAY; 730 my %stash = $cv->STASH->ARRAY;
700 while (my ($k, $v) = each %stash) { 731 while (my ($k, $v) = each %stash) {
701 $v->isa (B::GV::) 732 $v->isa (B::GV::)
… …
704 my $cv = $v->CV; 735 my $cv = $v->CV;
705 736
706 if ($cv->isa (B::CV::) 737 if ($cv->isa (B::CV::)
707 && ${$cv->START} 738 && ${$cv->START}
708 && $cv->START->name ne "null") { 739 && $cv->START->name ne "null") {
740
709 push @cv, $cv; 741 push @func, {
742 cv => $cv,
743 name => $k,
710 push @cv_source, cv2c $cv; 744 source => cv2c $cv,
745 };
711 } 746 }
712 } 747 }
713 748
714 my @ptr = source2ptr @cv_source; 749 func2ptr @func;
715 750
716 for (0 .. $#cv) { 751 for my $f (@func) {
717 patch_cv $cv[$_], $ptr[$_]; 752 patch_cv $f->{cv}, $f->{ptr};
718 } 753 }
719 }; 754 };
720 755
721 if ($@) { 756 if ($@) {
722 $ignore{$pkg}++; 757 $ignore{$pkg}++;
… …
747adds 1-3 C<assert>'s per perl op, to ensure that opcode order and C 782adds 1-3 C<assert>'s per perl op, to ensure that opcode order and C
748execution order are compatible. 783execution order are compatible.
749 784
750=item FASTER_CACHE 785=item FASTER_CACHE
751 786
752NOT YET IMPLEMENTED 787NOT YET IMPLEMENTED CORRECTLY, SHARING BEETWEEN INSTANCES IS IMPOSSIBLE
753 788
754Set a persistent cache directory that caches compiled code 789Set a persistent cache directory that caches compiled code
755fragments. Normally, code compiled by Faster will be deleted immediately, 790fragments. Normally, code compiled by Faster will be deleted immediately,
756and every restart will recompile everything. Setting this variable to a 791and every restart will recompile everything. Setting this variable to a
757directory makes Faster cache the generated files for re-use. 792directory makes Faster cache the generated files for re-use.

Diff Legend

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