diff options
author | Nick Ing-Simmons <nik@tiuk.ti.com> | 1998-12-05 16:14:42 +0000 |
---|---|---|
committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 1998-12-05 16:14:42 +0000 |
commit | 0cc1d052f2b5aa0a485e4a60aabe91829ddbe78c (patch) | |
tree | b4979327e0d5279d1ca64dcbac71db825e46eaef | |
parent | cf86991c04b212c029b30807ecab507b784fd8ad (diff) | |
download | perl-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
-rw-r--r-- | ext/B/B.pm | 7 | ||||
-rw-r--r-- | ext/B/B.xs | 23 | ||||
-rw-r--r-- | ext/B/B/C.pm | 50 | ||||
-rw-r--r-- | ext/B/B/CC.pm | 26 |
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-//; |