applied patch after demunging headers with appropriate paths

	Message-ID: <JIHEJPFDFKIBDAAA@my-deja.com>
	Subject: [Patch 5.005_57] unsigned arithmetic (Compiler)

p4raw-id: //depot/perl@3622

diff --git a/cc_runtime.h b/cc_runtime.h
index bb0e07a..110b106 100644 (file)
--- a/cc_runtime.h
+++ b/cc_runtime.h
@@ -52,7 +52,7 @@
        case 2: JMPENV_POP; JMPENV_JUMP(2);     \
        case 3:                                 \
            JMPENV_POP;                         \
-           if (PL_restartop != nxt)            \
+           if (PL_restartop && PL_restartop != nxt)            \
                JMPENV_JUMP(3);                 \
        }                                       \
        PL_op = nxt;                            \

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 7e32d01..1777b21 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -797,6 +797,11 @@ IV
 SvIVX(sv)
        B::IV   sv
 
+UV 
+SvUVX(sv) 
+       B::IV   sv
+                      
+
 MODULE = B     PACKAGE = B::IV
 
 #define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv))

diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index 5a143bc..eb67bcf 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -896,9 +896,9 @@ BEGIN {
     # XXX The standard perl PP code has extra handling for
     # some special case arguments of these operators.
     #
-    sub pp_add { numeric_binop($_[0], $plus_op, INTS_CLOSED) }
-    sub pp_subtract { numeric_binop($_[0], $minus_op, INTS_CLOSED) }
-    sub pp_multiply { numeric_binop($_[0], $multiply_op, INTS_CLOSED) }
+    sub pp_add { numeric_binop($_[0], $plus_op) }
+    sub pp_subtract { numeric_binop($_[0], $minus_op) }
+    sub pp_multiply { numeric_binop($_[0], $multiply_op) }
     sub pp_divide { numeric_binop($_[0], $divide_op) }
     sub pp_modulo { int_binop($_[0], $modulo_op) } # differs from perl's
 
@@ -944,7 +944,7 @@ sub pp_sassign {
        ($src, $dst) = ($dst, $src) if $backwards;
        my $type = $src->{type};
        if ($type == T_INT) {
-           $dst->set_int($src->as_int);
+           $dst->set_int($src->as_int,$src->{flags} & VALID_UNSIGNED);
        } elsif ($type == T_DOUBLE) {
            $dst->set_numeric($src->as_numeric);
        } else {
@@ -957,7 +957,11 @@ sub pp_sassign {
            my $type = $src->{type};
            runtime("if (PL_tainting && PL_tainted) TAINT_NOT;");
            if ($type == T_INT) {
-               runtime sprintf("sv_setiv(TOPs, %s);", $src->as_int);
+                if ($src->{flags} & VALID_UNSIGNED){ 
+                     runtime sprintf("sv_setuv(TOPs, %s);", $src->as_int);
+                }else{
+                    runtime sprintf("sv_setiv(TOPs, %s);", $src->as_int);
+                }
            } elsif ($type == T_DOUBLE) {
                runtime sprintf("sv_setnv(TOPs, %s);", $src->as_double);
            } else {

diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm
index 123b2fc..0db3e33 100644 (file)
--- a/ext/B/B/Stackobj.pm
+++ b/ext/B/B/Stackobj.pm
@@ -8,15 +8,15 @@
 package B::Stackobj;  
 use Exporter ();
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(set_callback T_UNKNOWN T_DOUBLE T_INT
+@EXPORT_OK = qw(set_callback T_UNKNOWN T_DOUBLE T_INT VALID_UNSIGNED
                VALID_INT VALID_DOUBLE VALID_SV REGISTER TEMPORARY);
 %EXPORT_TAGS = (types => [qw(T_UNKNOWN T_DOUBLE T_INT)],
                flags => [qw(VALID_INT VALID_DOUBLE VALID_SV
-                            REGISTER TEMPORARY)]);
+                            VALID_UNSIGNED REGISTER TEMPORARY)]);
 
 use Carp qw(confess);
 use strict;
-use B qw(class SVf_IOK SVf_NOK);
+use B qw(class SVf_IOK SVf_NOK SVf_IVisUV);
 
 # Types
 sub T_UNKNOWN () { 0 }
@@ -26,12 +26,13 @@ sub T_SPECIAL () { 3 }
 
 # Flags
 sub VALID_INT ()       { 0x01 }
-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
+sub VALID_UNSIGNED ()  { 0x02 }
+sub VALID_DOUBLE ()    { 0x04 }
+sub VALID_SV ()                { 0x08 }
+sub REGISTER ()                { 0x10 } # no implicit write-back when calling subs
+sub TEMPORARY ()       { 0x20 } # no implicit write-back needed at all
+sub SAVE_INT ()        { 0x40 } #if int part needs to be saved at all
+sub SAVE_DOUBLE ()     { 0x80 } #if double part needs to be saved at all
 
 
 #
@@ -47,7 +48,7 @@ sub runtime { &$runtime_callback(@_) }
 
 sub write_back { confess "stack object does not implement write_back" }
 
-sub invalidate { shift->{flags} &= ~(VALID_INT | VALID_DOUBLE) }
+sub invalidate { shift->{flags} &= ~(VALID_INT |VALID_UNSIGNED | VALID_DOUBLE) }
 
 sub as_sv {
     my $obj = shift;
@@ -137,10 +138,11 @@ sub minipeek {
 # set_numeric and set_sv are only invoked on legal lvalues.
 #
 sub set_int {
-    my ($obj, $expr) = @_;
+    my ($obj, $expr,$unsigned) = @_;
     runtime("$obj->{iv} = $expr;");
     $obj->{flags} &= ~(VALID_SV | VALID_DOUBLE);
     $obj->{flags} |= VALID_INT|SAVE_INT;
+    $obj->{flags} |= VALID_UNSIGNED if $unsigned; 
 }
 
 sub set_double {
@@ -215,7 +217,11 @@ sub B::Stackobj::Padsv::write_back {
     my $flags = $obj->{flags};
     return if $flags & VALID_SV;
     if ($flags & VALID_INT) {
-       runtime("sv_setiv($obj->{sv}, $obj->{iv});");
+        if ($flags & VALID_UNSIGNED ){
+            runtime("sv_setuv($obj->{sv}, $obj->{iv});");
+        }else{
+            runtime("sv_setiv($obj->{sv}, $obj->{iv});");
+        }     
     } elsif ($flags & VALID_DOUBLE) {
        runtime("sv_setnv($obj->{sv}, $obj->{nv});");
     } else {
@@ -242,7 +248,12 @@ sub B::Stackobj::Const::new {
        if ($svflags & SVf_IOK) {
                $obj->{flags} = VALID_INT|VALID_DOUBLE;
                $obj->{type} = T_INT;
-               $obj->{nv} = $obj->{iv} = $sv->IV;
+                if ($svflags & SVf_IVisUV){
+                    $obj->{flags} |= VALID_UNSIGNED;
+                    $obj->{nv} = $obj->{iv} = $sv->UVX;
+                }else{
+                    $obj->{nv} = $obj->{iv} = $sv->IV;
+                }
        } elsif ($svflags & SVf_NOK) {
                $obj->{flags} = VALID_INT|VALID_DOUBLE;
                $obj->{type} = T_DOUBLE;

diff --git a/ext/B/defsubs.h.PL b/ext/B/defsubs.h.PL
index c04c1a3..2129c8c 100644 (file)
--- a/ext/B/defsubs.h.PL
+++ b/ext/B/defsubs.h.PL
@@ -8,7 +8,8 @@ open(OUT,">$out") || die "Cannot open $file:$!";
 print "Extracting $out . . .\n";
 foreach my $const (qw(AVf_REAL 
                      HEf_SVKEY
-                      SVf_IOK SVf_NOK SVf_POK SVf_ROK SVp_IOK SVp_POK ))
+                      SVf_IOK SVf_IVisUV SVf_NOK SVf_POK 
+                     SVf_ROK SVp_IOK SVp_POK ))
  {
   doconst($const);
  }

diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap
index b1ec063..65970cf 100644 (file)
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@@ -29,6 +29,7 @@ HV *                  T_HVREF
 CV *                   T_CVREF
 
 IV                     T_IV
+UV                     T_UV
 I32                    T_IV
 I16                    T_IV
 I8                     T_IV

diff --git a/t/harness b/t/harness
index ead3ebe..c46a870 100644 (file)
--- a/t/harness
+++ b/t/harness
@@ -15,23 +15,38 @@ use Test::Harness;
 $Test::Harness::switches = "";    # Too much noise otherwise
 $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v';
 
+#fudge DATA for now.
+%datahandle = qw(
+               lib/bigint.t            1
+               lib/bigintpm.t          1
+               lib/bigfloat.t          1
+               lib/bigfloatpm.t        1
+               op/gv.t                 1
+               lib/complex.t           1
+               lib/ph.t                1
+               lib/soundex.t           1
+               op/misc.t               1
+               op/runlevel.t           1
+               op/tie.t                1
+               op/lex_assign.t         1
+               pragma/subs.t           1
+               );
+
+foreach (keys %datahandle) {
+     unlink "$_.t";
+}
+
 @tests = @ARGV;
 @tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t lib/*.t> unless @tests;
 
 Test::Harness::runtests @tests;
 exit(0) unless -e "../testcompile";
 
-#fudge DATA for now.
 %infinite =  qw (
-        op/bop.t        1
-        lib/hostname.t  1
-        );
-
-%datahandle = qw(
-        lib/bigint.t        1
-        lib/bigintpm.t      1
-        lib/bigfloat.t      1
-        lib/bigfloatpm.t    1
+        op/bop.t       1
+        lib/hostname.t 1
+       op/lex_assign.t 1
+       lib/ph.t        1  
         );
 
 my $dhwrapper = <<'EOT';
@@ -42,7 +57,7 @@ EOT
 @tests = grep (!$infinite{$_}, @tests);
 @tests = map {
          my $new = $_;
-         if ($datahandle{$_}) {
+        if ($datahandle{$_} && !( -f $new.t) ) {
              $new .= '.t';
              local(*F, *T);
              open(F,"<$_") or die "Can't open $_: $!";