1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 2000 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 (* Machine-specific command-line options *)
17
18 let command_line_options =
19 [ "-fPIC", Arg.Set Clflags.pic_code,
20 " Generate position-independent machine code (default)";
21 "-fno-PIC", Arg.Clear Clflags.pic_code,
22 " Generate position-dependent machine code" ]
23
24 (* Specific operations for the AMD64 processor *)
25
26 open Format
27
28 type addressing_mode =
29 Ibased of string * int (* symbol + displ *)
30 | Iindexed of int (* reg + displ *)
31 | Iindexed2 of int (* reg + reg + displ *)
32 | Iscaled of int * int (* reg * scale + displ *)
33 | Iindexed2scaled of int * int (* reg + reg * scale + displ *)
34
35 type specific_operation =
36 Ilea of addressing_mode (* "lea" gives scaled adds *)
37 | Istore_int of nativeint * addressing_mode * bool
38 (* Store an integer constant *)
39 | Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
40 | Ifloatarithmem of float_operation * addressing_mode
41 (* Float arith operation with memory *)
42 | Ibswap of int (* endianness conversion *)
43 | Isqrtf (* Float square root *)
44 | Ifloatsqrtf of addressing_mode (* Float square root from memory *)
45 | Isextend32 (* 32 to 64 bit conversion with sign
46 extension *)
47 | Izextend32 (* 32 to 64 bit conversion with zero
48 extension *)
49
50 and float_operation =
51 Ifloatadd | Ifloatsub | Ifloatmul | Ifloatdiv
52
53 let spacetime_node_hole_pointer_is_live_before _specific_op = false
54
55 (* Sizes, endianness *)
56
57 let big_endian = false
58
59 let size_addr = 8
60 let size_int = 8
61 let size_float = 8
62
63 let allow_unaligned_access = true
64
65 (* Behavior of division *)
66
67 let division_crashes_on_overflow = true
68
69 (* Operations on addressing modes *)
70
71 let identity_addressing = Iindexed 0
72
73 let offset_addressing addr delta =
74 match addr with
75 Ibased(s, n) -> Ibased(s, n + delta)
76 | Iindexed n -> Iindexed(n + delta)
77 | Iindexed2 n -> Iindexed2(n + delta)
78 | Iscaled(scale, n) -> Iscaled(scale, n + delta)
79 | Iindexed2scaled(scale, n) -> Iindexed2scaled(scale, n + delta)
80
81 let num_args_addressing = function
82 Ibased _ -> 0
83 | Iindexed _ -> 1
84 | Iindexed2 _ -> 2
85 | Iscaled _ -> 1
86 | Iindexed2scaled _ -> 2
87
88 (* Printing operations and addressing modes *)
89
90 let print_addressing printreg addr ppf arg =
91 match addr with
92 | Ibased(s, 0) ->
93 fprintf ppf "\"%s\"" s
94 | Ibased(s, n) ->
95 fprintf ppf "\"%s\" + %i" s n
96 | Iindexed n ->
97 let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
98 fprintf ppf "%a%s" printreg arg.(0) idx
99 | Iindexed2 n ->
100 let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
101 fprintf ppf "%a + %a%s" printreg arg.(0) printreg arg.(1) idx
102 | Iscaled(scale, n) ->
103 let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
104 fprintf ppf "%a * %i%s" printreg arg.(0) scale idx
105 | Iindexed2scaled(scale, n) ->
106 let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
107 fprintf ppf "%a + %a * %i%s" printreg arg.(0) printreg arg.(1) scale idx
108
109 let print_specific_operation printreg op ppf arg =
110 match op with
111 | Ilea addr -> print_addressing printreg addr ppf arg
112 | Istore_int(n, addr, is_assign) ->
113 fprintf ppf "[%a] := %nd %s"
114 (print_addressing printreg addr) arg n
115 (if is_assign then "(assign)" else "(init)")
116 | Ioffset_loc(n, addr) ->
117 fprintf ppf "[%a] +:= %i" (print_addressing printreg addr) arg n
118 | Isqrtf ->
119 fprintf ppf "sqrtf %a" printreg arg.(0)
120 | Ifloatsqrtf addr ->
121 fprintf ppf "sqrtf float64[%a]"
122 (print_addressing printreg addr) [|arg.(0)|]
123 | Ifloatarithmem(op, addr) ->
124 let op_name = function
125 | Ifloatadd -> "+f"
126 | Ifloatsub -> "-f"
127 | Ifloatmul -> "*f"
128 | Ifloatdiv -> "/f" in
129 fprintf ppf "%a %s float64[%a]" printreg arg.(0) (op_name op)
130 (print_addressing printreg addr)
131 (Array.sub arg 1 (Array.length arg - 1))
132 | Ibswap i ->
133 fprintf ppf "bswap_%i %a" i printreg arg.(0)
134 | Isextend32 ->
135 fprintf ppf "sextend32 %a" printreg arg.(0)
136 | Izextend32 ->
137 fprintf ppf "zextend32 %a" printreg arg.(0)
138
139 let win64 =
140 match Config.system with
141 | "win64" | "mingw64" | "cygwin" -> true
142 | _ -> false
143