From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sat, 2 Jan 1999 10:04:02 +0000 (+0000)
Subject: Integrate ext/B changes from //depot/cfgperl
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=735441390c16c09ebb52147d3fa2b2a5ebe75048;p=p5sagit%2Fp5-mst-13.2.git

Integrate ext/B changes from //depot/cfgperl

p4raw-id: //depot/perl@2550
p4raw-integrated: from //depot/cfgperl@2491 'copy in' ext/B/B.xs
	(@2460..) 'merge in' ext/B/B/C.pm ext/B/B/CC.pm
	ext/B/B/Stackobj.pm (@2524..)
---

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index bbf49cd..97e3a88 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -1268,9 +1268,17 @@ sub descend_marked_unused {
     }
 }
 
+sub descend_marked_unused {
+    foreach my $pack (keys %unused_sub_packages)
+    {
+    	mark_package($pack);
+    }
+}
+ 
 sub save_main {
     warn "Starting compile\n";
     warn "Walking tree\n";
+    seek(STDOUT,0,0); #exclude print statements in BEGIN{} into output
     walkoptree(main_root, "save");
     warn "done main optree, walking symtable for extras\n" if $debug_cv;
     save_unused_subs();
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index efb17a1..e4f8877 100644
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -73,7 +73,6 @@ BEGIN {
     }
 }
 
-
 my ($module_name);
 my ($debug_op, $debug_stack, $debug_cxstack, $debug_pad, $debug_runtime,
     $debug_shadow, $debug_queue, $debug_lineno, $debug_timings);
@@ -346,8 +345,9 @@ sub dopoptoloop {
 sub dopoptolabel {
     my $label = shift;
     my $cxix = $#cxstack;
-    while ($cxix >= 0 && $cxstack[$cxix]->{type} != CXt_LOOP
-	   && $cxstack[$cxix]->{label} ne $label) {
+    while ($cxix >= 0 &&
+	   ($cxstack[$cxix]->{type} != CXt_LOOP ||
+	    $cxstack[$cxix]->{label} ne $label)) {
 	$cxix--;
     }
     debug "dopoptolabel: returning $cxix" if $debug_cxstack;
@@ -662,11 +662,15 @@ sub numeric_binop {
 	    }
 	} else {
 	    if ($force_int) {
+	        my $rightruntime = new B::Pseudoreg ("IV", "riv");
+	    	runtime(sprintf("$$rightruntime = %s;",$right));
 		runtime(sprintf("sv_setiv(TOPs, %s);",
-				&$operator("TOPi", $right)));
+				&$operator("TOPi", $$rightruntime)));
 	    } else {
+	    	my $rightruntime = new B::Pseudoreg ("double", "rnv");
+	    	runtime(sprintf("$$rightruntime = %s;",$right));
 		runtime(sprintf("sv_setnv(TOPs, %s);",
-				&$operator("TOPn", $right)));
+				&$operator("TOPn",$$rightruntime)));
 	    }
 	}
     } else {
@@ -1405,6 +1409,7 @@ sub cc_main {
 		     );
                  
     }
+    seek(STDOUT,0,0); #prevent print statements from BEGIN{} into the output
     output_boilerplate();
     print "\n";
     output_all("perl_init");
diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm
index 7760006..09a3e90 100644
--- a/ext/B/B/Stackobj.pm
+++ b/ext/B/B/Stackobj.pm
@@ -26,6 +26,7 @@ sub SVf_NOK () { 0x20000 }
 sub T_UNKNOWN () { 0 }
 sub T_DOUBLE ()  { 1 }
 sub T_INT ()     { 2 }
+sub T_SPECIAL () { 3 }
 
 # Flags
 sub VALID_INT ()	{ 0x01 }
@@ -91,6 +92,7 @@ sub as_bool {
 	}
 	return sprintf("(SvTRUE(%s))", $obj->as_sv) ;
 }
+
 #
 # Debugging methods
 #
@@ -223,17 +225,21 @@ sub B::Stackobj::Const::new {
 	flags => 0,
 	sv => $sv    # holds the SV object until write_back happens
     }, $class;
-    my $svflags = $sv->FLAGS;
-    if ($svflags & SVf_IOK) {
-	$obj->{flags} = VALID_INT|VALID_DOUBLE;
-	$obj->{type} = T_INT;
-	$obj->{nv} = $obj->{iv} = $sv->IV;
-    } elsif ($svflags & SVf_NOK) {
-	$obj->{flags} = VALID_INT|VALID_DOUBLE;
-	$obj->{type} = T_DOUBLE;
-	$obj->{iv} = $obj->{nv} = $sv->NV;
-    } else {
-	$obj->{type} = T_UNKNOWN;
+    if ( ref($sv) eq  "B::SPECIAL" ){
+	$obj->{type}= T_SPECIAL;	
+    }else{
+    	my $svflags = $sv->FLAGS;
+    	if ($svflags & SVf_IOK) {
+		$obj->{flags} = VALID_INT|VALID_DOUBLE;
+		$obj->{type} = T_INT;
+		$obj->{nv} = $obj->{iv} = $sv->IV;
+    	} elsif ($svflags & SVf_NOK) {
+		$obj->{flags} = VALID_INT|VALID_DOUBLE;
+		$obj->{type} = T_DOUBLE;
+		$obj->{iv} = $obj->{nv} = $sv->NV;
+    	} else {
+		$obj->{type} = T_UNKNOWN;
+    	}
     }
     return $obj;
 }