IRC, iterated register coalescing (draft implementation) (ocaml#678)

* Rebase * ocamlformat * Disable CFG tests. * Restore ocamlcfg tests. * Prologue * Revert dataflow changes. * Revert dataflow changes. * Format * Use the dedicated flag. * Review * Review * CRs * Review * ocamlformat * Arm64 * Review * Review * Review * Review * ocamlformat * Fix review change * Debugging tweaks. * ocamlformat * Review. * ocamlformat Co-authored-by: Greta Yorsh <gyorsh@janestreet.com>
stedolan · Aug 4, 2022 · 6d40006 · 6d40006
1 parent 339c55d
commit 6d40006
Show file tree

Hide file tree

Showing 27 changed files with 2,727 additions and 47 deletions.
diff --git a/backend/arm64/proc.ml b/backend/arm64/proc.ml
@@ -279,6 +279,8 @@ let destroyed_at_raise = all_phys_regs
 
 let destroyed_at_reloadretaddr = [| |]
 
+let destroyed_at_pushtrap = [| |]
+
 (* Maximal register pressure *)
 
 let safe_register_pressure = function

diff --git a/backend/asmgen.ml b/backend/asmgen.ml
@@ -136,7 +136,7 @@ let save_cfg f =
 let save_mach_as_cfg pass f =
   if should_save_ir_after pass && (not !start_from_emit) then begin
     let cfg =
-      Cfgize.fundecl f ~preserve_orig_labels:false ~simplify_terminators:true
+      Cfgize.fundecl f ~before_register_allocation:false ~preserve_orig_labels:false ~simplify_terminators:true
     in
     let cfg_unit_info = Compiler_pass_map.find pass pass_to_cfg in
     cfg_unit_info.items <- Cfg_format.(Cfg cfg) :: cfg_unit_info.items
@@ -284,6 +284,7 @@ let test_cfgize (f : Mach.fundecl) (res : Linear.fundecl) : unit =
   let result =
     Cfgize.fundecl
       f
+      ~before_register_allocation:false
       ~preserve_orig_labels:false
       ~simplify_terminators:false
   in
@@ -314,6 +315,28 @@ let reorder_blocks_random ppf_dump cl =
      pass_dump_cfg_if ppf_dump Flambda_backend_flags.dump_cfg
        "After reorder_blocks_random" cl
 
+let cfgize (f : Mach.fundecl) : Cfg_with_layout.t =
+  if ocamlcfg_verbose then begin
+    Format.eprintf "Asmgen.cfgize on function %s...\n%!" f.Mach.fun_name;
+  end;
+  Cfgize.fundecl
+    f
+    ~before_register_allocation:true
+    ~preserve_orig_labels:false
+    ~simplify_terminators:true
+
+type register_allocator =
+  | Upstream
+  | IRC
+
+let register_allocator : register_allocator =
+  match Sys.getenv_opt "REGISTER_ALLOCATOR" with
+  | None -> Upstream
+  | Some id ->
+    match String.lowercase_ascii id with
+    | "irc" -> IRC
+    | _ -> Misc.fatal_errorf "unknown register allocator %S" id
+
 let compile_fundecl ?dwarf ~ppf_dump fd_cmm =
   Proc.init ();
   Reg.reset();
@@ -333,24 +356,38 @@ let compile_fundecl ?dwarf ~ppf_dump fd_cmm =
   ++ Profile.record ~accumulate:true "deadcode" Deadcode.fundecl
   ++ Compiler_hooks.execute_and_pipe Compiler_hooks.Mach_live
   ++ pass_dump_if ppf_dump dump_live "Liveness analysis"
-  ++ Profile.record ~accumulate:true "spill" Spill.fundecl
-  ++ Profile.record ~accumulate:true "liveness" liveness
-  ++ Compiler_hooks.execute_and_pipe Compiler_hooks.Mach_spill
-  ++ pass_dump_if ppf_dump dump_spill "After spilling"
-  ++ Profile.record ~accumulate:true "split" Split.fundecl
-  ++ Compiler_hooks.execute_and_pipe Compiler_hooks.Mach_split
-  ++ pass_dump_if ppf_dump dump_split "After live range splitting"
-  ++ Profile.record ~accumulate:true "liveness" liveness
-  ++ Profile.record ~accumulate:true "regalloc" (regalloc ~ppf_dump 1)
-  ++ Profile.record ~accumulate:true "available_regs" Available_regs.fundecl
-  ++ Profile.record ~accumulate:true "linearize" (fun (f : Mach.fundecl) ->
-      let res = Linearize.fundecl f in
-      (* CR xclerc for xclerc: temporary, for testing. *)
-      if !Flambda_backend_flags.cfg_equivalence_check then begin
-        test_cfgize f res;
-      end;
-      res)
-  ++ pass_dump_linear_if ppf_dump dump_linear "Linearized code"
+  ++ (fun (fd : Mach.fundecl) ->
+      match register_allocator with
+      | IRC ->
+        let res =
+          fd
+          ++ Profile.record ~accumulate:true "cfgize" cfgize
+          ++ Profile.record ~accumulate:true "cfg_irc" Cfg_irc.run
+        in
+        (Cfg_regalloc_utils.simplify_cfg res)
+        ++ Profile.record ~accumulate:true "cfg_to_linear" Cfg_to_linear.run
+      | Upstream ->
+        let res =
+          fd
+          ++ Profile.record ~accumulate:true "spill" Spill.fundecl
+          ++ Profile.record ~accumulate:true "liveness" liveness
+          ++ Compiler_hooks.execute_and_pipe Compiler_hooks.Mach_spill
+          ++ pass_dump_if ppf_dump dump_spill "After spilling"
+          ++ Profile.record ~accumulate:true "split" Split.fundecl
+          ++ Compiler_hooks.execute_and_pipe Compiler_hooks.Mach_split
+          ++ pass_dump_if ppf_dump dump_split "After live range splitting"
+          ++ Profile.record ~accumulate:true "liveness" liveness
+          ++ Profile.record ~accumulate:true "regalloc" (regalloc ~ppf_dump 1)
+          ++ Profile.record ~accumulate:true "available_regs" Available_regs.fundecl
+        in
+        res
+        ++ Profile.record ~accumulate:true "linearize" (fun (f : Mach.fundecl) ->
+            let res = Linearize.fundecl f in
+            if !Flambda_backend_flags.cfg_equivalence_check then begin
+              test_cfgize f res;
+            end;
+            res)
+        ++ pass_dump_linear_if ppf_dump dump_linear "Linearized code")
   ++ Compiler_hooks.execute_and_pipe Compiler_hooks.Linear
   ++ (fun (fd : Linear.fundecl) ->
     if !Flambda_backend_flags.use_ocamlcfg then begin

diff --git a/backend/cfg/cfg.ml b/backend/cfg/cfg.ml
@@ -157,6 +157,8 @@ let entry_label t = t.entry_label
 
 let iter_blocks t ~f = Label.Tbl.iter f t.blocks
 
+let fold_blocks t ~f ~init = Label.Tbl.fold f t.blocks init
+
 let register_predecessors_for_all_blocks (t : t) =
   Label.Tbl.iter
     (fun label block ->
@@ -425,3 +427,11 @@ let set_stack_offset (instr : _ instruction) stack_offset =
 
 let set_live (instr : _ instruction) live =
   if Reg.Set.equal instr.live live then instr else { instr with live }
+
+let string_of_irc_work_list = function
+  | Unknown_list -> "unknown_list"
+  | Coalesced -> "coalesced"
+  | Constrained -> "constrained"
+  | Frozen -> "frozen"
+  | Work_list -> "work_list"
+  | Active -> "active"
diff --git a/backend/cfg/cfg.mli b/backend/cfg/cfg.mli
@@ -119,6 +119,8 @@ val get_block_exn : t -> Label.t -> basic_block
 
 val iter_blocks : t -> f:(Label.t -> basic_block -> unit) -> unit
 
+val fold_blocks : t -> f:(Label.t -> basic_block -> 'a -> 'a) -> init:'a -> 'a
+
 val register_predecessors_for_all_blocks : t -> unit
 
 (** Printing *)
@@ -159,3 +161,9 @@ val is_noop_move : basic instruction -> bool
 val set_stack_offset : 'a instruction -> int -> 'a instruction
 
 val set_live : 'a instruction -> Reg.Set.t -> 'a instruction
+
+val string_of_irc_work_list : irc_work_list -> string
+
+val dump_basic : Format.formatter -> basic -> unit
+
+val dump_terminator : ?sep:string -> Format.formatter -> terminator -> unit
diff --git a/backend/cfg/cfg_dataflow.ml b/backend/cfg/cfg_dataflow.ml
@@ -233,7 +233,8 @@ module Backward
       domain Label.Tbl.t * domain Instr.Tbl.t * WorkSet.t ref =
    fun cfg ~init ->
     let map_block = Label.Tbl.create (Label.Tbl.length cfg.Cfg.blocks) in
-    let map_instr = Instr.Tbl.create (Label.Tbl.length cfg.Cfg.blocks) in
+    (* CR-soon xclerc for xclerc: review the `16` constant. *)
+    let map_instr = Instr.Tbl.create (Label.Tbl.length cfg.Cfg.blocks * 16) in
     let set = ref WorkSet.empty in
     let value = init in
     Cfg.iter_blocks cfg ~f:(fun label _block ->

diff --git a/backend/cfg/cfg_equivalence.ml b/backend/cfg/cfg_equivalence.ml
@@ -394,8 +394,17 @@ let check_basic_instruction :
     match expected.desc with Prologue -> false | _ -> true
     [@@ocaml.warning "-4"]
   in
-  check_instruction ~check_live:true ~check_dbg ~check_arg:true idx location
-    expected result
+  let check_live =
+    match result.desc with
+    | Op _ -> true
+    | Call _ -> true
+    | Reloadretaddr -> true
+    | Pushtrap _ -> false
+    | Poptrap -> false
+    | Prologue -> false
+  in
+  check_instruction ~check_live ~check_dbg ~check_arg:true idx location expected
+    result
 
 let rec check_basic_instruction_list :
     State.t ->

diff --git a/backend/cfg/cfg_intf.ml b/backend/cfg/cfg_intf.ml
@@ -124,15 +124,24 @@ module S = struct
       uo : Label.t  (** if at least one of x or y is NaN *)
     }
 
+  type irc_work_list =
+    | Unknown_list
+    | Coalesced
+    | Constrained
+    | Frozen
+    | Work_list
+    | Active
+
   type 'a instruction =
     { desc : 'a;
-      arg : Reg.t array;
-      res : Reg.t array;
+      mutable arg : Reg.t array;
+      mutable res : Reg.t array;
       dbg : Debuginfo.t;
       fdo : Fdo_info.t;
       live : Reg.Set.t;
       stack_offset : int;
-      id : int
+      id : int;
+      mutable irc_work_list : irc_work_list
     }
 
   type basic =