Uniformizing a couple of debug print functions

5 files changed, 148 insertions, 167 deletions

diff --git a/backend/Duplicateaux.ml b/backend/Duplicateaux.ml
index 861df3cd..21078975 100644
--- a/backend/Duplicateaux.ml
+++ b/backend/Duplicateaux.ml
@@ -22,9 +22,8 @@
 open RTL
 open Maps
 open Camlcoq
+open DebugPrint
 
-let debug_flag = LICMaux.debug_flag
-let debug = LICMaux.debug
 let get_loop_headers = LICMaux.get_loop_headers
 let get_some = LICMaux.get_some
 let rtl_successors = LICMaux.rtl_successors
@@ -87,8 +86,6 @@ end
 
 module PSet = Set.Make(PInt)
 
-let print_intlist = LICMaux.print_intlist
-
 let print_intset s =
   let seq = PSet.to_seq s
   in begin
@@ -101,18 +98,6 @@ let print_intset s =
     end
   end
 
-let ptree_printbool pt =
-  let elements = PTree.elements pt
-  in begin
-    if !debug_flag then begin
-      Printf.printf "[";
-      List.iter (fun (n, b) ->
-        if b then Printf.printf "%d, " (P.to_int n) else ()
-      ) elements;
-      Printf.printf "]"
-    end
-  end
-
 (* Looks ahead (until a branch) to see if a node further down verifies
  * the given predicate *)
 let rec look_ahead_gen (successors: RTL.instruction -> P.t list) code node is_loop_header predicate =
@@ -215,16 +200,6 @@ type innerLoop = {
 
 let print_pset = LICMaux.pp_pset
 
-let print_ptree printer pt =
-  let elements = PTree.elements pt in
-  begin
-    debug "[\n";
-    List.iter (fun (n, elt) ->
-      debug "\t%d: %a\n" (P.to_int n) printer elt
-    ) elements;
-    debug "]\n"
-  end
-
 let rtl_successors_pref = function
 | Itailcall _ | Ireturn _ -> []
 | Icall(_,_,_,_,n) | Ibuiltin(_,_,_,n) | Inop n | Iop (_,_,_,n)
@@ -554,8 +529,6 @@ let print_traces oc traces =
       Printf.fprintf oc "Traces: {%a}\n" f traces
   end
 
-let print_code code = LICMaux.print_code code
-
 (* Dumb (but linear) trace selection *)
 let select_traces_linear code entrypoint =
   let is_visited = ref (PTree.map (fun n i -> false) code) in
@@ -770,14 +743,6 @@ let invert_iconds code =
  * cyclic dependencies between LICMaux and Duplicateaux
  *)
 
-
-
-let print_option_pint oc o =
-  if !debug_flag then
-    match o with
-    | None -> Printf.fprintf oc "None"
-    | Some n -> Printf.fprintf oc "Some %d" (P.to_int n)
-
 let print_inner_loop iloop =
   debug "{preds: %a, body: %a, head: %d, finals: %a, sb_final: %a}\n"
     print_intlist iloop.preds
@@ -794,8 +759,6 @@ let rec print_inner_loops = function
     print_inner_loops iloops
   end
 
-let print_pint oc i = if !debug_flag then Printf.fprintf oc "%d" (P.to_int i) else ()
-
 let cb_exit_node = function
   | Icond (_,_,n1,n2,p) -> begin match p with
       | Some true -> Some n2
diff --git a/backend/LICMaux.ml b/backend/LICMaux.ml
index df98077b..1f6b8817 100644
--- a/backend/LICMaux.ml
+++ b/backend/LICMaux.ml
@@ -16,16 +16,11 @@ open Maps;;
 open Kildall;;
 open HashedSet;;
 open Inject;;
+open DebugPrint;;
 
 type reg = P.t;;
 
 (** get_loop_headers moved from Duplicateaux.ml to LICMaux.ml to prevent cycle dependencies *)
-let debug_flag = ref false
-
-let debug fmt =
-  if !debug_flag then (flush stderr; Printf.eprintf fmt)
-  else Printf.ifprintf stderr fmt
-
 type vstate = Unvisited | Processed | Visited
 
 let get_some = function
@@ -39,42 +34,6 @@ let rtl_successors = function
 | Icond (_,_,n1,n2,_) -> [n1; n2]
 | Ijumptable (_,ln) -> ln
 
-let print_ptree_bool oc pt =
-  if !debug_flag then
-    let elements = PTree.elements pt in
-    begin
-      Printf.fprintf oc "[";
-      List.iter (fun (n, b) ->
-        if b then Printf.fprintf oc "%d, " (P.to_int n)
-      ) elements;
-      Printf.fprintf oc "]\n"
-    end
-  else ()
-
-let print_intlist oc l =
-  let rec f oc = function
-  | [] -> ()
-  | n::ln -> (Printf.fprintf oc "%d %a" (P.to_int n) f ln)
-  in begin
-    if !debug_flag then begin
-      Printf.fprintf oc "[%a]" f l
-    end
-  end
-
-(* Adapted from backend/PrintRTL.ml: print_function *)
-let print_code code = let open PrintRTL in let open Printf in
-  if (!debug_flag) then begin
-    fprintf stdout "{\n";
-    let instrs =
-      List.sort
-        (fun (pc1, _) (pc2, _) -> compare pc2 pc1)
-        (List.rev_map
-          (fun (pc, i) -> (P.to_int pc, i))
-          (PTree.elements code)) in
-    List.iter (print_instruction stdout) instrs;
-    fprintf stdout "}"
-  end
-
 (** Getting loop branches with a DFS visit :
   * Each node is either Unvisited, Visited, or Processed
   * pre-order: node becomes Processed
diff --git a/common/DebugPrint.ml b/common/DebugPrint.ml
new file mode 100644
index 00000000..64efe727
--- /dev/null
+++ b/common/DebugPrint.ml
@@ -0,0 +1,118 @@
+open Maps
+open Camlcoq
+open Registers
+
+let debug_flag = ref false
+
+let debug fmt =
+  if !debug_flag then (flush stderr; Printf.eprintf fmt)
+  else Printf.ifprintf stderr fmt
+
+let print_ptree_bool oc pt =
+  if !debug_flag then
+    let elements = PTree.elements pt in
+    begin
+      Printf.fprintf oc "[";
+      List.iter (fun (n, b) ->
+        if b then Printf.fprintf oc "%d, " (P.to_int n)
+      ) elements;
+      Printf.fprintf oc "]\n"
+    end
+  else ()
+
+let print_intlist oc l =
+  let rec f oc = function
+  | [] -> ()
+  | n::ln -> (Printf.fprintf oc "%d %a" (P.to_int n) f ln)
+  in begin
+    if !debug_flag then begin
+      Printf.fprintf oc "[%a]" f l
+    end
+  end
+
+(* Adapted from backend/PrintRTL.ml: print_function *)
+let print_code code = let open PrintRTL in let open Printf in
+  if (!debug_flag) then begin
+    fprintf stdout "{\n";
+    let instrs =
+      List.sort
+        (fun (pc1, _) (pc2, _) -> compare pc2 pc1)
+        (List.rev_map
+          (fun (pc, i) -> (P.to_int pc, i))
+          (PTree.elements code)) in
+    List.iter (print_instruction stdout) instrs;
+    fprintf stdout "}"
+  end
+
+let ptree_printbool pt =
+  let elements = PTree.elements pt
+  in begin
+    if !debug_flag then begin
+      Printf.printf "[";
+      List.iter (fun (n, b) ->
+        if b then Printf.printf "%d, " (P.to_int n) else ()
+      ) elements;
+      Printf.printf "]"
+    end
+  end
+
+let print_ptree printer pt =
+  let elements = PTree.elements pt in
+  begin
+    debug "[\n";
+    List.iter (fun (n, elt) ->
+      debug "\t%d: %a\n" (P.to_int n) printer elt
+    ) elements;
+    debug "]\n"
+  end
+
+let print_option_pint oc o =
+  if !debug_flag then
+    match o with
+    | None -> Printf.fprintf oc "None"
+    | Some n -> Printf.fprintf oc "Some %d" (P.to_int n)
+
+let print_pint oc i = if !debug_flag then Printf.fprintf oc "%d" (P.to_int i) else ()
+
+let print_regset rs = begin
+  debug "[";
+  List.iter (fun n -> debug "%d " (P.to_int n)) (Regset.elements rs);
+  debug "]"
+end
+
+let print_ptree_regset pt = begin
+  debug "[";
+  List.iter (fun (n, rs) ->
+    debug "\n\t";
+    debug "%d: " (P.to_int n);
+    print_regset rs
+  ) (PTree.elements pt);
+  debug "]"
+end
+
+let print_true_nodes booltree = begin
+  debug "[";
+  List.iter (fun (n,b) ->
+    if b then debug "%d " (P.to_int n)
+  ) (PTree.elements booltree);
+  debug "]";
+end
+
+
+let print_instructions insts code =
+  let get_some = function
+  | None -> failwith "Did not get some"
+  | Some thing -> thing
+  in if (!debug_flag) then begin
+    debug "[ ";
+    List.iter (
+      fun n -> (PrintRTL.print_instruction stdout (P.to_int n, get_some @@ PTree.get n code))
+    ) insts; debug "]"
+  end
+
+let print_arrayp arr = begin
+  debug "[| ";
+  Array.iter (fun n -> debug "%d, " (P.to_int n)) arr;
+  debug "|]"
+end
+
diff --git a/scheduling/RTLpathLivegenaux.ml b/scheduling/RTLpathLivegenaux.ml
index 765aa55f..ab921954 100644
--- a/scheduling/RTLpathLivegenaux.ml
+++ b/scheduling/RTLpathLivegenaux.ml
@@ -6,15 +6,7 @@ open Camlcoq
 open Datatypes
 open Kildall
 open Lattice
-
-let debug_flag = ref false
-
-let dprintf fmt = let open Printf in begin
-  flush stdout;
-  match !debug_flag with
-  | true -> printf fmt
-  | false -> ifprintf stdout fmt
-end
+open DebugPrint
 
 let get_some = function
 | None -> failwith "Got None instead of Some _"
@@ -124,22 +116,6 @@ let get_path_map code entry join_points =
     !path_map
   end
 
-let print_regset rs = begin
-  dprintf "[";
-  List.iter (fun n -> dprintf "%d " (P.to_int n)) (Regset.elements rs);
-  dprintf "]"
-end
-
-let print_ptree_regset pt = begin
-  dprintf "[";
-  List.iter (fun (n, rs) ->
-    dprintf "\n\t";
-    dprintf "%d: " (P.to_int n);
-    print_regset rs
-  ) (PTree.elements pt);
-  dprintf "]"
-end
-
 let transfer f pc after = let open Liveness in
   match PTree.get pc f.fn_code with
   | Some i ->
@@ -259,7 +235,7 @@ let set_pathmap_liveness f pm =
   let new_pm = ref PTree.empty in
   let code = f.fn_code in
   begin
-    dprintf "Liveness: "; print_ptree_regset liveness; dprintf "\n";
+    debug "Liveness: "; print_ptree_regset liveness; debug "\n";
     List.iter (fun (n, pi) ->
       let inputs = get_some @@ PTree.get n liveness in
       let outputs = get_outputs liveness code n pi in
@@ -269,31 +245,23 @@ let set_pathmap_liveness f pm =
     !new_pm
   end
 
-let print_true_nodes booltree = begin
-  dprintf "[";
-  List.iter (fun (n,b) ->
-    if b then dprintf "%d " (P.to_int n)
-  ) (PTree.elements booltree);
-  dprintf "]";
-end
-
 let print_path_info pi = begin
-  dprintf "(psize=%d; " (Camlcoq.Nat.to_int pi.psize);
-  dprintf "input_regs=";
+  debug "(psize=%d; " (Camlcoq.Nat.to_int pi.psize);
+  debug "input_regs=";
   print_regset pi.input_regs;
-  dprintf "; output_regs=";
+  debug "; output_regs=";
   print_regset pi.output_regs;
-  dprintf ")"
+  debug ")"
 end
 
 let print_path_map path_map = begin
-  dprintf "[";
+  debug "[";
   List.iter (fun (n,pi) ->
-    dprintf "\n\t";
-    dprintf "%d: " (P.to_int n);
+    debug "\n\t";
+    debug "%d: " (P.to_int n);
     print_path_info pi
   ) (PTree.elements path_map);
-  dprintf "]"
+  debug "]"
 end
 
 let build_path_map f = 
@@ -302,10 +270,10 @@ let build_path_map f =
   let join_points = get_join_points code entry in
   let path_map = set_pathmap_liveness f @@ get_path_map code entry join_points in
   begin
-    dprintf "Join points: ";
+    debug "Join points: ";
     print_true_nodes join_points;
-    dprintf "\nPath map: ";
+    debug "\nPath map: ";
     print_path_map path_map;
-    dprintf "\n";
+    debug "\n";
     path_map
   end
diff --git a/scheduling/RTLpathScheduleraux.ml b/scheduling/RTLpathScheduleraux.ml
index d5646a2b..a294d0b5 100644
--- a/scheduling/RTLpathScheduleraux.ml
+++ b/scheduling/RTLpathScheduleraux.ml
@@ -5,6 +5,7 @@ open RTLpathLivegenaux
 open Registers
 open Camlcoq
 open Machine
+open DebugPrint
 
 let config = Machine.config
 
@@ -18,54 +19,26 @@ type superblock = {
   typing: RTLtyping.regenv
 }
 
-let print_instructions insts code =
-  if (!debug_flag) then begin
-    dprintf "[ ";
-    List.iter (
-      fun n -> (PrintRTL.print_instruction stdout (P.to_int n, get_some @@ PTree.get n code))
-    ) insts; dprintf "]"
-  end
-
 let print_superblock sb code =
   let insts = sb.instructions in
   let li = sb.liveins in
   let outs = sb.output_regs in
   begin
-    dprintf "{ instructions = "; print_instructions (Array.to_list insts) code; dprintf "\n";
-    dprintf "  liveins = "; print_ptree_regset li; dprintf "\n";
-    dprintf "  output_regs = "; print_regset outs; dprintf "}"
+    debug "{ instructions = "; print_instructions (Array.to_list insts) code; debug "\n";
+    debug "  liveins = "; print_ptree_regset li; debug "\n";
+    debug "  output_regs = "; print_regset outs; debug "}"
   end
 
 let print_superblocks lsb code =
   let rec f = function
     | [] -> ()
-    | sb :: lsb -> (print_superblock sb code; dprintf ",\n"; f lsb)
+    | sb :: lsb -> (print_superblock sb code; debug ",\n"; f lsb)
   in begin
-    dprintf "[\n";
+    debug "[\n";
     f lsb;
-    dprintf "]"
-  end
-
-(* Adapted from backend/PrintRTL.ml: print_function *)
-let print_code code = let open PrintRTL in let open Printf in
-  if (!debug_flag) then begin
-    fprintf stdout "{\n";
-    let instrs =
-      List.sort
-        (fun (pc1, _) (pc2, _) -> compare pc2 pc1)
-        (List.rev_map
-          (fun (pc, i) -> (P.to_int pc, i))
-          (PTree.elements code)) in
-    List.iter (print_instruction stdout) instrs;
-    fprintf stdout "}"
+    debug "]"
   end
 
-let print_arrayp arr = begin
-  dprintf "[| ";
-  Array.iter (fun n -> dprintf "%d, " (P.to_int n)) arr;
-  dprintf "|]"
-end
-
 let get_superblocks code entry pm typing =
   let visited = ref (PTree.map (fun n i -> false) code) in
   let rec get_superblocks_rec pc =
@@ -103,7 +76,7 @@ let get_superblocks code entry pm typing =
     end
   in let lsb = get_superblocks_rec entry in begin
     (* debug_flag := true; *)
-    dprintf "Superblocks identified:"; print_superblocks lsb code; dprintf "\n";
+    debug "Superblocks identified:"; print_superblocks lsb code; debug "\n";
     (* debug_flag := false; *)
     lsb
 end
@@ -329,10 +302,10 @@ let rec do_schedule code = function
       let new_code = apply_schedule code' sb schedule in
       begin
         (* debug_flag := true; *)
-        dprintf "Old Code: "; print_code code;
-        dprintf "\nSchedule to apply: "; print_arrayp schedule;
-        dprintf "\nNew Code: "; print_code new_code;
-        dprintf "\n";
+        debug "Old Code: "; print_code code;
+        debug "\nSchedule to apply: "; print_arrayp schedule;
+        debug "\nNew Code: "; print_code new_code;
+        debug "\n";
         (* debug_flag := false; *)
         do_schedule new_code lsb
       end
@@ -348,10 +321,10 @@ let scheduler f =
   let lsb = get_superblocks code entry pm typing in
   begin
     (* debug_flag := true; *)
-    dprintf "Pathmap:\n"; dprintf "\n";
+    debug "Pathmap:\n"; debug "\n";
     print_path_map pm;
-    dprintf "Superblocks:\n";
-    print_superblocks lsb code; dprintf "\n";
+    debug "Superblocks:\n";
+    print_superblocks lsb code; debug "\n";
     (* debug_flag := false; *)
     let tc = do_schedule code lsb in
     (((tc, entry), pm), id_ptree)