package jasmin

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

Source file pp_arm_v8a.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
(* Assembly printer for ARMv8-A (AArch64).

   GNU assembler (ELF) syntax. General-purpose registers are printed in
   their 64-bit X form except for the instruction operands that require the
   32-bit W form (narrow loads and stores, 32-bit multiplies, zero
   extensions). Immediate values are printed as nonnegative integers. *)

open Arch_decl
open Utils
open PrintASM
open Asm_utils

(* Architecture imports*)
open Arm_common
open Armv8a_decl
open Armv8a_instr_decl

let arch = armv8a_decl

let imm_pre = "#"

(* We support the following AArch64 memory accesses.
   Offset addressing:
     - A base register and an immediate offset (displacement):
       [<reg>, #<imm>].
     - 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_imm = pp_imm imm_pre

let pp_register = pp_register arch

(* The 32-bit (W) view of a general-purpose register. *)
let pp_wregister r =
  match pp_register r with
  | "xzr" -> "wzr"
  | "sp" -> "wsp"
  | s -> "w" ^ String.sub s 1 (String.length s - 1)

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

(* A64 has no conditional execution: a condition is always a proper operand
   (CSEL, CSET, ...), declared last in the argument list, so it is printed
   in place like any other operand. *)
let pp_asm_arg ?(wform = false) (arg : (register, Arch_utils.empty, Arch_utils.empty, rflag, condt) asm_arg) =
  match arg with
  | Condt ct -> pp_condt ct
  | Imm (ws, w) -> pp_imm (Conv.z_unsigned_of_word ws w)
  | Reg r -> if wform then pp_wregister r else pp_register r
  | Regx _ -> .
  | Addr (Areg ra) -> pp_reg_address ra
  | Addr (Arip r) -> pp_rip_address r
  | XReg _ -> .

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

let pp_shift_kind = hash_to_string string_of_shift_kind

(* Append the optional shift to the last (immediate) operand:
   [..., <shift> #<amount>]. *)
let pp_shift (ARMv8A_op (_, opts)) args =
  match has_shift opts with
  | None ->
      args
  | Some sk ->
      let sh = pp_shift_kind sk in
      List.modify_last (Format.asprintf "%s %s" sh) args

(* The last operand of MOVZ/MOVN/MOVK is the halfword shift: print it as
   [LSL #<sh>], dropping it when it is zero. *)
let pp_mov_wide_shift args =
  match List.rev args with
  | "#0" :: rest -> List.rev rest
  | sh :: rest -> List.rev (Format.asprintf "lsl %s" sh :: rest)
  | [] -> []

let pp_mnemonic (ARMv8A_op (mn, _) as op) =
  let id = instr_desc Armv8a_decl.armv8a_decl Armv8a_instr_decl.armv8a_op_decl (None, op) in
  let pp = id.id_pp_asm [] in
  match mn with
  | UXTW -> "mov" (* [UXTW] is written [MOV <Wd>, <Wn>]. *)
  | _ -> String.lowercase_ascii pp.pp_aop_name

(* Split an [ADR] instruction to a global symbol into an [ADRP]/[ADD]
   pair using :lo12: relocations. *)
let pp_ADR args =
  match args with
  | dst :: addr :: _ ->
      [ Instr ("adrp", [ dst; addr ]);
        Instr ("add", [ dst; dst; ":lo12:" ^ addr ]) ]
  | _ -> assert false

module Armv8aTarget : AsmTargetBuilder.AsmTarget with
  type reg = Armv8a_decl.register
  and type regx = Arch_utils.empty
  and type xreg = Arch_utils.empty
  and type rflag = Arm_common.rflag
  and type cond = Arm_common.condt
  and type asm_op = armv8a_asm_op
= struct

  type reg = Armv8a_decl.register
  type regx = Arch_utils.empty
  type xreg = Arch_utils.empty
  type rflag = Arm_common.rflag
  type cond = Arm_common.condt
  type asm_op = armv8a_asm_op

  let headers = []

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

  (* A64 instructions must be 4-byte aligned. *)
  let function_directives = [ Instr (".p2align", ["2"]) ]

  (* The return address (X30) is saved on the stack around the body of
     export functions; SP must stay 16-byte aligned. *)
  let function_header =
    [
      Instr ("str", [ "x30"; "[sp, #-16]!" ])
    ]

  let function_tail =
    [
      Instr ("ldr", [ "x30"; "[sp], #16" ]);
      Instr ("ret", [])
    ]

  let pp_instr_r fn i =
    match i with
    | ALIGN ->
        (* A64 instructions are fixed-width: code is always 4-byte
           aligned, there is nothing to emit. *)
        []

    | 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 ->
        begin match arg with
        | Reg R30 -> [ Instr ("ret", []) ]
        | Reg r -> [ Instr ("br", [ pp_register r ]) ]
        | _ ->
            hierror ~loc:Lnone ~kind:"assembly printing"
              "unsupported indirect jump argument"
        end

    | Jcc (lbl, ct) ->
        let iname = Format.asprintf "b.%s" (pp_condt ct) in
        [ Instr (iname, [ string_of_label fn lbl ]) ]

    | JAL (R30, lbl) ->
        [ Instr ("bl", [ pp_remote_label lbl ]) ]

    | CALL _
    | JAL _ -> assert false

    | POPPC ->
        [ Instr ("ldr", [ "x30"; "[sp], #16" ]); Instr ("ret", []) ]

    | SysCall op ->
        [ Instr ("bl", [ pp_syscall op ]) ]

    | Declassify_val (lty, a) ->
        declassify_val (fun _lty a -> pp_asm_arg a) lty a

    | Declassify_mem (len, a) ->
        declassify_mem arch len a

    | AsmOp (op, args) ->
        let (ARMv8A_op (mn, _)) = op in
        let id = instr_desc Armv8a_decl.armv8a_decl Armv8a_instr_decl.armv8a_op_decl (None, op) in
        let pp = id.id_pp_asm args in
        match op, args with
        | ARMv8A_op (ADR, _), _ :: Addr (Arip _) :: _ ->
            let args = List.map (fun (_, a) -> pp_asm_arg a) pp.pp_aop_args in
            pp_ADR args
        | _, _ ->
            let name = pp_mnemonic op in
            (* Registers are printed in the W form when the instruction
               declaration pairs them with a width of at most [U32]. *)
            let pargs =
              List.map
                (fun (sz, a) -> pp_asm_arg ~wform:(Wsize.size_8_32 sz) a)
                pp.pp_aop_args
            in
            let pargs =
              match mn with
              | MOVZ | MOVN | MOVK -> pp_mov_wide_shift pargs
              | _ -> pp_shift op pargs
            in
            [ Instr (name, pargs) ]

end

module Armv8aBuilder = AsmTargetBuilder.Make(Armv8aTarget)

let print_prog fmt prog = PrintASM.pp_asm fmt (Armv8aBuilder.asm_of_prog prog)