preliminary work on powerpc (does not work)

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

2 files changed, 77 insertions, 20 deletions

diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
index d55d38f827..f36d44129e 100644
--- a/asmcomp/power/emit.mlp
+++ b/asmcomp/power/emit.mlp
@@ -12,8 +12,6 @@
 
 (* $Id$ *)
 
-let allow_dynlink = ref true
-
 (* Emission of PowerPC assembly code *)
 
 module StringSet = Set.Make(struct type t = string let compare = compare end)
@@ -83,17 +81,17 @@ let data_space =
   | "rhapsody"    -> "	.data\n"
   | _ -> assert false
 
-let code_space =
+let code_space () =
   match Config.system with
   | "elf" | "bsd" -> "	.section \".text\"\n"
-  | "rhapsody" when !allow_dynlink -> "  .data\n"
-  | "rhapsody"    -> "	.text\n"
+  | "rhapsody" when !Clflags.dlcode -> "	.section __TEXT,__selfmod,regular,self_modifying_code\n"
+  | "rhapsody"    -> "	.text\n" 
   | _ -> assert false
 
-let rodata_space =
+let rodata_space () =
   match Config.system with
   | "elf" | "bsd" -> "	.section \".rodata\"\n"
-  | "rhapsody" when !allow_dynlink -> "  .data\n"
+  | "rhapsody" when !Clflags.dlcode -> "	.data\n"
   | "rhapsody"    -> "	.const\n"
   | _ -> assert false
 
@@ -255,6 +253,37 @@ let emit_external s =
   `	.indirect_symbol {emit_symbol s}\n`;
   `	{emit_string datag}	0\n`
 
+
+let external_stubs = ref StringSet.empty
+let external_non_lazy = ref StringSet.empty
+
+let emit_stub s =
+  let lbl = new_label() in
+  `	.section __TEXT,__picsymbolstub1,symbol_stubs,pure_instructions,32\n`;
+  `	.align 5\n`;
+  `L{emit_symbol s}$stub:\n`;
+  `	.indirect_symbol {emit_symbol s}\n`;
+  `	mflr r0\n`;
+  `	bcl 20,31,{emit_label lbl}\n`;
+  `{emit_label lbl}:\n`;
+  `	mflr r11\n`;
+  `	addis r11,r11,ha16(L{emit_symbol s}$lazy_ptr-{emit_label lbl})\n`;
+  `	mtlr r0\n`;
+  `	lwzu r12,lo16(L{emit_symbol s}$lazy_ptr-{emit_label lbl})(r11)\n`;
+  `	mtctr r12\n`;
+  `	bctr\n`;
+  `	.lazy_symbol_pointer\n`;
+  `L{emit_symbol s}$lazy_ptr:\n`;
+  `	.indirect_symbol {emit_symbol s}\n`;
+  `	.long	dyld_stub_binding_helper\n`
+
+let emit_non_lazy s =
+  `	.non_lazy_symbol_pointer\n`;
+  `L{emit_symbol s}$non_lazy_ptr:\n`;
+  `	.indirect_symbol {emit_symbol s}\n`;
+  `	{emit_string datag}	0\n`
+
+
 (* Names for conditional branches after comparisons *)
 
 let branch_for_comparison = function
@@ -482,14 +511,28 @@ let rec emit_instr i dslot =
         `	addis	{emit_gpr 11}, 0, {emit_upper emit_label lbl}\n`;
         `	lfd	{emit_reg i.res.(0)}, {emit_lower emit_label lbl}({emit_gpr 11})\n`
     | Lop(Iconst_symbol s) ->
-        `	addis	{emit_reg i.res.(0)}, 0, {emit_upper emit_symbol s}\n`;
-        `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_lower emit_symbol s}\n`
+	if !Clflags.dlcode then begin
+	  let lbl = new_label () in
+	  external_non_lazy := StringSet.add s !external_non_lazy;
+	  `	bcl 20,31,{emit_label lbl}\n`;
+	  `{emit_label lbl}:\n`;
+	  `	mflr {emit_reg i.res.(0)}\n`;
+          `	addis	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, ha16(L{emit_symbol s}$non_lazy_ptr-{emit_label lbl})\n`;
+          `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, lo16(L{emit_symbol s}$non_lazy_ptr-{emit_label lbl})\n`
+	end else begin
+          `	addis	{emit_reg i.res.(0)}, 0, {emit_upper emit_symbol s}\n`;
+          `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_lower emit_symbol s}\n`
+	end
     | Lop(Icall_ind) ->
         `	mtctr	{emit_reg i.arg.(0)}\n`;
         `	bctrl\n`;
         record_frame i.live i.dbg
     | Lop(Icall_imm s) ->
-        `	bl	{emit_symbol s}\n`;
+	if !Clflags.dlcode then begin
+          external_stubs := StringSet.add s !external_stubs;
+          `	bl	L{emit_symbol s}$stub\n`;
+	end else	
+          `	bl	{emit_symbol s}\n`;
         record_frame i.live i.dbg
     | Lop(Itailcall_ind) ->
         let n = frame_size() in
@@ -528,7 +571,12 @@ let rec emit_instr i dslot =
             `	addis	{emit_gpr 11}, 0, {emit_upper emit_symbol s}\n`;
             `	addi	{emit_gpr 11}, {emit_gpr 11}, {emit_lower emit_symbol s}\n`
           end;
-          `	bl	{emit_symbol "caml_c_call"}\n`;
+	  if !Clflags.dlcode then begin
+	    (* WRONG: stub will destroy r11 *)
+	    external_stubs := StringSet.add "caml_c_call" !external_stubs;
+	    `	bl	L{emit_symbol "caml_c_call"}$stub\n`;
+	  end else
+            `	bl	{emit_symbol "caml_c_call"}\n`;
           record_frame i.live i.dbg
         end else begin
           if pic_externals then begin
@@ -752,12 +800,12 @@ let rec emit_instr i dslot =
         `	add	{emit_gpr 0}, {emit_gpr 11}, {emit_gpr 0}\n`;
         `	mtctr	{emit_gpr 0}\n`;
         `	bctr\n`;
-        emit_string rodata_space;
+        emit_string (rodata_space ());
         `{emit_label lbl}:`;
         for i = 0 to Array.length jumptbl - 1 do
           `	.long	{emit_label jumptbl.(i)} - {emit_label lbl}\n`
         done;
-        emit_string code_space
+        emit_string (code_space ())
     | Lsetuptrap lbl ->
         `	bl	{emit_label lbl}\n`
     | Lpushtrap ->
@@ -845,7 +893,7 @@ let fundecl fundecl =
       `	.type	{emit_symbol fundecl.fun_name}, @function\n`
   | _ -> ()
   end;
-  emit_string code_space;
+  emit_string (code_space ());
   `	.align	2\n`;
   `{emit_symbol fundecl.fun_name}:\n`;
   let n = frame_size() in
@@ -863,11 +911,16 @@ let fundecl fundecl =
   (* Emit the glue code to call the GC *)
   if !call_gc_label > 0 then begin
     `{emit_label !call_gc_label}:\n`;
-    `	b	{emit_symbol "caml_call_gc"}\n`
+(*    if !Clflags.dlcode then begin
+      (* WRONG: stub will destroy r11 *)
+      external_stubs := StringSet.add "caml_call_gc" !external_stubs;
+      `	b	L{emit_symbol "caml_call_gc"}$stub\n`;
+    end else *)
+      `	b	{emit_symbol "caml_call_gc"}\n`
   end;
   (* Emit the numeric literals *)
   if !float_literals <> [] || !int_literals <> [] then begin
-    emit_string rodata_space;
+    emit_string (rodata_space ());
     `	.align	3\n`;
     List.iter
       (fun (f, lbl) ->
@@ -925,13 +978,15 @@ let data l =
 let begin_assembly() =
   defined_functions := StringSet.empty;
   external_functions := StringSet.empty;
+  external_stubs := StringSet.empty;
+  external_non_lazy := StringSet.empty;
   (* Emit the beginning of the segments *)
   let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
   emit_string data_space;
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`;
   let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
-  emit_string code_space;
+  emit_string (code_space ());
   declare_global_data lbl_begin;
   `{emit_symbol lbl_begin}:\n`
 
@@ -939,8 +994,10 @@ let end_assembly() =
   if pic_externals then
     (* Emit the pointers to external functions *)
     StringSet.iter emit_external !external_functions;
+  StringSet.iter emit_stub !external_stubs;
+  StringSet.iter emit_non_lazy !external_non_lazy;
   (* Emit the end of the segments *)
-  emit_string code_space;
+  emit_string (code_space ());
   let lbl_end = Compilenv.make_symbol (Some "code_end") in
   declare_global_data lbl_end;
   `{emit_symbol lbl_end}:\n`;
@@ -951,7 +1008,7 @@ let end_assembly() =
   `{emit_symbol lbl_end}:\n`;
   `	{emit_string datag}	0\n`;
   (* Emit the frame descriptors *)
-  emit_string rodata_space;
+  emit_string (rodata_space ());
   let lbl = Compilenv.make_symbol (Some "frametable") in
   declare_global_data lbl;
   `{emit_symbol lbl}:\n`;
diff --git a/asmcomp/power/selection.ml b/asmcomp/power/selection.ml
index f3880b0da6..1b2b3b5332 100644
--- a/asmcomp/power/selection.ml
+++ b/asmcomp/power/selection.ml
@@ -28,7 +28,7 @@ type addressing_expr =
   | Aadd of expression * expression
 
 let rec select_addr = function
-    Cconst_symbol s ->
+    Cconst_symbol s when not !Clflags.dlcode ->
       (Asymbol s, 0)
   | Cop((Caddi | Cadda), [arg; Cconst_int m]) ->
       let (a, n) = select_addr arg in (a, n + m)