Finish code generation rewrite. Clean up B::Section class and

handle symbol table translation internally. Simple .pm modules
now compile OK.

p4raw-id: //depot/perlext/Compiler@14

diff --git a/B.pm b/B.pm
index eca5a78..ebc98b0 100644 (file)
--- a/B.pm
+++ b/B.pm
@@ -109,17 +109,17 @@ sub timing_info {
            $hr, $min, $sec, $user, $sys);
 }
 
-my %symtable;
-sub savesym {
-    my ($obj, $value) = @_;
-#    warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
-    $symtable{sprintf("sym_%x", $$obj)} = $value;
-}
+#my %symtable;
+#sub savesym {
+#    my ($obj, $value) = @_;
+##    warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
+#    $symtable{sprintf("sym_%x", $$obj)} = $value;
+#}
 
-sub objsym {
-    my $obj = shift;
-    return $symtable{sprintf("sym_%x", $$obj)};
-}
+#sub objsym {
+#    my $obj = shift;
+#    return $symtable{sprintf("sym_%x", $$obj)};
+#}
 
 sub walkoptree_exec {
     my ($op, $method, $level) = @_;
@@ -202,39 +202,63 @@ sub walksymtable {
 {
     package B::Section;
     my $output_fh;
+    my %sections;
     
     sub new {
-       my ($class, $section) = @_;
+       my ($class, $section, $symtable, $default) = @_;
        $output_fh ||= FileHandle->new_tmpfile;
-       bless [$section, -1], $class;
+       my $obj = bless [-1, $section, $symtable, $default], $class;
+       $sections{$section} = $obj;
+       return $obj;
     }
     
+    sub get {
+       my ($class, $section) = @_;
+       return $sections{$section};
+    }
+
     sub add {
        my $section = shift;
        while (defined($_ = shift)) {
-           print $output_fh "$section->[0]\t$_\n";
-           $section->[1]++;
+           print $output_fh "$section->[1]\t$_\n";
+           $section->[0]++;
        }
     }
 
-    sub name {
+    sub index {
        my $section = shift;
        return $section->[0];
     }
 
-    sub index {
+    sub name {
        my $section = shift;
        return $section->[1];
     }
 
+    sub symtable {
+       my $section = shift;
+       return $section->[2];
+    }
+       
+    sub default {
+       my $section = shift;
+       return $section->[3];
+    }
+       
     sub output {
        my ($section, $fh, $format) = @_;
-       my $name = $section->[0];
+       my $name = $section->name;
+       my $sym = $section->symtable || {};
+       my $default = $section->default;
+
        seek($output_fh, 0, 0);
        while (<$output_fh>) {
            chomp;
            s/^(.*?)\t//;
            if ($1 eq $name) {
+               s{(s\\_[0-9a-f]+)} {
+                   exists($sym->{$1}) ? $sym->{$1} : $default;
+               }ge;
                printf $fh $format, $_;
            }
        }

diff --git a/B/C.pm b/B/C.pm
index adf810a..7f796a4 100644 (file)
--- a/B/C.pm
+++ b/B/C.pm
@@ -8,8 +8,8 @@
 package B::C;
 use Exporter ();
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(output_all output_boilerplate
-               output_main set_callback save_unused_subs objsym);
+@EXPORT_OK = qw(output_all output_boilerplate output_main
+               init_sections set_callback save_unused_subs objsym);
 
 use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
         class cstring cchar svref_2object compile_stats comppadlist hash);
@@ -64,14 +64,13 @@ sub AVf_REAL () { 1 }
 
 sub savesym {
     my ($obj, $value) = @_;
-    my $sym = sprintf("sym_%x", $$obj);
-    $symsect->add("$sym\t$value");
+    my $sym = sprintf("s\\_%x", $$obj);
     $symtable{$sym} = $value;
 }
 
 sub objsym {
     my $obj = shift;
-    return $symtable{sprintf("sym_%x", $$obj)};
+    return $symtable{sprintf("s\\_%x", $$obj)};
 }
 
 sub getsym {
@@ -108,7 +107,7 @@ sub B::OP::save {
     my ($op, $level) = @_;
     my $type = $op->type;
     $nullop_count++ unless $type;
-    $opsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x",
+    $opsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x",
                         ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
                         $type, $op_seq, $op->flags, $op->private));
     savesym($op, sprintf("&op_list[%d]", $opsect->index));
@@ -137,7 +136,7 @@ sub B::FAKEOP::private { $_[0]->{private} || 0 }
 
 sub B::UNOP::save {
     my ($op, $level) = @_;
-    $unopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x",
+    $unopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x",
                           ${$op->next}, ${$op->sibling}, $op->ppaddr,
                           $op->targ, $op->type, $op_seq, $op->flags,
                           $op->private, ${$op->first}));
@@ -146,7 +145,7 @@ sub B::UNOP::save {
 
 sub B::BINOP::save {
     my ($op, $level) = @_;
-    $binopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x",
+    $binopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
                            ${$op->next}, ${$op->sibling}, $op->ppaddr,
                            $op->targ, $op->type, $op_seq, $op->flags,
                            $op->private, ${$op->first}, ${$op->last}));
@@ -155,7 +154,7 @@ sub B::BINOP::save {
 
 sub B::LISTOP::save {
     my ($op, $level) = @_;
-    $listopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x, %u",
+    $listopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u",
                             ${$op->next}, ${$op->sibling}, $op->ppaddr,
                             $op->targ, $op->type, $op_seq, $op->flags,
                             $op->private, ${$op->first}, ${$op->last},
@@ -165,7 +164,7 @@ sub B::LISTOP::save {
 
 sub B::LOGOP::save {
     my ($op, $level) = @_;
-    $logopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x",
+    $logopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
                            ${$op->next}, ${$op->sibling}, $op->ppaddr,
                            $op->targ, $op->type, $op_seq, $op->flags,
                            $op->private, ${$op->first}, ${$op->other}));
@@ -174,7 +173,7 @@ sub B::LOGOP::save {
 
 sub B::CONDOP::save {
     my ($op, $level) = @_;
-    $condopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x, sym_%x",
+    $condopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x",
                             ${$op->next}, ${$op->sibling}, $op->ppaddr,
                             $op->targ, $op->type, $op_seq, $op->flags,
                             $op->private, ${$op->first}, ${$op->true},
@@ -187,7 +186,7 @@ sub B::LOOP::save {
     #warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n",
     #           peekop($op->redoop), peekop($op->nextop),
     #           peekop($op->lastop)); # debug
-    $loopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x, %u, sym_%x, sym_%x, sym_%x",
+    $loopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, s\\_%x, s\\_%x, s\\_%x",
                           ${$op->next}, ${$op->sibling}, $op->ppaddr,
                           $op->targ, $op->type, $op_seq, $op->flags,
                           $op->private, ${$op->first}, ${$op->last},
@@ -198,7 +197,7 @@ sub B::LOOP::save {
 
 sub B::PVOP::save {
     my ($op, $level) = @_;
-    $pvopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+    $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
                           ${$op->next}, ${$op->sibling}, $op->ppaddr,
                           $op->targ, $op->type, $op_seq, $op->flags,
                           $op->private, cstring($op->pv)));
@@ -208,7 +207,7 @@ sub B::PVOP::save {
 sub B::SVOP::save {
     my ($op, $level) = @_;
     my $svsym = $op->sv->save;
-    $svopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+    $svopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
                           ${$op->next}, ${$op->sibling}, $op->ppaddr,
                           $op->targ, $op->type, $op_seq, $op->flags,
                           $op->private, "(SV*)$svsym"));
@@ -218,7 +217,7 @@ sub B::SVOP::save {
 sub B::GVOP::save {
     my ($op, $level) = @_;
     my $gvsym = $op->gv->save;
-    $gvopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, Nullgv",
+    $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, Nullgv",
                           ${$op->next}, ${$op->sibling}, $op->ppaddr,
                           $op->targ, $op->type, $op_seq, $op->flags,
                           $op->private));
@@ -232,7 +231,7 @@ sub B::COP::save {
     my $stashsym = $op->stash->save;
     warn sprintf("COP: line %d file %s\n", $op->line, $op->filegv->SV->PV)
        if $debug_cops;
-    $copsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u",
+    $copsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u",
                          ${$op->next}, ${$op->sibling}, $op->ppaddr,
                          $op->targ, $op->type, $op_seq, $op->flags,
                          $op->private, cstring($op->label), $op->cop_seq,
@@ -248,8 +247,8 @@ sub B::PMOP::save {
     my $shortsym = $op->pmshort->save;
     my $replroot = $op->pmreplroot;
     my $replstart = $op->pmreplstart;
-    my $replrootfield = sprintf("sym_%x", $$replroot);
-    my $replstartfield = sprintf("sym_%x", $$replstart);
+    my $replrootfield = sprintf("s\\_%x", $$replroot);
+    my $replstartfield = sprintf("s\\_%x", $$replstart);
     my $gvsym;
     my $ppaddr = $op->ppaddr;
     if ($$replroot) {
@@ -267,7 +266,7 @@ sub B::PMOP::save {
     # pmnext handling is broken in perl itself, I think. Bad op_pmnext
     # fields aren't noticed in perl's runtime (unless you try reset) but we
     # segfault when trying to dereference it to find op->op_pmnext->op_type
-    $pmopsect->add(sprintf("sym_%x, sym_%x, %s, %u, %u, %u, 0x%x, 0x%x, sym_%x, sym_%x, %u, %s, %s, 0, 0, %s, 0x%x, 0x%x, %u",
+    $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, %s, 0x%x, 0x%x, %u",
                           ${$op->next}, ${$op->sibling}, $ppaddr, $op->targ,
                           $op->type, $op_seq, $op->flags, $op->private,
                           ${$op->first}, ${$op->last}, $op->children,
@@ -453,7 +452,7 @@ sub B::PVMG::save_magic {
        warn sprintf("xmg_stash = %s (0x%x)\n", $stash->NAME, $$stash)
            if $debug_mg;
        # XXX Hope stash is already going to be saved.
-       $init->add(sprintf("SvSTASH(sym_%x) = sym_%x;", $$sv, $$stash));
+       $init->add(sprintf("SvSTASH(s\\_%x) = s\\_%x;", $$sv, $$stash));
     }
     my @mgchain = $sv->MAGIC;
     my ($mg, $type, $obj, $ptr);
@@ -467,7 +466,7 @@ sub B::PVMG::save_magic {
                         class($sv), $$sv, class($obj), $$obj,
                         cchar($type), cstring($ptr));
        }
-       $init->add(sprintf("sv_magic((SV*)sym_%x, (SV*)sym_%x, %s, %s, %d);",
+       $init->add(sprintf("sv_magic((SV*)s\\_%x, (SV*)s\\_%x, %s, %s, %d);",
                           $$sv, $$obj, cchar($type),cstring($ptr),$len));
     }
 }
@@ -584,27 +583,27 @@ sub B::CV::save {
        warn "No definition for sub %s::%s (unable to autoload)\n",
            $cvstashname, $cvname; # debug
     }
-    $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, sym_%lx, $xsub, $xsubany, Nullgv, Nullgv, %d, sym_%lx, (CV*)sym_%lx, 0",
+    $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%lx, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%lx, (CV*)s\\_%lx, 0",
                          $xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
                          $cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
                          $$padlist, ${$cv->OUTSIDE}));
     if ($$gv) {
        $gv->save;
-       $init->add(sprintf("CvGV(sym_%lx) = sym_%lx;",$$cv,$$gv));
+       $init->add(sprintf("CvGV(s\\_%lx) = s\\_%lx;",$$cv,$$gv));
        warn sprintf("done saving GV 0x%x for CV 0x%x\n",
                     $$gv, $$cv) if $debug_cv;
     }
     my $filegv = $cv->FILEGV;
     if ($$filegv) {
        $filegv->save;
-       $init->add(sprintf("CvFILEGV(sym_%lx) = sym_%lx;", $$cv, $$filegv));
+       $init->add(sprintf("CvFILEGV(s\\_%lx) = s\\_%lx;", $$cv, $$filegv));
        warn sprintf("done saving FILEGV 0x%x for CV 0x%x\n",
                     $$filegv, $$cv) if $debug_cv;
     }
     my $stash = $cv->STASH;
     if ($$stash) {
        $stash->save;
-       $init->add(sprintf("CvSTASH(sym_%lx) = sym_%lx;", $$cv, $$stash));
+       $init->add(sprintf("CvSTASH(s\\_%lx) = s\\_%lx;", $$cv, $$stash));
        warn sprintf("done saving STASH 0x%x for CV 0x%x\n",
                     $$stash, $$cv) if $debug_cv;
     }
@@ -655,43 +654,43 @@ sub B::GV::save {
 #      warn "GV::save saving subfields\n"; # debug
        my $gvsv = $gv->SV;
        if ($$gvsv) {
-           $init->add(sprintf("GvSV($sym) = sym_%x;", $$gvsv));
+           $init->add(sprintf("GvSV($sym) = s\\_%x;", $$gvsv));
 #          warn "GV::save \$$name\n"; # debug
            $gvsv->save;
        }
        my $gvav = $gv->AV;
        if ($$gvav) {
-           $init->add(sprintf("GvAV($sym) = sym_%x;", $$gvav));
+           $init->add(sprintf("GvAV($sym) = s\\_%x;", $$gvav));
 #          warn "GV::save \@$name\n"; # debug
            $gvav->save;
        }
        my $gvhv = $gv->HV;
        if ($$gvhv) {
-           $init->add(sprintf("GvHV($sym) = sym_%x;", $$gvhv));
+           $init->add(sprintf("GvHV($sym) = s\\_%x;", $$gvhv));
 #          warn "GV::save \%$name\n"; # debug
            $gvhv->save;
        }
        my $gvcv = $gv->CV;
        if ($$gvcv) {
-           $init->add(sprintf("GvCV($sym) = (CV*)sym_%x;", $$gvcv));
+           $init->add(sprintf("GvCV($sym) = (CV*)s\\_%x;", $$gvcv));
 #          warn "GV::save &$name\n"; # debug
            $gvcv->save;
        }
        my $gvfilegv = $gv->FILEGV;
        if ($$gvfilegv) {
-           $init->add(sprintf("GvFILEGV($sym) = sym_%x;",$$gvfilegv));
+           $init->add(sprintf("GvFILEGV($sym) = s\\_%x;",$$gvfilegv));
 #          warn "GV::save GvFILEGV(*$name)\n"; # debug
            $gvfilegv->save;
        }
        my $gvform = $gv->FORM;
        if ($$gvform) {
-           $init->add(sprintf("GvFORM($sym) = (CV*)sym_%x;", $$gvform));
+           $init->add(sprintf("GvFORM($sym) = (CV*)s\\_%x;", $$gvform));
 #          warn "GV::save GvFORM(*$name)\n"; # debug
            $gvform->save;
        }
        my $gvio = $gv->IO;
        if ($$gvio) {
-           $init->add(sprintf("GvIOp($sym) = sym_%x;", $$gvio));
+           $init->add(sprintf("GvIOp($sym) = s\\_%x;", $$gvio));
 #          warn "GV::save GvIO(*$name)\n"; # debug
            $gvio->save;
        }
@@ -761,7 +760,7 @@ sub B::HV::save {
        # XXX Beware of weird package names containing double-quotes, \n, ...?
        $init->add(qq[hv$hv_index = gv_stashpv("$name", TRUE);]);
        if ($adpmroot) {
-           $init->add(sprintf("HvPMROOT(hv$hv_index) = (PMOP*)sym_%x;",
+           $init->add(sprintf("HvPMROOT(hv$hv_index) = (PMOP*)s\\_%x;",
                               $adpmroot));
        }
        $sym = savesym($hv, "hv$hv_index");
@@ -810,7 +809,7 @@ sub B::IO::save {
     foreach $field (qw(TOP_GV FMT_GV BOTTOM_GV)) {
        $fsym = $io->$field();
        if ($$fsym) {
-           $init->add(sprintf("Io$field($sym) = (GV*)sym_%x;", $$fsym));
+           $init->add(sprintf("Io$field($sym) = (GV*)s\\_%x;", $$fsym));
            $fsym->save;
        }
     }
@@ -1083,21 +1082,14 @@ sub save_unused_subs {
     });
 }
 
-sub init_sections {
-    my ($name, $sectref);
-    while (($name, $sectref) = splice(@_, 0, 2)) {
-       $$sectref = new B::Section $name;
-    }
-}
-
 sub save_main {
     my $curpad_sym = (comppadlist->ARRAY)[1]->save;
     walkoptree(main_root, "save");
     warn "done main optree, walking symtable for extras\n" if $debug_cv;
     save_unused_subs(@unused_sub_packages);
 
-    $init->add(sprintf("main_root = sym_%x;", ${main_root()}),
-              sprintf("main_start = sym_%x;", ${main_start()}),
+    $init->add(sprintf("main_root = s\\_%x;", ${main_root()}),
+              sprintf("main_start = s\\_%x;", ${main_start()}),
               "curpad = AvARRAY($curpad_sym);");
     output_boilerplate();
     print "\n";
@@ -1106,6 +1098,25 @@ sub save_main {
     output_main();
 }
 
+sub init_sections {
+    my @sections = (init => \$init, decl => \$decl, sym => \$symsect,
+                   binop => \$binopsect, condop => \$condopsect,
+                   cop => \$copsect, cvop => \$cvopsect, gvop => \$gvopsect,
+                   listop => \$listopsect, logop => \$logopsect,
+                   loop => \$loopsect, op => \$opsect, pmop => \$pmopsect,
+                   pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect,
+                   sv => \$svsect, xpv => \$xpvsect, xpvav => \$xpvavsect,
+                   xpvhv => \$xpvhvsect, xpvcv => \$xpvcvsect,
+                   xpviv => \$xpvivsect, xpvnv => \$xpvnvsect,
+                   xpvmg => \$xpvmgsect, xpvlv => \$xpvlvsect,
+                   xrv => \$xrvsect, xpvbm => \$xpvbmsect,
+                   xpvio => \$xpviosect);
+    my ($name, $sectref);
+    while (($name, $sectref) = splice(@sections, 0, 2)) {
+       $$sectref = new B::Section $name, \%symtable, 0;
+    }
+}
+
 sub compile {
     my @options = @_;
     my ($option, $opt, $arg);
@@ -1165,17 +1176,7 @@ sub compile {
            }
        }
     }
-    init_sections(init => \$init, decl => \$decl, sym => \$symsect,
-                 binop => \$binopsect, condop => \$condopsect,
-                 cop => \$copsect, cvop => \$cvopsect, gvop => \$gvopsect,
-                 listop => \$listopsect, logop => \$logopsect,
-                 loop => \$loopsect, op => \$opsect, pmop => \$pmopsect,
-                 pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect,
-                 sv => \$svsect, xpv => \$xpvsect, xpvav => \$xpvavsect,
-                 xpvhv => \$xpvhvsect, xpvcv => \$xpvcvsect,
-                 xpviv => \$xpvivsect, xpvnv => \$xpvnvsect,
-                 xpvmg => \$xpvmgsect, xpvlv => \$xpvlvsect, xrv => \$xrvsect,
-                 xpvbm => \$xpvbmsect, xpvio => \$xpviosect);
+    init_sections();
     if (@options) {
        return sub {
            my $objname;

diff --git a/B/CC.pm b/B/CC.pm
index c01a6bf..6bb3acd 100644 (file)
--- a/B/CC.pm
+++ b/B/CC.pm
@@ -9,7 +9,8 @@ package B::CC;
 use strict;
 use B qw(main_start main_root class comppadlist peekop svref_2object
        timing_info);
-use B::C qw(save_unused_subs objsym output_all output_boilerplate output_main);
+use B::C qw(save_unused_subs objsym init_sections
+           output_all output_boilerplate output_main);
 use B::Bblock qw(find_leaders);
 use B::Stackobj qw(:types :flags);
 
@@ -530,7 +531,6 @@ sub pp_cond_expr {
     runtime(sprintf("if (!$bool) goto %s;", label($false)));
     return $op->true;
 }
-           
 
 sub pp_padsv {
     my $op = shift;
@@ -1379,7 +1379,7 @@ sub cc_main {
 
     return if $errors;
     if (!defined($module)) {
-       $init->add(sprintf("main_root = sym_%x;", ${main_root()}),
+       $init->add(sprintf("main_root = s\\_%x;", ${main_root()}),
                   "main_start = $start;",
                   "curpad = AvARRAY($curpad_sym);");
     }
@@ -1493,8 +1493,9 @@ sub compile {
            }
        }
     }
-    $init = new B::Section "init";
-    $decl = new B::Section "decl";
+    init_sections();
+    $init = B::Section->get("init");
+    $decl = B::Section->get("decl");
 
     if (@options) {
        return sub {