diff options
| -rw-r--r-- | Changes | 1 | ||||
| -rw-r--r-- | asmcomp/cmmgen.ml | 3 | ||||
| -rw-r--r-- | bytecomp/bytegen.ml | 1 | ||||
| -rw-r--r-- | bytecomp/lambda.ml | 2 | ||||
| -rw-r--r-- | bytecomp/lambda.mli | 2 | ||||
| -rw-r--r-- | bytecomp/printlambda.ml | 1 | ||||
| -rw-r--r-- | bytecomp/translcore.ml | 5 | ||||
| -rw-r--r-- | otherlibs/bigarray/bigarray.ml | 12 | ||||
| -rw-r--r-- | otherlibs/bigarray/bigarray.mli | 12 | ||||
| -rw-r--r-- | otherlibs/bigarray/bigarray_stubs.c | 15 |
10 files changed, 41 insertions, 13 deletions
@@ -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: diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 45ddfd2b5..31272f69e 100644 --- a/asmcomp/cmmgen.ml +++ b/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]) -> diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 502b15f83..ec528f98f 100644 --- a/bytecomp/bytegen.ml +++ b/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 diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index a8479052c..e2f9e06e1 100644 --- a/bytecomp/lambda.ml +++ b/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 diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli index 540fe2f1c..af2a9e6f1 100644 --- a/bytecomp/lambda.mli +++ b/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 diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml index 4ecf2df38..e6d84309d 100644 --- a/bytecomp/printlambda.ml +++ b/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 -> diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 978813e45..9c2f3646e 100644 --- a/bytecomp/translcore.ml +++ b/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 = diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml index 26bdaac52..4cadfd917 100644 --- a/otherlibs/bigarray/bigarray.ml +++ b/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 diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index 515079fca..a14a5e4fc 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/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" diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index 567a72deb..4af0bfde6 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/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) |