From: Nick Ing-Simmons Date: Sat, 7 Aug 1999 12:19:46 +0000 (+0000) Subject: B::C changes to get simple Tk app. compiling again X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=be6f35027b4f1bba1d34b364cfe6e5e7770f8f84;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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