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

p4raw-id: //depot/perl@3933

1 files changed, 62 insertions, 48 deletions

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 18c1aba433..800785bcae 100644
--- 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