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(** Structured representation of Intel assembly language (32 and 64 bit). *)
17
18type condition =
19  | L | GE     (* signed comparisons: less/greater *)
20  | LE | G
21  | B | AE     (* unsigned comparisons: below/above *)
22  | BE | A
23  | E | NE     (* equal *)
24  | O | NO     (* overflow *)
25  | S | NS     (* sign *)
26  | P | NP     (* parity *)
27
28type rounding =
29  | RoundUp
30  | RoundDown
31  | RoundNearest
32  | RoundTruncate
33
34type constant =
35  | Const of int64
36  | ConstThis
37  | ConstLabel of string
38  | ConstAdd of constant * constant
39  | ConstSub of constant * constant
40
41(* data_type is used mainly on memory addressing to specify
42   the size of the addressed memory chunk.  It is directly
43   used by the MASM emitter and indirectly by the GAS emitter
44   to infer the instruction suffix. *)
45
46type data_type =
47  | NONE
48  | REAL4 | REAL8 (* floating point values *)
49  | BYTE | WORD | DWORD | QWORD | OWORD (* integer values *)
50  | NEAR | PROC
51
52type reg64 =
53  | RAX | RBX | RCX | RDX | RSP | RBP | RSI | RDI
54  | R8 | R9 | R10 | R11 | R12 | R13 | R14 | R15
55
56type reg8h =
57  | AH | BH | CH | DH
58
59
60type registerf = XMM of int | TOS | ST of int
61
62type arch = X64 | X86
63
64type addr =
65  {
66    arch: arch;
67    typ: data_type;
68    idx: reg64;
69    scale: int;
70    base: reg64 option;
71    sym: string option;
72    displ: int;
73  }
74  (** Addressing modes:
75      displ + sym + base + idx * scale
76      (if scale = 0, idx is ignored and base must be None)
77  *)
78
79type arg =
80  | Imm of int64
81  (** Operand is an immediate constant integer *)
82
83  | Sym of  string
84  (** Address of a symbol (absolute address except for call/jmp target
85      where it is interpreted as a relative displacement *)
86
87  | Reg8L of reg64
88  | Reg8H of reg8h
89  | Reg16 of reg64
90  | Reg32 of reg64
91  | Reg64 of reg64
92  | Regf of registerf
93
94  | Mem of addr
95  | Mem64_RIP of data_type * string * int
96
97type instruction =
98  | ADD of arg * arg
99  | ADDSD of arg * arg
100  | AND of arg * arg
101  | ANDPD of arg * arg
102  | BSWAP of arg
103  | CALL of arg
104  | CDQ
105  | CMOV of condition * arg * arg
106  | CMP of arg * arg
107  | COMISD of arg * arg
108  | CQO
109  | CVTSD2SI of arg * arg
110  | CVTSD2SS of arg * arg
111  | CVTSI2SD of arg * arg
112  | CVTSS2SD of arg * arg
113  | CVTTSD2SI of arg * arg
114  | DEC of arg
115  | DIVSD of arg * arg
116  | FABS
117  | FADD of arg
118  | FADDP of arg * arg
119  | FCHS
120  | FCOMP of arg
121  | FCOMPP
122  | FCOS
123  | FDIV of arg
124  | FDIVP of arg * arg
125  | FDIVR of arg
126  | FDIVRP of arg * arg
127  | FILD of arg
128  | FISTP of arg
129  | FLD of arg
130  | FLD1
131  | FLDCW of arg
132  | FLDLG2
133  | FLDLN2
134  | FLDZ
135  | FMUL of arg
136  | FMULP of arg * arg
137  | FNSTCW of arg
138  | FNSTSW of arg
139  | FPATAN
140  | FPTAN
141  | FSIN
142  | FSQRT
143  | FSTP of arg
144  | FSUB of arg
145  | FSUBP of arg * arg
146  | FSUBR of arg
147  | FSUBRP of arg * arg
148  | FXCH of arg
149  | FYL2X
150  | HLT
151  | IDIV of arg
152  | IMUL of arg * arg option
153  | INC of arg
154  | J of condition * arg
155  | JMP of arg
156  | LEA of arg * arg
157  | LEAVE
158  | MOV of arg * arg
159  | MOVAPD of arg * arg
160  | MOVLPD of arg * arg
161  | MOVSD of arg * arg
162  | MOVSS of arg * arg
163  | MOVSX of arg * arg
164  | MOVSXD of arg * arg
165  | MOVZX of arg * arg
166  | MULSD of arg * arg
167  | NEG of arg
168  | NOP
169  | OR of arg * arg
170  | POP of arg
171  | PUSH of arg
172  | RET
173  | ROUNDSD of rounding * arg * arg
174  | SAL of arg * arg
175  | SAR of arg * arg
176  | SET of condition * arg
177  | SHR of arg * arg
178  | SQRTSD of arg * arg
179  | SUB of arg * arg
180  | SUBSD of arg * arg
181  | TEST of arg * arg
182  | UCOMISD of arg * arg
183  | XCHG of arg * arg
184  | XOR of arg * arg
185  | XORPD of arg * arg
186
187type asm_line =
188  | Ins of instruction
189
190  | Align of bool * int
191  | Byte of constant
192  | Bytes of string
193  | Comment of string
194  | Global of string
195  | Long of constant
196  | NewLabel of string * data_type
197  | Quad of constant
198  | Section of string list * string option * string list
199  | Space of int
200  | Word of constant
201
202  (* masm only (the gas emitter will fail on them) *)
203  | External of string * data_type
204  | Mode386
205  | Model of string
206
207  (* gas only (the masm emitter will fail on them) *)
208  | Cfi_adjust_cfa_offset of int
209  | Cfi_endproc
210  | Cfi_startproc
211  | File of int * string (* (file_num, file_name) *)
212  | Indirect_symbol of string
213  | Loc of int * int * int (* (file_num, line, col) *)
214  | Private_extern of string
215  | Set of string * constant
216  | Size of string * constant
217  | Type of string * string
218
219type asm_program = asm_line list
220