Generate PIE code for Apple. This only affects symbol literals. Jumps can be resolved by ld (that's where PIE is simpler than PIC).

Signed-off-by: Gerd Stolpmann <gerd@gerd-stolpmann.de>

2 files changed, 89 insertions, 11 deletions

diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp
index 8bc406281f..24ec8e7781 100644
--- a/asmcomp/arm/emit.mlp
+++ b/asmcomp/arm/emit.mlp
@@ -13,6 +13,9 @@
 
 (* Emission of ARM assembly code *)
 
+module StrSet = Set.Make(String)
+module StrMap = Map.Make(String)
+
 open Misc
 open Cmm
 open Arch
@@ -310,6 +313,8 @@ let float_literals = ref ([] : (int64 * label) list)
 let gotrel_literals = ref ([] : (label * label) list)
 (* Pending symbol literals *)
 let symbol_literals = ref ([] : (string * label) list)
+(* Symbol literals emitted at the end of the object *)
+let delayed_symbol_literals = ref (StrMap.empty : label StrMap.t)
 (* Total space (in words) occupied by pending literals *)
 let num_literals = ref 0
 
@@ -341,7 +346,16 @@ let symbol_literal s =
     symbol_literals := (s, lbl) :: !symbol_literals;
     lbl
 
-(* Emit all pending literals *)
+let delayed_symbol_literal s =
+  try
+    StrMap.find s !delayed_symbol_literals
+  with Not_found ->
+    let lbl = new_label() in
+    delayed_symbol_literals := StrMap.add s lbl !delayed_symbol_literals;
+    lbl
+
+
+(* Emit all pending literals, but not the delayed ones *)
 let emit_literals() =
   if !float_literals <> [] then begin
     `	.align	3\n`;
@@ -368,10 +382,60 @@ let emit_literals() =
   end;
   num_literals := 0
 
+
+let emit_delayed_symbol_literals() =
+  if !delayed_symbol_literals <> StrMap.empty then begin
+    assert macosx;
+    let direct, indirect =
+      List.partition
+        (fun (sym, lbl) ->
+           Compilenv.symbol_in_current_unit sym
+        )
+        (StrMap.bindings !delayed_symbol_literals) in
+    (* references to symbols defined in this object can be resolved by the
+       assembler
+     *)
+    if direct <> [] then begin
+      `	.data\n`;
+      `	.align	2\n`;
+      List.iter
+        (fun (sym, lbl) ->
+           `{emit_label lbl}:	.word	{emit_symbol sym}\n`;
+        )
+        direct
+    end;
+    (* references to symbols defined in other objects need to go into the
+       section for indirect symbols, and will be resolved statically by ld.
+     *)
+    if indirect <> [] then begin
+      `	.non_lazy_symbol_pointer\n`;
+      `	.align	2\n`;
+      List.iter
+        (fun (sym, lbl) ->
+          `{emit_label lbl}:	.indirect_symbol	{emit_symbol sym}\n`;
+          `	.long 0\n`;
+        )
+        indirect;
+    end;
+    delayed_symbol_literals := StrMap.empty
+  end
+
+
 (* Emit code to load the address of a symbol *)
 
 let emit_load_symbol_addr dst s =
-  if !pic_code then begin
+  if !pie_code then begin
+    assert macosx;
+    let offset = if !thumb then 4 else 8 in
+    let lbl_pic = new_label() in
+    let lbl_sym = delayed_symbol_literal s in
+    `	movw	{emit_reg dst}, #:lower16:({emit_label lbl_sym}-({emit_label lbl_pic}+{emit_int offset}))\n`;
+    `	movt	{emit_reg dst}, #:upper16:({emit_label lbl_sym}-({emit_label lbl_pic}+{emit_int offset}))\n`;
+    `{emit_label lbl_pic}:	add	{emit_reg dst}, pc\n`;
+    `	ldr	{emit_reg dst}, [{emit_reg dst}]\n`;
+    4
+  end else if !pic_code then begin
+    assert (not macosx);
     let lbl_pic = new_label() in
     let lbl_got = gotrel_literal lbl_pic in
     let lbl_sym = symbol_literal s in
@@ -865,7 +929,7 @@ let emit_instr i =
             if tramtbl.(j) <> jumptbl.(j) then
               `{emit_label tramtbl.(j)}:	b	{emit_label jumptbl.(j)}\n`
           done
-        end else if not !pic_code then begin
+        end else if not !pic_code && not !pie_code then begin
           `	ldr	pc, [pc, {emit_reg i.arg.(0)}, lsl #2]\n`;
           `	nop\n`;
           for j = 0 to Array.length jumptbl - 1 do
@@ -1005,6 +1069,7 @@ let data l =
 
 let begin_assembly() =
   reset_debug_info();
+  delayed_symbol_literals := StrMap.empty;
   `	.syntax	unified\n`;
   if not macosx then begin
     match !arch with
@@ -1083,6 +1148,7 @@ let end_assembly () =
     `	.type	{emit_symbol lbl}, %object\n`;
     `	.size	{emit_symbol lbl}, .-{emit_symbol lbl}\n`;
   end;
+  emit_delayed_symbol_literals();
   begin match Config.system with
     "linux_eabihf" | "linux_eabi" ->
       (* Mark stack as non-executable *)
diff --git a/asmrun/arm.S b/asmrun/arm.S
index c5b397c372..cae38573e1 100644
--- a/asmrun/arm.S
+++ b/asmrun/arm.S
@@ -46,25 +46,34 @@ P($0):  .word Glo($0)
 P($0):  .word Loc($0)
         .endm
 #else
+        /* for ARM>=7 we can easily support PIE because we have movw and movt */
         .thumb
+        Lpcreloffs = 4     /* for .arm: 8 */
         .macro .funtype
         .thumb_func $0
         .endm
-        /* load global address, non-PIE */
+        /* load global address, PIE */
         .macro ldgaddr
-        ldr $0, P($1)
+        movw $0, #:lower16:(P($1) - (9f + Lpcreloffs))
+        movt $0, #:upper16:(P($1) - (9f + Lpcreloffs))
+9:
+        add $0, pc               /* actually $0 := $0 + pc + Lpcreloffs */
+        ldr $0, [$0]
         .endm
-        /* indirection for global address, non-PIE */
+        /* indirection for global address, PIE */
         .macro gaddr
-P($0):  .word Glo($0)
+P($0):  .indirect_symbol Glo($0)
+        .long 0
         .endm
-        /* load local address, non-PIE */
+        /* load local address, PIE */
         .macro ldladdr
-        ldr $0, P($1)
+        movw $0, #:lower16:(Loc($1) - (9f + Lpcreloffs))
+        movt $0, #:upper16:(Loc($1) - (9f + Lpcreloffs))
+9:
+        add $0, pc               /* actually $0 := $0 + pc + Lpcreloffs */
         .endm
-        /* indirection for local address, non-PIE */
+        /* indirection for local address, PIE */
         .macro laddr
-P($0):  .word Loc($0)
         .endm
 #endif
         .macro  .type
@@ -558,6 +567,9 @@ Glo(caml_ml_array_bound_error):
 
 /* Indirection block for macosx */
 #if defined(SYS_macosx)
+#if !defined(MODEL_armv6)
+        .non_lazy_symbol_pointer
+#endif
         .align 2
          gaddr caml_last_return_address
          gaddr caml_bottom_of_stack