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

7 files changed, 68 insertions, 31 deletions

diff --git a/cc_runtime.h b/cc_runtime.h
index bb0e07a58c..110b106d7d 100644
--- 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 7e32d01ac9..1777b21254 100644
--- 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 5a143bc307..eb67bcf7db 100644
--- 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 123b2fcc5c..0db3e33de8 100644
--- 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 c04c1a3ba5..2129c8c5bb 100644
--- 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 b1ec063dd7..65970cff27 100644
--- 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 ead3ebea15..c46a87090c 100644
--- 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 $_: $!";