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(* Description of the ARM processor *) 18 19open Misc 20open Cmm 21open Reg 22open Arch 23open Mach 24 25(* Instruction selection *) 26 27let word_addressed = false 28 29(* Registers available for register allocation *) 30 31(* Integer register map: 32 r0 - r3 general purpose (not preserved) 33 r4 - r7 general purpose (preserved) 34 r8 trap pointer (preserved) 35 r9 platform register, usually reserved 36 r10 allocation pointer (preserved) 37 r11 allocation limit (preserved) 38 r12 intra-procedural scratch register (not preserved) 39 r13 stack pointer 40 r14 return address 41 r15 program counter 42 Floating-point register map (VFPv{2,3}): 43 d0 - d7 general purpose (not preserved) 44 d8 - d15 general purpose (preserved) 45 d16 - d31 generat purpose (not preserved), VFPv3 only 46*) 47 48let int_reg_name = 49 [| "r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12" |] 50 51let float_reg_name = 52 [| "d0"; "d1"; "d2"; "d3"; "d4"; "d5"; "d6"; "d7"; 53 "d8"; "d9"; "d10"; "d11"; "d12"; "d13"; "d14"; "d15"; 54 "d16"; "d17"; "d18"; "d19"; "d20"; "d21"; "d22"; "d23"; 55 "d24"; "d25"; "d26"; "d27"; "d28"; "d29"; "d30"; "d31" |] 56 57(* We have three register classes: 58 0 for integer registers 59 1 for VFPv2 and VFPv3-D16 60 2 for VFPv3 61 This way we can choose between VFPv2/VFPv3-D16 and VFPv3 62 at (ocamlopt) runtime using command line switches. 63*) 64 65let num_register_classes = 3 66 67let register_class r = 68 match (r.typ, !fpu) with 69 | (Val | Int | Addr), _ -> 0 70 | Float, VFPv2 -> 1 71 | Float, VFPv3_D16 -> 1 72 | Float, _ -> 2 73 74let num_available_registers = 75 [| 9; 16; 32 |] 76 77let first_available_register = 78 [| 0; 100; 100 |] 79 80let register_name r = 81 if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) 82 83let rotate_registers = true 84 85(* Representation of hard registers by pseudo-registers *) 86 87let hard_int_reg = 88 let v = Array.make 9 Reg.dummy in 89 for i = 0 to 8 do 90 v.(i) <- Reg.at_location Int (Reg i) 91 done; 92 v 93 94let hard_float_reg = 95 let v = Array.make 32 Reg.dummy in 96 for i = 0 to 31 do 97 v.(i) <- Reg.at_location Float (Reg(100 + i)) 98 done; 99 v 100 101let all_phys_regs = 102 Array.append hard_int_reg hard_float_reg 103 104let phys_reg n = 105 if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) 106 107let stack_slot slot ty = 108 Reg.at_location ty (Stack slot) 109 110let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *) 111 112(* Calling conventions *) 113 114let calling_conventions first_int last_int first_float last_float make_stack 115 arg = 116 let loc = Array.make (Array.length arg) [| Reg.dummy |] in 117 let int = ref first_int in 118 let float = ref first_float in 119 let ofs = ref 0 in 120 for i = 0 to Array.length arg - 1 do 121 match arg.(i) with 122 | [| arg |] -> 123 begin match arg.typ with 124 | Val | Int | Addr as ty -> 125 if !int <= last_int then begin 126 loc.(i) <- [| phys_reg !int |]; 127 incr int 128 end else begin 129 loc.(i) <- [| stack_slot (make_stack !ofs) ty |]; 130 ofs := !ofs + size_int 131 end 132 | Float -> 133 assert (abi = EABI_HF); 134 assert (!fpu >= VFPv2); 135 if !float <= last_float then begin 136 loc.(i) <- [| phys_reg !float |]; 137 incr float 138 end else begin 139 ofs := Misc.align !ofs size_float; 140 loc.(i) <- [| stack_slot (make_stack !ofs) Float |]; 141 ofs := !ofs + size_float 142 end 143 end 144 | [| arg1; arg2 |] -> 145 (* Passing of 64-bit quantities to external functions. *) 146 begin match arg1.typ, arg2.typ with 147 | Int, Int -> 148 (* 64-bit quantities split across two registers must either be in a 149 consecutive pair of registers where the lowest numbered is an 150 even-numbered register; or in a stack slot that is 8-byte 151 aligned. *) 152 int := Misc.align !int 2; 153 if !int <= last_int - 1 then begin 154 let reg_lower = phys_reg !int in 155 let reg_upper = phys_reg (1 + !int) in 156 loc.(i) <- [| reg_lower; reg_upper |]; 157 int := !int + 2 158 end else begin 159 let size_int64 = size_int * 2 in 160 ofs := Misc.align !ofs size_int64; 161 let stack_lower = stack_slot (make_stack !ofs) Int in 162 let stack_upper = stack_slot (make_stack (size_int + !ofs)) Int in 163 loc.(i) <- [| stack_lower; stack_upper |]; 164 ofs := !ofs + size_int64 165 end 166 | _, _ -> 167 let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in 168 fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \ 169 type(s) for multi-register argument: %s, %s" 170 (f arg1.typ) (f arg2.typ)) 171 end 172 | _ -> 173 fatal_error "Proc.calling_conventions: bad number of registers for \ 174 multi-register argument" 175 done; 176 (loc, Misc.align !ofs 8) (* keep stack 8-aligned *) 177 178let incoming ofs = Incoming ofs 179let outgoing ofs = Outgoing ofs 180let not_supported _ofs = fatal_error "Proc.loc_results: cannot call" 181 182(* OCaml calling convention: 183 first integer args in r0...r7 184 first float args in d0...d15 (EABI+VFP) 185 remaining args on stack. 186 Return values in r0...r7 or d0...d15. *) 187 188let max_arguments_for_tailcalls = 8 189 190let single_regs arg = Array.map (fun arg -> [| arg |]) arg 191let ensure_single_regs res = 192 Array.map (function 193 | [| res |] -> res 194 | _ -> failwith "Proc.ensure_single_regs") 195 res 196 197let loc_arguments arg = 198 let (loc, alignment) = 199 calling_conventions 0 7 100 115 outgoing (single_regs arg) 200 in 201 ensure_single_regs loc, alignment 202let loc_parameters arg = 203 let (loc, _) = calling_conventions 0 7 100 115 incoming (single_regs arg) in 204 ensure_single_regs loc 205let loc_results res = 206 let (loc, _) = 207 calling_conventions 0 7 100 115 not_supported (single_regs res) 208 in 209 ensure_single_regs loc 210 211(* C calling convention: 212 first integer args in r0...r3 213 first float args in d0...d7 (EABI+VFP) 214 remaining args on stack. 215 Return values in r0...r1 or d0. *) 216 217let loc_external_arguments arg = 218 calling_conventions 0 3 100 107 outgoing arg 219let loc_external_results res = 220 let (loc, _) = 221 calling_conventions 0 1 100 100 not_supported (single_regs res) 222 in 223 ensure_single_regs loc 224 225let loc_exn_bucket = phys_reg 0 226 227(* Volatile registers: none *) 228 229let regs_are_volatile _rs = false 230 231(* Registers destroyed by operations *) 232 233let destroyed_at_alloc = (* r0-r6, d0-d15 preserved *) 234 Array.of_list (List.map 235 phys_reg 236 [7;8; 237 116;117;118;119;120;121;122;123; 238 124;125;126;127;128;129;130;131]) 239 240let destroyed_at_c_call = 241 Array.of_list (List.map 242 phys_reg 243 (match abi with 244 EABI -> (* r4-r7 preserved *) 245 [0;1;2;3;8; 246 100;101;102;103;104;105;106;107; 247 108;109;110;111;112;113;114;115; 248 116;117;118;119;120;121;122;123; 249 124;125;126;127;128;129;130;131] 250 | EABI_HF -> (* r4-r7, d8-d15 preserved *) 251 [0;1;2;3;8; 252 100;101;102;103;104;105;106;107; 253 116;117;118;119;120;121;122;123; 254 124;125;126;127;128;129;130;131])) 255 256let destroyed_at_oper = function 257 Iop(Icall_ind _ | Icall_imm _) 258 | Iop(Iextcall { alloc = true; _ }) -> 259 all_phys_regs 260 | Iop(Iextcall { alloc = false; _}) -> 261 destroyed_at_c_call 262 | Iop(Ialloc _) -> 263 destroyed_at_alloc 264 | Iop(Iconst_symbol _) when !Clflags.pic_code -> 265 [| phys_reg 3; phys_reg 8 |] (* r3 and r12 destroyed *) 266 | Iop(Iintop Imulh) when !arch < ARMv6 -> 267 [| phys_reg 8 |] (* r12 destroyed *) 268 | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) -> 269 [| phys_reg 107 |] (* d7 (s14-s15) destroyed *) 270 | _ -> [||] 271 272let destroyed_at_raise = all_phys_regs 273 274(* Maximal register pressure *) 275 276let safe_register_pressure = function 277 Iextcall _ -> if abi = EABI then 0 else 4 278 | Ialloc _ -> if abi = EABI then 0 else 7 279 | Iconst_symbol _ when !Clflags.pic_code -> 7 280 | Iintop Imulh when !arch < ARMv6 -> 8 281 | _ -> 9 282 283let max_register_pressure = function 284 Iextcall _ -> if abi = EABI then [| 4; 0; 0 |] else [| 4; 8; 8 |] 285 | Ialloc _ -> if abi = EABI then [| 7; 0; 0 |] else [| 7; 8; 8 |] 286 | Iconst_symbol _ when !Clflags.pic_code -> [| 7; 16; 32 |] 287 | Iintoffloat | Ifloatofint 288 | Iload(Single, _) | Istore(Single, _, _) -> [| 9; 15; 31 |] 289 | Iintop Imulh when !arch < ARMv6 -> [| 8; 16; 32 |] 290 | _ -> [| 9; 16; 32 |] 291 292(* Pure operations (without any side effect besides updating their result 293 registers). *) 294 295let op_is_pure = function 296 | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ 297 | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ 298 | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) 299 | Ispecific(Ishiftcheckbound _) -> false 300 | _ -> true 301 302(* Layout of the stack *) 303 304let num_stack_slots = [| 0; 0; 0 |] 305let contains_calls = ref false 306 307(* Calling the assembler *) 308 309let assemble_file infile outfile = 310 Ccomp.command (Config.asm ^ " -o " ^ 311 Filename.quote outfile ^ " " ^ Filename.quote infile) 312 313 314let init () = () 315