diff options
author | Vishal Bhatia <vishal@deja.com> | 1998-12-09 14:16:50 -0800 |
---|---|---|
committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 1998-12-10 21:00:50 +0000 |
commit | a9b6343a0cbd709bfa038c43a178314fd9eb0af2 (patch) | |
tree | e5ceebec0343a807b517aaeb7865d7ccb145e189 /ext | |
parent | acba1d67a98a60de898ada2fc3df1e9efc92b76d (diff) | |
download | perl-a9b6343a0cbd709bfa038c43a178314fd9eb0af2.tar.gz |
1. Fixes the bug reported by Robin Barker <rmb1@cise.npl.co.uk>
2. Fixes the bug regarding return value of c-functions generated out
of perl subs. ( Just includes the patch I sent earlier)
3. Incorporates the other changes that need to be done to get CC.pm
use ISA search for packages and methods on the same lines as C.pm
Vishal would appreciate comments about B::Stackobj changes from
someone knowing that module well.
p4raw-id: //depot/perl@2461
Diffstat (limited to 'ext')
-rw-r--r-- | ext/B/B/C.pm | 12 | ||||
-rw-r--r-- | ext/B/B/CC.pm | 14 | ||||
-rw-r--r-- | ext/B/B/Stackobj.pm | 10 |
3 files changed, 23 insertions, 13 deletions
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm index 40583bd71d..58d88591a6 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -1244,6 +1244,7 @@ sub walkpackages sub save_unused_subs { no strict qw(refs); + &descend_marked_unused; warn "Prescan\n"; walkpackages(\%{"main::"}, sub { should_save($_[0]); return 1 }); warn "Saving methods\n"; @@ -1263,12 +1264,15 @@ sub save_context "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));"); } +sub descend_marked_unused { + foreach my $pack (keys %unused_sub_packages) + { + mark_package($pack); + } +} + sub save_main { warn "Starting compile\n"; - foreach my $pack (keys %unused_sub_packages) - { - mark_package($pack); - } warn "Walking tree\n"; walkoptree(main_root, "save"); warn "done main optree, walking symtable for extras\n" if $debug_cv; diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm index e6c21bca75..efb17a1280 100644 --- a/ext/B/B/CC.pm +++ b/ext/B/B/CC.pm @@ -73,10 +73,6 @@ BEGIN { } } -my @unused_sub_packages; # list of packages (given by -u options) to search - # explicitly and save every sub we find there, even - # if apparently unused (could be only referenced from - # an eval "" or from a $SIG{FOO} = "bar"). my ($module_name); my ($debug_op, $debug_stack, $debug_cxstack, $debug_pad, $debug_runtime, @@ -200,7 +196,7 @@ sub top_int { @stack ? $stack[-1]->as_int : "TOPi" } sub top_double { @stack ? $stack[-1]->as_double : "TOPn" } sub top_numeric { @stack ? $stack[-1]->as_numeric : "TOPn" } sub top_sv { @stack ? $stack[-1]->as_sv : "TOPs" } -sub top_bool { @stack ? $stack[-1]->as_numeric : "SvTRUE(TOPs)" } +sub top_bool { @stack ? $stack[-1]->as_bool : "SvTRUE(TOPs)" } sub pop_int { @stack ? (pop @stack)->as_int : "POPi" } sub pop_double { @stack ? (pop @stack)->as_double : "POPn" } @@ -208,7 +204,7 @@ sub pop_numeric { @stack ? (pop @stack)->as_numeric : "POPn" } sub pop_sv { @stack ? (pop @stack)->as_sv : "POPs" } sub pop_bool { if (@stack) { - return ((pop @stack)->as_numeric); + return ((pop @stack)->as_bool); } else { # Careful: POPs has an auto-decrement and SvTRUE evaluates # its argument more than once. @@ -1063,7 +1059,7 @@ sub pp_return { write_back_lexicals(REGISTER|TEMPORARY); write_back_stack(); doop($op); - runtime("PUTBACK;", "return (PL_op)?PL_op->op_next:0;"); + runtime("PUTBACK;", "return PL_op;"); $know_op = 0; return $op->next; } @@ -1356,7 +1352,7 @@ sub cc { $need_freetmps = 0; } if (!$$op) { - runtime("PUTBACK;","return (PL_op)?PL_op->op_next:0;"); + runtime("PUTBACK;","return PL_op;"); } elsif ($done{$$op}) { runtime(sprintf("goto %s;", label($op))); } @@ -1493,7 +1489,7 @@ sub compile { } elsif ($opt eq "m") { $arg ||= shift @options; $module = $arg; - push(@unused_sub_packages, $arg); + mark_unused($arg,undef); } elsif ($opt eq "p") { $arg ||= shift @options; $patchlevel = $arg; diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm index eea966ceb6..77600065ab 100644 --- a/ext/B/B/Stackobj.pm +++ b/ext/B/B/Stackobj.pm @@ -81,6 +81,16 @@ sub as_numeric { return $obj->{type} == T_INT ? $obj->as_int : $obj->as_double; } +sub as_bool { + my $obj=shift; + if ($obj->{flags} & VALID_INT ){ + return $obj->{iv}; + } + if ($obj->{flags} & VALID_DOUBLE ){ + return $obj->{nv}; + } + return sprintf("(SvTRUE(%s))", $obj->as_sv) ; +} # # Debugging methods # |