Register allocation: parameters for spilling heuristics (#1776)

backend/regalloc/regalloc_utils.ml

@@ -398,13 +398,26 @@ let update_live_fields : Cfg_with_layout.t -> liveness -> unit =
       set_liveness block.terminator)
 
 (* CR-soon xclerc for xclerc: consider adding an overflow check. *)
-let pow10 n =
+let pow ~base n =
   let res = ref 1 in
   for _ = 1 to n do
-    res := !res * 10
+    res := !res * base
   done;
   !res
 
+let spill_normal_cost = lazy (find_param_value "SPILL_NORMAL_COST")
+
+let spill_cold_cost = lazy (find_param_value "SPILL_COLD_COST")
+
+let spill_loop_cost = lazy (find_param_value "SPILL_LOOP_COST")
+
+let cost_for_block : Cfg.basic_block -> int =
+ fun block ->
+  let param =
+    match block.cold with false -> spill_normal_cost | true -> spill_cold_cost
+  in
+  match Lazy.force param with None -> 1 | Some cost -> int_of_string cost
+
 let update_spill_cost : Cfg_with_infos.t -> flat:bool -> unit -> unit =
  fun cfg_with_infos ~flat () ->
   List.iter (Reg.all_registers ()) ~f:(fun reg -> reg.Reg.spill_cost <- 0);
@@ -426,13 +439,21 @@ let update_spill_cost : Cfg_with_infos.t -> flat:bool -> unit -> unit =
     else (Cfg_with_infos.loop_infos cfg_with_infos).loop_depths
   in
   Cfg.iter_blocks cfg ~f:(fun label block ->
-      let cost =
+      let base_cost = cost_for_block block in
+      let cost_multiplier =
         match Label.Map.find_opt label loops_depths with
         | None ->
           assert flat;
           1
-        | Some depth -> pow10 depth
+        | Some depth ->
+          let base =
+            match Lazy.force spill_loop_cost with
+            | None -> 10
+            | Some cost -> int_of_string cost
+          in
+          pow ~base depth
       in
+      let cost = base_cost * cost_multiplier in
       DLL.iter ~f:(fun instr -> update_instr cost instr) block.body;
       (* Ignore probes *)
       match block.terminator.desc with