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
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
|
/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Xavier Leroy and Damien Doligez, 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 Library General Public License. */
/* */
/***********************************************************************/
/* $Id$ */
#ifndef _mlvalues_
#define _mlvalues_
#include "config.h"
#include "misc.h"
/* Definitions
word: Four bytes on 32 and 16 bit architectures,
eight bytes on 64 bit architectures.
long: A C long integer.
val: The ML representation of something. A long or a block or a pointer
outside the heap. If it is a block, it is the (encoded) address
of an object. If it is a long, it is encoded as well.
block: Something allocated. It always has a header and some
fields or some number of bytes (a multiple of the word size).
field: A word-sized val which is part of a block.
bp: Pointer to the first byte of a block. (a char *)
op: Pointer to the first field of a block. (a value *)
hp: Pointer to the header of a block. (a char *)
int32: Four bytes on all architectures.
int64: Eight bytes on all architectures.
Remark: A block size is always a multiple of the word size, and at least
one word plus the header.
bosize: Size (in bytes) of the "bytes" part.
wosize: Size (in words) of the "fields" part.
bhsize: Size (in bytes) of the block with its header.
whsize: Size (in words) of the block with its header.
hd: A header.
tag: The value of the tag field of the header.
color: The value of the color field of the header.
This is for use only by the GC.
*/
typedef long value;
typedef unsigned long header_t;
typedef unsigned long mlsize_t;
typedef unsigned int tag_t; /* Actually, an unsigned char */
typedef unsigned long color_t;
typedef unsigned long mark_t;
/* Longs vs blocks. */
#define Is_long(x) (((x) & 1) != 0)
#define Is_block(x) (((x) & 1) == 0)
/* Conversion macro names are always of the form "to_from". */
/* Example: Val_long as in "Val from long" or "Val of long". */
#define Val_long(x) (((long)(x) << 1) + 1)
#define Long_val(x) ((x) >> 1)
#define Max_long ((1L << (8 * sizeof(value) - 2)) - 1)
#define Min_long (-(1L << (8 * sizeof(value) - 2)))
#define Val_int(x) Val_long(x)
#define Int_val(x) ((int) Long_val(x))
/* Structure of the header:
For 16-bit and 32-bit architectures:
+--------+-------+-----+
| wosize | color | tag |
+--------+-------+-----+
bits 31 10 9 8 7 0
For 64-bit architectures:
+--------+-------+-----+
| wosize | color | tag |
+--------+-------+-----+
bits 63 10 9 8 7 0
*/
#define Tag_hd(hd) ((tag_t) ((hd) & 0xFF))
#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10))
#define Hd_val(val) (((header_t *) (val)) [-1]) /* Also an l-value. */
#define Hd_op(op) (Hd_val (op)) /* Also an l-value. */
#define Hd_bp(bp) (Hd_val (bp)) /* Also an l-value. */
#define Hd_hp(hp) (* ((header_t *) (hp))) /* Also an l-value. */
#define Hp_val(val) ((char *) (((header_t *) (val)) - 1))
#define Hp_op(op) (Hp_val (op))
#define Hp_bp(bp) (Hp_val (bp))
#define Val_op(op) ((value) (op))
#define Val_hp(hp) ((value) (((header_t *) (hp)) + 1))
#define Op_hp(hp) ((value *) Val_hp (hp))
#define Bp_hp(hp) ((char *) Val_hp (hp))
#define Num_tags (1 << 8)
#ifdef ARCH_SIXTYFOUR
#define Max_wosize ((1L << 54) - 1)
#else
#define Max_wosize ((1 << 22) - 1)
#endif
#define Wosize_val(val) (Wosize_hd (Hd_val (val)))
#define Wosize_op(op) (Wosize_val (op))
#define Wosize_bp(bp) (Wosize_val (bp))
#define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp)))
#define Whsize_wosize(sz) ((sz) + 1)
#define Wosize_whsize(sz) ((sz) - 1)
#define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1)
#define Bsize_wsize(sz) ((sz) * sizeof (value))
#define Wsize_bsize(sz) ((sz) / sizeof (value))
#define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz)))
#define Bhsize_bosize(sz) ((sz) + sizeof (header_t))
#define Bosize_val(val) (Bsize_wsize (Wosize_val (val)))
#define Bosize_op(op) (Bosize_val (Val_op (op)))
#define Bosize_bp(bp) (Bosize_val (Val_bp (bp)))
#define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd)))
#define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp)))
#define Whsize_val(val) (Whsize_hp (Hp_val (val)))
#define Whsize_bp(bp) (Whsize_val (Val_bp (bp)))
#define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd)))
#define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp)))
#define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd)))
#ifdef ARCH_BIG_ENDIAN
#define Tag_val(val) (((unsigned char *) (val)) [-1])
/* Also an l-value. */
#define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1])
/* Also an l-value. */
#else
#define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)])
/* Also an l-value. */
#define Tag_hp(hp) (((unsigned char *) (hp)) [0])
/* Also an l-value. */
#endif
/* The lowest tag for blocks containing no value. */
#define No_scan_tag 251
/* 1- If tag < No_scan_tag : a tuple of fields. */
/* Pointer to the first field. */
#define Op_val(x) ((value *) (x))
/* Fields are numbered from 0. */
#define Field(x, i) (((value *)(x)) [i]) /* Also an l-value. */
typedef int32 opcode_t;
typedef opcode_t * code_t;
/* Special case of tuples of fields: closures */
#define Closure_tag 250
#define Code_val(val) (((code_t *) (val)) [0]) /* Also an l-value. */
/* If tag == Infix_tag : an infix header inside a closure */
/* Infix_tag must be odd so that the infix header is scanned as an integer */
/* Infix_tag must be 1 modulo 4 and infix headers can only occur in blocks
with tag Closure_tag (see compact.c). */
#define Infix_tag 249
#define Infix_offset_hd(hd) (Bosize_hd(hd))
#define Infix_offset_val(v) Infix_offset_hd(Hd_val(v))
/* Another special case: objects */
#define Object_tag 248
#define Class_val(val) Field((val), 0)
#define Oid_val(val) Long_val(Field((val), 1))
/* Another special case: variants */
CAMLextern value hash_variant(char * tag);
/* 2- If tag >= No_scan_tag : a sequence of bytes. */
/* Pointer to the first byte */
#define Bp_val(v) ((char *) (v))
#define Val_bp(p) ((value) (p))
/* Bytes are numbered from 0. */
#define Byte(x, i) (((char *) (x)) [i]) /* Also an l-value. */
#define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */
/* Abstract things. Their contents is not traced by the GC; therefore they
must not contain any [value].
*/
#define Abstract_tag 251
/* Strings. */
#define String_tag 252
#define String_val(x) ((char *) Bp_val(x))
CAMLextern mlsize_t string_length (value);
/* Floating-point numbers. */
#define Double_tag 253
#define Double_wosize ((sizeof(double) / sizeof(value)))
#ifndef ARCH_ALIGN_DOUBLE
#define Double_val(v) (* (double *)(v))
#define Store_double_val(v,d) (* (double *)(v) = (d))
#else
CAMLextern double Double_val (value);
CAMLextern void Store_double_val (value,double);
#endif
/* Arrays of floating-point numbers. */
#define Double_array_tag 254
#define Double_field(v,i) Double_val((value)((double *)(v) + (i)))
#define Store_double_field(v,i,d) do{ \
mlsize_t caml__temp_i = (i); \
double caml__temp_d = (d); \
Store_double_val((value)((double *) v + caml__temp_i), caml__temp_d); \
}while(0)
/* Custom blocks. They contain a pointer to a "method suite"
of functions (for finalization, comparison, hashing, etc)
followed by raw data. The contents of custom blocks is not traced by
the GC; therefore, they must not contain any [value].
See [custom.h] for operations on method suites. */
#define Custom_tag 255
#define Data_custom_val(v) ((void *) &Field((v), 1))
struct custom_operations; /* defined in [custom.h] */
/* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */
#define Int32_val(v) (*((int32 *) Data_custom_val(v)))
#define Nativeint_val(v) (*((long *) Data_custom_val(v)))
#ifndef ARCH_ALIGN_INT64
#define Int64_val(v) (*((int64 *) Data_custom_val(v)))
#else
CAMLextern int64 Int64_val(value v);
#endif
/* 3- Atoms are 0-tuples. They are statically allocated once and for all. */
CAMLextern header_t atom_table[];
#define Atom(tag) (Val_hp (&(atom_table [(tag)])))
/* Is_atom tests whether a well-formed block is statically allocated
outside the heap. For the bytecode system, only zero-sized block (Atoms)
fall in this class. For the native-code generator, data
emitted by the code generator (as described in the table
caml_data_segments) are also atoms. */
#ifndef NATIVE_CODE
#define Is_atom(v) ((v) >= Atom(0) && (v) <= Atom(255))
#else
CAMLextern char * static_data_start, * static_data_end;
#define Is_atom(v) \
((((char *)(v) >= static_data_start && (char *)(v) < static_data_end) || \
((v) >= Atom(0) && (v) <= Atom(255))))
#endif
/* Booleans are integers 0 or 1 */
#define Val_bool(x) Val_int((x) != 0)
#define Bool_val(x) Int_val(x)
#define Val_false Val_int(0)
#define Val_true Val_int(1)
#define Val_not(x) (Val_false + Val_true - (x))
/* The unit value is 0 (tagged) */
#define Val_unit Val_int(0)
/* List constructors */
#define Val_emptylist Val_int(0)
#define Tag_cons 0
/* The table of global identifiers */
extern value global_data;
#endif /* _mlvalues_ */
|