moved cmm refactors into their own branch

ocaml-flambda · Dec 23, 2024 · 227f0c8 · 227f0c8
1 parent 6da1dde
commit 227f0c8
Show file tree

Hide file tree

Showing 14 changed files with 593 additions and 615 deletions.
diff --git a/backend/arm64/cfg_selection.ml b/backend/arm64/cfg_selection.ml
@@ -171,7 +171,7 @@ class selector =
     method! insert_move_extcall_arg env ty_arg src dst =
       let ty_arg_is_int32 =
         match ty_arg with
-        | XInt32 -> true
+        | XInt8 | XInt16 | XInt32 -> true
         | XInt | XInt64 | XFloat32 | XFloat | XVec128 -> false
       in
       if macosx && ty_arg_is_int32 && is_stack_slot dst

diff --git a/backend/arm64/proc.ml b/backend/arm64/proc.ml
@@ -263,7 +263,7 @@ let external_calling_conventions
     begin match ty_arg with
     | XInt | XInt64 ->
         loc.(i) <- [| loc_int last_int make_stack int ofs |]
-    | XInt32 ->
+    | XInt32 | XInt16 | XInt8 ->
         loc.(i) <- [| loc_int32 last_int make_stack int ofs |]
     | XFloat ->
         loc.(i) <- [| loc_float last_float make_stack float ofs |]

diff --git a/backend/arm64/selection.ml b/backend/arm64/selection.ml
@@ -157,7 +157,12 @@ class selector =
       | _ -> super#select_operation op args dbg
 
     method! insert_move_extcall_arg env ty_arg src dst =
-      if macosx && ty_arg = XInt32 && is_stack_slot dst
+      let ty_arg_is_int32 =
+        match ty_arg with
+        | XInt8 | XInt16 | XInt32 -> true
+        | XInt | XInt64 | XFloat32 | XFloat | XVec128 -> false
+      in
+      if macosx && ty_arg_is_int32 && is_stack_slot dst
       then self#insert env (Iop (Ispecific Imove32)) src dst
       else self#insert_moves env src dst
   end

diff --git a/backend/cmm.ml b/backend/cmm.ml
@@ -1,3 +1,4 @@
+# 1 "backend/cmm.ml"
 (**************************************************************************)
 (*                                                                        *)
 (*                                 OCaml                                  *)
@@ -101,6 +102,8 @@ let ge_component comp1 comp2 =
 
 type exttype =
   | XInt
+  | XInt8
+  | XInt16
   | XInt32
   | XInt64
   | XFloat32
@@ -109,6 +112,8 @@ type exttype =
 
 let machtype_of_exttype = function
   | XInt -> typ_int
+  | XInt8 -> typ_int
+  | XInt16 -> typ_int
   | XInt32 -> typ_int
   | XInt64 -> typ_int
   | XFloat -> typ_float
@@ -573,21 +578,19 @@ let equal_machtype_component (left : machtype_component) (right : machtype_compo
   | Float32, (Val | Addr | Int | Float | Vec128) ->
     false
 
-let equal_exttype left right =
-  match left, right with
-  | XInt, XInt -> true
-  | XInt32, XInt32 -> true
-  | XInt64, XInt64 -> true
-  | XFloat32, XFloat32 -> true
-  | XFloat, XFloat -> true
-  | XVec128, XVec128 -> true
-  | XInt, (XInt32 | XInt64 | XFloat | XFloat32 | XVec128)
-  | XInt32, (XInt | XInt64 | XFloat | XFloat32 | XVec128)
-  | XInt64, (XInt | XInt32 | XFloat | XFloat32 | XVec128)
-  | XFloat, (XInt | XInt32 | XFloat32 | XInt64 | XVec128)
-  | XVec128, (XInt | XInt32 | XInt64 | XFloat | XFloat32)
-  | XFloat32, (XInt | XInt32 | XInt64 | XFloat | XVec128) ->
-    false
+let equal_exttype
+      ((XInt
+       | XInt8
+       | XInt16
+       | XInt32
+       | XInt64
+       | XFloat32
+       | XFloat
+       | XVec128) as left)
+      right
+  =
+  (* we can use polymorphic compare as long as exttype is all constant constructors *)
+  left = right
 
 let equal_vec128_type v1 v2 =
   match v1, v2 with

diff --git a/backend/cmm.mli b/backend/cmm.mli
@@ -74,6 +74,8 @@ val ge_component
 
 type exttype =
   | XInt                                (**r OCaml value, word-sized integer *)
+  | XInt8                               (**r 8-bit integer *)
+  | XInt16                              (**r 16-bit integer  *)
   | XInt32                              (**r 32-bit integer *)
   | XInt64                              (**r 64-bit integer  *)
   | XFloat32                            (**r single-precision FP number *)

diff --git a/backend/cmm_builtins.ml b/backend/cmm_builtins.ml
@@ -512,7 +512,7 @@ let transl_builtin name args dbg typ_res =
   | "caml_unsigned_int64_mulh_unboxed" ->
     mulhi ~signed:false Unboxed_int64 args dbg
   | "caml_int32_unsigned_to_int_trunc_unboxed_to_untagged" ->
-    Some (zero_extend_32 dbg (one_arg name args))
+    Some (zero_extend ~bits:32 (one_arg name args) dbg)
   | "caml_csel_value" | "caml_csel_int_untagged" | "caml_csel_int64_unboxed"
   | "caml_csel_int32_unboxed" | "caml_csel_nativeint_unboxed" ->
     (* Unboxed float variant of csel intrinsic is not currently supported. It