Register allocation: more destruction points (#1774)

ocaml-flambda · Sep 11, 2023 · 86993b6 · 86993b6
1 parent c5b826c
commit 86993b6
Show file tree

Hide file tree

Showing 4 changed files with 15 additions and 5 deletions.
diff --git a/backend/amd64/proc.ml b/backend/amd64/proc.ml
@@ -552,7 +552,7 @@ let destroyed_at_terminator (terminator : Cfg_intf.S.terminator) =
    spill registers that would spill anyway); we could also return `true`
    when `destroyed_at_terminator` returns `destroyed_at_c_call` for instance. *)
 (* note: keep this function in sync with `destroyed_at_terminator` above. *)
-let is_destruction_point (terminator : Cfg_intf.S.terminator) =
+let is_destruction_point ~(more_destruction_points : bool) (terminator : Cfg_intf.S.terminator) =
   match terminator with
   | Never -> assert false
   | Prim {op = Alloc _; _} ->
@@ -565,7 +565,10 @@ let is_destruction_point (terminator : Cfg_intf.S.terminator) =
     false
   | Call_no_return { func_symbol = _; alloc; ty_res = _; ty_args = _; }
   | Prim {op = External { func_symbol = _; alloc; ty_res = _; ty_args = _; }; _} ->
-    if alloc then true else false
+    if more_destruction_points then
+      true
+    else
+      if alloc then true else false
   | Call {op = Indirect | Direct _; _} ->
     true
   | Specific_can_raise { op = (Ilea _ | Ibswap _ | Isqrtf | Isextend32 | Izextend32

diff --git a/backend/arm64/proc.ml b/backend/arm64/proc.ml
@@ -364,7 +364,7 @@ let destroyed_at_terminator (terminator : Cfg_intf.S.terminator) =
    `all_phys_regs`; we could also return `true` when `destroyed_at_terminator`
    returns `destroyed_at_c_call` for instance. *)
 (* note: keep this function in sync with `destroyed_at_terminator` above. *)
-let is_destruction_point (terminator : Cfg_intf.S.terminator) =
+let is_destruction_point ~(more_destruction_points : bool) (terminator : Cfg_intf.S.terminator) =
   match terminator with
   | Never -> assert false
   | Call {op = Indirect | Direct _; _} ->
@@ -378,6 +378,9 @@ let is_destruction_point (terminator : Cfg_intf.S.terminator) =
     false
   | Call_no_return { func_symbol = _; alloc; ty_res = _; ty_args = _; }
   | Prim {op  = External { func_symbol = _; alloc; ty_res = _; ty_args = _; }; _} ->
+    if more_destruction_points then
+      true
+    else
     if alloc then true else false
   | Poll_and_jump _ -> false
 

diff --git a/backend/proc.mli b/backend/proc.mli
@@ -66,7 +66,7 @@ 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
 val destroyed_at_terminator : Cfg_intf.S.terminator -> Reg.t array
-val is_destruction_point : Cfg_intf.S.terminator -> bool
+val is_destruction_point : more_destruction_points:bool -> Cfg_intf.S.terminator -> bool
 
 (* Volatile registers: those that change value when read *)
 val regs_are_volatile: Reg.t array -> bool

diff --git a/backend/regalloc/regalloc_split_utils.ml b/backend/regalloc/regalloc_split_utils.ml
@@ -6,6 +6,9 @@ let split_debug = false
 
 let split_live_ranges : bool Lazy.t = bool_of_param "SPLIT_LIVE_RANGES"
 
+let split_more_destruction_points : bool Lazy.t =
+  bool_of_param "SPLIT_MORE_DESTR_POINTS"
+
 let bool_of_param param_name =
   bool_of_param ~guard:(split_debug, "split_debug") param_name
 
@@ -79,7 +82,8 @@ type destruction_kind =
 
 let destruction_point_at_end : Cfg.basic_block -> destruction_kind option =
  fun block ->
-  if Proc.is_destruction_point block.terminator.desc
+  let more_destruction_points = Lazy.force split_more_destruction_points in
+  if Proc.is_destruction_point ~more_destruction_points block.terminator.desc
   then Some Destruction_on_all_paths
   else if Option.is_none block.exn
   then None