Guest User

Untitled

a guest
Feb 16th, 2019
94
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 13.51 KB | None | 0 0
  1. diff --git a/otherlibs/bigarray/bigarray.h b/otherlibs/bigarray/bigarray.h
  2. index 26fdcc9..76b1c6b 100644
  3. --- a/otherlibs/bigarray/bigarray.h
  4. +++ b/otherlibs/bigarray/bigarray.h
  5. @@ -44,13 +44,15 @@ enum caml_ba_kind {
  6. CAML_BA_NATIVE_INT, /* Platform-native long integers (32 or 64 bits) */
  7. CAML_BA_COMPLEX32, /* Single-precision complex */
  8. CAML_BA_COMPLEX64, /* Double-precision complex */
  9. + CAML_BA_CHAR, /* Characters */
  10. CAML_BA_KIND_MASK = 0xFF /* Mask for kind in flags field */
  11. };
  12.  
  13. enum caml_ba_layout {
  14. CAML_BA_C_LAYOUT = 0, /* Row major, indices start at 0 */
  15. CAML_BA_FORTRAN_LAYOUT = 0x100, /* Column major, indices start at 1 */
  16. - CAML_BA_LAYOUT_MASK = 0x100 /* Mask for layout in flags field */
  17. + CAML_BA_LAYOUT_MASK = 0x100, /* Mask for layout in flags field */
  18. + CAML_BA_LAYOUT_SHIFT = 8 /* Bit offset of layout flag */
  19. };
  20.  
  21. enum caml_ba_managed {
  22. diff --git a/otherlibs/bigarray/bigarray.ml b/otherlibs/bigarray/bigarray.ml
  23. index 4cadfd9..6108356 100644
  24. --- a/otherlibs/bigarray/bigarray.ml
  25. +++ b/otherlibs/bigarray/bigarray.ml
  26. @@ -17,48 +17,63 @@ external init : unit -> unit = "caml_ba_init"
  27.  
  28. let _ = init()
  29.  
  30. -type ('a, 'b) kind = int
  31. -
  32. -type int8_signed_elt
  33. -type int8_unsigned_elt
  34. -type int16_signed_elt
  35. -type int16_unsigned_elt
  36. -type int_elt
  37. -type int32_elt
  38. -type int64_elt
  39. -type nativeint_elt
  40. -type float32_elt
  41. -type float64_elt
  42. -type complex32_elt
  43. -type complex64_elt
  44. +type float32_elt = Float32_elt
  45. +type float64_elt = Float64_elt
  46. +type int8_signed_elt = Int8_signed_elt
  47. +type int8_unsigned_elt = Int8_unsigned_elt
  48. +type int16_signed_elt = Int16_signed_elt
  49. +type int16_unsigned_elt = Int16_unsigned_elt
  50. +type int32_elt = Int32_elt
  51. +type int64_elt = Int64_elt
  52. +type int_elt = Int_elt
  53. +type nativeint_elt = Nativeint_elt
  54. +type complex32_elt = Complex32_elt
  55. +type complex64_elt = Complex64_elt
  56. +
  57. +type ('a, 'b) kind =
  58. + Float32 : (float, float32_elt) kind
  59. + | Float64 : (float, float64_elt) kind
  60. + | Int8_signed : (int, int8_signed_elt) kind
  61. + | Int8_unsigned : (int, int8_unsigned_elt) kind
  62. + | Int16_signed : (int, int16_signed_elt) kind
  63. + | Int16_unsigned : (int, int16_unsigned_elt) kind
  64. + | Int32 : (int32, int32_elt) kind
  65. + | Int64 : (int64, int64_elt) kind
  66. + | Int : (int, int_elt) kind
  67. + | Nativeint : (nativeint, nativeint_elt) kind
  68. + | Complex32 : (Complex.t, complex32_elt) kind
  69. + | Complex64 : (Complex.t, complex64_elt) kind
  70. + | Char : (char, int8_unsigned_elt) kind
  71.  
  72. (* Keep those constants in sync with the caml_ba_kind enumeration
  73. in bigarray.h *)
  74.  
  75. -let float32 = 0
  76. -let float64 = 1
  77. -let int8_signed = 2
  78. -let int8_unsigned = 3
  79. -let int16_signed = 4
  80. -let int16_unsigned = 5
  81. -let int32 = 6
  82. -let int64 = 7
  83. -let int = 8
  84. -let nativeint = 9
  85. -let char = int8_unsigned
  86. -let complex32 = 10
  87. -let complex64 = 11
  88. -
  89. -type 'a layout = int
  90. -
  91. -type c_layout
  92. -type fortran_layout
  93. +let float32 = Float32
  94. +let float64 = Float64
  95. +let int8_signed = Int8_signed
  96. +let int8_unsigned = Int8_unsigned
  97. +let int16_signed = Int16_signed
  98. +let int16_unsigned = Int16_unsigned
  99. +let int32 = Int32
  100. +let int64 = Int64
  101. +let int = Int
  102. +let nativeint = Nativeint
  103. +let complex32 = Complex32
  104. +let complex64 = Complex64
  105. +let char = Char
  106. +
  107. +type c_layout = C_layout_typ
  108. +type fortran_layout = Fortran_layout_typ
  109. +
  110. +type 'a layout =
  111. + C_layout: c_layout layout
  112. + | Fortran_layout: fortran_layout layout
  113.  
  114. (* Keep those constants in sync with the caml_ba_layout enumeration
  115. in bigarray.h *)
  116.  
  117. -let c_layout = 0
  118. -let fortran_layout = 0x100
  119. +let c_layout = C_layout
  120. +let fortran_layout = Fortran_layout
  121.  
  122. module Genarray = struct
  123. type ('a, 'b, 'c) t
  124. @@ -113,9 +128,13 @@ module Array1 = struct
  125. external sub: ('a, 'b, 'c) t -> int -> int -> ('a, 'b, 'c) t = "caml_ba_sub"
  126. external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
  127. external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
  128. - let of_array kind layout data =
  129. + let of_array (type t) kind (layout: t layout) data =
  130. let ba = create kind layout (Array.length data) in
  131. - let ofs = if layout = c_layout then 0 else 1 in
  132. + let ofs =
  133. + match layout with
  134. + C_layout -> 0
  135. + | Fortran_layout -> 1
  136. + in
  137. for i = 0 to Array.length data - 1 do unsafe_set ba (i + ofs) data.(i) done;
  138. ba
  139. let map_file fd ?pos kind layout shared dim =
  140. @@ -143,11 +162,15 @@ module Array2 = struct
  141. let slice_right a n = Genarray.slice_right a [|n|]
  142. external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
  143. external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
  144. - let of_array kind layout data =
  145. + let of_array (type t) kind (layout: t layout) data =
  146. let dim1 = Array.length data in
  147. let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
  148. let ba = create kind layout dim1 dim2 in
  149. - let ofs = if layout = c_layout then 0 else 1 in
  150. + let ofs =
  151. + match layout with
  152. + C_layout -> 0
  153. + | Fortran_layout -> 1
  154. + in
  155. for i = 0 to dim1 - 1 do
  156. let row = data.(i) in
  157. if Array.length row <> dim2 then
  158. @@ -186,12 +209,16 @@ module Array3 = struct
  159. let slice_right_2 a n = Genarray.slice_right a [|n|]
  160. external blit: ('a, 'b, 'c) t -> ('a, 'b, 'c) t -> unit = "caml_ba_blit"
  161. external fill: ('a, 'b, 'c) t -> 'a -> unit = "caml_ba_fill"
  162. - let of_array kind layout data =
  163. + let of_array (type t) kind (layout: t layout) data =
  164. let dim1 = Array.length data in
  165. let dim2 = if dim1 = 0 then 0 else Array.length data.(0) in
  166. let dim3 = if dim2 = 0 then 0 else Array.length data.(0).(0) in
  167. let ba = create kind layout dim1 dim2 dim3 in
  168. - let ofs = if layout = c_layout then 0 else 1 in
  169. + let ofs =
  170. + match layout with
  171. + C_layout -> 0
  172. + | Fortran_layout -> 1
  173. + in
  174. for i = 0 to dim1 - 1 do
  175. let row = data.(i) in
  176. if Array.length row <> dim2 then
  177. diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli
  178. index eb9f3c5..a5ed795 100644
  179. --- a/otherlibs/bigarray/bigarray.mli
  180. +++ b/otherlibs/bigarray/bigarray.mli
  181. @@ -56,20 +56,33 @@
  182. of the abstract types defined below.
  183. *)
  184.  
  185. -type float32_elt
  186. -type float64_elt
  187. -type complex32_elt
  188. -type complex64_elt
  189. -type int8_signed_elt
  190. -type int8_unsigned_elt
  191. -type int16_signed_elt
  192. -type int16_unsigned_elt
  193. -type int_elt
  194. -type int32_elt
  195. -type int64_elt
  196. -type nativeint_elt
  197. -
  198. -type ('a, 'b) kind
  199. +type float32_elt = Float32_elt
  200. +type float64_elt = Float64_elt
  201. +type int8_signed_elt = Int8_signed_elt
  202. +type int8_unsigned_elt = Int8_unsigned_elt
  203. +type int16_signed_elt = Int16_signed_elt
  204. +type int16_unsigned_elt = Int16_unsigned_elt
  205. +type int32_elt = Int32_elt
  206. +type int64_elt = Int64_elt
  207. +type int_elt = Int_elt
  208. +type nativeint_elt = Nativeint_elt
  209. +type complex32_elt = Complex32_elt
  210. +type complex64_elt = Complex64_elt
  211. +
  212. +type ('a, 'b) kind =
  213. + Float32 : (float, float32_elt) kind
  214. + | Float64 : (float, float64_elt) kind
  215. + | Int8_signed : (int, int8_signed_elt) kind
  216. + | Int8_unsigned : (int, int8_unsigned_elt) kind
  217. + | Int16_signed : (int, int16_signed_elt) kind
  218. + | Int16_unsigned : (int, int16_unsigned_elt) kind
  219. + | Int32 : (int32, int32_elt) kind
  220. + | Int64 : (int64, int64_elt) kind
  221. + | Int : (int, int_elt) kind
  222. + | Nativeint : (nativeint, nativeint_elt) kind
  223. + | Complex32 : (Complex.t, complex32_elt) kind
  224. + | Complex64 : (Complex.t, complex64_elt) kind
  225. + | Char : (char, int8_unsigned_elt) kind
  226. (** To each element kind is associated an OCaml type, which is
  227. the type of OCaml values that can be stored in the big array
  228. or read back from it. This type is not necessarily the same
  229. @@ -140,10 +153,10 @@ val char : (char, int8_unsigned_elt) kind
  230.  
  231. (** {6 Array layouts} *)
  232.  
  233. -type c_layout
  234. +type c_layout = C_layout_typ
  235. (** See {!Bigarray.fortran_layout}.*)
  236.  
  237. -type fortran_layout
  238. +type fortran_layout = Fortran_layout_typ
  239. (** To facilitate interoperability with existing C and Fortran code,
  240. this library supports two different memory layouts for big arrays,
  241. one compatible with the C conventions,
  242. @@ -166,7 +179,9 @@ type fortran_layout
  243. Each layout style is identified at the type level by the
  244. abstract types {!Bigarray.c_layout} and [fortran_layout] respectively. *)
  245.  
  246. -type 'a layout
  247. +type 'a layout =
  248. + C_layout: c_layout layout
  249. + | Fortran_layout: fortran_layout layout
  250. (** The type ['a layout] represents one of the two supported
  251. memory layouts: C-style if ['a] is {!Bigarray.c_layout}, Fortran-style
  252. if ['a] is {!Bigarray.fortran_layout}. *)
  253. diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c
  254. index f30fa4c..4ec5976 100644
  255. --- a/otherlibs/bigarray/bigarray_stubs.c
  256. +++ b/otherlibs/bigarray/bigarray_stubs.c
  257. @@ -50,7 +50,8 @@ int caml_ba_element_size[] =
  258. 2 /*SINT16*/, 2 /*UINT16*/,
  259. 4 /*INT32*/, 8 /*INT64*/,
  260. sizeof(value) /*CAML_INT*/, sizeof(value) /*NATIVE_INT*/,
  261. - 8 /*COMPLEX32*/, 16 /*COMPLEX64*/
  262. + 8 /*COMPLEX32*/, 16 /*COMPLEX64*/,
  263. + 1 /*CHAR*/
  264. };
  265.  
  266. /* Compute the number of bytes for the elements of a big array */
  267. @@ -141,7 +142,7 @@ caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim)
  268. intnat dimcopy[CAML_BA_MAX_NUM_DIMS];
  269.  
  270. Assert(num_dims >= 1 && num_dims <= CAML_BA_MAX_NUM_DIMS);
  271. - Assert((flags & CAML_BA_KIND_MASK) <= CAML_BA_COMPLEX64);
  272. + Assert((flags & CAML_BA_KIND_MASK) <= CAML_BA_CHAR);
  273. for (i = 0; i < num_dims; i++) dimcopy[i] = dim[i];
  274. size = 0;
  275. if (data == NULL) {
  276. @@ -203,7 +204,7 @@ CAMLprim value caml_ba_create(value vkind, value vlayout, value vdim)
  277. if (dim[i] < 0)
  278. caml_invalid_argument("Bigarray.create: negative dimension");
  279. }
  280. - flags = Int_val(vkind) | Int_val(vlayout);
  281. + flags = Int_val(vkind) | (Int_val(vlayout) << CAML_BA_LAYOUT_SHIFT);
  282. return caml_ba_alloc(flags, num_dims, NULL, dim);
  283. }
  284.  
  285. @@ -291,6 +292,8 @@ value caml_ba_get_N(value vb, value * vind, int nind)
  286. case CAML_BA_COMPLEX64:
  287. { double * p = ((double *) b->data) + offset * 2;
  288. return copy_two_doubles(p[0], p[1]); }
  289. + case CAML_BA_CHAR:
  290. + return Val_int(((char *) b->data)[offset]);
  291. }
  292. }
  293.  
  294. @@ -439,6 +442,7 @@ static value caml_ba_set_aux(value vb, value * vind, intnat nind, value newval)
  295. ((float *) b->data)[offset] = Double_val(newval); break;
  296. case CAML_BA_FLOAT64:
  297. ((double *) b->data)[offset] = Double_val(newval); break;
  298. + case CAML_BA_CHAR:
  299. case CAML_BA_SINT8:
  300. case CAML_BA_UINT8:
  301. ((int8 *) b->data)[offset] = Int_val(newval); break;
  302. @@ -656,7 +660,8 @@ CAMLprim value caml_ba_kind(value vb)
  303.  
  304. CAMLprim value caml_ba_layout(value vb)
  305. {
  306. - return Val_int(Caml_ba_array_val(vb)->flags & CAML_BA_LAYOUT_MASK);
  307. + int layout = Caml_ba_array_val(vb)->flags & CAML_BA_LAYOUT_MASK;
  308. + return Val_int(layout >> CAML_BA_LAYOUT_SHIFT);
  309. }
  310.  
  311. /* Finalization of a big array */
  312. @@ -749,6 +754,8 @@ static int caml_ba_compare(value v1, value v2)
  313. num_elts *= 2; /*fallthrough*/
  314. case CAML_BA_FLOAT64:
  315. DO_FLOAT_COMPARISON(double);
  316. + case CAML_BA_CHAR:
  317. + DO_INTEGER_COMPARISON(char);
  318. case CAML_BA_SINT8:
  319. DO_INTEGER_COMPARISON(int8);
  320. case CAML_BA_UINT8:
  321. @@ -799,6 +806,7 @@ static intnat caml_ba_hash(value v)
  322. h = 0;
  323.  
  324. switch (b->flags & CAML_BA_KIND_MASK) {
  325. + case CAML_BA_CHAR:
  326. case CAML_BA_SINT8:
  327. case CAML_BA_UINT8: {
  328. uint8 * p = b->data;
  329. @@ -917,6 +925,7 @@ static void caml_ba_serialize(value v,
  330. for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i];
  331. /* Serialize elements */
  332. switch (b->flags & CAML_BA_KIND_MASK) {
  333. + case CAML_BA_CHAR:
  334. case CAML_BA_SINT8:
  335. case CAML_BA_UINT8:
  336. caml_serialize_block_1(b->data, num_elts); break;
  337. @@ -980,7 +989,7 @@ uintnat caml_ba_deserialize(void * dst)
  338. /* Compute total number of elements */
  339. num_elts = caml_ba_num_elts(b);
  340. /* Determine element size in bytes */
  341. - if ((b->flags & CAML_BA_KIND_MASK) > CAML_BA_COMPLEX64)
  342. + if ((b->flags & CAML_BA_KIND_MASK) > CAML_BA_CHAR)
  343. caml_deserialize_error("input_value: bad bigarray kind");
  344. elt_size = caml_ba_element_size[b->flags & CAML_BA_KIND_MASK];
  345. /* Allocate room for data */
  346. @@ -989,6 +998,7 @@ uintnat caml_ba_deserialize(void * dst)
  347. caml_deserialize_error("input_value: out of memory for bigarray");
  348. /* Read data */
  349. switch (b->flags & CAML_BA_KIND_MASK) {
  350. + case CAML_BA_CHAR:
  351. case CAML_BA_SINT8:
  352. case CAML_BA_UINT8:
  353. caml_deserialize_block_1(b->data, num_elts); break;
  354. @@ -1173,6 +1183,7 @@ CAMLprim value caml_ba_fill(value vb, value vinit)
  355. for (p = b->data; num_elts > 0; p++, num_elts--) *p = init;
  356. break;
  357. }
  358. + case CAML_BA_CHAR:
  359. case CAML_BA_SINT8:
  360. case CAML_BA_UINT8: {
  361. int init = Int_val(vinit);
  362. diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c
  363. index 5ba8cbf..d555c84 100644
  364. --- a/otherlibs/bigarray/mmap_unix.c
  365. +++ b/otherlibs/bigarray/mmap_unix.c
  366. @@ -101,7 +101,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
  367. void * addr;
  368.  
  369. fd = Int_val(vfd);
  370. - flags = Int_val(vkind) | Int_val(vlayout);
  371. + flags = Int_val(vkind) | (Int_val(vlayout) << CAML_BA_LAYOUT_SHIFT);
  372. startpos = File_offset_val(vstart);
  373. num_dims = Wosize_val(vdim);
  374. major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
  375. diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c
  376. index 4eca668..5b898c0 100644
  377. --- a/otherlibs/bigarray/mmap_win32.c
  378. +++ b/otherlibs/bigarray/mmap_win32.c
  379. @@ -56,7 +56,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
  380. SYSTEM_INFO sysinfo;
  381.  
  382. fd = Handle_val(vfd);
  383. - flags = Int_val(vkind) | Int_val(vlayout);
  384. + flags = Int_val(vkind) | (Int_val(vlayout) << CAML_BA_LAYOUT_SHIFT);
  385. startpos = Int64_val(vstart);
  386. num_dims = Wosize_val(vdim);
  387. major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0;
Add Comment
Please, Sign In to add comment