X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB%2FStackobj.pm;h=b17dfb8173af34e20d4045fd46ed4ae8355b4b45;hb=461824dcfbc00b3c4e20590f06d6c9881e4a416b;hp=35e04e2f928ad128aeaad78f411b8f8b14e67661;hpb=4c1f658f2c79575014c109439365f1a6c403e8c4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm
index 35e04e2..b17dfb8 100644
--- a/ext/B/B/Stackobj.pm
+++ b/ext/B/B/Stackobj.pm
@@ -6,17 +6,20 @@
 #      License or the Artistic License, as specified in the README file.
 #
 package B::Stackobj;  
+
+our $VERSION = '1.00';
+
 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,10 +29,14 @@ 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 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
+
 
 #
 # Callback for runtime code generation
@@ -44,7 +51,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;
@@ -59,7 +66,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 +75,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};
 }
@@ -134,17 +141,18 @@ 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;
+    $obj->{flags} |= VALID_INT|SAVE_INT;
+    $obj->{flags} |= VALID_UNSIGNED if $unsigned; 
 }
 
 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 +178,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 +196,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 {
@@ -201,7 +220,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 {
@@ -228,7 +251,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;
@@ -250,13 +278,21 @@ sub B::Stackobj::Const::write_back {
 
 sub B::Stackobj::Const::load_int {
     my $obj = shift;
-    $obj->{iv} = int($obj->{sv}->PV);
+    if (ref($obj->{sv}) eq "B::RV"){
+       $obj->{iv} = int($obj->{sv}->RV->PV);
+    }else{
+       $obj->{iv} = int($obj->{sv}->PV);
+    }
     $obj->{flags} |= VALID_INT;
 }
 
 sub B::Stackobj::Const::load_double {
     my $obj = shift;
-    $obj->{nv} = $obj->{sv}->PV + 0.0;
+    if (ref($obj->{sv}) eq "B::RV"){
+        $obj->{nv} = $obj->{sv}->RV->PV + 0.0;
+    }else{
+        $obj->{nv} = $obj->{sv}->PV + 0.0;
+    }
     $obj->{flags} |= VALID_DOUBLE;
 }