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
|
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* Pretty-printing of pseudo machine code *)
open Format
open Cmm
open Reg
open Mach
let reg ppf r =
if not (Reg.anonymous r) then
fprintf ppf "%s" (Reg.name r)
else
fprintf ppf "%s"
(match r.typ with Val -> "V" | Addr -> "A" | Int -> "I" | Float -> "F");
fprintf ppf "/%i" r.stamp;
begin match r.loc with
| Unknown -> ()
| Reg r ->
fprintf ppf "[%s]" (Proc.register_name r)
| Stack(Local s) ->
fprintf ppf "[s%i]" s
| Stack(Incoming s) ->
fprintf ppf "[si%i]" s
| Stack(Outgoing s) ->
fprintf ppf "[so%i]" s
end
let regs ppf v =
match Array.length v with
| 0 -> ()
| 1 -> reg ppf v.(0)
| n -> reg ppf v.(0);
for i = 1 to n-1 do fprintf ppf " %a" reg v.(i) done
let regset ppf s =
let first = ref true in
Reg.Set.iter
(fun r ->
if !first then begin first := false; fprintf ppf "%a" reg r end
else fprintf ppf "@ %a" reg r)
s
let regsetaddr ppf s =
let first = ref true in
Reg.Set.iter
(fun r ->
if !first then begin first := false; fprintf ppf "%a" reg r end
else fprintf ppf "@ %a" reg r;
match r.typ with
| Val -> fprintf ppf "*"
| Addr -> fprintf ppf "!"
| _ -> ())
s
let intcomp = function
| Isigned c -> Printf.sprintf " %ss " (Printcmm.comparison c)
| Iunsigned c -> Printf.sprintf " %su " (Printcmm.comparison c)
let floatcomp c =
Printf.sprintf " %sf " (Printcmm.comparison c)
let intop = function
| Iadd -> " + "
| Isub -> " - "
| Imul -> " * "
| Imulh -> " *h "
| Idiv -> " div "
| Imod -> " mod "
| Iand -> " & "
| Ior -> " | "
| Ixor -> " ^ "
| Ilsl -> " << "
| Ilsr -> " >>u "
| Iasr -> " >>s "
| Icomp cmp -> intcomp cmp
| Icheckbound -> " check > "
let test tst ppf arg =
match tst with
| Itruetest -> reg ppf arg.(0)
| Ifalsetest -> fprintf ppf "not %a" reg arg.(0)
| Iinttest cmp -> fprintf ppf "%a%s%a" reg arg.(0) (intcomp cmp) reg arg.(1)
| Iinttest_imm(cmp, n) -> fprintf ppf "%a%s%i" reg arg.(0) (intcomp cmp) n
| Ifloattest(cmp, neg) ->
fprintf ppf "%s%a%s%a"
(if neg then "not " else "")
reg arg.(0) (floatcomp cmp) reg arg.(1)
| Ieventest -> fprintf ppf "%a & 1 == 0" reg arg.(0)
| Ioddtest -> fprintf ppf "%a & 1 == 1" reg arg.(0)
let print_live = ref false
let operation op arg ppf res =
if Array.length res > 0 then fprintf ppf "%a := " regs res;
match op with
| Imove -> regs ppf arg
| Ispill -> fprintf ppf "%a (spill)" regs arg
| Ireload -> fprintf ppf "%a (reload)" regs arg
| Iconst_int n
| Iconst_blockheader n -> fprintf ppf "%s" (Nativeint.to_string n)
| Iconst_float f -> fprintf ppf "%F" f
| Iconst_symbol s -> fprintf ppf "\"%s\"" s
| Icall_ind -> fprintf ppf "call %a" regs arg
| Icall_imm lbl -> fprintf ppf "call \"%s\" %a" lbl regs arg
| Itailcall_ind -> fprintf ppf "tailcall %a" regs arg
| Itailcall_imm lbl -> fprintf ppf "tailcall \"%s\" %a" lbl regs arg
| Iextcall(lbl, alloc) ->
fprintf ppf "extcall \"%s\" %a%s" lbl regs arg
(if alloc then "" else " (noalloc)")
| Istackoffset n ->
fprintf ppf "offset stack %i" n
| Iload(chunk, addr) ->
fprintf ppf "%s[%a]"
(Printcmm.chunk chunk) (Arch.print_addressing reg addr) arg
| Istore(chunk, addr, is_assign) ->
fprintf ppf "%s[%a] := %a %s"
(Printcmm.chunk chunk)
(Arch.print_addressing reg addr)
(Array.sub arg 1 (Array.length arg - 1))
reg arg.(0)
(if is_assign then "(assign)" else "(init)")
| Ialloc n -> fprintf ppf "alloc %i" n
| Iintop(op) -> fprintf ppf "%a%s%a" reg arg.(0) (intop op) reg arg.(1)
| Iintop_imm(op, n) -> fprintf ppf "%a%s%i" reg arg.(0) (intop op) n
| Inegf -> fprintf ppf "-f %a" reg arg.(0)
| Iabsf -> fprintf ppf "absf %a" reg arg.(0)
| Iaddf -> fprintf ppf "%a +f %a" reg arg.(0) reg arg.(1)
| Isubf -> fprintf ppf "%a -f %a" reg arg.(0) reg arg.(1)
| Imulf -> fprintf ppf "%a *f %a" reg arg.(0) reg arg.(1)
| Idivf -> fprintf ppf "%a /f %a" reg arg.(0) reg arg.(1)
| Ifloatofint -> fprintf ppf "floatofint %a" reg arg.(0)
| Iintoffloat -> fprintf ppf "intoffloat %a" reg arg.(0)
| Ispecific op ->
Arch.print_specific_operation reg op ppf arg
let rec instr ppf i =
if !print_live then begin
fprintf ppf "@[<1>{%a" regsetaddr i.live;
if Array.length i.arg > 0 then fprintf ppf "@ +@ %a" regs i.arg;
fprintf ppf "}@]@,";
end;
begin match i.desc with
| Iend -> ()
| Iop op ->
operation op i.arg ppf i.res
| Ireturn ->
fprintf ppf "return %a" regs i.arg
| Iifthenelse(tst, ifso, ifnot) ->
fprintf ppf "@[<v 2>if %a then@,%a" (test tst) i.arg instr ifso;
begin match ifnot.desc with
| Iend -> ()
| _ -> fprintf ppf "@;<0 -2>else@,%a" instr ifnot
end;
fprintf ppf "@;<0 -2>endif@]"
| Iswitch(index, cases) ->
fprintf ppf "switch %a" reg i.arg.(0);
for i = 0 to Array.length cases - 1 do
fprintf ppf "@,@[<v 2>@[";
for j = 0 to Array.length index - 1 do
if index.(j) = i then fprintf ppf "case %i:@," j
done;
fprintf ppf "@]@,%a@]" instr cases.(i)
done;
fprintf ppf "@,endswitch"
| Iloop(body) ->
fprintf ppf "@[<v 2>loop@,%a@;<0 -2>endloop@]" instr body
| Icatch(i, body, handler) ->
fprintf
ppf "@[<v 2>catch@,%a@;<0 -2>with(%d)@,%a@;<0 -2>endcatch@]"
instr body i instr handler
| Iexit i ->
fprintf ppf "exit(%d)" i
| Itrywith(body, handler) ->
fprintf ppf "@[<v 2>try@,%a@;<0 -2>with@,%a@;<0 -2>endtry@]"
instr body instr handler
| Iraise k ->
fprintf ppf "%s %a" (Lambda.raise_kind k) reg i.arg.(0)
end;
if not (Debuginfo.is_none i.dbg) then
fprintf ppf "%s" (Debuginfo.to_string i.dbg);
begin match i.next.desc with
Iend -> ()
| _ -> fprintf ppf "@,%a" instr i.next
end
let fundecl ppf f =
let dbg =
if Debuginfo.is_none f.fun_dbg then
""
else
" " ^ Debuginfo.to_string f.fun_dbg in
fprintf ppf "@[<v 2>%s(%a)%s@,%a@]"
f.fun_name regs f.fun_args dbg instr f.fun_body
let phase msg ppf f =
fprintf ppf "*** %s@.%a@." msg fundecl f
let interference ppf r =
let interf ppf =
List.iter
(fun r -> fprintf ppf "@ %a" reg r)
r.interf in
fprintf ppf "@[<2>%a:%t@]@." reg r interf
let interferences ppf () =
fprintf ppf "*** Interferences@.";
List.iter (interference ppf) (Reg.all_registers())
let preference ppf r =
let prefs ppf =
List.iter
(fun (r, w) -> fprintf ppf "@ %a weight %i" reg r w)
r.prefer in
fprintf ppf "@[<2>%a: %t@]@." reg r prefs
let preferences ppf () =
fprintf ppf "*** Preferences@.";
List.iter (preference ppf) (Reg.all_registers())
|
