1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
open Maps
open Camlcoq
open Registers
open RTLcommonaux
let debug_flag = ref false
let debug fmt =
if !debug_flag then (flush stderr; flush stdout; 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_ptree_opint oc pt =
if !debug_flag then
let elements = PTree.elements pt in
begin
Printf.fprintf oc "[";
List.iter (fun (n, op) ->
match op with
| None -> ()
| Some p -> Printf.fprintf oc "%d -> %d, " (P.to_int n) (P.to_int p)
) 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
let print_ptree_oplist oc pt =
if !debug_flag then
let elements = PTree.elements pt in
begin
Printf.fprintf oc "[";
List.iter (fun (n, ol) ->
match ol with
| None -> ()
| Some l -> Printf.fprintf oc "%d -> %a,\n" (P.to_int n) print_intlist l
) elements;
Printf.fprintf oc "]\n"
end
else ()
(* 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 =
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
|
