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

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

1 files changed, 31 insertions, 8 deletions

diff --git a/asmcomp/sparc/emit.mlp b/asmcomp/sparc/emit.mlp
index b5722883d3..3e472bb95e 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