summaryrefslogtreecommitdiff
path: root/ext/B
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>1998-12-05 16:14:42 +0000
committerNick Ing-Simmons <nik@tiuk.ti.com>1998-12-05 16:14:42 +0000
commit0cc1d052f2b5aa0a485e4a60aabe91829ddbe78c (patch)
treeb4979327e0d5279d1ca64dcbac71db825e46eaef /ext/B
parentcf86991c04b212c029b30807ecab507b784fd8ad (diff)
downloadperl-0cc1d052f2b5aa0a485e4a60aabe91829ddbe78c.tar.gz
Avoid hard-coding op numbers
Update CC.pm to save %INC, and to co-exist with new C.pm p4raw-id: //depot/perl@2453
Diffstat (limited to 'ext/B')
-rw-r--r--ext/B/B.pm7
-rw-r--r--ext/B/B.xs23
-rw-r--r--ext/B/B/C.pm50
-rw-r--r--ext/B/B/CC.pm26
4 files changed, 72 insertions, 34 deletions
diff --git a/ext/B/B.pm b/ext/B/B.pm
index 75dcfb3b74..1599fe21c5 100644
--- 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 3b8a7e35de..3e300240ea 100644
--- 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 1c351fcf7b..40583bd71d 100644
--- 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 80c3f9e614..e6c21bca75 100644
--- 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-//;