Remove float32/simd backend extension checks

backend/amd64/arch.ml

@@ -108,20 +108,6 @@ let command_line_options =
       " Do not emit .note.ocaml_eh section with trap handling information"
   ] @ Extension.args
 
-let assert_simd_enabled () =
-  if not (Language_extension.is_enabled SIMD) then
-  Misc.fatal_error "SIMD is not enabled. This error might happen \
-  if you are using SIMD yourself or are linking code that uses it. \
-  Pass [-extension-universe stable] to the compiler, or set \
-  (extension_universe stable) in your library configuration file."
-
-let assert_float32_enabled () =
-  if not (Language_extension.(is_at_least Small_numbers Stable)) then
-  Misc.fatal_error "float32 is not enabled. This error might happen \
-  if you are using float32 yourself or are linking code that uses it. \
-  Pass [-extension-universe stable] to the compiler, or set \
-  (extension_universe stable) in your library configuration file."
-
 (* Specific operations for the AMD64 processor *)
 
 open Format

backend/amd64/arch.mli

@@ -42,9 +42,6 @@ val trap_notes : bool ref
 val arch_check_symbols : bool ref
 val command_line_options : (string * Arg.spec * string) list
 
-val assert_simd_enabled : unit -> unit
-val assert_float32_enabled : unit -> unit
-
 (* Specific operations for the AMD64 processor *)
 
 type sym_global = Global | Local

backend/amd64/emit.mlp

@@ -54,13 +54,7 @@ let float_reg_name = Array.init 16 (fun i -> XMM i)
 let register_name typ r =
   match (typ : machtype_component) with
   | Int | Val | Addr -> Reg64 (int_reg_name.(r))
-  | Float -> Regf (float_reg_name.(r - 100))
-  | Vec128 ->
-    assert_simd_enabled ();
-    Regf (float_reg_name.(r - 100))
-  | Float32 ->
-    assert_float32_enabled ();
-    Regf (float_reg_name.(r - 100))
+  | Float | Float32 | Vec128 -> Regf (float_reg_name.(r - 100))
 
 let phys_rax = phys_reg Int 0
 let phys_rdx = phys_reg Int 4
@@ -2082,10 +2076,6 @@ let make_stack_loc ~offset n (r : Reg.t) =
      probe arguments) in the wrapper's frame. *)
   let loc = Stack (Outgoing (offset + n)) in
   (* Manufacture stack entry with this register's type *)
-  (match r.typ with
-   | Int | Val | Addr | Float -> ()
-   | Float32 -> assert_float32_enabled ()
-   | Vec128 -> assert_simd_enabled ());
   Reg.at_location r.typ loc
 
 (* CR mshinwell: Not now, but after code review, it would be better to

backend/amd64/proc.ml

@@ -102,24 +102,21 @@ let num_register_classes = 2
 let register_class r =
   match r.typ with
   | Val | Int | Addr -> 0
-  | Float -> 1
-  | Vec128 -> assert_simd_enabled (); 1
-  | Float32 -> assert_float32_enabled (); 1
+  | Float | Float32 | Vec128 -> 1
 
 let num_stack_slot_classes = 3
 
 let stack_slot_class typ =
   match (typ : machtype_component) with
   | Val | Addr | Int -> 0
-  | Float -> 1
-  | Vec128 -> assert_simd_enabled (); 2
-  | Float32 -> assert_float32_enabled (); 1
+  | Float | Float32 -> 1
+  | Vec128 -> 2
 
 let stack_class_tag c =
   match c with
   | 0 -> "i"
   | 1 -> "f"
-  | 2 -> assert_simd_enabled (); "x"
+  | 2 -> "x"
   | c -> Misc.fatal_errorf "Unspecified stack slot class %d" c
 
 let num_available_registers = [| 13; 16 |]
@@ -131,13 +128,7 @@ let register_name ty r =
   match (ty : machtype_component) with
   | Int | Addr | Val ->
     int_reg_name.(r - first_available_register.(0))
-  | Float ->
-    float_reg_name.(r - first_available_register.(1))
-  | Vec128 ->
-    assert_simd_enabled ();
-    float_reg_name.(r - first_available_register.(1))
-  | Float32 ->
-    assert_float32_enabled ();
+  | Float | Float32 | Vec128 ->
     float_reg_name.(r - first_available_register.(1))
 
 (* Pack registers starting at %rax so as to reduce the number of REX
@@ -159,40 +150,22 @@ let hard_float_reg =
 let hard_vec128_reg =
   let v = Array.make 16 Reg.dummy in
   for i = 0 to 15 do v.(i) <- Reg.at_location Vec128 (Reg (100 + i)) done;
-  fun () -> assert_simd_enabled (); v
+  v
 
 let hard_float32_reg =
   let v = Array.make 16 Reg.dummy in
   for i = 0 to 15 do v.(i) <- Reg.at_location Float32 (Reg (100 + i)) done;
-  fun () -> assert_float32_enabled (); v
-
-let extension_regs (type a) ?prefix (ext : a Language_extension.t) (maturity : a) () =
-  if not (Language_extension.is_at_least ext maturity) then [||]
-  else let regs =
-    match ext with
-    | SIMD -> hard_vec128_reg ()
-    | Small_numbers -> hard_float32_reg ()
-    | Mode | Unique | Include_functor | Comprehensions
-    | Polymorphic_parameters | Immutable_arrays
-    | Module_strengthening | Layouts | Labeled_tuples -> [||]
-  in match prefix with
-  | None -> regs
-  | Some p -> Array.sub regs 0 (Int.min p (Array.length regs))
+  v
 
 let all_phys_regs =
-  let open Language_extension in
-  let basic_regs = Array.append hard_int_reg hard_float_reg in
-  let simd_regs = extension_regs SIMD () in
-  let f32_regs = extension_regs Small_numbers Stable in
-  fun () -> Array.append basic_regs
-            (Array.append (simd_regs ()) (f32_regs ()))
+  Array.concat [hard_int_reg; hard_float_reg; hard_float32_reg; hard_vec128_reg]
 
 let phys_reg ty n =
   match (ty : machtype_component) with
   | Int | Addr | Val -> hard_int_reg.(n)
   | Float -> hard_float_reg.(n - 100)
-  | Float32 -> (hard_float32_reg ()).(n - 100)
-  | Vec128 -> (hard_vec128_reg ()).(n - 100)
+  | Float32 -> hard_float32_reg.(n - 100)
+  | Vec128 -> hard_vec128_reg.(n - 100)
 
 let rax = phys_reg Int 0
 let rdx = phys_reg Int 4
@@ -203,18 +176,7 @@ let rbp = phys_reg Int 12
 
 (* CSE needs to know that all versions of xmm15 are destroyed. *)
 let destroy_xmm n =
-  let f64 = [| phys_reg Float (100 + n) |] in
-  let f32 =
-    if Language_extension.(is_at_least Small_numbers Stable)
-    then [| phys_reg Float32 (100 + n) |]
-    else [||]
-  in
-  let v128 =
-    if Language_extension.is_enabled SIMD
-    then [| phys_reg Vec128 (100 + n) |]
-    else [||]
-  in
-  Array.append f64 (Array.append f32 v128)
+  [| phys_reg Float (100 + n); phys_reg Float32 (100 + n); phys_reg Vec128 (100 + n) |]
 
 let destroyed_by_plt_stub =
   if not X86_proc.use_plt then [| |] else [| r10; r11 |]
@@ -223,12 +185,7 @@ let num_destroyed_by_plt_stub = Array.length destroyed_by_plt_stub
 
 let destroyed_by_plt_stub_set = Reg.set_of_array destroyed_by_plt_stub
 
-let stack_slot slot ty =
-  (match (ty : machtype_component) with
-   | Float | Int | Addr | Val -> ()
-   | Float32 -> assert_float32_enabled ()
-   | Vec128 -> assert_simd_enabled ());
-  Reg.at_location ty (Stack slot)
+let stack_slot slot ty = Reg.at_location ty (Stack slot)
 
 (* Instruction selection *)
 
@@ -411,27 +368,21 @@ let int_regs_destroyed_at_c_call =
 
 let destroyed_at_c_call_win64 =
   (* Win64: rbx, rbp, rsi, rdi, r12-r15, xmm6-xmm15 preserved *)
-  let open Language_extension in
-  let basic_regs = Array.append
-    (Array.map (phys_reg Int) int_regs_destroyed_at_c_call_win64)
-    (Array.sub hard_float_reg 0 6)
-  in
-  let v128_regs = extension_regs ~prefix:6 SIMD () in
-  let f32_regs = extension_regs ~prefix:6 Small_numbers Stable in
-  fun () -> Array.append basic_regs
-              (Array.append (v128_regs ()) (f32_regs ()))
+  Array.concat [
+    Array.map (phys_reg Int) int_regs_destroyed_at_c_call_win64;
+    Array.sub hard_float_reg 0 6;
+    Array.sub hard_float32_reg 0 6;
+    Array.sub hard_vec128_reg 0 6
+  ]
 
 let destroyed_at_c_call_unix =
-  let open Language_extension in
   (* Unix: rbx, rbp, r12-r15 preserved *)
-  let basic_regs = Array.append
-      (Array.map (phys_reg Int) int_regs_destroyed_at_c_call)
-    hard_float_reg
-  in
-  let v128_regs = extension_regs SIMD () in
-  let f32_regs = extension_regs Small_numbers Stable in
-  fun () -> Array.append basic_regs
-              (Array.append (v128_regs ()) (f32_regs ()))
+  Array.concat [
+      Array.map (phys_reg Int) int_regs_destroyed_at_c_call;
+      hard_float_reg;
+      hard_float32_reg;
+      hard_vec128_reg
+  ]
 
 let destroyed_at_c_call =
   (* C calling conventions preserve rbx, but it is clobbered
@@ -468,12 +419,11 @@ let destroyed_by_simd_op op =
 
 (* note: keep this function in sync with `destroyed_at_{basic,terminator}` below. *)
 let destroyed_at_oper = function
-    Iop(Icall_ind | Icall_imm _) ->
-      all_phys_regs ()
+    Iop(Icall_ind | Icall_imm _) -> all_phys_regs
   | Iop(Iextcall {alloc; stack_ofs; }) ->
       assert (stack_ofs >= 0);
-      if alloc || stack_ofs > 0 then all_phys_regs ()
-      else destroyed_at_c_call ()
+      if alloc || stack_ofs > 0 then all_phys_regs
+      else destroyed_at_c_call
   | Iop(Iintop(Idiv | Imod)) | Iop(Iintop_imm((Idiv | Imod), _))
         -> [| rax; rdx |]
   | Iop(Istore(Single { reg = Float64 }, _, _))
@@ -588,9 +538,8 @@ let destroyed_at_terminator (terminator : Cfg_intf.S.terminator) =
   | Call_no_return { func_symbol = _; alloc; ty_res = _; ty_args = _; stack_ofs; }
   | Prim {op = External { func_symbol = _; alloc; ty_res = _; ty_args = _; stack_ofs; }; _} ->
     assert (stack_ofs >= 0);
-    if alloc || stack_ofs > 0 then all_phys_regs () else destroyed_at_c_call ()
-  | Call {op = Indirect | Direct _; _} ->
-    all_phys_regs ()
+    if alloc || stack_ofs > 0 then all_phys_regs else destroyed_at_c_call
+  | Call {op = Indirect | Direct _; _} -> all_phys_regs
   | Specific_can_raise { op = (Ilea _ | Ibswap _ | Isextend32 | Izextend32
                        | Ifloatarithmem _ | Irdtsc | Irdpmc | Ipause
                        | Isimd _ | Ilfence | Isfence | Imfence
@@ -754,8 +703,6 @@ let slot_offset loc ~stack_class ~stack_offset ~fun_contains_calls
           ~num_stack_slots:fun_num_stack_slots
         + n)
   | Local n ->
-      if fun_num_stack_slots.(2) > 0 || stack_class >= 2
-      then assert_simd_enabled ();
       Bytes_relative_to_stack_pointer (
         stack_offset +
           (* Preserves original ordering (int -> float) *)
@@ -784,7 +731,7 @@ let init () =
 (* Precolored_regs is not always the same as [all_phys_regs], as some physical registers
    may not be allocatable (e.g. rbp when frame pointers are enabled). *)
 let precolored_regs () =
-  let phys_regs = Reg.set_of_array (all_phys_regs ()) in
+  let phys_regs = Reg.set_of_array all_phys_regs in
   if fp then Reg.Set.remove rbp phys_regs else phys_regs
 
 let operation_supported = function

backend/arm64/proc.ml

@@ -340,7 +340,7 @@ let destroyed_at_oper = function
       [| reg_d7 |]            (* d7 / s7 destroyed *)
   | _ -> [||]
 
-let destroyed_at_raise () = all_phys_regs
+let destroyed_at_raise = all_phys_regs
 
 let destroyed_at_reloadretaddr = [| |]
 

backend/interf.ml

@@ -127,7 +127,7 @@ let build_graph fundecl =
     | Iexit _ ->
         ()
     | Itrywith(body, _kind, (_ts, handler)) ->
-        add_interf_set (Proc.destroyed_at_raise ()) handler.live;
+        add_interf_set Proc.destroyed_at_raise handler.live;
         interf body; interf handler; interf i.next
     | Iraise _ -> () in
 

backend/interval.ml

@@ -108,7 +108,7 @@ let insert_destroyed_at_oper intervals instr pos =
     update_interval_position_by_array intervals destroyed pos Result
 
 let insert_destroyed_at_raise intervals pos =
-  let destroyed = Proc.destroyed_at_raise () in
+  let destroyed = Proc.destroyed_at_raise in
   if Array.length destroyed > 0 then
     update_interval_position_by_array intervals destroyed pos Result
 

backend/proc.mli

@@ -61,7 +61,7 @@ val max_register_pressure: Mach.operation -> int array
 
 (* Registers destroyed by operations *)
 val destroyed_at_oper: Mach.instruction_desc -> Reg.t array
-val destroyed_at_raise: unit -> Reg.t array
+val destroyed_at_raise: Reg.t array
 val destroyed_at_reloadretaddr : Reg.t array
 val destroyed_at_pushtrap : Reg.t array
 val destroyed_at_basic : Cfg_intf.S.basic -> Reg.t array

backend/regalloc/regalloc_gi_utils.ml

@@ -494,7 +494,7 @@ let build_intervals : Cfg_with_infos.t -> Interval.t Reg.Tbl.t =
     let off = on + 1 in
     if trap_handler
     then
-      Array.iter (Proc.destroyed_at_raise ()) ~f:(fun reg ->
+      Array.iter Proc.destroyed_at_raise ~f:(fun reg ->
           update_range reg ~begin_:on ~end_:on);
     instr.ls_order <- on;
     Array.iter instr.arg ~f:(fun reg -> update_range reg ~begin_:on ~end_:on);

backend/regalloc/regalloc_irc.ml

@@ -91,9 +91,8 @@ let build : State.t -> Cfg_with_infos.t -> unit =
         let live = Cfg_dataflow.Instr.Tbl.find liveness first_id in
         Reg.Set.iter
           (fun reg1 ->
-            Array.iter
-              (filter_fp (Proc.destroyed_at_raise ()))
-              ~f:(fun reg2 -> State.add_edge state reg1 reg2))
+            Array.iter (filter_fp Proc.destroyed_at_raise) ~f:(fun reg2 ->
+                State.add_edge state reg1 reg2))
           (Reg.Set.remove Proc.loc_exn_bucket live.before))
 
 let make_work_list : State.t -> unit =

backend/regalloc/regalloc_ls.ml

@@ -75,7 +75,7 @@ let build_intervals : State.t -> Cfg_with_infos.t -> unit =
     let off = on + 1 in
     if trap_handler
     then
-      Array.iter (Proc.destroyed_at_raise ()) ~f:(fun reg ->
+      Array.iter Proc.destroyed_at_raise ~f:(fun reg ->
           update_range reg ~begin_:on ~end_:on);
     instr.ls_order <- on;
     Array.iter instr.arg ~f:(fun reg -> update_range reg ~begin_:on ~end_:on);

backend/regalloc/regalloc_validate.ml

@@ -1136,7 +1136,7 @@ module Transfer (Desc_val : Description_value) :
                     equations
                     |> Equation_set.verify_destroyed_locations
                          ~destroyed:
-                           (Location.of_regs_exn (Proc.destroyed_at_raise ()))
+                           (Location.of_regs_exn Proc.destroyed_at_raise)
                     |> Result.map_error (fun message ->
                            Printf.sprintf
                              "While verifying locations destroyed at raise: %s"