merge changes from 3.10.2merged to 3.11.0

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9153 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

2 files changed, 79 insertions, 22 deletions

diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index c38a73e8c2..4ab379bdaf 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -23,6 +23,12 @@ open Mach
 open Linearize
 open Emitaux
 
+let macosx =
+  match Config.system with
+  | "macosx" -> true
+  | _ -> false
+
+
 (* Tradeoff between code size and code speed *)
 
 let fastcode_flag = ref true
@@ -54,7 +60,26 @@ let slot_offset loc cl =
 (* Symbols *)
 
 let emit_symbol s =
-  Emitaux.emit_symbol '$' s
+    if macosx then emit_string "_"; 
+    Emitaux.emit_symbol '$' s
+
+let emit_call s =
+  if !Clflags.dlcode && not macosx
+  then `call	{emit_symbol s}@PLT`
+  else `call	{emit_symbol s}`
+
+let emit_jump s =
+  if !Clflags.dlcode && not macosx
+  then `jmp	{emit_symbol s}@PLT`
+  else `jmp	{emit_symbol s}`
+
+let load_symbol_addr s =
+  if !Clflags.dlcode
+  then `movq	{emit_symbol s}@GOTPCREL(%rip)`
+  else if !pic_code
+  then `leaq	{emit_symbol s}(%rip)`
+  else `movq	${emit_symbol s}`
+
 
 let emit_call s =
   if !Clflags.dlcode
@@ -82,6 +107,7 @@ let emit_label lbl =
 (* Output a .align directive. *)
 
 let emit_align n =
+    let n = if macosx then Misc.log2 n else n in
   `	.align	{emit_int n}\n`
 
 let emit_Llabel fallthrough lbl =
@@ -588,7 +614,9 @@ let emit_instr fallthrough i =
         end else begin
           `	jmp	*{emit_label lbl}(, {emit_reg i.arg.(0)}, 8)\n`
         end;
-        `	.section .rodata\n`;
+        if macosx
+        then `	.const\n`
+        else `	.section .rodata\n`;
         emit_align 8;
         `{emit_label lbl}:`;
         for i = 0 to Array.length jumptbl - 1 do
@@ -670,9 +698,16 @@ let fundecl fundecl =
   List.iter emit_call_gc !call_gc_sites;
   emit_call_bound_errors ();
   if !float_constants <> [] then begin
-    `	.section	.rodata.cst8,\"a\",@progbits\n`;
+    if macosx
+    then `	.literal8\n`
+    else `	.section	.rodata.cst8,\"a\",@progbits\n`;
     List.iter emit_float_constant !float_constants
-  end
+  end;
+  match Config.system with
+    "linux" | "gnu" ->
+      `	.type	{emit_symbol fundecl.fun_name},@function\n`;
+      `	.size	{emit_symbol fundecl.fun_name},.-{emit_symbol fundecl.fun_name}\n`
+  | _ -> ()
 
 (* Emission of data *)
 
@@ -715,11 +750,19 @@ let data l =
 let begin_assembly() =
   if !Clflags.dlcode then begin
     (* from amd64.S; could emit these constants on demand *)
-    `	.section        .rodata.cst8,\"a\",@progbits\n`;
-    `	.align  16\n`;
-    `caml_negf_mask:	.quad   0x8000000000000000, 0\n`;
-    `	.align  16\n`;
-    `caml_absf_mask:	.quad   0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF\n`;
+    if macosx then begin
+        `	.literal16\n`;
+        `	.align  4\n`;
+        `caml_negf_mask:	.quad   0x8000000000000000, 0\n`;
+        `	.align  4\n`;
+        `caml_absf_mask:	.quad   0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF\n`;
+    end else begin
+        `	.section        .rodata.cst8,\"a\",@progbits\n`;
+        `	.align  16\n`;
+        `caml_negf_mask:	.quad   0x8000000000000000, 0\n`;
+        `	.align  16\n`;
+        `caml_absf_mask:	.quad   0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF\n`;
+    end;
   end;
   let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
   `	.data\n`;
@@ -733,6 +776,7 @@ let begin_assembly() =
 let end_assembly() =
   let lbl_end = Compilenv.make_symbol (Some "code_end") in
   `	.text\n`;
+  if macosx then `	NOP\n`; (* suppress "ld warning: atom sorting error" *)
   `	.globl	{emit_symbol lbl_end}\n`;
   `{emit_symbol lbl_end}:\n`;
   `	.data\n`;
@@ -749,8 +793,17 @@ let end_assembly() =
       efa_32 = (fun n -> `	.long	{emit_int32 n}\n`);
       efa_word = (fun n -> `	.quad	{emit_int n}\n`);
       efa_align = emit_align;
-      efa_label_rel = (fun lbl ofs ->
-                           `	.long	({emit_label lbl} - .) + {emit_int32 ofs}\n`);
+      efa_label_rel =
+        if macosx then begin
+          let setcnt = ref 0 in
+          fun lbl ofs ->
+            incr setcnt;
+            `	.set	L$set${emit_int !setcnt}, ({emit_label lbl} - .) + {emit_int32 ofs}\n`;
+            `	.long L$set${emit_int !setcnt}\n`
+        end else begin
+	  fun lbl ofs ->
+             `	.long	({emit_label lbl} - .) + {emit_int32 ofs}\n`
+	end;
       efa_def_label = (fun l -> `{emit_label l}:\n`);
       efa_string = (fun s -> emit_string_directive "	.asciz	" s) };
   if Config.system = "linux" then
diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml
index 6ee3ee160d..26955f4099 100644
--- a/asmcomp/amd64/selection.ml
+++ b/asmcomp/amd64/selection.ml
@@ -122,17 +122,21 @@ method is_immediate n = n <= 0x7FFFFFFF && n >= -0x80000000
 method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n
 
 method select_addressing exp =
-  match select_addr exp with
-    (Asymbol s, d) ->
-      (Ibased(s, d), Ctuple [])
-  | (Alinear e, d) ->
-      (Iindexed d, e)
-  | (Aadd(e1, e2), d) ->
-      (Iindexed2 d, Ctuple[e1; e2])
-  | (Ascale(e, scale), d) ->
-      (Iscaled(scale, d), e)
-  | (Ascaledadd(e1, e2, scale), d) ->
-      (Iindexed2scaled(scale, d), Ctuple[e1; e2])
+  let (a, d) = select_addr exp in
+  (* PR#4625: displacement must be a signed 32-bit immediate *)
+  if d < -0x8000_0000 || d > 0x7FFF_FFFF
+  then (Iindexed 0, exp)
+  else match a with
+    | Asymbol s ->
+        (Ibased(s, d), Ctuple [])
+    | Alinear e ->
+        (Iindexed d, e)
+    | Aadd(e1, e2) ->
+        (Iindexed2 d, Ctuple[e1; e2])
+    | Ascale(e, scale) ->
+        (Iscaled(scale, d), e)
+    | Ascaledadd(e1, e2, scale) ->
+        (Iindexed2scaled(scale, d), Ctuple[e1; e2])
 
 method select_store addr exp =
   match exp with