Add -dranges command-line flag and remove DEBUG_RANGES env var test (#1742)

Author: mshinwell

backend/debug/compute_ranges.ml

@@ -15,11 +15,6 @@
 open! Int_replace_polymorphic_compare
 module L = Linear
 
-let debug =
-  match Sys.getenv "DEBUG_RANGES" with
-  | exception Not_found -> false
-  | _ -> true
-
 module Make (S : Compute_ranges_intf.S_functor) = struct
   module Subrange_state = S.Subrange_state
   module Subrange_info = S.Subrange_info
@@ -301,12 +296,12 @@ module Make (S : Compute_ranges_intf.S_functor) = struct
       ~(prev_insn : L.instruction option) ~known_available_after_prev_insn =
     let available_before = S.available_before insn in
     let available_across = S.available_across insn in
-    if debug
+    if !Flambda_backend_flags.dranges
     then
       Format.eprintf "canonicalised available_before:@ %a\n"
         (Misc.Stdlib.Option.print KS.print)
         available_before;
-    if debug
+    if !Flambda_backend_flags.dranges
     then
       Format.eprintf "canonicalised available_across:@ %a\n"
         (Misc.Stdlib.Option.print KS.print)
@@ -324,7 +319,7 @@ module Make (S : Compute_ranges_intf.S_functor) = struct
       ~fun_num_stack_slots ~(first_insn : L.instruction) ~(insn : L.instruction)
       ~(prev_insn : L.instruction option) ~currently_open_subranges
       ~subrange_state =
-    if debug
+    if !Flambda_backend_flags.dranges
     then Format.eprintf "process_instruction:@ %a\n" Printlinear.instr insn;
     let used_label = ref None in
     let get_label () =
@@ -354,12 +349,13 @@ module Make (S : Compute_ranges_intf.S_functor) = struct
       then Misc.fatal_errorf "Key %a already has an open range" S.Key.print key;
       (* If the range is later discarded, the inserted label may actually be
          useless, but this doesn't matter. It does not generate any code. *)
-      if debug then Format.eprintf "opening subrange for %a\n%!" S.Key.print key;
+      if !Flambda_backend_flags.dranges
+      then Format.eprintf "opening subrange for %a\n%!" S.Key.print key;
       let label, label_insn = get_label () in
       KM.add key (label, start_pos_offset, label_insn) currently_open_subranges
     in
     let close_subrange key ~end_pos_offset ~currently_open_subranges =
-      if debug
+      if !Flambda_backend_flags.dranges
       then Format.eprintf "closing subrange for key %a\n" S.Key.print key;
       match KM.find key currently_open_subranges with
       | exception Not_found ->
@@ -412,12 +408,14 @@ module Make (S : Compute_ranges_intf.S_functor) = struct
     in
     (* Apply actions *)
     let no_actions = List.compare_length_with actions 0 = 0 in
-    if debug && no_actions then Format.eprintf "no actions to apply\n%!";
-    if debug && not no_actions then Format.eprintf "applying actions:\n%!";
+    if !Flambda_backend_flags.dranges && no_actions
+    then Format.eprintf "no actions to apply\n%!";
+    if !Flambda_backend_flags.dranges && not no_actions
+    then Format.eprintf "applying actions:\n%!";
     let currently_open_subranges =
       List.fold_left
         (fun currently_open_subranges (key, (action : action)) ->
-          if debug
+          if !Flambda_backend_flags.dranges
           then
             Format.eprintf "  --> action for key %a: %a\n" S.Key.print key
               print_action action;
@@ -437,13 +435,14 @@ module Make (S : Compute_ranges_intf.S_functor) = struct
             close_subrange key ~end_pos_offset:1 ~currently_open_subranges)
         currently_open_subranges actions
     in
-    if debug && not no_actions
+    if !Flambda_backend_flags.dranges && not no_actions
     then Format.eprintf "finished applying actions.\n%!";
     (* Close all subranges if at last instruction *)
     let currently_open_subranges =
       match insn.desc with
       | Lend ->
-        if debug then Format.eprintf "closing subranges for last insn\n%!";
+        if !Flambda_backend_flags.dranges
+        then Format.eprintf "closing subranges for last insn\n%!";
         let currently_open_subranges =
           KM.fold
             (fun key _ currently_open_subranges ->
@@ -521,7 +520,8 @@ module Make (S : Compute_ranges_intf.S_functor) = struct
   let empty = { ranges = S.Index.Tbl.create 1 }
 
   let create (fundecl : L.fundecl) =
-    if debug then Format.eprintf "Compute_ranges for %s\n" fundecl.fun_name;
+    if !Flambda_backend_flags.dranges
+    then Format.eprintf "Compute_ranges for %s\n" fundecl.fun_name;
     let t = { ranges = S.Index.Tbl.create 42 } in
     let first_insn =
       process_instructions t fundecl

driver/flambda_backend_args.ml

@@ -130,6 +130,9 @@ let mk_dump_inlining_paths f =
 let mk_davail f =
   "-davail", Arg.Unit f, " Dump register availability information"
 
+let mk_dranges f =
+  "-dranges", Arg.Unit f, " Dump results of Compute_ranges"
+
 let mk_ddebug_invariants f =
   "-ddebug-invariants", Arg.Unit f, " Run invariant checks during generation of debugging information"
 
@@ -551,6 +554,7 @@ module type Flambda_backend_options = sig
   val no_ocamlcfg : unit -> unit
   val dump_inlining_paths : unit -> unit
   val davail : unit -> unit
+  val dranges : unit -> unit
   val ddebug_invariants : unit -> unit
   val dcfg : unit -> unit
   val dcfg_invariants : unit -> unit
@@ -650,6 +654,7 @@ struct
   let list2 = [
     mk_dump_inlining_paths F.dump_inlining_paths;
     mk_davail F.davail;
+    mk_dranges F.dranges;
     mk_ddebug_invariants F.ddebug_invariants;
     mk_ocamlcfg F.ocamlcfg;
     mk_no_ocamlcfg F.no_ocamlcfg;
@@ -807,6 +812,7 @@ module Flambda_backend_options_impl = struct
   let dump_inlining_paths = set' Flambda_backend_flags.dump_inlining_paths
 
   let davail = set' Flambda_backend_flags.davail
+  let dranges = set' Flambda_backend_flags.dranges
 
   let ddebug_invariants = set' Dwarf_flags.ddebug_invariants
 
@@ -1062,6 +1068,7 @@ module Extra_params = struct
     | "cfg-peephole-optimize" -> set' Flambda_backend_flags.cfg_peephole_optimize
     | "dump-inlining-paths" -> set' Flambda_backend_flags.dump_inlining_paths
     | "davail" -> set' Flambda_backend_flags.davail
+    | "dranges" -> set' Flambda_backend_flags.dranges
     | "ddebug-invariants" -> set' Dwarf_flags.ddebug_invariants
     | "reorder-blocks-random" ->
        set_int_option' Flambda_backend_flags.reorder_blocks_random

driver/flambda_backend_args.mli

@@ -24,6 +24,7 @@ module type Flambda_backend_options = sig
   val no_ocamlcfg : unit -> unit
   val dump_inlining_paths : unit -> unit
   val davail : unit -> unit
+  val dranges : unit -> unit
   val ddebug_invariants : unit -> unit
   val dcfg : unit -> unit
   val dcfg_invariants : unit -> unit

driver/flambda_backend_flags.ml

@@ -57,6 +57,7 @@ type 'a or_default = Set of 'a | Default
 
 let dump_inlining_paths = ref false
 let davail = ref false
+let dranges = ref false
 
 let opt_level = ref Default
 

driver/flambda_backend_flags.mli

@@ -34,6 +34,7 @@ val heap_reduction_threshold : int ref
 val dump_checkmach : bool ref
 
 val davail : bool ref
+val dranges : bool ref
 
 type checkmach_details_cutoff =
   | Keep_all