Doubly-linked lists for register lists (IRC state) (ocaml-flambda#1125)

backend/cfg/cfg_irc.ml

@@ -65,9 +65,8 @@ let build : State.t -> Cfg_with_liveness.t -> unit =
 
 let make_work_list : State.t -> unit =
  fun state ->
-  let initial = State.get_and_clear_initial state in
   if irc_debug then log ~indent:1 "make_work_list";
-  List.iter initial ~f:(fun reg ->
+  State.iter_and_clear_initial state ~f:(fun reg ->
       let deg = reg.Reg.degree in
       if irc_debug
       then

backend/cfg/cfg_irc_state.ml

@@ -2,6 +2,7 @@
 
 open! Cfg_regalloc_utils
 open! Cfg_irc_utils
+module Doubly_linked_list = Flambda_backend_utils.Doubly_linked_list
 
 module RegWorkList = ArraySet.Make (struct
   type t = Reg.t
@@ -39,13 +40,13 @@ let instruction_set_of_instruction_work_list (iwl : InstructionWorkList.t) :
       Instruction.Set.add elem acc)
 
 type t =
-  { mutable initial : Reg.t list;
+  { mutable initial : Reg.t Doubly_linked_list.t;
     simplify_work_list : RegWorkList.t;
     freeze_work_list : RegWorkList.t;
     spill_work_list : RegWorkList.t;
     spilled_nodes : RegWorkList.t;
     coalesced_nodes : RegWorkList.t;
-    mutable colored_nodes : Reg.t list;
+    colored_nodes : Reg.t Doubly_linked_list.t;
     mutable select_stack : Reg.t list;
     coalesced_moves : InstructionWorkList.t;
     constrained_moves : InstructionWorkList.t;
@@ -88,7 +89,7 @@ let[@inline] make ~initial ~next_instruction_id () =
   let spill_work_list = RegWorkList.make ~original_capacity in
   let spilled_nodes = RegWorkList.make ~original_capacity in
   let coalesced_nodes = RegWorkList.make ~original_capacity in
-  let colored_nodes = [] in
+  let colored_nodes = Doubly_linked_list.make_empty () in
   let select_stack = [] in
   let original_capacity = Int.min max_capacity (pred next_instruction_id) in
   let coalesced_moves = InstructionWorkList.make ~original_capacity in
@@ -101,6 +102,7 @@ let[@inline] make ~initial ~next_instruction_id () =
   let stack_slots = Reg.Tbl.create 128 in
   let num_stack_slots = Array.make Proc.num_register_classes 0 in
   let introduced_temporaries = Reg.Set.empty in
+  let initial = Doubly_linked_list.of_list initial in
   { initial;
     simplify_work_list;
     freeze_work_list;
@@ -128,16 +130,16 @@ let[@inline] add_initial_one state reg =
   reg.Reg.irc_alias <- None;
   reg.Reg.interf <- [];
   reg.Reg.degree <- 0;
-  state.initial <- reg :: state.initial
+  Doubly_linked_list.add_begin state.initial reg
 
 let[@inline] add_initial_list state regs =
   List.iter regs ~f:(fun reg ->
       reg.Reg.irc_work_list <- Initial;
       reg.Reg.irc_color <- None;
       reg.Reg.irc_alias <- None;
       reg.Reg.interf <- [];
-      reg.Reg.degree <- 0);
-  state.initial <- regs @ state.initial
+      reg.Reg.degree <- 0;
+      Doubly_linked_list.add_begin state.initial reg)
 
 let[@inline] reset state ~new_temporaries =
   let unknown_reg_work_list (rwl : RegWorkList.t) : unit =
@@ -161,10 +163,12 @@ let[@inline] reset state ~new_temporaries =
       reg.Reg.irc_alias <- None;
       reg.Reg.interf <- [];
       assert (reg.Reg.degree = Degree.infinite));
-  state.initial
-    <- new_temporaries @ state.colored_nodes
-       @ RegWorkList.to_list state.coalesced_nodes;
-  List.iter state.initial ~f:(fun reg -> reg.Reg.irc_work_list <- Initial);
+  state.initial <- Doubly_linked_list.of_list new_temporaries;
+  Doubly_linked_list.transfer ~from:state.colored_nodes ~to_:state.initial ();
+  RegWorkList.iter state.coalesced_nodes ~f:(fun reg ->
+      Doubly_linked_list.add_end state.initial reg);
+  Doubly_linked_list.iter state.initial ~f:(fun reg ->
+      reg.Reg.irc_work_list <- Initial);
   unknown_reg_work_list state.simplify_work_list;
   RegWorkList.clear state.simplify_work_list;
   unknown_reg_work_list state.freeze_work_list;
@@ -174,7 +178,6 @@ let[@inline] reset state ~new_temporaries =
   unknown_reg_work_list state.spilled_nodes;
   RegWorkList.clear state.spilled_nodes;
   RegWorkList.clear state.coalesced_nodes;
-  state.colored_nodes <- [];
   assert (state.select_stack = []);
   unknown_instruction_work_list state.coalesced_moves;
   InstructionWorkList.clear state.coalesced_moves;
@@ -197,11 +200,11 @@ let[@inline] is_precolored _state reg = reg.Reg.irc_work_list = Reg.Precolored
 let[@inline] is_precolored_or_colored _state reg =
   reg.Reg.irc_work_list = Reg.Precolored || reg.Reg.irc_work_list = Reg.Colored
 
-let[@inline] get_and_clear_initial state =
-  List.iter state.initial ~f:(fun reg -> reg.Reg.irc_work_list <- Unknown_list);
-  let res = state.initial in
-  state.initial <- [];
-  res
+let[@inline] iter_and_clear_initial state ~f =
+  Doubly_linked_list.iter state.initial ~f:(fun reg ->
+      reg.Reg.irc_work_list <- Unknown_list);
+  Doubly_linked_list.iter state.initial ~f;
+  Doubly_linked_list.clear state.initial
 
 let[@inline] is_empty_simplify_work_list state =
   RegWorkList.is_empty state.simplify_work_list
@@ -280,7 +283,7 @@ let[@inline] iter_coalesced_nodes state ~f =
 
 let[@inline] add_colored_nodes state reg =
   reg.Reg.irc_work_list <- Reg.Colored;
-  state.colored_nodes <- reg :: state.colored_nodes
+  Doubly_linked_list.add_begin state.colored_nodes reg
 
 let[@inline] is_empty_select_stack state = state.select_stack = []
 
@@ -549,6 +552,9 @@ let[@inline] check_inter_has_no_duplicates (reg : Reg.t) : unit =
   if List.length l <> Reg.Set.cardinal s
   then fatal "interf list for %a is not a set" Printmach.reg reg
 
+let reg_set_of_doubly_linked_list (l : Reg.t Doubly_linked_list.t) : Reg.Set.t =
+  Doubly_linked_list.fold_right l ~init:Reg.Set.empty ~f:Reg.Set.add
+
 let[@inline] invariant state =
   (* CR xclerc for xclerc: avoid multiple conversions to sets. *)
   if irc_debug && irc_invariants
@@ -559,17 +565,17 @@ let[@inline] invariant state =
     (* register sets are disjoint *)
     check_disjoint ~is_disjoint:Reg.Set.disjoint
       [ "precolored", Reg.set_of_array all_precolored_regs;
-        "initial", Reg.Set.of_list state.initial;
+        "initial", reg_set_of_doubly_linked_list state.initial;
         "simplify_work_list", reg_set_of_reg_work_list state.simplify_work_list;
         "freeze_work_list", reg_set_of_reg_work_list state.freeze_work_list;
         "spill_work_list", reg_set_of_reg_work_list state.spill_work_list;
         "spilled_nodes", reg_set_of_reg_work_list state.spilled_nodes;
         "coalesced_nodes", reg_set_of_reg_work_list state.coalesced_nodes;
-        "colored_nodes", Reg.Set.of_list state.colored_nodes;
+        "colored_nodes", reg_set_of_doubly_linked_list state.colored_nodes;
         "select_stack", Reg.Set.of_list state.select_stack ];
     List.iter ~f:check_set_and_field_consistency_reg
       [ "precolored", Reg.set_of_array all_precolored_regs, Reg.Precolored;
-        "initial", Reg.Set.of_list state.initial, Reg.Initial;
+        "initial", reg_set_of_doubly_linked_list state.initial, Reg.Initial;
         ( "simplify_work_list",
           reg_set_of_reg_work_list state.simplify_work_list,
           Reg.Simplify );
@@ -585,7 +591,9 @@ let[@inline] invariant state =
         ( "coalesced_nodes",
           reg_set_of_reg_work_list state.coalesced_nodes,
           Reg.Coalesced );
-        "colored_nodes", Reg.Set.of_list state.colored_nodes, Reg.Colored;
+        ( "colored_nodes",
+          reg_set_of_doubly_linked_list state.colored_nodes,
+          Reg.Colored );
         "select_stack", Reg.Set.of_list state.select_stack, Reg.Select_stack ];
     (* move sets are disjoint *)
     check_disjoint ~is_disjoint:Instruction.Set.disjoint

backend/cfg/cfg_irc_state.mli

@@ -17,7 +17,7 @@ val is_precolored : t -> Reg.t -> bool
 
 val is_precolored_or_colored : t -> Reg.t -> bool
 
-val get_and_clear_initial : t -> Reg.t list
+val iter_and_clear_initial : t -> f:(Reg.t -> unit) -> unit
 
 val is_empty_simplify_work_list : t -> bool
 

backend/cfg/cfg_regalloc_utils.ml

@@ -382,7 +382,7 @@ let remove_prologue_if_not_required : Cfg_with_layout.t -> unit =
   in
   if not prologue_required
   then
-    (* note: `Cfize` has put the prologue in the entry block *)
+    (* note: `Cfgize` has put the prologue in the entry block *)
     let block = Cfg.get_block_exn cfg cfg.entry_label in
     DLL.filter_left block.body ~f:(fun instr ->
         match instr.Cfg.desc with Cfg.Prologue -> false | _ -> true)

utils/doubly_linked_list.ml

@@ -77,6 +77,11 @@ let make_single value =
   let node = unattached_node value in
   { length = 1; first = node; last = node }
 
+let clear t =
+  t.length <- 0;
+  t.first <- Empty;
+  t.last <- Empty
+
 let hd t = match t.first with Empty -> None | Node { value; _ } -> Some value
 
 let last t = match t.last with Empty -> None | Node { value; _ } -> Some value

utils/doubly_linked_list.mli

@@ -16,6 +16,8 @@ val make_single : 'a -> 'a t
 
 val of_list : 'a list -> 'a t
 
+val clear : 'a t -> unit
+
 val hd : 'a t -> 'a option
 
 val last : 'a t -> 'a option