aboutsummaryrefslogtreecommitdiffstats
path: root/scheduling
diff options
context:
space:
mode:
Diffstat (limited to 'scheduling')
-rw-r--r--scheduling/RTLpathLivegenaux.ml58
-rw-r--r--scheduling/RTLpathScheduleraux.ml57
2 files changed, 28 insertions, 87 deletions
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)
generated by cgit (git 2.34.1) at 2024-07-14 04:35:27 +0000