Store instruction id sequence in CFG (#3933)

Author: xclerc

backend/cfg/cfg.ml

@@ -87,11 +87,12 @@ type t =
     fun_contains_calls : bool;
     (* CR-someday gyorsh: compute locally. *)
     fun_num_stack_slots : int Stack_class.Tbl.t;
-    fun_poll : Lambda.poll_attribute
+    fun_poll : Lambda.poll_attribute;
+    next_instruction_id : InstructionId.sequence
   }
 
 let create ~fun_name ~fun_args ~fun_codegen_options ~fun_dbg ~fun_contains_calls
-    ~fun_num_stack_slots ~fun_poll =
+    ~fun_num_stack_slots ~fun_poll ~next_instruction_id =
   { fun_name;
     fun_args;
     fun_codegen_options;
@@ -102,7 +103,8 @@ let create ~fun_name ~fun_args ~fun_codegen_options ~fun_dbg ~fun_contains_calls
     blocks = Label.Tbl.create 31;
     fun_contains_calls;
     fun_num_stack_slots;
-    fun_poll
+    fun_poll;
+    next_instruction_id
   }
 
 let mem_block t label = Label.Tbl.mem t.blocks label
@@ -539,31 +541,8 @@ let make_instruction ~desc ?(arg = [||]) ?(res = [||]) ?(dbg = Debuginfo.none)
     available_across
   }
 
-let instr_id = InstructionId.make_sequence ()
-
-let reset_instr_id () = InstructionId.reset instr_id
-
-let next_instr_id () = InstructionId.get_and_incr instr_id
-
 let invalid_stack_offset = -1
 
-let make_instr desc arg res dbg =
-  { desc;
-    arg;
-    res;
-    dbg;
-    fdo = Fdo_info.none;
-    live = Reg.Set.empty;
-    stack_offset = invalid_stack_offset;
-    id = next_instr_id ();
-    irc_work_list = Unknown_list;
-    ls_order = 0;
-    (* CR mshinwell/xclerc: should this be [None]? *)
-    available_before =
-      Some (Reg_availability_set.Ok Reg_with_debug_info.Set.empty);
-    available_across = None
-  }
-
 let make_empty_block ?label terminator : basic_block =
   let start =
     match label with None -> Cmm.new_label () | Some label -> label
@@ -654,16 +633,6 @@ let basic_block_contains_calls block =
      | Prim { op = Probe _; _ } -> true)
   || DLL.exists block.body ~f:is_alloc_or_poll
 
-let max_instr_id t =
-  (* CR-someday xclerc for xclerc: factor out with similar function in
-     regalloc/. *)
-  fold_blocks t ~init:InstructionId.none ~f:(fun _label block max_id ->
-      let max_id =
-        DLL.fold_left block.body ~init:max_id ~f:(fun max_id instr ->
-            InstructionId.max max_id instr.id)
-      in
-      InstructionId.max max_id block.terminator.id)
-
 let equal_irc_work_list left right =
   match left, right with
   | Unknown_list, Unknown_list

backend/cfg/cfg.mli

@@ -83,6 +83,9 @@ type codegen_option =
 
 val of_cmm_codegen_option : Cmm.codegen_option list -> codegen_option list
 
+(* CR-someday xclerc: we should probably make `t` abstract and make each and
+   every modifiction through accessors; that would help enforce invariants. *)
+
 (** Control Flow Graph of a function. *)
 type t =
   { blocks : basic_block Label.Tbl.t;  (** Map from labels to blocks *)
@@ -100,7 +103,8 @@ type t =
         (** Precomputed during selection and poll insertion. *)
     fun_num_stack_slots : int Stack_class.Tbl.t;
         (** Precomputed at register allocation time *)
-    fun_poll : Lambda.poll_attribute (* Whether to insert polling points. *)
+    fun_poll : Lambda.poll_attribute; (* Whether to insert polling points. *)
+    next_instruction_id : InstructionId.sequence (* Next instruction id. *)
   }
 
 val create :
@@ -111,6 +115,7 @@ val create :
   fun_contains_calls:bool ->
   fun_num_stack_slots:int Stack_class.Tbl.t ->
   fun_poll:Lambda.poll_attribute ->
+  next_instruction_id:InstructionId.sequence ->
   t
 
 val fun_name : t -> string
@@ -229,23 +234,11 @@ val make_instruction :
   unit ->
   'a instruction
 
-(* CR mshinwell: consolidate with [make_instruction] and tidy up ID interface *)
-val make_instr :
-  'a -> Reg.t array -> Reg.t array -> Debuginfo.t -> 'a instruction
-
-(** These IDs are also used by [make_instr] *)
-val next_instr_id : unit -> InstructionId.t
-
-val reset_instr_id : unit -> unit
-
 val make_empty_block : ?label:Label.t -> terminator instruction -> basic_block
 
 (** "Contains calls" in the traditional sense as used in upstream [Selectgen]. *)
 val basic_block_contains_calls : basic_block -> bool
 
-(* [max_instr_id cfg] returns the maximum instruction identifier in [cfg]. *)
-val max_instr_id : t -> InstructionId.t
-
 val equal_irc_work_list : irc_work_list -> irc_work_list -> bool
 
 val invalid_stack_offset : int

backend/cfg/cfg_comballoc.ml

@@ -177,9 +177,7 @@ let rec combine : instr_id:InstructionId.sequence -> cell option -> unit =
 let run : Cfg_with_layout.t -> Cfg_with_layout.t =
  fun cfg_with_layout ->
   let cfg = Cfg_with_layout.cfg cfg_with_layout in
-  let instr_id =
-    InstructionId.make_sequence ~last_used:(Cfg.max_instr_id cfg) ()
-  in
+  let instr_id = cfg.next_instruction_id in
   Cfg.iter_blocks cfg ~f:(fun _label block ->
       combine ~instr_id (DLL.hd_cell block.body));
   cfg_with_layout

backend/cfg/cfg_cse.ml

@@ -258,16 +258,14 @@ let debug = false
 module State : sig
   type t
 
-  val make : last_used:InstructionId.t -> t
+  val make : InstructionId.sequence -> t
 
   val get_and_incr_instruction_id : t -> InstructionId.t
 end = struct
   (* CR-soon xclerc for xclerc: factor out with the state of GI, IRC, LS. *)
   type t = { instruction_id : InstructionId.sequence }
 
-  let make ~last_used =
-    let instruction_id = InstructionId.make_sequence ~last_used () in
-    { instruction_id }
+  let make instruction_id = { instruction_id }
 
   let get_and_incr_instruction_id state =
     InstructionId.get_and_incr state.instruction_id
@@ -521,8 +519,7 @@ module Cse_generic (Target : Cfg_cse_target_intf.S) = struct
     let cfg = Cfg_with_layout.cfg cfg_with_layout in
     (if not (List.mem ~set:cfg.fun_codegen_options Cfg.No_CSE)
     then
-      let cfg_infos = Regalloc_utils.collect_cfg_infos cfg_with_layout in
-      let state = State.make ~last_used:cfg_infos.max_instruction_id in
+      let state = State.make cfg.next_instruction_id in
       cse_blocks state cfg);
     cfg_with_layout
 end

backend/cfg/cfg_polling.ml

@@ -303,13 +303,8 @@ let instr_cfg_with_layout :
     bool =
  fun cfg_with_layout ~safe_map ~back_edges ->
   let cfg = Cfg_with_layout.cfg cfg_with_layout in
-  let instruction_id =
-    lazy
-      (let cfg = Cfg_with_layout.cfg cfg_with_layout in
-       InstructionId.make_sequence ~last_used:(Cfg.max_instr_id cfg) ())
-  in
   let next_instruction_id () =
-    InstructionId.get_and_incr (Lazy.force instruction_id)
+    InstructionId.get_and_incr cfg.next_instruction_id
   in
   Cfg_edge.Set.fold
     (fun { Cfg_edge.src; dst } added_poll ->

backend/cfg/cfg_stack_checks.ml

@@ -44,9 +44,7 @@ let is_nontail_call : Cfg.terminator -> bool =
 
 (* Returns the stack check info, and the max of seen instruction ids. *)
 let block_preproc_stack_check_result :
-    Cfg.basic_block ->
-    frame_size:int ->
-    Emitaux.preproc_stack_check_result * InstructionId.t =
+    Cfg.basic_block -> frame_size:int -> Emitaux.preproc_stack_check_result =
  fun block ~frame_size ->
   let contains_nontail_calls =
     (* XCR mshinwell: move to a method in Cfg somewhere?
@@ -55,20 +53,17 @@ let block_preproc_stack_check_result :
        think the predicate is generic enough to be moved to `Cfg`. *)
     is_nontail_call block.terminator.desc
   in
-  let max_frame_size, max_instr_id =
-    DLL.fold_left block.body
-      ~init:(block.terminator.stack_offset, block.terminator.id)
-      ~f:(fun (max_stack_frame, max_instr_id) (instr : _ Cfg.instruction) ->
-        ( Int.max max_stack_frame instr.stack_offset,
-          InstructionId.max max_instr_id instr.id ))
+  let max_frame_size =
+    DLL.fold_left block.body ~init:block.terminator.stack_offset
+      ~f:(fun max_stack_frame (instr : _ Cfg.instruction) ->
+        Int.max max_stack_frame instr.stack_offset)
   in
   let max_frame_size = max_frame_size + frame_size in
-  { max_frame_size; contains_nontail_calls }, max_instr_id
+  { max_frame_size; contains_nontail_calls }
 
 type cfg_info =
   { max_frame_size : int;
-    blocks_needing_stack_checks : Label.Set.t;
-    max_instr_id : InstructionId.t
+    blocks_needing_stack_checks : Label.Set.t
   }
 
 let build_cfg_info : Cfg.t -> cfg_info =
@@ -78,18 +73,11 @@ let build_cfg_info : Cfg.t -> cfg_info =
       ~contains_calls:cfg.fun_contains_calls
   in
   let init =
-    { max_frame_size = 0;
-      blocks_needing_stack_checks = Label.Set.empty;
-      max_instr_id = InstructionId.none
-    }
+    { max_frame_size = 0; blocks_needing_stack_checks = Label.Set.empty }
   in
   Cfg.fold_blocks cfg ~init
-    ~f:(fun
-         label
-         block
-         { max_frame_size; blocks_needing_stack_checks; max_instr_id }
-       ->
-      let preproc_stack_check_result, max_instr_id_block =
+    ~f:(fun label block { max_frame_size; blocks_needing_stack_checks } ->
+      let preproc_stack_check_result =
         block_preproc_stack_check_result block ~frame_size
       in
       let block_needs_stack_checks =
@@ -105,8 +93,7 @@ let build_cfg_info : Cfg.t -> cfg_info =
         then Label.Set.add label blocks_needing_stack_checks
         else blocks_needing_stack_checks
       in
-      let max_instr_id = InstructionId.max max_instr_id max_instr_id_block in
-      { max_frame_size; blocks_needing_stack_checks; max_instr_id })
+      { max_frame_size; blocks_needing_stack_checks })
 
 (* Populates `num_checks` with the number of blocks needing a stack check in the
    subtree whose root is the associated label, and returns that value. *)
@@ -170,8 +157,7 @@ let rec find_stack_check_block :
        num_checks_tree"
       to_cover
 
-let insert_instruction (cfg : Cfg.t) (label : Label.t) ~max_frame_size
-    ~max_instr_id =
+let insert_instruction (cfg : Cfg.t) (label : Label.t) ~max_frame_size =
   let block = Cfg.get_block_exn cfg label in
   let stack_offset = Cfg.first_instruction_stack_offset block in
   let check : Cfg.basic Cfg.instruction =
@@ -183,16 +169,15 @@ let insert_instruction (cfg : Cfg.t) (label : Label.t) ~max_frame_size
 
        xclerc: (keeping the comment, and the explicit values below until all of
        that is implemented.) *)
-    let seq = InstructionId.make_sequence ~last_used:max_instr_id () in
-    let id = InstructionId.get_and_incr seq in
+    let id = InstructionId.get_and_incr cfg.next_instruction_id in
     Cfg.make_instruction ()
       ~desc:(Cfg.Stack_check { max_frame_size_bytes = max_frame_size })
       ~stack_offset ~id ~available_before:None ~available_across:None
   in
   DLL.add_begin block.body check
 
 let insert_stack_checks (cfg : Cfg.t) ~max_frame_size
-    ~blocks_needing_stack_checks ~max_instr_id =
+    ~blocks_needing_stack_checks =
   (* CR-soon xclerc for xclerc: use the dominators and loop infos from
      Cfg_with_infos (at least on some paths). *)
   let doms = Cfg_dominators.build cfg in
@@ -207,7 +192,7 @@ let insert_stack_checks (cfg : Cfg.t) ~max_frame_size
   | 0 -> ()
   | to_cover ->
     let label = find_stack_check_block tree ~to_cover ~num_checks ~loop_infos in
-    insert_instruction cfg label ~max_frame_size ~max_instr_id
+    insert_instruction cfg label ~max_frame_size
 
 (* CR-someday xclerc for xclerc: we may want to duplicate the check in some
    cases, rather than simply pushing it down. *)
@@ -218,7 +203,7 @@ let cfg (cfg_with_layout : Cfg_with_layout.t) =
     let cfg = Cfg_with_layout.cfg cfg_with_layout in
     (if not Config.no_stack_checks
     then
-      let { max_frame_size; blocks_needing_stack_checks; max_instr_id } =
+      let { max_frame_size; blocks_needing_stack_checks } =
         build_cfg_info cfg
       in
       if not (Label.Set.is_empty blocks_needing_stack_checks)
@@ -227,7 +212,5 @@ let cfg (cfg_with_layout : Cfg_with_layout.t) =
            < !Flambda_backend_flags.cfg_stack_checks_threshold
         then
           insert_stack_checks cfg ~max_frame_size ~blocks_needing_stack_checks
-            ~max_instr_id
-        else
-          insert_instruction cfg cfg.entry_label ~max_frame_size ~max_instr_id);
+        else insert_instruction cfg cfg.entry_label ~max_frame_size);
     cfg_with_layout