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 (file)
--- 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 (file)
--- 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";