Source file `marshal.ml`

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
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
(*                                                                        *)
(*   Copyright 1997 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

type extern_flags =
    No_sharing
  | Closures
  | Compat_32
  | Compression
(* note: this type definition is used in 'runtime/debugger.c' *)

external to_channel: out_channel -> 'a -> extern_flags list -> unit
    = "caml_output_value"
external to_bytes: 'a -> extern_flags list -> bytes
    = "caml_output_value_to_bytes"
external to_string: 'a -> extern_flags list -> string
    = "caml_output_value_to_string"
external to_buffer_unsafe:
      bytes -> int -> int -> 'a -> extern_flags list -> int
    = "caml_output_value_to_buffer"

let to_buffer buff ofs len v flags =
  if ofs < 0 || len < 0 || ofs > Bytes.length buff - len
  then invalid_arg "Marshal.to_buffer: substring out of bounds"
  else to_buffer_unsafe buff ofs len v flags

(* The functions below use byte sequences as input, never using any
   mutation. It makes sense to use non-mutated [bytes] rather than
   [string], because we really work with sequences of bytes, not
   a text representation.
*)

external from_channel: in_channel -> 'a = "caml_input_value"
external from_bytes_unsafe: bytes -> int -> 'a = "caml_input_value_from_bytes"
external data_size_unsafe: bytes -> int -> int = "caml_marshal_data_size"

let header_size = 16
let data_size buff ofs =
  if ofs < 0 || ofs > Bytes.length buff - header_size
  then invalid_arg "Marshal.data_size"
  else data_size_unsafe buff ofs
let total_size buff ofs = header_size + data_size buff ofs

let from_bytes buff ofs =
  if ofs < 0 || ofs > Bytes.length buff - header_size
  then invalid_arg "Marshal.from_bytes"
  else begin
    let len = data_size_unsafe buff ofs in
    if ofs > Bytes.length buff - (header_size + len)
    then invalid_arg "Marshal.from_bytes"
    else from_bytes_unsafe buff ofs
  end

let from_string buff ofs =
  (* Bytes.unsafe_of_string is safe here, as the produced byte
     sequence is never mutated *)
  from_bytes (Bytes.unsafe_of_string buff) ofs

let compression_supported () =
  let s = to_string () [Compression] in
  match s.[3] with
  | '\xBD' -> true
  | '\xBE' -> false
  | _ -> assert false