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