implement p6sort on moarvm.

rakudo · Jan 3, 2014 · f920930 · f920930
1 parent caa3b0f
commit f920930
Show file tree

Hide file tree

Showing 2 changed files with 74 additions and 13 deletions.
diff --git a/src/vm/moar/Perl6/Ops.nqp b/src/vm/moar/Perl6/Ops.nqp
@@ -273,7 +273,80 @@ $ops.add_hll_moarop_mapping('perl6', 'p6shiftpush', 'p6shiftpush');
 $ops.add_hll_moarop_mapping('perl6', 'p6arrfindtypes', 'p6arrfindtypes');
 $ops.add_hll_moarop_mapping('perl6', 'p6decodelocaltime', 'p6decodelocaltime');
 #$ops.map_classlib_hll_op('perl6', 'tclc', $TYPE_P6OPS, 'tclc', [$RT_STR], $RT_STR, :tc);
-$ops.add_hll_moarop_mapping('perl6', 'p6sort', 'p6sort');
+proto sub p6sort(@input_data, &comparator) {
+    # using the "bottom-up" mergesort implementation as shown in the english
+    # wikipedia article
+
+    # for some extra (hopefully measurable) benefit, we plop our indices
+    # into native integer lists before going on.
+
+    my @b_list := nqp::list_i();
+    my @data := nqp::list_i();
+    nqp::setelems(@b_list, +@input_data);
+    nqp::setelems(@b_list, 0);
+    nqp::setelems(@data, +@input_data);
+    nqp::setelems(@data, 0);
+
+    my int $copy_idx;
+    for @input_data {
+        nqp::bindpos_i(@data, $copy_idx++, $_);
+    }
+
+    my int $n := +@data;
+
+    my int $run_w := 1; # the width of each of the runs we are looking at
+    while $run_w < $n {
+        my int $i;
+
+        while $i < $n {
+            my int $left  := $i;
+            my int $right := $i + $run_w;
+            $right        := $n if $n < $right;
+
+            my int $end   := $i + 2 * $run_w;
+            $end          := $n if $n < $end;
+
+            my int $i0    := $left;
+            my int $i1    := $right;
+            my int $j     := $i0;
+
+            while $j < $end {
+                if $i0 < $right && ($i1 >= $end || -1 == comparator(nqp::atpos_i(@data, $i0), nqp::atpos_i(@data, $i1))) {
+                    nqp::bindpos_i(@b_list, $j, nqp::atpos_i(@data, $i0));
+                    $i0 := $i0 + 1;
+                } else {
+                    nqp::bindpos_i(@b_list, $j, nqp::atpos_i(@data, $i1));
+                    $i1 := $i1 + 1;
+                }
+                $j := $j + 1;
+            }
+
+            $i := $i + 2 * $run_w;
+        }
+
+        {
+            my $t := @b_list;
+            @b_list := @data;
+            @data := $t;
+        }
+
+        $run_w := $run_w * 2;
+    }
+
+    $copy_idx := 0;
+    for @data {
+        nqp::bindpos(@input_data, $copy_idx++, $_);
+    }
+}
+my $p6sort := -> $qastcomp, $op {
+    $qastcomp.as_mast(QAST::Op.new(
+        :op('call'),
+        QAST::WVal.new( :value(nqp::getcodeobj(&p6sort)) ),
+        $op[0],
+        $op[1]
+    ));
+};
+$ops.add_hll_op('perl6', 'p6sort', :!inlinable, $p6sort);
 $ops.add_hll_moarop_mapping('perl6', 'p6staticouter', 'p6staticouter');
 my $p6bool := -> $qastcomp, $op {
     # Compile instructions.

diff --git a/src/vm/moar/ops/perl6_ops.c b/src/vm/moar/ops/perl6_ops.c
@@ -521,17 +521,6 @@ static void p6decodelocaltime(MVMThreadContext *tc) {
     MVM_exception_throw_adhoc(tc, "p6decodelocaltime NYI");
 }
 
-static MVMuint8 s_p6sort[] = {
-    MVM_operand_obj | MVM_operand_write_reg,
-    MVM_operand_obj | MVM_operand_read_reg,
-    MVM_operand_obj | MVM_operand_read_reg
-};
-static void p6sort(MVMThreadContext *tc) {
-    MVMObject    *indices = GET_REG(tc, 2).o;
-    MVMObject *comparator = GET_REG(tc, 4).o;
-    MVM_exception_throw_adhoc(tc, "p6sort NYI");
-}
-
 static MVMuint8 s_p6staticouter[] = {
     MVM_operand_obj | MVM_operand_write_reg,
     MVM_operand_obj | MVM_operand_read_reg
@@ -577,6 +566,5 @@ MVM_DLL_EXPORT void Rakudo_ops_init(MVMThreadContext *tc) {
     MVM_ext_register_extop(tc, "p6shiftpush", p6shiftpush, 4, s_p6shiftpush);
     MVM_ext_register_extop(tc, "p6arrfindtypes", p6arrfindtypes, 5, s_p6arrfindtypes);
     MVM_ext_register_extop(tc, "p6decodelocaltime", p6decodelocaltime, 2, s_p6decodelocaltime);
-    MVM_ext_register_extop(tc, "p6sort", p6sort, 3, s_p6sort);
     MVM_ext_register_extop(tc, "p6staticouter", p6staticouter, 2, s_p6staticouter);
 }