~ubuntu-branches/ubuntu/lucid/bin-prot/lucid

« back to all changes in this revision

Viewing changes to lib/unsafe_common.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stefano Zacchiroli
  • Date: 2008-05-09 15:24:37 UTC
  • Revision ID: james.westby@ubuntu.com-20080509152437-7gils45p37xcs40c
Tags: upstream-1.0.5
ImportĀ upstreamĀ versionĀ 1.0.5

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(* File: unsafe_common.ml
 
2
 
 
3
    Copyright (C) 2007-
 
4
 
 
5
      Jane Street Holding, LLC
 
6
      Author: Markus Mottl
 
7
      email: mmottl\@janestcapital.com
 
8
      WWW: http://www.janestcapital.com/ocaml
 
9
 
 
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.
 
14
 
 
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.
 
19
 
 
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
 
23
*)
 
24
 
 
25
(* Unsafe_common: functions common to unsafe binary protocol conversion. *)
 
26
 
 
27
open Common
 
28
open Bigarray
 
29
 
 
30
type sptr
 
31
type eptr
 
32
type sptr_ptr
 
33
 
 
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"
 
36
 
 
37
external get_buf_pos :
 
38
  start : sptr -> cur : sptr -> pos = "get_buf_pos_stub" "noalloc"
 
39
 
 
40
external get_safe_buf_pos :
 
41
  buf -> start : sptr -> cur : sptr -> pos = "get_safe_buf_pos_stub" "noalloc"
 
42
 
 
43
external alloc_sptr_ptr :
 
44
  buf -> pos : pos -> sptr_ptr = "alloc_sptr_ptr_stub" "noalloc"
 
45
 
 
46
external dealloc_sptr_ptr :
 
47
  buf -> sptr_ptr -> pos = "dealloc_sptr_ptr_stub" "noalloc"
 
48
 
 
49
external get_sptr_ptr : sptr_ptr -> buf -> pos = "get_sptr_ptr_stub" "noalloc"
 
50
 
 
51
external set_sptr_ptr :
 
52
  sptr_ptr -> buf -> pos : pos -> unit = "set_sptr_ptr_stub" "noalloc"
 
53
 
 
54
external get_sptr_ptr_sptr :
 
55
  sptr_ptr -> sptr = "get_sptr_ptr_sptr_stub" "noalloc"
 
56
 
 
57
external set_sptr_ptr_sptr :
 
58
  sptr_ptr -> sptr -> unit = "set_sptr_ptr_sptr_stub" "noalloc"
 
59
 
 
60
external get_ptr_string : sptr -> eptr -> string = "get_ptr_string_stub"
 
61
 
 
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
 
69
  sptr_ptr, eptr