1 #ifndef _mlvalues_
2 #define _mlvalues_
3 
4 
5 #include "config.h"
6 #include "misc.h"
7 
8 /* Definitions
9 
10   word: Four bytes on 32 and 16 bit architectures,
11         eight bytes on 64 bit architectures.
12   long: A C long integer.
13   val: The ML representation of something.  A long or a block or a pointer
14        outside the heap.  If it is a block, it is the (encoded) address
15        of an object.  If it is a long, it is encoded as well.
16   object: Something allocated.  It always has a header and some
17           fields or some number of bytes (a multiple of the word size).
18   field: A word-sized val which is part of an object.
19   bp: Pointer to the first byte of an object.  (a char *)
20   op: Pointer to the first field of an object.  (a value *)
21   hp: Pointer to the header of an object.  (a char *)
22   int32: Four bytes on all architectures.
23 
24   Remark: An object size is always a multiple of the word size, and at least
25           one word plus the header.
26 
27   bosize: Size (in bytes) of the "bytes" part.
28   wosize: Size (in words) of the "fields" part.
29   bhsize: Size (in bytes) of the object with its header.
30   whsize: Size (in words) of the object with its header.
31 
32   hd: A header.
33   tag: The value of the tag field of the header.
34   color: The value of the color field of the header.
35          This is for use only by the GC.
36 */
37 
38 typedef long value;
39 typedef unsigned long header_t;
40 #ifdef SIXTEEN
41 typedef unsigned int mlsize_t;
42 #else
43 typedef unsigned long mlsize_t;
44 #endif
45 typedef unsigned int tag_t;             /* Actually, an unsigned char */
46 typedef unsigned long color_t;
47 typedef unsigned long mark_t;
48 
49 #ifdef SIXTYFOUR
50 typedef int int32;            /* Not portable, but checked by autoconf. */
51 typedef unsigned int uint32;  /* Seems like a reasonable assumption anyway. */
52 #else
53 typedef long int32;
54 typedef unsigned long uint32;
55 #endif
56 
57 /* Longs vs blocks. */
58 #define Is_long(x)   (((x) & 1) == 1)
59 #define Is_block(x)  (((x) & 1) == 0)
60 
61 /* Conversion macro names are always of the form  "to_from". */
62 /* Example: Val_long as in "Val from long" or "Val of long". */
63 #define Val_long(x)     (((long)(x) << 1) + 1)
64 #define Long_val(x)     ((x) >> 1)
65 #define Max_long ((long)((1L << (8 * sizeof(value) - 2)) - 1))
66 #define Min_long ((long) -(1L << (8 * sizeof(value) - 2)))
67 #define Val_int Val_long
68 #define Int_val(x) ((int) Long_val(x))
69 
70 /* Structure of the header:
71 
72 For 16-bit and 32-bit architectures:
73      +--------+-------+-----+
74      | wosize | color | tag |
75      +--------+-------+-----+
76 bits  31    10 9     8 7   0
77 
78 For 64-bit architectures:
79 
80      +--------+-------+-----+
81      | wosize | color | tag |
82      +--------+-------+-----+
83 bits  63    10 9     8 7   0
84 
85 */
86 
87 #define Tag_hd(hd) ((tag_t) ((hd) & 0xFF))
88 #define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10))
89 
90 #define Hd_val(val) (((header_t *) (val)) [-1])        /* Also an l-value. */
91 #define Hd_op(op) (Hd_val (op))                        /* Also an l-value. */
92 #define Hd_bp(bp) (Hd_val (bp))                        /* Also an l-value. */
93 #define Hd_hp(hp) (* ((header_t *) (hp)))              /* Also an l-value. */
94 #define Hp_val(val) ((char *) (((header_t *) (val)) - 1))
95 #define Hp_op(op) (Hp_val (op))
96 #define Hp_bp(bp) (Hp_val (bp))
97 #define Val_op(op) ((value) (op))
98 #define Val_hp(hp) ((value) (((header_t *) (hp)) + 1))
99 #define Op_hp(hp) ((value *) Val_hp (hp))
100 #define Bp_hp(hp) ((char *) Val_hp (hp))
101 
102 #define Num_tags (1 << 8)
103 #ifdef SIXTYFOUR
104 #define Max_wosize ((1L << 54) - 1)
105 #else
106 #ifdef SIXTEEN
107 #define Max_wosize ((1 << 14) - 1)
108 #else
109 #define Max_wosize ((1 << 22) - 1)
110 #endif
111 #endif
112 
113 #define Wosize_val(val) (Wosize_hd (Hd_val (val)))
114 #define Wosize_op(op) (Wosize_val (op))
115 #define Wosize_bp(bp) (Wosize_val (bp))
116 #define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp)))
117 #define Whsize_wosize(sz) ((sz) + 1)
118 #define Wosize_whsize(sz) ((sz) - 1)
119 #define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1)
120 #define Bsize_wsize(sz) ((sz) * sizeof (value))
121 #define Wsize_bsize(sz) ((sz) / sizeof (value))
122 #define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz)))
123 #define Bhsize_bosize(sz) ((sz) + sizeof (header_t))
124 #define Bosize_val(val) (Bsize_wsize (Wosize_val (val)))
125 #define Bosize_op(op) (Bosize_val (Val_op (op)))
126 #define Bosize_bp(bp) (Bosize_val (Val_bp (bp)))
127 #define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd)))
128 #define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp)))
129 #define Whsize_val(val) (Whsize_hp (Hp_val (val)))
130 #define Whsize_bp(bp) (Whsize_val (Val_bp (bp)))
131 #define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd)))
132 #define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp)))
133 #define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd)))
134 
135 #ifdef MOSML_BIG_ENDIAN
136 #define Tag_val(val) (((unsigned char *) (val)) [-1])
137                                                  /* Also an l-value. */
138 #define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1])
139                                                  /* Also an l-value. */
140 #else
141 #define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)])
142                                                  /* Also an l-value. */
143 #define Tag_hp(hp) (((unsigned char *) (hp)) [0])
144                                                  /* Also an l-value. */
145 #endif
146 
147 /* The tag values MUST AGREE with compiler/Config.mlp: */
148 
149 /* The Lowest tag for blocks containing no value. */
150 #define No_scan_tag (Num_tags - 5)
151 
152 
153 /* 1- If tag < No_scan_tag : a tuple of fields.  */
154 
155 /* Pointer to the first field. */
156 #define Op_val(x) ((value *) (x))
157 /* Fields are numbered from 0. */
158 #define Field(x, i) (((value *)(x)) [i])           /* Also an l-value. */
159 
160 /* A sequence of bytecodes */
161 typedef unsigned char * bytecode_t;
162 
163 /* A sequence of real machine instruction addresses */
164 typedef void ** realcode_t;
165 
166 /* GCC 2.0 has labels as first-class values. We take advantage of that
167    to provide faster dispatch than the "switch" statement. */
168 
169 #if defined(__GNUC__) && __GNUC__ >= 2 && !defined(DEBUG)
170 #define DIRECT_JUMP
171 #endif
172 
173 #if defined(DIRECT_JUMP) && defined(THREADED)
174 #define CODE realcode_t
175 #else
176 #define CODE bytecode_t
177 #endif
178 
179 #define Closure_wosize 2
180 #define Closure_tag (No_scan_tag - 2)
181 #define Code_val(val) (((CODE *) (val)) [0])     /* Also an l-value. */
182 #define Env_val(val) (Field(val, 1))               /* Also an l-value. */
183 
184 /* --- Reference cells are used in Moscow SML --- */
185 
186 #define Reference_tag (No_scan_tag - 1)
187 
188 /* --- --- */
189 
190 
191 /* 2- If tag >= No_scan_tag : a sequence of bytes. */
192 
193 /* Pointer to the first byte */
194 #define Bp_val(v) ((char *) (v))
195 #define Val_bp(p) ((value) (p))
196 /* Bytes are numbered from 0. */
197 #define Byte(x, i) (((char *) (x)) [i])            /* Also an l-value. */
198 #define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */
199 
200 /* Arrays of weak pointers.  Just like abstract things, but the GC will
201    reset each cell (during the weak phase, between marking and sweeping)
202    as the pointed-to object gets deallocated.
203 */
204 #define Weak_tag No_scan_tag
205 
206 /* Abstract things.  Their contents is not traced by the GC; therefore they
207    must not contain any [value].
208 */
209 #define Abstract_tag (No_scan_tag + 1)
210 
211 /* Strings. */
212 #define String_tag (No_scan_tag + 2)
213 #define String_val(x) ((char *) Bp_val(x))
214 
215 /* Floating-point numbers. */
216 #define Double_tag (No_scan_tag + 3)
217 #define Double_wosize ((sizeof(double) / sizeof(value)))
218 #ifndef ALIGN_DOUBLE
219 #define Double_val(v) (* (double *) (v))
220 #else
221 EXTERN double Double_val (value);
222 #endif
223 void Store_double_val (value,double);
224 
225 /* Finalized things.  Just like abstract things, but the GC will call the
226    [Final_fun] before deallocation.
227 */
228 #define Final_tag (No_scan_tag + 4)
229 typedef void (*final_fun) (value);
230 #define Final_fun(val) (((final_fun *) (val)) [0]) /* Also an l-value. */
231 
232 
233 /* 3- Atoms are 0-tuples.  They are statically allocated once and for all. */
234 
235 EXTERN header_t first_atoms[];
236 #define Atom(tag) (Val_hp (&(first_atoms [tag])))
237 #define Is_atom(v) (v >= Atom(0) && v <= Atom(255))
238 
239 /* Booleans are atoms tagged 0 or 1 */
240 
241 #define Val_bool(x) Atom((x) != 0)
242 #define Bool_val(x) Tag_val(x)
243 #define Val_false Atom(0)
244 #define Val_true Atom(1)
245 
246 /* The unit value is the atom tagged 0 */
247 
248 #define Val_unit Atom(0)
249 
250 /*  SML option values: Must match compiler/Types.sml: */
251 
252 #define NONE Atom(0)
253 #define SOMEtag (1)
254 
255 #endif /* _mlvalues_ */
256