Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- diff --git a/otherlibs/bigarray/bigarray.h b/otherlibs/bigarray/bigarray.h
- index 26fdcc9..76b1c6b 100644
- --- a/otherlibs/bigarray/bigarray.h
- +++ b/otherlibs/bigarray/bigarray.h
- @@ -44,13 +44,15 @@ enum caml_ba_kind {
- CAML_BA_NATIVE_INT, /* Platform-native long integers (32 or 64 bits) */
- CAML_BA_COMPLEX32, /* Single-precision complex */
- CAML_BA_COMPLEX64, /* Double-precision complex */
- + CAML_BA_CHAR, /* Characters */
- CAML_BA_KIND_MASK = 0xFF /* Mask for kind in flags field */
- };
- enum caml_ba_layout {
- CAML_BA_C_LAYOUT = 0, /* Row major, indices start at 0 */
- CAML_BA_FORTRAN_LAYOUT = 0x100, /* Column major, indices start at 1 */
- - CAML_BA_LAYOUT_MASK = 0x100 /* Mask for layout in flags field */
- + CAML_BA_LAYOUT_MASK = 0x100, /* Mask for layout in flags field */
- + CAML_BA_LAYOUT_SHIFT = 8 /* Bit offset of layout flag */
- };
- enum caml_ba_managed {
- diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml
- index 4cadfd9..6108356 100644
- --- a/otherlibs/bigarray/bigarray.ml
- +++ b/otherlibs/bigarray/bigarray.ml
- @@ -17,48 +17,63 @@ external init : unit -> unit = "caml_ba_init"
- let _ = init()
- -type ('a, 'b) kind = int
- -
- -type int8_signed_elt
- -type int8_unsigned_elt
- -type int16_signed_elt
- -type int16_unsigned_elt
- -type int_elt
- -type int32_elt
- -type int64_elt
- -type nativeint_elt
- -type float32_elt
- -type float64_elt
- -type complex32_elt
- -type complex64_elt
- +type float32_elt = Float32_elt
- +type float64_elt = Float64_elt
- +type int8_signed_elt = Int8_signed_elt
- +type int8_unsigned_elt = Int8_unsigned_elt
- +type int16_signed_elt = Int16_signed_elt
- +type int16_unsigned_elt = Int16_unsigned_elt
- +type int32_elt = Int32_elt
- +type int64_elt = Int64_elt
- +type int_elt = Int_elt
- +type nativeint_elt = Nativeint_elt
- +type complex32_elt = Complex32_elt
- +type complex64_elt = Complex64_elt
- +
- +type ('a, 'b) kind =
- + Float32 : (float, float32_elt) kind
- + | Float64 : (float, float64_elt) kind
- + | Int8_signed : (int, int8_signed_elt) kind
- + | Int8_unsigned : (int, int8_unsigned_elt) kind
- + | Int16_signed : (int, int16_signed_elt) kind
- + | Int16_unsigned : (int, int16_unsigned_elt) kind
- + | Int32 : (int32, int32_elt) kind
- + | Int64 : (int64, int64_elt) kind
- + | Int : (int, int_elt) kind
- + | Nativeint : (nativeint, nativeint_elt) kind
- + | Complex32 : (Complex.t, complex32_elt) kind
- + | Complex64 : (Complex.t, complex64_elt) kind
- + | Char : (char, int8_unsigned_elt) kind
- (* Keep those constants in sync with the caml_ba_kind enumeration
- in bigarray.h *)
- -let float32 = 0
- -let float64 = 1
- -let int8_signed = 2
- -let int8_unsigned = 3
- -let int16_signed = 4
- -let int16_unsigned = 5
- -let int32 = 6
- -let int64 = 7
- -let int = 8
- -let nativeint = 9
- -let char = int8_unsigned
- -let complex32 = 10
- -let complex64 = 11
- -
- -type 'a layout = int
- -
- -type c_layout
- -type fortran_layout
- +let float32 = Float32
- +let float64 = Float64
- +let int8_signed = Int8_signed
- +let int8_unsigned = Int8_unsigned
- +let int16_signed = Int16_signed
- +let int16_unsigned = Int16_unsigned
- +let int32 = Int32
- +let int64 = Int64
- +let int = Int
- +let nativeint = Nativeint
- +let complex32 = Complex32
- +let complex64 = Complex64
- +let char = Char
- +
- +type c_layout = C_layout_typ
- +type fortran_layout = Fortran_layout_typ
- +
- +type 'a layout =
- + C_layout: c_layout layout
- + | Fortran_layout: fortran_layout layout
- (* Keep those constants in sync with the caml_ba_layout enumeration
- in bigarray.h *)
- -let c_layout = 0
- -let fortran_layout = 0x100
- +let c_layout = C_layout
- +let fortran_layout = Fortran_layout
- module Genarray = struct
- type ('a, 'b, 'c) t
- @@ -113,9 +128,13 @@ module Array1 = struct
- external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub"
- external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
- external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
- - let of_array kind layout data =
- + let of_array (type t) kind (layout: t layout) data =
- let ba = create kind layout (Array.length data) in
- - let ofs = if layout = c_layout then 0 else 1 in
- + let ofs =
- + match layout with
- + C_layout -> 0
- + | Fortran_layout -> 1
- + in
- for i = 0 to Array.length data - 1 do unsafe_set ba (i + ofs) data.(i) done;
- ba
- let map_file fd ?pos kind layout shared dim =
- @@ -143,11 +162,15 @@ module Array2 = struct
- let slice_right a n = Genarray.slice_right a [|n|]
- external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
- external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
- - let of_array kind layout data =
- + let of_array (type t) kind (layout: t layout) data =
- let dim1 = Array.length data in
- let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
- let ba = create kind layout dim1 dim2 in
- - let ofs = if layout = c_layout then 0 else 1 in
- + let ofs =
- + match layout with
- + C_layout -> 0
- + | Fortran_layout -> 1
- + in
- for i = 0 to dim1 - 1 do
- let row = data.(i) in
- if Array.length row <> dim2 then
- @@ -186,12 +209,16 @@ module Array3 = struct
- let slice_right_2 a n = Genarray.slice_right a [|n|]
- external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
- external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
- - let of_array kind layout data =
- + let of_array (type t) kind (layout: t layout) data =
- let dim1 = Array.length data in
- let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
- let dim3 = if dim2 = 0 then 0 else Array.length data.(0).(0) in
- let ba = create kind layout dim1 dim2 dim3 in
- - let ofs = if layout = c_layout then 0 else 1 in
- + let ofs =
- + match layout with
- + C_layout -> 0
- + | Fortran_layout -> 1
- + in
- for i = 0 to dim1 - 1 do
- let row = data.(i) in
- if Array.length row <> dim2 then
- diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli
- index eb9f3c5..a5ed795 100644
- --- a/otherlibs/bigarray/bigarray.mli
- +++ b/otherlibs/bigarray/bigarray.mli
- @@ -56,20 +56,33 @@
- of the abstract types defined below.
- *)
- -type float32_elt
- -type float64_elt
- -type complex32_elt
- -type complex64_elt
- -type int8_signed_elt
- -type int8_unsigned_elt
- -type int16_signed_elt
- -type int16_unsigned_elt
- -type int_elt
- -type int32_elt
- -type int64_elt
- -type nativeint_elt
- -
- -type ('a, 'b) kind
- +type float32_elt = Float32_elt
- +type float64_elt = Float64_elt
- +type int8_signed_elt = Int8_signed_elt
- +type int8_unsigned_elt = Int8_unsigned_elt
- +type int16_signed_elt = Int16_signed_elt
- +type int16_unsigned_elt = Int16_unsigned_elt
- +type int32_elt = Int32_elt
- +type int64_elt = Int64_elt
- +type int_elt = Int_elt
- +type nativeint_elt = Nativeint_elt
- +type complex32_elt = Complex32_elt
- +type complex64_elt = Complex64_elt
- +
- +type ('a, 'b) kind =
- + Float32 : (float, float32_elt) kind
- + | Float64 : (float, float64_elt) kind
- + | Int8_signed : (int, int8_signed_elt) kind
- + | Int8_unsigned : (int, int8_unsigned_elt) kind
- + | Int16_signed : (int, int16_signed_elt) kind
- + | Int16_unsigned : (int, int16_unsigned_elt) kind
- + | Int32 : (int32, int32_elt) kind
- + | Int64 : (int64, int64_elt) kind
- + | Int : (int, int_elt) kind
- + | Nativeint : (nativeint, nativeint_elt) kind
- + | Complex32 : (Complex.t, complex32_elt) kind
- + | Complex64 : (Complex.t, complex64_elt) kind
- + | Char : (char, int8_unsigned_elt) kind
- (** To each element kind is associated an OCaml type, which is
- the type of OCaml values that can be stored in the big array
- or read back from it. This type is not necessarily the same
- @@ -140,10 +153,10 @@ val char : (char, int8_unsigned_elt) kind
- (** {6 Array layouts} *)
- -type c_layout
- +type c_layout = C_layout_typ
- (** See {!Bigarray.fortran_layout}.*)
- -type fortran_layout
- +type fortran_layout = Fortran_layout_typ
- (** To facilitate interoperability with existing C and Fortran code,
- this library supports two different memory layouts for big arrays,
- one compatible with the C conventions,
- @@ -166,7 +179,9 @@ type fortran_layout
- Each layout style is identified at the type level by the
- abstract types {!Bigarray.c_layout} and [fortran_layout] respectively. *)
- -type 'a layout
- +type 'a layout =
- + C_layout: c_layout layout
- + | Fortran_layout: fortran_layout layout
- (** The type ['a layout] represents one of the two supported
- memory layouts: C-style if ['a] is {!Bigarray.c_layout}, Fortran-style
- if ['a] is {!Bigarray.fortran_layout}. *)
- diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c
- index f30fa4c..4ec5976 100644
- --- a/otherlibs/bigarray/bigarray_stubs.c
- +++ b/otherlibs/bigarray/bigarray_stubs.c
- @@ -50,7 +50,8 @@ int caml_ba_element_size[] =
- 2 /*SINT16*/, 2 /*UINT16*/,
- 4 /*INT32*/, 8 /*INT64*/,
- sizeof(value) /*CAML_INT*/, sizeof(value) /*NATIVE_INT*/,
- - 8 /*COMPLEX32*/, 16 /*COMPLEX64*/
- + 8 /*COMPLEX32*/, 16 /*COMPLEX64*/,
- + 1 /*CHAR*/
- };
- /* Compute the number of bytes for the elements of a big array */
- @@ -141,7 +142,7 @@ caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim)
- intnat dimcopy[CAML_BA_MAX_NUM_DIMS];
- Assert(num_dims >= 1 && num_dims <= CAML_BA_MAX_NUM_DIMS);
- - Assert((flags & CAML_BA_KIND_MASK) <= CAML_BA_COMPLEX64);
- + Assert((flags & CAML_BA_KIND_MASK) <= CAML_BA_CHAR);
- for (i = 0; i < num_dims; i++) dimcopy[i] = dim[i];
- size = 0;
- if (data == NULL) {
- @@ -203,7 +204,7 @@ CAMLprim value caml_ba_create(value vkind, value vlayout, value vdim)
- if (dim[i] < 0)
- caml_invalid_argument("Bigarray.create: negative dimension");
- }
- - flags = Int_val(vkind) | Int_val(vlayout);
- + flags = Int_val(vkind) | (Int_val(vlayout) << CAML_BA_LAYOUT_SHIFT);
- return caml_ba_alloc(flags, num_dims, NULL, dim);
- }
- @@ -291,6 +292,8 @@ value caml_ba_get_N(value vb, value * vind, int nind)
- case CAML_BA_COMPLEX64:
- { double * p = ((double *) b->data) + offset * 2;
- return copy_two_doubles(p[0], p[1]); }
- + case CAML_BA_CHAR:
- + return Val_int(((char *) b->data)[offset]);
- }
- }
- @@ -439,6 +442,7 @@ static value caml_ba_set_aux(value vb, value * vind, intnat nind, value newval)
- ((float *) b->data)[offset] = Double_val(newval); break;
- case CAML_BA_FLOAT64:
- ((double *) b->data)[offset] = Double_val(newval); break;
- + case CAML_BA_CHAR:
- case CAML_BA_SINT8:
- case CAML_BA_UINT8:
- ((int8 *) b->data)[offset] = Int_val(newval); break;
- @@ -656,7 +660,8 @@ CAMLprim value caml_ba_kind(value vb)
- CAMLprim value caml_ba_layout(value vb)
- {
- - return Val_int(Caml_ba_array_val(vb)->flags & CAML_BA_LAYOUT_MASK);
- + int layout = Caml_ba_array_val(vb)->flags & CAML_BA_LAYOUT_MASK;
- + return Val_int(layout >> CAML_BA_LAYOUT_SHIFT);
- }
- /* Finalization of a big array */
- @@ -749,6 +754,8 @@ static int caml_ba_compare(value v1, value v2)
- num_elts *= 2; /*fallthrough*/
- case CAML_BA_FLOAT64:
- DO_FLOAT_COMPARISON(double);
- + case CAML_BA_CHAR:
- + DO_INTEGER_COMPARISON(char);
- case CAML_BA_SINT8:
- DO_INTEGER_COMPARISON(int8);
- case CAML_BA_UINT8:
- @@ -799,6 +806,7 @@ static intnat caml_ba_hash(value v)
- h = 0;
- switch (b->flags & CAML_BA_KIND_MASK) {
- + case CAML_BA_CHAR:
- case CAML_BA_SINT8:
- case CAML_BA_UINT8: {
- uint8 * p = b->data;
- @@ -917,6 +925,7 @@ static void caml_ba_serialize(value v,
- for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
- /* Serialize elements */
- switch (b->flags & CAML_BA_KIND_MASK) {
- + case CAML_BA_CHAR:
- case CAML_BA_SINT8:
- case CAML_BA_UINT8:
- caml_serialize_block_1(b->data, num_elts); break;
- @@ -980,7 +989,7 @@ uintnat caml_ba_deserialize(void * dst)
- /* Compute total number of elements */
- num_elts = caml_ba_num_elts(b);
- /* Determine element size in bytes */
- - if ((b->flags & CAML_BA_KIND_MASK) > CAML_BA_COMPLEX64)
- + if ((b->flags & CAML_BA_KIND_MASK) > CAML_BA_CHAR)
- caml_deserialize_error("input_value: bad bigarray kind");
- elt_size = caml_ba_element_size[b->flags & CAML_BA_KIND_MASK];
- /* Allocate room for data */
- @@ -989,6 +998,7 @@ uintnat caml_ba_deserialize(void * dst)
- caml_deserialize_error("input_value: out of memory for bigarray");
- /* Read data */
- switch (b->flags & CAML_BA_KIND_MASK) {
- + case CAML_BA_CHAR:
- case CAML_BA_SINT8:
- case CAML_BA_UINT8:
- caml_deserialize_block_1(b->data, num_elts); break;
- @@ -1173,6 +1183,7 @@ CAMLprim value caml_ba_fill(value vb, value vinit)
- for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
- break;
- }
- + case CAML_BA_CHAR:
- case CAML_BA_SINT8:
- case CAML_BA_UINT8: {
- int init = Int_val(vinit);
- diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c
- index 5ba8cbf..d555c84 100644
- --- a/otherlibs/bigarray/mmap_unix.c
- +++ b/otherlibs/bigarray/mmap_unix.c
- @@ -101,7 +101,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
- void * addr;
- fd = Int_val(vfd);
- - flags = Int_val(vkind) | Int_val(vlayout);
- + flags = Int_val(vkind) | (Int_val(vlayout) << CAML_BA_LAYOUT_SHIFT);
- startpos = File_offset_val(vstart);
- num_dims = Wosize_val(vdim);
- major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
- diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c
- index 4eca668..5b898c0 100644
- --- a/otherlibs/bigarray/mmap_win32.c
- +++ b/otherlibs/bigarray/mmap_win32.c
- @@ -56,7 +56,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
- SYSTEM_INFO sysinfo;
- fd = Handle_val(vfd);
- - flags = Int_val(vkind) | Int_val(vlayout);
- + flags = Int_val(vkind) | (Int_val(vlayout) << CAML_BA_LAYOUT_SHIFT);
- startpos = Int64_val(vstart);
- num_dims = Wosize_val(vdim);
- major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
Add Comment
Please, Sign In to add comment