forked from ocaml/ocaml
-
Notifications
You must be signed in to change notification settings - Fork 0
/
intext.h
218 lines (184 loc) · 8.51 KB
/
intext.h
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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
/**************************************************************************/
/* */
/* OCaml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1996 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. */
/* */
/**************************************************************************/
/* Structured input/output */
#ifndef CAML_INTEXT_H
#define CAML_INTEXT_H
#include "misc.h"
#include "mlvalues.h"
#ifdef CAML_INTERNALS
#include "io.h"
/* Magic number */
#define Intext_magic_number_small 0x8495A6BE
#define Intext_magic_number_big 0x8495A6BF
#define Intext_magic_number_compressed 0x8495A6BD
/* Header format for the "small" model: 20 bytes
0 "small" magic number
4 length of marshaled data, in bytes
8 number of shared blocks
12 size in words when read on a 32-bit platform
16 size in words when read on a 64-bit platform
The 4 numbers are 32 bits each, in big endian.
Header format for the "big" model: 32 bytes
0 "big" magic number
4 four reserved bytes, currently set to 0
8 length of marshaled data, in bytes
16 number of shared blocks
24 size in words when read on a 64-bit platform
The 3 numbers are 64 bits each, in big endian.
Header format for the "compressed" model: 10 to 55 bytes
0 "compressed" magic number
4 low 6 bits: total size of the header
high 2 bits: reserved, currently 0
5 and following
5 variable-length integers, in VLQ format (1 to 10 bytes each)
- length of compressed marshaled data, in bytes
- length of uncompressed marshaled data, in bytes
- number of shared blocks
- size in words when read on a 32-bit platform
- size in words when read on a 64-bit platform
VLQ format is one or several bytes like 1xxxxxxx 1yyyyyyy 0zzzzzzz.
First bytes have top bit 1, last byte has top bit 0.
Each byte carries 7 bits of the number.
Bytes come in big-endian order: xxxxxxx are the 7 high-order bits,
zzzzzzzz the 7 low-order bits.
*/
#define MAX_INTEXT_HEADER_SIZE 55
/* Codes for the compact format */
#define PREFIX_SMALL_BLOCK 0x80
#define PREFIX_SMALL_INT 0x40
#define PREFIX_SMALL_STRING 0x20
#define CODE_INT8 0x0
#define CODE_INT16 0x1
#define CODE_INT32 0x2
#define CODE_INT64 0x3
#define CODE_SHARED8 0x4
#define CODE_SHARED16 0x5
#define CODE_SHARED32 0x6
#define CODE_SHARED64 0x14
#define CODE_BLOCK32 0x8
#define CODE_BLOCK64 0x13
#define CODE_STRING8 0x9
#define CODE_STRING32 0xA
#define CODE_STRING64 0x15
#define CODE_DOUBLE_BIG 0xB
#define CODE_DOUBLE_LITTLE 0xC
#define CODE_DOUBLE_ARRAY8_BIG 0xD
#define CODE_DOUBLE_ARRAY8_LITTLE 0xE
#define CODE_DOUBLE_ARRAY32_BIG 0xF
#define CODE_DOUBLE_ARRAY32_LITTLE 0x7
#define CODE_DOUBLE_ARRAY64_BIG 0x16
#define CODE_DOUBLE_ARRAY64_LITTLE 0x17
#define CODE_CODEPOINTER 0x10
#define CODE_INFIXPOINTER 0x11
#define OLD_CODE_CUSTOM 0x12 // no longer supported
#define CODE_CUSTOM_LEN 0x18
#define CODE_CUSTOM_FIXED 0x19
#if ARCH_FLOAT_ENDIANNESS == 0x76543210
#define CODE_DOUBLE_NATIVE CODE_DOUBLE_BIG
#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_BIG
#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_BIG
#define CODE_DOUBLE_ARRAY64_NATIVE CODE_DOUBLE_ARRAY64_BIG
#else
#define CODE_DOUBLE_NATIVE CODE_DOUBLE_LITTLE
#define CODE_DOUBLE_ARRAY8_NATIVE CODE_DOUBLE_ARRAY8_LITTLE
#define CODE_DOUBLE_ARRAY32_NATIVE CODE_DOUBLE_ARRAY32_LITTLE
#define CODE_DOUBLE_ARRAY64_NATIVE CODE_DOUBLE_ARRAY64_LITTLE
#endif
/* Size-ing data structures for extern. Chosen so that
sizeof(struct trail_block) and sizeof(struct output_block)
are slightly below 8Kb. */
#define ENTRIES_PER_TRAIL_BLOCK 1025
#define SIZE_EXTERN_OUTPUT_BLOCK 8100
struct caml_output_block {
struct caml_output_block * next;
char * end;
char data[SIZE_EXTERN_OUTPUT_BLOCK];
};
void caml_free_extern_state (void);
/* The entry points */
void caml_output_val (struct channel * chan, value v, value flags);
/* Output [v] with flags [flags] on the channel [chan]. */
void caml_free_intern_state (void);
/* Compression hooks */
CAMLextern _Bool (*caml_extern_compress_output)(struct caml_output_block **);
CAMLextern size_t (*caml_intern_decompress_input)(unsigned char *,
uintnat,
const unsigned char *,
uintnat);
#endif /* CAML_INTERNALS */
#ifdef __cplusplus
extern "C" {
#endif
CAMLextern void caml_output_value_to_malloc(value v, value flags,
/*out*/ char ** buf,
/*out*/ intnat * len);
/* Output [v] with flags [flags] to a memory buffer allocated with
malloc. On return, [*buf] points to the buffer and [*len]
contains the number of bytes in buffer. */
CAMLextern intnat caml_output_value_to_block(value v, value flags,
char * data, intnat len);
/* Output [v] with flags [flags] to a user-provided memory buffer.
[data] points to the start of this buffer, and [len] is its size
in bytes. Return the number of bytes actually written in buffer.
Raise [Failure] if buffer is too short. */
#ifdef CAML_INTERNALS
value caml_input_val (struct channel * chan);
/* Read a structured value from the channel [chan]. */
#endif /* CAML_INTERNALS */
CAMLextern value caml_input_val_from_string (value str, intnat ofs);
/* Read a structured value from the OCaml string [str], starting
at offset [ofs]. */
CAMLextern value caml_input_value_from_malloc(char * data, intnat ofs);
/* Read a structured value from a malloced buffer. [data] points
to the beginning of the buffer, and [ofs] is the offset of the
beginning of the externed data in this buffer. The buffer is
deallocated with [free] on return, or if an exception is raised. */
CAMLextern value caml_input_value_from_block(const char * data, intnat len);
/* Read a structured value from a user-provided buffer. [data] points
to the beginning of the externed data in this buffer,
and [len] is the length in bytes of valid data in this buffer.
The buffer is never deallocated by this routine. */
/* Functions for writing user-defined marshallers */
CAMLextern void caml_serialize_int_1(int i);
CAMLextern void caml_serialize_int_2(int i);
CAMLextern void caml_serialize_int_4(int32_t i);
CAMLextern void caml_serialize_int_8(int64_t i);
CAMLextern void caml_serialize_float_4(float f);
CAMLextern void caml_serialize_float_8(double f);
CAMLextern void caml_serialize_block_1(void * data, intnat len);
CAMLextern void caml_serialize_block_2(void * data, intnat len);
CAMLextern void caml_serialize_block_4(void * data, intnat len);
CAMLextern void caml_serialize_block_8(void * data, intnat len);
CAMLextern void caml_serialize_block_float_8(void * data, intnat len);
CAMLextern int caml_deserialize_uint_1(void);
CAMLextern int caml_deserialize_sint_1(void);
CAMLextern int caml_deserialize_uint_2(void);
CAMLextern int caml_deserialize_sint_2(void);
CAMLextern uint32_t caml_deserialize_uint_4(void);
CAMLextern int32_t caml_deserialize_sint_4(void);
CAMLextern uint64_t caml_deserialize_uint_8(void);
CAMLextern int64_t caml_deserialize_sint_8(void);
CAMLextern float caml_deserialize_float_4(void);
CAMLextern double caml_deserialize_float_8(void);
CAMLextern void caml_deserialize_block_1(void * data, intnat len);
CAMLextern void caml_deserialize_block_2(void * data, intnat len);
CAMLextern void caml_deserialize_block_4(void * data, intnat len);
CAMLextern void caml_deserialize_block_8(void * data, intnat len);
CAMLextern void caml_deserialize_block_float_8(void * data, intnat len);
CAMLnoret CAMLextern void caml_deserialize_error(char * msg);
#ifdef __cplusplus
}
#endif
#endif /* CAML_INTEXT_H */