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

Comparing Faster/Faster.pm (file contents):
Revision 1.29 by root, Sun Mar 12 21:36:00 2006 UTC vs.
Revision 1.30 by root, Mon Mar 13 16:59:36 2006 UTC

71 71
72# we don't need no steenking PIC on x86 72# we don't need no steenking PIC on x86
73$COMPILE =~ s/-f(?:PIC|pic)//g 73$COMPILE =~ s/-f(?:PIC|pic)//g
74 if $Config{archname} =~ /^(i[3456]86)-/; 74 if $Config{archname} =~ /^(i[3456]86)-/;
75 75
76my $opt_assert = $ENV{FASTER_DEBUG}; 76my $opt_assert = $ENV{FASTER_DEBUG} > 1;
77my $verbose = $ENV{FASTER_VERBOSE}+0; 77my $verbose = $ENV{FASTER_VERBOSE}+0;
78 78
79warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2; 79warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2;
80 80
81our $source; 81our $source;
145# ops that do not need an ASYNC_CHECK 145# ops that do not need an ASYNC_CHECK
146my %f_noasync = map +($_ => undef), qw( 146my %f_noasync = map +($_ => undef), qw(
147 mapstart grepstart match entereval 147 mapstart grepstart match entereval
148 enteriter entersub leaveloop 148 enteriter entersub leaveloop
149 149
150 pushmark nextstate 150 pushmark nextstate caller
151 151
152 const stub unstack 152 const stub unstack
153 last next redo seq 153 last next redo goto seq
154 padsv padav padhv padany 154 padsv padav padhv padany
155 aassign sassign orassign 155 aassign sassign orassign
156 rv2av rv2cv rv2gv rv2hv refgen 156 rv2av rv2cv rv2gv rv2hv refgen
157 gv gvsv 157 gv gvsv
158 add subtract multiply divide 158 add subtract multiply divide
159 complement cond_expr and or not 159 complement cond_expr and or not bit_and bit_or bit_xor
160 defined 160 defined
161 method method_named bless 161 method method_named bless
162 preinc postinc predec postdec 162 preinc postinc predec postdec
163 aelem aelemfast helem delete exists 163 aelem aelemfast helem delete exists
164 pushre subst list join split concat 164 pushre subst list lslice join split concat
165 length substr stringify ord 165 length substr stringify ord
166 push pop shift unshift 166 push pop shift unshift
167 eq ne gt lt ge le 167 eq ne gt lt ge le
168 regcomp regcreset regcmaybe 168 regcomp regcreset regcmaybe
169); 169);
225 225
226 out_next; 226 out_next;
227} 227}
228 228
229sub op_pushmark { 229sub op_pushmark {
230 $source .= " PUSHMARK (PL_stack_sp);\n"; 230 $source .= " faster_PUSHMARK (PL_stack_sp);\n";
231 231
232 out_next; 232 out_next;
233} 233}
234 234
235if ($Config{useithreads} ne "define") { 235if ($Config{useithreads} ne "define") {
515 local %op_regcomp; 515 local %op_regcomp;
516 516
517 my %opsseen; 517 my %opsseen;
518 my @todo = $cv->START; 518 my @todo = $cv->START;
519 my %op_target; 519 my %op_target;
520 my $numpushmark;
520 521
521 while (my $op = shift @todo) { 522 while (my $op = shift @todo) {
522 for (; $$op; $op = $op->next) { 523 for (; $$op; $op = $op->next) {
523 last if $opsseen{$$op}++; 524 last if $opsseen{$$op}++;
524 525
558 559
559 push @op_loop, \@targ; 560 push @op_loop, \@targ;
560 push @todo, @targ; 561 push @todo, @targ;
561 562
562 $op_target{$$_}++ for @targ; 563 $op_target{$$_}++ for @targ;
564
563 } elsif ($class eq "COP") { 565 } elsif ($class eq "COP") {
564 $insn->{bblock}++ if defined $op->label; 566 $insn->{bblock}++ if defined $op->label;
567
568 } else {
569 if ($name eq "pushmark") {
570 $numpushmark++;
571 }
565 } 572 }
566 } 573 }
567 } 574 }
568 575
569 $_->{bblock}++ for grep $op_target{${$_->{op}}}, @ops; 576 $_->{bblock}++ for grep $op_target{${$_->{op}}}, @ops;
571 local $source = <<EOF; 578 local $source = <<EOF;
572OP *%%%FUNC%%% (pTHX) 579OP *%%%FUNC%%% (pTHX)
573{ 580{
574 register OP *nextop = (OP *)${$ops[0]->{op}}L; 581 register OP *nextop = (OP *)${$ops[0]->{op}}L;
575EOF 582EOF
583
584 $source .= " faster_PUSHMARK_PREALLOC ($numpushmark);\n"
585 if $numpushmark;
576 586
577 while (@ops) { 587 while (@ops) {
578 $insn = shift @ops; 588 $insn = shift @ops;
579 589
580 $op = $insn->{op}; 590 $op = $insn->{op};
681 691
682#include "EXTERN.h" 692#include "EXTERN.h"
683#include "perl.h" 693#include "perl.h"
684#include "XSUB.h" 694#include "XSUB.h"
685 695
696#if 1
697# define faster_PUSHMARK_PREALLOC(count) while (PL_markstack_ptr + (count) >= PL_markstack_max) markstack_grow ()
698# define faster_PUSHMARK(p) *++PL_markstack_ptr = (p) - PL_stack_base
699#else
700# define faster_PUSHMARK_PREALLOC(count) 1
701# define faster_PUSHMARK(p) PUSHMARK(p)
702#endif
703
686#define RUNOPS_TILL(op) \\ 704#define RUNOPS_TILL(op) \\
687 while (nextop != (op)) \\ 705 while (nextop != (op)) \\
688 { \\ 706 { \\
689 PERL_ASYNC_CHECK (); \\ 707 PERL_ASYNC_CHECK (); \\
690 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\ 708 PL_op = nextop; nextop = (PL_op->op_ppaddr)(aTHX); \\
701 $meta->{$f->{func}} = $f->{so} = $stem; 719 $meta->{$f->{func}} = $f->{so} = $stem;
702 } 720 }
703 721
704 close $fh; 722 close $fh;
705 system "$COMPILE -o $stem$_o $stem.c"; 723 system "$COMPILE -o $stem$_o $stem.c";
706 unlink "$stem.c"; 724 unlink "$stem.c" unless $ENV{FASTER_DEBUG} > 0;
707 system "$LINK -o $stem$_so $stem$_o $LIBS"; 725 system "$LINK -o $stem$_so $stem$_o $LIBS";
708 unlink "$stem$_o"; 726 unlink "$stem$_o";
709 } 727 }
710 728
711 for my $f (@func) { 729 for my $f (@func) {
801function is compiled into which shared object. 819function is compiled into which shared object.
802 820
803=item FASTER_DEBUG 821=item FASTER_DEBUG
804 822
805Add debugging code when set to values higher than C<0>. Currently, this 823Add debugging code when set to values higher than C<0>. Currently, this
806adds 1-3 C<assert>'s per perl op, to ensure that opcode order and C 824adds 1-3 C<assert>'s per perl op (FASTER_DEBUG > 1), to ensure that opcode
807execution order are compatible. 825order and C execution order are compatible.
808 826
809=item FASTER_CACHE 827=item FASTER_CACHE
810 828
811Set a persistent cache directory that caches compiled code fragments. The 829Set a persistent cache directory that caches compiled code fragments. The
812default is C<$HOME/.perl-faster-cache> if C<HOME> is set and a temporary 830default is C<$HOME/.perl-faster-cache> if C<HOME> is set and a temporary

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines