Merge pull request #9699 from EduardoRFS/trunk-ios

Add support for iOS and macOS on ARM64

1 files changed, 46 insertions, 14 deletions

diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp
index e401f7b0a4..636da014a9 100644
--- a/asmcomp/arm64/emit.mlp
+++ b/asmcomp/arm64/emit.mlp
@@ -38,18 +38,35 @@ let reg_trap_ptr = phys_reg 23
 let reg_alloc_ptr = phys_reg 24
 let reg_alloc_limit = phys_reg 25
 let reg_tmp1 = phys_reg 26
-let reg_x15 = phys_reg 15
+let reg_x8 = phys_reg 8
 
 (* Output a label *)
 
+let label_prefix =
+  if macosx then "L" else ".L"
+
 let emit_label lbl =
-  emit_string ".L"; emit_int lbl
+  emit_string label_prefix; emit_int lbl
 
 (* Symbols *)
 
 let emit_symbol s =
+  if macosx then emit_string "_";
   Emitaux.emit_symbol '$' s
 
+(* Object types *)
+
+let emit_symbol_type emit_lbl_or_sym lbl_or_sym ty =
+  if not macosx then begin
+    `	.type	{emit_lbl_or_sym lbl_or_sym}, %{emit_string ty}\n`
+  end
+
+
+let emit_symbol_size sym =
+  if not macosx then begin
+    `	.size	{emit_symbol sym}, .-{emit_symbol sym}\n`
+  end
+
 (* Output a pseudo-register *)
 
 let emit_reg = function
@@ -320,6 +337,8 @@ let float_literal f =
 (* Emit all pending literals *)
 let emit_literals() =
   if !float_literals <> [] then begin
+    if macosx then
+      `	.section	__TEXT,__literal8,8byte_literals\n`;
     `	.align	3\n`;
     List.iter
       (fun (f, lbl) ->
@@ -331,7 +350,10 @@ let emit_literals() =
 (* Emit code to load the address of a symbol *)
 
 let emit_load_symbol_addr dst s =
-  if not !Clflags.dlcode then begin
+  if macosx then begin
+    `	adrp	{emit_reg dst}, {emit_symbol s}@GOTPAGE\n`;
+    `	ldr	{emit_reg dst}, [{emit_reg dst}, {emit_symbol s}@GOTPAGEOFF]\n`
+  end else if not !Clflags.dlcode then begin
     `	adrp	{emit_reg dst}, {emit_symbol s}\n`;
     `	add	{emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n`
   end else begin
@@ -566,7 +588,7 @@ let assembly_code_for_allocation ?label_after_call_gc i ~n ~far =
     | 16 -> `	bl	{emit_symbol "caml_alloc1"}\n`
     | 24 -> `	bl	{emit_symbol "caml_alloc2"}\n`
     | 32 -> `	bl	{emit_symbol "caml_alloc3"}\n`
-    | _  -> emit_intconst reg_x15 (Nativeint.of_int n);
+    | _  -> emit_intconst reg_x8 (Nativeint.of_int n);
             `	bl	{emit_symbol "caml_allocN"}\n`
     end;
     `{emit_label lbl_frame}:	add	{emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
@@ -581,6 +603,17 @@ let emit_named_text_section func_name =
   else
     `	.text\n`
 
+(* Emit code to load an emitted literal *)
+
+let emit_load_literal dst lbl =
+  if macosx then begin
+    `	adrp	{emit_reg reg_tmp1}, {emit_label lbl}@PAGE\n`;
+    `	ldr	{emit_reg dst}, [{emit_reg reg_tmp1}, {emit_label lbl}@PAGEOFF]\n`
+  end else begin
+    `	adrp	{emit_reg reg_tmp1}, {emit_label lbl}\n`;
+    `	ldr	{emit_reg dst}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
+  end
+
 (* Output the assembly code for an instruction *)
 
 let emit_instr i =
@@ -633,8 +666,7 @@ let emit_instr i =
           `	fmov	{emit_reg i.res.(0)}, #{emit_printf "%.7f" (Int64.float_of_bits f)}\n`
         else begin
           let lbl = float_literal f in
-          `	adrp	{emit_reg reg_tmp1}, {emit_label lbl}\n`;
-          `	ldr	{emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
+          emit_load_literal i.res.(0) lbl
         end
     | Lop(Iconst_symbol s) ->
         emit_load_symbol_addr i.res.(0) s
@@ -654,7 +686,7 @@ let emit_instr i =
     | Lop(Iextcall { func; alloc = false; label_after = _; }) ->
         `	bl	{emit_symbol func}\n`
     | Lop(Iextcall { func; alloc = true; label_after; }) ->
-        emit_load_symbol_addr reg_x15 func;
+        emit_load_symbol_addr reg_x8 func;
         `	bl	{emit_symbol "caml_c_call"}\n`;
         `{record_frame i.live false i.dbg ~label:label_after}\n`
     | Lop(Istackoffset n) ->
@@ -954,7 +986,7 @@ let fundecl fundecl =
   emit_named_text_section !function_name;
   `	.align	3\n`;
   `	.globl	{emit_symbol fundecl.fun_name}\n`;
-  `	.type	{emit_symbol fundecl.fun_name}, %function\n`;
+  emit_symbol_type emit_symbol fundecl.fun_name "function";
   `{emit_symbol fundecl.fun_name}:\n`;
   emit_debug_info fundecl.fun_dbg;
   cfi_startproc();
@@ -972,8 +1004,8 @@ let fundecl fundecl =
   assert (List.length !call_gc_sites = num_call_gc);
   assert (List.length !bound_error_sites = num_check_bound);
   cfi_endproc();
-  `	.type	{emit_symbol fundecl.fun_name}, %function\n`;
-  `	.size	{emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
+  emit_symbol_type emit_symbol fundecl.fun_name "function";
+  emit_symbol_size fundecl.fun_name;
   emit_literals()
 
 (* Emission of data *)
@@ -1036,10 +1068,10 @@ let end_assembly () =
   `{emit_symbol lbl}:\n`;
   emit_frames
     { efa_code_label = (fun lbl ->
-                       `	.type	{emit_label lbl}, %function\n`;
+                       emit_symbol_type emit_label lbl "function";
                        `	.quad	{emit_label lbl}\n`);
       efa_data_label = (fun lbl ->
-                       `	.type	{emit_label lbl}, %object\n`;
+                       emit_symbol_type emit_label lbl "object";
                        `	.quad	{emit_label lbl}\n`);
       efa_16 = (fun n -> `	.short	{emit_int n}\n`);
       efa_32 = (fun n -> `	.long	{emit_int32 n}\n`);
@@ -1049,8 +1081,8 @@ let end_assembly () =
                            `	.long	{emit_label lbl} - . + {emit_int32 ofs}\n`);
       efa_def_label = (fun lbl -> `{emit_label lbl}:\n`);
       efa_string = (fun s -> emit_string_directive "	.asciz	" s) };
-  `	.type	{emit_symbol lbl}, %object\n`;
-  `	.size	{emit_symbol lbl}, .-{emit_symbol lbl}\n`;
+  emit_symbol_type emit_symbol lbl "object";
+  emit_symbol_size lbl;
   begin match Config.system with
   | "linux" ->
       (* Mark stack as non-executable *)