5
Jane Street Holding, LLC
7
email: mmottl\@janestcapital.com
8
WWW: http://www.janestcapital.com/ocaml
10
This library is free software; you can redistribute it and/or
11
modify it under the terms of the GNU Lesser General Public
12
License as published by the Free Software Foundation; either
13
version 2 of the License, or (at your option) any later version.
15
This library is distributed in the hope that it will be useful,
16
but WITHOUT ANY WARRANTY; without even the implied warranty of
17
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18
Lesser General Public License for more details.
20
You should have received a copy of the GNU Lesser General Public
21
License along with this library; if not, write to the Free Software
22
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25
(* Utils: utility functions for user convenience *)
33
let bin_dump ?(with_size = false) (sizer, writer) v =
34
let buf, pos, pos_len =
37
let len_len = bin_size_int len in
38
let tot_len = len + len_len in
39
let buf = create_buf tot_len in
40
let pos = bin_write_nat0 buf ~pos:0 (Nat0.unsafe_of_int len) in
43
let buf = create_buf len in
46
let pos = writer buf ~pos v in
47
if pos = pos_len then buf
48
else failwith "Bin_prot.Utils.bin_dump: size changed during writing"
50
module Read_buf = struct
53
| Read_len of int (* how many bytes of the length have been read *)
54
| Read_data of int * int (* [(pos, remaining)] *)
58
mutable state : state;
59
mutable data_buf : buf;
67
data_buf = create_buf max_int_size;
70
let alloc_buf rbuf buf_size =
71
let dst = create_buf buf_size in
75
let enforce_buf_size rbuf buf_size =
76
let buf_size = max buf_size max_int_size in
77
let src = rbuf.data_buf in
78
Array1.dim src <= buf_size ||
80
| Empty -> ignore (alloc_buf rbuf buf_size); true
82
let dst = alloc_buf rbuf buf_size in
83
for i = 0 to len - 1 do dst.{i} <- src.{i} done;
85
| Read_data (pos, remaining) ->
86
pos + remaining <= buf_size &&
87
let dst = alloc_buf rbuf buf_size in
88
unsafe_blit_buf ~src_pos:0 ~src ~dst_pos:0 ~dst ~len:pos;
91
let purge rbuf = rbuf.state <- Empty
93
let get_size rbuf = Array1.dim rbuf.data_buf
95
let get_buffered_data_size rbuf =
98
| Read_len size | Read_data (size, _) -> size
100
let maybe_read_size buf ~pos_ref =
102
let psize = Read_ml.bin_read_nat0 buf ~pos_ref in
103
Some (Nat0.to_int psize)
104
with Buffer_short -> None
106
let check_max_size ?max_size len =
110
if max_size < len then failwith "Bin_prot.Utils.next: max_size exceeded"
112
let have_len ?max_size reader src ~pos_ref rbuf msg_len =
113
check_max_size ?max_size msg_len;
114
let src_pos = !pos_ref in
115
let dim = Array1.dim src in
116
let len = dim - src_pos in
117
if msg_len > len then
119
let data_buf = rbuf.data_buf in
120
if Array1.dim data_buf < msg_len then
121
let new_data_buf = create_buf msg_len in
122
rbuf.data_buf <- new_data_buf;
126
unsafe_blit_buf ~src_pos ~src ~dst_pos:0 ~dst ~len;
127
rbuf.state <- Read_data (len, msg_len - len);
132
Some (reader src ~pos_ref))
134
let next_empty ?max_size reader src ~pos_ref rbuf =
135
let pos = !pos_ref in (* not after maybe_read_size (side effect!) *)
136
match maybe_read_size src ~pos_ref with
137
| Some len -> have_len ?max_size reader src ~pos_ref rbuf len
139
let dim = Array1.dim src in
141
let data_buf = rbuf.data_buf in
142
for i = pos to dim - 1 do data_buf.{i - pos} <- src.{i} done;
143
rbuf.state <- Read_len (dim - pos);
146
let next_read_len ?max_size reader src ~pos_ref rbuf data_buf_pos =
147
let pos = !pos_ref in
148
let dim = Array1.dim src in
149
let max_chars = min (max_int_size - data_buf_pos) (dim - pos) in
150
let data_buf = Array1.sub rbuf.data_buf 0 (data_buf_pos + max_chars) in
151
for i = 0 to max_chars - 1 do
152
data_buf.{data_buf_pos + i} <- src.{pos + i};
155
match maybe_read_size data_buf ~pos_ref with
157
pos_ref := pos + !pos_ref - data_buf_pos;
158
have_len ?max_size reader src ~pos_ref rbuf len
161
rbuf.state <- Read_len (data_buf_pos + max_chars);
164
let next_read_data reader src ~pos_ref rbuf dst_pos len =
165
let pos = !pos_ref in
166
let dim = Array1.dim src in
167
let avail = dim - pos in
168
if len > avail then (
169
unsafe_blit_buf ~src_pos:pos ~src ~dst_pos ~dst:rbuf.data_buf ~len:avail;
170
rbuf.state <- Read_data (dst_pos + avail, len - avail);
174
let msg_len = dst_pos + len in
176
let data_buf = rbuf.data_buf in
177
if Array1.dim data_buf > msg_len then Array1.sub data_buf 0 msg_len
181
unsafe_blit_buf ~src_pos:pos ~src ~dst_pos ~dst ~len;
182
let dst_pos_ref = ref 0 in
183
let res = reader dst ~pos_ref:dst_pos_ref in
184
if !dst_pos_ref <> msg_len then
186
"Bin_prot.Utils.next_read_data: protocol lied about length of value";
187
pos_ref := pos + len;
190
let next ?max_size reader src ~pos_ref rbuf =
191
match rbuf.state with
192
| Empty -> next_empty ?max_size reader src ~pos_ref rbuf
193
| Read_len pos -> next_read_len ?max_size reader src ~pos_ref rbuf pos
194
| Read_data (pos, len) ->
195
check_max_size ?max_size (pos + len);
196
next_read_data reader src ~pos_ref rbuf pos len
200
(* Conversion of binable types *)
202
module type Make_binable_spec = sig
206
val to_binable : t -> binable
207
val of_binable : binable -> t
209
val bin_size_binable : binable Size.sizer
210
val bin_write_binable : binable Map_to_safe.writer
211
val bin_write_binable_ : binable Unsafe_write_c.writer
212
val bin_read_binable : binable Read_ml.reader
213
val bin_read_binable_ : binable Unsafe_read_c.reader
214
val bin_read_binable__ : (int -> binable) Unsafe_read_c.reader
215
val bin_sw_arg_binable : binable Map_to_safe.sw_arg
218
module Make_binable (Bin_spec : Make_binable_spec) = struct
223
let bin_size_t t = bin_size_binable (to_binable t)
224
let bin_write_t buf ~pos t = bin_write_binable buf ~pos (to_binable t)
225
let bin_write_t_ sptr eptr t = bin_write_binable_ sptr eptr (to_binable t)
226
let bin_read_t buf ~pos_ref = of_binable (bin_read_binable buf ~pos_ref)
227
let bin_read_t_ sptr_ptr eptr = of_binable (bin_read_binable_ sptr_ptr eptr)
229
let bin_read_t__ sptr_ptr eptr n =
230
of_binable (bin_read_binable__ sptr_ptr eptr n)
232
let bin_sw_arg_t = bin_size_t, bin_write_t
added
removed
lib/utils.ml
