Integrate from mainperl.

p4raw-id: //depot/cfgperl@2460

5 files changed, 285 insertions, 127 deletions

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 75dcfb3b74..1599fe21c5 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -11,7 +11,7 @@ require Exporter;
 @ISA = qw(Exporter DynaLoader);
 @EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname
 		class peekop cast_I32 cstring cchar hash threadsv_names
-		main_root main_start main_cv svref_2object
+		main_root main_start main_cv svref_2object opnumber
 		walkoptree walkoptree_slow walkoptree_exec walksymtable
 		parents comppadlist sv_undef compile_stats timing_info init_av);
 
@@ -187,9 +187,12 @@ sub walkoptree_exec {
 sub walksymtable {
     my ($symref, $method, $recurse, $prefix) = @_;
     my $sym;
+    my $ref;
     no strict 'vars';
     local(*glob);
-    while (($sym, *glob) = each %$symref) {
+    $prefix = '' unless defined $prefix;
+    while (($sym, $ref) = each %$symref) {
+	*glob = $ref;
 	if ($sym =~ /::$/) {
 	    $sym = $prefix . $sym;
 	    if ($sym ne "main::" && &$recurse($sym)) {
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 678bbbdbaf..3e300240ea 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -514,7 +514,28 @@ svref_2object(sv)
 	    croak("argument is not a reference");
 	RETVAL = (SV*)SvRV(sv);
     OUTPUT:
-	RETVAL
+	RETVAL              
+
+void
+opnumber(name)
+char *	name
+CODE:
+{
+ int i; 
+ IV  result = -1;
+ ST(0) = sv_newmortal();
+ if (strncmp(name,"pp_",3) == 0)
+   name += 3;
+ for (i = 0; i < PL_maxo; i++)
+  {
+   if (strcmp(name, PL_op_name[i]) == 0)
+    {
+     result = i;
+     break;
+    }
+  }
+ sv_setiv(ST(0),result);
+}
 
 void
 ppname(opnum)
@@ -533,10 +554,9 @@ hash(sv)
 	char *s;
 	STRLEN len;
 	U32 hash = 0;
-	char hexhash[11]; /* must fit "0xffffffff" plus trailing \0 */
+	char hexhash[19]; /* must fit "0xffffffff" plus trailing \0 */
 	s = SvPV(sv, len);
-	while (len--)
-	    hash = hash * 33 + *s++;
+	PERL_HASH(hash, s, len);
 	sprintf(hexhash, "0x%x", hash);
 	ST(0) = sv_2mortal(newSVpv(hexhash, 0));
 
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index e695cc2876..40583bd71d 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -5,15 +5,51 @@
 #      You may distribute under the terms of either the GNU General Public
 #      License or the Artistic License, as specified in the README file.
 #
+package B::C::Section;
+use B ();
+use base B::Section;
+
+sub new
+{
+ my $class = shift;
+ my $o = $class->SUPER::new(@_);
+ push(@$o,[]);
+ return $o;
+}
+
+sub add
+{  
+ my $section = shift;
+ push(@{$section->[-1]},@_);
+}
+
+sub index
+{  
+ my $section = shift;
+ return scalar(@{$section->[-1]})-1;
+}
+
+sub output
+{   
+ my ($section, $fh, $format) = @_;
+ my $sym = $section->symtable || {};
+ my $default = $section->default;
+ foreach (@{$section->[-1]})
+  {
+   s{(s\\_[0-9a-f]+)}{ exists($sym->{$1}) ? $sym->{$1} : $default; }ge;
+   printf $fh $format, $_;
+  }
+}
+
 package B::C;
 use Exporter ();
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(output_all output_boilerplate output_main
-		init_sections set_callback save_unused_subs objsym);
+@EXPORT_OK = qw(output_all output_boilerplate output_main mark_unused
+		init_sections set_callback save_unused_subs objsym save_context);
 
 use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
 	 class cstring cchar svref_2object compile_stats comppadlist hash
-	 threadsv_names main_cv init_av);
+	 threadsv_names main_cv init_av opnumber);
 use B::Asmdata qw(@specialsv_name);
 
 use FileHandle;
@@ -25,13 +61,14 @@ 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;
 my $verbose;
-my @unused_sub_packages;
+my %unused_sub_packages;
 my $nullop_count;
-my $pv_copy_on_grow;
+my $pv_copy_on_grow = 0;
 my ($debug_cops, $debug_av, $debug_cv, $debug_mg);
 
 my @threadsv_names;
@@ -40,7 +77,7 @@ BEGIN {
 }
 
 # Code sections
-my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, $cvopsect,
+my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, 
     $gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
     $pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect,
     $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect,
@@ -68,9 +105,9 @@ my $op_seq = 65535;
 
 sub AVf_REAL () { 1 }
 
-# XXX This shouldn't really be hardcoded here but it saves
-# looking up the name of every BASEOP in B::OP
-sub OP_THREADSV () { 345 }
+# Look this up here so we can do just a number compare
+# rather than looking up the name of every BASEOP in B::OP
+my $OP_THREADSV = opnumber('threadsv');
 
 sub savesym {
     my ($obj, $value) = @_;
@@ -98,10 +135,11 @@ sub getsym {
 }
 
 sub savepv {
-    my $pv = shift;
+    my $pv = shift;         
+    $pv    = '' unless defined $pv;  # Is this sane ?
     my $pvsym = 0;
     my $pvmax = 0;
-    if ($pv_copy_on_grow) {
+    if ($pv_copy_on_grow) { 
 	my $cstring = cstring($pv);
 	if ($cstring ne "0") { # sic
 	    $pvsym = sprintf("pv%d", $pv_index++);
@@ -117,7 +155,7 @@ sub B::OP::save {
     my ($op, $level) = @_;
     my $type = $op->type;
     $nullop_count++ unless $type;
-    if ($type == OP_THREADSV) {
+    if ($type == $OP_THREADSV) {
 	# saves looking up ppaddr but it's a bit naughty to hard code this
 	$init->add(sprintf("(void)find_threadsv(%s);",
 			   cstring($threadsv_names[$op->targ])));
@@ -388,7 +426,8 @@ sub B::PVNV::save {
     my ($sv) = @_;
     my $sym = objsym($sv);
     return $sym if defined $sym;
-    my $pv = $sv->PV;
+    my $pv = $sv->PV;     
+    $pv = '' unless defined $pv;
     my $len = length($pv);
     my ($pvsym, $pvmax) = savepv($pv);
     $xpvnvsect->add(sprintf("%s, %u, %u, %d, %s",
@@ -489,7 +528,9 @@ sub B::RV::save {
     my ($sv) = @_;
     my $sym = objsym($sv);
     return $sym if defined $sym;
-    $xrvsect->add($sv->RV->save);
+    my $rv = $sv->RV->save;
+    $rv =~ s/^\([AGHS]V\s*\*\)\s*(\&sv_list.*)$/$1/;
+    $xrvsect->add($rv);
     $svsect->add(sprintf("&xrv_list[%d], %lu, 0x%x",
 			 $xrvsect->index, $sv->REFCNT + 1, $sv->FLAGS));
     return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
@@ -564,6 +605,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) {
@@ -595,7 +640,8 @@ sub B::CV::save {
     else {
 	warn sprintf("No definition for sub %s::%s (unable to autoload)\n",
 		     $cvstashname, $cvname); # debug
-    }
+    }              
+    $pv = '' unless defined $pv; # Avoid use of undef warnings
     $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0x%x",
 			  $xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
 			  $cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
@@ -802,6 +848,8 @@ sub B::HV::save {
 	    my ($key, $value) = splice(@contents, 0, 2);
 	    $init->add(sprintf("\thv_store(hv, %s, %u, %s, %s);",
 			       cstring($key),length($key),$value, hash($key)));
+#	    $init->add(sprintf("\thv_store(hv, %s, %u, %s, %s);",
+#			       cstring($key),length($key),$value, 0));
 	}
 	$init->add("}");
     }
@@ -813,6 +861,7 @@ sub B::IO::save {
     my $sym = objsym($io);
     return $sym if defined $sym;
     my $pv = $io->PV;
+    $pv = '' unless defined $pv;
     my $len = length($pv);
     $xpviosect->add(sprintf("0, %u, %u, %d, %s, 0, 0, 0, 0, 0, %d, %d, %d, %d, %s, Nullgv, %s, Nullgv, %s, Nullgv, %d, %s, 0x%x",
 			    $len, $len+1, $io->IVX, $io->NVX, $io->LINES,
@@ -849,7 +898,7 @@ sub output_all {
     my $section;
     my @sections = ($opsect, $unopsect, $binopsect, $logopsect, $condopsect,
 		    $listopsect, $pmopsect, $svopsect, $gvopsect, $pvopsect,
-		    $cvopsect, $loopsect, $copsect, $svsect, $xpvsect,
+		    $loopsect, $copsect, $svsect, $xpvsect,
 		    $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect,
 		    $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect);
     $bootstrap->output(\*STDOUT, "/* bootstrap %s */\n");
@@ -1056,107 +1105,179 @@ sub save_object {
 
 sub Dummy_BootStrap { }            
 
-sub B::GV::savecv {
-    my $gv = shift;
-    my $cv = $gv->CV;
-    my $name = $gv->NAME;
-    if ($$cv) {
-	if ($name eq "bootstrap" && $cv->XSUB) {
-	    my $file = $cv->FILEGV->SV->PV;
-	    $bootstrap->add($file);
-	    my $name = $gv->STASH->NAME.'::'.$name;
-	    no strict 'refs';
-            *{$name} = \&Dummy_BootStrap;   
-	    $cv = $gv->CV;
-	}
-	if ($debug_cv) {
-	    warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
-			 $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)){
-          warn sprintf("omitting cv in superclass %s", $gv->STASH->NAME) 
-              if $debug_cv;
-          return ;
+sub B::GV::savecv 
+{
+ my $gv = shift;
+ my $package=$gv->STASH->NAME;
+ my $name = $gv->NAME;
+ my $cv = $gv->CV;
+ return unless ($$cv || $name eq 'ISA');
+ # We may be looking at this package just because it is a branch in the 
+ # symbol table which is on the path to a package which we need to save
+ # e.g. this is 'Getopt' and wee need to save 'Getopt::Long'
+ # 
+ if ($$cv && $name eq "bootstrap" && $cv->XSUB)
+  {
+   my $file = $cv->FILEGV->SV->PV;
+   $bootstrap->add($file);
+  }
+ unless ($unused_sub_packages{$package})
+  {
+   warn sprintf("omitting cv $name in %s\n", $package) if $$cv; # if $debug_cv;
+   return ;
+  }
+ if ($$cv) 
+  {
+   if ($name eq "bootstrap" && $cv->XSUB) 
+    {
+     my $name = $gv->STASH->NAME.'::'.$name;
+     no strict 'refs';
+     *{$name} = \&Dummy_BootStrap;   
+     $cv = $gv->CV;
+    }
+   warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
+                  $package, $name, $$cv, $$gv) if ($debug_cv); 
+   $gv->save;
+  }
+ elsif ($name eq 'ISA')
+  {
+   $gv->save;
+  }
+}
+
+sub mark_package
+{    
+ my $package = shift;
+ unless ($unused_sub_packages{$package})
+  {    
+   no strict 'refs';
+   $unused_sub_packages{$package} = 1;
+   if (defined(@{$package.'::ISA'}))
+    {
+     foreach my $isa (@{$package.'::ISA'}) 
+      {
+       if ($isa eq 'DynaLoader')
+        {
+         unless (defined(&{$package.'::bootstrap'}))
+          {                    
+           warn "Forcing bootstrap of $package\n";
+           eval { $package->bootstrap }; 
+          }
+        }
+       else
+        {
+         unless ($unused_sub_packages{$isa})
+          {
+           warn "$isa saved (it is in $package\'s \@ISA)\n";
+           mark_package($isa);
+          }
+        }
       }
-	$gv->save;
     }
-    elsif ($name eq 'ISA')
-     {
-      $gv->save;
-     }
+  }
+ return 1;
+}
+     
+sub should_save
+{
+ no strict qw(vars refs);
+ my $package = shift;
+ $package =~ s/::$//;
+ return $unused_sub_packages{$package} = 0 if ($package =~ /::::/);  # skip ::::ISA::CACHE etc.
+ # warn "Considering $package\n";#debug
+ foreach my $u (grep($unused_sub_packages{$_},keys %unused_sub_packages)) 
+  {  
+   # If this package is a prefix to something we are saving, traverse it 
+   # but do not mark it for saving if it is not already
+   # e.g. to get to Getopt::Long we need to traverse Getopt but need
+   # not save Getopt
+   return 1 if ($u =~ /^$package\:\:/);
+  }
+ if (exists $unused_sub_packages{$package})
+  {
+   # warn "Cached $package is ".$unused_sub_packages{$package}."\n"; 
+   return $unused_sub_packages{$package} 
+  }
+ # Omit the packages which we use (and which cause grief
+ # because of fancy "goto &$AUTOLOAD" stuff).
+ # XXX Surely there must be a nicer way to do this.
+ if ($package eq "FileHandle" || $package eq "Config" || 
+     $package eq "SelectSaver" || $package =~/^(B|IO)::/) 
+  {
+   return $unused_sub_packages{$package} = 0;
+  }
+ # Now see if current package looks like an OO class this is probably too strong.
+ foreach my $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH TIEHANDLE)) 
+  {
+   if ($package->can($m)) 
+    {
+     warn "$package has method $m: saving package\n";#debug
+     return mark_package($package);
+    }
+  }
+ return $unused_sub_packages{$package} = 0;
+}
 
+sub walkpackages 
+{
+ my ($symref, $recurse, $prefix) = @_;
+ my $sym;
+ my $ref;
+ no strict 'vars';
+ local(*glob);
+ $prefix = '' unless defined $prefix;
+ while (($sym, $ref) = each %$symref) 
+  {             
+   *glob = $ref;
+   if ($sym =~ /::$/) 
+    {
+     $sym = $prefix . $sym;
+     if ($sym ne "main::" && &$recurse($sym)) 
+      {
+       walkpackages(\%glob, $recurse, $sym);
+      }
+    } 
+  }
 }
 
 
+sub save_unused_subs 
+{
+ no strict qw(refs);
+ warn "Prescan\n";
+ walkpackages(\%{"main::"}, sub { should_save($_[0]); return 1 });
+ warn "Saving methods\n";
+ walksymtable(\%{"main::"}, "savecv", \&should_save);
+}
 
-sub save_unused_subs {
-    my %search_pack;
-    map { $search_pack{$_} = 1 } @_;
-    @unused_sub_packages=@_;
-    no strict qw(vars refs);
-    walksymtable(\%{"main::"}, "savecv", sub {
-	my $package = shift;
-	$package =~ s/::$//;
-	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).
-	# XXX Surely there must be a nicer way to do this.
-	if ($package eq "FileHandle"
-	    || $package eq "Config"
-	    || $package eq "SelectSaver") {
-	    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);
-	}
-	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;
-		return 1;
-	    }
-	}
-	return 0;
-    });
+sub save_context
+{
+ my $curpad_nam = (comppadlist->ARRAY)[0]->save;
+ my $curpad_sym = (comppadlist->ARRAY)[1]->save;
+ my $inc_hv     = svref_2object(\%INC)->save;
+ my $inc_av     = svref_2object(\@INC)->save;
+ $init->add(   "PL_curpad = AvARRAY($curpad_sym);",
+	       "GvHV(PL_incgv) = $inc_hv;",
+	       "GvAV(PL_incgv) = $inc_av;",
+               "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
+               "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
 }
 
 sub save_main {
+    warn "Starting compile\n";
+    foreach my $pack (keys %unused_sub_packages)
+     {
+      mark_package($pack);
+     }
     warn "Walking tree\n";
-    my $curpad_nam = (comppadlist->ARRAY)[0]->save;
-    my $curpad_sym = (comppadlist->ARRAY)[1]->save;
-    my $init_av    = init_av->save;
-    my $inc_hv     = svref_2object(\%INC)->save;
-    my $inc_av     = svref_2object(\@INC)->save;
     walkoptree(main_root, "save");
     warn "done main optree, walking symtable for extras\n" if $debug_cv;
-    save_unused_subs(@unused_sub_packages);
-
+    save_unused_subs();
+    my $init_av = init_av->save;
     $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
 	       sprintf("PL_main_start = s\\_%x;", ${main_start()}),
-	       "PL_curpad = AvARRAY($curpad_sym);",
-	       "PL_initav = $init_av;",
-	       "GvHV(PL_incgv) = $inc_hv;",
-	       "GvAV(PL_incgv) = $inc_av;",
-               "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
-               "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
+	       "PL_initav = $init_av;");
+    save_context();
     warn "Writing output\n";
     output_boilerplate();
     print "\n";
@@ -1168,7 +1289,7 @@ sub save_main {
 sub init_sections {
     my @sections = (init => \$init, decl => \$decl, sym => \$symsect,
 		    binop => \$binopsect, condop => \$condopsect,
-		    cop => \$copsect, cvop => \$cvopsect, gvop => \$gvopsect,
+		    cop => \$copsect, gvop => \$gvopsect,
 		    listop => \$listopsect, logop => \$logopsect,
 		    loop => \$loopsect, op => \$opsect, pmop => \$pmopsect,
 		    pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect,
@@ -1180,8 +1301,14 @@ sub init_sections {
 		    xpvio => \$xpviosect, bootstrap => \$bootstrap);
     my ($name, $sectref);
     while (($name, $sectref) = splice(@sections, 0, 2)) {
-	$$sectref = new B::Section $name, \%symtable, 0;
+	$$sectref = new B::C::Section $name, \%symtable, 0;
     }
+}           
+
+sub mark_unused
+{
+ my ($arg,$val) = @_;
+ $unused_sub_packages{$arg} = $val;
 }
 
 sub compile {
@@ -1226,7 +1353,7 @@ sub compile {
 	    $verbose = 1;
 	} elsif ($opt eq "u") {
 	    $arg ||= shift @options;
-	    push(@unused_sub_packages, $arg);
+	    mark_unused($arg,undef);
 	} elsif ($opt eq "f") {
 	    $arg ||= shift @options;
 	    if ($arg eq "cog") {
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index d200d70f1a..e6c21bca75 100644
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -8,8 +8,8 @@
 package B::CC;
 use strict;
 use B qw(main_start main_root class comppadlist peekop svref_2object
-	timing_info);
-use B::C qw(save_unused_subs objsym init_sections
+	timing_info init_av);
+use B::C qw(save_unused_subs objsym init_sections mark_unused
 	    output_all output_boilerplate output_main);
 use B::Bblock qw(find_leaders);
 use B::Stackobj qw(:types :flags);
@@ -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--;");
@@ -1264,11 +1264,11 @@ sub pp_substcont {
     write_back_stack();
     doop($op);
     my $pmop = $op->other;
-    warn sprintf("substcont: op = %s, pmop = %s\n",
-		 peekop($op), peekop($pmop));#debug
-#    my $pmopsym = objsym($pmop);
+    # warn sprintf("substcont: op = %s, pmop = %s\n",
+    # 		 peekop($op), peekop($pmop));#debug
+#   my $pmopsym = objsym($pmop);
     my $pmopsym = $pmop->save; # XXX can this recurse?
-    warn "pmopsym = $pmopsym\n";#debug
+#   warn "pmopsym = $pmopsym\n";#debug
     runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplstart) goto %s;",
 		    $pmopsym, label($pmop->pmreplstart));
     invalidate_lexicals();
@@ -1387,10 +1387,13 @@ sub cc_obj {
 
 sub cc_main {
     my @comppadlist = comppadlist->ARRAY;
-    my $curpad_nam = $comppadlist[0]->save;
-    my $curpad_sym = $comppadlist[1]->save;
+    my $curpad_nam  = $comppadlist[0]->save;
+    my $curpad_sym  = $comppadlist[1]->save;
+    my $init_av     = init_av->save; 
+    my $inc_hv      = svref_2object(\%INC)->save;
+    my $inc_av      = svref_2object(\@INC)->save;
     my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
-    save_unused_subs(@unused_sub_packages);
+    save_unused_subs();
     cc_recurse();
 
     return if $errors;
@@ -1398,8 +1401,13 @@ 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;",
+		   "GvHV(PL_incgv) = $inc_hv;",
+		   "GvAV(PL_incgv) = $inc_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";
@@ -1459,7 +1467,7 @@ sub compile {
 	    $module_name = $arg;
 	} elsif ($opt eq "u") {
 	    $arg ||= shift @options;
-	    push(@unused_sub_packages, $arg);
+	    mark_unused($arg,undef);
 	} elsif ($opt eq "f") {
 	    $arg ||= shift @options;
 	    my $value = $arg !~ s/^no-//;
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 5e0bd1d3de..60f6f0dbd8 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -1442,7 +1442,7 @@ sub pp_truncate {
     my(@exprs);
     my $parens = ($cx >= 5) || $self->{'parens'};
     my $kid = $op->first->sibling;
-    my($fh, $len);
+    my $fh;
     if ($op->flags & OPf_SPECIAL) {
 	# $kid is an OP_CONST
 	$fh = $kid->sv->PV;