1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*             Xavier Leroy, projet Gallium, INRIA Rocquencourt           *)
6(*                 Benedikt Meurer, University of Siegen                  *)
7(*                                                                        *)
8(*   Copyright 2013 Institut National de Recherche en Informatique et     *)
9(*     en Automatique.                                                    *)
10(*   Copyright 2012 Benedikt Meurer.                                      *)
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(* Specific operations for the ARM processor, 64-bit mode *)
19
20open Format
21
22let command_line_options = []
23
24(* Addressing modes *)
25
26type addressing_mode =
27  | Iindexed of int                     (* reg + displ *)
28  | Ibased of string * int              (* global var + displ *)
29
30(* We do not support the reg + shifted reg addressing mode, because
31   what we really need is reg + shifted reg + displ,
32   and this is decomposed in two instructions (reg + shifted reg -> tmp,
33   then addressing tmp + displ). *)
34
35(* Specific operations *)
36
37type cmm_label = int
38  (* Do not introduce a dependency to Cmm *)
39
40type specific_operation =
41  | Ifar_alloc of { words : int; label_after_call_gc : cmm_label option; }
42  | Ifar_intop_checkbound of { label_after_error : cmm_label option; }
43  | Ifar_intop_imm_checkbound of
44      { bound : int; label_after_error : cmm_label option; }
45  | Ishiftarith of arith_operation * int
46  | Ishiftcheckbound of { shift : int; label_after_error : cmm_label option; }
47  | Ifar_shiftcheckbound of
48      { shift : int; label_after_error : cmm_label option; }
49  | Imuladd       (* multiply and add *)
50  | Imulsub       (* multiply and subtract *)
51  | Inegmulf      (* floating-point negate and multiply *)
52  | Imuladdf      (* floating-point multiply and add *)
53  | Inegmuladdf   (* floating-point negate, multiply and add *)
54  | Imulsubf      (* floating-point multiply and subtract *)
55  | Inegmulsubf   (* floating-point negate, multiply and subtract *)
56  | Isqrtf        (* floating-point square root *)
57  | Ibswap of int (* endianess conversion *)
58
59and arith_operation =
60    Ishiftadd
61  | Ishiftsub
62
63let spacetime_node_hole_pointer_is_live_before = function
64  | Ifar_alloc _ | Ifar_intop_checkbound _ | Ifar_intop_imm_checkbound _
65  | Ishiftarith _ | Ishiftcheckbound _ | Ifar_shiftcheckbound _ -> false
66  | Imuladd | Imulsub | Inegmulf | Imuladdf | Inegmuladdf | Imulsubf
67  | Inegmulsubf | Isqrtf | Ibswap _ -> false
68
69(* Sizes, endianness *)
70
71let big_endian = false
72
73let size_addr = 8
74let size_int = 8
75let size_float = 8
76
77let allow_unaligned_access = false
78
79(* Behavior of division *)
80
81let division_crashes_on_overflow = false
82
83(* Operations on addressing modes *)
84
85let identity_addressing = Iindexed 0
86
87let offset_addressing addr delta =
88  match addr with
89  | Iindexed n -> Iindexed(n + delta)
90  | Ibased(s, n) -> Ibased(s, n + delta)
91
92let num_args_addressing = function
93  | Iindexed _ -> 1
94  | Ibased _ -> 0
95
96(* Printing operations and addressing modes *)
97
98let print_addressing printreg addr ppf arg =
99  match addr with
100  | Iindexed n ->
101      printreg ppf arg.(0);
102      if n <> 0 then fprintf ppf " + %i" n
103  | Ibased(s, 0) ->
104      fprintf ppf "\"%s\"" s
105  | Ibased(s, n) ->
106      fprintf ppf "\"%s\" + %i" s n
107
108let print_specific_operation printreg op ppf arg =
109  match op with
110  | Ifar_alloc { words; label_after_call_gc = _; } ->
111    fprintf ppf "(far) alloc %i" words
112  | Ifar_intop_checkbound _ ->
113    fprintf ppf "%a (far) check > %a" printreg arg.(0) printreg arg.(1)
114  | Ifar_intop_imm_checkbound { bound; _ } ->
115    fprintf ppf "%a (far) check > %i" printreg arg.(0) bound
116  | Ishiftarith(op, shift) ->
117      let op_name = function
118      | Ishiftadd -> "+"
119      | Ishiftsub -> "-" in
120      let shift_mark =
121       if shift >= 0
122       then sprintf "<< %i" shift
123       else sprintf ">> %i" (-shift) in
124      fprintf ppf "%a %s %a %s"
125       printreg arg.(0) (op_name op) printreg arg.(1) shift_mark
126  | Ishiftcheckbound { shift; _ } ->
127      fprintf ppf "check %a >> %i > %a" printreg arg.(0) shift
128        printreg arg.(1)
129  | Ifar_shiftcheckbound { shift; _ } ->
130      fprintf ppf
131        "(far) check %a >> %i > %a" printreg arg.(0) shift printreg arg.(1)
132  | Imuladd ->
133      fprintf ppf "(%a * %a) + %a"
134        printreg arg.(0)
135        printreg arg.(1)
136        printreg arg.(2)
137  | Imulsub ->
138      fprintf ppf "-(%a * %a) + %a"
139        printreg arg.(0)
140        printreg arg.(1)
141        printreg arg.(2)
142  | Inegmulf ->
143      fprintf ppf "-f (%a *f %a)"
144        printreg arg.(0)
145        printreg arg.(1)
146  | Imuladdf ->
147      fprintf ppf "%a +f (%a *f %a)"
148        printreg arg.(0)
149        printreg arg.(1)
150        printreg arg.(2)
151  | Inegmuladdf ->
152      fprintf ppf "(-f %a) -f (%a *f %a)"
153        printreg arg.(0)
154        printreg arg.(1)
155        printreg arg.(2)
156  | Imulsubf ->
157      fprintf ppf "%a -f (%a *f %a)"
158        printreg arg.(0)
159        printreg arg.(1)
160        printreg arg.(2)
161  | Inegmulsubf ->
162      fprintf ppf "(-f %a) +f (%a *f %a)"
163        printreg arg.(0)
164        printreg arg.(1)
165        printreg arg.(2)
166  | Isqrtf ->
167      fprintf ppf "sqrtf %a"
168        printreg arg.(0)
169  | Ibswap n ->
170      fprintf ppf "bswap%i %a" n
171        printreg arg.(0)
172