Source file pp_arm_m4.ml
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
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
open Arch_decl
open Utils
open PrintCommon
open PrintASM
open Prog
open Asm_utils
open Arm_decl
open Arm_instr_decl
open Arm_expand_imm
let arch = arm_decl
let imm_pre = "#"
let pp_reg_address_aux base disp off scal =
match (disp, off, scal) with
| None, None, None ->
Format.asprintf "[%s]" base
| Some disp, None, None ->
Format.asprintf "[%s, %s%s]" base imm_pre disp
| None, Some off, None ->
Format.asprintf "[%s, %s]" base off
| None, Some off, Some scal ->
Format.asprintf "[%s, %s, lsl %s%s]" base off imm_pre scal
| _, _, _ ->
hierror
~loc:Lnone
~kind:"assembly printing"
~internal:true
"the address computation is too complex: an intermediate variable might be needed"
let pp_brace s = Format.asprintf "{%s}" s
let pp_imm = pp_imm imm_pre
let pp_register = pp_register arch
let pp_reg_address addr =
let addr = parse_reg_address arch addr in
pp_reg_address_aux addr.base addr.displacement addr.offset addr.scale
let pp_condt = hash_to_string string_of_condt
let pp_asm_arg (arg : (register, Arch_utils.empty, Arch_utils.empty, rflag, condt) asm_arg) =
match arg with
| Condt _ -> None
| Imm (ws, w) -> Some (pp_imm (Conv.z_unsigned_of_word ws w))
| Reg r -> Some (pp_register r)
| Regx _ -> .
| Addr (Areg ra) ->
Some (pp_reg_address ra)
| Addr (Arip r) -> Some (pp_rip_address r)
| XReg _ -> .
let = [ Instr (".thumb", []); Instr (".syntax unified", []) ]
let pp_set_flags opts = if opts.set_flags then "s" else ""
let pp_conditional args =
match List.opick (is_Condt arch) args with
| Some ct -> pp_condt ct
| None -> ""
let pp_shift_kind = hash_to_string string_of_shift_kind
let pp_shift (ARM_op (_, opts)) args =
match opts.has_shift with
| None ->
args
| Some sk ->
let sh = pp_shift_kind sk in
List.modify_last (Format.asprintf "%s %s" sh) args
let pp_mnemonic_ext (ARM_op (_, opts) as op) suff args =
let id = instr_desc Arm_decl.arm_decl Arm_instr_decl.arm_op_decl (None, op) in
let pp = id.id_pp_asm args in
Format.asprintf "%s%s%s%s" pp.pp_aop_name suff (pp_set_flags opts) (pp_conditional args)
let get_IT i =
match i with
| AsmOp (_, args) -> begin
match List.opick (is_Condt arch) args with
| None -> []
| Some c -> [ Instr ("it", [ pp_condt c ]) ]
end
| _ -> []
module ArgChecker : sig
val check_args :
arm_op ->
(Wsize.wsize * (register, Arch_utils.empty, Arch_utils.empty, rflag, condt) asm_arg)
list ->
string
end = struct
let exn_imm_too_big n =
hierror
~loc:Lnone
~kind:"printing"
"invalid immediate (%s is too large)."
(Z.to_string (Conv.z_of_cz n))
let exn_imm_shifted n =
hierror
~loc:Lnone
~kind:"printing"
"unsupported immediate (%s needs a shift with carry)."
(Z.to_string (Conv.z_of_cz n))
let chk_imm args n on_shift on_none =
match List.at args n with
| _, Imm (_, w) -> (
let n = Word0.wunsigned Wsize.U32 w in
match ei_kind n with
| EI_shift -> on_shift n
| EI_none -> on_none n
| _ -> "")
| _ -> ""
let chk_w12_encoding opts n =
if opts.set_flags || not (is_w12_encoding n) then exn_imm_too_big n
else "w"
let chk_w16_encoding opts n =
if opts.set_flags || not (is_w16_encoding n) then exn_imm_too_big n
else "w"
let chk_imm_accept_shift args n = chk_imm args n (fun _ -> "") exn_imm_too_big
let chk_imm_accept_shift_w12 args n opts =
chk_imm args n (fun _ -> "") (chk_w12_encoding opts)
let chk_imm_reject_shift args n =
chk_imm args n exn_imm_shifted exn_imm_too_big
let chk_imm_w16_encoding args n opts =
chk_imm args n (chk_w16_encoding opts) (chk_w16_encoding opts)
let check_args (ARM_op (mn, opts)) args =
match mn with
| ADC | SBC | RSB -> chk_imm_accept_shift args 2
| CMP | CMN -> chk_imm_accept_shift args 1
| ADD | SUB -> chk_imm_accept_shift_w12 args 2 opts
| MOV -> chk_imm_w16_encoding args 1 opts
| AND | BIC | EOR | ORR -> chk_imm_reject_shift args 2
| MVN | TST -> chk_imm_reject_shift args 1
| _ -> ""
end
let pp_ADR pp opts args =
let name_lo = pp_mnemonic_ext (ARM_op(MOV, opts)) "w" args in
let name_hi = pp_mnemonic_ext (ARM_op(MOVT, opts)) "" args in
let args =
List.filter_map (fun (_, a) -> pp_asm_arg a) pp.pp_aop_args
in
let args_lo, args_hi =
match args with
| dst :: addr :: rest ->
let lo = "#:lower16:" ^ addr in
let hi = "#:upper16:" ^ addr in
(dst :: lo :: rest, dst :: hi :: rest)
| _ -> assert false
in
[ Instr(name_lo, args_lo); Instr(name_hi, args_hi) ]
let arch = arm_decl
module ArmTarget : AsmTargetBuilder.AsmTarget with
type reg = Arm_decl.register
and type regx = Arch_utils.empty
and type xreg = Arch_utils.empty
and type rflag = Arm_decl.rflag
and type cond = Arm_decl.condt
and type asm_op = arm_op
= struct
type reg = Arm_decl.register
type regx = Arch_utils.empty
type xreg = Arch_utils.empty
type rflag = Arm_decl.rflag
type cond = Arm_decl.condt
type asm_op = arm_op
let = [ Instr (".thumb", []); Instr (".syntax unified", []) ]
let =
[
Instr (".p2align", ["5"]) ;
Label global_datas_label
]
let function_tail =
[ Instr ("pop", [ "{pc}" ]) ]
let =
[
Instr ("push", [pp_brace (pp_register LR)])
]
let pp_instr_r fn i =
match i with
| ALIGN ->
failwith "TODO_ARM: pp_instr align"
| LABEL (_, lbl) ->
[ Label (string_of_label fn lbl) ]
| STORELABEL (dst, lbl) ->
[ Instr ("adr", [ pp_register dst; string_of_label fn lbl ]) ]
| JMP lbl ->
[ Instr ("b", [ pp_remote_label lbl ]) ]
| JMPI arg ->
let lbl =
match arg with
| Reg r -> pp_register r
| _ -> failwith "TODO_ARM: pp_instr jmpi"
in
[ Instr ("bx", [ lbl ]) ]
| Jcc (lbl, ct) ->
let iname = Format.asprintf "b%s" (pp_condt ct) in
[ Instr (iname, [ string_of_label fn lbl ]) ]
| JAL (LR, lbl) ->
[ Instr ("bl", [ pp_remote_label lbl ]) ]
| CALL _
| JAL _ -> assert false
| POPPC ->
[ Instr ("pop", [ "{pc}" ]) ]
| SysCall op ->
[Instr ("bl", [ pp_syscall op ])]
| AsmOp (op, args) ->
let id = instr_desc arm_decl arm_op_decl (None, op) in
let pp = id.id_pp_asm args in
let suff = ArgChecker.check_args op pp.pp_aop_args in
match op, args with
| ARM_op(ADR, opts), _ :: Addr (Arip _) :: _ -> pp_ADR pp opts args
| _, _ ->
let name = pp_mnemonic_ext op suff args in
let args =
List.filter_map (fun (_, a) -> pp_asm_arg a) pp.pp_aop_args
in
let args = pp_shift op args in
get_IT i @ [ Instr (name, args) ]
end
module ArmBuilder = AsmTargetBuilder.Make(ArmTarget)
let print_prog fmt prog = PrintASM.pp_asm fmt (ArmBuilder.asm_of_prog prog)