package jasmin

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

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
(* Assembly printer for ARM Cortex M4 (ARMv7-M).

We always use the Unified Assembly Language (UAL).
Immediate values (denoted <imm>) are always nonnegative integers.
*)

open Arch_decl
open Utils
open PrintCommon
open PrintASM
open Prog
open Asm_utils

(* Architecture imports*)
open Arm_decl
open Arm_instr_decl
open Arm_expand_imm

let arch = arm_decl

let imm_pre = "#"

(* We support the following ARMv7-M memory accesses.
   Offset addressing:
     - A base register and an immediate offset (displacement):
       [<reg>, #+/-<imm>] (where + can be omitted).
     - A base register and a register offset: [<reg>, <reg>].
     - A base register and a scaled register offset: [<reg>, <reg>, LSL #<imm>].
*)
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 _ -> .

(* -------------------------------------------------------------------- *)

(* TODO_ARM: Review. *)
let headers = [ Instr (".thumb", []); Instr (".syntax unified", []) ]

(* -------------------------------------------------------------------- *)

let pp_set_flags opts = if opts.set_flags then "s" else ""

(* We assume the only condition in the argument list is the one we need to
   print. *)
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)

(* To conform to the Unified Assembly Language (UAL) of ARM, IT instructions
   must be introduced *in addition* to conditional suffixes. *)
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
  (* Return the (possibly empty) suffix for the mnemonic according to its
     arguments.
     Raise an error if the arguments are invalid. *)
  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"

  (* Accept [EI_shift], reject [EI_none]. *)
  let chk_imm_accept_shift args n = chk_imm args n (fun _ -> "") exn_imm_too_big

  (* Accept [EI_shift], force W-encoding of 12-bits on [EI_none]. *)
  let chk_imm_accept_shift_w12 args n opts =
    chk_imm args n (fun _ -> "") (chk_w12_encoding opts)

  (* Reject [EI_shift] and [EI_none]. *)
  let chk_imm_reject_shift args n =
    chk_imm args n exn_imm_shifted exn_imm_too_big

  (* We need to avoid encoding T2 when the constant is a shift to avoid setting
     the carry flag.
     We force the W-encoding of 16-bits on both [EI_shift] and [EI_none]. *)
  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

(* Split an [ADR] instruction to a global symbol into a [MOVW]/[MOVT] pair. *)
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 headers = [ Instr (".thumb", []); Instr (".syntax unified", []) ]

  let data_segment_header =
    [
      Instr (".p2align", ["5"]) ;
      Label global_datas_label
    ]

  let function_tail =
    (* TODO_ARM: Review. *)
    [ Instr ("pop", [ "{pc}" ]) ]


  let function_header =
    [
        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 ->
        (* TODO_ARM: Review. *)
        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
        (* We need to perform the check even if we don't use the suffix, for
           instance for [LDR] or [STR]. *)
        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)