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
16open X86_ast
17open X86_proc
18
19let bprintf = Printf.bprintf
20
21let string_of_datatype = function
22  | QWORD -> "QWORD"
23  | OWORD -> "OWORD"
24  | NONE -> assert false
25  | REAL4 -> "REAL4"
26  | REAL8 -> "REAL8"
27  | BYTE -> "BYTE"
28  | WORD -> "WORD"
29  | DWORD -> "DWORD"
30  | NEAR -> "NEAR"
31  | PROC -> "PROC"
32
33
34let string_of_datatype_ptr = function
35  | QWORD -> "QWORD PTR "
36  | OWORD -> "OWORD PTR "
37  | NONE -> ""
38  | REAL4 -> "REAL4 PTR "
39  | REAL8 -> "REAL8 PTR "
40  | BYTE -> "BYTE PTR "
41  | WORD -> "WORD PTR "
42  | DWORD -> "DWORD PTR "
43  | NEAR -> "NEAR PTR "
44  | PROC -> "PROC PTR "
45
46let arg_mem b {arch; typ; idx; scale; base; sym; displ} =
47  let string_of_register =
48    match arch with
49    | X86 -> string_of_reg32
50    | X64 -> string_of_reg64
51  in
52  Buffer.add_string b (string_of_datatype_ptr typ);
53  Buffer.add_char b '[';
54  begin match sym with
55  | None -> ()
56  | Some s -> Buffer.add_string b s
57  end;
58  if scale <> 0 then begin
59    if sym <> None then Buffer.add_char b '+';
60    Buffer.add_string b (string_of_register idx);
61    if scale <> 1 then bprintf b "*%d" scale;
62  end;
63  begin match base with
64  | None -> ()
65  | Some r ->
66      assert(scale > 0);
67      Buffer.add_char b '+';
68      Buffer.add_string b (string_of_register r);
69  end;
70  begin if displ > 0 then bprintf b "+%d" displ
71    else if displ < 0 then bprintf b "%d" displ
72  end;
73  Buffer.add_char b ']'
74
75let arg b = function
76  | Sym s -> bprintf b "OFFSET %s" s
77  | Imm n when n <= 0x7FFF_FFFFL && n >= -0x8000_0000L -> bprintf b "%Ld" n
78  | Imm int -> bprintf b "0%LxH" int (* force ml64 to use mov reg, imm64 *)
79  | Reg8L x -> Buffer.add_string b (string_of_reg8l x)
80  | Reg8H x -> Buffer.add_string b (string_of_reg8h x)
81  | Reg16 x -> Buffer.add_string b (string_of_reg16 x)
82  | Reg32 x -> Buffer.add_string b (string_of_reg32 x)
83  | Reg64 x -> Buffer.add_string b (string_of_reg64 x)
84  | Regf x -> Buffer.add_string b (string_of_registerf x)
85
86  (* We don't need to specify RIP on Win64, since EXTERN will provide
87     the list of external symbols that need this addressing mode, and
88     MASM will automatically use RIP addressing when needed. *)
89  | Mem64_RIP (typ, s, displ) ->
90      bprintf b "%s%s" (string_of_datatype_ptr typ) s;
91      if displ > 0 then bprintf b "+%d" displ
92      else if displ < 0 then bprintf b "%d" displ
93  | Mem addr -> arg_mem b addr
94
95let rec cst b = function
96  | ConstLabel _ | Const _ | ConstThis as c -> scst b c
97  | ConstAdd (c1, c2) -> bprintf b "%a + %a" scst c1 scst c2
98  | ConstSub (c1, c2) -> bprintf b "%a - %a" scst c1 scst c2
99
100and scst b = function
101  | ConstThis -> Buffer.add_string b "THIS BYTE"
102  | ConstLabel l -> Buffer.add_string b l
103  | Const n when n <= 0x7FFF_FFFFL && n >= -0x8000_0000L ->
104      Buffer.add_string b (Int64.to_string n)
105  | Const n -> bprintf b "0%LxH" n
106  | ConstAdd (c1, c2) -> bprintf b "(%a + %a)" scst c1 scst c2
107  | ConstSub (c1, c2) -> bprintf b "(%a - %a)" scst c1 scst c2
108
109let i0 b s = bprintf b "\t%s" s
110let i1 b s x = bprintf b "\t%s\t%a" s arg x
111let i2 b s x y = bprintf b "\t%s\t%a, %a" s arg y arg x
112
113let i1_call_jmp b s = function
114  | Sym x -> bprintf b "\t%s\t%s" s x
115  | x -> i1 b s x
116
117let print_instr b = function
118  | ADD (arg1, arg2) -> i2 b "add" arg1 arg2
119  | ADDSD (arg1, arg2) -> i2 b "addsd" arg1 arg2
120  | AND (arg1, arg2) -> i2 b "and" arg1 arg2
121  | ANDPD (arg1, arg2) -> i2 b "andpd" arg1 arg2
122  | BSWAP arg -> i1 b "bswap" arg
123  | CALL arg  -> i1_call_jmp b "call" arg
124  | CDQ -> i0 b "cdq"
125  | CMOV (c, arg1, arg2) -> i2 b ("cmov" ^ string_of_condition c) arg1 arg2
126  | CMP (arg1, arg2) -> i2 b "cmp" arg1 arg2
127  | COMISD (arg1, arg2) -> i2 b "comisd" arg1 arg2
128  | CQO -> i0 b "cqo"
129  | CVTSD2SI (arg1, arg2) -> i2 b "cvtsd2si" arg1 arg2
130  | CVTSD2SS (arg1, arg2) -> i2 b "cvtsd2ss" arg1 arg2
131  | CVTSI2SD (arg1, arg2) -> i2 b "cvtsi2sd" arg1 arg2
132  | CVTSS2SD (arg1, arg2) -> i2 b "cvtss2sd" arg1 arg2
133  | CVTTSD2SI (arg1, arg2) -> i2 b "cvttsd2si" arg1 arg2
134  | DEC arg -> i1 b "dec" arg
135  | DIVSD (arg1, arg2) -> i2 b "divsd" arg1 arg2
136  | FABS -> i0 b "fabs"
137  | FADD arg -> i1 b "fadd" arg
138  | FADDP (arg1, arg2)  -> i2 b "faddp" arg1 arg2
139  | FCHS -> i0 b "fchs"
140  | FCOMP arg -> i1 b "fcomp" arg
141  | FCOMPP -> i0 b "fcompp"
142  | FCOS -> i0 b "fcos"
143  | FDIV arg -> i1 b "fdiv" arg
144  | FDIVP (arg1, arg2)  -> i2 b "fdivp" arg1 arg2
145  | FDIVR arg -> i1 b "fdivr" arg
146  | FDIVRP (arg1, arg2)  -> i2 b "fdivrp" arg1 arg2
147  | FILD arg -> i1 b "fild" arg
148  | FISTP arg -> i1 b "fistp" arg
149  | FLD arg -> i1 b "fld" arg
150  | FLD1 -> i0 b "fld1"
151  | FLDCW arg -> i1 b "fldcw" arg
152  | FLDLG2 -> i0 b "fldlg2"
153  | FLDLN2 -> i0 b "fldln2"
154  | FLDZ -> i0 b "fldz"
155  | FMUL arg -> i1 b "fmul" arg
156  | FMULP (arg1, arg2)  -> i2 b "fmulp" arg1 arg2
157  | FNSTCW arg -> i1 b "fnstcw" arg
158  | FNSTSW arg -> i1 b "fnstsw" arg
159  | FPATAN -> i0 b "fpatan"
160  | FPTAN -> i0 b "fptan"
161  | FSIN -> i0 b "fsin"
162  | FSQRT -> i0 b "fsqrt"
163  | FSTP arg -> i1 b "fstp" arg
164  | FSUB arg -> i1 b "fsub" arg
165  | FSUBP (arg1, arg2)  -> i2 b "fsubp" arg1 arg2
166  | FSUBR arg -> i1 b "fsubr" arg
167  | FSUBRP (arg1, arg2)  -> i2 b "fsubrp" arg1 arg2
168  | FXCH arg -> i1 b "fxch" arg
169  | FYL2X -> i0 b "fyl2x"
170  | HLT -> assert false
171  | IDIV arg -> i1 b "idiv" arg
172  | IMUL (arg, None) -> i1 b "imul" arg
173  | IMUL (arg1, Some arg2) -> i2 b "imul" arg1 arg2
174  | INC arg -> i1 b "inc" arg
175  | J (c, arg) -> i1_call_jmp b ("j" ^ string_of_condition c) arg
176  | JMP arg -> i1_call_jmp b "jmp" arg
177  | LEA (arg1, arg2) -> i2 b "lea" arg1 arg2
178  | LEAVE -> i0 b "leave"
179  | MOV (Imm n as arg1, Reg64 r) when
180      n >= 0x8000_0000L && n <= 0xFFFF_FFFFL ->
181      (* Work-around a bug in ml64.  Use a mov to the corresponding
182         32-bit lower register when the constant fits in 32-bit.
183         The associated higher 32-bit register will be zeroed. *)
184      i2 b "mov" arg1 (Reg32 r)
185  | MOV (arg1, arg2) -> i2 b "mov" arg1 arg2
186  | MOVAPD (arg1, arg2) -> i2 b "movapd" arg1 arg2
187  | MOVLPD (arg1, arg2) -> i2 b "movlpd" arg1 arg2
188  | MOVSD (arg1, arg2) -> i2 b "movsd" arg1 arg2
189  | MOVSS (arg1, arg2) -> i2 b "movss" arg1 arg2
190  | MOVSX (arg1, arg2) -> i2 b "movsx" arg1 arg2
191  | MOVSXD (arg1, arg2) -> i2 b "movsxd" arg1 arg2
192  | MOVZX (arg1, arg2) -> i2 b "movzx" arg1 arg2
193  | MULSD (arg1, arg2) -> i2 b "mulsd" arg1 arg2
194  | NEG arg -> i1 b "neg" arg
195  | NOP -> i0 b "nop"
196  | OR (arg1, arg2) -> i2 b "or" arg1 arg2
197  | POP arg -> i1 b "pop" arg
198  | PUSH arg -> i1 b "push" arg
199  | RET -> i0 b "ret"
200  | ROUNDSD (r, arg1, arg2) -> i2 b (string_of_rounding r) arg1 arg2
201  | SAL (arg1, arg2) -> i2 b "sal" arg1 arg2
202  | SAR (arg1, arg2) -> i2 b "sar" arg1 arg2
203  | SET (c, arg) -> i1 b ("set" ^ string_of_condition c) arg
204  | SHR (arg1, arg2) -> i2 b "shr" arg1 arg2
205  | SQRTSD (arg1, arg2) -> i2 b "sqrtsd" arg1 arg2
206  | SUB (arg1, arg2) -> i2 b "sub" arg1 arg2
207  | SUBSD (arg1, arg2) -> i2 b "subsd" arg1 arg2
208  | TEST (arg1, arg2) -> i2 b "test" arg1 arg2
209  | UCOMISD (arg1, arg2) -> i2 b "ucomisd" arg1 arg2
210  | XCHG (arg1, arg2) -> i2 b "xchg" arg1 arg2
211  | XOR (arg1, arg2) -> i2 b "xor" arg1 arg2
212  | XORPD (arg1, arg2) -> i2 b "xorpd" arg1 arg2
213
214
215let print_line b = function
216  | Ins instr -> print_instr b instr
217
218  | Align (_data,n) -> bprintf b "\tALIGN\t%d" n
219  | Byte n -> bprintf b "\tBYTE\t%a" cst n
220  | Bytes s -> buf_bytes_directive b "BYTE" s
221  | Comment s -> bprintf b " ; %s " s
222  | Global s -> bprintf b "\tPUBLIC\t%s" s
223  | Long n -> bprintf b "\tDWORD\t%a" cst n
224  | NewLabel (s, NONE) -> bprintf b "%s:" s
225  | NewLabel (s, ptr) -> bprintf b "%s LABEL %s" s (string_of_datatype ptr)
226  | Quad n -> bprintf b "\tQWORD\t%a" cst n
227  | Section ([".data"], None, []) -> bprintf b "\t.DATA"
228  | Section ([".text"], None, []) -> bprintf b "\t.CODE"
229  | Section _ -> assert false
230  | Space n -> bprintf b "\tBYTE\t%d DUP (?)" n
231  | Word n -> bprintf b "\tWORD\t%a" cst n
232
233  (* windows only *)
234  | External (s, ptr) -> bprintf b "\tEXTRN\t%s: %s" s (string_of_datatype ptr)
235  | Mode386 -> bprintf b "\t.386"
236  | Model name -> bprintf b "\t.MODEL %s" name (* name = FLAT *)
237
238  (* gas only *)
239  | Cfi_adjust_cfa_offset _
240  | Cfi_endproc
241  | Cfi_startproc
242  | File _
243  | Indirect_symbol _
244  | Loc _
245  | Private_extern _
246  | Set _
247  | Size _
248  | Type _
249    -> assert false
250
251let generate_asm oc lines =
252  let b = Buffer.create 10000 in
253  List.iter
254    (fun i ->
255       Buffer.clear b;
256       print_line b i;
257       Buffer.add_char b '\n';
258       Buffer.output_buffer oc b
259    )
260    lines;
261  output_string oc "\tEND\n"
262