1998-10-09 07:43:30 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Objective Caml *)
|
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 1998 Institut National de Recherche en Informatique et *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
|
(* under the terms of the Q Public License version 1.0. *)
|
1998-10-09 07:43:30 -07:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
|
|
|
(* Description of the ARM processor *)
|
|
|
|
|
|
|
|
open Misc
|
|
|
|
open Cmm
|
|
|
|
open Reg
|
|
|
|
open Arch
|
|
|
|
open Mach
|
|
|
|
|
|
|
|
(* Instruction selection *)
|
|
|
|
|
|
|
|
let word_addressed = false
|
|
|
|
|
|
|
|
(* Registers available for register allocation *)
|
|
|
|
|
|
|
|
(* Register map:
|
2009-05-04 06:46:46 -07:00
|
|
|
r0 - r3 general purpose (not preserved by C)
|
|
|
|
r4 - r7 general purpose (preserved)
|
|
|
|
r8 allocation pointer (preserved)
|
|
|
|
r9 platform register, usually reserved
|
|
|
|
r10 allocation limit (preserved)
|
|
|
|
r11 trap pointer (preserved)
|
|
|
|
r12 general purpose (not preserved by C)
|
1998-10-09 07:43:30 -07:00
|
|
|
r13 stack pointer
|
|
|
|
r14 return address
|
|
|
|
r15 program counter
|
|
|
|
*)
|
|
|
|
|
|
|
|
let int_reg_name = [|
|
2009-05-04 06:46:46 -07:00
|
|
|
"r0"; "r1"; "r2"; "r3"; "r4"; "r5"; "r6"; "r7"; "r12"
|
1998-10-09 07:43:30 -07:00
|
|
|
|]
|
1999-11-29 11:16:30 -08:00
|
|
|
|
2009-03-31 02:45:55 -07:00
|
|
|
let num_register_classes = 1
|
1998-10-09 07:43:30 -07:00
|
|
|
|
2009-03-31 02:45:55 -07:00
|
|
|
let register_class r = assert (r.typ <> Float); 0
|
1998-10-09 07:43:30 -07:00
|
|
|
|
2009-05-04 06:46:46 -07:00
|
|
|
let num_available_registers = [| 9 |]
|
1998-10-09 07:43:30 -07:00
|
|
|
|
2009-03-31 02:45:55 -07:00
|
|
|
let first_available_register = [| 0 |]
|
1998-10-09 07:43:30 -07:00
|
|
|
|
2009-03-31 02:45:55 -07:00
|
|
|
let register_name r = int_reg_name.(r)
|
1998-10-09 07:43:30 -07:00
|
|
|
|
|
|
|
let rotate_registers = true
|
|
|
|
|
|
|
|
(* Representation of hard registers by pseudo-registers *)
|
|
|
|
|
|
|
|
let hard_int_reg =
|
2009-05-04 06:46:46 -07:00
|
|
|
let v = Array.create 9 Reg.dummy in
|
|
|
|
for i = 0 to 8 do v.(i) <- Reg.at_location Int (Reg i) done;
|
1998-10-09 07:43:30 -07:00
|
|
|
v
|
|
|
|
|
2009-03-31 02:45:55 -07:00
|
|
|
let all_phys_regs = hard_int_reg
|
1998-10-09 07:43:30 -07:00
|
|
|
|
2009-03-31 02:45:55 -07:00
|
|
|
let phys_reg n = all_phys_regs.(n)
|
1998-10-09 07:43:30 -07:00
|
|
|
|
|
|
|
let stack_slot slot ty =
|
2009-03-31 02:45:55 -07:00
|
|
|
assert (ty <> Float);
|
1998-10-09 07:43:30 -07:00
|
|
|
Reg.at_location ty (Stack slot)
|
|
|
|
|
|
|
|
(* Calling conventions *)
|
|
|
|
|
2009-03-31 02:45:55 -07:00
|
|
|
(* XXX float types have already been expanded into pairs of integers.
|
|
|
|
So we cannot align these floats. See if that causes a problem. *)
|
|
|
|
|
|
|
|
let calling_conventions first_int last_int make_stack arg =
|
1998-10-09 07:43:30 -07:00
|
|
|
let loc = Array.create (Array.length arg) Reg.dummy in
|
|
|
|
let int = ref first_int in
|
|
|
|
let ofs = ref 0 in
|
|
|
|
for i = 0 to Array.length arg - 1 do
|
|
|
|
match arg.(i).typ with
|
|
|
|
Int | Addr as ty ->
|
|
|
|
if !int <= last_int then begin
|
|
|
|
loc.(i) <- phys_reg !int;
|
|
|
|
incr int
|
|
|
|
end else begin
|
|
|
|
loc.(i) <- stack_slot (make_stack !ofs) ty;
|
|
|
|
ofs := !ofs + size_int
|
|
|
|
end
|
|
|
|
| Float ->
|
2009-03-31 02:45:55 -07:00
|
|
|
assert false
|
1998-10-09 07:43:30 -07:00
|
|
|
done;
|
2009-03-31 02:45:55 -07:00
|
|
|
(loc, Misc.align !ofs 8)
|
1998-10-09 07:43:30 -07:00
|
|
|
|
|
|
|
let incoming ofs = Incoming ofs
|
|
|
|
let outgoing ofs = Outgoing ofs
|
|
|
|
let not_supported ofs = fatal_error "Proc.loc_results: cannot call"
|
|
|
|
|
|
|
|
let loc_arguments arg =
|
2009-03-31 02:45:55 -07:00
|
|
|
calling_conventions 0 7 outgoing arg
|
1998-10-09 07:43:30 -07:00
|
|
|
let loc_parameters arg =
|
2009-03-31 02:45:55 -07:00
|
|
|
let (loc, ofs) = calling_conventions 0 7 incoming arg in loc
|
1998-10-09 07:43:30 -07:00
|
|
|
let loc_results res =
|
2009-03-31 02:45:55 -07:00
|
|
|
let (loc, ofs) = calling_conventions 0 7 not_supported res in loc
|
1998-10-09 07:43:30 -07:00
|
|
|
|
|
|
|
let loc_external_arguments arg =
|
2009-03-31 02:45:55 -07:00
|
|
|
calling_conventions 0 3 outgoing arg
|
1998-10-09 07:43:30 -07:00
|
|
|
let loc_external_results res =
|
2009-03-31 02:45:55 -07:00
|
|
|
let (loc, ofs) = calling_conventions 0 1 not_supported res in loc
|
1998-10-09 07:43:30 -07:00
|
|
|
|
|
|
|
let loc_exn_bucket = phys_reg 0
|
|
|
|
|
|
|
|
(* Registers destroyed by operations *)
|
|
|
|
|
2009-05-04 06:46:46 -07:00
|
|
|
let destroyed_at_c_call = (* r4-r7 preserved *)
|
|
|
|
Array.of_list(List.map phys_reg [0;1;2;3;8])
|
1998-10-09 07:43:30 -07:00
|
|
|
|
|
|
|
let destroyed_at_oper = function
|
|
|
|
Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs
|
|
|
|
| Iop(Iextcall(_, false)) -> destroyed_at_c_call
|
2009-05-04 06:46:46 -07:00
|
|
|
| Iop(Ialloc(_)) -> [|phys_reg 8|] (* r12 destroyed *)
|
1998-10-09 07:43:30 -07:00
|
|
|
| _ -> [||]
|
|
|
|
|
|
|
|
let destroyed_at_raise = all_phys_regs
|
|
|
|
|
|
|
|
(* Maximal register pressure *)
|
|
|
|
|
|
|
|
let safe_register_pressure = function
|
|
|
|
Iextcall(_, _) -> 4
|
2009-05-04 06:46:46 -07:00
|
|
|
| _ -> 9
|
1998-10-09 07:43:30 -07:00
|
|
|
let max_register_pressure = function
|
2009-03-31 02:45:55 -07:00
|
|
|
Iextcall(_, _) -> [| 4 |]
|
2009-05-04 06:46:46 -07:00
|
|
|
| _ -> [| 9 |]
|
1998-10-09 07:43:30 -07:00
|
|
|
|
|
|
|
(* Layout of the stack *)
|
|
|
|
|
2009-03-31 02:45:55 -07:00
|
|
|
let num_stack_slots = [| 0 |]
|
1998-10-09 07:43:30 -07:00
|
|
|
let contains_calls = ref false
|
|
|
|
|
|
|
|
(* Calling the assembler *)
|
|
|
|
|
|
|
|
let assemble_file infile outfile =
|
2007-10-30 05:37:16 -07:00
|
|
|
Ccomp.command (Config.asm ^ " -o " ^
|
|
|
|
Filename.quote outfile ^ " " ^ Filename.quote infile)
|
1998-10-09 07:43:30 -07:00
|
|
|
|
2002-07-22 09:38:07 -07:00
|
|
|
open Clflags;;
|
|
|
|
open Config;;
|