1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) 6(* Bill O'Farrell, IBM *) 7(* *) 8(* Copyright 2015 Institut National de Recherche en Informatique et *) 9(* en Automatique. *) 10(* Copyright 2015 IBM (Bill O'Farrell with help from Tristan Amini). *) 11(* *) 12(* All rights reserved. This file is distributed under the terms of *) 13(* the GNU Lesser General Public License version 2.1, with the *) 14(* special exception on linking described in the file LICENSE. *) 15(* *) 16(**************************************************************************) 17 18(* Description of the Z Processor *) 19 20open Misc 21open Cmm 22open Reg 23open Arch 24open Mach 25 26(* Instruction selection *) 27 28let word_addressed = false 29 30(* Registers available for register allocation *) 31 32(* Integer register map: 33 0 temporary, null register for some operations (volatile) 34 1 temporary (volatile) 35 2 - 5 function arguments and results (volatile) 36 6 function arguments and results (persevered by C) 37 7 - 9 general purpose, preserved by C 38 10 allocation limit (preserved by C) 39 11 allocation pointer (preserved by C) 40 12 general purpose (preserved by C) 41 13 trap pointer (preserved by C) 42 14 return address (volatile) 43 15 stack pointer (preserved by C) 44 Floating-point register map: 45 0, 2, 4, 6 function arguments and results (volatile) 46 1, 3, 5, 7 general purpose (volatile) 47 8 - 14 general purpose, preserved by C 48 15 temporary, preserved by C 49 50Note: integer register r12 is used as GOT pointer by some C compilers. 51The code generated by OCaml does not need a GOT pointer, using PC-relative 52addressing instead for accessing the GOT. This frees r12 as a 53general-purpose register. *) 54 55let int_reg_name = 56 [| "%r2"; "%r3"; "%r4"; "%r5"; "%r6"; "%r7"; "%r8"; "%r9"; "%r12" |] 57 58let float_reg_name = 59 [| "%f0"; "%f2"; "%f4"; "%f6"; "%f1"; "%f3"; "%f5"; "%f7"; 60 "%f8"; "%f9"; "%f10"; "%f11"; "%f12"; "%f13"; "%f14"; "%f15" |] 61 62let num_register_classes = 2 63 64let register_class r = 65 match r.typ with 66 | Val | Int | Addr -> 0 67 | Float -> 1 68 69let num_available_registers = [| 9; 15 |] 70 71let first_available_register = [| 0; 100 |] 72 73let register_name r = 74 if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) 75 76let rotate_registers = true 77 78(* Representation of hard registers by pseudo-registers *) 79 80let hard_int_reg = 81 let v = Array.make 9 Reg.dummy in 82 for i = 0 to 8 do v.(i) <- Reg.at_location Int (Reg i) done; v 83 84let hard_float_reg = 85 let v = Array.make 16 Reg.dummy in 86 for i = 0 to 15 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; v 87 88let all_phys_regs = 89 Array.append hard_int_reg hard_float_reg 90 91let phys_reg n = 92 if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) 93 94let stack_slot slot ty = 95 Reg.at_location ty (Stack slot) 96 97let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *) 98 99(* Calling conventions *) 100 101let calling_conventions 102 first_int last_int first_float last_float make_stack stack_ofs arg = 103 let loc = Array.make (Array.length arg) Reg.dummy in 104 let int = ref first_int in 105 let float = ref first_float in 106 let ofs = ref stack_ofs in 107 for i = 0 to Array.length arg - 1 do 108 match arg.(i).typ with 109 | Val | Int | Addr as ty -> 110 if !int <= last_int then begin 111 loc.(i) <- phys_reg !int; 112 incr int 113 end else begin 114 loc.(i) <- stack_slot (make_stack !ofs) ty; 115 ofs := !ofs + size_int 116 end 117 | Float -> 118 if !float <= last_float then begin 119 loc.(i) <- phys_reg !float; 120 incr float 121 end else begin 122 loc.(i) <- stack_slot (make_stack !ofs) Float; 123 ofs := !ofs + size_float 124 end 125 done; 126 (loc, Misc.align !ofs 16) 127 (* Keep stack 16-aligned. *) 128 129let incoming ofs = Incoming ofs 130let outgoing ofs = Outgoing ofs 131let not_supported _ofs = fatal_error "Proc.loc_results: cannot call" 132 133let max_arguments_for_tailcalls = 5 134 135let loc_arguments arg = 136 calling_conventions 0 4 100 103 outgoing 0 arg 137let loc_parameters arg = 138 let (loc, _ofs) = calling_conventions 0 4 100 103 incoming 0 arg in loc 139let loc_results res = 140 let (loc, _ofs) = calling_conventions 0 4 100 103 not_supported 0 res in loc 141 142(* C calling conventions under SVR4: 143 use GPR 2-6 and FPR 0,2,4,6 just like ML calling conventions. 144 Using a float register does not affect the int registers. 145 Always reserve 160 bytes at bottom of stack, plus whatever is needed 146 to hold the overflow arguments. *) 147 148let loc_external_arguments arg = 149 let arg = 150 Array.map (fun regs -> assert (Array.length regs = 1); regs.(0)) arg in 151 let (loc, ofs) = 152 calling_conventions 0 4 100 103 outgoing 160 arg in 153 (Array.map (fun reg -> [|reg|]) loc, ofs) 154 155(* Results are in GPR 2 and FPR 0 *) 156 157let loc_external_results res = 158 let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported 0 res in loc 159 160(* Exceptions are in GPR 2 *) 161 162let loc_exn_bucket = phys_reg 0 163 164(* Volatile registers: none *) 165 166let regs_are_volatile _rs = false 167 168(* Registers destroyed by operations *) 169 170let destroyed_at_c_call = 171 Array.of_list(List.map phys_reg 172 [0; 1; 2; 3; 4; 173 100; 101; 102; 103; 104; 105; 106; 107]) 174 175let destroyed_at_oper = function 176 Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; _ }) -> 177 all_phys_regs 178 | Iop(Iextcall { alloc = false; _ }) -> destroyed_at_c_call 179 | _ -> [||] 180 181let destroyed_at_raise = all_phys_regs 182 183(* Maximal register pressure *) 184 185let safe_register_pressure = function 186 Iextcall _ -> 4 187 | _ -> 9 188 189let max_register_pressure = function 190 Iextcall _ -> [| 4; 7 |] 191 | _ -> [| 9; 15 |] 192 193(* Pure operations (without any side effect besides updating their result 194 registers). *) 195 196let op_is_pure = function 197 | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ 198 | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ 199 | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false 200 | Ispecific(Imultaddf | Imultsubf) -> true 201 | _ -> true 202 203(* Layout of the stack *) 204 205let num_stack_slots = [| 0; 0 |] 206let contains_calls = ref false 207 208(* Calling the assembler *) 209 210let assemble_file infile outfile = 211 Ccomp.command (Config.asm ^ " -o " ^ 212 Filename.quote outfile ^ " " ^ Filename.quote infile) 213 214let init () = () 215