Revu checkbound pour Sparc/non-Solaris (PR#2980)

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

5 files changed, 90 insertions, 63 deletions

diff --git a/asmcomp/sparc/emit.mlp b/asmcomp/sparc/emit.mlp
index b5722883d..3e472bb95 100644
--- a/asmcomp/sparc/emit.mlp
+++ b/asmcomp/sparc/emit.mlp
@@ -24,6 +24,10 @@ open Mach
 open Linearize
 open Emitaux
 
+(* Solaris vs. the other ports *)
+
+let solaris = Config.system = "solaris"
+
 (* Tradeoff between code size and code speed *)
 
 let fastcode_flag = ref true
@@ -260,6 +264,7 @@ let name_for_float_comparison cmp neg =
 
 let function_name = ref ""
 let tailrec_entry_point = ref 0
+let range_check_trap = ref 0
 
 let rec emit_instr i dslot =
     match i.desc with
@@ -388,15 +393,15 @@ let rec emit_instr i dslot =
         end
     | Lop(Ialloc n) ->
         if !fastcode_flag then begin
-          let indirect = Config.system <> "solaris" in
           let lbl_cont = new_label() in
-          if indirect then 
+          if solaris then begin
+            `	sub	%l6, {emit_int n}, %l6\n`;
+            `	cmp	%l6, %l7\n`
+          end else begin
             `	ld	[%l7], %g1\n`;
-          `	sub	%l6, {emit_int n}, %l6\n`;
-          if indirect then
+            `	sub	%l6, {emit_int n}, %l6\n`;
             `	cmp	%l6, %g1\n`
-          else
-            `	cmp	%l6, %l7\n`;
+          end;
           `	bgeu	{emit_label lbl_cont}\n`;
           `	add	%l6, 4, {emit_reg i.res.(0)}\n`; (* in delay slot *)
           `{record_frame i.live}	call	{emit_symbol "caml_call_gc"}\n`;
@@ -425,7 +430,13 @@ let rec emit_instr i dslot =
         end
     | Lop(Iintop Icheckbound) ->
         `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
-        `	tleu	5\n`            (* 5 = ST_RANGE_CHECK *)
+        if solaris then
+          `	tleu	5\n`            (* 5 = ST_RANGE_CHECK *)
+        else begin
+          if !range_check_trap = 0 then range_check_trap := new_label();
+          `	bleu	{emit_label !range_check_trap}\n`;
+          `	nop\n`                  (* delay slot *)
+        end
     | Lop(Iintop Idiv) ->
         `	sra	{emit_reg i.arg.(0)}, 31, %g1\n`;
         `	wr	%g1, %y\n`;
@@ -477,7 +488,13 @@ let rec emit_instr i dslot =
         end
     | Lop(Iintop_imm(Icheckbound, n)) ->
         `	cmp	{emit_reg i.arg.(0)}, {emit_int n}\n`;
-        `	tleu	5\n`            (* 5 = ST_RANGE_CHECK *)
+        if solaris then
+          `	tleu	5\n`            (* 5 = ST_RANGE_CHECK *)
+        else begin
+          if !range_check_trap = 0 then range_check_trap := new_label();
+          `	bleu	{emit_label !range_check_trap}\n`;
+          `	nop\n`                  (* delay slot *)
+        end
     | Lop(Iintop_imm(op, n)) ->
         let instr = name_for_int_operation op in
         `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`
@@ -663,6 +680,7 @@ let fundecl fundecl =
   function_name := fundecl.fun_name;
   fastcode_flag := fundecl.fun_fast;
   tailrec_entry_point := new_label();
+  range_check_trap := 0;
   stack_offset := 0;
   float_constants := [];
   `	.text\n`;
@@ -679,6 +697,11 @@ let fundecl fundecl =
     `	st	%o7, [%sp + {emit_int(n - 4 + 96)}]\n`;
   `{emit_label !tailrec_entry_point}:\n`;
   emit_all fundecl.fun_body;
+  if !range_check_trap > 0 then begin
+    `{emit_label !range_check_trap}:\n`;
+    `	call	{emit_symbol "caml_ml_array_bound_error"}\n`;
+    `	nop\n`
+  end;
   emit_size fundecl.fun_name;
   List.iter emit_float_constant !float_constants
 
diff --git a/asmrun/signals.c b/asmrun/signals.c
index 34d228c15..4770d01f6 100644
--- a/asmrun/signals.c
+++ b/asmrun/signals.c
@@ -301,7 +301,7 @@ value caml_install_signal_handler(value signal_number, value action) /* ML */
 
 /* Machine- and OS-dependent handling of bound check trap */
 
-#if defined(TARGET_sparc) || defined(TARGET_power)
+#if defined(TARGET_power) || (defined(TARGET_sparc) && defined(SYS_solaris))
 DECLARE_SIGNAL_HANDLER(trap_handler)
 {
 #if defined(SYS_solaris)
@@ -323,13 +323,9 @@ DECLARE_SIGNAL_HANDLER(trap_handler)
     sigprocmask(SIG_UNBLOCK, &mask, NULL);
   }
 #endif
-#if defined(CONTEXT_EXCEPTION_POINTER) && defined(CONTEXT_YOUNG_PTR)
   caml_exception_pointer = (char *) CONTEXT_EXCEPTION_POINTER;
   caml_young_ptr = (char *) CONTEXT_YOUNG_PTR;
   caml_array_bound_error();
-#else
-  caml_fatal_error("Fatal error: out-of-bound access in array or string\n");
-#endif
 }
 #endif
 
@@ -378,7 +374,7 @@ DECLARE_SIGNAL_HANDLER(segv_handler)
 void caml_init_signals(void)
 {
   /* Bound-check trap handling */
-#if defined(TARGET_sparc)
+#if defined(TARGET_sparc) && defined(SYS_solaris)
   { struct sigaction act;
     sigemptyset(&act.sa_mask);
     SET_SIGACT(act, trap_handler);
diff --git a/asmrun/sparc.S b/asmrun/sparc.S
index c4290f45b..4da0550d2 100644
--- a/asmrun/sparc.S
+++ b/asmrun/sparc.S
@@ -20,15 +20,12 @@
 
 #if defined(SYS_sunos)
 
-        .common _caml_required_size, 4, "bss"
-
 #define Caml_young_limit _caml_young_limit
 #define Caml_young_ptr _caml_young_ptr
 #define Caml_bottom_of_stack _caml_bottom_of_stack
 #define Caml_last_return_address _caml_last_return_address
 #define Caml_gc_regs _caml_gc_regs
 #define Caml_exception_pointer _caml_exception_pointer
-#define Caml_required_size _caml_required_size
 #define Caml_allocN _caml_allocN
 #define Caml_call_gc _caml_call_gc
 #define Caml_garbage_collection _caml_garbage_collection
@@ -43,18 +40,17 @@
 #define Caml_apply3 _caml_apply3
 #define Caml_raise _caml_raise
 #define Caml_system__frametable _caml_system__frametable
+#define Caml_ml_array_bound_error _caml_ml_array_bound_error
+#define Caml_array_bound_error _caml_array_bound_error
 
 #else
 
-        .common caml_required_size, 4, 4
-
 #define Caml_young_limit caml_young_limit
 #define Caml_young_ptr caml_young_ptr
 #define Caml_bottom_of_stack caml_bottom_of_stack
 #define Caml_last_return_address caml_last_return_address
 #define Caml_gc_regs caml_gc_regs
 #define Caml_exception_pointer caml_exception_pointer
-#define Caml_required_size caml_required_size
 #define Caml_allocN caml_allocN
 #define Caml_call_gc caml_call_gc
 #define Caml_garbage_collection caml_garbage_collection
@@ -69,6 +65,8 @@
 #define Caml_apply3 caml_apply3
 #define Caml_raise caml_raise
 #define Caml_system__frametable caml_system__frametable
+#define Caml_ml_array_bound_error caml_ml_array_bound_error
+#define Caml_array_bound_error caml_array_bound_error
 
 #endif
 
@@ -108,8 +106,6 @@ Caml_allocN:
 
 /* Required size in %g2 */
 Caml_call_gc:
-    /* Save %g2 (required size) */
-        Store(%g2, Caml_required_size)
     /* Save exception pointer if GC raises */
         Store(Exn_ptr, Caml_exception_pointer)
     /* Save current allocation pointer for debugging purposes */
@@ -121,26 +117,28 @@ Caml_call_gc:
     /* Allocate space on stack for caml_context structure and float regs */
         sub     %sp, 20*4 + 15*8, %sp
     /* Save int regs on stack and save it into caml_gc_regs */
-L100:   add     %sp, 96 + 15*8, %g2
-        st      %o0, [%g2]
-        st      %o1, [%g2 + 0x4]
-        st      %o2, [%g2 + 0x8]
-        st      %o3, [%g2 + 0xc]
-        st      %o4, [%g2 + 0x10]
-        st      %o5, [%g2 + 0x14]
-        st      %i0, [%g2 + 0x18]
-        st      %i1, [%g2 + 0x1c]
-        st      %i2, [%g2 + 0x20]
-        st      %i3, [%g2 + 0x24]
-        st      %i4, [%g2 + 0x28]
-        st      %i5, [%g2 + 0x2c]
-        st      %l0, [%g2 + 0x30]
-        st      %l1, [%g2 + 0x34]
-        st      %l2, [%g2 + 0x38]
-        st      %l3, [%g2 + 0x3c]
-        st      %l4, [%g2 + 0x40]
-        st      %g3, [%g2 + 0x44]
-        st      %g4, [%g2 + 0x48]
+L100:   add     %sp, 96 + 15*8, %g1
+        st      %o0, [%g1]
+        st      %o1, [%g1 + 0x4]
+        st      %o2, [%g1 + 0x8]
+        st      %o3, [%g1 + 0xc]
+        st      %o4, [%g1 + 0x10]
+        st      %o5, [%g1 + 0x14]
+        st      %i0, [%g1 + 0x18]
+        st      %i1, [%g1 + 0x1c]
+        st      %i2, [%g1 + 0x20]
+        st      %i3, [%g1 + 0x24]
+        st      %i4, [%g1 + 0x28]
+        st      %i5, [%g1 + 0x2c]
+        st      %l0, [%g1 + 0x30]
+        st      %l1, [%g1 + 0x34]
+        st      %l2, [%g1 + 0x38]
+        st      %l3, [%g1 + 0x3c]
+        st      %l4, [%g1 + 0x40]
+        st      %g3, [%g1 + 0x44]
+        st      %g4, [%g1 + 0x48]
+        st      %g2, [%g1 + 0x4C]       /* Save required size */
+        mov     %g1, %g2
         Store(%g2, Caml_gc_regs)
     /* Save the floating-point registers */
         add     %sp, 96, %g1
@@ -163,26 +161,27 @@ L100:   add     %sp, 96 + 15*8, %g2
         call    Caml_garbage_collection
         nop
     /* Restore all regs used by the code generator */
-        add     %sp, 96 + 15*8, %g2
-        ld      [%g2], %o0
-        ld      [%g2 + 0x4], %o1
-        ld      [%g2 + 0x8], %o2
-        ld      [%g2 + 0xc], %o3
-        ld      [%g2 + 0x10], %o4
-        ld      [%g2 + 0x14], %o5
-        ld      [%g2 + 0x18], %i0
-        ld      [%g2 + 0x1c], %i1
-        ld      [%g2 + 0x20], %i2
-        ld      [%g2 + 0x24], %i3
-        ld      [%g2 + 0x28], %i4
-        ld      [%g2 + 0x2c], %i5
-        ld      [%g2 + 0x30], %l0
-        ld      [%g2 + 0x34], %l1
-        ld      [%g2 + 0x38], %l2
-        ld      [%g2 + 0x3c], %l3
-        ld      [%g2 + 0x40], %l4
-        ld      [%g2 + 0x44], %g3
-        ld      [%g2 + 0x48], %g4
+        add     %sp, 96 + 15*8, %g1
+        ld      [%g1], %o0
+        ld      [%g1 + 0x4], %o1
+        ld      [%g1 + 0x8], %o2
+        ld      [%g1 + 0xc], %o3
+        ld      [%g1 + 0x10], %o4
+        ld      [%g1 + 0x14], %o5
+        ld      [%g1 + 0x18], %i0
+        ld      [%g1 + 0x1c], %i1
+        ld      [%g1 + 0x20], %i2
+        ld      [%g1 + 0x24], %i3
+        ld      [%g1 + 0x28], %i4
+        ld      [%g1 + 0x2c], %i5
+        ld      [%g1 + 0x30], %l0
+        ld      [%g1 + 0x34], %l1
+        ld      [%g1 + 0x38], %l2
+        ld      [%g1 + 0x3c], %l3
+        ld      [%g1 + 0x40], %l4
+        ld      [%g1 + 0x44], %g3
+        ld      [%g1 + 0x48], %g4
+        ld      [%g1 + 0x4C], %g2     /* Recover desired size */
         add     %sp, 96, %g1
         ldd     [%g1], %f0
         ldd     [%g1 + 0x8], %f2
@@ -202,7 +201,6 @@ L100:   add     %sp, 96 + 15*8, %g2
     /* Reload alloc ptr */
         Load(Caml_young_ptr, Alloc_ptr)
     /* Allocate space for block */
-        Load(Caml_required_size, %g2)
 #ifdef INDIRECT_LIMIT
         ld      [Alloc_limit], %g1
         sub     Alloc_ptr, %g2, Alloc_ptr
@@ -376,6 +374,16 @@ Caml_callback3_exn:
         b       L108
         or      %l2, %lo(Caml_apply3), %l2
 
+#ifndef SYS_solaris
+/* Glue code to call [caml_array_bound_error] */
+
+        .global Caml_ml_array_bound_error
+Caml_ml_array_bound_error:
+        Address(Caml_array_bound_error, %g2)
+        b       Caml_c_call
+        nop
+#endif
+
 #ifdef SYS_solaris
         .section ".rodata"
 #else
diff --git a/boot/ocamlc b/boot/ocamlc
index 5ff5ffc96..9ee47c39c 100755
--- a/boot/ocamlc
+++ b/boot/ocamlc
diff --git a/boot/ocamllex b/boot/ocamllex
index e41b767cc..128730376 100755
--- a/boot/ocamllex
+++ b/boot/ocamllex