l4/pkg/ocaml/ocaml/contrib/asmcomp/mips/proc.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id: proc.ml 8462 2007-10-30 12:37:16Z xleroy $ *)
  14
  15 (* Description of the Mips processor *)
  16
  17 open Misc
  18 open Cmm
  19 open Reg
  20 open Arch
  21 open Mach
  22
  23 (* Instruction selection *)
  24
  25 let word_addressed = false
  26
  27 (* Registers available for register allocation *)
  28
  29 (* Register map:
  30     $0                          always 0
  31     $1                          temporary for the assembler
  32     $2 - $7     0 - 5           function results
  33     $8 - $15    6 - 13          function arguments
  34     $16 - $21   14 - 19         general purpose (preserved by C)
  35     $22                         allocation pointer (preserved by C)
  36     $23                         allocation limit (preserved by C)
  37     $24 - $25                   temporaries
  38     $26 - $29                   kernel regs, stack pointer, global pointer
  39     $30                         trap pointer (preserved by C)
  40     $31                         return address
  41
  42     $f0 - $f3   100 - 103       function results
  43     $f4 - $f11  104 - 111       general purpose
  44     $f12 - $f19 112 - 119       function arguments
  45     $f20 - $f30 120 - 130       general purpose (even numbered preserved by C)
  46     $f31                        temporary *)
  47
  48 let int_reg_name = [|
  49   (* 0-5 *)    "$2"; "$3"; "$4"; "$5"; "$6"; "$7";
  50   (* 6-13 *)   "$8"; "$9"; "$10"; "$11"; "$12"; "$13"; "$14"; "$15";
  51   (* 14-19 *)  "$16"; "$17"; "$18"; "$19"; "$20"; "$21"
  52 |]
  53
  54 let float_reg_name = [|
  55   "$f0"; "$f1"; "$f2"; "$f3"; "$f4";
  56   "$f5"; "$f6"; "$f7"; "$f8"; "$f9";
  57   "$f10"; "$f11"; "$f12"; "$f13"; "$f14";
  58   "$f15"; "$f16"; "$f17"; "$f18"; "$f19";
  59   "$f20"; "$f21"; "$f22"; "$f23"; "$f24";
  60   "$f25"; "$f26"; "$f27"; "$f28"; "$f29"; "$f30"
  61 |]
  62
  63 let num_register_classes = 2
  64
  65 let register_class r =
  66   match r.typ with
  67     Int -> 0
  68   | Addr -> 0
  69   | Float -> 1
  70
  71 let num_available_registers = [| 20; 31 |]
  72
  73 let first_available_register = [| 0; 100 |]
  74
  75 let register_name r =
  76   if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
  77
  78 let rotate_registers = true
  79
  80 (* Representation of hard registers by pseudo-registers *)
  81
  82 let hard_int_reg =
  83   let v = Array.create 20 Reg.dummy in
  84   for i = 0 to 19 do v.(i) <- Reg.at_location Int (Reg i) done;
  85   v
  86
  87 let hard_float_reg =
  88   let v = Array.create 31 Reg.dummy in
  89   for i = 0 to 30 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done;
  90   v
  91
  92 let all_phys_regs =
  93   Array.append hard_int_reg hard_float_reg
  94
  95 let phys_reg n =
  96   if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
  97
  98 let stack_slot slot ty =
  99   Reg.at_location ty (Stack slot)
 100
 101 (* Calling conventions *)
 102
 103 let calling_conventions first_int last_int first_float last_float
 104                         make_stack arg =
 105   let loc = Array.create (Array.length arg) Reg.dummy in
 106   let int = ref first_int in
 107   let float = ref first_float in
 108   let ofs = ref 0 in
 109   for i = 0 to Array.length arg - 1 do
 110     match arg.(i).typ with
 111       Int | Addr as ty ->
 112         if !int <= last_int then begin
 113           loc.(i) <- phys_reg !int;
 114           incr int
 115         end else begin
 116           loc.(i) <- stack_slot (make_stack !ofs) ty;
 117           ofs := !ofs + size_int
 118         end
 119     | Float ->
 120         if !float <= last_float then begin
 121           loc.(i) <- phys_reg !float;
 122           incr float
 123         end else begin
 124           loc.(i) <- stack_slot (make_stack !ofs) Float;
 125           ofs := !ofs + size_float
 126         end
 127   done;
 128   (loc, Misc.align !ofs 16)         (* Keep stack 16-aligned *)
 129
 130 let incoming ofs = Incoming ofs
 131 let outgoing ofs = Outgoing ofs
 132 let not_supported ofs = fatal_error "Proc.loc_results: cannot call"
 133
 134 let loc_arguments arg =
 135   calling_conventions 6 13 112 119 outgoing arg
 136 let loc_parameters arg =
 137   let (loc, ofs) = calling_conventions 6 13 112 119 incoming arg in loc
 138 let loc_results res =
 139   let (loc, ofs) = calling_conventions 0 5 100 103 not_supported res in loc
 140
 141 (* The C calling conventions are as follows:
 142    the first 8 arguments are passed either in integer regs $4...$11
 143    or float regs $f12...$f19.  Each argument "consumes" both one slot
 144    in the int register file and one slot in the float register file.
 145    Extra arguments are passed on stack, in a 64-bits slot, right-justified
 146    (i.e. at +4 from natural address). *)
 147
 148 let loc_external_arguments arg =
 149   let loc = Array.create (Array.length arg) Reg.dummy in
 150   let int = ref 2 in
 151   let float = ref 112 in
 152   let ofs = ref 0 in
 153   for i = 0 to Array.length arg - 1 do
 154     if i < 8 then begin
 155       loc.(i) <- phys_reg (if arg.(i).typ = Float then !float else !int);
 156       incr int;
 157       incr float
 158     end else begin
 159       begin match arg.(i).typ with
 160         Float -> loc.(i) <- stack_slot (Outgoing !ofs) Float
 161       | ty    -> loc.(i) <- stack_slot (Outgoing (!ofs + 4)) ty
 162       end;
 163       ofs := !ofs + 8
 164     end
 165   done;
 166   (loc, Misc.align !ofs 16)
 167
 168 let loc_external_results res =
 169   let (loc, ofs) = calling_conventions 0 0 100 100 not_supported res in loc
 170
 171 let loc_exn_bucket = phys_reg 0         (* $2 *)
 172
 173 (* Registers destroyed by operations *)
 174
 175 let destroyed_at_c_call =
 176   (* $16 - $21, $f20, $f22, $f24, $f26, $f28, $f30 preserved *)
 177   Array.of_list(List.map phys_reg
 178     [0;1;2;3;4;5;6;7;8;9;10;11;12;13;
 179      100;101;102;103;104;105;106;107;108;109;110;111;112;113;114;
 180      115;116;117;118;119;121;123;125;127;129])
 181
 182 let destroyed_at_oper = function
 183     Iop(Icall_ind | Icall_imm _ | Iextcall(_, true)) -> all_phys_regs
 184   | Iop(Iextcall(_, false)) -> destroyed_at_c_call
 185   | _ -> [||]
 186
 187 let destroyed_at_raise = all_phys_regs
 188
 189 (* Maximal register pressure *)
 190
 191 let safe_register_pressure = function
 192     Iextcall(_, _) -> 6
 193   | _ -> 20
 194 let max_register_pressure = function
 195     Iextcall(_, _) -> [| 6; 6 |]
 196   | _ -> [| 20; 31 |]
 197
 198 (* Layout of the stack *)
 199
 200 let num_stack_slots = [| 0; 0 |]
 201 let contains_calls = ref false
 202
 203 (* Calling the assembler *)
 204
 205 let assemble_file infile outfile =
 206   Ccomp.command (Config.asm ^ " -o " ^
 207                  Filename.quote outfile ^ " " ^ Filename.quote infile)
 208
 209 open Clflags;;
 210 open Config;;