Re: [PATCH 5.005_57] pp_sort sorted out

[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 143ae41..059491d 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -8,7 +8,7 @@
 package B::CC;
 use strict;
 use B qw(main_start main_root class comppadlist peekop svref_2object
-       timing_info init_av  sv_undef
+       timing_info init_av sv_undef amagic_generation 
        OPf_WANT_LIST OPf_WANT OPf_MOD OPf_STACKED OPf_SPECIAL
        OPpASSIGN_BACKWARDS OPpLVAL_INTRO OPpDEREF_AV OPpDEREF_HV
        OPpDEREF OPpFLIP_LINENUM G_ARRAY G_SCALAR    
@@ -92,7 +92,9 @@ 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 pp_entersub pp_enter);
+%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 pp_entersub pp_enter);
 
 sub debug {
     if ($debug_runtime) {
@@ -149,7 +151,7 @@ sub init_pp {
     declare("SV", "**svp");
     map { declare("SV", "*$_") } qw(sv src dst left right);
     declare("MAGIC", "*mg");
-    $decl->add("static OP * $ppname _((ARGSproto));");
+    $decl->add("static OP * $ppname (pTHX);");
     debug "init_pp: $ppname\n" if $debug_queue;
 }
 
@@ -585,10 +587,44 @@ sub pp_dbstate {
 #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 {
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    if ($op->flags & OPf_SPECIAL && $op->flags & OPf_STACKED){
+       #this indicates the "sort BLOCK Array" case 
+        #ugly optree surgery required.
+       my $root=$op->first->sibling->first;
+       my $start=$root->first;
+       $op->first->save;
+       $op->first->sibling->save;
+       $root->save;
+       $start->save;
+       my $sym=objsym($start);
+       my $fakeop=cc_queue("pp_sort".$$op,$root,$start);       
+       $init->add(sprintf("($sym)->op_next=%s;",$fakeop));
+    } 
+    $curcop->write_back;
+    write_back_lexicals(); 
+    write_back_stack(); 
+    doop($op);
+    return $op->next;
+}
+
+sub pp_leavesub{
+    my $op = shift;
+    my $ppname = $op->ppaddr;
+    write_back_lexicals() unless $skip_lexicals{$ppname};
+    write_back_stack() unless $skip_stack{$ppname};
+    runtime("if (PL_curstackinfo->si_type == PERLSI_SORT) {");
+    runtime("\tPUTBACK;return 0;");
+    runtime("}");
+    doop($op);
+    return $op->next;
+}
+
 sub pp_gv {
     my $op = shift;
     my $gvsym = $op->gv->save;
@@ -1000,7 +1036,7 @@ sub pp_entersub {
     write_back_stack();
     my $sym = doop($op);
     runtime("while (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){");
-    runtime("PL_op = (*PL_op->op_ppaddr)(ARGS);");
+    runtime("PL_op = (*PL_op->op_ppaddr)(aTHX);");
     runtime("SPAGAIN;}");
     $know_op = 0;
     invalidate_lexicals(REGISTER|TEMPORARY);
@@ -1043,7 +1079,7 @@ sub pp_leavewrite {
     my $sym = doop($op);
     # XXX Is this the right way to distinguish between it returning
     # CvSTART(cv) (via doform) and pop_return()?
-    #runtime("if (PL_op) PL_op = (*PL_op->op_ppaddr)(ARGS);");
+    #runtime("if (PL_op) PL_op = (*PL_op->op_ppaddr)(aTHX);");
     runtime("SPAGAIN;");
     $know_op = 0;
     invalidate_lexicals(REGISTER|TEMPORARY);
@@ -1424,7 +1460,12 @@ sub cc {
        warn sprintf("Basic block analysis at %s\n", timing_info);
     }
     $leaders = find_leaders($root, $start);
-    @bblock_todo = ($start, values %$leaders);
+    my @leaders= keys %$leaders; 
+    if ($#leaders > -1) { 
+       @bblock_todo = ($start, values %$leaders) ;
+    } else{
+       runtime("return PL_op?PL_op->op_next:0;");
+    }
     if ($debug_timings) {
        warn sprintf("Compilation at %s\n", timing_info);
     }
@@ -1488,6 +1529,7 @@ sub cc_main {
 
     my $inc_hv      = svref_2object(\%INC)->save;
     my $inc_av      = svref_2object(\@INC)->save;
+    my $amagic_generate= amagic_generation;
     return if $errors;
     if (!defined($module)) {
        $init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
@@ -1498,6 +1540,7 @@ sub cc_main {
                   "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_amagic_generation= $amagic_generate;",
                     );
                  
     }
@@ -1524,7 +1567,7 @@ XS(boot_$cmodule)
     SAVESPTR(PL_op);
     PL_curpad = AvARRAY($curpad_sym);
     PL_op = $start;
-    pp_main(ARGS);
+    pp_main(aTHX);
     FREETMPS;
     LEAVE;
     ST(0) = &PL_sv_yes;