diff options
author | Alain Frisch <alain@frisch.fr> | 2014-09-22 10:01:46 +0000 |
---|---|---|
committer | Alain Frisch <alain@frisch.fr> | 2014-09-22 10:01:46 +0000 |
commit | 7f7a43b200819212303e50b327d87442919de226 (patch) | |
tree | 1d42fe6a7cc5e9f5067f92b02e7d0ef40e762cf6 | |
parent | 09fb7eb2683e67be69be7b20929c0002d85615c7 (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.mli | 15 | ||||
-rw-r--r-- | asmcomp/intel_dsl.ml | 15 | ||||
-rw-r--r-- | asmcomp/intel_gas.ml | 28 | ||||
-rw-r--r-- | asmcomp/intel_masm.ml | 48 |
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 |