Avoid hard-coding op numbers

Update CC.pm to save %INC, and to co-exist with new C.pm

p4raw-id: //depot/perl@2453

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 75dcfb3..1599fe2 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -11,7 +11,7 @@ require Exporter;
 @ISA = qw(Exporter DynaLoader);
 @EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname
                class peekop cast_I32 cstring cchar hash threadsv_names
-               main_root main_start main_cv svref_2object
+               main_root main_start main_cv svref_2object opnumber
                walkoptree walkoptree_slow walkoptree_exec walksymtable
                parents comppadlist sv_undef compile_stats timing_info init_av);
 
@@ -187,9 +187,12 @@ sub walkoptree_exec {
 sub walksymtable {
     my ($symref, $method, $recurse, $prefix) = @_;
     my $sym;
+    my $ref;
     no strict 'vars';
     local(*glob);
-    while (($sym, *glob) = each %$symref) {
+    $prefix = '' unless defined $prefix;
+    while (($sym, $ref) = each %$symref) {
+       *glob = $ref;
        if ($sym =~ /::$/) {
            $sym = $prefix . $sym;
            if ($sym ne "main::" && &$recurse($sym)) {

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 3b8a7e3..3e30024 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -514,7 +514,28 @@ svref_2object(sv)
            croak("argument is not a reference");
        RETVAL = (SV*)SvRV(sv);
     OUTPUT:
-       RETVAL
+       RETVAL              
+
+void
+opnumber(name)
+char * name
+CODE:
+{
+ int i; 
+ IV  result = -1;
+ ST(0) = sv_newmortal();
+ if (strncmp(name,"pp_",3) == 0)
+   name += 3;
+ for (i = 0; i < PL_maxo; i++)
+  {
+   if (strcmp(name, PL_op_name[i]) == 0)
+    {
+     result = i;
+     break;
+    }
+  }
+ sv_setiv(ST(0),result);
+}
 
 void
 ppname(opnum)

diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 1c351fc..40583bd 100644 (file)
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -44,12 +44,12 @@ sub output
 package B::C;
 use Exporter ();
 @ISA = qw(Exporter);
-@EXPORT_OK = qw(output_all output_boilerplate output_main
-               init_sections set_callback save_unused_subs objsym);
+@EXPORT_OK = qw(output_all output_boilerplate output_main mark_unused
+               init_sections set_callback save_unused_subs objsym save_context);
 
 use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
         class cstring cchar svref_2object compile_stats comppadlist hash
-        threadsv_names main_cv init_av);
+        threadsv_names main_cv init_av opnumber);
 use B::Asmdata qw(@specialsv_name);
 
 use FileHandle;
@@ -105,9 +105,9 @@ my $op_seq = 65535;
 
 sub AVf_REAL () { 1 }
 
-# XXX This shouldn't really be hardcoded here but it saves
-# looking up the name of every BASEOP in B::OP
-sub OP_THREADSV () { 345 }
+# Look this up here so we can do just a number compare
+# rather than looking up the name of every BASEOP in B::OP
+my $OP_THREADSV = opnumber('threadsv');
 
 sub savesym {
     my ($obj, $value) = @_;
@@ -155,7 +155,7 @@ sub B::OP::save {
     my ($op, $level) = @_;
     my $type = $op->type;
     $nullop_count++ unless $type;
-    if ($type == OP_THREADSV) {
+    if ($type == $OP_THREADSV) {
        # saves looking up ppaddr but it's a bit naughty to hard code this
        $init->add(sprintf("(void)find_threadsv(%s);",
                           cstring($threadsv_names[$op->targ])));
@@ -1250,30 +1250,34 @@ sub save_unused_subs
  walksymtable(\%{"main::"}, "savecv", \&should_save);
 }
 
+sub save_context
+{
+ my $curpad_nam = (comppadlist->ARRAY)[0]->save;
+ my $curpad_sym = (comppadlist->ARRAY)[1]->save;
+ my $inc_hv     = svref_2object(\%INC)->save;
+ my $inc_av     = svref_2object(\@INC)->save;
+ $init->add(   "PL_curpad = AvARRAY($curpad_sym);",
+              "GvHV(PL_incgv) = $inc_hv;",
+              "GvAV(PL_incgv) = $inc_av;",
+               "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
+               "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
+}
+
 sub save_main {
     warn "Starting compile\n";
     foreach my $pack (keys %unused_sub_packages)
      {
       mark_package($pack);
      }
-    my $curpad_nam = (comppadlist->ARRAY)[0]->save;
-    my $curpad_sym = (comppadlist->ARRAY)[1]->save;
-    my $init_av    = init_av->save;
-    my $inc_hv     = svref_2object(\%INC)->save;
-    my $inc_av     = svref_2object(\@INC)->save;
     warn "Walking tree\n";
     walkoptree(main_root, "save");
     warn "done main optree, walking symtable for extras\n" if $debug_cv;
     save_unused_subs();
-
+    my $init_av = init_av->save;
     $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
               sprintf("PL_main_start = s\\_%x;", ${main_start()}),
-              "PL_curpad = AvARRAY($curpad_sym);",
-              "PL_initav = $init_av;",
-              "GvHV(PL_incgv) = $inc_hv;",
-              "GvAV(PL_incgv) = $inc_av;",
-               "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
-               "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
+              "PL_initav = $init_av;");
+    save_context();
     warn "Writing output\n";
     output_boilerplate();
     print "\n";
@@ -1299,6 +1303,12 @@ sub init_sections {
     while (($name, $sectref) = splice(@sections, 0, 2)) {
        $$sectref = new B::C::Section $name, \%symtable, 0;
     }
+}           
+
+sub mark_unused
+{
+ my ($arg,$val) = @_;
+ $unused_sub_packages{$arg} = $val;
 }
 
 sub compile {
@@ -1343,7 +1353,7 @@ sub compile {
            $verbose = 1;
        } elsif ($opt eq "u") {
            $arg ||= shift @options;
-           $unused_sub_packages{$arg} = undef;
+           mark_unused($arg,undef);
        } elsif ($opt eq "f") {
            $arg ||= shift @options;
            if ($arg eq "cog") {

diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index 80c3f9e..e6c21bc 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -9,7 +9,7 @@ package B::CC;
 use strict;
 use B qw(main_start main_root class comppadlist peekop svref_2object
        timing_info init_av);
-use B::C qw(save_unused_subs objsym init_sections
+use B::C qw(save_unused_subs objsym init_sections mark_unused
            output_all output_boilerplate output_main);
 use B::Bblock qw(find_leaders);
 use B::Stackobj qw(:types :flags);
@@ -1264,11 +1264,11 @@ sub pp_substcont {
     write_back_stack();
     doop($op);
     my $pmop = $op->other;
-    warn sprintf("substcont: op = %s, pmop = %s\n",
-                peekop($op), peekop($pmop));#debug
-#    my $pmopsym = objsym($pmop);
+    # warn sprintf("substcont: op = %s, pmop = %s\n",
+    #           peekop($op), peekop($pmop));#debug
+#   my $pmopsym = objsym($pmop);
     my $pmopsym = $pmop->save; # XXX can this recurse?
-    warn "pmopsym = $pmopsym\n";#debug
+#   warn "pmopsym = $pmopsym\n";#debug
     runtime sprintf("if (PL_op == ((PMOP*)(%s))->op_pmreplstart) goto %s;",
                    $pmopsym, label($pmop->pmreplstart));
     invalidate_lexicals();
@@ -1387,11 +1387,13 @@ sub cc_obj {
 
 sub cc_main {
     my @comppadlist = comppadlist->ARRAY;
-    my $curpad_nam = $comppadlist[0]->save;
-    my $curpad_sym = $comppadlist[1]->save;
-    my $init_av   = init_av->save;
+    my $curpad_nam  = $comppadlist[0]->save;
+    my $curpad_sym  = $comppadlist[1]->save;
+    my $init_av     = init_av->save; 
+    my $inc_hv      = svref_2object(\%INC)->save;
+    my $inc_av      = svref_2object(\@INC)->save;
     my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
-    save_unused_subs(@unused_sub_packages);
+    save_unused_subs();
     cc_recurse();
 
     return if $errors;
@@ -1399,7 +1401,9 @@ sub cc_main {
        $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
                   "PL_main_start = $start;",
                   "PL_curpad = AvARRAY($curpad_sym);",
-                  "PL_initav = $init_av;",
+                  "PL_initav = $init_av;",
+                  "GvHV(PL_incgv) = $inc_hv;",
+                  "GvAV(PL_incgv) = $inc_av;",
                   "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
                   "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));",
                     );
@@ -1463,7 +1467,7 @@ sub compile {
            $module_name = $arg;
        } elsif ($opt eq "u") {
            $arg ||= shift @options;
-           push(@unused_sub_packages, $arg);
+           mark_unused($arg,undef);
        } elsif ($opt eq "f") {
            $arg ||= shift @options;
            my $value = $arg !~ s/^no-//;