compiler fixes from Vishal Bhatia <vishalb@hotmail.com>

	Date: Tue, 30 Mar 1999 23:40:34 PST
	Message-ID: <19990331074034.6117.qmail@hotmail.com>
	Subject: [PATCH 5.005_56] pp_entersub and pp_leavewrite(CC.pm)
	--
	Date: Wed, 07 Apr 1999 00:28:23 -0800
	Message-ID: <FGBNLNPOEELFAAAA@my-dejanews.com>
	Subject: [PATCH 5.005_56] function prototypes(B.pm)
	--
	Date: Thu, 22 Apr 1999 23:40:52 -0700
	Message-ID: <OEAOMKBMLDADCAAA@my-dejanews.com>
	Subject: [PATCH 5.005_56 ] discarding worthless padsvs
	--
	Date: Tue, 27 Apr 1999 01:14:49 PDT
	Message-ID: <19990427081449.28615.qmail@hotmail.com>
	Subject: [PATCH 5.005_56] pp_ncmp implementation ( CC.pm)

p4raw-id: //depot/perl@3314

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 8fd3baf..f864883 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -188,7 +188,7 @@ sub walksymtable {
     local(*glob);
     $prefix = '' unless defined $prefix;
     while (($sym, $ref) = each %$symref) {
-       *glob = $ref;
+       *glob = "*main::".$prefix.$sym;
        if ($sym =~ /::$/) {
            $sym = $prefix . $sym;
            if ($sym ne "main::" && &$recurse($sym)) {

diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index 2430c51..143ae41 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -92,7 +92,7 @@ sub init_hash { map { $_ => 1 } @_ }
 #
 %skip_lexicals = init_hash qw(pp_enter pp_enterloop);
 %skip_invalidate = init_hash qw(pp_enter pp_enterloop);
-%need_curcop = init_hash qw(pp_rv2gv  pp_bless pp_repeat pp_sort pp_caller pp_reset pp_rv2cv pp_entereval pp_require pp_dofile pp_entertry pp_enterloop pp_enteriter );
+%need_curcop = init_hash qw(pp_rv2gv  pp_bless pp_repeat pp_sort pp_caller pp_reset pp_rv2cv pp_entereval pp_require pp_dofile pp_entertry pp_enterloop pp_enteriter pp_entersub pp_enter);
 
 sub debug {
     if ($debug_runtime) {
@@ -399,12 +399,22 @@ sub load_pad {
        }
        $pad[$ix] = new B::Stackobj::Padsv ($type, $flags, $ix,
                                            "i_$name", "d_$name");
-       declare("IV", $type == T_INT ? "i_$name = 0" : "i_$name");
-       declare("double", $type == T_DOUBLE ? "d_$name = 0" : "d_$name");
+
        debug sprintf("PL_curpad[$ix] = %s\n", $pad[$ix]->peek) if $debug_pad;
     }
 }
 
+sub declare_pad {
+    my $ix;
+    for ($ix = 1; $ix <= $#pad; $ix++) {
+       my $type = $pad[$ix]->{type};
+       declare("IV", $type == T_INT ? 
+               sprintf("%s=0",$pad[$ix]->{iv}):$pad[$ix]->{iv}) if $pad[$ix]->save_int;
+       declare("double", $type == T_DOUBLE ?
+                sprintf("%s = 0",$pad[$ix]->{nv}):$pad[$ix]->{nv} )if $pad[$ix]->save_double;
+
+    }
+}
 #
 # Debugging stuff
 #
@@ -684,6 +694,60 @@ sub numeric_binop {
     return $op->next;
 }
 
+sub pp_ncmp {
+    my ($op) = @_;
+    if ($op->flags & OPf_STACKED) {
+       my $right = pop_numeric();
+       if (@stack >= 1) {
+           my $left = top_numeric();
+           runtime sprintf("if (%s > %s){",$left,$right);
+               $stack[-1]->set_int(1);
+           $stack[-1]->write_back();
+           runtime sprintf("}else if (%s < %s ) {",$left,$right);
+               $stack[-1]->set_int(-1);
+           $stack[-1]->write_back();
+           runtime sprintf("}else if (%s == %s) {",$left,$right);
+               $stack[-1]->set_int(0);
+           $stack[-1]->write_back();
+           runtime sprintf("}else {"); 
+               $stack[-1]->set_sv("&PL_sv_undef");
+           runtime "}";
+       } else {
+           my $rightruntime = new B::Pseudoreg ("double", "rnv");
+           runtime(sprintf("$$rightruntime = %s;",$right));
+           runtime sprintf(qq/if ("TOPn" > %s){/,$rightruntime);
+           runtime sprintf("sv_setiv(TOPs,1);");
+           runtime sprintf(qq/}else if ( "TOPn" < %s ) {/,$$rightruntime);
+           runtime sprintf("sv_setiv(TOPs,-1);");
+           runtime sprintf(qq/} else if ("TOPn" == %s) {/,$$rightruntime);
+           runtime sprintf("sv_setiv(TOPs,0);");
+           runtime sprintf(qq/}else {/); 
+           runtime sprintf("sv_setiv(TOPs,&PL_sv_undef;");
+           runtime "}";
+       }
+    } else {
+               my $targ = $pad[$op->targ];
+        my $right = new B::Pseudoreg ("double", "rnv");
+        my $left = new B::Pseudoreg ("double", "lnv");
+        runtime(sprintf("$$right = %s; $$left = %s;",
+                           pop_numeric(), pop_numeric));
+       runtime sprintf("if (%s > %s){",$$left,$$right);
+               $targ->set_int(1);
+               $targ->write_back();
+       runtime sprintf("}else if (%s < %s ) {",$$left,$$right);
+               $targ->set_int(-1);
+               $targ->write_back();
+       runtime sprintf("}else if (%s == %s) {",$$left,$$right);
+               $targ->set_int(0);
+               $targ->write_back();
+       runtime sprintf("}else {"); 
+               $targ->set_sv("&PL_sv_undef");
+       runtime "}";
+       push(@stack, $targ);
+    }
+    return $op->next;
+}
+
 sub sv_binop {
     my ($op, $operator, $flags) = @_;
     if ($op->flags & OPf_STACKED) {
@@ -779,7 +843,6 @@ BEGIN {
     my $modulo_op = infix_op("%");
     my $lshift_op = infix_op("<<");
     my $rshift_op = infix_op(">>");
-    my $ncmp_op = sub { "($_[0] > $_[1] ? 1 : ($_[0] < $_[1]) ? -1 : 0)" };
     my $scmp_op = prefix_op("sv_cmp");
     my $seq_op = prefix_op("sv_eq");
     my $sne_op = prefix_op("!sv_eq");
@@ -803,7 +866,6 @@ BEGIN {
     sub pp_multiply { numeric_binop($_[0], $multiply_op, INTS_CLOSED) }
     sub pp_divide { numeric_binop($_[0], $divide_op) }
     sub pp_modulo { int_binop($_[0], $modulo_op) } # differs from perl's
-    sub pp_ncmp { numeric_binop($_[0], $ncmp_op, INT_RESULT) }
 
     sub pp_left_shift { int_binop($_[0], $lshift_op) }
     sub pp_right_shift { int_binop($_[0], $rshift_op) }
@@ -933,6 +995,7 @@ sub pp_list {
 
 sub pp_entersub {
     my $op = shift;
+    $curcop->write_back;
     write_back_lexicals(REGISTER|TEMPORARY);
     write_back_stack();
     my $sym = doop($op);
@@ -980,7 +1043,7 @@ sub pp_leavewrite {
     my $sym = doop($op);
     # XXX Is this the right way to distinguish between it returning
     # CvSTART(cv) (via doform) and pop_return()?
-    runtime("if (PL_op) PL_op = (*PL_op->op_ppaddr)(ARGS);");
+    #runtime("if (PL_op) PL_op = (*PL_op->op_ppaddr)(ARGS);");
     runtime("SPAGAIN;");
     $know_op = 0;
     invalidate_lexicals(REGISTER|TEMPORARY);
@@ -1391,6 +1454,7 @@ sub cc {
     if ($debug_timings) {
        warn sprintf("Saving runtime at %s\n", timing_info);
     }
+    declare_pad(@padlist) ;
     save_runtime();
 }
 

diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm
index 35e04e2..c6aa1ba 100644 (file)
--- a/ext/B/B/Stackobj.pm
+++ b/ext/B/B/Stackobj.pm
@@ -30,6 +30,9 @@ sub VALID_DOUBLE ()   { 0x02 }
 sub VALID_SV ()                { 0x04 }
 sub REGISTER ()                { 0x08 } # no implicit write-back when calling subs
 sub TEMPORARY ()       { 0x10 } # no implicit write-back needed at all
+sub SAVE_INT ()        { 0x20 } #if int part needs to be saved at all
+sub SAVE_DOUBLE ()     { 0x40 } #if double part needs to be saved at all
+
 
 #
 # Callback for runtime code generation
@@ -59,7 +62,7 @@ sub as_int {
     my $obj = shift;
     if (!($obj->{flags} & VALID_INT)) {
        $obj->load_int;
-       $obj->{flags} |= VALID_INT;
+       $obj->{flags} |= VALID_INT|SAVE_INT;
     }
     return $obj->{iv};
 }
@@ -68,7 +71,7 @@ sub as_double {
     my $obj = shift;
     if (!($obj->{flags} & VALID_DOUBLE)) {
        $obj->load_double;
-       $obj->{flags} |= VALID_DOUBLE;
+       $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
     }
     return $obj->{nv};
 }
@@ -137,14 +140,14 @@ sub set_int {
     my ($obj, $expr) = @_;
     runtime("$obj->{iv} = $expr;");
     $obj->{flags} &= ~(VALID_SV | VALID_DOUBLE);
-    $obj->{flags} |= VALID_INT;
+    $obj->{flags} |= VALID_INT|SAVE_INT;
 }
 
 sub set_double {
     my ($obj, $expr) = @_;
     runtime("$obj->{nv} = $expr;");
     $obj->{flags} &= ~(VALID_SV | VALID_INT);
-    $obj->{flags} |= VALID_DOUBLE;
+    $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
 }
 
 sub set_numeric {
@@ -170,6 +173,8 @@ sub set_sv {
 @B::Stackobj::Padsv::ISA = 'B::Stackobj';
 sub B::Stackobj::Padsv::new {
     my ($class, $type, $extra_flags, $ix, $iname, $dname) = @_;
+    $extra_flags |= SAVE_INT if $extra_flags & VALID_INT;
+    $extra_flags |= SAVE_DOUBLE if $extra_flags & VALID_DOUBLE;
     bless {
        type => $type,
        flags => VALID_SV | $extra_flags,
@@ -186,14 +191,23 @@ sub B::Stackobj::Padsv::load_int {
     } else {
        runtime("$obj->{iv} = SvIV($obj->{sv});");
     }
-    $obj->{flags} |= VALID_INT;
+    $obj->{flags} |= VALID_INT|SAVE_INT;
 }
 
 sub B::Stackobj::Padsv::load_double {
     my $obj = shift;
     $obj->write_back;
     runtime("$obj->{nv} = SvNV($obj->{sv});");
-    $obj->{flags} |= VALID_DOUBLE;
+    $obj->{flags} |= VALID_DOUBLE|SAVE_DOUBLE;
+}
+sub B::Stackobj::Padsv::save_int {
+    my $obj = shift;
+    return $obj->{flags} & SAVE_INT;
+}
+
+sub B::Stackobj::Padsv::save_double {
+    my $obj = shift;
+    return $obj->{flags} & SAVE_DOUBLE;
 }
 
 sub B::Stackobj::Padsv::write_back {

diff --git a/t/op/gv.t b/t/op/gv.t
index 10d84ee..ee7978e 100755 (executable)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -62,7 +62,7 @@ if (defined $baa) {
 #        fact that %X::Y:: is stored in %X:: isn't documented.
 #        (I hope.)
 
-{ package Foo::Bar }
+{ package Foo::Bar; $test=1; }
 print exists $Foo::{'Bar::'} ? "ok 12\n" : "not ok 12\n";
 print $Foo::{'Bar::'} eq '*Foo::Bar::' ? "ok 13\n" : "not ok 13\n";
 

diff --git a/t/op/ref.t b/t/op/ref.t
index 618cfcc..a2baab8 100755 (executable)
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -241,11 +241,11 @@ print $$_,"\n";
     package A;
     sub new { bless {}, shift }
     DESTROY { print "# destroying 'A'\nok 51\n" }
-    package B;
+    package _B;
     sub new { bless {}, shift }
-    DESTROY { print "# destroying 'B'\nok 50\n"; bless shift, 'A' }
+    DESTROY { print "# destroying '_B'\nok 50\n"; bless shift, 'A' }
     package main;
-    my $b = B->new;
+    my $b = _B->new;
 }
 
 # test if $_[0] is properly protected in DESTROY()