diff options
| author | Xavier Leroy <xavier.leroy@inria.fr> | 1995-07-07 16:42:05 +0000 |
|---|---|---|
| committer | Xavier Leroy <xavier.leroy@inria.fr> | 1995-07-07 16:42:05 +0000 |
| commit | bbbf6d016497de98d776934e20fbac905d48d6a1 (patch) | |
| tree | ff7158f4d554bda63f162c1b9d1e0066d8beab0a | |
| parent | 5c09b581c8667ea74a6be6386679dd5afb4ccb45 (diff) | |
Ajout construction "checkbounds" dans C--.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@71 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | asmcomp/cmm.ml | 1 | ||||
| -rw-r--r-- | asmcomp/cmm.mli | 1 | ||||
| -rw-r--r-- | asmcomp/emit_alpha.mlp | 12 | ||||
| -rw-r--r-- | asmcomp/mach.ml | 1 | ||||
| -rw-r--r-- | asmcomp/mach.mli | 1 | ||||
| -rw-r--r-- | asmcomp/printcmm.ml | 1 | ||||
| -rw-r--r-- | asmcomp/printmach.ml | 5 | ||||
| -rw-r--r-- | asmcomp/selection.ml | 2 | ||||
| -rw-r--r-- | testasmcomp/lexcmm.mll | 1 | ||||
| -rw-r--r-- | testasmcomp/parsecmm.mly | 2 |
10 files changed, 24 insertions, 3 deletions
diff --git a/asmcomp/cmm.ml b/asmcomp/cmm.ml index a998e0caa..cfeab7b39 100644 --- a/asmcomp/cmm.ml +++ b/asmcomp/cmm.ml @@ -66,6 +66,7 @@ type operation = | Cfloatofint | Cintoffloat | Ccmpf of comparison | Craise + | Ccheckbound type expression = Cconst_int of int diff --git a/asmcomp/cmm.mli b/asmcomp/cmm.mli index 842d063b9..2315f8a41 100644 --- a/asmcomp/cmm.mli +++ b/asmcomp/cmm.mli @@ -52,6 +52,7 @@ type operation = | Cfloatofint | Cintoffloat | Ccmpf of comparison | Craise + | Ccheckbound type expression = Cconst_int of int diff --git a/asmcomp/emit_alpha.mlp b/asmcomp/emit_alpha.mlp index 409d07a0f..2d7f90641 100644 --- a/asmcomp/emit_alpha.mlp +++ b/asmcomp/emit_alpha.mlp @@ -253,12 +253,12 @@ let name_for_float_comparison = function (* Output the assembly code for an instruction *) -(* Table of direct entry points (without setting GP) *) -let nogp_entry_points = (Hashtbl.new 17 : (string, int) Hashtbl.t) (* 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 emit_instr i = match i.desc with @@ -391,6 +391,10 @@ let emit_instr i = liveregs i live_25; ` jsr caml_modify\n` (* Pointer in $25 *) end + | Lop(Icheckbound) -> + if !range_check_trap = 0 then range_check_trap := new_label(); + ` cmplt {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, $25\n`; + ` beq {emit_label !range_check_trap}\n` | Lop(Iintop(Icomp cmp)) -> let (comp, test) = name_for_int_comparison cmp in ` {emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`; @@ -543,6 +547,7 @@ let fundecl fundecl = call_gc_sites := []; modify_sites := []; uses_gp := instr_uses_gp fundecl.fun_body; + range_check_trap := 0; ` .text\n`; ` .align 4\n`; ` .globl {emit_symbol fundecl.fun_name}\n`; @@ -563,6 +568,8 @@ let fundecl fundecl = emit_all fundecl.fun_body; List.iter emit_call_gc !call_gc_sites; List.iter emit_modify !modify_sites; + if !range_check_trap > 0 then + `{emit_label !range_check_trap}: call_pal PAL_gentrap\n`; ` .end {emit_symbol fundecl.fun_name}\n` (* Emission of data *) @@ -610,6 +617,7 @@ 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/mach.ml b/asmcomp/mach.ml index 9895257d3..d7a0ee7cf 100644 --- a/asmcomp/mach.ml +++ b/asmcomp/mach.ml @@ -37,6 +37,7 @@ type operation = | Iintop_imm of integer_operation * int | Iaddf | Isubf | Imulf | Idivf | Ifloatofint | Iintoffloat + | Icheckbound | Ispecific of Arch.specific_operation type instruction = diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli index c268f627f..83c2c2fa6 100644 --- a/asmcomp/mach.mli +++ b/asmcomp/mach.mli @@ -37,6 +37,7 @@ type operation = | Iintop_imm of integer_operation * int | Iaddf | Isubf | Imulf | Idivf | Ifloatofint | Iintoffloat + | Icheckbound | Ispecific of Arch.specific_operation type instruction = diff --git a/asmcomp/printcmm.ml b/asmcomp/printcmm.ml index 0250dd980..91210e613 100644 --- a/asmcomp/printcmm.ml +++ b/asmcomp/printcmm.ml @@ -67,6 +67,7 @@ let operation = function | Cintoffloat -> print_string "intoffloat" | Ccmpf c -> comparison c; print_string "f" | Craise -> print_string "raise" + | Ccheckbound -> print_string "checkbound" let rec expression = function Cconst_int n -> print_int n diff --git a/asmcomp/printmach.ml b/asmcomp/printmach.ml index ae72c374b..23c3fd7cc 100644 --- a/asmcomp/printmach.ml +++ b/asmcomp/printmach.ml @@ -122,7 +122,10 @@ let operation op arg res = | Idivf -> reg arg.(0); print_string " /f "; reg arg.(1) | Ifloatofint -> print_string "floatofint "; reg arg.(0) | Iintoffloat -> print_string "intoffloat "; reg arg.(0) - | Ispecific op -> Arch.print_specific_operation reg op arg + | Icheckbound -> + print_string "check "; reg arg.(0); print_string " < "; reg arg.(1) + | Ispecific op -> + Arch.print_specific_operation reg op arg let rec instr i = if !print_live then begin diff --git a/asmcomp/selection.ml b/asmcomp/selection.ml index 3d6d70b93..7133b87ba 100644 --- a/asmcomp/selection.ml +++ b/asmcomp/selection.ml @@ -25,6 +25,7 @@ let oper_result_type = function | Cfloatofint -> typ_float | Cintoffloat -> typ_int | Craise -> typ_void + | Ccheckbound -> typ_void | _ -> fatal_error "Selection.oper_result_type" (* Infer the size in bytes of the result of a simple expression *) @@ -96,6 +97,7 @@ let rec sel_operation op args = | (Cdivf, _) -> (Idivf, args) | (Cfloatofint, _) -> (Ifloatofint, args) | (Cintoffloat, _) -> (Iintoffloat, args) + | (Ccheckbound, _) -> (Icheckbound, args) | _ -> fatal_error "Selection.sel_oper" and sel_arith_comm op = function diff --git a/testasmcomp/lexcmm.mll b/testasmcomp/lexcmm.mll index 9414d8366..dba6c7580 100644 --- a/testasmcomp/lexcmm.mll +++ b/testasmcomp/lexcmm.mll @@ -25,6 +25,7 @@ let keyword_table = "byte", BYTE; "case", CASE; "catch", CATCH; + "checkbound", CHECKBOUND; "exit", EXIT; "extcall", EXTCALL; "float", FLOAT; diff --git a/testasmcomp/parsecmm.mly b/testasmcomp/parsecmm.mly index aa7d4ddb1..a20a0c6bb 100644 --- a/testasmcomp/parsecmm.mly +++ b/testasmcomp/parsecmm.mly @@ -44,6 +44,7 @@ let access_array base numelt size = %token BYTE %token CASE %token CATCH +%token CHECKBOUND %token COLON %token DIVF %token DIVI @@ -258,6 +259,7 @@ binaryop: | LEF { Ccmpf Cle } | GTF { Ccmpf Cgt } | GEF { Ccmpf Cge } + | CHECKBOUND { Ccheckbound } ; sequence: expr sequence { Csequence($1, $2) } |