1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
(* File: read_c.ml
Copyright (C) 2007-
Jane Street Holding, LLC
Author: Markus Mottl
email: mmottl\@janestreet.com
WWW: http://www.janestreet.com/ocaml
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
(* Read_c: wrapping unsafe C-style readers to safe ML-style ones. *)
open Bigarray
open Common
open Unsafe_common
open Unsafe_read_c
let handle_error buf sptr_ptr read_err =
let err_pos = dealloc_sptr_ptr buf sptr_ptr in
let err_pos =
match read_err with
| ReadError.Variant _ -> err_pos - 4
| _ -> err_pos
in
raise_read_error read_err err_pos
let handle_exc buf sptr_ptr exc =
ignore (dealloc_sptr_ptr buf sptr_ptr);
raise exc
let at_end buf sptr_ptr pos_ref el =
let pos = dealloc_sptr_ptr buf sptr_ptr in
pos_ref := pos;
el
let make read_c buf ~pos_ref =
let sptr_ptr, eptr = get_read_init buf ~pos_ref in
let el =
try read_c sptr_ptr eptr with
| Error read_err -> handle_error buf sptr_ptr read_err
| exc -> handle_exc buf sptr_ptr exc
in
at_end buf sptr_ptr pos_ref el
let unmake read_ml buf sptr_ptr _eptr =
let start_pos = get_sptr_ptr sptr_ptr buf in
let pos_ref = ref start_pos in
let el = read_ml buf ~pos_ref in
set_sptr_ptr sptr_ptr buf ~pos:!pos_ref;
el
let make1 read_c read_ml_el buf ~pos_ref =
let sptr_ptr, eptr = get_read_init buf ~pos_ref in
let read_c_el = unmake read_ml_el buf in
let el =
try read_c read_c_el sptr_ptr eptr with
| Error read_err -> handle_error buf sptr_ptr read_err
| exc -> handle_exc buf sptr_ptr exc
in
at_end buf sptr_ptr pos_ref el
let make2 read_c read_ml_el1 read_ml_el2 buf ~pos_ref =
let sptr_ptr, eptr = get_read_init buf ~pos_ref in
let read_c_el1 = unmake read_ml_el1 buf in
let read_c_el2 = unmake read_ml_el2 buf in
let el =
try read_c read_c_el1 read_c_el2 sptr_ptr eptr with
| Error read_err -> handle_error buf sptr_ptr read_err
| exc -> handle_exc buf sptr_ptr exc
in
at_end buf sptr_ptr pos_ref el
let make3 read_c read_ml_el1 read_ml_el2 read_ml_el3 buf ~pos_ref =
let sptr_ptr, eptr = get_read_init buf ~pos_ref in
let read_c_el1 = unmake read_ml_el1 buf in
let read_c_el2 = unmake read_ml_el2 buf in
let read_c_el3 = unmake read_ml_el3 buf in
let el =
try read_c read_c_el1 read_c_el2 read_c_el3 sptr_ptr eptr with
| Error read_err -> handle_error buf sptr_ptr read_err
| exc -> handle_exc buf sptr_ptr exc
in
at_end buf sptr_ptr pos_ref el
let bin_read_unit = make Unsafe_read_c.bin_read_unit
let bin_read_bool = make Unsafe_read_c.bin_read_bool
let bin_read_string = make Unsafe_read_c.bin_read_string
let bin_read_char = make Unsafe_read_c.bin_read_char
let bin_read_int = make Unsafe_read_c.bin_read_int
let bin_read_float = make Unsafe_read_c.bin_read_float
let bin_read_int32 = make Unsafe_read_c.bin_read_int32
let bin_read_int64 = make Unsafe_read_c.bin_read_int64
let bin_read_nativeint = make Unsafe_read_c.bin_read_nativeint
let bin_read_nat0 = make Unsafe_read_c.bin_read_nat0
let bin_read_ref mlw = make1 Unsafe_read_c.bin_read_ref mlw
let bin_read_lazy mlw = make1 Unsafe_read_c.bin_read_lazy mlw
let bin_read_option mlw = make1 Unsafe_read_c.bin_read_option mlw
let bin_read_pair mlw = make2 Unsafe_read_c.bin_read_pair mlw
let bin_read_triple mlw = make3 Unsafe_read_c.bin_read_triple mlw
let bin_read_list mlw = make1 Unsafe_read_c.bin_read_list mlw
let bin_read_array mlw = make1 Unsafe_read_c.bin_read_array mlw
let bin_read_hashtbl mlw = make2 Unsafe_read_c.bin_read_hashtbl mlw
let bin_read_float32_vec = make Unsafe_read_c.bin_read_float32_vec
let bin_read_float64_vec = make Unsafe_read_c.bin_read_float64_vec
let bin_read_vec = make Unsafe_read_c.bin_read_vec
let bin_read_float32_mat = make Unsafe_read_c.bin_read_float32_mat
let bin_read_float64_mat = make Unsafe_read_c.bin_read_float64_mat
let bin_read_mat = make Unsafe_read_c.bin_read_mat
let bin_read_bigstring = make Unsafe_read_c.bin_read_bigstring
let bin_read_float_array = make Unsafe_read_c.bin_read_float_array
let bin_read_variant_int el = make Unsafe_read_c.bin_read_variant_int el
let bin_read_variant_tag el = make Unsafe_read_c.bin_read_variant_tag el
let bin_read_int_64bit = make Unsafe_read_c.bin_read_int_64bit
let bin_read_int64_bits = make Unsafe_read_c.bin_read_int64_bits
let bin_read_network16_int = make Unsafe_read_c.bin_read_network16_int
let bin_read_network32_int = make Unsafe_read_c.bin_read_network32_int
let bin_read_network32_int32 = make Unsafe_read_c.bin_read_network32_int32
let bin_read_network64_int = make Unsafe_read_c.bin_read_network64_int
let bin_read_network64_int64 = make Unsafe_read_c.bin_read_network64_int64
|
