0005762: Add primitives for fast access to bigarray dimensions

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 0b5d09d..8b182f1 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -979,6 +979,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]) -> diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index 2e2875d..dfc1990 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -86,6 +86,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 diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli index c228d36..122fe11 100644 --- a/bytecomp/lambda.mli +++ b/bytecomp/lambda.mli @@ -86,6 +86,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 diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml index cb99003..9414eea 100644 --- a/bytecomp/printlambda.ml +++ b/bytecomp/printlambda.ml @@ -184,6 +184,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 -> diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 586863a..cd18417 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -275,7 +275,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 = diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml index 1d3dbcf..dea9610 100644 --- a/otherlibs/bigarray/bigarray.ml +++ b/otherlibs/bigarray/bigarray.ml @@ -109,7 +109,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" @@ -132,8 +132,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 @@ -172,9 +172,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 diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index fb252cb..af48d64 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -448,7 +448,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. *) @@ -528,10 +528,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" @@ -631,13 +631,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" diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index c66ccbc..173a9c8 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -482,6 +482,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) diff --git a/testsuite/tests/lib-bigarray/bigarray_dim.ml b/testsuite/tests/lib-bigarray/bigarray_dim.ml new file mode 100644 index 0000000..d4d1c10 --- /dev/null +++ b/testsuite/tests/lib-bigarray/bigarray_dim.ml @@ -0,0 +1,25 @@ +open Bigarray + +let a1 = Array1.create char c_layout 40 +let b1 = Array1.create char fortran_layout 40 + +let a2 = Array2.create char c_layout 40 50 +let b2 = Array2.create char fortran_layout 40 50 + +let a3 = Array3.create char c_layout 40 50 60 +let b3 = Array3.create char fortran_layout 40 50 60 + +let () = + Printf.printf "%i\n%i\n\n%i %i\n%i %i\n\n%i %i %i\n%i %i %i\n%!" + (Array1.dim a1) + (Array1.dim b1) + (Array2.dim1 a2) + (Array2.dim2 a2) + (Array2.dim1 b2) + (Array2.dim2 b2) + (Array3.dim1 a3) + (Array3.dim2 a3) + (Array3.dim3 a3) + (Array3.dim1 b3) + (Array3.dim2 b3) + (Array3.dim3 b3) diff --git a/testsuite/tests/lib-bigarray/bigarray_dim.reference b/testsuite/tests/lib-bigarray/bigarray_dim.reference new file mode 100644 index 0000000..64e4c8d --- /dev/null +++ b/testsuite/tests/lib-bigarray/bigarray_dim.reference @@ -0,0 +1,8 @@ +40 +40 + +40 50 +40 50 + +40 50 60 +40 50 60

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 0b5d09d..8b182f1 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -979,6 +979,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]) -> diff --git a/boot/ocamlc b/boot/ocamlc index a586202..d597271 100755 Binary files a/boot/ocamlc and b/boot/ocamlc differ diff --git a/boot/ocamldep b/boot/ocamldep index 9f54a43..5d9d019 100755 Binary files a/boot/ocamldep and b/boot/ocamldep differ diff --git a/boot/ocamllex b/boot/ocamllex index 79ca85f..72e56ad 100755 Binary files a/boot/ocamllex and b/boot/ocamllex differ diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 105be62..6afd473 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -376,6 +376,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 diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index 2e2875d..dfc1990 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -86,6 +86,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 diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli index c228d36..122fe11 100644 --- a/bytecomp/lambda.mli +++ b/bytecomp/lambda.mli @@ -86,6 +86,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 diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml index cb99003..9414eea 100644 --- a/bytecomp/printlambda.ml +++ b/bytecomp/printlambda.ml @@ -184,6 +184,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 -> diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 586863a..cd18417 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -275,7 +275,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 = diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml index 1d3dbcf..dea9610 100644 --- a/otherlibs/bigarray/bigarray.ml +++ b/otherlibs/bigarray/bigarray.ml @@ -109,7 +109,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" @@ -132,8 +132,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 @@ -172,9 +172,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 diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index fb252cb..af48d64 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -448,7 +448,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. *) @@ -528,10 +528,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" @@ -631,13 +631,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" diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index c66ccbc..173a9c8 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -482,6 +482,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) diff --git a/testsuite/tests/lib-bigarray/bigarray_dim.ml b/testsuite/tests/lib-bigarray/bigarray_dim.ml new file mode 100644 index 0000000..d4d1c10 --- /dev/null +++ b/testsuite/tests/lib-bigarray/bigarray_dim.ml @@ -0,0 +1,25 @@ +open Bigarray + +let a1 = Array1.create char c_layout 40 +let b1 = Array1.create char fortran_layout 40 + +let a2 = Array2.create char c_layout 40 50 +let b2 = Array2.create char fortran_layout 40 50 + +let a3 = Array3.create char c_layout 40 50 60 +let b3 = Array3.create char fortran_layout 40 50 60 + +let () = + Printf.printf "%i\n%i\n\n%i %i\n%i %i\n\n%i %i %i\n%i %i %i\n%!" + (Array1.dim a1) + (Array1.dim b1) + (Array2.dim1 a2) + (Array2.dim2 a2) + (Array2.dim1 b2) + (Array2.dim2 b2) + (Array3.dim1 a3) + (Array3.dim2 a3) + (Array3.dim3 a3) + (Array3.dim1 b3) + (Array3.dim2 b3) + (Array3.dim3 b3) diff --git a/testsuite/tests/lib-bigarray/bigarray_dim.reference b/testsuite/tests/lib-bigarray/bigarray_dim.reference new file mode 100644 index 0000000..64e4c8d --- /dev/null +++ b/testsuite/tests/lib-bigarray/bigarray_dim.reference @@ -0,0 +1,8 @@ +40 +40 + +40 50 +40 50 + +40 50 60 +40 50 60

Issue History
Date Modified	Username	Field	Change
2012-09-20 15:59	chambart	New Issue
2012-09-20 15:59	chambart	File Added: patch
2012-09-24 12:41	chambart	File Added: patch2
2012-09-24 12:42	chambart	Note Added: 0008150
2012-09-29 22:40	doligez	Status	new => acknowledged
2012-11-06 18:03	lefessan	Assigned To	=> lefessan
2012-11-06 18:03	lefessan	Status	acknowledged => assigned
2012-11-06 18:04	lefessan	Note Added: 0008433
2012-11-06 18:04	lefessan	Status	assigned => resolved
2012-11-06 18:04	lefessan	Fixed in Version	=> 4.01.0+dev
2012-11-06 18:04	lefessan	Resolution	open => fixed

Notes
(0008150) chambart (reporter) 2012-09-24 12:42	I forgot to record bytecomp/bytegen.ml in the first patch

(0008433) lefessan (developer) 2012-11-06 18:04	Committed in trunk as r13069.

Relationships