summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAlain Frisch <alain@frisch.fr>2014-09-22 10:01:46 +0000
committerAlain Frisch <alain@frisch.fr>2014-09-22 10:01:46 +0000
commit7f7a43b200819212303e50b327d87442919de226 (patch)
tree1d42fe6a7cc5e9f5067f92b02e7d0ef40e762cf6
parent09fb7eb2683e67be69be7b20929c0002d85615c7 (diff)
Turn addr into a record.
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/abstract_intel_emit@15283 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r--asmcomp/intel_ast.mli15
-rw-r--r--asmcomp/intel_dsl.ml15
-rw-r--r--asmcomp/intel_gas.ml28
-rw-r--r--asmcomp/intel_masm.ml48
4 files changed, 59 insertions, 47 deletions
diff --git a/asmcomp/intel_ast.mli b/asmcomp/intel_ast.mli
index 06cbcdaf9..ff853cb97 100644
--- a/asmcomp/intel_ast.mli
+++ b/asmcomp/intel_ast.mli
@@ -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
diff --git a/asmcomp/intel_dsl.ml b/asmcomp/intel_dsl.ml
index c25013474..bb5114e98 100644
--- a/asmcomp/intel_dsl.ml
+++ b/asmcomp/intel_dsl.ml
@@ -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
diff --git a/asmcomp/intel_gas.ml b/asmcomp/intel_gas.ml
index 957c65aec..d2fb06fd5 100644
--- a/asmcomp/intel_gas.ml
+++ b/asmcomp/intel_gas.ml
@@ -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
diff --git a/asmcomp/intel_masm.ml b/asmcomp/intel_masm.ml
index 8eb74c167..b7046f687 100644
--- a/asmcomp/intel_masm.ml
+++ b/asmcomp/intel_masm.ml
@@ -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