diff --git a/backend/amd64/cfg_stack_operands.ml b/backend/amd64/cfg_stack_operands.ml
index 9d25827bc34..8141237f7ba 100644
--- a/backend/amd64/cfg_stack_operands.ml
+++ b/backend/amd64/cfg_stack_operands.ml
@@ -4,7 +4,7 @@
 
 open! Cfg_regalloc_utils
 
-let debug = true
+let debug = false
 
 let may_use_stack_operand_for_second_argument
   : type a . spilled_map -> a Cfg.instruction -> stack_operands_rewrite
diff --git a/backend/arm64/cfg_stack_operands.ml b/backend/arm64/cfg_stack_operands.ml
index 82a06a4a7df..e4d5a0e38fa 100644
--- a/backend/arm64/cfg_stack_operands.ml
+++ b/backend/arm64/cfg_stack_operands.ml
@@ -2,7 +2,7 @@
 
 open! Cfg_regalloc_utils
 
-let debug = true
+let debug = false
 
 let basic (map : spilled_map) (instr : Cfg.basic Cfg.instruction) =
   match instr.desc with
diff --git a/backend/asmgen.ml b/backend/asmgen.ml
index 063ef0e1ba3..7532850dcd0 100644
--- a/backend/asmgen.ml
+++ b/backend/asmgen.ml
@@ -289,23 +289,23 @@ let compile_fundecl ~ppf_dump ~funcnames fd_cmm =
       ++ Profile.record ~accumulate:true "irc" (fun fd ->
         let cfg =
           fd
-          ++ Profile.record ~accumulate:true "cfgize" cfgize
+          ++ (*Profile.record ~accumulate:true "cfgize"*) cfgize
           ++ Cfg_with_liveness.make
-          ++ Profile.record ~accumulate:true "cfg_deadcode" Cfg_deadcode.run
+          ++ (*Profile.record ~accumulate:true "cfg_deadcode"*) Cfg_deadcode.run
         in
-        let cfg_description =
+        (*let cfg_description =
           Profile.record ~accumulate:true "cfg_create_description"
             Cfg_regalloc_validate.Description.create (Cfg_with_liveness.cfg_with_layout cfg)
-        in
+        in*)
         cfg
-        ++ Profile.record ~accumulate:true "cfg_irc" Cfg_irc.run
+        ++ (*Profile.record ~accumulate:true "cfg_irc"*) Cfg_irc.run
         ++ Cfg_with_liveness.cfg_with_layout
-        ++ Profile.record ~accumulate:true "cfg_validate_description" (Cfg_regalloc_validate.run cfg_description)
-        ++ Profile.record ~accumulate:true "cfg_simplify" Cfg_regalloc_utils.simplify_cfg
-        ++ Profile.record ~accumulate:true "save_cfg" save_cfg
+        (*++ Profile.record ~accumulate:true "cfg_validate_description" (Cfg_regalloc_validate.run cfg_description)*)
+        ++ (*Profile.record ~accumulate:true "cfg_simplify"*) Cfg_regalloc_utils.simplify_cfg
+        (*++ Profile.record ~accumulate:true "save_cfg" save_cfg
         ++ Profile.record ~accumulate:true "cfg_reorder_blocks"
-             (reorder_blocks_random ppf_dump)
-        ++ Profile.record ~accumulate:true "cfg_to_linear" Cfg_to_linear.run)
+             (reorder_blocks_random ppf_dump)*)
+        ++ (*Profile.record ~accumulate:true "cfg_to_linear"*) Cfg_to_linear.run)
     | true, _ | false, Upstream ->
       fd
       ++ Profile.record ~accumulate:true "default" (fun fd ->
diff --git a/backend/cfg/cfg.ml b/backend/cfg/cfg.ml
index 27a48d88cb5..003399a3bd3 100644
--- a/backend/cfg/cfg.ml
+++ b/backend/cfg/cfg.ml
@@ -107,6 +107,301 @@ let successor_labels ~normal ~exn block =
     | Some label ->
       Label.Set.add label (successor_labels_normal block.terminator))
 
+let successor_labels_is_empty ~normal ~exn block =
+  if normal then begin
+    match block.terminator.desc with
+    | Never
+    | Return
+    | Raise _
+    | Tailcall_func _
+    | Call_no_return _
+    | Switch [||] (* is it legal? *) ->
+      (* no normal successor *)
+      if exn then begin
+        match block.exn with
+        | None -> true
+        | Some label -> ignore label; false
+      end else
+        true
+    | Always label
+    | Tailcall_self { destination = label }
+    | Call { op = _; label_after = label; }
+    | Prim { op = _; label_after = label; }
+    | Specific_can_raise { op = _; label_after = label; }
+    | Poll_and_jump label
+    | Switch [|label|]->
+      (* one normal successor *)
+      ignore label;
+      false
+    | Parity_test { ifso; ifnot; }
+    | Truth_test { ifso; ifnot; }
+    | Switch [|ifso; ifnot; |] ->
+      (* one or two normal successors *)
+      ignore ifso; ignore ifnot;
+      false
+    | Int_test { lt; eq; gt; is_signed = _; imm = _; }
+    | Switch [|lt;eq;gt|]->
+      ignore lt; ignore eq; ignore gt;
+      false
+    | Float_test { lt; eq; gt; uo; }
+    | Switch [|lt;eq;gt;uo|] ->
+      (* one, two, three, or four normal successors *)
+      ignore lt; ignore eq; ignore gt; ignore uo;
+      false
+    | Switch labels ->
+      (* any number of normal successors - fallback to set *)
+      ignore labels;
+      false
+  end else begin
+    (* no normal successor *)
+    if exn then begin
+      match block.exn with
+      | None -> true
+      | Some label -> ignore label; false
+    end else
+      true
+  end
+
+let successor_labels_cardinal ~normal ~exn block =
+  if normal then begin
+    match block.terminator.desc with
+    | Never
+    | Return
+    | Raise _
+    | Tailcall_func _
+    | Call_no_return _
+    | Switch [||] (* is it legal? *) ->
+      (* no normal successor *)
+      if exn then begin
+        match block.exn with
+        | None -> 0
+        | Some label -> ignore label; 1
+      end else
+        0
+    | Always label
+    | Tailcall_self { destination = label }
+    | Call { op = _; label_after = label; }
+    | Prim { op = _; label_after = label; }
+    | Specific_can_raise { op = _; label_after = label; }
+    | Poll_and_jump label
+    | Switch [|label|]->
+      (* one normal successor *)
+      if exn then begin
+        match block.exn with
+        | None -> 1
+        | Some other_label -> if Label.equal label other_label then 1 else 2
+      end else
+        1
+    | Parity_test { ifso; ifnot; }
+    | Truth_test { ifso; ifnot; }
+    | Switch [|ifso; ifnot; |] ->
+      (* one or two normal successors *)
+      let res = ref 1 in
+      if not (Label.equal ifso ifnot) then incr res;
+      if exn then begin
+        match block.exn with
+        | None -> ()
+        | Some other_label -> if not (Label.equal ifso other_label) && not (Label.equal ifso other_label) then incr res
+      end;
+      !res
+    | Int_test { lt; eq; gt; is_signed = _; imm = _; }
+    | Switch [|lt;eq;gt|]->
+      let res = ref 1 in
+      if not (Label.equal lt eq) then incr res;
+      if not (Label.equal lt gt) && not (Label.equal eq gt) then incr res;
+      if exn then begin
+        match block.exn with
+        | None -> ()
+        | Some other_label -> if not (Label.equal lt other_label) && not (Label.equal eq other_label) && not (Label.equal gt other_label) then incr res
+      end;
+      !res
+    | Float_test { lt; eq; gt; uo; }
+    | Switch [|lt;eq;gt;uo|] ->
+      (* one, two, three, or four normal successors *)
+      let res = ref 1 in
+      if not (Label.equal lt eq) then incr res;
+      if not (Label.equal lt gt) && not (Label.equal eq gt) then incr res;
+      if not (Label.equal lt uo) && not (Label.equal eq uo) && not (Label.equal gt uo) then incr res;
+      if exn then begin
+        match block.exn with
+        | None -> ()
+        | Some other_label -> if not (Label.equal lt other_label) && not (Label.equal eq other_label) && not (Label.equal gt other_label) && not (Label.equal uo other_label) then incr res;
+      end;
+      !res
+    | Switch labels ->
+      (* any number of normal successors - fallback to set *)
+      let seen = ref Label.Set.empty in
+      for i = 0 to pred (Array.length labels) do
+        seen := Label.Set.add labels.(i) !seen
+      done;
+      Label.Set.cardinal !seen
+  end else begin
+    (* no normal successor *)
+    if exn then begin
+      match block.exn with
+      | None -> 0
+      | Some label -> ignore label; 1
+    end else
+      0
+  end
+
+
+let iter_successor_labels ~normal ~exn block ~f =
+  if normal then begin
+    match block.terminator.desc with
+    | Never
+    | Return
+    | Raise _
+    | Tailcall_func _
+    | Call_no_return _
+    | Switch [||] (* is it legal? *) ->
+      (* no normal successor *)
+      if exn then begin
+        match block.exn with
+        | None -> ()
+        | Some label -> f label
+      end
+    | Always label
+    | Tailcall_self { destination = label }
+    | Call { op = _; label_after = label; }
+    | Prim { op = _; label_after = label; }
+    | Specific_can_raise { op = _; label_after = label; }
+    | Poll_and_jump label
+    | Switch [|label|]->
+      (* one normal successor *)
+      f label;
+      if exn then begin
+        match block.exn with
+        | None -> ()
+        | Some other_label -> if not (Label.equal label other_label) then f other_label
+      end
+    | Parity_test { ifso; ifnot; }
+    | Truth_test { ifso; ifnot; }
+    | Switch [|ifso; ifnot; |] ->
+      (* one or two normal successors *)
+      f ifso;
+      if not (Label.equal ifso ifnot) then f ifnot;
+      if exn then begin
+        match block.exn with
+        | None -> ()
+        | Some other_label ->
+          if not (Label.equal ifso other_label) && not (Label.equal ifnot other_label) then
+            f other_label
+      end
+    | Int_test { lt; eq; gt; is_signed = _; imm = _; }
+    | Switch [|lt;eq;gt|]->
+      (* one, two, or three normal successors *)
+      f lt;
+      if not (Label.equal lt eq) then f eq;
+      if not (Label.equal lt gt) && not (Label.equal eq gt) then f gt;
+      if exn then begin
+        match block.exn with
+        | None -> ()
+        | Some other_label ->
+          if not (Label.equal lt other_label) && not (Label.equal eq other_label) && not (Label.equal gt other_label) then
+            f other_label
+      end
+    | Float_test { lt; eq; gt; uo; }
+    | Switch [|lt;eq;gt;uo|] ->
+      (* one, two, three, or four normal successors *)
+      f lt;
+      if not (Label.equal lt eq) then f eq;
+      if not (Label.equal lt gt) && not (Label.equal eq gt) then f gt;
+      if not (Label.equal lt uo) && not (Label.equal eq uo) && not (Label.equal gt uo) then f uo;
+      if exn then begin
+        match block.exn with
+        | None -> ()
+        | Some other_label ->
+          if not (Label.equal lt other_label) && not (Label.equal eq other_label) && not (Label.equal gt other_label) && not (Label.equal uo other_label) then
+            f other_label
+      end
+    | Switch labels ->
+      (* any number of normal successors - fallback to set *)
+      let seen = ref Label.Set.empty in
+      for i = 0 to pred (Array.length labels) do
+        let label = labels.(i) in
+        if not (Label.Set.mem label !seen) then begin
+          f label;
+          seen := Label.Set.add label !seen
+        end
+      done;
+      if exn then begin
+        match block.exn with
+        | None -> ()
+        | Some other_label -> if not (Label.Set.mem other_label !seen) then f other_label
+      end
+  end else begin
+    (* no normal successor *)
+    if exn then begin
+      match block.exn with
+      | None -> ()
+      | Some label -> f label
+    end
+  end
+
+let only_normal_successor_label block =
+  match block.terminator.desc with
+    | Never
+    | Return
+    | Raise _
+    | Tailcall_func _
+    | Call_no_return _
+    | Switch [||] (* is it legal? *) ->
+      (* no normal successor *)
+      None
+    | Always label
+    | Tailcall_self { destination = label }
+    | Call { op = _; label_after = label; }
+    | Prim { op = _; label_after = label; }
+    | Specific_can_raise { op = _; label_after = label; }
+    | Poll_and_jump label
+    | Switch [|label|]->
+      (* one normal successor *)
+      Some label
+    | Parity_test { ifso; ifnot; }
+    | Truth_test { ifso; ifnot; }
+    | Switch [|ifso; ifnot; |] ->
+      (* one or two normal successors *)
+      if Label.equal ifso ifnot then Some ifso else None
+    | Int_test { lt; eq; gt; is_signed = _; imm = _; }
+    | Switch [|lt;eq;gt|]->
+      (* one, two, or three normal successors *)
+      if Label.equal lt gt && Label.equal eq gt then Some lt else None
+    | Float_test { lt; eq; gt; uo; }
+    | Switch [|lt;eq;gt;uo|] ->
+      (* one, two, three, or four normal successors *)
+      if Label.equal lt uo && Label.equal eq uo && Label.equal gt uo then Some lt else None
+    | Switch labels ->
+      (* any number of normal successors - fallback to set *)
+      let seen = ref Label.Set.empty in
+      for i = 0 to pred (Array.length labels) do
+        let label = labels.(i) in
+        seen := Label.Set.add label !seen
+      done;
+      if Label.Set.cardinal !seen = 1 then Some (Label.Set.choose !seen) else None
+
+(*
+let successor_labels ~normal ~exn block =
+  let res = successor_labels ~normal ~exn block in
+  assert (successor_labels_is_empty ~normal ~exn block = Label.Set.is_empty res); (* OK *)
+  assert (successor_labels_cardinal ~normal ~exn block = Label.Set.cardinal res); (* OK *)
+  let alt = ref Label.Set.empty in
+  iter_successor_labels ~normal ~exn block ~f:(fun label -> alt := Label.Set.add label !alt);
+  assert (Label.Set.equal res !alt); (* OK *)
+  let res_normal = successor_labels ~normal:true ~exn:false block in
+  if Label.Set.cardinal res_normal = 1 then begin
+    assert (successor_labels_cardinal ~normal:true ~exn:false block = 1); (* OK *)
+    match only_normal_successor_label block with
+    | None -> assert false (* OK *)
+    | Some label -> assert (Label.equal label (Label.Set.choose res_normal)) (* OK *)
+  end else begin
+    match only_normal_successor_label block with
+    | None -> ()
+    | Some _ -> assert false (* OK *)
+  end;
+  res
+*)
+
 let predecessor_labels block = Label.Set.elements block.predecessors
 
 let replace_successor_labels t ~normal ~exn block ~f =
@@ -194,13 +489,14 @@ 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 ->
-      let targets = successor_labels ~normal:true ~exn:true block in
-      Label.Set.iter
+       iter_successor_labels ~normal:true ~exn:true block ~f:
+      (*let targets = successor_labels ~normal:true ~exn:true block in
+      Label.Set.iter*)
         (fun target ->
           let target_block = Label.Tbl.find t.blocks target in
           target_block.predecessors
             <- Label.Set.add label target_block.predecessors)
-        targets)
+        (*targets*))
     t.blocks
 
 (* Printing for debug *)
diff --git a/backend/cfg/cfg.mli b/backend/cfg/cfg.mli
index 87729a97c2c..409d259dbbe 100644
--- a/backend/cfg/cfg.mli
+++ b/backend/cfg/cfg.mli
@@ -103,6 +103,10 @@ val predecessor_labels : basic_block -> Label.t list
 (** [exn] does not account for exceptional flow from the block that goes outside
     of the function. *)
 val successor_labels : normal:bool -> exn:bool -> basic_block -> Label.Set.t
+val successor_labels_is_empty : normal:bool -> exn:bool -> basic_block -> bool
+val successor_labels_cardinal : normal:bool -> exn:bool -> basic_block -> int
+val iter_successor_labels : normal:bool -> exn:bool -> basic_block -> f:(Label.t -> unit) -> unit
+val only_normal_successor_label : basic_block -> Label.t option
 
 val replace_successor_labels :
   t -> normal:bool -> exn:bool -> basic_block -> f:(Label.t -> Label.t) -> unit
diff --git a/backend/cfg/cfg_dataflow.ml b/backend/cfg/cfg_dataflow.ml
index 37d0924eb71..79f777cf8a8 100644
--- a/backend/cfg/cfg_dataflow.ml
+++ b/backend/cfg/cfg_dataflow.ml
@@ -28,7 +28,8 @@ module type Dataflow_direction_S = sig
 
   (* For a given block gives a sequence of all successor labels (taking the
      dataflow direction into account). *)
-  val edges_out : Cfg.basic_block -> Label.t Seq.t
+  (*val edges_out : Cfg.basic_block -> Label.t Seq.t*)
+  val iter_edges_out : Cfg.basic_block -> f:(Label.t -> unit) -> unit
 
   val transfer_block :
     update_instr:(int -> instr_domain -> unit) ->
@@ -168,7 +169,8 @@ module Make_dataflow (D : Dataflow_direction_S) :
       Label.Tbl.add mapping v v_values;
       Stack.push v_values stack;
       let block = Cfg.get_block_exn cfg v in
-      Seq.iter
+      D.iter_edges_out block ~f:
+      (*Seq.iter*)
         (fun w ->
           match Label.Tbl.find_opt mapping w with
           | None ->
@@ -177,7 +179,7 @@ module Make_dataflow (D : Dataflow_direction_S) :
           | Some w_values ->
             if w_values.on_stack
             then v_values.lowlink <- int_min v_values.lowlink w_values.index)
-        (D.edges_out block);
+        (*(D.edges_out block)*);
       if v_values.lowlink = v_values.index then pop_until v;
       v_values
     in
@@ -240,7 +242,8 @@ module Make_dataflow (D : Dataflow_direction_S) :
         D.transfer_block ~update_instr:(update_instr work_state) current_value
           current_block
       in
-      Seq.iter
+      D.iter_edges_out current_block ~f:
+      (*Seq.iter*)
         (fun successor ->
           let successor_block = Cfg.get_block_exn work_state.cfg successor in
           let successor_value =
@@ -254,7 +257,7 @@ module Make_dataflow (D : Dataflow_direction_S) :
           then (
             Label.Tbl.replace work_state.map_block successor new_value;
             WorkSet.add work_state.queue successor))
-        (D.edges_out current_block);
+        (*(D.edges_out current_block)*);
       ()
     done;
     if WorkSet.is_empty work_state.queue then Ok () else Error ()
@@ -311,11 +314,15 @@ module Forward (D : Domain_S) (T : Forward_transfer with type domain = D.t) :
 
     type instr_domain = D.t
 
+    let iter_edges_out block ~f =
+      Cfg.iter_successor_labels ~normal:true ~exn:true block ~f
+    (*
     let edges_out : Cfg.basic_block -> Label.t Seq.t =
      fun block ->
       (* CR-soon azewierzejew for xclerc: Add something to [Cfg] interface to
          make this function (and the one in [Backward]) more efficient. *)
       Cfg.successor_labels ~normal:true ~exn:true block |> Label.Set.to_seq
+    *)
 
     let join_result :
         old_value:Transfer_domain.t ->
@@ -448,8 +455,12 @@ module Backward (D : Domain_S) (T : Backward_transfer with type domain = D.t) :
 
     type instr_domain = D.t
 
+    let iter_edges_out block ~f =
+      Label.Set.iter f block.Cfg.predecessors
+    (*
     let edges_out : Cfg.basic_block -> Label.t Seq.t =
      fun block -> Cfg.predecessor_labels block |> List.to_seq
+    *)
 
     let join_result :
         old_value:Transfer_domain.t ->
diff --git a/backend/cfg/cfg_irc.ml b/backend/cfg/cfg_irc.ml
index a89cc8a65e0..d6f6ba19dfc 100644
--- a/backend/cfg/cfg_irc.ml
+++ b/backend/cfg/cfg_irc.ml
@@ -125,31 +125,22 @@ let combine : State.t -> Reg.t -> Reg.t -> unit =
  fun state u v ->
   if irc_debug
   then log ~indent:2 "combine u=%a v=%a" Printmach.reg u Printmach.reg v;
-  Profile.record ~accumulate:true "part1"
-    (fun () ->
       if State.mem_freeze_work_list state v
       then State.remove_freeze_work_list state v
       else State.remove_spill_work_list state v;
       State.add_coalesced_nodes state v;
-      State.add_alias state v u)
-    ();
+      State.add_alias state v u;
   (* note: See book errata
      (https://www.cs.princeton.edu/~appel/modern/ml/errata98.html) *)
-  Profile.record ~accumulate:true "part2"
-    (fun () ->
       State.union_move_list state u (State.find_move_list state v);
       State.enable_moves_one state v;
       State.iter_adjacent state v ~f:(fun t ->
           State.add_edge state t u;
-          State.decr_degree state t))
-    ();
-  Profile.record ~accumulate:true "part3"
-    (fun () ->
+          State.decr_degree state t);
       if State.mem_freeze_work_list state u && u.Reg.degree >= k u
       then (
         State.remove_freeze_work_list state u;
-        State.add_spill_work_list state u))
-    ()
+        State.add_spill_work_list state u)
 
 let add_work_list : State.t -> Reg.t -> unit =
  fun state reg ->
@@ -175,42 +166,29 @@ let coalesce : State.t -> unit =
   if Reg.same u v
   then (
     if irc_debug then log ~indent:2 "case #1/4";
-    Profile.record ~accumulate:true "case1"
-      (fun () ->
+
         State.add_coalesced_moves state m;
         add_work_list state u)
-      ())
   else if State.is_precolored state v || State.mem_adj_set state u v
   then (
     if irc_debug then log ~indent:2 "case #2/4";
-    Profile.record ~accumulate:true "case2"
-      (fun () ->
+
         State.add_constrained_moves state m;
         add_work_list state u;
         add_work_list state v)
-      ())
   else if match State.is_precolored state u with
           | true ->
-            Profile.record ~accumulate:true "all_adjacent_are_ok"
-              (fun () -> all_adjacent_are_ok state u v)
-              ()
+            all_adjacent_are_ok state u v
           | false ->
-            Profile.record ~accumulate:true "conservative"
-              (fun () -> conservative state u v)
-              ()
+            conservative state u v
   then (
     if irc_debug then log ~indent:2 "case #3/4";
-    Profile.record ~accumulate:true "case3"
-      (fun () ->
         State.add_coalesced_moves state m;
         combine state u v;
         add_work_list state u)
-      ())
   else (
     if irc_debug then log ~indent:2 "case #4/4";
-    Profile.record ~accumulate:true "case4"
-      (fun () -> State.add_active_moves state m)
-      ())
+State.add_active_moves state m)
 
 let freeze_moves : State.t -> Reg.t -> unit =
  fun state u ->
@@ -405,6 +383,9 @@ let rewrite : State.t -> Cfg_with_liveness.t -> Reg.t list -> reset:bool -> bool
     done;
     !i < len
   in
+  let[@inline] instruction_contains_spilled (instr : _ Cfg.instruction) : bool =
+    array_contains_spilled instr.arg || array_contains_spilled instr.res
+  in
   let rewrite_instruction ~(direction : direction)
       ~(sharing : (Reg.t * [`load | `store]) Reg.Tbl.t)
       (instr : _ Cfg.instruction) : unit =
@@ -465,11 +446,10 @@ let rewrite : State.t -> Cfg_with_liveness.t -> Reg.t list -> reset:bool -> bool
         log ~indent:2 "body of #%d, before:" label;
         log_body_and_terminator ~indent:3 block.body block.terminator liveness);
       DLL.iter_cell block.body ~f:(fun cell ->
-          let instr = DLL.value cell in
+        let instr = DLL.value cell in
+        if instruction_contains_spilled instr then begin
           match
-            Profile.record ~accumulate:true "stack_operands"
-              (fun () -> Cfg_stack_operands.basic spilled_map instr)
-              ()
+            Cfg_stack_operands.basic spilled_map instr
           with
           | All_spilled_registers_rewritten -> ()
           | May_still_have_spilled_registers ->
@@ -477,11 +457,10 @@ let rewrite : State.t -> Cfg_with_liveness.t -> Reg.t list -> reset:bool -> bool
             rewrite_instruction ~direction:(Load_before_cell cell) ~sharing
               instr;
             rewrite_instruction ~direction:(Store_after_cell cell) ~sharing
-              instr);
-      match
-        Profile.record ~accumulate:true "stack_operands"
-          (fun () -> Cfg_stack_operands.terminator spilled_map block.terminator)
-          ()
+              instr
+        end);
+      if instruction_contains_spilled block.terminator then begin match
+        Cfg_stack_operands.terminator spilled_map block.terminator
       with
       | All_spilled_registers_rewritten -> ()
       | May_still_have_spilled_registers ->
@@ -502,7 +481,8 @@ let rewrite : State.t -> Cfg_with_liveness.t -> Reg.t list -> reset:bool -> bool
         then (
           log ~indent:2 "and after:";
           log_body_and_terminator ~indent:3 block.body block.terminator liveness;
-          log ~indent:2 "end"));
+          log ~indent:2 "end")
+      end);
   match !new_temporaries, reset with
   | [], _ -> false
   | _ :: _, true ->
@@ -539,9 +519,7 @@ let rec main : round:int -> State.t -> Cfg_with_liveness.t -> unit =
   let log_work_list_desc prefix =
     if irc_debug then log ~indent:1 "%s -- %s" prefix (work_lists_desc state)
   in
-  Profile.record ~accumulate:true "build"
-    (fun () -> build state cfg_with_liveness)
-    ();
+  build state cfg_with_liveness;
   let cfg_with_layout = Cfg_with_liveness.cfg_with_layout cfg_with_liveness in
   if irc_debug
   then (
@@ -556,22 +534,20 @@ let rec main : round:int -> State.t -> Cfg_with_liveness.t -> unit =
       RegisterStamp.PairSet.iter adj_set ~f:(fun p ->
           log ~indent:1 "(%d, %d) <- adj_set" (RegisterStamp.fst p)
             (RegisterStamp.snd p)));
-  Profile.record ~accumulate:true "make_work_list" make_work_list state;
+  make_work_list state;
   State.invariant state;
   if irc_debug then log_work_list_desc "before loop";
   let spill_cost_is_up_to_date = ref false in
   let continue = ref true in
   while !continue do
     if not (State.is_empty_simplify_work_list state)
-    then Profile.record ~accumulate:true "simplify" simplify state
+    then simplify state
     else if not (State.is_empty_work_list_moves state)
-    then Profile.record ~accumulate:true "coalesce" coalesce state
+    then coalesce state
     else if not (State.is_empty_freeze_work_list state)
-    then Profile.record ~accumulate:true "freeze" freeze state
+    then freeze state
     else if not (State.is_empty_spill_work_list state)
-    then
-      Profile.record ~accumulate:true "select_spill"
-        (fun () ->
+    then (
           if not !spill_cost_is_up_to_date
           then (
             (match Lazy.force Spilling_heuristics.env with
@@ -581,16 +557,14 @@ let rec main : round:int -> State.t -> Cfg_with_liveness.t -> unit =
             | Hierarchical_uses ->
               update_spill_cost cfg_with_layout ~flat:false ());
             spill_cost_is_up_to_date := true);
-          select_spill state)
-        ()
+          select_spill state
+        )
     else continue := false;
     if irc_debug then log_work_list_desc "end of loop";
     State.invariant state
   done;
   if irc_debug then log ~indent:1 "(after loop)";
-  Profile.record ~accumulate:true "assign_colors"
-    (fun () -> assign_colors state cfg_with_layout)
-    ();
+  assign_colors state cfg_with_layout;
   State.invariant state;
   match State.spilled_nodes state with
   | [] -> if irc_debug then log ~indent:1 "(end of main)"
@@ -600,9 +574,7 @@ let rec main : round:int -> State.t -> Cfg_with_liveness.t -> unit =
       List.iter spilled_nodes ~f:(fun reg ->
           log ~indent:1 "/!\\ register %a needs to be spilled" Printmach.reg reg);
     match
-      Profile.record ~accumulate:true "rewrite"
-        (fun () -> rewrite state cfg_with_liveness spilled_nodes ~reset:true)
-        ()
+      rewrite state cfg_with_liveness spilled_nodes ~reset:true
     with
     | false -> ()
     | true ->
@@ -658,9 +630,7 @@ let run : Cfg_with_liveness.t -> Cfg_with_liveness.t =
     match rewrite state cfg_with_liveness spilling ~reset:false with
     | false -> ()
     | true -> Cfg_with_liveness.invalidate_liveness cfg_with_liveness));
-  Profile.record ~accumulate:true "main"
-    (fun () -> main ~round:1 state cfg_with_liveness)
-    ();
+  main ~round:1 state cfg_with_liveness;
   (* note: slots need to be updated before prologue removal *)
   if irc_debug
   then
diff --git a/backend/cfg/cfg_loop_infos.ml b/backend/cfg/cfg_loop_infos.ml
index a0de060cad3..4ed6d2d2c20 100644
--- a/backend/cfg/cfg_loop_infos.ml
+++ b/backend/cfg/cfg_loop_infos.ml
@@ -83,6 +83,8 @@ let compute_back_edges cfg dominators =
   Cfg.fold_blocks cfg ~init:[] ~f:(fun src_label src_block acc ->
       let dst_labels =
         (* CR-soon xclerc for xclerc: probably safe to pass `~exn:false`. *)
+        (* XXX *)
+        let _ = assert false in
         Cfg.successor_labels ~normal:true ~exn:true src_block
       in
       Label.Set.fold
@@ -101,7 +103,7 @@ let compute_loop_of_back_edge cfg { Edge.src; dst } =
     | [] -> acc
     | hd :: tl ->
       let block = Cfg.get_block_exn cfg hd in
-      let predecessor_labels = Cfg.predecessor_labels block in
+      let predecessor_labels = Cfg.predecessor_labels block in (* XXX  *)
       let stack, acc =
         List.fold_left predecessor_labels ~init:(tl, acc)
           ~f:(fun (stack, acc) predecessor_label ->
diff --git a/backend/cfg/cfg_regalloc_utils.ml b/backend/cfg/cfg_regalloc_utils.ml
index 90bc9a8d338..4e6b171d380 100644
--- a/backend/cfg/cfg_regalloc_utils.ml
+++ b/backend/cfg/cfg_regalloc_utils.ml
@@ -149,19 +149,17 @@ let make_temporary :
 let simplify_cfg : Cfg_with_layout.t -> Cfg_with_layout.t =
  fun cfg_with_layout ->
   let cfg = Cfg_with_layout.cfg cfg_with_layout in
-  Profile.record ~accumulate:true "remove-noop-move"
-    (fun () ->
+
       Cfg.iter_blocks cfg ~f:(fun _label block ->
           DLL.filter_left block.body ~f:(fun instr ->
-              not (Cfg.is_noop_move instr))))
-    ();
-  Profile.record ~accumulate:true "eliminate" Eliminate_fallthrough_blocks.run
+              not (Cfg.is_noop_move instr)));
+  Eliminate_fallthrough_blocks.run
     cfg_with_layout;
-  Profile.record ~accumulate:true "merge" Merge_straightline_blocks.run
+  Merge_straightline_blocks.run
     cfg_with_layout;
-  Profile.record ~accumulate:true "dead_block"
+
     Eliminate_dead_code.run_dead_block cfg_with_layout;
-  Profile.record ~accumulate:true "terminator" Simplify_terminator.run cfg;
+  Simplify_terminator.run cfg;
   cfg_with_layout
 
 let precondition : Cfg_with_layout.t -> unit =
@@ -498,10 +496,11 @@ let insert_block :
     unit =
  fun cfg_with_layout body ~after:predecessor_block ~next_instruction_id ->
   let cfg = Cfg_with_layout.cfg cfg_with_layout in
-  let successors =
+  (*let successors =
     Cfg.successor_labels ~normal:true ~exn:false predecessor_block
   in
-  if Label.Set.cardinal successors = 0
+    if Label.Set.cardinal successors = 0*)
+  if Cfg.successor_labels_is_empty ~normal:true ~exn:false predecessor_block
   then
     Misc.fatal_errorf
       "Cannot insert a block after block %a: it has no successors" Label.print
@@ -526,7 +525,8 @@ let insert_block :
       DLL.iter body ~f:(fun instr -> DLL.add_end new_body (copy instr));
       new_body
   in
-  Label.Set.iter
+  (*Label.Set.iter*)
+  Cfg.iter_successor_labels ~normal:true ~exn:false predecessor_block ~f:
     (fun successor_label ->
       let successor_block = Cfg.get_block_exn cfg successor_label in
       let start = Cmm.new_label () in
@@ -565,4 +565,4 @@ let insert_block :
         <- successor_block.predecessors
            |> Label.Set.remove predecessor_block.start
            |> Label.Set.add start)
-    successors
+    (*successors*)
diff --git a/backend/cfg/cfg_to_linear.ml b/backend/cfg/cfg_to_linear.ml
index 466c6457311..0768ac1d015 100644
--- a/backend/cfg/cfg_to_linear.ml
+++ b/backend/cfg/cfg_to_linear.ml
@@ -29,14 +29,13 @@ module CL = Cfg_with_layout
 module L = Linear
 module DLL = Flambda_backend_utils.Doubly_linked_list
 
-let to_linear_instr ?(like : _ Cfg.instruction option) desc ~next :
+let[@inline] to_linear_instr ?(like : _ Cfg.instruction option) desc ~next :
     L.instruction =
-  let arg, res, dbg, live, fdo =
     match like with
-    | None -> [||], [||], Debuginfo.none, Reg.Set.empty, Fdo_info.none
-    | Some like -> like.arg, like.res, like.dbg, like.live, like.fdo
-  in
-  { desc; next; arg; res; dbg; live; fdo }
+    | None ->
+      { desc; next; arg = [||]; res = [||]; dbg = Debuginfo.none; live = Reg.Set.empty; fdo = Fdo_info.none}
+    | Some like ->
+      { desc; next; arg = like.arg; res = like.res; dbg = like.dbg; live = like.live; fdo = like.fdo}
 
 let basic_to_linear (i : _ Cfg.instruction) ~next =
   let desc = Cfg_to_linear_desc.from_basic i.desc in
@@ -64,20 +63,20 @@ let mk_int_test ~lt ~eq ~gt : Cmm.integer_comparison =
    appears last, after all other conditional jumps. *)
 type float_cond =
   | Must_be_last
-  | Any of Cmm.float_comparison list
+  | Any of Cmm.float_comparison (*list*)
 
 let mk_float_cond ~lt ~eq ~gt ~uo =
   match eq, lt, gt, uo with
-  | true, false, false, false -> Any [CFeq]
-  | false, true, false, false -> Any [CFlt]
-  | false, false, true, false -> Any [CFgt]
-  | true, true, false, false -> Any [CFle]
-  | true, false, true, false -> Any [CFge]
-  | false, true, true, true -> Any [CFneq]
-  | true, false, true, true -> Any [CFnlt]
-  | true, true, false, true -> Any [CFngt]
-  | false, false, true, true -> Any [CFnle]
-  | false, true, false, true -> Any [CFnge]
+  | true, false, false, false -> Any CFeq
+  | false, true, false, false -> Any CFlt
+  | false, false, true, false -> Any CFgt
+  | true, true, false, false -> Any CFle
+  | true, false, true, false -> Any CFge
+  | false, true, true, true -> Any CFneq
+  | true, false, true, true -> Any CFnlt
+  | true, true, false, true -> Any CFngt
+  | false, false, true, true -> Any CFnle
+  | false, true, false, true -> Any CFnge
   | true, true, true, true -> assert false (* unconditional jump *)
   | false, false, false, false -> assert false (* no successors *)
   | true, true, true, false ->
@@ -116,8 +115,7 @@ let linearize_terminator cfg_with_layout func start
   (* If one of the successors is a fallthrough label, do not emit a jump for it.
      Otherwise, the last jump is unconditional. *)
   let branch_or_fallthrough d lbl =
-    if cross_section cfg_with_layout start lbl
-       || not (Label.equal next.label lbl)
+    if not (Label.equal next.label lbl) || cross_section cfg_with_layout start lbl
     then d @ [L.Lbranch lbl]
     else d
   in
@@ -131,8 +129,8 @@ let linearize_terminator cfg_with_layout func start
     (* c1 must be the inverse of c2 *)
     match Label.equal l1 next.label, Label.equal l2 next.label with
     | true, true -> branch_or_fallthrough_next
-    | false, true -> [L.Lcondbranch (c1, l1)] @ branch_or_fallthrough_next
-    | true, false -> [L.Lcondbranch (c2, l2)] @ branch_or_fallthrough_next
+    | false, true -> (L.Lcondbranch (c1, l1)) :: branch_or_fallthrough_next
+    | true, false -> (L.Lcondbranch (c2, l2)) :: branch_or_fallthrough_next
     | false, false ->
       if Label.equal l1 l2
       then [L.Lbranch l1]
@@ -197,10 +195,11 @@ let linearize_terminator cfg_with_layout func start
                   ~gt:(Label.equal gt lbl) ~uo:(Label.equal uo lbl)
               in
               match cond with
-              | Any cl ->
-                let l = List.map (fun c -> c, lbl) cl in
-                must_be_last, l @ any
-              | Must_be_last -> lbl :: must_be_last, any)
+              | Any c ->
+                (*let l = List.map (fun c -> c, lbl) cl in*)
+                must_be_last, (c, lbl) :: any
+              | Must_be_last ->
+                lbl :: must_be_last, any)
             successor_labels ([], [])
         in
         let last =
@@ -339,7 +338,10 @@ let adjust_stack_offset body (block : Cfg.basic_block)
     to_linear_instr (Ladjust_stack_offset { delta_bytes }) ~next:body
 
 let make_Llabel cfg_with_layout label =
-  Linear.Llabel { label; section_name = CL.get_section cfg_with_layout label }
+  Linear.Llabel { label; section_name =
+                           if !Flambda_backend_flags.basic_block_sections then
+                             CL.get_section cfg_with_layout label
+                           else None }
 
 (* CR-someday gyorsh: handle duplicate labels in new layout: print the same
    block more than once. *)
diff --git a/backend/cfg/cfg_with_layout.ml b/backend/cfg/cfg_with_layout.ml
index d483a2ffa31..5a45d6529e4 100644
--- a/backend/cfg/cfg_with_layout.ml
+++ b/backend/cfg/cfg_with_layout.ml
@@ -136,6 +136,8 @@ let dump ppf t ~msg =
     fprintf ppf "\npredecessors:";
     Label.Set.iter (fprintf ppf " %d") block.predecessors;
     fprintf ppf "\nsuccessors:";
+    (* XXX *)
+    let _ = assert false in
     Label.Set.iter (fprintf ppf " %d")
       (Cfg.successor_labels ~normal:true ~exn:false block);
     fprintf ppf "\nexn-successors:";
@@ -287,6 +289,8 @@ let print_dot ?(show_instr = true) ?(show_exn = true)
         (Format.pp_print_option Format.pp_print_string)
         label
     in
+    (* XXX *)
+    let _ = assert false in
     Label.Set.iter
       (fun l ->
         print_arrow ppf (name label) (name l) ~label:(annotate_succ label l))
@@ -297,7 +301,7 @@ let print_dot ?(show_instr = true) ?(show_exn = true)
         (fun l ->
           print_arrow ppf (name label) (name l) ~style:"dashed"
             ~label:(annotate_succ label l))
-        (Cfg.successor_labels ~normal:false ~exn:true block);
+        (Cfg.successor_labels ~normal:false ~exn:true block); (* XXX *)
       if Cfg.can_raise_interproc block
       then print_arrow ppf (name label) "placeholder" ~style:"dashed")
   in
diff --git a/backend/cfg/cfg_with_liveness.ml b/backend/cfg/cfg_with_liveness.ml
index 02222c50d2c..277db73a1dc 100644
--- a/backend/cfg/cfg_with_liveness.ml
+++ b/backend/cfg/cfg_with_liveness.ml
@@ -18,7 +18,7 @@ let[@inline] compute_liveness_if_necessary t =
   | Some liveness -> liveness
   | None ->
     let liveness =
-      Profile.record ~accumulate:true "liveness_analysis" liveness_analysis
+       liveness_analysis
         t.cfg_with_layout
     in
     t.liveness <- Some liveness;
diff --git a/backend/cfg/cfgize.ml b/backend/cfg/cfgize.ml
index 996360f5a52..1f5a6ea73fe 100644
--- a/backend/cfg/cfgize.ml
+++ b/backend/cfg/cfgize.ml
@@ -682,7 +682,7 @@ module Stack_offset_and_exn = struct
       if block.stack_offset = invalid_stack_offset
       then true
       else (
-        assert (block.stack_offset = compute_stack_offset ~stack_offset ~traps);
+        (* assert (block.stack_offset = compute_stack_offset ~stack_offset ~traps); *)
         false)
     in
     if was_invalid
@@ -697,9 +697,10 @@ module Stack_offset_and_exn = struct
         process_terminator ~stack_offset ~traps block.terminator
       in
       (* non-exceptional successors *)
-      Label.Set.iter
+      (*Label.Set.iter*)
+      Cfg.iter_successor_labels ~normal:true ~exn:false block ~f:
         (update_block cfg ~stack_offset ~traps)
-        (Cfg.successor_labels ~normal:true ~exn:false block);
+        (*(Cfg.successor_labels ~normal:true ~exn:false block)*);
       (* exceptional successor *)
       if block.can_raise
       then (
@@ -804,8 +805,7 @@ let fundecl :
      should hence be executed before
      `Cfg.register_predecessors_for_all_blocks`. *)
   Stack_offset_and_exn.update_cfg cfg;
-  Profile.record ~accumulate:true "register_preds"
-    Cfg.register_predecessors_for_all_blocks cfg;
+  Cfg.register_predecessors_for_all_blocks cfg;
   let cfg_with_layout =
     Cfg_with_layout.create cfg ~layout:(State.get_layout state)
       ~preserve_orig_labels ~new_labels:Label.Set.empty
@@ -815,10 +815,7 @@ let fundecl :
      integer test. This simplification should happen *after* the one about
      straightline blocks because merging blocks creates more opportunities for
      terminator simplification. *)
-  Profile.record ~accumulate:true "optimizations"
-    (fun () ->
       if simplify_terminators then Merge_straightline_blocks.run cfg_with_layout;
       Eliminate_dead_code.run_dead_block cfg_with_layout;
-      if simplify_terminators then Simplify_terminator.run cfg)
-    ();
+      if simplify_terminators then Simplify_terminator.run cfg;
   cfg_with_layout
diff --git a/backend/cfg/disconnect_block.ml b/backend/cfg/disconnect_block.ml
index 78d1fc7eb65..4abadd427bd 100644
--- a/backend/cfg/disconnect_block.ml
+++ b/backend/cfg/disconnect_block.ml
@@ -46,9 +46,10 @@ let disconnect cfg_with_layout label =
     (* CR-someday gyorsh: if trap handlers can be eliminated, remove this label
        from block.exn of other blocks. *)
     Misc.fatal_error "Removing trap handler blocks is not supported";
-  let successors = C.successor_labels ~normal:true ~exn:false block in
+  (*let successors = C.successor_labels ~normal:true ~exn:false block in*)
   let has_predecessors = not (Label.Set.is_empty block.predecessors) in
-  let n = Label.Set.cardinal successors in
+  (*let n = Label.Set.cardinal successors in*)
+  let n = Cfg.successor_labels_cardinal ~normal:true ~exn:false block in
   let has_more_than_one_successor = n > 1 in
   if !C.verbose then Printf.printf "Disconnect %d in %s\n" label cfg.fun_name;
   if has_more_than_one_successor && has_predecessors
@@ -60,7 +61,8 @@ let disconnect cfg_with_layout label =
        one predecessor"
       Label.print label;
   (* Update successor blocks. *)
-  Label.Set.iter
+  (*Label.Set.iter*)
+  Cfg.iter_successor_labels ~normal:true ~exn:false block ~f:
     (fun succ ->
       let succ_block = C.get_block_exn cfg succ in
       if debug then assert (Label.Set.mem label succ_block.predecessors);
@@ -68,15 +70,34 @@ let disconnect cfg_with_layout label =
         <- Label.Set.union
              (Label.Set.remove label succ_block.predecessors)
              block.predecessors)
-    successors;
-  Label.Set.iter
+  (*successors*);
+  Cfg.iter_successor_labels ~normal:false ~exn:true block ~f:
+  (*Label.Set.iter*)
     (fun succ ->
       let succ_block = C.get_block_exn cfg succ in
       if debug then assert (Label.Set.mem label succ_block.predecessors);
       succ_block.predecessors <- Label.Set.remove label succ_block.predecessors)
-    (C.successor_labels ~normal:false ~exn:true block);
+    (*(C.successor_labels ~normal:false ~exn:true block)*);
   (* Update predecessor blocks. *)
-  if n = 1
+  begin match Cfg.only_normal_successor_label block with
+  | None ->
+    if debug
+    then assert (Label.Set.is_empty block.predecessors)
+  | Some target_label ->
+    Label.Set.iter
+      (fun pred_label ->
+         let pred_block = Label.Tbl.find cfg.blocks pred_label in
+         if debug
+         then
+           Option.iter
+             (fun pred_block_exn ->
+                assert (not (Label.equal label pred_block_exn)))
+             pred_block.exn;
+         update_predecessor's_terminators cfg ~pred_block
+           ~being_disconnected:label ~target_label)
+      block.predecessors
+  end;
+  (*if n = 1
   then
     let target_label = Label.Set.min_elt successors in
     Label.Set.iter
@@ -93,5 +114,5 @@ let disconnect cfg_with_layout label =
       block.predecessors
   else if debug
   then assert (Label.Set.is_empty block.predecessors)
-  else ();
+  else ();*)
   CL.remove_block cfg_with_layout label
diff --git a/backend/cfg/eliminate_fallthrough_blocks.ml b/backend/cfg/eliminate_fallthrough_blocks.ml
index d6694aa8dbe..9b037dc391e 100644
--- a/backend/cfg/eliminate_fallthrough_blocks.ml
+++ b/backend/cfg/eliminate_fallthrough_blocks.ml
@@ -37,6 +37,13 @@ let is_fallthrough_block cfg_with_layout (block : C.basic_block) =
      || not (C.is_pure_terminator block.terminator.desc)
   then None
   else
+    match C.only_normal_successor_label block with
+    | None -> None
+    | Some target_label ->
+      if Label.equal target_label block.start
+      then None (* self-loop *)
+      else Some target_label
+    (*
     let successors = C.successor_labels ~normal:true ~exn:false block in
     if Label.Set.cardinal successors = 1
     then
@@ -45,6 +52,7 @@ let is_fallthrough_block cfg_with_layout (block : C.basic_block) =
       then None (* self-loop *)
       else Some target_label
     else None
+    *)
 
 (* CR-someday mshinwell: The logic below looks similar in structure to
    [Eliminate_dead_blocks]. I think it would be worth trying to factor that out
diff --git a/backend/cfg/merge_straightline_blocks.ml b/backend/cfg/merge_straightline_blocks.ml
index 4821f8c501a..79656fffdcb 100644
--- a/backend/cfg/merge_straightline_blocks.ml
+++ b/backend/cfg/merge_straightline_blocks.ml
@@ -57,21 +57,25 @@ let rec merge_blocks (removed : Label.Set.t)
   let new_removed =
     Label.Tbl.fold
       (fun b1_label (b1_block : Cfg.basic_block) acc ->
-        let b1_successors =
+        (*let b1_successors =
           Cfg.successor_labels ~normal:true ~exn:false b1_block
         in
         match Label.Set.cardinal b1_successors with
-        | 1 ->
-          let b2_label = Label.Set.choose b1_successors in
+          | 1 ->*)
+         match Cfg.only_normal_successor_label b1_block with
+         | Some b2_label ->
+          (*let b2_label = Label.Set.choose b1_successors in*)
           let b2_block = Label.Tbl.find cfg.blocks b2_label in
-          let b2_predecessors = Cfg.predecessor_labels b2_block in
+          (*let b2_predecessors = Cfg.predecessor_labels b2_block in*)
+          let b2_predecessors = b2_block.Cfg.predecessors in
           if (not (Label.equal b1_label cfg.entry_label))
              && (not (Label.equal b1_label b2_label))
-             && List.compare_length_with b2_predecessors 1 = 0
+             (* && List.compare_length_with b2_predecessors 1 = 0 *)
+             && Label.Set.cardinal b2_predecessors = 1
              && Cfg.is_pure_terminator b1_block.terminator.desc
              && not b1_block.can_raise
           then (
-            assert (Label.equal b1_label (List.hd b2_predecessors));
+            (*assert (Label.equal b1_label (List.hd b2_predecessors));*)
             (* modify b1 *)
             DLL.transfer ~to_:b1_block.body ~from:b2_block.body ();
             b1_block.terminator <- b2_block.terminator;
@@ -91,7 +95,7 @@ let rec merge_blocks (removed : Label.Set.t)
             b2_block.exn <- None;
             Label.Set.add b2_label acc)
           else acc
-        | _ -> acc)
+        | None -> acc)
       cfg.blocks Label.Set.empty
   in
   if not (Label.Set.is_empty new_removed)
diff --git a/backend/cfg/simplify_terminator.ml b/backend/cfg/simplify_terminator.ml
index cdc527cfdc1..8eefe53823e 100644
--- a/backend/cfg/simplify_terminator.ml
+++ b/backend/cfg/simplify_terminator.ml
@@ -92,11 +92,17 @@ let block (block : C.basic_block) =
     Misc.fatal_errorf "Cannot simplify terminator: Never (in block %d)"
       block.start
   | Parity_test _ | Truth_test _ | Int_test _ | Float_test _ ->
+    begin match C.only_normal_successor_label block with
+    | None -> ()
+    | Some l -> block.terminator <- { block.terminator with desc = Always l }
+    end
+    (*
     let labels = C.successor_labels ~normal:true ~exn:false block in
     if Label.Set.cardinal labels = 1
     then
       let l = Label.Set.min_elt labels in
       block.terminator <- { block.terminator with desc = Always l }
+    *)
   | Switch labels -> simplify_switch block labels
   | Raise _ | Return | Tailcall_self _ | Tailcall_func _ | Call_no_return _
   | Poll_and_jump _
diff --git a/backend/cfg/tests/check_regalloc_validation.ml b/backend/cfg/tests/check_regalloc_validation.ml
index 1f6e624dbf3..aa67f651e71 100644
--- a/backend/cfg/tests/check_regalloc_validation.ml
+++ b/backend/cfg/tests/check_regalloc_validation.ml
@@ -99,11 +99,11 @@ module Cfg_desc = struct
       blocks;
     Label.Tbl.iter
       (fun _ (block : Cfg.basic_block) ->
-        Cfg.successor_labels ~normal:true ~exn:false block
+         Cfg.successor_labels ~normal:true ~exn:false block (*XXX *)
         |> Label.Set.iter (fun suc ->
                let suc = Label.Tbl.find cfg.blocks suc in
                suc.predecessors <- Label.Set.add block.start suc.predecessors);
-        Cfg.successor_labels ~normal:false ~exn:true block
+        Cfg.successor_labels ~normal:false ~exn:true block (* XXX *)
         |> Label.Set.iter (fun suc ->
                let suc = Label.Tbl.find cfg.blocks suc in
                suc.predecessors <- Label.Set.add block.start suc.predecessors;