From aaacbcffe24d4935cf7f2e1dc444bd07290926e4 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Tue, 17 Mar 2020 15:45:57 +0100
Subject: [PATCH 1/7] Avoid exponential case in liveness

---
 asmcomp/liveness.ml | 63 ++++++++++++++++++++++++++++++++++++++++++++-
 asmcomp/mach.ml     | 36 ++++++++++++++++++++++++++
 asmcomp/mach.mli    |  2 ++
 3 files changed, 100 insertions(+), 1 deletion(-)

diff --git a/asmcomp/liveness.ml b/asmcomp/liveness.ml
index 5ee9d785a598..e03d51458eb5 100644
--- a/asmcomp/liveness.ml
+++ b/asmcomp/liveness.ml
@@ -30,6 +30,44 @@ let initial_env =
     last_regular_trywith_handler = Reg.Set.empty;
   }
 
+let same_env env1 env2 =
+  List.for_all2 (fun (nfail1, live_regs1) (nfail2, live_regs2) ->
+      nfail1 = nfail2 && Reg.Set.equal live_regs1 live_regs2)
+    env1.at_exit
+    env2.at_exit
+  && Reg.Set.equal env1.at_raise env2.at_raise
+  && Reg.Set.equal env1.last_regular_trywith_handler
+       env2.last_regular_trywith_handler
+
+type cache_entry =
+  { free_conts : Numbers.Int.Set.t; (* free continuation of the handler,
+                                       including delayed exception handlers *)
+    restricted_env : liveness_env;  (* last used environment,
+                                       restricted to the live conts *)
+    at_join : Reg.Set.t;            (* last used set at join *)
+    before_handler : Reg.Set.t;    (* last computed result *)
+}
+
+let fixpoint_cache : cache_entry Numbers.Int.Map.t ref =
+ ref Numbers.Int.Map.empty
+
+let reset_cache () = fixpoint_cache := Numbers.Int.Map.empty
+
+let free_conts_of_handler (_nfail, ts, instr) =
+  let module S = Numbers.Int.Set in
+  let rec add_exn_conts conts = function
+    | Uncaught -> conts
+    | Generic_trap ts -> add_exn_conts conts ts
+    | Specific_trap (nfail, ts) -> add_exn_conts (S.add nfail conts) ts
+  in
+  add_exn_conts (free_conts instr) ts
+
+let restrict_env env conts =
+  { env with at_exit =
+               List.filter (fun (n, _) -> Numbers.Int.Set.mem n conts)
+                 env.at_exit;
+  }
+
 let find_live_at_exit env k =
   try
     List.assoc k env.at_exit
@@ -113,7 +151,29 @@ let rec live env i finally =
       let aux env (nfail, ts, handler) (nfail', before_handler) =
         assert(nfail = nfail');
         let env = env_from_trap_stack env ts in
-        let before_handler' = live env handler at_join in
+        let before_handler', free_conts, restricted_env, do_update =
+          match Numbers.Int.Map.find nfail !fixpoint_cache with
+          | exception Not_found ->
+            let free_conts = free_conts_of_handler (nfail, ts, handler) in
+            let restricted_env = restrict_env env free_conts in
+            live env handler at_join, free_conts, restricted_env, true
+          | cache ->
+            let restricted_env = restrict_env env cache.free_conts in
+            if same_env restricted_env cache.restricted_env
+            && Reg.Set.equal at_join cache.at_join
+            then cache.before_handler, cache.free_conts, cache.restricted_env, false
+            else live env handler at_join, cache.free_conts, restricted_env, true
+        in
+        if do_update then begin
+          let cache_entry =
+            { free_conts;
+              restricted_env;
+              at_join;
+              before_handler = before_handler';
+            }
+          in
+          fixpoint_cache := Numbers.Int.Map.add nfail cache_entry !fixpoint_cache
+        end;
         nfail, Reg.Set.union before_handler before_handler'
       in
       let aux_equal (nfail, before_handler) (nfail', before_handler') =
@@ -168,6 +228,7 @@ let rec live env i finally =
       Reg.add_set_array env.at_raise arg
 
 let fundecl f =
+  reset_cache ();
   let initially_live = live initial_env f.fun_body Reg.Set.empty in
   (* Sanity check: only function parameters (and the Spacetime node hole
      register, if profiling) can be live at entrypoint *)
diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml
index 51ba2cffd026..591e187e322c 100644
--- a/asmcomp/mach.ml
+++ b/asmcomp/mach.ml
@@ -210,3 +210,39 @@ let operation_can_raise op =
   | Iintop (Icheckbound _) | Iintop_imm (Icheckbound _, _)
   | Ialloc _ -> true
   | _ -> false
+
+let rec free_conts i =
+  let module S = Numbers.Int.Set in
+  match i.desc with
+  | Iend -> S.empty
+  | desc ->
+    let next_conts = free_conts i.next in
+    match desc with
+    | Iend -> assert false
+    | Iop _ -> next_conts
+    | Ireturn _ -> next_conts
+    | Iifthenelse (_, then_, else_) ->
+      S.union next_conts (S.union (free_conts then_) (free_conts else_))
+    | Iswitch (_, cases) ->
+      Array.fold_left (fun conts instr -> S.union conts (free_conts instr))
+        next_conts cases
+    | Icatch (_rec_flag, handlers, body) ->
+      let conts = S.union next_conts (free_conts body) in
+      let conts =
+        List.fold_left (fun conts (_nfail, _ts, i) ->
+            S.union conts (free_conts i))
+          conts handlers
+      in
+      List.fold_left (fun conts (nfail, _ts, _i) ->
+          S.remove nfail conts)
+        conts handlers
+    | Iexit (nfail, _) -> S.add nfail next_conts
+    | Itrywith (body, kind, (_ts, handler)) ->
+      let conts =
+        S.union next_conts (S.union (free_conts body) (free_conts handler))
+      in
+      begin match kind with
+      | Regular -> conts
+      | Delayed nfail -> S.remove nfail conts
+      end
+    | Iraise _ -> next_conts
diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli
index ec4769aaa4d3..03e0a4b67cd3 100644
--- a/asmcomp/mach.mli
+++ b/asmcomp/mach.mli
@@ -147,3 +147,5 @@ val instr_iter: (instruction -> unit) -> instruction -> unit
 val spacetime_node_hole_pointer_is_live_before : instruction -> bool
 
 val operation_can_raise : operation -> bool
+
+val free_conts : instruction -> Numbers.Int.Set.t

From 69fceca0e451e51e482bf56e98f0624732c37061 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Wed, 18 Mar 2020 18:29:17 +0100
Subject: [PATCH 2/7] Avoid quadratic cases for free conts

---
 asmcomp/liveness.ml | 34 +++++++------------
 asmcomp/mach.ml     | 80 ++++++++++++++++++++++++++-------------------
 asmcomp/mach.mli    |  2 +-
 3 files changed, 60 insertions(+), 56 deletions(-)

diff --git a/asmcomp/liveness.ml b/asmcomp/liveness.ml
index e03d51458eb5..59a7dbb98b42 100644
--- a/asmcomp/liveness.ml
+++ b/asmcomp/liveness.ml
@@ -22,12 +22,14 @@ type liveness_env =
   { at_exit : (int * Reg.Set.t) list;
     at_raise : Reg.Set.t;
     last_regular_trywith_handler : Reg.Set.t;
+    free_conts_for_handlers : Numbers.Int.Set.t Numbers.Int.Map.t;
   }
 
-let initial_env =
+let initial_env fundecl =
   { at_exit = [];
     at_raise = Reg.Set.empty;
     last_regular_trywith_handler = Reg.Set.empty;
+    free_conts_for_handlers = Mach.free_conts_for_handlers fundecl;
   }
 
 let same_env env1 env2 =
@@ -40,9 +42,7 @@ let same_env env1 env2 =
        env2.last_regular_trywith_handler
 
 type cache_entry =
-  { free_conts : Numbers.Int.Set.t; (* free continuation of the handler,
-                                       including delayed exception handlers *)
-    restricted_env : liveness_env;  (* last used environment,
+  { restricted_env : liveness_env;  (* last used environment,
                                        restricted to the live conts *)
     at_join : Reg.Set.t;            (* last used set at join *)
     before_handler : Reg.Set.t;    (* last computed result *)
@@ -53,15 +53,6 @@ let fixpoint_cache : cache_entry Numbers.Int.Map.t ref =
 
 let reset_cache () = fixpoint_cache := Numbers.Int.Map.empty
 
-let free_conts_of_handler (_nfail, ts, instr) =
-  let module S = Numbers.Int.Set in
-  let rec add_exn_conts conts = function
-    | Uncaught -> conts
-    | Generic_trap ts -> add_exn_conts conts ts
-    | Specific_trap (nfail, ts) -> add_exn_conts (S.add nfail conts) ts
-  in
-  add_exn_conts (free_conts instr) ts
-
 let restrict_env env conts =
   { env with at_exit =
                List.filter (fun (n, _) -> Numbers.Int.Set.mem n conts)
@@ -151,23 +142,22 @@ let rec live env i finally =
       let aux env (nfail, ts, handler) (nfail', before_handler) =
         assert(nfail = nfail');
         let env = env_from_trap_stack env ts in
-        let before_handler', free_conts, restricted_env, do_update =
+        let free_conts = Numbers.Int.Map.find nfail env.free_conts_for_handlers in
+        let before_handler', restricted_env, do_update =
           match Numbers.Int.Map.find nfail !fixpoint_cache with
           | exception Not_found ->
-            let free_conts = free_conts_of_handler (nfail, ts, handler) in
             let restricted_env = restrict_env env free_conts in
-            live env handler at_join, free_conts, restricted_env, true
+            live env handler at_join, restricted_env, true
           | cache ->
-            let restricted_env = restrict_env env cache.free_conts in
+            let restricted_env = restrict_env env free_conts in
             if same_env restricted_env cache.restricted_env
             && Reg.Set.equal at_join cache.at_join
-            then cache.before_handler, cache.free_conts, cache.restricted_env, false
-            else live env handler at_join, cache.free_conts, restricted_env, true
+            then cache.before_handler, cache.restricted_env, false
+            else live env handler at_join, restricted_env, true
         in
         if do_update then begin
           let cache_entry =
-            { free_conts;
-              restricted_env;
+            { restricted_env;
               at_join;
               before_handler = before_handler';
             }
@@ -229,7 +219,7 @@ let rec live env i finally =
 
 let fundecl f =
   reset_cache ();
-  let initially_live = live initial_env f.fun_body Reg.Set.empty in
+  let initially_live = live (initial_env f) f.fun_body Reg.Set.empty in
   (* Sanity check: only function parameters (and the Spacetime node hole
      register, if profiling) can be live at entrypoint *)
   let wrong_live = Reg.Set.diff initially_live (Reg.set_of_array f.fun_args) in
diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml
index 591e187e322c..b0f67c880b7c 100644
--- a/asmcomp/mach.ml
+++ b/asmcomp/mach.ml
@@ -211,38 +211,52 @@ let operation_can_raise op =
   | Ialloc _ -> true
   | _ -> false
 
-let rec free_conts i =
+let free_conts_for_handlers fundecl =
   let module S = Numbers.Int.Set in
-  match i.desc with
-  | Iend -> S.empty
-  | desc ->
-    let next_conts = free_conts i.next in
-    match desc with
-    | Iend -> assert false
-    | Iop _ -> next_conts
-    | Ireturn _ -> next_conts
-    | Iifthenelse (_, then_, else_) ->
-      S.union next_conts (S.union (free_conts then_) (free_conts else_))
-    | Iswitch (_, cases) ->
-      Array.fold_left (fun conts instr -> S.union conts (free_conts instr))
-        next_conts cases
-    | Icatch (_rec_flag, handlers, body) ->
-      let conts = S.union next_conts (free_conts body) in
-      let conts =
-        List.fold_left (fun conts (_nfail, _ts, i) ->
-            S.union conts (free_conts i))
-          conts handlers
-      in
-      List.fold_left (fun conts (nfail, _ts, _i) ->
+  let module M = Numbers.Int.Map in
+  let acc = ref M.empty in
+  let rec free_conts i =
+    match i.desc with
+    | Iend -> S.empty
+    | desc ->
+      let next_conts = free_conts i.next in
+      match desc with
+      | Iend -> assert false
+      | Iop _ -> next_conts
+      | Ireturn _ -> next_conts
+      | Iifthenelse (_, then_, else_) ->
+        S.union next_conts (S.union (free_conts then_) (free_conts else_))
+      | Iswitch (_, cases) ->
+        Array.fold_left (fun conts instr -> S.union conts (free_conts instr))
+          next_conts cases
+      | Icatch (_rec_flag, handlers, body) ->
+        let conts = S.union next_conts (free_conts body) in
+        let conts =
+          List.fold_left (fun conts (nfail, ts, i) ->
+            let rec add_exn_conts conts = function
+              | Uncaught -> conts
+              | Generic_trap ts -> add_exn_conts conts ts
+              | Specific_trap (nfail, ts) -> add_exn_conts (S.add nfail conts) ts
+            in
+            let free = add_exn_conts (free_conts i) ts in
+            acc := M.add nfail free !acc;
+            S.union conts free)
+            conts handlers
+        in
+        List.fold_left (fun conts (nfail, _ts, _i) ->
           S.remove nfail conts)
-        conts handlers
-    | Iexit (nfail, _) -> S.add nfail next_conts
-    | Itrywith (body, kind, (_ts, handler)) ->
-      let conts =
-        S.union next_conts (S.union (free_conts body) (free_conts handler))
-      in
-      begin match kind with
-      | Regular -> conts
-      | Delayed nfail -> S.remove nfail conts
-      end
-    | Iraise _ -> next_conts
+          conts handlers
+      | Iexit (nfail, _) -> S.add nfail next_conts
+      | Itrywith (body, kind, (_ts, handler)) ->
+        let conts =
+          S.union next_conts (S.union (free_conts body) (free_conts handler))
+        in
+        begin match kind with
+        | Regular -> conts
+        | Delayed nfail -> S.remove nfail conts
+        end
+      | Iraise _ -> next_conts
+  in
+  let free = free_conts fundecl.fun_body in
+  assert(S.is_empty free);
+  !acc
diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli
index 03e0a4b67cd3..c9c3524cc08f 100644
--- a/asmcomp/mach.mli
+++ b/asmcomp/mach.mli
@@ -148,4 +148,4 @@ val spacetime_node_hole_pointer_is_live_before : instruction -> bool
 
 val operation_can_raise : operation -> bool
 
-val free_conts : instruction -> Numbers.Int.Set.t
+val free_conts_for_handlers : fundecl -> Numbers.Int.Set.t Numbers.Int.Map.t

From 77cfcdc9be5e360e049033d4257b3965e332c85c Mon Sep 17 00:00:00 2001
From: Vincent Laviron <vincent.laviron@gmail.com>
Date: Fri, 20 Mar 2020 10:07:51 +0100
Subject: [PATCH 3/7] Remove mutable state from spill

---
 asmcomp/spill.ml  | 343 +++++++++++++++++++++++++++++-----------------
 asmcomp/spill.mli |   1 -
 2 files changed, 215 insertions(+), 129 deletions(-)

diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml
index 0147d97ef836..eb6f7d65ddbc 100644
--- a/asmcomp/spill.ml
+++ b/asmcomp/spill.ml
@@ -33,37 +33,75 @@ open Mach
    across the instruction that haven't been used for the longest time.
    These registers will be spilled and reloaded as described above. *)
 
-(* Association of spill registers to registers *)
+type reload_env =
+  {
+    (* Association of spill registers to registers.
+       This is mostly a result of the reload pass, but
+       it is also used during reload. *)
+    spill_env : Reg.t Reg.Map.t;
+
+    (* Record the position of last use of registers.
+       This is used during reload to choose which registers to spill. *)
+    use_date : int Reg.Map.t;
+
+    (* The current date.
+       This is used during reload to set the use_date. *)
+    current_date : int;
+
+    (* A-list recording what is destroyed at if-then-else points.
+       This is computed during reload for use during spill. *)
+    destroyed_at_fork: (instruction * Reg.Set.t) list;
+
+    (* Map from continuation labels to their reload set.
+       This is internal to reload, and flows both ways:
+       - The catch construct creates empty bindings
+       - The exit constructs add their reload set to the bindings
+       - The catch construct then uses the reload sets to analyze
+         the handlers
+       In the case of recursive handlers, since the handlers can
+       update the map, a fixpoint is needed. *)
+    reload_at_exit : Reg.Set.t Numbers.Int.Map.t;
+  }
+
+let empty_reload_env =
+  { spill_env = Reg.Map.empty;
+    use_date = Reg.Map.empty;
+    current_date = 0;
+    destroyed_at_fork = [];
+    reload_at_exit = Numbers.Int.Map.empty;
+  }
 
-let spill_env = ref (Reg.Map.empty : Reg.t Reg.Map.t)
+let _spill_env = ref (Reg.Map.empty : Reg.t Reg.Map.t)
 
-let spill_reg r =
+let spill_reg env r =
   try
-    Reg.Map.find r !spill_env
+    env, Reg.Map.find r env.spill_env
   with Not_found ->
     let spill_r = Reg.create r.typ in
     spill_r.spill <- true;
     if not (Reg.anonymous r) then spill_r.raw_name <- r.raw_name;
-    spill_env := Reg.Map.add r spill_r !spill_env;
+    { env with spill_env = Reg.Map.add r spill_r env.spill_env; },
     spill_r
 
-(* Record the position of last use of registers *)
 
-let use_date = ref (Reg.Map.empty : int Reg.Map.t)
-let current_date = ref 0
+let _use_date = ref (Reg.Map.empty : int Reg.Map.t)
+let _current_date = ref 0
 
-let record_use regv =
-  for i = 0 to Array.length regv - 1 do
-    let r = regv.(i) in
-    let prev_date = try Reg.Map.find r !use_date with Not_found -> 0 in
-    if !current_date > prev_date then
-      use_date := Reg.Map.add r !current_date !use_date
-  done
+let record_use env regv =
+  let use_date = Array.fold_left (fun use_date r ->
+      let prev_date = try Reg.Map.find r use_date with Not_found -> 0 in
+      if env.current_date > prev_date then
+        Reg.Map.add r env.current_date use_date
+      else
+        use_date)
+    env.use_date regv
+  in
+  { env with use_date; }
 
 (* Check if the register pressure overflows the maximum pressure allowed
    at that point. If so, spill enough registers to lower the pressure. *)
 
-let add_superpressure_regs op live_regs res_regs spilled =
+let add_superpressure_regs env op live_regs res_regs spilled =
   let max_pressure = Proc.max_register_pressure op in
   let regs = Reg.add_set_array live_regs res_regs in
   (* Compute the pressure in each register class *)
@@ -94,7 +132,7 @@ let add_superpressure_regs op live_regs res_regs spilled =
              r.loc = Unknown
           then begin
             try
-              let d = Reg.Map.find r !use_date in
+              let d = Reg.Map.find r env.use_date in
               if d < !lru_date then begin
                 lru_date := d;
                 lru_reg := r
@@ -114,40 +152,47 @@ let add_superpressure_regs op live_regs res_regs spilled =
 
 (* A-list recording what is destroyed at if-then-else points. *)
 
-let destroyed_at_fork = ref ([] : (instruction * Reg.Set.t) list)
+let _destroyed_at_fork = ref ([] : (instruction * Reg.Set.t) list)
 
 (* First pass: insert reload instructions based on an approximation of
    what is destroyed at pressure points. *)
 
-let add_reloads regset i =
+let add_reloads env regset i =
   Reg.Set.fold
-    (fun r i -> instr_cons (Iop Ireload) [|spill_reg r|] [|r|] i)
-    regset i
+    (fun r (env, i) ->
+       let env, r' = spill_reg env r in
+       env,
+       instr_cons (Iop Ireload) [|r'|] [|r|] i)
+    regset (env, i)
 
-let reload_at_exit = ref []
+let _reload_at_exit = ref []
 
-let find_reload_at_exit k =
+let find_reload_at_exit env k =
   try
-    List.assoc k !reload_at_exit
+    Numbers.Int.Map.find k env.reload_at_exit
   with
   | Not_found -> Misc.fatal_error "Spill.find_reload_at_exit"
 
-let rec reload i before =
-  incr current_date;
-  record_use i.arg;
-  record_use i.res;
+let rec reload env i before =
+  let env = { env with current_date = succ env.current_date; } in
+  let env = record_use env i.arg in
+  let env = record_use env i.res in
   match i.desc with
     Iend ->
-      (i, before)
+      (i, before, env)
   | Ireturn _ | Iop(Itailcall_ind _) | Iop(Itailcall_imm _) ->
-      (add_reloads (Reg.inter_set_array before i.arg) i,
-       Reg.Set.empty)
+      let env, i =
+        add_reloads env (Reg.inter_set_array before i.arg) i
+      in
+       (i, Reg.Set.empty, env)
   | Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; }) ->
       (* All regs live across must be spilled *)
-      let (new_next, finally) = reload i.next i.live in
-      (add_reloads (Reg.inter_set_array before i.arg)
-                   (instr_cons_debug i.desc i.arg i.res i.dbg new_next),
-       finally)
+      let (new_next, finally, env) = reload env i.next i.live in
+      let env, i =
+        add_reloads env (Reg.inter_set_array before i.arg)
+          (instr_cons_debug i.desc i.arg i.res i.dbg new_next)
+      in
+       (i, finally, env)
   | Iop op ->
       let new_before =
         (* Quick check to see if the register pressure is below the maximum *)
@@ -155,104 +200,140 @@ let rec reload i before =
            (Reg.Set.cardinal i.live + Array.length i.res <=
             Proc.safe_register_pressure op)
         then before
-        else add_superpressure_regs op i.live i.res before in
+        else add_superpressure_regs env op i.live i.res before in
       let after =
         Reg.diff_set_array (Reg.diff_set_array new_before i.arg) i.res in
-      let (new_next, finally) = reload i.next after in
-      (add_reloads (Reg.inter_set_array new_before i.arg)
-                   (instr_cons_debug i.desc i.arg i.res i.dbg new_next),
-       finally)
+      let (new_next, finally, env) = reload env i.next after in
+      let env, i =
+        add_reloads env (Reg.inter_set_array new_before i.arg)
+          (instr_cons_debug i.desc i.arg i.res i.dbg new_next)
+      in
+      (i, finally, env)
   | Iifthenelse(test, ifso, ifnot) ->
       let at_fork = Reg.diff_set_array before i.arg in
-      let date_fork = !current_date in
-      let (new_ifso, after_ifso) = reload ifso at_fork in
-      let date_ifso = !current_date in
-      current_date := date_fork;
-      let (new_ifnot, after_ifnot) = reload ifnot at_fork in
-      current_date := max date_ifso !current_date;
-      let (new_next, finally) =
-        reload i.next (Reg.Set.union after_ifso after_ifnot) in
+      let (new_ifso, after_ifso, env_ifso) = reload env ifso at_fork in
+      let env =
+        { env_ifso with current_date = env.current_date; }
+      in
+      let (new_ifnot, after_ifnot, env_ifnot) = reload env ifnot at_fork in
+      let env =
+        { env_ifnot with current_date =
+                     max env_ifso.current_date env_ifnot.current_date;
+        }
+      in
+      let (new_next, finally, env) =
+        reload env i.next (Reg.Set.union after_ifso after_ifnot) in
       let new_i =
         instr_cons (Iifthenelse(test, new_ifso, new_ifnot))
         i.arg i.res new_next in
-      destroyed_at_fork := (new_i, at_fork) :: !destroyed_at_fork;
-      (add_reloads (Reg.inter_set_array before i.arg) new_i,
-       finally)
+      let env =
+        { env with destroyed_at_fork =
+                     (new_i, at_fork) :: env.destroyed_at_fork;
+        }
+      in
+      let env, i =
+        add_reloads env (Reg.inter_set_array before i.arg) new_i
+      in
+      (i, finally, env)
   | Iswitch(index, cases) ->
       let at_fork = Reg.diff_set_array before i.arg in
-      let date_fork = !current_date in
-      let date_join = ref 0 in
-      let after_cases = ref Reg.Set.empty in
+      let date_fork = env.current_date in
+      let new_cases_list, env, after_cases =
+        Array.fold_left (fun (new_cases_list, env, after_cases) c ->
+            let date_join = env.current_date in
+            let env = { env with current_date = date_fork; } in
+            let (new_c, after_c, env_c) = reload env c at_fork in
+            let env =
+              { env_c with current_date = max date_join env_c.current_date; }
+            in
+            (new_c :: new_cases_list, env, Reg.Set.union after_cases after_c))
+          ([], env, Reg.Set.empty) cases
+      in
       let new_cases =
-        Array.map
-          (fun c ->
-            current_date := date_fork;
-            let (new_c, after_c) = reload c at_fork in
-            after_cases := Reg.Set.union !after_cases after_c;
-            date_join := max !date_join !current_date;
-            new_c)
-          cases in
-      current_date := !date_join;
-      let (new_next, finally) = reload i.next !after_cases in
-      (add_reloads (Reg.inter_set_array before i.arg)
-                   (instr_cons (Iswitch(index, new_cases))
-                               i.arg i.res new_next),
-       finally)
+        Array.of_list (List.rev new_cases_list)
+      in
+      let (new_next, finally, env) = reload env i.next after_cases in
+      let env, i =
+        add_reloads env (Reg.inter_set_array before i.arg)
+          (instr_cons (Iswitch(index, new_cases))
+             i.arg i.res new_next)
+      in
+      (i, finally, env)
   | Icatch(rec_flag, handlers, body) ->
-      let new_sets = List.map
-          (fun (nfail, _, _) -> nfail, ref Reg.Set.empty) handlers in
-      let previous_reload_at_exit = !reload_at_exit in
-      reload_at_exit := new_sets @ !reload_at_exit ;
-      let (new_body, after_body) = reload body before in
-      let rec fixpoint () =
-        let at_exits = List.map (fun (nfail, set) -> (nfail, !set)) new_sets in
-        let res =
-          List.map2 (fun (nfail', _ts, handler) (nfail, at_exit) ->
-              assert(nfail = nfail');
-              reload handler at_exit) handlers at_exits in
+      let reload_at_exit = List.fold_left
+          (fun reload_at_exit (nfail, _, _) ->
+            Numbers.Int.Map.add nfail Reg.Set.empty reload_at_exit)
+          env.reload_at_exit
+          handlers
+      in
+      let env = { env with reload_at_exit; } in
+      let (new_body, after_body, env) = reload env body before in
+      let rec fixpoint env_fix =
+        let new_handlers, after_union, env =
+          List.fold_right
+            (fun (nfail, ts, handler) (handlers, after_union, env) ->
+               let handler, after_handler, env =
+                 reload env handler (find_reload_at_exit env nfail)
+               in
+               ((nfail, ts, handler) :: handlers,
+                Reg.Set.union after_union after_handler,
+                env))
+            handlers ([], after_body, env_fix)
+        in
         match rec_flag with
         | Cmm.Nonrecursive ->
-            res
+            new_handlers, after_union, env
         | Cmm.Recursive ->
-            let equal = List.for_all2 (fun (nfail', at_exit) (nfail, new_set) ->
-                assert(nfail = nfail');
-                Reg.Set.equal at_exit !new_set)
-                at_exits new_sets in
+            let equal =
+              List.for_all (fun (nfail, _ts, _handler) ->
+                Reg.Set.equal
+                  (find_reload_at_exit env_fix nfail)
+                  (find_reload_at_exit env nfail))
+                handlers
+            in
             if equal
-            then res
-            else fixpoint ()
+            then new_handlers, after_union, env
+            else fixpoint env
       in
-      let res = fixpoint () in
-      reload_at_exit := previous_reload_at_exit;
-      let union = List.fold_left
-          (fun acc (_, after_handler) -> Reg.Set.union acc after_handler)
-          after_body res in
-      let (new_next, finally) = reload i.next union in
-      let new_handlers = List.map2
-          (fun (nfail, ts, _) (new_handler, _) -> nfail, ts, new_handler)
-          handlers res in
+      let new_handlers, after_union, env = fixpoint env in
+      let reload_at_exit =
+        List.fold_left (fun reload_at_exit (nfail, _, _) ->
+            Numbers.Int.Map.remove nfail reload_at_exit)
+          env.reload_at_exit handlers
+      in
+      let env = { env with reload_at_exit; } in
+      let (new_next, finally, env) = reload env i.next after_union in
       (instr_cons
          (Icatch(rec_flag, new_handlers, new_body)) i.arg i.res new_next,
-       finally)
+       finally,
+       env)
   | Iexit (nfail, _traps) ->
-      let set = find_reload_at_exit nfail in
-      set := Reg.Set.union !set before;
-      (i, Reg.Set.empty)
+      let set = find_reload_at_exit env nfail in
+      let env =
+        { env with reload_at_exit =
+                     Numbers.Int.Map.add nfail (Reg.Set.union set before)
+                       env.reload_at_exit;
+        }
+      in
+      (i, Reg.Set.empty, env)
   | Itrywith(body, kind, (ts, handler)) ->
-      let (new_body, after_body) = reload body before in
+      let (new_body, after_body, env) = reload env body before in
       (* All registers live at the beginning of the handler are destroyed,
          except the exception bucket *)
       let before_handler =
         Reg.Set.remove Proc.loc_exn_bucket
                        (Reg.add_set_array handler.live handler.arg) in
-      let (new_handler, after_handler) = reload handler before_handler in
-      let (new_next, finally) =
-        reload i.next (Reg.Set.union after_body after_handler) in
-      (instr_cons (Itrywith(new_body, kind, (ts, new_handler)))
-         i.arg i.res new_next,
-       finally)
+      let (new_handler, after_handler, env) =
+        reload env handler before_handler
+      in
+      let (new_next, finally, env) =
+        reload env i.next (Reg.Set.union after_body after_handler) in
+      (instr_cons (Itrywith(new_body, kind, (ts, new_handler))) i.arg i.res new_next,
+       finally,
+       env)
   | Iraise _ ->
-      (add_reloads (Reg.inter_set_array before i.arg) i, Reg.Set.empty)
+      let env, i = add_reloads env (Reg.inter_set_array before i.arg) i in
+      (i, Reg.Set.empty, env)
 
 (* Second pass: add spill instructions based on what we've decided to reload.
    That is, any register that may be reloaded in the future must be spilled
@@ -276,20 +357,29 @@ type spill_env =
   { at_exit : (int * (bool ref * Reg.Set.t)) list;
     at_raise : Reg.Set.t;
     last_regular_trywith_handler : Reg.Set.t;
+    spill_env : Reg.t Reg.Map.t;
+    destroyed_at_fork : (instruction * Reg.Set.t) list;
     loop : bool;
     arm : bool;
     catch : bool;
   }
 
-let initial_env =
+let initial_env (reload_env : reload_env) =
   { at_exit = [];
     at_raise = Reg.Set.empty;
     last_regular_trywith_handler = Reg.Set.empty;
+    spill_env = reload_env.spill_env;
+    destroyed_at_fork = reload_env.destroyed_at_fork;
     loop = false;
     arm = false;
     catch = false;
   }
 
+let spill_reg_no_add (env : spill_env) r =
+  try Reg.Map.find r env.spill_env
+  with Not_found ->
+    Misc.fatal_errorf "Spill: Register %s unknown" (Reg.name r)
+
 let find_spill_at_exit env k =
   try
     let used, set = List.assoc k env.at_exit in
@@ -304,9 +394,9 @@ let at_raise_from_trap_stack env ts =
   | Generic_trap _ -> env.last_regular_trywith_handler
   | Specific_trap (nfail, _) -> find_spill_at_exit env nfail
 
-let add_spills regset i =
+let add_spills env regset i =
   Reg.Set.fold
-    (fun r i -> instr_cons (Iop Ispill) [|r|] [|spill_reg r|] i)
+    (fun r i -> instr_cons (Iop Ispill) [|r|] [|spill_reg_no_add env r|] i)
     regset i
 
 let rec spill env i finally =
@@ -331,7 +421,7 @@ let rec spill env i finally =
         | _ ->
             before1 in
       (instr_cons_debug i.desc i.arg i.res i.dbg
-                  (add_spills (Reg.inter_set_array after i.res) new_next),
+                  (add_spills env (Reg.inter_set_array after i.res) new_next),
        before)
   | Iifthenelse(test, ifso, ifnot) ->
       let (new_next, at_join) = spill env i.next finally in
@@ -344,14 +434,18 @@ let rec spill env i finally =
                      i.arg i.res new_next,
          Reg.Set.union before_ifso before_ifnot)
       else begin
-        let destroyed = List.assq i !destroyed_at_fork in
+        let destroyed = List.assq i env.destroyed_at_fork in
         let spill_ifso_branch =
           Reg.Set.diff (Reg.Set.diff before_ifso before_ifnot) destroyed
         and spill_ifnot_branch =
           Reg.Set.diff (Reg.Set.diff before_ifnot before_ifso) destroyed in
+        Format.eprintf "Destroyed_at_fork: %a@.before_ifso: %a@. before_ifnot: %a@.@."
+          Printmach.regset destroyed
+          Printmach.regset before_ifso
+          Printmach.regset before_ifnot;
         (instr_cons
-            (Iifthenelse(test, add_spills spill_ifso_branch new_ifso,
-                               add_spills spill_ifnot_branch new_ifnot))
+            (Iifthenelse(test, add_spills env spill_ifso_branch new_ifso,
+                               add_spills env spill_ifnot_branch new_ifnot))
             i.arg i.res new_next,
          Reg.Set.diff (Reg.Set.diff (Reg.Set.union before_ifso before_ifnot)
                                     spill_ifso_branch)
@@ -442,22 +536,15 @@ let rec spill env i finally =
 
 (* Entry point *)
 
-let reset () =
-  spill_env := Reg.Map.empty;
-  use_date := Reg.Map.empty;
-  current_date := 0;
-  destroyed_at_fork := []
-
 let fundecl f =
-  reset ();
-
-  let (body1, _) = reload f.fun_body Reg.Set.empty in
-  let (body2, tospill_at_entry) = spill initial_env body1 Reg.Set.empty in
+  let (body1, _, reload_env) =
+    reload empty_reload_env f.fun_body Reg.Set.empty
+  in
+  let spill_env = initial_env reload_env in
+  let (body2, tospill_at_entry) = spill spill_env body1 Reg.Set.empty in
   let new_body =
-    add_spills (Reg.inter_set_array tospill_at_entry f.fun_args) body2 in
-  spill_env := Reg.Map.empty;
-  use_date := Reg.Map.empty;
-  destroyed_at_fork := [];
+    add_spills spill_env (Reg.inter_set_array tospill_at_entry f.fun_args) body2
+  in
   { fun_name = f.fun_name;
     fun_args = f.fun_args;
     fun_body = new_body;
diff --git a/asmcomp/spill.mli b/asmcomp/spill.mli
index cb1917e45c28..c508f660be5d 100644
--- a/asmcomp/spill.mli
+++ b/asmcomp/spill.mli
@@ -17,4 +17,3 @@
    before register allocation. *)
 
 val fundecl: Mach.fundecl -> Mach.fundecl
-val reset : unit -> unit

From 58c95a744f8004a18c6f19c8019d7fdcb644710a Mon Sep 17 00:00:00 2001
From: Vincent Laviron <vincent.laviron@gmail.com>
Date: Fri, 20 Mar 2020 10:26:29 +0100
Subject: [PATCH 4/7] Remove leftover debug

---
 asmcomp/spill.ml | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml
index eb6f7d65ddbc..1868bda857d6 100644
--- a/asmcomp/spill.ml
+++ b/asmcomp/spill.ml
@@ -439,10 +439,6 @@ let rec spill env i finally =
           Reg.Set.diff (Reg.Set.diff before_ifso before_ifnot) destroyed
         and spill_ifnot_branch =
           Reg.Set.diff (Reg.Set.diff before_ifnot before_ifso) destroyed in
-        Format.eprintf "Destroyed_at_fork: %a@.before_ifso: %a@. before_ifnot: %a@.@."
-          Printmach.regset destroyed
-          Printmach.regset before_ifso
-          Printmach.regset before_ifnot;
         (instr_cons
             (Iifthenelse(test, add_spills env spill_ifso_branch new_ifso,
                                add_spills env spill_ifnot_branch new_ifnot))

From 5aa3a068d1cca6e4bb5396d129f53dd5d8a6d97f Mon Sep 17 00:00:00 2001
From: Vincent Laviron <vincent.laviron@gmail.com>
Date: Fri, 20 Mar 2020 10:52:56 +0100
Subject: [PATCH 5/7] Use cache for reload

---
 asmcomp/spill.ml | 65 +++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 51 insertions(+), 14 deletions(-)

diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml
index 1868bda857d6..df09b81fee02 100644
--- a/asmcomp/spill.ml
+++ b/asmcomp/spill.ml
@@ -61,17 +61,39 @@ type reload_env =
        In the case of recursive handlers, since the handlers can
        update the map, a fixpoint is needed. *)
     reload_at_exit : Reg.Set.t Numbers.Int.Map.t;
+
+    free_conts_for_handlers : Numbers.Int.Set.t Numbers.Int.Map.t;
   }
 
-let empty_reload_env =
+let initial_reload_env fundecl =
   { spill_env = Reg.Map.empty;
     use_date = Reg.Map.empty;
     current_date = 0;
     destroyed_at_fork = [];
     reload_at_exit = Numbers.Int.Map.empty;
+    free_conts_for_handlers = Mach.free_conts_for_handlers fundecl;
+  }
+
+type reload_cache_entry =
+  { at_exit_restricted : Reg.Set.t Numbers.Int.Map.t; (* last seen inputs *)
+    result : instruction * Reg.Set.t; (* last computed result *)
   }
 
-let _spill_env = ref (Reg.Map.empty : Reg.t Reg.Map.t)
+let reload_cache : reload_cache_entry Numbers.Int.Map.t ref =
+  ref Numbers.Int.Map.empty
+
+let cache_reload_result nfail env handler after_handler =
+  let at_exit_restricted =
+    Numbers.Int.Map.filter (fun n _at_exit ->
+        Numbers.Int.Set.mem n
+          (Numbers.Int.Map.find nfail env.free_conts_for_handlers))
+      env.reload_at_exit
+  in
+  let entry = { at_exit_restricted; result = (handler, after_handler); } in
+  reload_cache := Numbers.Int.Map.add nfail entry !reload_cache
+
+let reset_cache () =
+  reload_cache := Numbers.Int.Map.empty
 
 let spill_reg env r =
   try
@@ -83,10 +105,6 @@ let spill_reg env r =
     { env with spill_env = Reg.Map.add r spill_r env.spill_env; },
     spill_r
 
-
-let _use_date = ref (Reg.Map.empty : int Reg.Map.t)
-let _current_date = ref 0
-
 let record_use env regv =
   let use_date = Array.fold_left (fun use_date r ->
       let prev_date = try Reg.Map.find r use_date with Not_found -> 0 in
@@ -150,10 +168,6 @@ let add_superpressure_regs env op live_regs res_regs spilled =
     end in
   check_pressure 0 spilled
 
-(* A-list recording what is destroyed at if-then-else points. *)
-
-let _destroyed_at_fork = ref ([] : (instruction * Reg.Set.t) list)
-
 (* First pass: insert reload instructions based on an approximation of
    what is destroyed at pressure points. *)
 
@@ -165,14 +179,24 @@ let add_reloads env regset i =
        instr_cons (Iop Ireload) [|r'|] [|r|] i)
     regset (env, i)
 
-let _reload_at_exit = ref []
-
 let find_reload_at_exit env k =
   try
     Numbers.Int.Map.find k env.reload_at_exit
   with
   | Not_found -> Misc.fatal_error "Spill.find_reload_at_exit"
 
+let find_in_cache nfail env =
+  try
+    let { at_exit_restricted; result; } =
+      Numbers.Int.Map.find nfail !reload_cache
+    in
+    if Numbers.Int.Map.for_all (fun n at_exit ->
+        Reg.Set.equal at_exit (find_reload_at_exit env n))
+      at_exit_restricted
+    then Some result
+    else None
+  with Not_found -> None
+
 let rec reload env i before =
   let env = { env with current_date = succ env.current_date; } in
   let env = record_use env i.arg in
@@ -273,7 +297,15 @@ let rec reload env i before =
           List.fold_right
             (fun (nfail, ts, handler) (handlers, after_union, env) ->
                let handler, after_handler, env =
-                 reload env handler (find_reload_at_exit env nfail)
+                 match find_in_cache nfail env with
+                 | None ->
+                   let handler, after_handler, env =
+                     reload env handler (find_reload_at_exit env nfail)
+                   in
+                   cache_reload_result nfail env handler after_handler;
+                   handler, after_handler, env
+                 | Some (handler, after_handler) ->
+                   handler, after_handler, env
                in
                ((nfail, ts, handler) :: handlers,
                 Reg.Set.union after_union after_handler,
@@ -533,14 +565,19 @@ let rec spill env i finally =
 (* Entry point *)
 
 let fundecl f =
+  reset_cache ();
+  Printf.eprintf "Starting reload...%!";
   let (body1, _, reload_env) =
-    reload empty_reload_env f.fun_body Reg.Set.empty
+    reload (initial_reload_env f) f.fun_body Reg.Set.empty
   in
+  Printf.eprintf "done\n%!";
   let spill_env = initial_env reload_env in
+  Printf.eprintf "Starting spill...%!";
   let (body2, tospill_at_entry) = spill spill_env body1 Reg.Set.empty in
   let new_body =
     add_spills spill_env (Reg.inter_set_array tospill_at_entry f.fun_args) body2
   in
+  Printf.eprintf "done\n%!";
   { fun_name = f.fun_name;
     fun_args = f.fun_args;
     fun_body = new_body;

From aed61acbfa609fefd6d3e7abd5cefd648608f80a Mon Sep 17 00:00:00 2001
From: Vincent Laviron <vincent.laviron@gmail.com>
Date: Fri, 20 Mar 2020 10:59:02 +0100
Subject: [PATCH 6/7] Remove useless reference in spill

---
 asmcomp/spill.ml | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml
index df09b81fee02..70e7fbc4160e 100644
--- a/asmcomp/spill.ml
+++ b/asmcomp/spill.ml
@@ -386,7 +386,7 @@ let rec reload env i before =
    with Icatch. *)
 
 type spill_env =
-  { at_exit : (int * (bool ref * Reg.Set.t)) list;
+  { at_exit : (int * Reg.Set.t) list;
     at_raise : Reg.Set.t;
     last_regular_trywith_handler : Reg.Set.t;
     spill_env : Reg.t Reg.Map.t;
@@ -414,9 +414,7 @@ let spill_reg_no_add (env : spill_env) r =
 
 let find_spill_at_exit env k =
   try
-    let used, set = List.assoc k env.at_exit in
-    used := true;
-    set
+    List.assoc k env.at_exit
   with
   | Not_found -> Misc.fatal_error "Spill.find_spill_at_exit"
 
@@ -495,7 +493,7 @@ let rec spill env i finally =
   | Icatch(rec_flag, handlers, body) ->
       let (new_next, at_join) = spill env i.next finally in
       let spill_at_exit_add at_exits = List.map2
-          (fun (nfail,_,_) at_exit -> nfail, (ref false, at_exit))
+          (fun (nfail,_,_) at_exit -> nfail, at_exit)
           handlers at_exits
       in
       let rec fixpoint at_exits =
@@ -519,8 +517,8 @@ let rec spill env i finally =
         | Cmm.Recursive ->
             let equal =
               List.for_all2
-                (fun (_new_handler, new_at_exit) (_, (used, at_exit)) ->
-                   Reg.Set.equal at_exit new_at_exit || not !used)
+                (fun (_new_handler, new_at_exit) (_, at_exit) ->
+                   Reg.Set.equal at_exit new_at_exit)
                 res spill_at_exit_add in
             if equal
             then res
@@ -552,7 +550,7 @@ let rec spill env i finally =
             }
         | Delayed nfail ->
             { env with at_exit =
-                         (nfail, (ref false, before_handler)) :: env.at_exit;
+                         (nfail, before_handler) :: env.at_exit;
             }
       in
       let (new_body, before_body) = spill env_body body at_join in

From 7d475819d0f622a13c5ac0c5e1066637429258ee Mon Sep 17 00:00:00 2001
From: Vincent Laviron <vincent.laviron@gmail.com>
Date: Fri, 20 Mar 2020 11:28:59 +0100
Subject: [PATCH 7/7] Add cache for spill

---
 asmcomp/spill.ml | 49 ++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 41 insertions(+), 8 deletions(-)

diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml
index 70e7fbc4160e..00931ca141e7 100644
--- a/asmcomp/spill.ml
+++ b/asmcomp/spill.ml
@@ -185,7 +185,7 @@ let find_reload_at_exit env k =
   with
   | Not_found -> Misc.fatal_error "Spill.find_reload_at_exit"
 
-let find_in_cache nfail env =
+let find_in_reload_cache nfail env =
   try
     let { at_exit_restricted; result; } =
       Numbers.Int.Map.find nfail !reload_cache
@@ -297,7 +297,7 @@ let rec reload env i before =
           List.fold_right
             (fun (nfail, ts, handler) (handlers, after_union, env) ->
                let handler, after_handler, env =
-                 match find_in_cache nfail env with
+                 match find_in_reload_cache nfail env with
                  | None ->
                    let handler, after_handler, env =
                      reload env handler (find_reload_at_exit env nfail)
@@ -394,6 +394,7 @@ type spill_env =
     loop : bool;
     arm : bool;
     catch : bool;
+    free_conts_for_handlers : Numbers.Int.Set.t Numbers.Int.Map.t;
   }
 
 let initial_env (reload_env : reload_env) =
@@ -402,11 +403,30 @@ let initial_env (reload_env : reload_env) =
     last_regular_trywith_handler = Reg.Set.empty;
     spill_env = reload_env.spill_env;
     destroyed_at_fork = reload_env.destroyed_at_fork;
+    free_conts_for_handlers = reload_env.free_conts_for_handlers;
     loop = false;
     arm = false;
     catch = false;
   }
 
+type spill_cache_entry =
+  { at_exit_restricted : (int * Reg.Set.t) list;
+    result : (instruction * Reg.Set.t);
+  }
+
+let spill_cache : spill_cache_entry Numbers.Int.Map.t ref =
+  ref Numbers.Int.Map.empty
+
+let cache_spill_result nfail env handler before_handler =
+  let at_exit_restricted =
+    List.filter (fun (n, _at_exit) ->
+        Numbers.Int.Set.mem n
+          (Numbers.Int.Map.find nfail env.free_conts_for_handlers))
+      env.at_exit
+  in
+  let entry = { at_exit_restricted; result = (handler, before_handler); } in
+  spill_cache := Numbers.Int.Map.add nfail entry !spill_cache
+
 let spill_reg_no_add (env : spill_env) r =
   try Reg.Map.find r env.spill_env
   with Not_found ->
@@ -424,6 +444,18 @@ let at_raise_from_trap_stack env ts =
   | Generic_trap _ -> env.last_regular_trywith_handler
   | Specific_trap (nfail, _) -> find_spill_at_exit env nfail
 
+let find_in_spill_cache nfail env =
+  try
+    let { at_exit_restricted; result; } =
+      Numbers.Int.Map.find nfail !spill_cache
+    in
+    if List.for_all (fun (n, at_exit) ->
+        Reg.Set.equal at_exit (find_spill_at_exit env n))
+      at_exit_restricted
+    then Some result
+    else None
+  with Not_found -> None
+
 let add_spills env regset i =
   Reg.Set.fold
     (fun r i -> instr_cons (Iop Ispill) [|r|] [|spill_reg_no_add env r|] i)
@@ -501,14 +533,19 @@ let rec spill env i finally =
         let new_at_exit = spill_at_exit_add @ env.at_exit in
         let res =
           List.map
-            (fun (_, ts, handler) ->
+            (fun (nfail, ts, handler) ->
                let env =
                  { env with at_exit = new_at_exit;
                             at_raise = at_raise_from_trap_stack env ts;
                             catch = true;
                  }
                in
-               spill env handler at_join)
+               match find_in_spill_cache nfail env with
+               | None ->
+                 let (handler, before_handler) = spill env handler at_join in
+                 cache_spill_result nfail env handler before_handler;
+                 handler, before_handler
+               | Some result -> result)
             handlers
         in
         match rec_flag with
@@ -564,18 +601,14 @@ let rec spill env i finally =
 
 let fundecl f =
   reset_cache ();
-  Printf.eprintf "Starting reload...%!";
   let (body1, _, reload_env) =
     reload (initial_reload_env f) f.fun_body Reg.Set.empty
   in
-  Printf.eprintf "done\n%!";
   let spill_env = initial_env reload_env in
-  Printf.eprintf "Starting spill...%!";
   let (body2, tospill_at_entry) = spill spill_env body1 Reg.Set.empty in
   let new_body =
     add_spills spill_env (Reg.inter_set_array tospill_at_entry f.fun_args) body2
   in
-  Printf.eprintf "done\n%!";
   { fun_name = f.fun_name;
     fun_args = f.fun_args;
     fun_body = new_body;