Inline inner DSL module.
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/abstract_intel_emit@15401 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Alain Frisch
parent
0fd13b09d7
commit
cf495ee713
|
|
@ -27,7 +27,6 @@ open Emitaux
|
|||
open Intel_ast
|
||||
open Intel_proc
|
||||
open Intel_dsl
|
||||
open Intel_dsl.DSL
|
||||
|
||||
let _label s = D.label ~typ:QWORD s
|
||||
|
||||
|
|
@ -432,7 +431,7 @@ let emit_instr fallthrough i =
|
|||
| _ -> I.mov (int 0, res i 0)
|
||||
end
|
||||
else
|
||||
I.mov (emit_nat n, res i 0)
|
||||
I.mov (nat n, res i 0)
|
||||
| Lop(Iconst_float f) ->
|
||||
begin match Int64.bits_of_float f with
|
||||
| 0x0000_0000_0000_0000L -> (* +0.0 *)
|
||||
|
|
@ -606,7 +605,7 @@ let emit_instr fallthrough i =
|
|||
| Lop(Ispecific(Ilea addr)) ->
|
||||
I.lea (addressing addr NONE i 0, res i 0)
|
||||
| Lop(Ispecific(Istore_int(n, addr, _))) ->
|
||||
I.mov (emit_nat n, addressing addr QWORD i 0)
|
||||
I.mov (nat n, addressing addr QWORD i 0)
|
||||
| Lop(Ispecific(Istore_symbol(s, addr, _))) ->
|
||||
assert (not !pic_code && not !Clflags.dlcode);
|
||||
add_used_symbol s;
|
||||
|
|
|
|||
|
|
@ -27,7 +27,6 @@ open Emitaux
|
|||
open Intel_ast
|
||||
open Intel_proc
|
||||
open Intel_dsl
|
||||
open Intel_dsl.DSL
|
||||
|
||||
let _label s = D.label ~typ:DWORD s
|
||||
|
||||
|
|
@ -501,7 +500,7 @@ let emit_instr fallthrough i =
|
|||
| Reg _ -> I.xor (reg i.res.(0), reg i.res.(0))
|
||||
| _ -> I.mov (int 0, reg i.res.(0))
|
||||
end else
|
||||
I.mov (emit_nat n, reg i.res.(0))
|
||||
I.mov (nat n, reg i.res.(0))
|
||||
| Lop(Iconst_float f) ->
|
||||
begin match Int64.bits_of_float f with
|
||||
| 0x0000_0000_0000_0000L -> (* +0.0 *)
|
||||
|
|
@ -727,7 +726,7 @@ let emit_instr fallthrough i =
|
|||
| Lop(Ispecific(Ilea addr)) ->
|
||||
I.lea (addressing addr DWORD i 0, reg i.res.(0))
|
||||
| Lop(Ispecific(Istore_int(n, addr, _))) ->
|
||||
I.mov (emit_nat n, addressing addr DWORD i 0)
|
||||
I.mov (nat n, addressing addr DWORD i 0)
|
||||
| Lop(Ispecific(Istore_symbol(s, addr, _))) ->
|
||||
add_used_symbol s;
|
||||
I.mov (immsym s, addressing addr DWORD i 0)
|
||||
|
|
@ -755,7 +754,7 @@ let emit_instr fallthrough i =
|
|||
stack_offset := !stack_offset + 4
|
||||
done
|
||||
| Lop(Ispecific(Ipush_int n)) ->
|
||||
I.push (emit_nat n);
|
||||
I.push (nat n);
|
||||
cfi_adjust_cfa_offset 4;
|
||||
stack_offset := !stack_offset + 4
|
||||
| Lop(Ispecific(Ipush_symbol s)) ->
|
||||
|
|
|
|||
|
|
@ -30,6 +30,47 @@
|
|||
open Intel_ast
|
||||
open Intel_proc
|
||||
|
||||
let sym s = Sym s
|
||||
|
||||
let nat n = Imm (Int64.of_nativeint n)
|
||||
let int n = Imm (Int64.of_int n)
|
||||
|
||||
let const_32 n = Const (Int64.of_int32 n)
|
||||
let const_nat n = Const (Int64.of_nativeint n)
|
||||
let const n = Const (Int64.of_int n)
|
||||
|
||||
let al = Reg8L RAX
|
||||
let ah = Reg8H AH
|
||||
let cl = Reg8L RCX
|
||||
let ax = Reg16 RAX
|
||||
let rax = Reg64 RAX
|
||||
let r10 = Reg64 R10
|
||||
let r11 = Reg64 R11
|
||||
let r14 = Reg64 R14
|
||||
let r15 = Reg64 R15
|
||||
let rsp = Reg64 RSP
|
||||
let rbp = Reg64 RBP
|
||||
let xmm15 = Regf (XMM 15)
|
||||
let eax = Reg32 RAX
|
||||
let ebx = Reg32 RBX
|
||||
let ecx = Reg32 RCX
|
||||
let edx = Reg32 RDX
|
||||
let ebp = Reg32 RBP
|
||||
let esp = Reg32 RSP
|
||||
let st0 = Regf (ST 0)
|
||||
let st1 = Regf (ST 1)
|
||||
|
||||
let mem32 typ ?(scale = 1) ?base ?sym displ idx =
|
||||
assert(scale > 0);
|
||||
Mem32 {typ; idx; scale; base; sym; displ}
|
||||
|
||||
let mem64 typ ?(scale = 1) ?base ?sym offset idx =
|
||||
assert(scale > 0);
|
||||
Mem64 {typ; idx; scale; base; sym; displ=offset}
|
||||
|
||||
let mem64_rip typ ?(ofs = 0) s =
|
||||
Mem64_RIP (typ, s, ofs)
|
||||
|
||||
module D = struct
|
||||
let section segment flags args = directive (Section (segment, flags, args))
|
||||
let align n = directive (Align (false, n))
|
||||
|
|
@ -59,53 +100,6 @@ module D = struct
|
|||
let word cst = directive (Word cst)
|
||||
end
|
||||
|
||||
module DSL = struct
|
||||
let sym s = Sym s
|
||||
|
||||
let emit_nat n = Imm (Int64.of_nativeint n)
|
||||
let int n = Imm (Int64.of_int n)
|
||||
|
||||
let const_64 n = Const n
|
||||
let const_32 n = Const (Int64.of_int32 n)
|
||||
let const_nat n = Const (Int64.of_nativeint n)
|
||||
let const n = Const (Int64.of_int n)
|
||||
|
||||
|
||||
let al = Reg8L RAX
|
||||
let ah = Reg8H AH
|
||||
let cl = Reg8L RCX
|
||||
|
||||
let ax = Reg16 RAX
|
||||
|
||||
let rax = Reg64 RAX
|
||||
let r10 = Reg64 R10
|
||||
let r11 = Reg64 R11
|
||||
let r14 = Reg64 R14
|
||||
let r15 = Reg64 R15
|
||||
let rsp = Reg64 RSP
|
||||
let rbp = Reg64 RBP
|
||||
let xmm15 = Regf (XMM 15)
|
||||
let eax = Reg32 RAX
|
||||
let ebx = Reg32 RBX
|
||||
let ecx = Reg32 RCX
|
||||
let edx = Reg32 RDX
|
||||
let ebp = Reg32 RBP
|
||||
let esp = Reg32 RSP
|
||||
let st0 = Regf (ST 0)
|
||||
let st1 = Regf (ST 1)
|
||||
|
||||
let mem32 typ ?(scale = 1) ?base ?sym displ idx =
|
||||
assert(scale > 0);
|
||||
Mem32 {typ; idx; scale; base; sym; displ}
|
||||
|
||||
let mem64 typ ?(scale = 1) ?base ?sym offset idx =
|
||||
assert(scale > 0);
|
||||
Mem64 {typ; idx; scale; base; sym; displ=offset}
|
||||
|
||||
let mem64_rip typ ?(ofs = 0) s =
|
||||
Mem64_RIP (typ, s, ofs)
|
||||
end
|
||||
|
||||
module I = struct
|
||||
let add (x, y) = emit (ADD (x, y))
|
||||
let addsd (arg1, arg2) = emit (ADDSD (arg1, arg2))
|
||||
|
|
|
|||
|
|
@ -29,6 +29,44 @@
|
|||
|
||||
open Intel_ast
|
||||
|
||||
val sym: string -> arg
|
||||
val nat: nativeint -> arg
|
||||
val int: int -> arg
|
||||
val const_32: int32 -> constant
|
||||
val const_nat: nativeint -> constant
|
||||
val const: int -> constant
|
||||
val al: arg
|
||||
val ah: arg
|
||||
val cl: arg
|
||||
val ax: arg
|
||||
val rax: arg
|
||||
val r10: arg
|
||||
val r11: arg
|
||||
val r14: arg
|
||||
val r15: arg
|
||||
val rsp: arg
|
||||
val rbp: arg
|
||||
val xmm15: arg
|
||||
val eax: arg
|
||||
val ebx: arg
|
||||
val ecx: arg
|
||||
val edx: arg
|
||||
val ebp: arg
|
||||
val esp: arg
|
||||
val st0: arg
|
||||
val st1: arg
|
||||
|
||||
val mem32:
|
||||
data_type -> ?scale:int -> ?base:reg64 -> ?sym:string ->
|
||||
int -> reg64 -> arg
|
||||
|
||||
val mem64:
|
||||
data_type -> ?scale:int -> ?base:reg64 -> ?sym:string ->
|
||||
int -> reg64 -> arg
|
||||
|
||||
val mem64_rip: data_type -> ?ofs:int -> string -> arg
|
||||
|
||||
|
||||
module D : sig
|
||||
(** Directives *)
|
||||
|
||||
|
|
@ -60,45 +98,6 @@ module D : sig
|
|||
val word: constant -> unit
|
||||
end
|
||||
|
||||
module DSL : sig
|
||||
val sym: string -> arg
|
||||
val emit_nat: nativeint -> arg
|
||||
val int: int -> arg
|
||||
val const_64: int64 -> constant
|
||||
val const_32: int32 -> constant
|
||||
val const_nat: nativeint -> constant
|
||||
val const: int -> constant
|
||||
val al: arg
|
||||
val ah: arg
|
||||
val cl: arg
|
||||
val ax: arg
|
||||
val rax: arg
|
||||
val r10: arg
|
||||
val r11: arg
|
||||
val r14: arg
|
||||
val r15: arg
|
||||
val rsp: arg
|
||||
val rbp: arg
|
||||
val xmm15: arg
|
||||
val eax: arg
|
||||
val ebx: arg
|
||||
val ecx: arg
|
||||
val edx: arg
|
||||
val ebp: arg
|
||||
val esp: arg
|
||||
val st0: arg
|
||||
val st1: arg
|
||||
|
||||
val mem32:
|
||||
data_type -> ?scale:int -> ?base:reg64 -> ?sym:string ->
|
||||
int -> reg64 -> arg
|
||||
|
||||
val mem64:
|
||||
data_type -> ?scale:int -> ?base:reg64 -> ?sym:string ->
|
||||
int -> reg64 -> arg
|
||||
|
||||
val mem64_rip: data_type -> ?ofs:int -> string -> arg
|
||||
end
|
||||
module I : sig
|
||||
val add: arg * arg -> unit
|
||||
val addsd: arg * arg -> unit
|
||||
|
|
|
|||
Loading…
Reference in New Issue