B::Concise -- an improved replacement for B::Terse

[p5sagit/p5-mst-13.2.git] / ext / B / B / C.pm

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 438c2c2..dac9417 100644 (file)
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -298,7 +298,7 @@ sub B::PADOP::save {
     my ($op, $level) = @_;
     my $sym = objsym($op);
     return $sym if defined $sym;
-    $padopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, Nullgv",
+    $padopsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, 0",
                           ${$op->next}, ${$op->sibling},
                           $op->targ, $op->type, $op_seq, $op->flags,
                           $op->private));
@@ -314,7 +314,7 @@ sub B::COP::save {
     return $sym if defined $sym;
     warn sprintf("COP: line %d file %s\n", $op->line, $op->file)
        if $debug_cops;
-    $copsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u",
+    $copsect->add(sprintf("s\\_%x, s\\_%x, NULL, %u, %u, %u, 0x%x, 0x%x, %s, NULL, NULL, %u, %d, %u",
                          ${$op->next}, ${$op->sibling},
                          $op->targ, $op->type, $op_seq, $op->flags,
                          $op->private, cstring($op->label), $op->cop_seq,
@@ -391,9 +391,10 @@ sub B::NULL::save {
     return $sym if defined $sym;
 #   warn "Saving SVt_NULL SV\n"; # debug
     # debug
-    #if ($$sv == 0) {
-    #  warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n";
-    #}
+    if ($$sv == 0) {
+       warn "NULL::save for sv = 0 called from @{[(caller(1))[3]]}\n";
+       return savesym($sv, "Nullsv /* XXX */");
+    }
     $svsect->add(sprintf("0, %u, 0x%x", $sv->REFCNT , $sv->FLAGS));
     return savesym($sv, sprintf("&sv_list[%d]", $svsect->index));
 }
@@ -764,24 +765,31 @@ sub B::GV::save {
        $sym = savesym($gv, "gv_list[$ix]");
        #warn sprintf("Saving GV 0x%x as $sym\n", $$gv); # debug
     }
+    my $is_empty = $gv->is_empty;
     my $gvname = $gv->NAME;
     my $name = cstring($gv->STASH->NAME . "::" . $gvname);
     #warn "GV name is $name\n"; # debug
-    my $egv = $gv->EGV;
     my $egvsym;
-    if ($$gv != $$egv) {
-       #warn(sprintf("EGV name is %s, saving it now\n",
-       #            $egv->STASH->NAME . "::" . $egv->NAME)); # debug
-       $egvsym = $egv->save;
+    unless ($is_empty) {
+       my $egv = $gv->EGV;
+       if ($$gv != $$egv) {
+           #warn(sprintf("EGV name is %s, saving it now\n",
+           #        $egv->STASH->NAME . "::" . $egv->NAME)); # debug
+           $egvsym = $egv->save;
+       }
     }
     $init->add(qq[$sym = gv_fetchpv($name, TRUE, SVt_PV);],
               sprintf("SvFLAGS($sym) = 0x%x;", $gv->FLAGS),
-              sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS),
-              sprintf("GvLINE($sym) = %u;", $gv->LINE));
+              sprintf("GvFLAGS($sym) = 0x%x;", $gv->GvFLAGS));
+    $init->add(sprintf("GvLINE($sym) = %u;", $gv->LINE)) unless $is_empty;
+
     # Shouldn't need to do save_magic since gv_fetchpv handles that
     #$gv->save_magic;
     my $refcnt = $gv->REFCNT + 1;
     $init->add(sprintf("SvREFCNT($sym) += %u;", $refcnt - 1)) if $refcnt > 1;
+
+    return $sym if $is_empty;
+
     my $gvrefcnt = $gv->GvREFCNT;
     if ($gvrefcnt > 1) {
        $init->add(sprintf("GvREFCNT($sym) += %u;", $gvrefcnt - 1));
@@ -1012,7 +1020,6 @@ sub output_all {
     print <<"EOT";
 static int $init_name()
 {
-       dTHR;
        dTARG;
        djSP;
 EOT
@@ -1060,7 +1067,7 @@ typedef struct {
     perl_mutex *xcv_mutexp;
     struct perl_thread *xcv_owner;     /* current owner thread */
 #endif /* USE_THREADS */
-    U8         xcv_flags;
+    cv_flags_t xcv_flags;
 } XPVCV_or_similar;
 #define ANYINIT(i) i
 #else
@@ -1082,6 +1089,7 @@ sub output_boilerplate {
     print <<'EOT';
 #include "EXTERN.h"
 #include "perl.h"
+#include "XSUB.h"
 
 /* Workaround for mapstart: the only op which needs a different ppaddr */
 #undef Perl_pp_mapstart
@@ -1329,7 +1337,7 @@ sub should_save
  # 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)) 
+   if (UNIVERSAL::can($package, $m))
     {
      warn "$package has method $m: saving package\n";#debug
      return mark_package($package);
@@ -1359,7 +1367,7 @@ sub walkpackages
    if ($sym =~ /::$/) 
     {
      $sym = $prefix . $sym;
-     if ($sym ne "main::" && &$recurse($sym)) 
+     if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) 
       {
        walkpackages(\%glob, $recurse, $sym);
       }