Bring stack backtraces up-to-date on PowerPC, incl. reraise.

Tested on PowerPC/Linux.  Needs testing on PowerPC/MacOS X.


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

5 files changed, 107 insertions, 34 deletions

diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp
index e82f5ff790..a9fb3a584d 100644
--- a/asmcomp/power/emit.mlp
+++ b/asmcomp/power/emit.mlp
@@ -45,13 +45,6 @@ let slot_offset loc cls =
   | Incoming n -> frame_size() + n
   | Outgoing n -> n
 
-(* Whether stack backtraces are supported *)
-
-let supports_backtraces =
-  match Config.system with
-  | "rhapsody" -> true
-  | _ -> false
-
 (* Output a symbol *)
 
 let emit_symbol =
@@ -267,7 +260,7 @@ let name_for_int_comparison = function
 
 let name_for_intop = function
     Iadd  -> "add"
-  | Imul - > if ppc64 then "mulld" else "mullw"
+  | Imul  -> if ppc64 then "mulld" else "mullw"
   | Imulh -> if ppc64 then "mulhd" else "mulhw"
   | Idiv  -> if ppc64 then "divd" else "divw"
   | Iand  -> "and"
@@ -596,7 +589,7 @@ let rec emit_instr i dslot =
             emit_set_comp c i.res.(0)
         end
     | Lop(Iintop Icheckbound) ->
-        if !Clflags.debug && supports_backtraces then
+        if !Clflags.debug then
           record_frame Reg.Set.empty i.dbg;
         `	{emit_string tglle}   {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
     | Lop(Iintop op) ->
@@ -614,7 +607,7 @@ let rec emit_instr i dslot =
             emit_set_comp c i.res.(0)
         end
     | Lop(Iintop_imm(Icheckbound, n)) ->
-        if !Clflags.debug && supports_backtraces then
+        if !Clflags.debug then
           record_frame Reg.Set.empty i.dbg;
         `	{emit_string tglle}i   {emit_reg i.arg.(0)}, {emit_int n}\n`
     | Lop(Iintop_imm(op, n)) ->
@@ -757,18 +750,21 @@ let rec emit_instr i dslot =
         `	addi	{emit_gpr 1}, {emit_gpr 1}, 16\n`;
         stack_offset := !stack_offset - 16
     | Lraise k ->
-        begin match !Clflags.debug && supports_backtraces, k with
-        | true, (Lambda.Raise_regular | Lambda.Raise_reraise) ->
+        begin match !Clflags.debug, k with
+        | true, Lambda.Raise_regular ->
           `	bl	{emit_symbol "caml_raise_exn"}\n`;
           record_frame Reg.Set.empty i.dbg
+        | true, Lambda.Raise_reraise ->
+          `	bl	{emit_symbol "caml_reraise_exn"}\n`;
+          record_frame Reg.Set.empty i.dbg
         | false, _
         | true, Lambda.Raise_notrace ->
           `	{emit_string lg}	{emit_gpr 0}, 0({emit_gpr 29})\n`;
           `	mr	{emit_gpr 1}, {emit_gpr 29}\n`;
-          `	mtlr	{emit_gpr 0}\n`;
+          `	mtctr	{emit_gpr 0}\n`;
           `	{emit_string lg}	{emit_gpr 29}, {emit_int size_addr}({emit_gpr 1})\n`;
           `	addi	{emit_gpr 1}, {emit_gpr 1}, 16\n`;
-          `	blr\n`
+          `	bctr\n`
         end
 
 and emit_delay = function
diff --git a/asmrun/power-elf.S b/asmrun/power-elf.S
index 94f4a29d4c..dfbf5b97a3 100644
--- a/asmrun/power-elf.S
+++ b/asmrun/power-elf.S
@@ -200,31 +200,87 @@ caml_c_call:
     /* Reload allocation pointer and allocation limit*/
         Loadglobal(31, caml_young_ptr, 11)
         Loadglobal(30, caml_young_limit, 11)
-    /* Say we are back into OCaml code */
-        li      12, 0
-        Storeglobal(12, caml_last_return_address, 11)
     /* Return to caller */
         blr
 
+/* Raise an exception from OCaml */
+        .globl  caml_raise_exn
+        .type   caml_raise_exn, @function
+caml_raise_exn:
+        Loadglobal(0, caml_backtrace_active, 11)
+        cmpwi   0, 0
+        bne     .L111
+.L110:
+    /* Pop trap frame */
+        lwz     0, 0(29)
+        mr      1, 29
+        mtctr   0
+        lwz     29, 4(29)
+        addi    1, 1, 16
+    /* Branch to handler */
+        bctr
+.L111:
+        li      0, 0
+        Storeglobal(0, caml_backtrace_pos, 11)
+.L112:
+        mr      28, 3           /* preserve exn bucket in callee-save reg */
+                                /* arg1: exception bucket, already in r3 */
+        mflr    4               /* arg2: PC of raise */
+        mr      5, 1            /* arg3: SP of raise */
+        mr      6, 29           /* arg4: SP of handler */
+        addi    1, 1, -16       /* reserve stack space for C call */
+        bl      caml_stash_backtrace
+        mr      3, 28           /* restore exn bucket */
+        b       .L110           /* raise the exn */
+
+        .globl  caml_reraise_exn
+        .type   caml_reraise_exn, @function
+caml_reraise_exn:
+        Loadglobal(0, caml_backtrace_active, 11)
+        cmpwi   0, 0
+        bne-    .L112
+    /* Pop trap frame */
+        lwz     0, 0(29)
+        mr      1, 29
+        mtctr   0
+        lwz     29, 4(29)
+        addi    1, 1, 16
+    /* Branch to handler */
+        bctr
+
 /* Raise an exception from C */
 
         .globl  caml_raise_exception
         .type   caml_raise_exception, @function
 caml_raise_exception:
+	Loadglobal(0, caml_backtrace_active, 11)
+	cmpwi	0, 0
+	bne	.L121
+.L120:
     /* Reload OCaml global registers */
         Loadglobal(1, caml_exception_pointer, 11)
         Loadglobal(31, caml_young_ptr, 11)
         Loadglobal(30, caml_young_limit, 11)
-    /* Say we are back into OCaml code */
-        li      0, 0
-        Storeglobal(0, caml_last_return_address, 11)
     /* Pop trap frame */
         lwz     0, 0(1)
         lwz     29, 4(1)
-        mtlr    0
+        mtctr   0
         addi    1, 1, 16
     /* Branch to handler */
-        blr
+        bctr
+.L121:
+        li      0, 0
+        Storeglobal(0, caml_backtrace_pos, 11)
+        mr      28, 3           /* preserve exn bucket in callee-save reg */
+                                /* arg1: exception bucket, already in r3 */
+        Loadglobal(4, caml_last_return_address, 11) /* arg2: PC of raise */
+	Loadglobal(5, caml_bottom_of_stack, 11)     /* arg3: SP of raise */
+	Loadglobal(6, caml_exception_pointer, 11)   /* arg4: SP of handler */
+        addi    1, 1, -16       /* reserve stack space for C call */
+        bl      caml_stash_backtrace
+        mr      3, 28           /* restore exn bucket */
+        b       .L120           /* raise the exn */
+
 
 /* Start the OCaml program */
 
diff --git a/asmrun/power-rhapsody.S b/asmrun/power-rhapsody.S
index 309c955b19..a228cc1d53 100644
--- a/asmrun/power-rhapsody.S
+++ b/asmrun/power-rhapsody.S
@@ -36,6 +36,14 @@
         addis   $2, 0, ha16($1)
         stg     $0, lo16($1)($2)
 .endmacro
+.macro Loadglobal32       /* reg,glob,tmp */
+        addis   $2, 0, ha16($1)
+        lwz     $0, lo16($1)($2)
+.endmacro
+.macro Storeglobal32      /* reg,glob,tmp */
+        addis   $2, 0, ha16($1)
+        stw     $0, lo16($1)($2)
+.endmacro
 
         .text
 
@@ -234,21 +242,22 @@ _caml_c_call:
 /* Raise an exception from OCaml */
         .globl  _caml_raise_exn
 _caml_raise_exn:
-        addis   r11, 0, ha16(_caml_backtrace_active)
-        lwz     r11, lo16(_caml_backtrace_active)(r11)
+        Loadglobal32 r11, _caml_backtrace_active, r11
         cmpwi   r11, 0
         bne     L110
 L111:
     /* Pop trap frame */
         lg      r0, 0(r29)
         mr      r1, r29
-        mtlr    r0
+        mtctr    r0
         lg      r29, WORD(r1)
         addi    r1, r1, 16
     /* Branch to handler */
-        blr
-
+        bctr
 L110:
+	li	r0, 0
+	Storeglobal32 r0, _caml_backtrace_pos, r11
+L114:		
         mr      r28, r3        /* preserve exn bucket in callee-save */
                                /* arg 1: exception bucket (already in r3) */
         mflr    r4             /* arg 2: PC of raise */
@@ -259,12 +268,25 @@ L110:
         mr      r3, r28
         b       L111
 
-/* Raise an exception from C */
+        .globl  _caml_reraise_exn
+_caml_reraise_exn:
+        Loadglobal32 r11, _caml_backtrace_active, r11
+        cmpwi   r11, 0
+        bne-    L114
+    /* Pop trap frame */
+        lg      r0, 0(r29)
+        mr      r1, r29
+        mtctr    r0
+        lg      r29, WORD(r1)
+        addi    r1, r1, 16
+    /* Branch to handler */
+        bctr
+
+	/* Raise an exception from C */
 
         .globl  _caml_raise_exception
 _caml_raise_exception:
-        addis   r11, 0, ha16(_caml_backtrace_active)
-        lwz     r11, lo16(_caml_backtrace_active)(r11)
+        Loadglobal32 r11, _caml_backtrace_active, r11
         cmpwi   r11, 0
         bne     L112
 L113:
@@ -278,10 +300,10 @@ L113:
     /* Pop trap frame */
         lg      r0, 0(r1)
         lg      r29, WORD(r1)
-        mtlr    r0
+        mtctr   r0
         addi    r1, r1, 16
     /* Branch to handler */
-        blr
+        bctr
 L112:
         mr      r28, r3        /* preserve exn bucket in callee-save */
                                /* arg 1: exception bucket (already in r3) */
diff --git a/asmrun/signals_asm.c b/asmrun/signals_asm.c
index 4f62bd38a9..df76c50102 100644
--- a/asmrun/signals_asm.c
+++ b/asmrun/signals_asm.c
@@ -166,10 +166,8 @@ DECLARE_SIGNAL_HANDLER(trap_handler)
 #endif
   caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
   caml_young_ptr = (char *) CONTEXT_YOUNG_PTR;
-#if defined(SYS_rhapsody)
   caml_bottom_of_stack = (char *) CONTEXT_SP;
   caml_last_return_address = (uintnat) CONTEXT_PC;
-#endif
   caml_array_bound_error();
 }
 #endif
diff --git a/asmrun/signals_osdep.h b/asmrun/signals_osdep.h
index 68ec837997..573e3a5716 100644
--- a/asmrun/signals_osdep.h
+++ b/asmrun/signals_osdep.h
@@ -253,6 +253,7 @@
   #define CONTEXT_EXCEPTION_POINTER (context->regs->gpr[29])
   #define CONTEXT_YOUNG_LIMIT (context->regs->gpr[30])
   #define CONTEXT_YOUNG_PTR (context->regs->gpr[31])
+  #define CONTEXT_SP (context->regs->gpr[1])
 
 /****************** PowerPC, BSD */