Split immediate symbol and immediate constant cases.
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/abstract_intel_emit@15284 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Alain Frisch
parent
7f7a43b200
commit
78445243b6
|
|
@ -101,8 +101,6 @@ let symbol_prefix = if system = S_macosx then "_" else ""
|
|||
let emit_symbol s =
|
||||
string_of_symbol symbol_prefix s
|
||||
|
||||
let abs ?tbl s = (emit_symbol s, tbl)
|
||||
|
||||
(* Record symbols used and defined - at the end generate extern for those
|
||||
used but not defined *)
|
||||
|
||||
|
|
@ -121,7 +119,7 @@ let use_plt =
|
|||
| _ -> !Clflags.dlcode
|
||||
|
||||
let rel_plt s =
|
||||
rel32 (if use_plt then abs s ~tbl:PLT else abs s)
|
||||
rel32 (if use_plt then emit_symbol s ^ "@PLT" else emit_symbol s)
|
||||
|
||||
let emit_call s =
|
||||
I.call (rel_plt s)
|
||||
|
|
@ -136,11 +134,11 @@ let windows =
|
|||
|
||||
let load_symbol_addr s arg =
|
||||
if !Clflags.dlcode && not windows then
|
||||
I.movq (from_rip QWORD (abs s ~tbl:GOTPCREL), arg)
|
||||
I.movq (from_rip QWORD (emit_symbol s ^ "@GOTPCREL"), arg)
|
||||
else if !pic_code then
|
||||
I.leaq (from_rip NO (abs s), arg)
|
||||
I.leaq (from_rip NO (emit_symbol s), arg)
|
||||
else
|
||||
I.movq (imm64 (abs s), arg)
|
||||
I.movq (imm64 (emit_symbol s), arg)
|
||||
|
||||
(* Output a label *)
|
||||
|
||||
|
|
@ -156,9 +154,7 @@ let emit_data_label lbl =
|
|||
else
|
||||
Printf.sprintf ".Ld%d" lbl
|
||||
|
||||
let abs_label s = (emit_label s, None)
|
||||
|
||||
let label s = rel32 (abs_label s)
|
||||
let label s = rel32 (emit_label s)
|
||||
|
||||
let def_label s =
|
||||
directive (NewLabel (emit_label s, NO))
|
||||
|
|
@ -232,7 +228,7 @@ let addressing addr typ i n =
|
|||
(* | Ibased _ when !Clflags.dlcode -> assert false ONLY on Unix *)
|
||||
| Ibased(s, ofs) ->
|
||||
add_used_symbol s;
|
||||
from_rip typ (abs s) ~ofs
|
||||
from_rip typ (emit_symbol s) ~ofs
|
||||
| Iindexed d ->
|
||||
mem_ptr typ d (arg64 i n)
|
||||
| Iindexed2 d ->
|
||||
|
|
@ -484,7 +480,7 @@ let emit_instr fallthrough i =
|
|||
I.xorpd (res i 0, res i 0)
|
||||
| _ ->
|
||||
let lbl = add_float_constant f in
|
||||
I.movsd (from_rip NO (abs_label lbl), res i 0)
|
||||
I.movsd (from_rip NO (emit_label lbl), res i 0)
|
||||
end
|
||||
| Lop(Iconst_symbol s) ->
|
||||
add_used_symbol s;
|
||||
|
|
@ -582,7 +578,7 @@ let emit_instr fallthrough i =
|
|||
load_symbol_addr "caml_young_limit" rax;
|
||||
I.cmpq (mem_ptr QWORD 0 RAX, r15);
|
||||
end else
|
||||
I.cmpq (from_rip QWORD (abs "caml_young_limit"), r15);
|
||||
I.cmpq (from_rip QWORD (emit_symbol "caml_young_limit"), r15);
|
||||
let lbl_call_gc = new_label() in
|
||||
let lbl_frame = record_frame_label i.live Debuginfo.none in
|
||||
I.jb (label lbl_call_gc);
|
||||
|
|
@ -642,9 +638,9 @@ let emit_instr fallthrough i =
|
|||
(* We have i.arg.(0) = i.res.(0) *)
|
||||
instr_for_intop op (int n, res i 0)
|
||||
| Lop(Inegf) ->
|
||||
I.xorpd (from_rip OWORD (abs "caml_negf_mask"), res i 0)
|
||||
I.xorpd (from_rip OWORD (emit_symbol "caml_negf_mask"), res i 0)
|
||||
| Lop(Iabsf) ->
|
||||
I.andpd (from_rip OWORD (abs "caml_absf_mask"), res i 0)
|
||||
I.andpd (from_rip OWORD (emit_symbol "caml_absf_mask"), res i 0)
|
||||
| Lop(Iaddf | Isubf | Imulf | Idivf as floatop) ->
|
||||
instr_for_floatop floatop (arg i 1, res i 0)
|
||||
| Lop(Ifloatofint) ->
|
||||
|
|
@ -744,7 +740,7 @@ let emit_instr fallthrough i =
|
|||
then (phys_reg 4 (*rdx*), phys_reg 0 (*rax*))
|
||||
else (phys_reg 0 (*rax*), phys_reg 4 (*rdx*)) in
|
||||
|
||||
I.leaq (from_rip NO (abs_label lbl), reg tmp1);
|
||||
I.leaq (from_rip NO (emit_label lbl), reg tmp1);
|
||||
I.movslq (mem_ptr DWORD 0 (arg64 i 0) ~scale:4 ~base:(reg64 tmp1), reg tmp2);
|
||||
I.addq (reg tmp2, reg tmp1);
|
||||
I.jmp (reg tmp1);
|
||||
|
|
|
|||
|
|
@ -107,10 +107,10 @@ let emit_symbol s =
|
|||
|
||||
let abs s = (emit_symbol s, None)
|
||||
|
||||
let immsym s = imm32 (abs s)
|
||||
let immsym s = imm32 (emit_symbol s)
|
||||
|
||||
let emit_call s =
|
||||
I.call (rel32 (abs s))
|
||||
I.call (rel32 (emit_symbol s))
|
||||
|
||||
(* Output a label *)
|
||||
|
||||
|
|
@ -129,9 +129,7 @@ let emit_label lbl =
|
|||
let emit_data_label lbl =
|
||||
Printf.sprintf "%sd%d" label_prefix lbl
|
||||
|
||||
let abs_label s = (emit_label s, None)
|
||||
|
||||
let label s = rel32 (abs_label s)
|
||||
let label s = rel32 (emit_label s)
|
||||
|
||||
let def_label s =
|
||||
directive (NewLabel (emit_label s, NO))
|
||||
|
|
@ -550,7 +548,7 @@ let emit_instr fallthrough i =
|
|||
else begin
|
||||
output_epilogue begin fun () ->
|
||||
add_used_symbol s;
|
||||
I.jmp (rel32 (abs s))
|
||||
I.jmp (rel32 (emit_symbol s))
|
||||
end
|
||||
end
|
||||
| Lop(Iextcall(s, alloc)) ->
|
||||
|
|
|
|||
|
|
@ -82,13 +82,12 @@ type register32 =
|
|||
|
||||
type registerf = XMM of int | TOS | ST of int
|
||||
|
||||
type symbol = string * reloc_table option
|
||||
|
||||
(* A direct value is a combination of:
|
||||
* an integer offset
|
||||
* a symbol
|
||||
*)
|
||||
type offset = symbol option * int64
|
||||
type offset = string option * int64
|
||||
|
||||
type 'reg addr =
|
||||
{
|
||||
|
|
@ -102,10 +101,15 @@ type 'reg addr =
|
|||
|
||||
type arg =
|
||||
(* operand is an immediate value *)
|
||||
| Imm of data_size * offset
|
||||
| Imm of data_size * int64
|
||||
| Sym of string
|
||||
|
||||
(* TODO:
|
||||
split Imm into immediate symbol (no offset, no reloc table)
|
||||
and pure constant *)
|
||||
|
||||
(* operand is a relative displacement (call/jmp targets) *)
|
||||
| Rel32 of symbol
|
||||
| Rel32 of string
|
||||
|
||||
| Reg8 of register8
|
||||
| Reg16 of register16
|
||||
|
|
|
|||
|
|
@ -62,15 +62,15 @@ module DSL = struct
|
|||
(* Override emitaux.ml *)
|
||||
let emit_int n =
|
||||
if n >= -0x80L && n <= 0x7FL then
|
||||
Imm (B8, (None, n))
|
||||
Imm (B8, n)
|
||||
else
|
||||
if n >= -0x8000L && n <= 0x7FFFL then
|
||||
Imm (B16, (None, n))
|
||||
Imm (B16, n)
|
||||
else
|
||||
(* We emit all immediates as B32, even if they are bigger.
|
||||
The only instruction (movabsq) taking an immediate B64 will cast
|
||||
B8|B16|B32 to B64. *)
|
||||
Imm (B32, (None, n))
|
||||
Imm (B32, n)
|
||||
|
||||
(* Override emitaux.ml *)
|
||||
let const_int n =
|
||||
|
|
@ -253,7 +253,7 @@ module DSL32 = struct
|
|||
let st0 = Regf (ST 0)
|
||||
let st1 = Regf (ST 1)
|
||||
|
||||
let imm32 l = Imm (B32, (Some l,0L))
|
||||
let imm32 l = Sym l
|
||||
|
||||
let mem_ptr typ ?(scale = 1) ?base ?sym offset idx =
|
||||
assert(scale > 0);
|
||||
|
|
@ -261,7 +261,7 @@ module DSL32 = struct
|
|||
|
||||
let mem_sym typ ?(ofs = 0) l =
|
||||
Mem32 {typ; idx=EAX; scale=0; base=None;
|
||||
displ=(Some (l, None), Int64.of_int ofs)}
|
||||
displ=(Some l, Int64.of_int ofs)}
|
||||
end
|
||||
|
||||
|
||||
|
|
@ -346,7 +346,7 @@ module DSL64 = struct
|
|||
let rbp = Reg64 RBP
|
||||
let xmm15 = Regf (XMM 15)
|
||||
|
||||
let imm64 s = Imm (B64, (Some s,0L))
|
||||
let imm64 s = Sym s
|
||||
|
||||
let mem_ptr typ ?(scale = 1) ?base offset idx =
|
||||
assert(scale > 0);
|
||||
|
|
|
|||
|
|
@ -46,37 +46,26 @@ open Intel_proc
|
|||
|
||||
let tab b = Buffer.add_char b '\t'
|
||||
|
||||
let string_of_table = function
|
||||
| Some PLT -> "@PLT"
|
||||
| Some GOTPCREL -> "@GOTPCREL"
|
||||
| None -> ""
|
||||
|
||||
let print_sym_tbl b (s, table) =
|
||||
Buffer.add_string b s;
|
||||
Buffer.add_string b (string_of_table table)
|
||||
|
||||
let print_reg b f r =
|
||||
Buffer.add_char b '%';
|
||||
Buffer.add_string b (f r)
|
||||
|
||||
let print_opt_reg b f = function
|
||||
| None -> ()
|
||||
| Some reg -> print_reg b f reg
|
||||
|
||||
let print_sym_offset b = function
|
||||
let bprint_arg_mem b string_of_register {typ=_; idx; scale; base; displ} =
|
||||
begin match displ with
|
||||
| (None, x) -> Printf.bprintf b "%Ld" x
|
||||
| (Some s, x) ->
|
||||
print_sym_tbl b s;
|
||||
Buffer.add_string b s;
|
||||
match x with
|
||||
| 0L -> ()
|
||||
| x when x > 0L -> Printf.bprintf b "+%Ld" x
|
||||
| x -> Printf.bprintf b "%Ld" x
|
||||
|
||||
let bprint_arg_mem b string_of_register {typ=_; idx; scale; base; displ} =
|
||||
print_sym_offset b displ;
|
||||
end;
|
||||
if scale <> 0 || base != None then begin
|
||||
Buffer.add_char b '(';
|
||||
print_opt_reg b string_of_register base;
|
||||
begin match base with
|
||||
| None -> ()
|
||||
| Some base -> print_reg b string_of_register base
|
||||
end;
|
||||
if scale <> 0 then begin
|
||||
if base <> None || scale <> 1 then Buffer.add_char b ',';
|
||||
print_reg b string_of_register idx;
|
||||
|
|
@ -86,8 +75,9 @@ let bprint_arg_mem b string_of_register {typ=_; idx; scale; base; displ} =
|
|||
end
|
||||
|
||||
let bprint_arg b = function
|
||||
| Rel32 sym -> print_sym_tbl b sym
|
||||
| Imm (_, x) -> Buffer.add_char b '$'; print_sym_offset b x
|
||||
| Rel32 s -> Buffer.add_string b s
|
||||
| Sym x -> Buffer.add_char b '$'; Buffer.add_string b x
|
||||
| Imm (_, x) -> Printf.bprintf b "$%Ld" x
|
||||
| Reg8 x -> print_reg b string_of_register8 x
|
||||
| Reg16 x -> print_reg b string_of_register16 x
|
||||
| Reg32 x -> print_reg b string_of_register32 x
|
||||
|
|
|
|||
|
|
@ -42,9 +42,9 @@ let bprint_arg_mem b string_of_register mem =
|
|||
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) ->
|
||||
| _, 0, None, (Some s , 0L) ->
|
||||
Printf.bprintf b "%s %s" (string_of_datatype_ptr ptr) s
|
||||
| _, 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
|
||||
|
|
@ -79,7 +79,7 @@ let bprint_arg_mem b string_of_register mem =
|
|||
(string_of_datatype_ptr ptr)
|
||||
(string_of_register reg2)
|
||||
(string_of_register reg1)
|
||||
| reg1, 1, None, (Some (s,_), 0L) ->
|
||||
| reg1, 1, None, (Some s, 0L) ->
|
||||
Printf.bprintf b "%s[%s+%s]"
|
||||
(string_of_datatype_ptr ptr)
|
||||
s
|
||||
|
|
@ -91,7 +91,7 @@ let bprint_arg_mem b string_of_register mem =
|
|||
(string_of_register reg1)
|
||||
(if offset > 0L then "+" else "")
|
||||
offset
|
||||
| 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
|
||||
|
|
@ -104,7 +104,7 @@ let bprint_arg_mem b string_of_register mem =
|
|||
(string_of_register reg2)
|
||||
(string_of_register reg1)
|
||||
scale
|
||||
| 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
|
||||
|
|
@ -118,7 +118,7 @@ let bprint_arg_mem b string_of_register mem =
|
|||
scale
|
||||
(if offset > 0L then "+" else "")
|
||||
offset
|
||||
| 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
|
||||
|
|
@ -127,7 +127,7 @@ let bprint_arg_mem b string_of_register mem =
|
|||
scale
|
||||
(if offset > 0L then "+" else "")
|
||||
offset
|
||||
| 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
|
||||
|
|
@ -138,19 +138,16 @@ let bprint_arg_mem b string_of_register mem =
|
|||
|
||||
let bprint_arg b arg =
|
||||
match arg with
|
||||
| Rel32 (s, None) ->
|
||||
| Rel32 s ->
|
||||
Printf.bprintf b "%s" s
|
||||
| Rel32 _ ->
|
||||
assert false
|
||||
|
||||
| Imm ( (B8|B16|B32), (None, int)) ->
|
||||
| Imm ( (B8|B16|B32), int) ->
|
||||
Printf.bprintf b "%Ld" int
|
||||
| Imm ( B64, (None, int)) ->
|
||||
| Imm ( B64, int) ->
|
||||
(* force ml64 to use mov reg, imm64 instruction *)
|
||||
Printf.bprintf b "0%LxH" int
|
||||
| Imm (_, (Some (s, None),0L)) ->
|
||||
| Sym s ->
|
||||
Printf.bprintf b "OFFSET %s" s
|
||||
| Imm (_, _) -> assert false
|
||||
|
||||
| Reg8 register8 ->
|
||||
Printf.bprintf b "%s" (string_of_register8 register8)
|
||||
|
|
@ -166,9 +163,9 @@ 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 {typ; idx=RIP; scale=1; base=None; displ=(Some (s,_), 0L)} ->
|
||||
| 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)} ->
|
||||
| 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 ->
|
||||
|
|
|
|||
Loading…
Reference in New Issue