1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*                 Benedikt Meurer, University of Siegen                  *)
6(*                                                                        *)
7(*   Copyright 1998 Institut National de Recherche en Informatique et     *)
8(*     en Automatique.                                                    *)
9(*   Copyright 2012 Benedikt Meurer.                                      *)
10(*                                                                        *)
11(*   All rights reserved.  This file is distributed under the terms of    *)
12(*   the GNU Lesser General Public License version 2.1, with the          *)
13(*   special exception on linking described in the file LICENSE.          *)
14(*                                                                        *)
15(**************************************************************************)
16
17(* Specific operations for the ARM processor *)
18
19open Format
20
21type abi = EABI | EABI_HF
22type arch = ARMv4 | ARMv5 | ARMv5TE | ARMv6 | ARMv6T2 | ARMv7
23type fpu = Soft | VFPv2 | VFPv3_D16 | VFPv3
24
25let abi =
26  match Config.system with
27    "linux_eabi" | "freebsd" -> EABI
28  | "linux_eabihf" | "netbsd" -> EABI_HF
29  | _ -> assert false
30
31let string_of_arch = function
32    ARMv4   -> "armv4"
33  | ARMv5   -> "armv5"
34  | ARMv5TE -> "armv5te"
35  | ARMv6   -> "armv6"
36  | ARMv6T2 -> "armv6t2"
37  | ARMv7   -> "armv7"
38
39let string_of_fpu = function
40    Soft      -> "soft"
41  | VFPv2     -> "vfpv2"
42  | VFPv3_D16 -> "vfpv3-d16"
43  | VFPv3     -> "vfpv3"
44
45(* Machine-specific command-line options *)
46
47let (arch, fpu, thumb) =
48  let (def_arch, def_fpu, def_thumb) =
49    begin match abi, Config.model with
50    (* Defaults for architecture, FPU and Thumb *)
51      EABI, "armv5"    -> ARMv5,   Soft,      false
52    | EABI, "armv5te"  -> ARMv5TE, Soft,      false
53    | EABI, "armv6"    -> ARMv6,   Soft,      false
54    | EABI, "armv6t2"  -> ARMv6T2, Soft,      false
55    | EABI, "armv7"    -> ARMv7,   Soft,      false
56    | EABI, _          -> ARMv4,   Soft,      false
57    | EABI_HF, "armv6" -> ARMv6,   VFPv2,     false
58    | EABI_HF, _       -> ARMv7,   VFPv3_D16, true
59    end in
60  (ref def_arch, ref def_fpu, ref def_thumb)
61
62let farch spec =
63  arch := begin match spec with
64             "armv4" when abi <> EABI_HF   -> ARMv4
65           | "armv5" when abi <> EABI_HF   -> ARMv5
66           | "armv5te" when abi <> EABI_HF -> ARMv5TE
67           | "armv6"                       -> ARMv6
68           | "armv6t2"                     -> ARMv6T2
69           | "armv7"                       -> ARMv7
70           | spec -> raise (Arg.Bad ("wrong '-farch' option: " ^ spec))
71  end
72
73let ffpu spec =
74  fpu := begin match spec with
75            "soft" when abi <> EABI_HF     -> Soft
76          | "vfpv2" when abi = EABI_HF     -> VFPv2
77          | "vfpv3-d16" when abi = EABI_HF -> VFPv3_D16
78          | "vfpv3" when abi = EABI_HF     -> VFPv3
79          | spec -> raise (Arg.Bad ("wrong '-ffpu' option: " ^ spec))
80  end
81
82let command_line_options =
83  [ "-farch", Arg.String farch,
84      "<arch>  Select the ARM target architecture"
85      ^ " (default: " ^ (string_of_arch !arch) ^ ")";
86    "-ffpu", Arg.String ffpu,
87      "<fpu>  Select the floating-point hardware"
88      ^ " (default: " ^ (string_of_fpu !fpu) ^ ")";
89    "-fPIC", Arg.Set Clflags.pic_code,
90      " Generate position-independent machine code";
91    "-fno-PIC", Arg.Clear Clflags.pic_code,
92      " Generate position-dependent machine code";
93    "-fthumb", Arg.Set thumb,
94      " Enable Thumb/Thumb-2 code generation"
95      ^ (if !thumb then " (default)" else "");
96    "-fno-thumb", Arg.Clear thumb,
97      " Disable Thumb/Thumb-2 code generation"
98      ^ (if not !thumb then " (default" else "")]
99
100(* Addressing modes *)
101
102type addressing_mode =
103    Iindexed of int                     (* reg + displ *)
104
105(* We do not support the reg + shifted reg addressing mode, because
106   what we really need is reg + shifted reg + displ,
107   and this is decomposed in two instructions (reg + shifted reg -> tmp,
108   then addressing tmp + displ). *)
109
110(* Specific operations *)
111
112type specific_operation =
113    Ishiftarith of arith_operation * shift_operation * int
114  | Ishiftcheckbound of shift_operation * int
115  | Irevsubimm of int
116  | Imulhadd      (* multiply high and add *)
117  | Imuladd       (* multiply and add *)
118  | Imulsub       (* multiply and subtract *)
119  | Inegmulf      (* floating-point negate and multiply *)
120  | Imuladdf      (* floating-point multiply and add *)
121  | Inegmuladdf   (* floating-point negate, multiply and add *)
122  | Imulsubf      (* floating-point multiply and subtract *)
123  | Inegmulsubf   (* floating-point negate, multiply and subtract *)
124  | Isqrtf        (* floating-point square root *)
125  | Ibswap of int (* endianess conversion *)
126
127and arith_operation =
128    Ishiftadd
129  | Ishiftsub
130  | Ishiftsubrev
131  | Ishiftand
132  | Ishiftor
133  | Ishiftxor
134
135and shift_operation =
136    Ishiftlogicalleft
137  | Ishiftlogicalright
138  | Ishiftarithmeticright
139
140let spacetime_node_hole_pointer_is_live_before _specific_op = false
141
142(* Sizes, endianness *)
143
144let big_endian = false
145
146let size_addr = 4
147let size_int = 4
148let size_float = 8
149
150let allow_unaligned_access = false
151
152(* Behavior of division *)
153
154let division_crashes_on_overflow = false
155
156(* Operations on addressing modes *)
157
158let identity_addressing = Iindexed 0
159
160let offset_addressing (Iindexed n) delta = Iindexed(n + delta)
161
162let num_args_addressing (Iindexed _) = 1
163
164(* Printing operations and addressing modes *)
165
166let print_addressing printreg addr ppf arg =
167  match addr with
168  | Iindexed n ->
169      printreg ppf arg.(0);
170      if n <> 0 then fprintf ppf " + %i" n
171
172let shiftop_name = function
173  | Ishiftlogicalleft -> "<<"
174  | Ishiftlogicalright -> ">>u"
175  | Ishiftarithmeticright -> ">>s"
176
177let print_specific_operation printreg op ppf arg =
178  match op with
179    Ishiftarith(op, shiftop, amount) ->
180      let (op1_name, op2_name) = match op with
181          Ishiftadd -> ("", "+")
182        | Ishiftsub -> ("", "-")
183        | Ishiftsubrev -> ("-", "+")
184        | Ishiftand -> ("", "&")
185        | Ishiftor -> ("", "|")
186        | Ishiftxor -> ("", "^") in
187      fprintf ppf "%s%a %s (%a %s %i)"
188        op1_name
189        printreg arg.(0)
190        op2_name
191        printreg arg.(1)
192        (shiftop_name shiftop)
193        amount
194  | Ishiftcheckbound(shiftop, amount) ->
195      fprintf ppf "check (%a %s %i) > %a"
196        printreg arg.(0)
197        (shiftop_name shiftop)
198        amount
199        printreg arg.(1)
200  | Irevsubimm n ->
201      fprintf ppf "%i %s %a" n "-" printreg arg.(0)
202  | Imulhadd ->
203      fprintf ppf "%a *h %a) + %a"
204        printreg arg.(0)
205        printreg arg.(1)
206        printreg arg.(2)
207  | Imuladd ->
208      fprintf ppf "(%a * %a) + %a"
209        printreg arg.(0)
210        printreg arg.(1)
211        printreg arg.(2)
212  | Imulsub ->
213      fprintf ppf "-(%a * %a) + %a"
214        printreg arg.(0)
215        printreg arg.(1)
216        printreg arg.(2)
217  | Inegmulf ->
218      fprintf ppf "-f (%a *f %a)"
219        printreg arg.(0)
220        printreg arg.(1)
221  | Imuladdf ->
222      fprintf ppf "%a +f (%a *f %a)"
223        printreg arg.(0)
224        printreg arg.(1)
225        printreg arg.(2)
226  | Inegmuladdf ->
227      fprintf ppf "%a -f (%a *f %a)"
228        printreg arg.(0)
229        printreg arg.(1)
230        printreg arg.(2)
231  | Imulsubf ->
232      fprintf ppf "(-f %a) +f (%a *f %a)"
233        printreg arg.(0)
234        printreg arg.(1)
235        printreg arg.(2)
236  | Inegmulsubf ->
237      fprintf ppf "(-f %a) -f (%a *f %a)"
238        printreg arg.(0)
239        printreg arg.(1)
240        printreg arg.(2)
241  | Isqrtf ->
242      fprintf ppf "sqrtf %a"
243        printreg arg.(0)
244  | Ibswap n ->
245      fprintf ppf "bswap%i %a" n
246        printreg arg.(0)
247
248(* Recognize immediate operands *)
249
250(* Immediate operands are 8-bit immediate values, zero-extended,
251   and rotated right by 0 ... 30 bits.
252   In Thumb/Thumb-2 mode we utilize 26 ... 30. *)
253
254let is_immediate n =
255  let n = ref n in
256  let s = ref 0 in
257  let m = if !thumb then 24 else 30 in
258  while (!s <= m && Int32.logand !n 0xffl <> !n) do
259    n := Int32.logor (Int32.shift_right_logical !n 2) (Int32.shift_left !n 30);
260    s := !s + 2
261  done;
262  !s <= m
263