From 713ddaae591a9d9ae26119548704b7d0be316d2f Mon Sep 17 00:00:00 2001
From: Benedikt Meurer <benedikt.meurer@googlemail.com>
Date: Sat, 20 Aug 2011 12:53:50 +0200
Subject: [PATCH 1/3] Optimize Ccheckbound during cmmgen.

Attempt to replace Cmm constructs like

  (checkbound (>>u arg n) m)

where n and m are integer constants with

  (checkbound arg (m << m + (1 << n - 1)))

which is both shorter and results in faster code. On amd64 and i386 this
replaces a sequence of mov,shr,cmp,jbe with a sequence of mov,cmp,jbe.
This could be further optimized to a sequence of cmp,jbe in the backends.

Signed-off-by: Benedikt Meurer <benedikt.meurer@googlemail.com>
---
 asmcomp/cmmgen.ml |   33 ++++++++++++++++++++-------------
 1 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index ca9d2f0..b8589d1 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -369,6 +369,14 @@ let make_float_alloc tag args =
   make_alloc_generic float_array_set tag
                      (List.length args * size_float / size_addr) args

+(* Bounds checking *)
+
+let make_checkbound dbg = function
+  | [Cop(Clsr, [a1; Cconst_int n]); Cconst_int m] when (m lsl n) > n ->
+      Cop(Ccheckbound dbg, [a1; Cconst_int(m lsl n + 1 lsl n - 1)])
+  | args ->
+      Cop(Ccheckbound dbg, args)
+
 (* To compile "let rec" over values *)

 let fundecls_size fundecls =
@@ -534,7 +542,7 @@ let bigarray_elt_size = function

 let bigarray_indexing unsafe elt_kind layout b args dbg =
   let check_bound a1 a2 k =
-    if unsafe then k else Csequence(Cop(Ccheckbound dbg, [a1;a2]), k) in
+    if unsafe then k else Csequence(make_checkbound dbg [a1;a2], k) in
   let rec ba_indexing dim_ofs delta_ofs = function
     [] -> assert false
   | [arg] ->
@@ -1207,7 +1215,7 @@ and transl_prim_2 p arg1 arg2 dbg =
         (bind "str" (transl arg1) (fun str ->
           bind "index" (untag_int (transl arg2)) (fun idx ->
             Csequence(
-              Cop(Ccheckbound dbg, [string_length str; idx]),
+              make_checkbound dbg [string_length str; idx],
               Cop(Cload Byte_unsigned, [add_int str idx])))))

   (* Array operations *)
@@ -1231,21 +1239,20 @@ and transl_prim_2 p arg1 arg2 dbg =
             bind "arr" (transl arg1) (fun arr ->
               bind "header" (header arr) (fun hdr ->
                 Cifthenelse(is_addr_array_hdr hdr,
-                  Csequence(Cop(Ccheckbound dbg, [addr_array_length hdr; idx]),
+                  Csequence(make_checkbound dbg [addr_array_length hdr; idx],
                             addr_array_ref arr idx),
-                  Csequence(Cop(Ccheckbound dbg, [float_array_length hdr; idx]),
+                  Csequence(make_checkbound dbg [float_array_length hdr; idx],
                             float_array_ref arr idx)))))
       | Paddrarray | Pintarray ->
           bind "index" (transl arg2) (fun idx ->
             bind "arr" (transl arg1) (fun arr ->
-              Csequence(Cop(Ccheckbound dbg, [addr_array_length(header arr); idx]),
+              Csequence(make_checkbound dbg [addr_array_length(header arr); idx],
                         addr_array_ref arr idx)))
       | Pfloatarray ->
           box_float(
             bind "index" (transl arg2) (fun idx ->
               bind "arr" (transl arg1) (fun arr ->
-                Csequence(Cop(Ccheckbound dbg,
-                              [float_array_length(header arr); idx]),
+                Csequence(make_checkbound dbg [float_array_length(header arr); idx],
                           unboxed_float_array_ref arr idx))))
       end

@@ -1314,7 +1321,7 @@ and transl_prim_3 p arg1 arg2 arg3 dbg =
         (bind "str" (transl arg1) (fun str ->
           bind "index" (untag_int (transl arg2)) (fun idx ->
             Csequence(
-              Cop(Ccheckbound dbg, [string_length str; idx]),
+              make_checkbound dbg [string_length str; idx],
               Cop(Cstore Byte_unsigned,
                   [add_int str idx; untag_int(transl arg3)])))))

@@ -1343,25 +1350,25 @@ and transl_prim_3 p arg1 arg2 arg3 dbg =
               bind "arr" (transl arg1) (fun arr ->
                 bind "header" (header arr) (fun hdr ->
                   Cifthenelse(is_addr_array_hdr hdr,
-                    Csequence(Cop(Ccheckbound dbg, [addr_array_length hdr; idx]),
+                    Csequence(make_checkbound dbg [addr_array_length hdr; idx],
                               addr_array_set arr idx newval),
-                    Csequence(Cop(Ccheckbound dbg, [float_array_length hdr; idx]),
+                    Csequence(make_checkbound dbg [float_array_length hdr; idx],
                               float_array_set arr idx
                                               (unbox_float newval)))))))
       | Paddrarray ->
           bind "index" (transl arg2) (fun idx ->
             bind "arr" (transl arg1) (fun arr ->
-              Csequence(Cop(Ccheckbound dbg, [addr_array_length(header arr); idx]),
+              Csequence(make_checkbound dbg [addr_array_length(header arr); idx],
                         addr_array_set arr idx (transl arg3))))
       | Pintarray ->
           bind "index" (transl arg2) (fun idx ->
             bind "arr" (transl arg1) (fun arr ->
-              Csequence(Cop(Ccheckbound dbg, [addr_array_length(header arr); idx]),
+              Csequence(make_checkbound dbg [addr_array_length(header arr); idx],
                         int_array_set arr idx (transl arg3))))
       | Pfloatarray ->
           bind "index" (transl arg2) (fun idx ->
             bind "arr" (transl arg1) (fun arr ->
-              Csequence(Cop(Ccheckbound dbg, [float_array_length(header arr);idx]),
+              Csequence(make_checkbound dbg [float_array_length(header arr);idx],
                         float_array_set arr idx (transl_unbox_float arg3))))
       end)
   | _ ->
--
1.7.4.4