128-bit Array Load/Store

backend/CSEgen.ml

@@ -240,9 +240,9 @@ method class_of_operation op =
   | Iload(_,_,mut) -> Op_load mut
   | Istore(_,_,asg) -> Op_store asg
   | Ialloc _ | Ipoll _ -> assert false     (* treated specially *)
-  | Iintop(Icheckbound) -> Op_checkbound
+  | Iintop(Icheckbound|Icheckalign _) -> Op_checkbound
   | Iintop _ -> Op_pure
-  | Iintop_imm(Icheckbound, _) -> Op_checkbound
+  | Iintop_imm((Icheckbound|Icheckalign _), _) -> Op_checkbound
   | Iintop_imm(_, _) -> Op_pure
   | Iintop_atomic _ -> Op_store true
   | Icompf _

backend/amd64/proc.ml

@@ -436,14 +436,14 @@ let destroyed_at_oper = function
                  | Ifloat_iround | Ifloat_min | Ifloat_max
                  | Ifloatarithmem (_, _) | Ibswap _ | Ifloatsqrtf _))
   | Iop(Iintop(Iadd | Isub | Imul | Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
-              | Ipopcnt | Iclz _ | Ictz _ | Icheckbound))
+              | Ipopcnt | Iclz _ | Ictz _ | Icheckbound | Icheckalign _))
   | Iop(Iintop_imm((Iadd | Isub | Imul | Imulh _ | Iand | Ior | Ixor | Ilsl
                    | Ilsr | Iasr | Ipopcnt | Iclz _ | Ictz _
-                   | Icheckbound),_))
+                   | Icheckbound | Icheckalign _),_))
   | Iop(Iintop_atomic _)
   | Iop(Istore((Byte_unsigned | Byte_signed | Sixteen_unsigned | Sixteen_signed
                | Thirtytwo_unsigned | Thirtytwo_signed | Word_int | Word_val
-               | Double | Onetwentyeight ), _, _))
+               | Double | Onetwentyeight_aligned | Onetwentyeight_unaligned), _, _))
   | Iop(Imove | Ispill | Ireload | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
        | Icompf _
        | Icsel _
@@ -476,21 +476,22 @@ let destroyed_at_basic (basic : Cfg_intf.S.basic) =
     destroyed_at_pushtrap
   | Op (Intop (Idiv | Imod)) | Op (Intop_imm ((Idiv | Imod), _)) ->
     [| rax; rdx |]
-  | Op(Store(Single, _, _)) ->
+  | Op (Store(Single, _, _)) ->
     destroy_xmm15 ()
   | Op(Intop(Imulh _ | Icomp _) | Intop_imm((Icomp _), _)) ->
     [| rax |]
   | Op (Specific (Irdtsc | Irdpmc)) ->
     [| rax; rdx |]
-  | Op (Intop Icheckbound | Intop_imm (Icheckbound, _)) ->
+  | Op (Intop (Icheckbound | Icheckalign _)
+  | Intop_imm ((Icheckbound | Icheckalign _), _)) ->
     assert false
   | Op (Move | Spill | Reload
        | Const_int _ | Const_float _ | Const_symbol _ | Const_vec128 _
        | Stackoffset _
        | Load _ | Store ((Byte_unsigned | Byte_signed | Sixteen_unsigned
                          | Sixteen_signed | Thirtytwo_unsigned
                          | Thirtytwo_signed | Word_int | Word_val
-                         | Double | Onetwentyeight ), _, _)
+                         | Double | Onetwentyeight_aligned | Onetwentyeight_unaligned), _, _)
        | Intop (Iadd | Isub | Imul | Iand | Ior | Ixor | Ilsl | Ilsr
                | Iasr | Ipopcnt | Iclz _ | Ictz _)
        | Intop_imm ((Iadd | Isub | Imul | Imulh _ | Iand | Ior | Ixor
@@ -526,7 +527,7 @@ let destroyed_at_terminator (terminator : Cfg_intf.S.terminator) =
     destroyed_at_alloc_or_poll
   | Always _ | Parity_test _ | Truth_test _ | Float_test _ | Int_test _
   | Return | Raise _ | Tailcall_self  _ | Tailcall_func _
-  | Prim {op = Checkbound _ | Probe _; _}
+  | Prim {op = Checkbound _ | Checkalign _ | Probe _; _}
   ->
     if fp then [| rbp |] else [||]
   | Switch _ ->
@@ -559,7 +560,7 @@ let is_destruction_point (terminator : Cfg_intf.S.terminator) =
     false
   | Always _ | Parity_test _ | Truth_test _ | Float_test _ | Int_test _
   | Return | Raise _ | Tailcall_self  _ | Tailcall_func _
-  | Prim {op = Checkbound _ | Probe _; _} ->
+  | Prim {op = (Checkbound _ | Checkalign _) | Probe _; _} ->
     false
   | Switch _ ->
     false
@@ -616,13 +617,13 @@ let max_register_pressure =
   | Istore(Single, _, _) | Icompf _ ->
     consumes ~int:0 ~float:1
   | Iintop(Iadd | Isub | Imul | Imulh _ | Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
-           | Ipopcnt|Iclz _| Ictz _|Icheckbound)
+           | Ipopcnt|Iclz _| Ictz _|Icheckbound|Icheckalign _)
   | Iintop_imm((Iadd | Isub | Imul | Imulh _ | Iand | Ior | Ixor | Ilsl | Ilsr
-                | Iasr | Ipopcnt | Iclz _| Ictz _|Icheckbound), _)
+                | Iasr | Ipopcnt | Iclz _| Ictz _|Icheckbound|Icheckalign _), _)
   | Iintop_atomic _
   | Istore((Byte_unsigned | Byte_signed | Sixteen_unsigned | Sixteen_signed
             | Thirtytwo_unsigned | Thirtytwo_signed | Word_int | Word_val
-            | Double | Onetwentyeight ),
+            | Double | Onetwentyeight_aligned | Onetwentyeight_unaligned),
             _, _)
   | Imove | Ispill | Ireload | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
   | Icsel _
@@ -729,6 +730,7 @@ let operation_supported = function
   | Ccmpf _
   | Craise _
   | Ccheckbound
+  | Ccheckalign _
   | Cvectorcast _ | Cscalarcast _
   | Cprobe _ | Cprobe_is_enabled _ | Copaque | Cbeginregion | Cendregion
     -> true

backend/amd64/regalloc_stack_operands.ml

@@ -7,10 +7,10 @@ open! Regalloc_utils
 let debug = false
 
 let may_use_stack_operand_for_second_argument
-  : type a . spilled_map -> a Cfg.instruction -> stack_operands_rewrite
-  = fun map instr ->
+  : type a . ?num_args:int -> spilled_map -> a Cfg.instruction -> stack_operands_rewrite
+  = fun ?(num_args = 2) map instr ->
   if debug then begin
-    check_lengths instr ~of_arg:2 ~of_res:1;
+    check_lengths instr ~of_arg:num_args ~of_res:1;
     check_same "res(0)" instr.res.(0) "arg(0)" instr.arg.(0);
   end;
   begin match is_spilled map instr.arg.(1) with
@@ -181,8 +181,13 @@ let basic (map : spilled_map) (instr : Cfg.basic Cfg.instruction) =
     may_use_stack_operand_for_second_argument map instr
   | Op (Specific (Isimd op)) ->
     (match Simd_selection.register_behavior op with
-    | R_to_R | R_R_to_fst -> May_still_have_spilled_registers
-    | R_RM_to_fst -> may_use_stack_operand_for_second_argument map instr
+    | R_to_fst | R_to_R | R_R_to_fst -> May_still_have_spilled_registers
+    | R_RM_to_fst | String_no_length | String_no_length_mask ->
+      may_use_stack_operand_for_second_argument map instr
+    | String_length | String_length_mask ->
+      may_use_stack_operand_for_second_argument ~num_args:4 map instr
+    | R_RM_XMM0_to_fst -> may_use_stack_operand_for_second_argument ~num_args:3 map instr
+    | R_to_RM -> may_use_stack_operand_for_result map instr ~num_args:1
     | RM_to_R -> may_use_stack_operand_for_only_argument map instr ~has_result:true)
   | Op (Scalarcast (V128_to_scalar (Float64x2) | V128_of_scalar (Float64x2))) ->
     unary_operation_argument_or_result_on_stack map instr
@@ -246,8 +251,8 @@ let basic (map : spilled_map) (instr : Cfg.basic Cfg.instruction) =
   | Prologue ->
     (* no rewrite *)
     May_still_have_spilled_registers
-  | Op (Intop Icheckbound)
-  | Op (Intop_imm ((Ipopcnt | Iclz _ | Ictz _ | Icheckbound), _)) ->
+  | Op (Intop (Icheckbound | Icheckalign _))
+  | Op (Intop_imm ((Ipopcnt | Iclz _ | Ictz _ | Icheckbound | Icheckalign _), _)) ->
     (* should not happen *)
     fatal "unexpected instruction"
   end
@@ -259,11 +264,16 @@ let terminator (map : spilled_map) (term : Cfg.terminator Cfg.instruction) =
   | Int_test { lt = _; eq = _; gt =_; is_signed = _; imm = None; }
   | Prim  {op = Checkbound { immediate = None; }; _} ->
     binary_operation map term No_result
+  | Prim  {op = Checkalign { immediate = None; _ }; _} ->
+    may_use_stack_operand_for_only_argument ~has_result:false map term
   | Int_test { lt = _; eq = _; gt =_; is_signed = _; imm = Some _; }
   | Parity_test { ifso = _; ifnot = _; }
   | Truth_test { ifso = _; ifnot = _; }
   | Prim {op = Checkbound { immediate = Some _; }; _} ->
     may_use_stack_operand_for_only_argument ~has_result:false map term
+  | Prim {op = Checkalign { immediate = Some _; _ }; _} ->
+    if debug then check_lengths term ~of_arg:0 ~of_res:0;
+    All_spilled_registers_rewritten
   | Float_test _ ->
     (* CR-someday xclerc for xclerc: this could be optimized, but the representation
        makes it more difficult than the cases above, because (i) multiple

backend/amd64/reload.ml

@@ -108,9 +108,9 @@ method! reload_operation op arg res =
         if stackp res.(0) then [| self#makereg res.(0) |] else res
       in
       arg, res
-  | Iintop(Imulh _ | Idiv | Imod | Ilsl | Ilsr | Iasr)
+  | Iintop(Imulh _ | Idiv | Imod | Ilsl | Ilsr | Iasr | Icheckalign _)
   | Iintop_imm((Iadd | Isub | Iand | Ior | Ixor | Ilsl | Ilsr | Iasr
-               | Imulh _ | Idiv | Imod | Icheckbound), _) ->
+               | Imulh _ | Idiv | Imod | Icheckbound | Icheckalign _), _) ->
       (* The argument(s) and results can be either in register or on stack *)
       (* Note: Imulh, Idiv, Imod: arg(0) and res(0) already forced in regs
                Ilsl, Ilsr, Iasr: arg(1) already forced in regs *)
@@ -134,6 +134,14 @@ method! reload_operation op arg res =
       else (arg, res)
   | Ispecific(Isimd op) ->
     (match Simd_selection.register_behavior op with
+    | R_to_fst ->
+      (* Argument must be in a register; result must be the argument. *)
+      let arg0 = if stackp arg.(0) then self#makereg arg.(0) else arg.(0) in
+      ([|arg0|], [|arg0|])
+    | R_to_RM ->
+      (* Argument must be in a register. *)
+      let arg0 = if stackp arg.(0) then self#makereg arg.(0) else arg.(0) in
+      ([|arg0|], res)
     | RM_to_R ->
       (* Result must be in a register. *)
       let res0 = if stackp res.(0) then self#makereg res.(0) else res.(0) in
@@ -148,11 +156,20 @@ method! reload_operation op arg res =
       let arg0 = if stackp arg.(0) then self#makereg arg.(0) else arg.(0) in
       let arg1 = if stackp arg.(1) then self#makereg arg.(1) else arg.(1) in
       ([|arg0; arg1|], [|arg0|])
-    | R_RM_to_fst ->
+    | R_RM_to_fst | R_RM_XMM0_to_fst ->
       (* First argument must be a register; the result must be the first arg.
          Note that stack-spilled vectors are properly aligned. *)
       let arg0 = if stackp arg.(0) then self#makereg arg.(0) else arg.(0) in
-      ([|arg0; arg.(1)|], [|arg0|]))
+      let arg = Array.copy arg in
+      Array.set arg 0 arg0;
+      (arg, [|arg0|])
+    | String_length | String_no_length | String_length_mask | String_no_length_mask ->
+      (* First argument must be a register. Specific register constraints
+         are enforced by selection. *)
+      let arg0 = if stackp arg.(0) then self#makereg arg.(0) else arg.(0) in
+      let arg = Array.copy arg in
+      Array.set arg 0 arg0;
+      (arg, res))
   | Ifloatofint | Iintoffloat ->
       (* Result must be in register, but argument can be on stack *)
       (arg, (if stackp res.(0) then [| self#makereg res.(0) |] else res))

backend/amd64/selection.ml

@@ -90,6 +90,7 @@ exception Use_default
 let rax = phys_reg Int 0
 let rcx = phys_reg Int 5
 let rdx = phys_reg Int 4
+let xmm0v () = phys_reg Vec128 100
 
 let pseudoregs_for_operation op arg res =
   match op with
@@ -156,19 +157,32 @@ let pseudoregs_for_operation op arg res =
     ([|res.(0); arg.(1)|], res)
   | Ispecific (Isimd op) ->
     (match Simd_selection.register_behavior op with
-    | RM_to_R | R_to_R -> (arg, res)
+    | R_to_R | RM_to_R | R_to_RM -> (arg, res)
+    | R_to_fst ->
+      (* arg.(0) and res.(0) must be the same *)
+      ([|res.(0)|], res)
     | R_R_to_fst | R_RM_to_fst ->
       (* arg.(0) and res.(0) must be the same *)
-      ([|res.(0); arg.(1)|], res))
+      ([|res.(0); arg.(1)|], res)
+    | R_RM_XMM0_to_fst ->
+      ([|res.(0); arg.(1); xmm0v ()|], res)
+    | String_length ->
+      ([|arg.(0); arg.(1); rax; rdx|], [| rcx |])
+    | String_length_mask ->
+      ([|arg.(0); arg.(1); rax; rdx|], [| xmm0v () |])
+    | String_no_length ->
+      (arg, [| rcx |])
+    | String_no_length_mask ->
+      (arg, [| xmm0v () |]))
   | Icsel _ ->
     (* last arg must be the same as res.(0) *)
     let len = Array.length arg in
     let arg = Array.copy arg in
     arg.(len-1) <- res.(0);
     (arg, res)
   (* Other instructions are regular *)
-  | Iintop (Ipopcnt|Iclz _|Ictz _|Icomp _|Icheckbound)
-  | Iintop_imm ((Imulh _|Idiv|Imod|Icomp _|Icheckbound
+  | Iintop (Ipopcnt|Iclz _|Ictz _|Icomp _|Icheckbound|Icheckalign _)
+  | Iintop_imm ((Imulh _|Idiv|Imod|Icomp _|Icheckbound|Icheckalign _
                 |Ipopcnt|Iclz _|Ictz _), _)
   | Ispecific (Isqrtf|Isextend32|Izextend32|Ilea _|Istore_int (_, _, _)
               |Ifloat_iround|Ifloat_round _