Fix crashes with native types in conditionals

Fixes RT#132718: https://rt.perl.org/Ticket/Display.html?id=132718 When we put together the MAST for if/unless/while/until/repeat_while /repeat_until ops, we look up which MVM conditional op to use. The compiler did not know about non-fullwidth natives, and complained about that with a crash. Fix by teaching it about all the types and coercing non-fullwidth natives to fullwidth when calling the op. - Use array lookup instead of nested ternaries; measurement showed this approach to be 3x faster - Remove duplicate sub and move All The Things to the Regex compiler. the Operations still sees our arrays, so there's no duplication involved - Swapping if_s0 to if_s op is OK: the if_s0 variant used to treat "0" string as false, but was later changed to treat it as true and after expansion of all the macros is now exactly equivalent to plain if_s. Same with unless_s0 - I applied the lookup of extra types in one place in the Regex compiler that used to use the old lookup. However, I did not add coercion as I'm unsure what code exercises that codepath and whether the coercion is needed at all.
Raku · Jan 20, 2018 · df45cb8 · zhuomingliang · Jan 20, 2018 · zoffixznet
1 parent c11e211
commit df45cb8
Show file tree

Hide file tree

Showing 2 changed files with 74 additions and 34 deletions.
diff --git a/src/vm/moar/QAST/QASTOperationsMAST.nqp b/src/vm/moar/QAST/QASTOperationsMAST.nqp
@@ -813,16 +813,32 @@ for <if unless with without> -> $op_name {
                    MAST::Call.new( :target($method_reg), :result($decont_reg), :flags([$Arg::obj]), $decont_reg));
                 $regalloc.release_register($method_reg, $MVM_reg_obj);
             }
+
             push_op(@ins,
-                resolve_condition_op(@comp_ops[0].result_kind, $op_name eq 'if' || $op_name eq 'with'),
+                ($op_name eq 'if' || $op_name eq 'with'
+                  ?? @Negated-condition-op-kinds[@comp_ops[0].result_kind]
+                  !! @Condition-op-kinds[        @comp_ops[0].result_kind]),
                 $decont_reg,
                 ($operands == 3 ?? $else_lbl !! $end_lbl)
             );
             $regalloc.release_register($decont_reg, $MVM_reg_obj);
         }
+        elsif @Full-width-coerce-to[@comp_ops[0].result_kind] -> $coerce-kind {
+            my $coerce-reg := $regalloc.fresh_register: $coerce-kind;
+            push_op(@ins,
+                $op_name eq 'if'
+                  ?? @Negated-condition-op-kinds[@comp_ops[0].result_kind]
+                  !! @Condition-op-kinds[        @comp_ops[0].result_kind],
+                $coerce-reg,
+                ($operands == 3 ?? $else_lbl !! $end_lbl)
+            );
+            $regalloc.release_register: $coerce-reg, $coerce-kind;
+        }
         else {
             push_op(@ins,
-                resolve_condition_op(@comp_ops[0].result_kind, $op_name eq 'if'),
+                $op_name eq 'if'
+                  ?? @Negated-condition-op-kinds[@comp_ops[0].result_kind]
+                  !! @Condition-op-kinds[        @comp_ops[0].result_kind],
                 @comp_ops[0].result_reg,
                 ($operands == 3 ?? $else_lbl !! $end_lbl)
             );
@@ -1095,15 +1111,31 @@ for ('', 'repeat_') -> $repness {
                 my $decont_reg := $regalloc.fresh_register($MVM_reg_obj);
                 push_op(@loop_il, 'decont', $decont_reg, @comp_ops[0].result_reg);
                 push_op(@loop_il,
-                    resolve_condition_op(@comp_ops[0].result_kind, $op_name eq 'while'),
+                    $op_name eq 'while'
+                      ?? @Negated-condition-op-kinds[@comp_ops[0].result_kind]
+                      !! @Condition-op-kinds[        @comp_ops[0].result_kind],
                     $decont_reg,
                     $done_lbl
                 );
                 $regalloc.release_register($decont_reg, $MVM_reg_obj);
             }
+            elsif @Full-width-coerce-to[@comp_ops[0].result_kind]
+            -> $coerce-kind {
+                my $coerce-reg := $regalloc.fresh_register: $coerce-kind;
+                push_op(@loop_il,
+                    $op_name eq 'while'
+                      ?? @Negated-condition-op-kinds[@comp_ops[0].result_kind]
+                      !! @Condition-op-kinds[        @comp_ops[0].result_kind],
+                    $coerce-reg,
+                    $done_lbl
+                );
+                $regalloc.release_register: $coerce-reg, $coerce-kind;
+            }
             else {
                 push_op(@loop_il,
-                    resolve_condition_op(@comp_ops[0].result_kind, $op_name eq 'while'),
+                    $op_name eq 'while'
+                      ?? @Negated-condition-op-kinds[@comp_ops[0].result_kind]
+                      !! @Condition-op-kinds[        @comp_ops[0].result_kind],
                     @comp_ops[0].result_reg,
                     $done_lbl
                 );
@@ -2949,20 +2981,6 @@ QAST::MASTOperations.add_core_moarop_mapping('force_gc', 'force_gc');
 # MoarVM-specific coverage ops
 QAST::MASTOperations.add_core_moarop_mapping('coveragecontrol', 'coveragecontrol');
 
-sub resolve_condition_op($kind, $negated) {
-    return $negated ??
-        $kind == $MVM_reg_int64 ?? 'unless_i' !!
-        $kind == $MVM_reg_num64 ?? 'unless_n' !!
-        $kind == $MVM_reg_str   ?? 'unless_s0' !!
-        $kind == $MVM_reg_obj   ?? 'unless_o' !!
-        nqp::die("Unhandled kind $kind")
-     !! $kind == $MVM_reg_int64 ?? 'if_i' !!
-        $kind == $MVM_reg_num64 ?? 'if_n' !!
-        $kind == $MVM_reg_str   ?? 'if_s0' !!
-        $kind == $MVM_reg_obj   ?? 'if_o' !!
-        nqp::die("Unhandled kind $kind")
-}
-
 sub push_op(@dest, str $op, *@args) {
     nqp::push(@dest, MAST::Op.new_with_operand_array( :$op, @args ));
 }

diff --git a/src/vm/moar/QAST/QASTRegexCompilerMAST.nqp b/src/vm/moar/QAST/QASTRegexCompilerMAST.nqp
@@ -18,6 +18,40 @@ my int $MVM_reg_uint16          := 18;
 my int $MVM_reg_uint32          := 19;
 my int $MVM_reg_uint64          := 20;
 
+my @Condition-op-kinds := nqp::list(
+    nqp::null,  'if_i',     # $MVM_reg_void,   $MVM_reg_int8
+    'if_i',     'if_i',     # $MVM_reg_int16,  $MVM_reg_int32
+    'if_i',     'if_n',     # $MVM_reg_int64,  $MVM_reg_num32
+    'if_n',     'if_s',     # $MVM_reg_num64,  $MVM_reg_str
+    'if_o',                 # $MVM_reg_obj
+    nqp::null, nqp::null, nqp::null, nqp::null,
+    nqp::null, nqp::null, nqp::null, nqp::null,
+    'if_i',                 # $MVM_reg_uint8
+    'if_i',     'if_i',     # $MVM_reg_uint16, $MVM_reg_uint32
+    'if_i',                 # $MVM_reg_uint64
+);
+my @Negated-condition-op-kinds := nqp::list(
+    nqp::null,  'unless_i', # $MVM_reg_void,   $MVM_reg_int8
+    'unless_i', 'unless_i', # $MVM_reg_int16,  $MVM_reg_int32
+    'unless_i', 'unless_n', # $MVM_reg_int64,  $MVM_reg_num32
+    'unless_n', 'unless_s', # $MVM_reg_num64,  $MVM_reg_str
+    'unless_o',             # $MVM_reg_obj,
+    nqp::null, nqp::null, nqp::null, nqp::null,
+    nqp::null, nqp::null, nqp::null, nqp::null,
+    'unless_i', 'unless_i', # $MVM_reg_uint8,  $MVM_reg_uint16
+    'unless_i', 'unless_i', # $MVM_reg_uint32, $MVM_reg_uint64
+);
+my @Full-width-coerce-to := nqp::list( # 0 means we don't need any coersion
+    0,              $MVM_reg_int64, # $MVM_reg_void,   $MVM_reg_int8
+    $MVM_reg_int64, $MVM_reg_int64, # $MVM_reg_int16,  $MVM_reg_int32
+    0,              $MVM_reg_num64, # $MVM_reg_int64,  $MVM_reg_num32
+    0,              0,              # $MVM_reg_num64,  $MVM_reg_str
+    0,                              # $MVM_reg_obj
+    0, 0, 0, 0,   0, 0, 0, 0,
+    $MVM_reg_int64, $MVM_reg_int64, # $MVM_reg_uint8,  $MVM_reg_uint16
+    $MVM_reg_int64, $MVM_reg_int64, # $MVM_reg_uint32, $MVM_reg_uint64
+);
+
 class QAST::MASTRegexCompiler {
     # The compiler we're working against.
     has $!qastcomp;
@@ -704,20 +738,6 @@ class QAST::MASTRegexCompiler {
         @ins
     }
 
-    sub resolve_condition_op($kind, $negated) {
-        return $negated ??
-            $kind == $MVM_reg_int64 ?? 'unless_i' !!
-            $kind == $MVM_reg_num64 ?? 'unless_n' !!
-            $kind == $MVM_reg_str   ?? 'unless_s' !!
-            $kind == $MVM_reg_obj   ?? 'unless_o' !!
-            ''
-         !! $kind == $MVM_reg_int64 ?? 'if_i' !!
-            $kind == $MVM_reg_num64 ?? 'if_n' !!
-            $kind == $MVM_reg_str   ?? 'if_s' !!
-            $kind == $MVM_reg_obj   ?? 'if_o' !!
-            ''
-    }
-
     method qastnode($node) {
         my @ins := [
             op('bindattr_i', %!reg<cur>, %!reg<curclass>, sval('$!pos'), %!reg<pos>, ival(-1)),
@@ -726,8 +746,10 @@ class QAST::MASTRegexCompiler {
         my $cmast := $!qastcomp.as_mast($node[0]);
         merge_ins(@ins, $cmast.instructions);
         $!regalloc.release_register($cmast.result_reg, $cmast.result_kind);
-        my $cndop := resolve_condition_op($cmast.result_kind, !$node.negate);
-        if $node.subtype eq 'zerowidth' && $cndop ne '' {
+        my $cndop := $node.negate # the negation meaning is reversed for the op
+          ?? @Condition-op-kinds[        $cmast.result_kind]
+          !! @Negated-condition-op-kinds[$cmast.result_kind];
+        if $node.subtype eq 'zerowidth' && ! nqp::isnull($cndop) {
             nqp::push(@ins, op('decont', $cmast.result_reg, $cmast.result_reg))
                 if $cmast.result_kind == $MVM_reg_obj;
             nqp::push(@ins, op($cndop, $cmast.result_reg, %!reg<fail>));