Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Turn addr into a record. 

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/abstract_intel_emit@15283 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2014-09-22 10:01:46 +00:00
parent 09fb7eb268
commit 7f7a43b200
4 changed files with 59 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
asmcomp/intel_ast.mli
View File

@ -90,13 +90,22 @@ type symbol = string * reloc_table option
*)
type offset = symbol option * int64
type 'reg addr = data_type * ('reg * (* scale *) int * 'reg option) * offset
type 'reg addr =
{
typ: data_type;
idx: 'reg;
scale: int;
base: 'reg option;
displ: offset;
}
(* displ + base + idx * scale *)
type arg =
(* operand is an immediate value *)
| Imm of data_size * offset
(* operand is a relative displacement *)
| Rel of data_size * symbol
(* operand is a relative displacement (call/jmp targets) *)
| Rel32 of symbol
| Reg8 of register8
| Reg16 of register16

15
asmcomp/intel_dsl.ml
View File

@ -36,8 +36,8 @@ module Check = struct
against a gas-style instruction suffix. *)
let check ty = function
| Mem32 (dtype, _, _)
| Mem64 (dtype, _, _) -> assert(dtype = ty)
| Mem32 {typ; _}
| Mem64 {typ; _} -> assert(typ = ty)
| arg ->
match arg, ty with
| (Reg16 _ | Reg32 _ | Reg64 _ | Regf _), BYTE
@ -57,7 +57,7 @@ module Check = struct
end
module DSL = struct
let rel32 s = Rel (B32, s)
let rel32 s = Rel32 s
(* Override emitaux.ml *)
let emit_int n =
@ -257,10 +257,11 @@ module DSL32 = struct
let mem_ptr typ ?(scale = 1) ?base ?sym offset idx =
assert(scale > 0);
Mem32 (typ, (idx, scale, base), (sym, Int64.of_int offset))
Mem32 {typ; idx; scale; base; displ=(sym, Int64.of_int offset)}
let mem_sym typ ?(ofs = 0) l =
Mem32 (typ, (EAX, 0, None), (Some (l, None), Int64.of_int ofs))
Mem32 {typ; idx=EAX; scale=0; base=None;
displ=(Some (l, None), Int64.of_int ofs)}
end
@ -349,8 +350,8 @@ module DSL64 = struct
let mem_ptr typ ?(scale = 1) ?base offset idx =
assert(scale > 0);
Mem64 (typ, (idx, scale, base), (None, Int64.of_int offset))
Mem64 {typ; idx; scale; base; displ=(None, Int64.of_int offset)}
let from_rip typ ?(ofs = 0) s =
Mem64 (typ, (RIP, 1, None), (Some s, Int64.of_int ofs))
Mem64 {typ; idx=RIP; scale=1; base=None; displ=(Some s, Int64.of_int ofs)}
end

28
asmcomp/intel_gas.ml
View File

@ -72,8 +72,8 @@ let print_sym_offset b = function
| x when x > 0L -> Printf.bprintf b "+%Ld" x
| x -> Printf.bprintf b "%Ld" x
let bprint_arg_mem b string_of_register (_ty, (idx, scale, base), x : 'a addr) =
print_sym_offset b x;
let bprint_arg_mem b string_of_register {typ=_; idx; scale; base; displ} =
print_sym_offset b displ;
if scale <> 0 || base != None then begin
Buffer.add_char b '(';
print_opt_reg b string_of_register base;
@ -86,7 +86,7 @@ let bprint_arg_mem b string_of_register (_ty, (idx, scale, base), x : 'a addr) =
end
let bprint_arg b = function
| Rel (_, sym) -> print_sym_tbl b sym
| Rel32 sym -> print_sym_tbl b sym
| Imm (_, x) -> Buffer.add_char b '$'; print_sym_offset b x
| Reg8 x -> print_reg b string_of_register8 x
| Reg16 x -> print_reg b string_of_register16 x
@ -115,13 +115,13 @@ and string_of_simple_constant = function
(string_of_simple_constant c1) (string_of_simple_constant c2)
let suffix = function
| Mem32 (BYTE, _, _) | Mem64 (BYTE, _, _) | Reg8 _ -> "b"
| Mem32 (WORD, _, _) | Mem64 (WORD, _, _) | Reg16 _ -> "w"
| Mem32 (DWORD, _, _) | Mem64 (DWORD, _, _) | Reg32 _
| Mem32 (REAL8, _, _) | Mem64 (REAL8, _, _) -> "l"
| Mem32 (QWORD, _, _) | Mem64 (QWORD, _, _) | Reg64 _ -> "q"
| Mem32 (REAL4, _, _) | Mem64 (REAL4, _, _) -> "s"
| Mem32 (NO, _, _) | Mem64 (NO, _, _) -> assert false
| Mem32 {typ=BYTE; _} | Mem64 {typ=BYTE; _} | Reg8 _ -> "b"
| Mem32 {typ=WORD; _} | Mem64 {typ=WORD; _} | Reg16 _ -> "w"
| Mem32 {typ=DWORD; _} | Mem64 {typ=DWORD; _} | Reg32 _
| Mem32 {typ=REAL8; _} | Mem64 {typ=REAL8; _} -> "l"
| Mem32 {typ=QWORD; _} | Mem64 {typ=QWORD; _} | Reg64 _ -> "q"
| Mem32 {typ=REAL4; _} | Mem64 {typ=REAL4; _} -> "s"
| Mem32 {typ=NO; _} | Mem64 {typ=NO; _} -> assert false
| _ -> ""
let i0 b s =
@ -177,8 +177,8 @@ let i2_ss b s x y =
let i1_call_jmp b s x =
match x with
(* this is the encoding of jump labels: don't use * *)
| Mem64 (_, (RIP, _, _), (Some _,_))
| Mem32 (_, (_, 0, None), (Some _, _)) (*used?*) ->
| Mem64 {idx=RIP; scale=1; base=None; displ=(Some _,_); _}
| Mem32 {idx=_; scale=0; base=None; displ=(Some _,_); _} (*used?*) ->
i1 b s x
| Reg32 _ | Reg64 _ | Mem32 _ | Mem64 _ ->
tab b;
@ -207,14 +207,14 @@ let emit_instr b = function
| FISTP arg -> i1_s b "fistp" arg
| FSTP (Mem32(REAL4, _, _) as arg) -> i1 b "fstps" arg
| FSTP (Mem32 {typ=REAL4; _} as arg) -> i1 b "fstps" arg
| FSTP arg -> i1 b "fstpl" arg
| FILD arg -> i1_s b "fild" arg
| HLT -> i0 b "hlt"
| FCOMPP -> i0 b "fcompp"
| FCOMP arg -> i1_s b "fcomp" arg
| FLD (Mem32(REAL4, _ , _) as arg ) -> i1 b "flds" arg
| FLD (Mem32 {typ=REAL4; _} as arg ) -> i1 b "flds" arg
| FLD arg -> i1 b "fldl" arg
| FNSTSW arg -> i1 b "fnstsw" arg
| FNSTCW arg -> i1 b "fnstcw" arg

48
asmcomp/intel_masm.ml
View File

@ -39,77 +39,78 @@ let string_of_datatype_ptr = function
| PROC -> "PROC PTR "
let bprint_arg_mem b string_of_register mem =
match mem with
| _, (_, 0, None), (None, _) -> assert false (* not implemented *)
| ptr, (_, 0, None), (Some (s,_) , 0L) ->
let ptr = mem.typ in
match mem.idx, mem.scale, mem.base, mem.displ with
| _, 0, None, (None, _) -> assert false (* not implemented *)
| _, 0, None, (Some (s,_) , 0L) ->
Printf.bprintf b "%s %s" (string_of_datatype_ptr ptr) s
| ptr, (_, 0, None), (Some (s,_) , d) ->
| _, 0, None, (Some (s,_) , d) ->
if d > 0L then
Printf.bprintf b "%s %s+%Ld" (string_of_datatype_ptr ptr) s d
else
Printf.bprintf b "%s %s%Ld" (string_of_datatype_ptr ptr) s d
| ptr, (reg1, 1, None), (None, 0L) ->
| reg1, 1, None, (None, 0L) ->
Printf.bprintf b "%s[%s]"
(string_of_datatype_ptr ptr)
(string_of_register reg1);
| ptr, (reg1, 1, None), (None, offset) ->
| reg1, 1, None, (None, offset) ->
Printf.bprintf b "%s[%s%s%Ld]"
(string_of_datatype_ptr ptr)
(string_of_register reg1)
(if offset > 0L then "+" else "")
offset
| ptr, (reg1, scale, None), (None, 0L) ->
| reg1, scale, None, (None, 0L) ->
Printf.bprintf b "%s[%s*%d]"
(string_of_datatype_ptr ptr)
(string_of_register reg1)
scale
| ptr, (reg1, scale, None), (None, offset) ->
| reg1, scale, None, (None, offset) ->
Printf.bprintf b "%s[%s*%d%s%Ld]"
(string_of_datatype_ptr ptr)
(string_of_register reg1)
scale
(if offset > 0L then "+" else "")
offset
| ptr, (reg1, 1, Some reg2), (None, 0L) ->
| reg1, 1, Some reg2, (None, 0L) ->
Printf.bprintf b "%s[%s+%s]"
(string_of_datatype_ptr ptr)
(string_of_register reg2)
(string_of_register reg1)
| ptr, (reg1, 1, None), (Some (s,_), 0L) ->
| reg1, 1, None, (Some (s,_), 0L) ->
Printf.bprintf b "%s[%s+%s]"
(string_of_datatype_ptr ptr)
s
(string_of_register reg1)
| ptr, (reg1, 1, Some reg2), (None, offset) ->
| reg1, 1, Some reg2, (None, offset) ->
Printf.bprintf b "%s[%s+%s%s%Ld]"
(string_of_datatype_ptr ptr)
(string_of_register reg2)
(string_of_register reg1)
(if offset > 0L then "+" else "")
offset
| ptr, (reg1, 1, None), (Some (s,_), offset ) ->
| reg1, 1, None, (Some (s,_), offset ) ->
Printf.bprintf b "%s[%s+%s%s%Ld]"
(string_of_datatype_ptr ptr)
s
(string_of_register reg1)
(if offset > 0L then "+" else "")
offset
| ptr, (reg1, scale, Some reg2), (None, 0L) ->
| reg1, scale, Some reg2, (None, 0L) ->
Printf.bprintf b "%s[%s+%s*%d]"
(string_of_datatype_ptr ptr)
(string_of_register reg2)
(string_of_register reg1)
scale
| ptr, (reg1, scale, None), (Some (s,_), 0L ) ->
| reg1, scale, None, (Some (s,_), 0L ) ->
Printf.bprintf b "%s[%s+%s*%d]"
(string_of_datatype_ptr ptr)
s
(string_of_register reg1)
scale
| ptr, (reg1, scale, Some reg2), (None, offset) ->
| reg1, scale, Some reg2, (None, offset) ->
Printf.bprintf b "%s[%s+%s*%d%s%Ld]"
(string_of_datatype_ptr ptr)
(string_of_register reg2)
@ -117,7 +118,7 @@ let bprint_arg_mem b string_of_register mem =
scale
(if offset > 0L then "+" else "")
offset
| ptr, (reg1, scale, Some reg2), (Some (s,_), offset) ->
| reg1, scale, Some reg2, (Some (s,_), offset) ->
Printf.bprintf b "%s[%s+%s+%s*%d%s%Ld]"
(string_of_datatype_ptr ptr)
s
@ -126,7 +127,7 @@ let bprint_arg_mem b string_of_register mem =
scale
(if offset > 0L then "+" else "")
offset
| ptr, (reg1, scale, None), (Some (s,_), offset) ->
| reg1, scale, None, (Some (s,_), offset) ->
Printf.bprintf b "%s[%s+%s*%d%s%Ld]"
(string_of_datatype_ptr ptr)
s
@ -137,9 +138,10 @@ let bprint_arg_mem b string_of_register mem =
let bprint_arg b arg =
match arg with
| Rel (_, (s, tbl)) ->
assert(tbl == None);
| Rel32 (s, None) ->
Printf.bprintf b "%s" s
| Rel32 _ ->
assert false
| Imm ( (B8|B16|B32), (None, int)) ->
Printf.bprintf b "%Ld" int
@ -164,10 +166,10 @@ let bprint_arg b arg =
(* We don't need to specify RIP on Win64, since EXTERN will provide
the list of external symbols that need this addressing mode, and
MASM will automatically use RIP addressing when needed. *)
| Mem64 (ptr, (RIP, 1, None), (Some (s,_) , 0L)) ->
Printf.bprintf b "%s %s" (string_of_datatype_ptr ptr) s
| Mem64 (ptr, (RIP, 1, None), (Some (s,_), d)) ->
Printf.bprintf b "%s %s+%Ld" (string_of_datatype_ptr ptr) s d
| Mem64 {typ; idx=RIP; scale=1; base=None; displ=(Some (s,_), 0L)} ->
Printf.bprintf b "%s %s" (string_of_datatype_ptr typ) s
| Mem64 {typ; idx=RIP; scale=1; base=None; displ=(Some (s,_), d)} ->
Printf.bprintf b "%s %s+%Ld" (string_of_datatype_ptr typ) s d
| Mem32 addr ->
bprint_arg_mem b string_of_register32 addr