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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Pretty-printing of pseudo machine code *)
open Format
open Cmm
open Reg
open Mach
let reg r =
if String.length r.name > 0 then
print_string r.name
else
print_string(match r.typ with Addr -> "A" | Int -> "I" | Float -> "F");
print_string "/";
print_int r.stamp;
begin match r.loc with
Unknown -> ()
| Reg r ->
print_string "["; print_string(Proc.register_name r); print_string "]"
| Stack(Local s) ->
print_string "[s"; print_int s; print_string "]"
| Stack(Incoming s) ->
print_string "[si"; print_int s; print_string "]"
| Stack(Outgoing s) ->
print_string "[so"; print_int s; print_string "]"
end
let regs v =
match Array.length v with
0 -> ()
| 1 -> reg v.(0)
| n -> reg v.(0);
for i = 1 to n-1 do print_string " "; reg v.(i) done
let regset s =
let first = ref true in
Reg.Set.iter
(fun r ->
if !first then first := false else print_space();
reg r)
s
let regsetaddr s =
let first = ref true in
Reg.Set.iter
(fun r ->
if !first then first := false else print_space();
reg r;
match r.typ with Addr -> print_string "*" | _ -> ())
s
let intcomp = function
Isigned c -> print_string " "; Printcmm.comparison c; print_string "s "
| Iunsigned c -> print_string " "; Printcmm.comparison c; print_string "u "
let floatcomp c =
print_string " "; Printcmm.comparison c; print_string "f "
let intop = function
Iadd -> print_string " + "
| Isub -> print_string " - "
| Imul -> print_string " * "
| Idiv -> print_string " div "
| Imod -> print_string " mod "
| Iand -> print_string " & "
| Ior -> print_string " | "
| Ixor -> print_string " ^ "
| Ilsl -> print_string " << "
| Ilsr -> print_string " >>u "
| Iasr -> print_string " >>s "
| Icomp cmp -> intcomp cmp
| Icheckbound -> print_string " check > "
let test tst arg =
match tst with
Itruetest -> reg arg.(0)
| Ifalsetest -> print_string "not "; reg arg.(0)
| Iinttest cmp -> reg arg.(0); intcomp cmp; reg arg.(1)
| Iinttest_imm(cmp, n) -> reg arg.(0); intcomp cmp; print_int n
| Ifloattest(cmp, neg) ->
if neg then print_string "not ";
reg arg.(0); floatcomp cmp; reg arg.(1)
| Ieventest -> reg arg.(0); print_string " & 1 == 0"
| Ioddtest -> reg arg.(0); print_string " & 1 == 1"
let print_live = ref false
let operation op arg res =
if Array.length res > 0 then begin regs res; print_string " := " end;
match op with
Imove -> regs arg
| Ispill -> regs arg; print_string " (spill)"
| Ireload -> regs arg; print_string " (reload)"
| Iconst_int n -> print_int n
| Iconst_float s -> print_string s
| Iconst_symbol s -> print_string "\""; print_string s; print_string "\""
| Icall_ind -> print_string "call "; regs arg
| Icall_imm lbl ->
print_string "call \""; print_string lbl;
print_string "\" "; regs arg
| Itailcall_ind -> print_string "tailcall "; regs arg
| Itailcall_imm lbl ->
print_string "tailcall \""; print_string lbl;
print_string "\" "; regs arg
| Iextcall(lbl, alloc) ->
print_string "extcall \""; print_string lbl;
print_string "\" "; regs arg;
if not alloc then print_string " (noalloc)"
| Istackoffset n ->
print_string "offset stack "; print_int n
| Iload(chunk, addr) ->
Printcmm.chunk chunk;
print_string "[";
Arch.print_addressing reg addr arg;
print_string "]"
| Istore(chunk, addr) ->
Printcmm.chunk chunk;
print_string "[";
Arch.print_addressing reg addr (Array.sub arg 1 (Array.length arg - 1));
print_string "] := ";
reg arg.(0)
| Ialloc n -> print_string "alloc "; print_int n
| Iintop(op) -> reg arg.(0); intop op; reg arg.(1)
| Iintop_imm(op, n) -> reg arg.(0); intop op; print_int n
| Inegf -> print_string "-f "; reg arg.(0)
| Iabsf -> print_string "absf "; reg arg.(0)
| Iaddf -> reg arg.(0); print_string " +f "; reg arg.(1)
| Isubf -> reg arg.(0); print_string " -f "; reg arg.(1)
| Imulf -> reg arg.(0); print_string " *f "; reg arg.(1)
| Idivf -> reg arg.(0); print_string " /f "; reg arg.(1)
| Ifloatofint -> print_string "floatofint "; reg arg.(0)
| Iintoffloat -> print_string "intoffloat "; reg arg.(0)
| Ispecific op ->
Arch.print_specific_operation reg op arg
let rec instr i =
if !print_live then begin
open_hovbox 1;
print_string "{";
regsetaddr i.live;
if Array.length i.arg > 0 then begin
print_space(); print_string "+"; print_space(); regs i.arg
end;
print_string "}";
close_box();
print_cut()
end;
begin match i.desc with
Iend -> ()
| Iop op ->
operation op i.arg i.res
| Ireturn ->
print_string "return "; regs i.arg
| Iifthenelse(tst, ifso, ifnot) ->
open_vbox 2;
print_string "if "; test tst i.arg; print_string " then"; print_cut();
instr ifso;
begin match ifnot.desc with
Iend -> ()
| _ -> print_break 0 (-2); print_string "else"; print_cut(); instr ifnot
end;
print_break 0 (-2); print_string "endif";
close_box()
| Iswitch(index, cases) ->
print_string "switch "; reg i.arg.(0);
for i = 0 to Array.length cases - 1 do
print_cut();
open_vbox 2;
open_hovbox 0;
for j = 0 to Array.length index - 1 do
if index.(j) = i then begin
print_string "case "; print_int j; print_string ":";
print_cut()
end
done;
close_box(); print_cut();
instr cases.(i);
close_box()
done;
print_cut(); print_string "endswitch"
| Iloop(body) ->
open_vbox 2;
print_string "loop"; print_cut();
instr body; print_break 0 (-2);
print_string "endloop ";
close_box()
| Icatch(body, handler) ->
open_vbox 2;
print_string "catch"; print_cut();
instr body;
print_break 0 (-2); print_string "with"; print_cut();
instr handler;
print_break 0 (-2); print_string "endcatch";
close_box()
| Iexit ->
print_string "exit"
| Itrywith(body, handler) ->
open_vbox 2;
print_string "try"; print_cut();
instr body;
print_break 0 (-2); print_string "with"; print_cut();
instr handler;
print_break 0 (-2); print_string "endtry";
close_box()
| Iraise ->
print_string "raise "; reg i.arg.(0)
end;
begin match i.next.desc with
Iend -> ()
| _ -> print_cut(); instr i.next
end
let fundecl f =
open_vbox 2;
print_string f.fun_name;
print_string "("; regs f.fun_args; print_string ")";
print_cut();
instr f.fun_body;
close_box()
let phase msg f =
print_string "*** "; print_string msg; print_newline();
fundecl f; print_newline()
let interference r =
open_hovbox 2;
reg r; print_string ":";
List.iter
(fun r -> print_space(); reg r)
r.interf;
close_box();
print_newline()
let interferences () =
print_string "*** Interferences"; print_newline();
List.iter interference (Reg.all_registers())
let preference r =
open_hovbox 2;
reg r; print_string ": ";
List.iter
(fun (r, w) -> print_space(); reg r; print_string " weight " ; print_int w)
r.prefer;
close_box();
print_newline()
let preferences () =
print_string "*** Preferences"; print_newline();
List.iter preference (Reg.all_registers())
|
