PR#5762: Add primitives for fast access to bigarray dimensions

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

Changes

@@ -41,6 +41,7 @@ Internals:
 
 Feature wishes:
 - PR#5597: add instruction trace option 't' to OCAMLRUNPARAM
+- PR#5762: Add primitives for fast access to bigarray dimensions
 
 
 OCaml 4.00.2:

asmcomp/cmmgen.ml

@@ -977,6 +977,9 @@ let rec transl = function
             | Pbigarray_native_int -> transl_unbox_int Pnativeint argnewval
             | _ -> untag_int (transl argnewval))
             dbg)
+      | (Pbigarraydim(n), [b]) ->
+          let dim_ofs = 4 + n in
+          tag_int (Cop(Cload Word, [field_address (transl b) dim_ofs]))
       | (p, [arg]) ->
           transl_prim_1 p arg dbg
       | (p, [arg1; arg2]) ->

bytecomp/bytegen.ml

@@ -374,6 +374,7 @@ let comp_primitive p args =
   | Pbintcomp(bi, Cge) -> Kccall("caml_greaterequal", 2)
   | Pbigarrayref(_, n, _, _) -> Kccall("caml_ba_get_" ^ string_of_int n, n + 1)
   | Pbigarrayset(_, n, _, _) -> Kccall("caml_ba_set_" ^ string_of_int n, n + 2)
+  | Pbigarraydim(n) -> Kccall("caml_ba_dim_" ^ string_of_int n, 1)
   | _ -> fatal_error "Bytegen.comp_primitive"
 
 let is_immed n = immed_min <= n && n <= immed_max

bytecomp/lambda.ml

@@ -84,6 +84,8 @@ type primitive =
   (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
   | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
   | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
+  (* size of the nth dimension of a big array *)
+  | Pbigarraydim of int
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge

bytecomp/lambda.mli

@@ -84,6 +84,8 @@ type primitive =
   (* Operations on big arrays: (unsafe, #dimensions, kind, layout) *)
   | Pbigarrayref of bool * int * bigarray_kind * bigarray_layout
   | Pbigarrayset of bool * int * bigarray_kind * bigarray_layout
+  (* size of the nth dimension of a big array *)
+  | Pbigarraydim of int
 
 and comparison =
     Ceq | Cneq | Clt | Cgt | Cle | Cge

bytecomp/printlambda.ml

@@ -182,6 +182,7 @@ let primitive ppf = function
       print_bigarray "get" unsafe kind ppf layout
   | Pbigarrayset(unsafe, n, kind, layout) ->
       print_bigarray "set" unsafe kind ppf layout
+  | Pbigarraydim(n) -> fprintf ppf "Bigarray.dim_%i" n
 
 let rec lam ppf = function
   | Lvar id ->

bytecomp/translcore.ml

@@ -272,7 +272,10 @@ let primitives_table = create_hashtable 57 [
   "%caml_ba_unsafe_set_2",
     Pbigarrayset(true, 2, Pbigarray_unknown, Pbigarray_unknown_layout);
   "%caml_ba_unsafe_set_3",
-    Pbigarrayset(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout)
+    Pbigarrayset(true, 3, Pbigarray_unknown, Pbigarray_unknown_layout);
+  "%caml_ba_dim_1", Pbigarraydim(1);
+  "%caml_ba_dim_2", Pbigarraydim(2);
+  "%caml_ba_dim_3", Pbigarraydim(3);
 ]
 
 let prim_makearray =

otherlibs/bigarray/bigarray.ml

@@ -107,7 +107,7 @@ module Array1 = struct
   external set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_set_1"
   external unsafe_get: ('a, 'b, 'c) t -> int -> 'a = "%caml_ba_unsafe_ref_1"
   external unsafe_set: ('a, 'b, 'c) t -> int -> 'a -> unit = "%caml_ba_unsafe_set_1"
-  let dim a = Genarray.nth_dim a 0
+  external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
   external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
   external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub"
@@ -130,8 +130,8 @@ module Array2 = struct
   external set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_set_2"
   external unsafe_get: ('a, 'b, 'c) t -> int -> int -> 'a = "%caml_ba_unsafe_ref_2"
   external unsafe_set: ('a, 'b, 'c) t -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_2"
-  let dim1 a = Genarray.nth_dim a 0
-  let dim2 a = Genarray.nth_dim a 1
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
   external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
   external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t
@@ -170,9 +170,9 @@ module Array3 = struct
     = "%caml_ba_set_3"
   external unsafe_get: ('a, 'b, 'c) t -> int -> int -> int -> 'a = "%caml_ba_unsafe_ref_3"
   external unsafe_set: ('a, 'b, 'c) t -> int -> int -> int -> 'a -> unit = "%caml_ba_unsafe_set_3"
-  let dim1 a = Genarray.nth_dim a 0
-  let dim2 a = Genarray.nth_dim a 1
-  let dim3 a = Genarray.nth_dim a 2
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
+  external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3"
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
   external layout: ('a, 'b, 'c) t -> 'c layout = "caml_ba_layout"
   external sub_left: ('a, 'b, c_layout) t -> int -> int -> ('a, 'b, c_layout) t

otherlibs/bigarray/bigarray.mli

@@ -446,7 +446,7 @@ module Array1 : sig
      determine the array element kind and the array layout
      as described for [Genarray.create]. *)
 
-  val dim: ('a, 'b, 'c) t -> int
+  external dim: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
   (** Return the size (dimension) of the given one-dimensional
      big array. *)
 
@@ -526,10 +526,10 @@ module Array2 :
      determine the array element kind and the array layout
      as described for {!Bigarray.Genarray.create}. *)
 
-  val dim1: ('a, 'b, 'c) t -> int
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
   (** Return the first dimension of the given two-dimensional big array. *)
 
-  val dim2: ('a, 'b, 'c) t -> int
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
   (** Return the second dimension of the given two-dimensional big array. *)
 
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"
@@ -629,13 +629,13 @@ module Array3 :
      [kind] and [layout] determine the array element kind and
      the array layout as described for {!Bigarray.Genarray.create}. *)
 
-  val dim1: ('a, 'b, 'c) t -> int
+  external dim1: ('a, 'b, 'c) t -> int = "%caml_ba_dim_1"
   (** Return the first dimension of the given three-dimensional big array. *)
 
-  val dim2: ('a, 'b, 'c) t -> int
+  external dim2: ('a, 'b, 'c) t -> int = "%caml_ba_dim_2"
   (** Return the second dimension of the given three-dimensional big array. *)
 
-  val dim3: ('a, 'b, 'c) t -> int
+  external dim3: ('a, 'b, 'c) t -> int = "%caml_ba_dim_3"
   (** Return the third dimension of the given three-dimensional big array. *)
 
   external kind: ('a, 'b, 'c) t -> ('a, 'b) kind = "caml_ba_kind"

otherlibs/bigarray/bigarray_stubs.c

@@ -475,6 +475,21 @@ CAMLprim value caml_ba_dim(value vb, value vn)
   return Val_long(b->dim[n]);
 }
 
+CAMLprim value caml_ba_dim_1(value vb)
+{
+  return caml_ba_dim(vb, Val_int(0));
+}
+
+CAMLprim value caml_ba_dim_2(value vb)
+{
+  return caml_ba_dim(vb, Val_int(1));
+}
+
+CAMLprim value caml_ba_dim_3(value vb)
+{
+  return caml_ba_dim(vb, Val_int(2));
+}
+
 /* Return the kind of a big array */
 
 CAMLprim value caml_ba_kind(value vb)