diff options
| -rw-r--r-- | asmcomp/amd64/emit.mlp | 63 | ||||
| -rw-r--r-- | asmcomp/x86_gas.ml | 7 | ||||
| -rw-r--r-- | asmcomp/x86_proc.ml | 6 | ||||
| -rw-r--r-- | asmcomp/x86_proc.mli | 2 |
4 files changed, 57 insertions, 21 deletions
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index b3c7b04b80..0ce2e423e1 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -100,26 +100,53 @@ 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 +let imp_table = Hashtbl.create 16 + +let reset_imp_table () = Hashtbl.clear imp_table + +let get_imp_symbol s = + match Hashtbl.find imp_table s with + | exception Not_found -> + let imps = "__caml_imp_" ^ s in + Hashtbl.add imp_table s imps; + imps + | imps -> imps + +let emit_imp_table () = + let f s imps = + _label (emit_symbol imps); + D.qword (ConstLabel (emit_symbol s)) in - sym (if use_plt then emit_symbol s ^ "@PLT" else emit_symbol s) + D.data(); + D.comment "relocation table start"; + D.align 8; + Hashtbl.iter f imp_table; + D.comment "relocation table end" + +let mem__imp s = + let imp_s = get_imp_symbol s in + mem64_rip QWORD (emit_symbol imp_s) + +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 windows = - match system with - | S_mingw64 | S_cygwin | S_win64 -> true - | _ -> false - let load_symbol_addr s arg = - if !Clflags.dlcode && not windows then - I.mov (mem64_rip QWORD (emit_symbol s ^ "@GOTPCREL")) arg + if !Clflags.dlcode then + if windows then begin + (* I.mov (mem__imp s) arg (\* mov __caml_imp_foo(%rip), ... *\) *) + I.mov (sym (emit_symbol s)) arg (* movabsq $foo, ... *) + end else I.mov (mem64_rip QWORD (emit_symbol s ^ "@GOTPCREL")) arg else if !Clflags.pic_code then I.lea (mem64_rip NONE (emit_symbol s)) arg else @@ -529,7 +556,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 @@ -835,13 +862,12 @@ let data l = let begin_assembly() = X86_proc.reset_asm_code (); reset_debug_info(); (* PR#5603 *) + reset_imp_table(); float_constants := []; if system = S_win64 then begin 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 +880,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; @@ -896,6 +923,8 @@ let end_assembly() = emit_global_label "code_end"; + emit_imp_table(); + D.data (); emit_global_label "data_end"; D.long (const 0); diff --git a/asmcomp/x86_gas.ml b/asmcomp/x86_gas.ml index 8739b3be66..2ea01fe88f 100644 --- a/asmcomp/x86_gas.ml +++ b/asmcomp/x86_gas.ml @@ -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 @@ -104,10 +104,9 @@ let i2_ss b s x y = bprintf b "\t%s%s%s\t%a, %a" s (suf x) (suf y) arg x arg y let i1_call_jmp b s = function (* this is the encoding of jump labels: don't use * *) - | Mem64_RIP _ | Mem {arch=X86; idx=_; scale=0; base=None; sym=Some _; _} as x -> i1 b s x - | Reg32 _ | Reg64 _ | Mem _ as x -> bprintf b "\t%s\t*%a" s arg x + | Reg32 _ | Reg64 _ | Mem _ | Mem64_RIP _ as x -> bprintf b "\t%s\t*%a" s arg x | Sym x -> bprintf b "\t%s\t%s" s x | _ -> assert false @@ -182,6 +181,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 diff --git a/asmcomp/x86_proc.ml b/asmcomp/x86_proc.ml index 4eec23b2db..70b92b2fe5 100644 --- a/asmcomp/x86_proc.ml +++ b/asmcomp/x86_proc.ml @@ -50,6 +50,11 @@ let system = match Config.system with | _ -> S_unknown +let windows = + match system with + | 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 @@ -265,3 +270,4 @@ let generate_code asm = | Some f -> binary_content := Some (f instrs) | None -> binary_content := None end + diff --git a/asmcomp/x86_proc.mli b/asmcomp/x86_proc.mli index 22506e2727..40f49af5f8 100644 --- a/asmcomp/x86_proc.mli +++ b/asmcomp/x86_proc.mli @@ -75,7 +75,7 @@ type system = val system: system val masm: bool - +val windows:bool (** Support for plumbing a binary code emitter *) |