B::CC::pp_rv2cv problem

[p5sagit/p5-mst-13.2.git] / ext / B / B / CC.pm

diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index e6c21bc..1197be4 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -66,6 +66,7 @@ my %skip_stack;               # Hash of PP names which don't need write_back_stack
 my %skip_lexicals;     # Hash of PP names which don't need write_back_lexicals
 my %skip_invalidate;   # Hash of PP names which don't need invalidate_lexicals
 my %ignore_op;         # Hash of ops which do nothing except returning op_next
+my %need_curcop;       # Hash of ops which need PL_curcop
 
 BEGIN {
     foreach (qw(pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) {
@@ -73,11 +74,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,
     $debug_shadow, $debug_queue, $debug_lineno, $debug_timings);
@@ -111,6 +107,7 @@ sub init_hash { map { $_ => 1 } @_ }
 #
 %skip_lexicals = init_hash qw(pp_enter pp_enterloop);
 %skip_invalidate = init_hash qw(pp_enter pp_enterloop);
+%need_curcop = init_hash qw(pp_rv2gv  pp_bless pp_repeat pp_sort pp_caller pp_reset pp_rv2cv pp_entereval pp_require pp_dofile pp_entertry pp_enterloop pp_enteriter );
 
 sub debug {
     if ($debug_runtime) {
@@ -200,7 +197,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 +205,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.
@@ -350,8 +347,9 @@ sub dopoptoloop {
 sub dopoptolabel {
     my $label = shift;
     my $cxix = $#cxstack;
-    while ($cxix >= 0 && $cxstack[$cxix]->{type} != CXt_LOOP
-          && $cxstack[$cxix]->{label} ne $label) {
+    while ($cxix >= 0 &&
+          ($cxstack[$cxix]->{type} != CXt_LOOP ||
+           $cxstack[$cxix]->{label} ne $label)) {
        $cxix--;
     }
     debug "dopoptolabel: returning $cxix" if $debug_cxstack;
@@ -584,14 +582,15 @@ sub pp_dbstate {
     return default_pp($op);
 }
 
-sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
-sub pp_bless { $curcop->write_back; default_pp(@_) }
-sub pp_repeat { $curcop->write_back; default_pp(@_) }
+#default_pp will handle this:
+#sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
+#sub pp_bless { $curcop->write_back; default_pp(@_) }
+#sub pp_repeat { $curcop->write_back; default_pp(@_) }
 # The following subs need $curcop->write_back if we decide to support arybase:
 # pp_pos, pp_substr, pp_index, pp_rindex, pp_aslice, pp_lslice, pp_splice
-sub pp_sort { $curcop->write_back; default_pp(@_) }
-sub pp_caller { $curcop->write_back; default_pp(@_) }
-sub pp_reset { $curcop->write_back; default_pp(@_) }
+#sub pp_sort { $curcop->write_back; default_pp(@_) }
+#sub pp_caller { $curcop->write_back; default_pp(@_) }
+#sub pp_reset { $curcop->write_back; default_pp(@_) }
 
 sub pp_gv {
     my $op = shift;
@@ -666,11 +665,15 @@ sub numeric_binop {
            }
        } else {
            if ($force_int) {
+               my $rightruntime = new B::Pseudoreg ("IV", "riv");
+               runtime(sprintf("$$rightruntime = %s;",$right));
                runtime(sprintf("sv_setiv(TOPs, %s);",
-                               &$operator("TOPi", $right)));
+                               &$operator("TOPi", $$rightruntime)));
            } else {
+               my $rightruntime = new B::Pseudoreg ("double", "rnv");
+               runtime(sprintf("$$rightruntime = %s;",$right));
                runtime(sprintf("sv_setnv(TOPs, %s);",
-                               &$operator("TOPn", $right)));
+                               &$operator("TOPn",$$rightruntime)));
            }
        }
     } else {
@@ -1063,7 +1066,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;
 }
@@ -1278,6 +1281,9 @@ sub pp_substcont {
 sub default_pp {
     my $op = shift;
     my $ppname = $op->ppaddr;
+    if ($curcop and $need_curcop{$ppname}){
+       $curcop->write_back;
+    }
     write_back_lexicals() unless $skip_lexicals{$ppname};
     write_back_stack() unless $skip_stack{$ppname};
     doop($op);
@@ -1356,7 +1362,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)));
        }
@@ -1409,6 +1415,7 @@ sub cc_main {
                     );
                  
     }
+    seek(STDOUT,0,0); #prevent print statements from BEGIN{} into the output
     output_boilerplate();
     print "\n";
     output_all("perl_init");
@@ -1493,7 +1500,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;