1
(* File: unsafe_common.ml
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
(* Unsafe_common: functions common to unsafe binary protocol conversion. *)
34
external get_sptr : buf -> pos : pos -> sptr = "get_buf_ptr_stub" "noalloc"
35
external get_eptr : buf -> pos : pos -> eptr = "get_buf_ptr_stub" "noalloc"
37
external get_buf_pos :
38
start : sptr -> cur : sptr -> pos = "get_buf_pos_stub" "noalloc"
40
external get_safe_buf_pos :
41
buf -> start : sptr -> cur : sptr -> pos = "get_safe_buf_pos_stub" "noalloc"
43
external alloc_sptr_ptr :
44
buf -> pos : pos -> sptr_ptr = "alloc_sptr_ptr_stub" "noalloc"
46
external dealloc_sptr_ptr :
47
buf -> sptr_ptr -> pos = "dealloc_sptr_ptr_stub" "noalloc"
49
external get_sptr_ptr : sptr_ptr -> buf -> pos = "get_sptr_ptr_stub" "noalloc"
51
external set_sptr_ptr :
52
sptr_ptr -> buf -> pos : pos -> unit = "set_sptr_ptr_stub" "noalloc"
54
external get_sptr_ptr_sptr :
55
sptr_ptr -> sptr = "get_sptr_ptr_sptr_stub" "noalloc"
57
external set_sptr_ptr_sptr :
58
sptr_ptr -> sptr -> unit = "set_sptr_ptr_sptr_stub" "noalloc"
60
external get_ptr_string : sptr -> eptr -> string = "get_ptr_string_stub"
62
let get_read_init buf ~pos_ref =
63
let start_pos = !pos_ref in
64
if start_pos < 0 then array_bound_error ();
65
let buf_len = Array1.dim buf in
66
if start_pos > buf_len then raise Buffer_short;
67
let sptr_ptr = alloc_sptr_ptr buf ~pos:start_pos in
68
let eptr = get_eptr buf ~pos:buf_len in