1# 2 "asmcomp/i386/proc.ml" 2(**************************************************************************) 3(* *) 4(* OCaml *) 5(* *) 6(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) 7(* *) 8(* Copyright 1996 Institut National de Recherche en Informatique et *) 9(* en Automatique. *) 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 Intel 386 processor *) 18 19open Misc 20open Arch 21open Cmm 22open Reg 23open Mach 24 25(* Which asm conventions to use *) 26let masm = 27 match Config.ccomp_type with 28 | "msvc" -> true 29 | _ -> false 30 31(* Registers available for register allocation *) 32 33(* Register map: 34 eax 0 eax - edi: function arguments and results 35 ebx 1 eax: C function results 36 ecx 2 ebx, esi, edi, ebp: preserved by C 37 edx 3 38 esi 4 39 edi 5 40 ebp 6 41 42 tos 100 top of floating-point stack. *) 43 44let int_reg_name = 45 if masm then 46 [| "eax"; "ebx"; "ecx"; "edx"; "esi"; "edi"; "ebp" |] 47 else 48 [| "%eax"; "%ebx"; "%ecx"; "%edx"; "%esi"; "%edi"; "%ebp" |] 49 50let float_reg_name = 51 if masm then 52 [| "tos" |] 53 else 54 [| "%tos" |] 55 56let num_register_classes = 2 57 58let register_class r = 59 match r.typ with 60 | Val | Int | Addr -> 0 61 | Float -> 1 62 63let num_available_registers = [| 7; 0 |] 64 65let first_available_register = [| 0; 100 |] 66 67let register_name r = 68 if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) 69 70(* There is little scheduling, and some operations are more compact 71 when their argument is %eax. *) 72 73let rotate_registers = false 74 75(* Representation of hard registers by pseudo-registers *) 76 77let hard_int_reg = 78 let v = Array.make 7 Reg.dummy in 79 for i = 0 to 6 do v.(i) <- Reg.at_location Int (Reg i) done; 80 v 81 82let hard_float_reg = [| Reg.at_location Float (Reg 100) |] 83 84let all_phys_regs = 85 Array.append hard_int_reg hard_float_reg 86 87let phys_reg n = 88 if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) 89 90let eax = phys_reg 0 91let ecx = phys_reg 2 92let edx = phys_reg 3 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(* Instruction selection *) 100 101let word_addressed = false 102 103(* Calling conventions *) 104 105(* To supplement the processor's meagre supply of registers, we also 106 use some global memory locations to pass arguments beyond the 6th. 107 These globals are denoted by Incoming and Outgoing stack locations 108 with negative offsets, starting at -64. 109 Unlike arguments passed on stack, arguments passed in globals 110 do not prevent tail-call elimination. The caller stores arguments 111 in these globals immediately before the call, and the first thing the 112 callee does is copy them to registers or stack locations. 113 Neither GC nor thread context switches can occur between these two 114 times. *) 115 116let calling_conventions first_int last_int first_float last_float make_stack 117 arg = 118 let loc = Array.make (Array.length arg) Reg.dummy in 119 let int = ref first_int in 120 let float = ref first_float in 121 let ofs = ref (-64) in 122 for i = 0 to Array.length arg - 1 do 123 match arg.(i).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 if !float <= last_float then begin 134 loc.(i) <- phys_reg !float; 135 incr float 136 end else begin 137 loc.(i) <- stack_slot (make_stack !ofs) Float; 138 ofs := !ofs + size_float 139 end 140 done; 141 (loc, Misc.align (max 0 !ofs) stack_alignment) 142 143let incoming ofs = Incoming ofs 144let outgoing ofs = Outgoing ofs 145let not_supported _ofs = fatal_error "Proc.loc_results: cannot call" 146 147(* Six arguments in integer registers plus eight in global memory. *) 148let max_arguments_for_tailcalls = 14 149 150let loc_arguments arg = 151 calling_conventions 0 5 100 99 outgoing arg 152let loc_parameters arg = 153 let (loc, _ofs) = calling_conventions 0 5 100 99 incoming arg in loc 154let loc_results res = 155 let (loc, _ofs) = calling_conventions 0 5 100 100 not_supported res in loc 156let loc_external_arguments _arg = 157 fatal_error "Proc.loc_external_arguments" 158let loc_external_results res = 159 match res with 160 | [|{typ=Int};{typ=Int}|] -> [|eax; edx|] 161 | _ -> 162 let (loc, _ofs) = calling_conventions 0 0 100 100 not_supported res in loc 163 164let loc_exn_bucket = eax 165 166(* Volatile registers: the x87 top of FP stack is *) 167 168let reg_is_volatile = function 169 | { typ = Float; loc = Reg _ } -> true 170 | _ -> false 171 172let regs_are_volatile rs = 173 try 174 for i = 0 to Array.length rs - 1 do 175 if reg_is_volatile rs.(i) then raise Exit 176 done; 177 false 178 with Exit -> 179 true 180 181(* Registers destroyed by operations *) 182 183let destroyed_at_c_call = (* ebx, esi, edi, ebp preserved *) 184 [|eax; ecx; edx|] 185 186let destroyed_at_oper = function 187 Iop(Icall_ind _ | Icall_imm _ | Iextcall { alloc = true; _}) -> 188 all_phys_regs 189 | Iop(Iextcall { alloc = false; }) -> destroyed_at_c_call 190 | Iop(Iintop(Idiv | Imod)) -> [| eax; edx |] 191 | Iop(Ialloc _ | Iintop Imulh) -> [| eax |] 192 | Iop(Iintop(Icomp _) | Iintop_imm(Icomp _, _)) -> [| eax |] 193 | Iop(Iintoffloat) -> [| eax |] 194 | Iifthenelse(Ifloattest(_, _), _, _) -> [| eax |] 195 | _ -> [||] 196 197let destroyed_at_raise = all_phys_regs 198 199(* Maximal register pressure *) 200 201let safe_register_pressure _op = 4 202 203let max_register_pressure = function 204 Iextcall _ -> [| 4; max_int |] 205 | Iintop(Idiv | Imod) -> [| 5; max_int |] 206 | Ialloc _ | Iintop(Icomp _) | Iintop_imm(Icomp _, _) | 207 Iintoffloat -> [| 6; max_int |] 208 | _ -> [|7; max_int |] 209 210(* Pure operations (without any side effect besides updating their result 211 registers). *) 212 213let op_is_pure = function 214 | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ 215 | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ 216 | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false 217 | Ispecific(Ilea _) -> true 218 | Ispecific _ -> false 219 | _ -> true 220 221(* Layout of the stack frame *) 222 223let num_stack_slots = [| 0; 0 |] 224let contains_calls = ref false 225 226(* Calling the assembler *) 227 228let assemble_file infile outfile = 229 X86_proc.assemble_file infile outfile 230 231let init () = () 232