B::C changes to get simple Tk app. compiling again

p4raw-id: //depot/perl@3933

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 18c1aba..800785b 100644 (file)
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -600,11 +600,18 @@ sub B::CV::save {
     # from PL_initav->save. Re-bootstrapping  will push INIT back in
     # so nullop should be sent.
     if ($cvxsub && ($cvname ne "INIT")) {
-    #if ($cvxsub) {
        my $egv = $gv->EGV;
        my $stashname = $egv->STASH->NAME;
-       $xsub{$stashname}='Static' unless  $xsub{$stashname};
-       return qq/(perl_get_cv("$stashname\:\:$cvname",0))/;
+         if ($cvname eq "bootstrap")
+          {                                   
+           my $file = $cv->FILEGV->SV->PV;    
+           $decl->add("/* bootstrap $file */"); 
+           warn "Bootstrap $stashname $file\n";
+           $xsub{$stashname}='Dynamic'; 
+          # $xsub{$stashname}='Static' unless  $xsub{$stashname};
+           # return qq/NULL/;
+          }                                   
+       return qq/(perl_get_cv("$stashname\:\:$cvname",TRUE))/;
     }
     if ($cvxsub && $cvname eq "INIT") {
         no strict 'refs';
@@ -706,7 +713,7 @@ sub B::CV::save {
 }
 
 sub B::GV::save {
-    my ($gv,$skip_cv) = @_;
+    my ($gv) = @_;
     my $sym = objsym($gv);
     if (defined($sym)) {
        #warn sprintf("GV 0x%x already saved as $sym\n", $$gv); # debug
@@ -764,20 +771,20 @@ sub B::GV::save {
 #          warn "GV::save \%$name\n"; # debug
        }
        my $gvcv = $gv->CV;
-       if ($$gvcv && !$skip_cv && !$gvcv->XSUB) { #not XSUB
-            $gvcv->save;
-            $init->add(sprintf("GvCV($sym) = (CV*)s\\_%x;", $$gvcv));
-#           warn "GV::save &$name\n"; # debug
-        }elsif ($$gvcv && $gvcv->XSUB && $name ne 
-               (my $origname=cstring($gvcv->GV->EGV->STASH->NAME .
-                "::" . $gvcv->GV->EGV->NAME))) { #XSUB alias
-
+       if ($$gvcv) { 
+           my $origname=cstring($gvcv->GV->EGV->STASH->NAME .
+                "::" . $gvcv->GV->EGV->NAME);  
+           if (0 && $gvcv->XSUB && $name ne $origname) { #XSUB alias
+               # must save as a 'stub' so newXS() has a CV to populate
                 $init->add("{ CV *cv;");
-                $init->add("\tcv=GvCV(gv_fetchpv($origname,FALSE,SVt_PV));");
+                $init->add("\tcv=perl_get_cv($origname,TRUE);");
                 $init->add("\tGvCV($sym)=cv;");
                 $init->add("\tSvREFCNT_inc((SV *)cv);");
-                $init->add("}");
-
+                $init->add("}");    
+           } else {     
+               $init->add(sprintf("GvCV($sym) = (CV*)(%s);", $gvcv->save));
+#              warn "GV::save &$name\n"; # debug
+           } 
         }     
        my $gvfilegv = $gv->FILEGV;
        if ($$gvfilegv) {
@@ -1046,6 +1053,7 @@ sub output_boilerplate {
 EXTERN_C void boot_DynaLoader (CV* cv);
 
 static void xs_init (void);
+static void dl_init (void);
 static PerlInterpreter *my_perl;
 EOT
 }
@@ -1110,6 +1118,7 @@ main(int argc, char **argv, char **env)
     exitstatus = perl_init();
     if (exitstatus)
        exit( exitstatus );
+    dl_init();
 
     exitstatus = perl_run( my_perl );
 
@@ -1132,25 +1141,48 @@ EOT
     print "\n#endif\n" ;
     delete $xsub{'DynaLoader'}; 
     delete $xsub{'UNIVERSAL'}; 
-    print("/* bootstrapping code*/\nSAVETMPS;\n");
+    print("/* bootstrapping code*/\n\tSAVETMPS;\n");
     print("\ttarg=sv_newmortal();\n");
     foreach my $stashname (keys %xsub ){
-       my $stashxsub=$stashname;
-       $stashxsub  =~ s/::/__/g; 
-       if ($xsub{$stashname} eq 'Dynamic') {
+       if ($xsub{$stashname} ne 'Dynamic') {
+          my $stashxsub=$stashname;
+          $stashxsub  =~ s/::/__/g; 
+          print "\tPUSHMARK(sp);\n";
+          print qq/\tXPUSHp("$stashname",strlen("$stashname")+1);\n/;
+          print "\tboot_$stashxsub(NULL);\n";
+       }   
+    }
+    print("\tFREETMPS;\n/* end bootstrapping code */\n");
+    print "\n}";
+    
+print <<'EOT';
+static void
+dl_init()
+{
+    char *file = __FILE__;
+    dTARG;
+    djSP;
+EOT
+    print("/* Dynamicboot strapping code*/\n\tSAVETMPS;\n");
+    print("\ttarg=sv_newmortal();\n");
+    foreach my $stashname (@DynaLoader::dl_modules) {
+       warn "Loaded $stashname\n";
+       if (exists($xsub{$stashname}) && $xsub{$stashname} eq 'Dynamic') {
+          my $stashxsub=$stashname;
+          $stashxsub  =~ s/::/__/g; 
+          print "\tPUSHMARK(sp);\n";
+          print qq/\tXPUSHp("$stashname",/,length($stashname)+1,qq/);\n/;
+          print qq/\tPUTBACK;\n/;
            print "#ifdef DYNALOADER_BOOTSTRAP\n";
           warn "bootstrapping $stashname added to xs_init\n";
-          print qq/\n\t{\n\tchar *args[]={"$stashxsub", NULL};/;
-           print qq/\n\t\tperl_call_argv("${stashxsub}::bootstrap",G_DISCARD,args);\n\t}/;
+          print qq/\tperl_call_method("bootstrap",G_DISCARD);\n/;
            print "\n#else\n";
-       }
-       print "\tPUSHMARK(sp);\n";
-       print qq/\tXPUSHp("$stashname",strlen("$stashname")+1);\n/;
-       print "\tboot_$stashxsub(NULL);\n";
-        print "#endif\n" if ($xsub{$stashname} eq 'Dynamic');
+          print "\tboot_$stashxsub(NULL);\n";
+           print "#endif\n";
+          print qq/\tSPAGAIN;\n/;
+       }   
     }
-
-    print("\tFREETMPS;\n/* end bootstrapping code */\n");
+    print("\tFREETMPS;\n/* end Dynamic bootstrapping code */\n");
     print "\n}";
 }
 sub dump_symtable {
@@ -1181,32 +1213,14 @@ sub B::GV::savecv
  my $sv = $gv->SV;
  my $av = $gv->AV;
  my $hv = $gv->HV;
- my $skip_cv = 0;
 
  # 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 we need to save 'Getopt::Long'
  # 
  return unless ($unused_sub_packages{$package});
- if ($$cv) 
-  {
-   if ($name eq "bootstrap" && $cv->XSUB) 
-    {
-     my $file = $cv->FILEGV->SV->PV;
-     my $name = $gv->STASH->NAME.'::'.$name;
-     no strict 'refs';
-     *{$name} = \&Dummy_BootStrap;   
-     $xsub{$gv->STASH->NAME}='Dynamic';
-     $cv = $gv->CV;
-    }
-   warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
-                  $package, $name, $$cv, $$gv) if ($debug_cv); 
-  }                                     
- else
-  {
-   return unless ($$av || $$sv || $$hv)
-  }
- $gv->save($skip_cv);
+ return unless ($$cv || $$av || $$sv || $$hv);
+ $gv->save;
 }
 
 sub mark_package