From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Fri, 4 Dec 1998 17:58:44 +0000 (+0000)
Subject: Vishal Bhatia's patch as a basis.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=44887cfac94a1e9c48e23a0c8847f5bf475857b0;p=p5sagit%2Fp5-mst-13.2.git

Vishal Bhatia's patch as a basis.

p4raw-id: //depot/perl@2450
---

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index e695cc2..4591859 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -25,6 +25,7 @@ my $gv_index = 0;
 my $re_index = 0;
 my $pv_index = 0;
 my $anonsub_index = 0;
+my $initsub_index = 0;
 
 my %symtable;
 my $warn_undefined_syms;
@@ -564,6 +565,10 @@ sub B::CV::save {
 		$ppname .= ($stashname eq "main") ?
 			    $gvname : "$stashname\::$gvname";
 		$ppname =~ s/::/__/g;
+	        if ($gvname eq "INIT"){
+		       $ppname .= "_$initsub_index";
+		       $initsub_index++;
+		    }
 	    }
 	}
 	if (!$ppname) {
@@ -1074,9 +1079,7 @@ sub B::GV::savecv {
 			 $gv->STASH->NAME, $name, $$cv, $$gv);
 	}
       my $package=$gv->STASH->NAME;
-      # This seems to undo all the ->isa and prefix stuff we do below
-      # so disable again for now
-      if (0 && ! grep(/^$package$/,@unused_sub_packages)){
+      if ( ! grep(/^$package$/,@unused_sub_packages)){
           warn sprintf("omitting cv in superclass %s", $gv->STASH->NAME) 
               if $debug_cv;
           return ;
@@ -1103,10 +1106,6 @@ sub save_unused_subs {
 	return 0 if ($package =~ /::::/);  # skip ::::ISA::CACHE etc.
 	#warn "Considering $package\n";#debug
 	return 1 if exists $search_pack{$package};
-      #sub try for a partial match
-      if (grep(/^$package\:\:/,@unused_sub_packages)){ 
-          return 1;   
-      }       
 	#warn "    (nothing explicit)\n";#debug
 	# Omit the packages which we use (and which cause grief
 	# because of fancy "goto &$AUTOLOAD" stuff).
@@ -1117,20 +1116,20 @@ sub save_unused_subs {
 	    return 0;
 	}
 	foreach my $u (keys %search_pack) {
-	    if ($package =~ /^${u}::/) {
-		warn "$package starts with $u\n";
-		return 1
-	    }
 	    if ($package->isa($u)) {
-		warn "$package isa $u\n";
-		return 1
-	    }
-	    return 1 if $package->isa($u);
-	}
+      		warn "$package isa $u\n" if defined $debug_cv;
+      		push @unused_sub_package, $package;
+	  		return 1
+ 	    }
+	if ($package =~ /^${u}::/) {
+   		warn "$package starts with $u\n" if defined $debug_cv;
+   		return 1
+ 	    }
+  }
 	foreach my $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH)) {
 	    if (defined(&{$package."::$m"})) {
 		warn "$package has method $m: -u$package assumed\n";#debug
-              push @unused_sub_package, $package;
+                push @unused_sub_package, $package;
 		return 1;
 	    }
 	}
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index d200d70..80c3f9e 100644
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -8,7 +8,7 @@
 package B::CC;
 use strict;
 use B qw(main_start main_root class comppadlist peekop svref_2object
-	timing_info);
+	timing_info init_av);
 use B::C qw(save_unused_subs objsym init_sections
 	    output_all output_boilerplate output_main);
 use B::Bblock qw(find_leaders);
@@ -499,7 +499,7 @@ sub pp_and {
     if (@stack >= 1) {
 	my $bool = pop_bool();
 	write_back_stack();
-	runtime(sprintf("if (!$bool) goto %s;", label($next)));
+	runtime(sprintf("if (!$bool) {XPUSHs(&PL_sv_no); goto %s;}", label($next)));
     } else {
 	runtime(sprintf("if (!%s) goto %s;", top_bool(), label($next)),
 		"*sp--;");
@@ -513,10 +513,10 @@ sub pp_or {
     reload_lexicals();
     unshift(@bblock_todo, $next);
     if (@stack >= 1) {
-	my $obj = pop @stack;
+	my $bool = pop_bool @stack;
 	write_back_stack();
-	runtime(sprintf("if (%s) { XPUSHs(%s); goto %s; }",
-			$obj->as_numeric, $obj->as_sv, label($next)));
+	runtime(sprintf("if (%s) { XPUSHs(&PL_sv_yes); goto %s; }",
+			$bool, label($next)));
     } else {
 	runtime(sprintf("if (%s) goto %s;", top_bool(), label($next)),
 		"*sp--;");
@@ -1389,6 +1389,7 @@ sub cc_main {
     my @comppadlist = comppadlist->ARRAY;
     my $curpad_nam = $comppadlist[0]->save;
     my $curpad_sym = $comppadlist[1]->save;
+    my $init_av   = init_av->save;
     my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
     save_unused_subs(@unused_sub_packages);
     cc_recurse();
@@ -1398,8 +1399,11 @@ sub cc_main {
 	$init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
 		   "PL_main_start = $start;",
 		   "PL_curpad = AvARRAY($curpad_sym);",
+	           "PL_initav = $init_av;",
 		   "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
-		   "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
+		   "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));",
+		     );
+                 
     }
     output_boilerplate();
     print "\n";