Modif du traitement des acces hors bornes.

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

5 files changed, 21 insertions, 8 deletions

diff --git a/asmcomp/emit_alpha.mlp b/asmcomp/emit_alpha.mlp
index 74904eb09..b6b56e2dc 100644
--- a/asmcomp/emit_alpha.mlp
+++ b/asmcomp/emit_alpha.mlp
@@ -588,7 +588,7 @@ let fundecl fundecl =
   emit_all fundecl.fun_body;
   List.iter emit_call_gc !call_gc_sites;
   if !range_check_trap > 0 then
-    `{emit_label !range_check_trap}:	call_pal PAL_gentrap\n`;
+    `{emit_label !range_check_trap}:	br	call_array_bound_error\n`;
   `	.end	{emit_symbol fundecl.fun_name}\n`
 
 (* Emission of data *)
@@ -638,7 +638,6 @@ let data l =
 (* Beginning / end of an assembly file *)
 
 let begin_assembly() =
-  `#include <alpha/pal.h>\n`;
   (* There are really two groups of registers:
       $sp and $15 always point to stack locations
       $0 - $14, $16-$23 never point to stack locations. *)
diff --git a/asmcomp/emit_hppa.mlp b/asmcomp/emit_hppa.mlp
index e4d677d4d..7bf5e1ff8 100644
--- a/asmcomp/emit_hppa.mlp
+++ b/asmcomp/emit_hppa.mlp
@@ -316,8 +316,12 @@ let swap_int_comparison = function
 
 (* Output the assembly code for an instruction *)
 
+(* Name of current function *)
 let function_name = ref ""
+(* Entry point for tail recursive calls *)
 let tailrec_entry_point = ref 0
+(* Label of trap for out-of-range accesses *)
+let range_check_trap = ref 0
 
 let rec emit_instr i dslot =
     match i.desc with
@@ -502,7 +506,9 @@ let rec emit_instr i dslot =
         `	comclr,{emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`;
         `	ldi	1, {emit_reg i.res.(0)}\n`
     | Lop(Iintop Icheckbound) ->
-        `	subt,<<= {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, %r0\n`
+        if !range_check_trap = 0 then range_check_trap := new_label();
+        `	comb,<<=,n {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label !range_check_trap}\n`
+        (* Forward branch -> nullify if taken *)
     | Lop(Iintop op) ->
         let instr = name_for_int_operation op in
         `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
@@ -537,8 +543,9 @@ let rec emit_instr i dslot =
         `	comiclr,{emit_string comp} {emit_int n}, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`;
         `	ldi	1, {emit_reg i.res.(0)}\n`
     | Lop(Iintop_imm(Icheckbound, n)) ->
-        (* We do a signed test here, as the argument is assumed positive. *)
-        `	addit,<= {emit_int(-n)}, {emit_reg i.arg.(0)}, %r0\n`
+        if !range_check_trap = 0 then range_check_trap := new_label();
+        `	comib,<<,n {emit_int n}, {emit_reg i.arg.(0)}, {emit_label !range_check_trap}\n`
+        (* Forward branch -> nullify if taken *)
     | Lop(Iintop_imm(op, n)) ->
         fatal_error "Emit_hppa: Iintop_imm"
     | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
@@ -705,6 +712,7 @@ let fundecl fundecl =
   stack_offset := 0;
   float_constants := [];
   defined_functions := StringSet.add fundecl.fun_name !defined_functions;
+  range_check_trap := 0;
   `	.text\n`;
   `	.align	2\n`;
   `	.globl	{emit_symbol fundecl.fun_name}\n`;
@@ -716,6 +724,12 @@ let fundecl fundecl =
     `	ldo	{emit_int n}(%r30), %r30\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:`;
+    `	ldil	L\`{emit_symbol "array_bound_error"}, %r1\n`;
+    `	ble	R\`{emit_symbol "array_bound_error"}(4, %r1)\n`;
+    `	nop\n`
+  end;
   List.iter emit_float_constant !float_constants
 
 (* Emission of data *)
diff --git a/asmcomp/emit_i386.mlp b/asmcomp/emit_i386.mlp
index 49adae5d9..3dfb0fe6a 100644
--- a/asmcomp/emit_i386.mlp
+++ b/asmcomp/emit_i386.mlp
@@ -648,7 +648,7 @@ let fundecl fundecl =
   `{emit_label !tailrec_entry_point}:`;
   emit_all fundecl.fun_body;
   if !range_check_trap > 0 then
-    `{emit_label !range_check_trap}:	int	$5\n`;
+    `{emit_label !range_check_trap}:	jmp	array_bound_error\n`;
   List.iter emit_float_constant !float_constants
 
 (* Emission of data *)
diff --git a/asmcomp/emit_mips.mlp b/asmcomp/emit_mips.mlp
index 80b1fd0a6..966b737fb 100644
--- a/asmcomp/emit_mips.mlp
+++ b/asmcomp/emit_mips.mlp
@@ -466,7 +466,7 @@ let fundecl fundecl =
   if !call_gc_label > 0 then
     `{emit_label !call_gc_label}:	j	caml_call_gc\n`;
   if !range_check_trap > 0 then
-    `{emit_label !range_check_trap}:	break	BRK_RANGE\n`;
+    `{emit_label !range_check_trap}:	j	array_bound_error\n`;
   `	.end	{emit_symbol fundecl.fun_name}\n`
 
 (* Emission of data *)
diff --git a/asmcomp/proc_alpha.ml b/asmcomp/proc_alpha.ml
index 83c022a57..1e76a30db 100644
--- a/asmcomp/proc_alpha.ml
+++ b/asmcomp/proc_alpha.ml
@@ -261,7 +261,7 @@ let contains_calls = ref false
 (* Calling the assembler *)
 
 let assemble_file infile outfile =
-  Sys.command ("as -O2 -o " ^ outfile ^ " " ^ infile)
+  Sys.command ("as -O2 -nocpp -o " ^ outfile ^ " " ^ infile)
 
 (* Calling the archiver *)