Premier jet portage Rhapsody

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

4 files changed, 623 insertions, 37 deletions

diff --git a/asmcomp/power/arch.ml b/asmcomp/power/arch.ml
index a1bfc1b08..be7172749 100644
--- a/asmcomp/power/arch.ml
+++ b/asmcomp/power/arch.ml
@@ -80,12 +80,13 @@ let powerpc =
   | _ -> Misc.fatal_error "wrong $(MODEL)"
 
 (* Distinguish between the PowerOpen (AIX, MacOS) TOC-based,
-   relative-addressing model and the SVR4 (Solaris, MkLinux)
+   relative-addressing model and the SVR4 (Solaris, MkLinux, Rhapsody)
    absolute-addressing model. *)
 
 let toc =
   match Config.system with
     "aix" -> true
   | "elf" -> false
+  | "rhapsody" -> false
   | _ -> Misc.fatal_error "wrong $(SYSTEM)"
 
diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
index 7a23839b5..64b0454d2 100644
--- a/asmcomp/power/emit.mlp
+++ b/asmcomp/power/emit.mlp
@@ -61,8 +61,11 @@ let slot_offset loc cls =
 
 (* Output a symbol *)
 
-let emit_symbol s =
-  Emitaux.emit_symbol '.' s
+let emit_symbol =
+  match Config.system with
+    "aix" | "elf" -> (fun s -> Emitaux.emit_symbol '.' s)
+  | "rhapsody"    -> (fun s -> emit_char '_'; Emitaux.emit_symbol '$' s)
+  | _ -> assert false
 
 let emit_codesymbol s =
   if toc then emit_char '.';
@@ -70,7 +73,12 @@ let emit_codesymbol s =
 
 (* Output a label *)
 
-let label_prefix = if toc then "L.." else ".L"
+let label_prefix =
+  match Config.system with
+    "aix" -> "L.."
+  | "elf" -> ".L"
+  | "rhapsody" -> "L"
+  | _ -> assert false
 
 let emit_label lbl =
   emit_string label_prefix; emit_int lbl
@@ -78,14 +86,25 @@ let emit_label lbl =
 (* Section switching *)
 
 let data_space =
-  if toc
-  then "	.csect  .data[RW]\n"
-  else "	.section \".data\"\n"
+  match Config.system with
+    "aix" -> "	.csect  .data[RW]\n"
+  | "elf" -> "	.section \".data\"\n"
+  | "rhapsody" -> "	.data\n"
+  | _ -> assert false
 
 let code_space =
-  if toc
-  then "	.csect  .text[PR]\n"
-  else "	.section \".text\"\n"
+  match Config.system with
+    "aix" -> "	.csect  .text[PR]\n"
+  | "elf" -> "	.section \".text\"\n"
+  | "rhapsody" -> "	.text\n"
+  | _ -> assert false
+
+let rodata_space =
+  match Config.system with
+    "aix" -> "	.csect  .data[RW]\n" (* ?? *)
+  | "elf" -> "	.section \".rodata\"\n"
+  | "rhapsody" -> "	.const\n"
+  | _ -> assert false
 
 (* Output a pseudo-register *)
 
@@ -116,9 +135,28 @@ let is_immediate n =
 let is_native_immediate n =
   Nativeint.cmp n 32767 <= 0 && Nativeint.cmp n (-32768) >= 0
 
+(* Output a "upper 16 bits" or "lower 16 bits" operator
+   (for the absolute addressing mode) *)
+
+let emit_upper emit_fun arg =
+  match Config.system with
+    "elf" ->
+      emit_fun arg; emit_string "@ha"
+  | "rhapsody" ->
+      emit_string "ha16("; emit_fun arg; emit_string ")"
+  | _ -> assert false
+
+let emit_lower emit_fun arg =
+  match Config.system with
+    "elf" ->
+      emit_fun arg; emit_string "@l"
+  | "rhapsody" ->
+      emit_string "lo16("; emit_fun arg; emit_string ")"
+  | _ -> assert false
+
 (* Output a load or store operation *)
 
-let emit_symbol_offset s d =
+let emit_symbol_offset (s, d) =
   emit_symbol s;
   if d > 0 then `+`;
   if d <> 0 then emit_int d
@@ -127,8 +165,8 @@ let emit_load_store instr addressing_mode addr n arg =
   match addressing_mode with
     Ibased(s, d) ->
       (* Only relevant in the absolute model *)
-      `	addis	11, 0, {emit_symbol_offset s d}@ha\n`;
-      `	{emit_string instr}	{emit_reg arg}, {emit_symbol_offset s d}@l(11)\n`
+      `	addis	11, 0, {emit_upper emit_symbol_offset (s,d)}\n`;
+      `	{emit_string instr}	{emit_reg arg}, {emit_lower emit_symbol_offset (s,d)}(11)\n`
   | Iindexed ofs ->
       if is_immediate ofs then
         `	{emit_string instr}	{emit_reg arg}, {emit_int ofs}({emit_reg addr.(n)})\n`
@@ -338,16 +376,16 @@ let rec emit_instr i dslot =
         end else begin
           let lbl = new_label() in
           float_literals := (s, lbl) :: !float_literals;
-          `	addis	11, 0, {emit_label lbl}@ha\n`;
-          `	lfd	{emit_reg i.res.(0)}, {emit_label lbl}@l(11)\n`
+          `	addis	11, 0, {emit_upper emit_label lbl}\n`;
+          `	lfd	{emit_reg i.res.(0)}, {emit_lower emit_label lbl}(11)\n`
         end
     | Lop(Iconst_symbol s) ->
         if toc then begin
           let lbl = label_symbol s in
           `	lwz	{emit_reg i.res.(0)}, {emit_label lbl}(2) # {emit_symbol s}\n`
         end else begin
-          `	addis	{emit_reg i.res.(0)}, 0, {emit_symbol s}@ha\n`;
-          `	addi	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, {emit_symbol s}@l\n`
+          `	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) ->
         if toc then begin
@@ -428,8 +466,8 @@ let rec emit_instr i dslot =
             let lbl = label_symbol s in
             `	lwz	11, {emit_label lbl}(2) # {emit_symbol s}\n`
           end else begin
-            `	addis	11, 0, {emit_symbol s}@ha\n`;
-            `	addi	11, 11, {emit_symbol s}@l\n`
+            `	addis	11, 0, {emit_upper emit_symbol s}\n`;
+            `	addi	11, 11, {emit_lower emit_symbol s}\n`
           end;
           record_frame i.live;
           `	bl	{emit_codesymbol "caml_c_call"}\n`
@@ -533,8 +571,8 @@ let rec emit_instr i dslot =
           let lbl = new_label() in
           float_literals := ("4.503601774854144e15", lbl) :: !float_literals;
           (* That float above also represents 0x4330000080000000 *)
-          `	addis	11, 0, {emit_label lbl}@ha\n`;
-          `	lfd	0, {emit_label lbl}@l(11)\n`
+          `	addis	11, 0, {emit_upper emit_label lbl}\n`;
+          `	lfd	0, {emit_lower emit_label lbl}(11)\n`
         end;
         `	lis	0, 0x4330\n`;
         `	stwu	0, -8(1)\n`;
@@ -629,8 +667,8 @@ let rec emit_instr i dslot =
         if toc then begin
           `	lwz	11, {emit_label !lbl_jumptbl}(2)\n`
         end else begin
-          `	addis	11, 0, {emit_label !lbl_jumptbl}@ha\n`;
-          `	addi	11, 11, {emit_label !lbl_jumptbl}@l\n`
+          `	addis	11, 0, {emit_upper emit_label !lbl_jumptbl}\n`;
+          `	addi	11, 11, {emit_lower emit_label !lbl_jumptbl}\n`
         end;
         `	addi	0, {emit_reg i.arg.(0)}, {emit_int !num_jumptbl_entries}\n`;
         `	slwi	0, 0, 2\n`;
@@ -722,13 +760,15 @@ let fundecl fundecl =
   call_gc_label := 0;
   float_literals := [];
   `	.globl	{emit_symbol fundecl.fun_name}\n`;
-  if toc then begin
-    `	.globl	.{emit_symbol fundecl.fun_name}\n`;
-    `	.csect	{emit_symbol fundecl.fun_name}[DS]\n`;
-    `{emit_symbol fundecl.fun_name}:\n`;
-    `	.long	.{emit_symbol fundecl.fun_name}, TOC[tc0], 0\n`
-  end else begin
-    `	.type	{emit_symbol fundecl.fun_name}, @function\n`
+  begin match Config.system with
+    "aix" ->
+      `	.globl	.{emit_symbol fundecl.fun_name}\n`;
+      `	.csect	{emit_symbol fundecl.fun_name}[DS]\n`;
+      `{emit_symbol fundecl.fun_name}:\n`;
+      `	.long	.{emit_symbol fundecl.fun_name}, TOC[tc0], 0\n`
+  | "elf" ->
+      `	.type	{emit_symbol fundecl.fun_name}, @function\n`
+  | _ -> ()
   end;
   emit_string code_space;
   `	.align	2\n`;
@@ -756,7 +796,7 @@ let fundecl fundecl =
   end;
   (* Emit the floating-point literals *)
   if !float_literals <> [] then begin
-    `	.section \".rodata\"\n`;
+    emit_string rodata_space;
     `	.align	3\n`;
     List.iter
       (fun (f, lbl) ->
@@ -768,7 +808,8 @@ let fundecl fundecl =
 
 let declare_global_data s =
   `	.globl	{emit_symbol s}\n`;
-  if not toc then `	.type	{emit_symbol s}, @object\n`
+  if Config.system = "elf" then
+    `	.type	{emit_symbol s}, @object\n`
 
 let emit_item = function
     Cdefine_symbol s ->
@@ -826,12 +867,9 @@ let end_assembly() =
         let lbl_tbl = new_label() in
         `	.toc\n`;
         `{emit_label !lbl_jumptbl}:	.tc	{emit_label lbl_tbl}[TC], {emit_label lbl_tbl}\n`;
-        `	.csect	.text[PR]\n`;
         lbl_tbl
-      end else begin
-        `	.section \".text\"\n`;
-        !lbl_jumptbl
-      end in
+      end else !lbl_jumptbl in
+    emit_string code_space;
     `{emit_label lbl_tbl}:\n`;
     List.iter
       (fun lbl -> `	.long	{emit_label lbl} - {emit_label lbl_tbl}\n`)
@@ -855,6 +893,7 @@ let end_assembly() =
   `{emit_symbol lbl_end}:\n`;
   `	.long	0\n`;
   (* Emit the frame descriptors *)
+  emit_string rodata_space;
   let lbl = Compilenv.current_unit_name() ^ "_frametable" in
   declare_global_data lbl;
   `{emit_symbol lbl}:\n`;
diff --git a/asmrun/power-rhapsody.S b/asmrun/power-rhapsody.S
new file mode 100644
index 000000000..7f1a5b833
--- /dev/null
+++ b/asmrun/power-rhapsody.S
@@ -0,0 +1,418 @@
+/*********************************************************************/
+/*                                                                   */
+/*                          Objective Caml                           */
+/*                                                                   */
+/*           Xavier Leroy, projet Cristal, INRIA Rocquencourt        */
+/*                                                                   */
+/* Copyright 1996 Institut National de Recherche en Informatique et  */
+/* Automatique.  Distributed only by permission.                     */
+/*                                                                   */
+/*********************************************************************/
+
+/* $Id$ */
+
+#define Addrglobal(reg,glob) \
+        addis   reg, 0, ha16(glob); \
+        addi    reg, reg, lo16(glob)
+#define Loadglobal(reg,glob,tmp) \
+        addis   tmp, 0, ha16(glob); \
+        lwz     reg, lo16(glob)(tmp)
+#define Storeglobal(reg,glob,tmp) \
+        addis   tmp, 0, ha16(glob); \
+        stw     reg, lo16(glob)(tmp)
+
+        .text
+
+/* Invoke the garbage collector. */
+
+        .globl  _caml_call_gc
+_caml_call_gc:
+    /* Set up stack frame */
+        stwu    1, -0x1A0(1)
+    /* 0x1A0 = 4*32 (int regs) + 8*32 (float regs) + 32 (space for C call) */
+    /* Record return address into Caml code */
+        mflr    0
+        Storeglobal(0, _caml_last_return_address, 11)
+    /* Record lowest stack address */
+        addi    0, 1, 0x1A0
+        Storeglobal(0, _caml_bottom_of_stack, 11)
+    /* Record pointer to register array */
+        addi    0, 1, 8*32 + 32
+        Storeglobal(0, _caml_gc_regs, 11)
+    /* Save current allocation pointer for debugging purposes */
+        Storeglobal(31, _young_ptr, 11)
+    /* Save exception pointer (if e.g. a sighandler raises) */
+        Storeglobal(29, _caml_exception_pointer, 11)
+    /* Save all registers used by the code generator */
+        addi    11, 1, 8*32 + 32 - 4
+        stwu    3, 4(11)
+        stwu    4, 4(11)
+        stwu    5, 4(11)
+        stwu    6, 4(11)
+        stwu    7, 4(11)
+        stwu    8, 4(11)
+        stwu    9, 4(11)
+        stwu    10, 4(11)
+        stwu    14, 4(11)
+        stwu    15, 4(11)
+        stwu    16, 4(11)
+        stwu    17, 4(11)
+        stwu    18, 4(11)
+        stwu    19, 4(11)
+        stwu    20, 4(11)
+        stwu    21, 4(11)
+        stwu    22, 4(11)
+        stwu    23, 4(11)
+        stwu    24, 4(11)
+        stwu    25, 4(11)
+        stwu    26, 4(11)
+        stwu    27, 4(11)
+        stwu    28, 4(11)
+        addi    11, 1, 32 - 8
+        stfdu   1, 8(11)
+        stfdu   2, 8(11)
+        stfdu   3, 8(11)
+        stfdu   4, 8(11)
+        stfdu   5, 8(11)
+        stfdu   6, 8(11)
+        stfdu   7, 8(11)
+        stfdu   8, 8(11)
+        stfdu   9, 8(11)
+        stfdu   10, 8(11)
+        stfdu   11, 8(11)
+        stfdu   12, 8(11)
+        stfdu   13, 8(11)
+        stfdu   14, 8(11)
+        stfdu   15, 8(11)
+        stfdu   16, 8(11)
+        stfdu   17, 8(11)
+        stfdu   18, 8(11)
+        stfdu   19, 8(11)
+        stfdu   20, 8(11)
+        stfdu   21, 8(11)
+        stfdu   22, 8(11)
+        stfdu   23, 8(11)
+        stfdu   24, 8(11)
+        stfdu   25, 8(11)
+        stfdu   26, 8(11)
+        stfdu   27, 8(11)
+        stfdu   28, 8(11)
+        stfdu   29, 8(11)
+        stfdu   30, 8(11)
+        stfdu   31, 8(11)
+    /* Call the GC */
+        bl      _garbage_collection
+    /* Reload new allocation pointer and allocation limit */
+        Loadglobal(31, _young_ptr, 11)
+        Loadglobal(30, _young_limit, 11)
+    /* Restore all regs used by the code generator */
+        addi    11, 1, 8*32 + 32 - 4
+        lwzu    3, 4(11)
+        lwzu    4, 4(11)
+        lwzu    5, 4(11)
+        lwzu    6, 4(11)
+        lwzu    7, 4(11)
+        lwzu    8, 4(11)
+        lwzu    9, 4(11)
+        lwzu    10, 4(11)
+        lwzu    14, 4(11)
+        lwzu    15, 4(11)
+        lwzu    16, 4(11)
+        lwzu    17, 4(11)
+        lwzu    18, 4(11)
+        lwzu    19, 4(11)
+        lwzu    20, 4(11)
+        lwzu    21, 4(11)
+        lwzu    22, 4(11)
+        lwzu    23, 4(11)
+        lwzu    24, 4(11)
+        lwzu    25, 4(11)
+        lwzu    26, 4(11)
+        lwzu    27, 4(11)
+        lwzu    28, 4(11)
+        addi    11, 1, 32 - 8
+        lfdu    1, 8(11)
+        lfdu    2, 8(11)
+        lfdu    3, 8(11)
+        lfdu    4, 8(11)
+        lfdu    5, 8(11)
+        lfdu    6, 8(11)
+        lfdu    7, 8(11)
+        lfdu    8, 8(11)
+        lfdu    9, 8(11)
+        lfdu    10, 8(11)
+        lfdu    11, 8(11)
+        lfdu    12, 8(11)
+        lfdu    13, 8(11)
+        lfdu    14, 8(11)
+        lfdu    15, 8(11)
+        lfdu    16, 8(11)
+        lfdu    17, 8(11)
+        lfdu    18, 8(11)
+        lfdu    19, 8(11)
+        lfdu    20, 8(11)
+        lfdu    21, 8(11)
+        lfdu    22, 8(11)
+        lfdu    23, 8(11)
+        lfdu    24, 8(11)
+        lfdu    25, 8(11)
+        lfdu    26, 8(11)
+        lfdu    27, 8(11)
+        lfdu    28, 8(11)
+        lfdu    29, 8(11)
+        lfdu    30, 8(11)
+        lfdu    31, 8(11)
+    /* Return to caller, restarting the allocation */
+        Loadglobal(0, _caml_last_return_address, 11)
+        addic   0, 0, -16     /* Restart the allocation (4 instructions) */
+        mtlr    0
+    /* Say we are back into Caml code */
+        li      12, 0
+        Storeglobal(12, _caml_last_return_address, 11)
+    /* Deallocate stack frame */
+        addi    1, 1, 0x1A0
+    /* Return */
+        blr
+
+/* Call a C function from Caml */
+
+        .globl  _caml_c_call
+_caml_c_call:
+    /* Save return address */
+        mflr    25
+    /* Get ready to call C function (address in 11) */
+        mtlr    11
+    /* Record lowest stack address and return address */
+        Storeglobal(1, _caml_bottom_of_stack, 12)
+        Storeglobal(25, _caml_last_return_address, 12)
+    /* Make the exception handler and alloc ptr available to the C code */
+        Storeglobal(31, _young_ptr, 11)
+        Storeglobal(29, _caml_exception_pointer, 11)
+    /* Call the function (address in link register) */
+        blrl
+    /* Restore return address (in 25, preserved by the C function) */
+        mtlr    25
+    /* Reload allocation pointer and allocation limit*/
+        Loadglobal(31, _young_ptr, 11)
+        Loadglobal(30, _young_limit, 11)
+    /* Say we are back into Caml code */
+        li      12, 0
+        Storeglobal(12, _caml_last_return_address, 11)
+    /* Return to caller */
+        blr
+        
+/* Raise an exception from C */
+
+        .globl  _raise_caml_exception
+_raise_caml_exception:
+    /* Reload Caml global registers */
+        Loadglobal(1, _caml_exception_pointer, 11)
+        Loadglobal(31, _young_ptr, 11)
+        Loadglobal(30, _young_limit, 11)
+    /* Say we are back into Caml code */
+        li      0, 0
+        Storeglobal(0, _caml_last_return_address, 11)
+    /* Pop trap frame */
+        lwz     0, 0(1)
+        lwz     29, 4(1)
+        mtlr    0
+        addi    1, 1, 8
+    /* Branch to handler */
+        blr
+
+/* Start the Caml program */
+
+        .globl  _caml_start_program
+_caml_start_program:
+        Addrglobal(12, _caml_program)
+
+/* Code shared between caml_start_program and callback */
+L102:
+    /* Allocate and link stack frame */
+        stwu    1, -256(1)
+    /* Save return address */
+        mflr    0
+        stw 0,  256+4(1)
+    /* Save all callee-save registers */
+    /* GPR 14 at sp+16 ... GPR 31 at sp+84
+       FPR 14 at sp+92 ... FPR 31 at sp+228 */
+        addi    11, 1, 16-4
+        stwu    14, 4(11)
+        stwu    15, 4(11)
+        stwu    16, 4(11)
+        stwu    17, 4(11)
+        stwu    18, 4(11)
+        stwu    19, 4(11)
+        stwu    20, 4(11)
+        stwu    21, 4(11)
+        stwu    22, 4(11)
+        stwu    23, 4(11)
+        stwu    24, 4(11)
+        stwu    25, 4(11)
+        stwu    26, 4(11)
+        stwu    27, 4(11)
+        stwu    28, 4(11)
+        stwu    29, 4(11)
+        stwu    30, 4(11)
+        stwu    31, 4(11)
+        stfdu   14, 8(11)
+        stfdu   15, 8(11)
+        stfdu   16, 8(11)
+        stfdu   17, 8(11)
+        stfdu   18, 8(11)
+        stfdu   19, 8(11)
+        stfdu   20, 8(11)
+        stfdu   21, 8(11)
+        stfdu   22, 8(11)
+        stfdu   23, 8(11)
+        stfdu   24, 8(11)
+        stfdu   25, 8(11)
+        stfdu   26, 8(11)
+        stfdu   27, 8(11)
+        stfdu   28, 8(11)
+        stfdu   29, 8(11)
+        stfdu   30, 8(11)
+        stfdu   31, 8(11)
+    /* Set up a callback link */
+        addi    1, 1, -16
+        Loadglobal(9, _caml_bottom_of_stack, 11)
+        Loadglobal(10, _caml_last_return_address, 11)
+        Loadglobal(11, _caml_gc_regs, 11)
+        stw     9, 0(1)
+        stw     10, 4(1)
+        stw     11, 8(1)
+    /* Build an exception handler to catch exceptions escaping out of Caml */
+        bl      L103
+        b       L104
+L103:
+        addi    1, 1, -8
+        mflr    0
+        stw     0, 0(1)
+        Loadglobal(11, _caml_exception_pointer, 11)
+        stw     11, 4(1)
+        mr      29, 1
+    /* Reload allocation pointers */
+        Loadglobal(31, _young_ptr, 11) 
+        Loadglobal(30, _young_limit, 11)
+    /* Say we are back into Caml code */
+        li      0, 0
+        Storeglobal(0, _caml_last_return_address, 11)
+    /* Call the Caml code */
+        mtlr    12
+L105:
+        blrl
+    /* Pop the trap frame, restoring caml_exception_pointer */
+        lwz     9, 4(1)
+        Storeglobal(9, _caml_exception_pointer, 11)
+        addi    1, 1, 8
+    /* Pop the callback link, restoring the global variables */
+        lwz     9, 0(1)
+        lwz     10, 4(1)
+        lwz     11, 8(1)
+        Storeglobal(9, _caml_bottom_of_stack, 12) 
+        Storeglobal(10, _caml_last_return_address, 12) 
+        Storeglobal(11, _caml_gc_regs, 12) 
+        addi    1, 1, 16
+    /* Update allocation pointer */
+        Storeglobal(31, _young_ptr, 11)
+    /* Restore callee-save registers */
+        addi    11, 1, 16-4
+        lwzu    14, 4(11)
+        lwzu    15, 4(11)
+        lwzu    16, 4(11)
+        lwzu    17, 4(11)
+        lwzu    18, 4(11)
+        lwzu    19, 4(11)
+        lwzu    20, 4(11)
+        lwzu    21, 4(11)
+        lwzu    22, 4(11)
+        lwzu    23, 4(11)
+        lwzu    24, 4(11)
+        lwzu    25, 4(11)
+        lwzu    26, 4(11)
+        lwzu    27, 4(11)
+        lwzu    28, 4(11)
+        lwzu    29, 4(11)
+        lwzu    30, 4(11)
+        lwzu    31, 4(11)
+        lfdu    14, 8(11)
+        lfdu    15, 8(11)
+        lfdu    16, 8(11)
+        lfdu    17, 8(11)
+        lfdu    18, 8(11)
+        lfdu    19, 8(11)
+        lfdu    20, 8(11)
+        lfdu    21, 8(11)
+        lfdu    22, 8(11)
+        lfdu    23, 8(11)
+        lfdu    24, 8(11)
+        lfdu    25, 8(11)
+        lfdu    26, 8(11)
+        lfdu    27, 8(11)
+        lfdu    28, 8(11)
+        lfdu    29, 8(11)
+        lfdu    30, 8(11)
+        lfdu    31, 8(11)
+    /* Reload return address */
+        lwz     0, 256+4(1)
+        mtlr    0
+    /* Return */
+        addi    1, 1, 256
+        blr
+
+    /* The trap handler: */
+L104:
+    /* Update caml_exception_pointer and young_ptr */
+        Storeglobal(29, _caml_exception_pointer, 11)
+        Storeglobal(31, _young_ptr, 11)
+    /* Pop the callback link, restoring the global variables */
+        lwz     9, 0(1)
+        lwz     10, 4(1)
+        lwz     11, 8(1)
+        Storeglobal(9, _caml_bottom_of_stack, 12) 
+        Storeglobal(10, _caml_last_return_address, 12) 
+        Storeglobal(11, _caml_gc_regs, 12) 
+    /* Re-raise the exception through mlraise, */
+    /* so that local C roots are cleaned up correctly */
+        b       mlraise
+
+/* Callback from C to Caml */
+
+        .globl  _callback
+_callback:
+    /* Initial shuffling of arguments */
+        mr      0, 3            /* Closure */
+        mr      3, 4            /* Argument */
+        mr      4, 0
+        lwz     12, 0(4)        /* Code pointer */
+        b       L102
+
+        .globl  _callback2
+_callback2:
+        mr      0, 3            /* Closure */
+        mr      3, 4            /* First argument */
+        mr      4, 5            /* Second argument */
+        mr      5, 0
+        Addrglobal(12, _caml_apply2)
+        b       L102
+        
+        .globl  _callback3
+_callback3:
+        mr      0, 3            /* Closure */
+        mr      3, 4            /* First argument */
+        mr      4, 5            /* Second argument */
+        mr      5, 6            /* Third argument */
+        mr      6, 0
+        Addrglobal(12, _caml_apply3)
+        b       L102
+
+/* Frame table */
+
+        .rodata
+        .globl  _system_frametable
+_system_frametable:
+        .long   1               /* one descriptor */
+        .long   L105 + 4       /* return address into callback */
+        .short  -1              /* negative size count => use callback link */
+        .short  0               /* no roots here */
+
diff --git a/testasmcomp/power-rhapsody.S b/testasmcomp/power-rhapsody.S
new file mode 100644
index 000000000..909b3055c
--- /dev/null
+++ b/testasmcomp/power-rhapsody.S
@@ -0,0 +1,128 @@
+/*********************************************************************/
+/*                                                                   */
+/*                          Objective Caml                           */
+/*                                                                   */
+/*           Xavier Leroy, projet Cristal, INRIA Rocquencourt        */
+/*                                                                   */
+/* Copyright 1996 Institut National de Recherche en Informatique et  */
+/* Automatique.  Distributed only by permission.                     */
+/*                                                                   */
+/*********************************************************************/
+
+/* $Id$ */
+
+/* Save and restore all callee-save registers */
+/* GPR 14 at sp+16 ... GPR 31 at sp+84
+   FPR 14 at sp+92 ... FPR 31 at sp+228 */
+
+#define Save_callee_save \
+        addic   11, 1, 16-4; \
+        stwu    14, 4(11); \
+        stwu    15, 4(11); \
+        stwu    16, 4(11); \
+        stwu    17, 4(11); \
+        stwu    18, 4(11); \
+        stwu    19, 4(11); \
+        stwu    20, 4(11); \
+        stwu    21, 4(11); \
+        stwu    22, 4(11); \
+        stwu    23, 4(11); \
+        stwu    24, 4(11); \
+        stwu    25, 4(11); \
+        stwu    26, 4(11); \
+        stwu    27, 4(11); \
+        stwu    28, 4(11); \
+        stwu    29, 4(11); \
+        stwu    30, 4(11); \
+        stwu    31, 4(11); \
+        stfdu   14, 8(11); \
+        stfdu   15, 8(11); \
+        stfdu   16, 8(11); \
+        stfdu   17, 8(11); \
+        stfdu   18, 8(11); \
+        stfdu   19, 8(11); \
+        stfdu   20, 8(11); \
+        stfdu   21, 8(11); \
+        stfdu   22, 8(11); \
+        stfdu   23, 8(11); \
+        stfdu   24, 8(11); \
+        stfdu   25, 8(11); \
+        stfdu   26, 8(11); \
+        stfdu   27, 8(11); \
+        stfdu   28, 8(11); \
+        stfdu   29, 8(11); \
+        stfdu   30, 8(11); \
+        stfdu   31, 8(11)
+
+#define Restore_callee_save \
+        addic   11, 1, 16-4; \
+        lwzu    14, 4(11); \
+        lwzu    15, 4(11); \
+        lwzu    16, 4(11); \
+        lwzu    17, 4(11); \
+        lwzu    18, 4(11); \
+        lwzu    19, 4(11); \
+        lwzu    20, 4(11); \
+        lwzu    21, 4(11); \
+        lwzu    22, 4(11); \
+        lwzu    23, 4(11); \
+        lwzu    24, 4(11); \
+        lwzu    25, 4(11); \
+        lwzu    26, 4(11); \
+        lwzu    27, 4(11); \
+        lwzu    28, 4(11); \
+        lwzu    29, 4(11); \
+        lwzu    30, 4(11); \
+        lwzu    31, 4(11); \
+        lfdu    14, 8(11); \
+        lfdu    15, 8(11); \
+        lfdu    16, 8(11); \
+        lfdu    17, 8(11); \
+        lfdu    18, 8(11); \
+        lfdu    19, 8(11); \
+        lfdu    20, 8(11); \
+        lfdu    21, 8(11); \
+        lfdu    22, 8(11); \
+        lfdu    23, 8(11); \
+        lfdu    24, 8(11); \
+        lfdu    25, 8(11); \
+        lfdu    26, 8(11); \
+        lfdu    27, 8(11); \
+        lfdu    28, 8(11); \
+        lfdu    29, 8(11); \
+        lfdu    30, 8(11); \
+        lfdu    31, 8(11)
+
+        .text
+
+        .globl  _call_gen_code
+_call_gen_code:
+    /* Allocate and link stack frame */
+        stwu    1, -256(1)
+    /* Save return address */
+        mflr    0
+        stw     0, 256+4(1)
+    /* Save all callee-save registers */
+        Save_callee_save
+    /* Shuffle arguments */
+        mtlr    3
+        mr 3, 4
+        mr 4, 5
+        mr 5, 6
+        mr 6, 7
+    /* Call the function */
+        blrl
+    /* Restore callee-save registers */
+        Restore_callee_save
+    /* Reload return address */
+        lwz     0, 256+4(1)
+        mtlr    0
+    /* Return */
+        addi    1, 1, 256
+        blr
+
+        .globl  _caml_c_call
+_caml_c_call:
+    /* Jump to C function (address in 11) */
+        mtctr   11
+        bctr