1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 2014 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 open X86_ast
17
18 type system =
19 (* 32 bits and 64 bits *)
20 | S_macosx
21 | S_gnu
22 | S_cygwin
23
24 (* 32 bits only *)
25 | S_solaris
26 | S_win32
27 | S_linux_elf
28 | S_bsd_elf
29 | S_beos
30 | S_mingw
31
32 (* 64 bits only *)
33 | S_win64
34 | S_linux
35 | S_mingw64
36
37 | S_unknown
38
39
40 let system = match Config.system with
41 | "macosx" -> S_macosx
42 | "solaris" -> S_solaris
43 | "win32" -> S_win32
44 | "linux_elf" -> S_linux_elf
45 | "bsd_elf" -> S_bsd_elf
46 | "beos" -> S_beos
47 | "gnu" -> S_gnu
48 | "cygwin" -> S_cygwin
49 | "mingw" -> S_mingw
50 | "mingw64" -> S_mingw64
51 | "win64" -> S_win64
52 | "linux" -> S_linux
53
54 | _ -> S_unknown
55
56 let windows =
57 match system with
58 | S_mingw64 | S_cygwin | S_win64 -> true
59 | _ -> false
60
61 let string_of_string_literal s =
62 let b = Buffer.create (String.length s + 2) in
63 let last_was_escape = ref false in
64 for i = 0 to String.length s - 1 do
65 let c = s.[i] in
66 if c >= '0' && c <= '9' then
67 if !last_was_escape
68 then Printf.bprintf b "\\%o" (Char.code c)
69 else Buffer.add_char b c
70 else if c >= ' ' && c <= '~' && c <> '"' (* '"' *) && c <> '\\' then begin
71 Buffer.add_char b c;
72 last_was_escape := false
73 end else begin
74 Printf.bprintf b "\\%o" (Char.code c);
75 last_was_escape := true
76 end
77 done;
78 Buffer.contents b
79
80 let string_of_symbol prefix s =
81 let spec = ref false in
82 for i = 0 to String.length s - 1 do
83 match String.unsafe_get s i with
84 | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' -> ()
85 | _ -> spec := true;
86 done;
87 if not !spec then if prefix = "" then s else prefix ^ s
88 else
89 let b = Buffer.create (String.length s + 10) in
90 Buffer.add_string b prefix;
91 String.iter
92 (function
93 | ('A'..'Z' | 'a'..'z' | '0'..'9' | '_') as c -> Buffer.add_char b c
94 | c -> Printf.bprintf b "$%02x" (Char.code c)
95 )
96 s;
97 Buffer.contents b
98
99 let buf_bytes_directive b directive s =
100 let pos = ref 0 in
101 for i = 0 to String.length s - 1 do
102 if !pos = 0
103 then begin
104 if i > 0 then Buffer.add_char b '\n';
105 Buffer.add_char b '\t';
106 Buffer.add_string b directive;
107 Buffer.add_char b '\t';
108 end
109 else Buffer.add_char b ',';
110 Printf.bprintf b "%d" (Char.code s.[i]);
111 incr pos;
112 if !pos >= 16 then begin pos := 0 end
113 done
114
115 let string_of_reg64 = function
116 | RAX -> "rax"
117 | RBX -> "rbx"
118 | RDI -> "rdi"
119 | RSI -> "rsi"
120 | RDX -> "rdx"
121 | RCX -> "rcx"
122 | RBP -> "rbp"
123 | RSP -> "rsp"
124 | R8 -> "r8"
125 | R9 -> "r9"
126 | R10 -> "r10"
127 | R11 -> "r11"
128 | R12 -> "r12"
129 | R13 -> "r13"
130 | R14 -> "r14"
131 | R15 -> "r15"
132
133 let string_of_reg8l = function
134 | RAX -> "al"
135 | RBX -> "bl"
136 | RCX -> "cl"
137 | RDX -> "dl"
138 | RSP -> "spl"
139 | RBP -> "bpl"
140 | RSI -> "sil"
141 | RDI -> "dil"
142 | R8 -> "r8b"
143 | R9 -> "r9b"
144 | R10 -> "r10b"
145 | R11 -> "r11b"
146 | R12 -> "r12b"
147 | R13 -> "r13b"
148 | R14 -> "r14b"
149 | R15 -> "r15b"
150
151 let string_of_reg8h = function
152 | AH -> "ah"
153 | BH -> "bh"
154 | CH -> "ch"
155 | DH -> "dh"
156
157 let string_of_reg16 = function
158 | RAX -> "ax"
159 | RBX -> "bx"
160 | RCX -> "cx"
161 | RDX -> "dx"
162 | RSP -> "sp"
163 | RBP -> "bp"
164 | RSI -> "si"
165 | RDI -> "di"
166 | R8 -> "r8w"
167 | R9 -> "r9w"
168 | R10 -> "r10w"
169 | R11 -> "r11w"
170 | R12 -> "r12w"
171 | R13 -> "r13w"
172 | R14 -> "r14w"
173 | R15 -> "r15w"
174
175 let string_of_reg32 = function
176 | RAX -> "eax"
177 | RBX -> "ebx"
178 | RCX -> "ecx"
179 | RDX -> "edx"
180 | RSP -> "esp"
181 | RBP -> "ebp"
182 | RSI -> "esi"
183 | RDI -> "edi"
184 | R8 -> "r8d"
185 | R9 -> "r9d"
186 | R10 -> "r10d"
187 | R11 -> "r11d"
188 | R12 -> "r12d"
189 | R13 -> "r13d"
190 | R14 -> "r14d"
191 | R15 -> "r15d"
192
193 let string_of_registerf = function
194 | XMM n -> Printf.sprintf "xmm%d" n
195 | TOS -> Printf.sprintf "tos"
196 | ST n -> Printf.sprintf "st(%d)" n
197
198 let string_of_condition = function
199 | E -> "e"
200 | AE -> "ae"
201 | A -> "a"
202 | GE -> "ge"
203 | G -> "g"
204 | NE -> "ne"
205 | B -> "b"
206 | BE -> "be"
207 | L -> "l"
208 | LE -> "le"
209 | NP -> "np"
210 | P -> "p"
211 | NS -> "ns"
212 | S -> "s"
213 | NO -> "no"
214 | O -> "o"
215
216 let string_of_rounding = function
217 | RoundDown -> "roundsd.down"
218 | RoundUp -> "roundsd.up"
219 | RoundTruncate -> "roundsd.trunc"
220 | RoundNearest -> "roundsd.near"
221
222 let internal_assembler = ref None
223 let register_internal_assembler f = internal_assembler := Some f
224
225 (* Which asm conventions to use *)
226 let masm =
227 match system with
228 | S_win32 | S_win64 -> true
229 | _ -> false
230
231 let use_plt =
232 match system with
233 | S_macosx | S_mingw64 | S_cygwin | S_win64 -> false
234 | _ -> !Clflags.dlcode
235
236 (* Shall we use an external assembler command ?
237 If [binary_content] contains some data, we can directly
238 save it. Otherwise, we have to ask an external command.
239 *)
240 let binary_content = ref None
241
242 let compile infile outfile =
243 if masm then
244 Ccomp.command (Config.asm ^
245 Filename.quote outfile ^ " " ^ Filename.quote infile ^
246 (if !Clflags.verbose then "" else ">NUL"))
247 else
248 Ccomp.command (Config.asm ^ " " ^
249 (String.concat " " (Misc.debug_prefix_map_flags ())) ^
250 " -o " ^ Filename.quote outfile ^ " " ^
251 Filename.quote infile)
252
253 let assemble_file infile outfile =
254 match !binary_content with
255 | None -> compile infile outfile
256 | Some content -> content outfile; binary_content := None; 0
257
258 let asm_code = ref []
259
260 let directive dir = asm_code := dir :: !asm_code
261 let emit ins = directive (Ins ins)
262
263 let reset_asm_code () = asm_code := []
264
265 let generate_code asm =
266 let instrs = List.rev !asm_code in
267 begin match asm with
268 | Some f -> f instrs
269 | None -> ()
270 end;
271 begin match !internal_assembler with
272 | Some f -> binary_content := Some (f instrs)
273 | None -> binary_content := None
274 end
275