Adapt amd64 backends under windows in order to avoid relative relocations to symbols that could be defined in other images. This is necessary to allow .cmxs to be loaded at arbitrary addresses. 32-bit relative relocations could previously fail if the .cmxs was loaded too far from the main program. Require flexdll 0.34, which has improved support for __imp_X symbols.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15789 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Alain Frisch
parent
954b798ba7
commit
2535da8317
|
|
@ -75,7 +75,7 @@ THIRD-PARTY SOFTWARE:
|
|||
http://www.microsoft.com/downloads/en/default.aspx
|
||||
under the name "Microsoft Windows 7 SDK".
|
||||
|
||||
[2] flexdll version 0.31 or later.
|
||||
[2] flexdll version 0.34 or later.
|
||||
Can be downloaded from http://alain.frisch.fr/flexdll.html
|
||||
|
||||
RECOMPILATION FROM THE SOURCES:
|
||||
|
|
@ -362,7 +362,7 @@ THIRD-PARTY SOFTWARE:
|
|||
http://www.microsoft.com/downloads/en/default.aspx
|
||||
under the name "Microsoft Windows 7 SDK".
|
||||
|
||||
[2] flexdll version 0.31 or later.
|
||||
[2] flexdll version 0.34 or later.
|
||||
Can be downloaded from http://alain.frisch.fr/flexdll.html
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -100,27 +100,35 @@ let symbols_used = ref StringSet.empty
|
|||
let add_def_symbol s = symbols_defined := StringSet.add s !symbols_defined
|
||||
let add_used_symbol s = symbols_used := StringSet.add s !symbols_used
|
||||
|
||||
let rel_plt s =
|
||||
let use_plt =
|
||||
match system with
|
||||
| S_macosx | S_mingw64 | S_cygwin | S_win64 -> false
|
||||
| _ -> !Clflags.dlcode
|
||||
in
|
||||
sym (if use_plt then emit_symbol s ^ "@PLT" else emit_symbol s)
|
||||
|
||||
let emit_call s = I.call (rel_plt s)
|
||||
|
||||
let emit_jump s = I.jmp (rel_plt s)
|
||||
|
||||
let windows =
|
||||
match system with
|
||||
| S_mingw64 | S_cygwin | S_win64 -> true
|
||||
| _ -> false
|
||||
|
||||
let mem__imp s =
|
||||
let imps = "__imp_" ^ s in
|
||||
add_used_symbol imps;
|
||||
mem64_rip QWORD (emit_symbol imps)
|
||||
|
||||
let rel_plt s =
|
||||
if windows && !Clflags.dlcode then
|
||||
mem__imp s
|
||||
else
|
||||
let use_plt =
|
||||
match system with
|
||||
| S_macosx | S_mingw64 | S_cygwin | S_win64 -> false
|
||||
| _ -> !Clflags.dlcode
|
||||
in
|
||||
sym (if use_plt then emit_symbol s ^ "@PLT" else emit_symbol s)
|
||||
|
||||
let emit_call s = I.call (rel_plt s)
|
||||
|
||||
let emit_jump s = I.jmp (rel_plt s)
|
||||
|
||||
let load_symbol_addr s arg =
|
||||
if !Clflags.dlcode && not windows then
|
||||
I.mov (mem64_rip QWORD (emit_symbol s ^ "@GOTPCREL")) arg
|
||||
else if !pic_code then
|
||||
else if !pic_code && not (windows && !Clflags.dlcode) then
|
||||
I.lea (mem64_rip NONE (emit_symbol s)) arg
|
||||
else
|
||||
I.mov (sym (emit_symbol s)) arg
|
||||
|
|
@ -529,7 +537,7 @@ let emit_instr fallthrough i =
|
|||
let lbl_redo = new_label() in
|
||||
def_label lbl_redo;
|
||||
I.sub (int n) r15;
|
||||
if !Clflags.dlcode && system <> S_win64 then begin
|
||||
if !Clflags.dlcode then begin
|
||||
load_symbol_addr "caml_young_limit" rax;
|
||||
I.cmp (mem64 QWORD 0 RAX) r15;
|
||||
end else
|
||||
|
|
@ -840,8 +848,6 @@ let begin_assembly() =
|
|||
D.extrn "caml_young_ptr" QWORD;
|
||||
D.extrn "caml_young_limit" QWORD;
|
||||
D.extrn "caml_exception_pointer" QWORD;
|
||||
D.extrn "caml_absf_mask" QWORD;
|
||||
D.extrn "caml_negf_mask" QWORD;
|
||||
D.extrn "caml_call_gc" NEAR;
|
||||
D.extrn "caml_c_call" NEAR;
|
||||
D.extrn "caml_allocN" NEAR;
|
||||
|
|
@ -854,11 +860,12 @@ let begin_assembly() =
|
|||
end;
|
||||
|
||||
|
||||
if !Clflags.dlcode && system <> S_win64 then begin
|
||||
if !Clflags.dlcode then begin
|
||||
(* from amd64.S; could emit these constants on demand *)
|
||||
begin match system with
|
||||
| S_macosx -> D.section ["__TEXT";"__literal16"] None ["16byte_literals"]
|
||||
| S_mingw64 | S_cygwin -> D.section [".rdata"] (Some "dr") []
|
||||
| S_win64 -> D.data ();
|
||||
| _ -> D.section [".rodata.cst8"] (Some "a") ["@progbits"]
|
||||
end;
|
||||
D.align 16;
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ let opt_displ b displ =
|
|||
else bprintf b "%d" displ
|
||||
|
||||
let arg_mem b {arch; typ=_; idx; scale; base; sym; displ} =
|
||||
let string_of_register =
|
||||
let string_of_register =
|
||||
match arch with
|
||||
| X86 -> string_of_reg32
|
||||
| X64 -> string_of_reg64
|
||||
|
|
@ -182,6 +182,8 @@ let print_instr b = function
|
|||
| MOV ((Imm n as arg1), (Reg64 _ as arg2))
|
||||
when not (n <= 0x7FFF_FFFFL && n >= -0x8000_0000L) ->
|
||||
i2 b "movabsq" arg1 arg2
|
||||
| MOV ((Sym _ as arg1), (Reg64 _ as arg2)) when windows ->
|
||||
i2 b "movabsq" arg1 arg2
|
||||
| MOV (arg1, arg2) -> i2_s b "mov" arg1 arg2
|
||||
| MOVAPD (arg1, arg2) -> i2 b "movapd" arg1 arg2
|
||||
| MOVLPD (arg1, arg2) -> i2 b "movlpd" arg1 arg2
|
||||
|
|
|
|||
|
|
@ -50,6 +50,12 @@ let system = match Config.system with
|
|||
|
||||
| _ -> S_unknown
|
||||
|
||||
let windows =
|
||||
match system with
|
||||
| S_mingw | S_win32
|
||||
| S_mingw64 | S_cygwin | S_win64 -> true
|
||||
| _ -> false
|
||||
|
||||
let string_of_string_literal s =
|
||||
let b = Buffer.create (String.length s + 2) in
|
||||
let last_was_escape = ref false in
|
||||
|
|
|
|||
|
|
@ -75,6 +75,7 @@ type system =
|
|||
|
||||
val system: system
|
||||
val masm: bool
|
||||
val windows: bool
|
||||
|
||||
|
||||
(** Support for plumbing a binary code emitter *)
|
||||
|
|
|
|||
Loading…
Reference in New Issue