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

Comparing Faster/Faster.pm (file contents):
Revision 1.33 by root, Mon Mar 13 17:10:32 2006 UTC vs.
Revision 1.34 by root, Wed Mar 15 02:32:27 2006 UTC

… …
72 File::Temp::tempdir (CLEANUP => 1) 72 File::Temp::tempdir (CLEANUP => 1)
73 }; 73 };
74 74
75my $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}";
76my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}"; 76my $LINK = "$Config{ld} $Config{ldflags} $Config{lddlflags} $Config{ccdlflags}";
77my $LIBS = "$Config{libs}"; 77my $LIBS = "";
78my $_o = $Config{_o}; 78my $_o = $Config{_o};
79my $_so = ".so"; 79my $_so = ".so";
80 80
81# we don't need no steenking PIC on x86 81# we don't need no steenking PIC on x86
82$COMPILE =~ s/-f(?:PIC|pic)//g 82$COMPILE =~ s/-f(?:PIC|pic)//g
83 if $Config{archname} =~ /^(i[3456]86)-/; 83 if $Config{archname} =~ /^(i[3456]86)-/;
84 84
85my $opt_assert = $ENV{FASTER_DEBUG} > 1; 85my $opt_assert = $ENV{FASTER_DEBUG} & 2;
86my $verbose = $ENV{FASTER_VERBOSE}+0; 86my $verbose = $ENV{FASTER_VERBOSE}+0;
87 87
88warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2; 88warn "Faster: CACHEDIR is $CACHEDIR\n" if $verbose > 2;
89 89
90our $source; 90our $source;
91 91
92our @ops; 92our @ops;
93our $insn; 93our $insn;
94our $op; 94our $op;
95our $op_name; 95our $op_name;
96our @op_loop;
97our %op_regcomp; 96our %op_regcomp;
98 97
99# ops that cause immediate return to the interpreter 98# ops that cause immediate return to the interpreter
100my %f_unsafe = map +($_ => undef), qw( 99my %f_unsafe = map +($_ => undef), qw(
101 leavesub leavesublv return 100 leavesub leavesublv return
… …
195sub out_callop { 194sub out_callop {
196 assert "nextop == (OP *)$$op"; 195 assert "nextop == (OP *)$$op";
197 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n"; 196 $source .= " PL_op = nextop; nextop = " . (callop $op) . ";\n";
198} 197}
199 198
199sub out_jump {
200 assert "nextop == (OP *)${$_[0]}L";
201 $source .= " goto op_${$_[0]};\n";
202}
203
200sub out_cond_jump { 204sub out_cond_jump {
201 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n"; 205 $source .= " if (nextop == (OP *)${$_[0]}L) goto op_${$_[0]};\n";
202} 206}
203 207
204sub out_jump_next { 208sub out_jump_next {
… …
495} 499}
496 500
497sub out_break_op { 501sub out_break_op {
498 my ($idx) = @_; 502 my ($idx) = @_;
499 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];
500 out_callop; 507 out_callop;
501 508 out_jump $next;
502 out_cond_jump $_->[$idx] 509 } elsif (my $loop = $insn->{loop}) {
503 for reverse @op_loop; 510 # less common case: maybe break to some outer loop
504
505 $source .= " return nextop;\n"; 511 $source .= " return nextop;\n";
512 # todo: walk stack up
513 } else {
514 $source .= " return nextop;\n";
515 }
506} 516}
507 517
508sub xop_next { 518sub op_next {
509 out_break_op 0; 519 out_break_op 0;
510} 520}
511 521
512sub op_last { 522sub op_last {
513 out_break_op 1; 523 out_break_op 1;
… …
519 529
520sub cv2c { 530sub cv2c {
521 my ($cv) = @_; 531 my ($cv) = @_;
522 532
523 local @ops; 533 local @ops;
524 local @op_loop;
525 local %op_regcomp; 534 local %op_regcomp;
526 535
527 my %opsseen; 536 my $curloop;
528 my @todo = $cv->START; 537 my @todo = $cv->START;
529 my %op_target; 538 my %op_target;
530 my $numpushmark; 539 my $numpushmark;
540 my $scope;
531 541
542 my %op_seen;
532 while (my $op = shift @todo) { 543 while (my $op = shift @todo) {
544 my $next;
533 for (; $$op; $op = $op->next) { 545 for (; $$op; $op = $next) {
534 last if $opsseen{$$op}++; 546 last if $op_seen{$$op}++;
547
548 $next = $op->next;
535 549
536 my $name = $op->name; 550 my $name = $op->name;
537 my $class = B::class $op; 551 my $class = B::class $op;
538 552
539 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;
540 560
541 push @ops, $insn; 561 push @ops, $insn;
542 562
543 if (exists $extend{$name}) { 563 if (exists $extend{$name}) {
544 my $extend = $extend{$name}; 564 my $extend = $extend{$name};
545 $extend = $extend->($op) if ref $extend; 565 $extend = $extend->($op) if ref $extend;
546 $insn->{extend} = $extend if defined $extend; 566 $insn->{extend} = $extend if defined $extend;
547 } 567 }
548 568
549 push @todo, $op->next; 569 # TODO: mark scopes similar to loops, make them comparable
550 570 # static cxstack(?)
551 if ($class eq "LOGOP") { 571 if ($class eq "LOGOP") {
552 push @todo, $op->other; 572 push @todo, $op->other;
553 $op_target{${$op->other}}++; 573 $op_target{${$op->other}}++;
554 574
555 # regcomp/o patches ops at runtime, lets expect that 575 # regcomp/o patches ops at runtime, lets expect that
… …
563 unshift @todo, $op->pmreplstart; 583 unshift @todo, $op->pmreplstart;
564 $op_target{${$op->pmreplstart}}++; 584 $op_target{${$op->pmreplstart}}++;
565 } 585 }
566 586
567 } elsif ($class eq "LOOP") { 587 } elsif ($class eq "LOOP") {
568 my @targ = ($op->nextop, $op->lastop->next, $op->redoop->next); 588 my @targ = ($op->nextop, $op->lastop->next, $op->redoop);
569 589
570 push @op_loop, \@targ; 590 unshift @todo, $next, $op->redoop, $op->nextop, $op->lastop;
571 push @todo, @targ; 591 $next = $op->redoop;
572 592
573 $op_target{$$_}++ for @targ; 593 $op_target{$$_}++ for @targ;
574 594
595 $insn->{loop_targ} = \@targ;
596 $curloop = $insn;
597
575 } elsif ($class eq "COP") { 598 } elsif ($class eq "COP") {
576 $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 }
577 603
578 } else { 604 } else {
579 if ($name eq "pushmark") { 605 if ($name eq "pushmark") {
580 $numpushmark++; 606 $numpushmark++;
581 } 607 }
… …
729 $meta->{$f->{func}} = $f->{so} = $stem; 755 $meta->{$f->{func}} = $f->{so} = $stem;
730 } 756 }
731 757
732 close $fh; 758 close $fh;
733 system "$COMPILE -o $stem$_o $stem.c"; 759 system "$COMPILE -o $stem$_o $stem.c";
734 unlink "$stem.c" unless $ENV{FASTER_DEBUG} > 0; 760 unlink "$stem.c" unless $ENV{FASTER_DEBUG} & 1;
735 system "$LINK -o $stem$_so $stem$_o $LIBS"; 761 system "$LINK -o $stem$_so $stem$_o $LIBS";
736 unlink "$stem$_o"; 762 unlink "$stem$_o";
737 } 763 }
738 764
739 for my $f (@func) { 765 for my $f (@func) {
… …
864These constructs will force the use of the interpreter for the currently 890These constructs will force the use of the interpreter for the currently
865executed function as soon as they are being encountered during execution. 891executed function as soon as they are being encountered during execution.
866 892
867 goto 893 goto
868 next, redo (but not well-behaved last's) 894 next, redo (but not well-behaved last's)
895 labels, if used
869 eval 896 eval
870 require 897 require
871 any use of formats 898 any use of formats
872 .., ... (flipflop operators) 899 .., ... (flipflop operators)
873 900

Diff Legend

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