1 /*
2 Ypsilon Scheme System
3 Copyright (c) 2004-2008 Y.FUJITA / LittleWing Company Limited.
4 See license.txt for terms and conditions of use
5 */
6
7 #ifndef OBJECT_H_INCLUDED
8 #define OBJECT_H_INCLUDED
9
10 #include "core.h"
11 #include "mutex.h"
12 #include "queue.h"
13
14 /*
15 immediate:
16
17 nnnn nnnn nnnn nnnn nnnn nnnn nnnn nnn1 : scm_fixnum_t
18 pppp pppp pppp pppp pppp pppp pppp p000 : scm_cell_t
19 cccc cccc cccc cccc cccc cccc 0000 0010 : scm_char_t
20 0000 0000 0000 0000 0000 0000 0001 0010 : scm_true
21 0000 0000 0000 0000 0000 0000 0010 0010 : scm_false
22 0000 0000 0000 0000 0000 0000 0011 0010 : scm_nil
23 0000 0000 0000 0000 0000 0000 0100 0010 : scm_undef
24 0000 0000 0000 0000 0000 0000 0101 0010 : scm_unspecified
25 0000 0000 0000 0000 0000 0000 0110 0010 : scm_eof
26 0000 0000 0000 0000 0000 0000 0111 0010 : scm_hash_free
27 0000 0000 0000 0000 0000 0000 1000 0010 : scm_hash_used
28 0000 0000 0000 0000 0000 0000 1001 0010 : scm_proc_apply
29 0000 0000 0000 0000 0000 0000 1010 0010 : scm_proc_callcc
30 0000 0000 0000 0000 0000 0000 1011 0010 : scm_proc_apply_values
31 .... .... .... .... .... .... 1101 0010 : (reserved)
32 .... .... .... .... .... .... 1110 0010 : (reserved)
33 .... .... .... .... .... .... 1111 0010 : (reserved)
34
35 xxxx xxxx xxxx xxxx xxxx xxxx xxxx x100 : scm_inst_t
36 pppp pppp pppp pppp pppp pppp pppp p110 : heap forward pointer
37
38 boxed:
39
40 nnnn nnnn nnnn SSSS SSSS IU-- ---- 1010 : scm_hdr_symbol I: inherent U: uninterned S: symbol code
41 .... .... .... .... TTTT L.-- ---- 1010 : scm_hdr_string L: literal T: (0x0 unknown) (0x1 ascii) (0x2 utf8)
42 nnnn nnnn nnnn nnnn .... NZ-- ---- 1010 : scm_hdr_bignum NZ: (01 positive) (11 negative) (00 zero)
43 .... .... .... .... .... P.-- ---- 1010 : scm_hdr_flonum P: precision (0 64bit) (1 32bit)
44 .... .... .... .... .... ..-- ---- 1010 : scm_hdr_cont
45 nnnn nnnn nnnn nnnn .... ..-- ---- 1010 : scm_hdr_closure if has rest arguments then n == (- 1 - <required argc>)
46 .... .... .... .... .... ..-- ---- 1010 : scm_hdr_subr
47 .... .... .... .... .... L.-- ---- 1010 : scm_hdr_vector L: literal
48 .... .... .... .... .... ..-- ---- 1010 : scm_hdr_port
49 nnnn nnnn nnnn nnnn .... ..-- ---- 1010 : scm_hdr_values
50 .... .... .... .... .... IU-- ---- 1010 : scm_hdr_hashtable I: immutable U: unsafe
51 .... .... .... .... .... ..-- ---- 1010 : scm_hdr_gloc
52 nnnn nnnn nnnn nnnn .... ..-- ---- 1010 : scm_hdr_tuple
53 .... .... .... .... .... IU-- ---- 1010 : scm_hdr_weakhashtable I: immutable U: unsafe
54 .... .... .... .... .... LM-- ---- 1010 : scm_hdr_bvector L: literal M: mapped
55 .... .... .... .... .... ..-- ---- 1010 : scm_hdr_complex
56 .... .... .... .... .... ..-- ---- 1010 : scm_hdr_rational
57 nnnn nnnn nnnn nnnn .... ..-- ---- 1010 : scm_hdr_heapenv
58 nnnn nnnn nnnn nnnn .... ..-- ---- 1010 : scm_hdr_heapcont
59 .... .... .... .... .... ..-- ---- 1010 : scm_hdr_weakmapping
60 .... .... .... .... .... ..-- ---- 1010 : scm_hdr_environment
61 .... .... .... .... .... ..-- ---- 1010 : scm_hdr_socket
62 */
63
64 #define OBJECT_DATUM_ALIGN 8
65 #define OBJECT_DATUM_ALIGN_MASK (OBJECT_DATUM_ALIGN - 1)
66
67 #define PORT_LOOKAHEAD_SIZE 6
68
69 typedef void* scm_obj_t;
70 typedef uintptr_t scm_hdr_t;
71 typedef scm_obj_t scm_cell_t;
72 typedef scm_obj_t scm_char_t;
73 typedef scm_obj_t scm_fixnum_t;
74 typedef scm_obj_t scm_inst_t;
75
76 #if ARCH_LP64
77 #define USE_DIGIT32 0
78 #define USE_DIGIT64 1
79 typedef uint64_t digit_t;
80 #else
81 #define USE_DIGIT32 1
82 #define USE_DIGIT64 0
83 typedef uint32_t digit_t;
84 #endif
85
86 const scm_obj_t scm_true = (scm_obj_t)0x12;
87 const scm_obj_t scm_false = (scm_obj_t)0x22;
88 const scm_obj_t scm_nil = (scm_obj_t)0x32;
89 const scm_obj_t scm_undef = (scm_obj_t)0x42; // unbound variable
90 const scm_obj_t scm_unspecified = (scm_obj_t)0x52;
91 const scm_obj_t scm_eof = (scm_obj_t)0x62;
92 const scm_obj_t scm_timeout = (scm_obj_t)0x72;
93 const scm_obj_t scm_shutdown = (scm_obj_t)0x82;
94 const scm_obj_t scm_hash_free = (scm_obj_t)0x92; // internal use
95 const scm_obj_t scm_hash_deleted = (scm_obj_t)0xa2; // internal use
96 const scm_obj_t scm_proc_apply = (scm_obj_t)0xb2;
97 const scm_obj_t scm_proc_callcc = (scm_obj_t)0xc2;
98 const scm_obj_t scm_proc_apply_values = (scm_obj_t)0xd2;
99
100 // primitive
101 #define TC_FLONUM 0x00
102 #define TC_BVECTOR 0x01
103 // finalize only
104 #define TC_BIGNUM 0x02
105 #define TC_SYMBOL 0x03
106 #define TC_STRING 0x04
107 // finalize & trace
108 #define TC_VECTOR 0x05
109 #define TC_TUPLE 0x06
110 #define TC_VALUES 0x07
111 #define TC_HASHTABLE 0x08
112 #define TC_WEAKHASHTABLE 0x09
113 #define TC_PORT 0x0a
114 // trace only (1)
115 #define TC_CLOSURE 0x0b
116 #define TC_CONT 0x0c
117 #define TC_GLOC 0x0d
118 #define TC_SUBR 0x0e
119 // trace only (2)
120 #define TC_COMPLEX 0x0f
121 #define TC_RATIONAL 0x10
122 #define TC_HEAPENV 0x11
123 #define TC_HEAPCONT 0x12
124 #define TC_WEAKMAPPING 0x13
125 #define TC_ENVIRONMENT 0x14
126 #define TC_SOCKET 0x15
127 #define TC_SHAREDQUEUE 0x16
128 #define TC_SHAREDBAG 0x17
129 #define TC_MASKBITS 0x3f
130
131 const scm_hdr_t scm_hdr_symbol = 0x00a | (TC_SYMBOL << 4);
132 const scm_hdr_t scm_hdr_string = 0x00a | (TC_STRING << 4);
133 const scm_hdr_t scm_hdr_bignum = 0x00a | (TC_BIGNUM << 4);
134 const scm_hdr_t scm_hdr_flonum = 0x00a | (TC_FLONUM << 4);
135 const scm_hdr_t scm_hdr_cont = 0x00a | (TC_CONT << 4);
136 const scm_hdr_t scm_hdr_closure = 0x00a | (TC_CLOSURE << 4);
137 const scm_hdr_t scm_hdr_subr = 0x00a | (TC_SUBR << 4);
138 const scm_hdr_t scm_hdr_vector = 0x00a | (TC_VECTOR << 4);
139 const scm_hdr_t scm_hdr_port = 0x00a | (TC_PORT << 4);
140 const scm_hdr_t scm_hdr_values = 0x00a | (TC_VALUES << 4);
141 const scm_hdr_t scm_hdr_hashtable = 0x00a | (TC_HASHTABLE << 4);
142 const scm_hdr_t scm_hdr_complex = 0x00a | (TC_COMPLEX << 4);
143 const scm_hdr_t scm_hdr_rational = 0x00a | (TC_RATIONAL << 4);
144 const scm_hdr_t scm_hdr_heapenv = 0x00a | (TC_HEAPENV << 4); // enclose heap environment
145 const scm_hdr_t scm_hdr_heapcont = 0x00a | (TC_HEAPCONT << 4); // enclose heap continuation
146 const scm_hdr_t scm_hdr_environment = 0x00a | (TC_ENVIRONMENT << 4);
147 const scm_hdr_t scm_hdr_gloc = 0x00a | (TC_GLOC << 4);
148 const scm_hdr_t scm_hdr_tuple = 0x00a | (TC_TUPLE << 4);
149 const scm_hdr_t scm_hdr_weakmapping = 0x00a | (TC_WEAKMAPPING << 4);
150 const scm_hdr_t scm_hdr_weakhashtable = 0x00a | (TC_WEAKHASHTABLE << 4);
151 const scm_hdr_t scm_hdr_bvector = 0x00a | (TC_BVECTOR << 4);
152 const scm_hdr_t scm_hdr_socket = 0x00a | (TC_SOCKET << 4);
153 const scm_hdr_t scm_hdr_sharedqueue = 0x00a | (TC_SHAREDQUEUE << 4);
154 const scm_hdr_t scm_hdr_sharedbag = 0x00a | (TC_SHAREDBAG << 4);
155
156 #define HDR_TYPE_MASKBITS 0x3ff
157
158 struct scm_pair_rec_t;
159 struct scm_symbol_rec_t;
160 struct scm_string_rec_t;
161 struct scm_flonum_rec_t;
162 struct scm_cont_rec_t;
163 struct scm_closure_rec_t;
164 struct scm_subr_rec_t;
165 struct scm_vector_rec_t;
166 struct scm_port_rec_t;
167 struct scm_values_rec_t;
168 struct scm_hashtable_rec_t;
169 struct scm_bignum_rec_t;
170 struct scm_complex_rec_t;
171 struct scm_rational_rec_t;
172 struct scm_environment_rec_t;
173 struct scm_gloc_rec_t;
174 struct scm_tuple_rec_t;
175 struct scm_weakmapping_rec_t;
176 struct scm_weakhashtable_rec_t;
177 struct scm_bvector_rec_t;
178 struct scm_socket_rec_t;
179 struct scm_sharedqueue_rec_t;
180 struct scm_sharedbag_rec_t;
181
182 typedef scm_pair_rec_t* scm_pair_t;
183 typedef scm_symbol_rec_t* scm_symbol_t;
184 typedef scm_string_rec_t* scm_string_t;
185 typedef scm_flonum_rec_t* scm_flonum_t;
186 typedef scm_cont_rec_t* scm_cont_t;
187 typedef scm_closure_rec_t* scm_closure_t;
188 typedef scm_subr_rec_t* scm_subr_t;
189 typedef scm_vector_rec_t* scm_vector_t;
190 typedef scm_port_rec_t* scm_port_t;
191 typedef scm_values_rec_t* scm_values_t;
192 typedef scm_hashtable_rec_t* scm_hashtable_t;
193 typedef scm_bignum_rec_t* scm_bignum_t;
194 typedef scm_complex_rec_t* scm_complex_t;
195 typedef scm_rational_rec_t* scm_rational_t;
196 typedef scm_environment_rec_t* scm_environment_t;
197 typedef scm_gloc_rec_t* scm_gloc_t;
198 typedef scm_tuple_rec_t* scm_tuple_t;
199 typedef scm_weakmapping_rec_t* scm_weakmapping_t;
200 typedef scm_weakhashtable_rec_t* scm_weakhashtable_t;
201 typedef scm_bvector_rec_t* scm_bvector_t;
202 typedef scm_socket_rec_t* scm_socket_t;
203 typedef scm_sharedqueue_rec_t* scm_sharedqueue_t;
204 typedef scm_sharedbag_rec_t* scm_sharedbag_t;
205
206 struct vm_cont_rec_t;
207 struct vm_env_rec_t;
208
209 typedef vm_cont_rec_t* vm_cont_t;
210 typedef vm_env_rec_t* vm_env_t;
211
212 typedef scm_obj_t (*subr_proc_t)(VM *, int argc, scm_obj_t argv[]);
213 typedef uint32_t (*hash_proc_t)(scm_obj_t obj, uint32_t bound);
214 typedef bool (*equiv_proc_t)(scm_obj_t obj1, scm_obj_t obj2);
215
216 #define OBJECT_ALIGNED(x) struct DECLSPEC(align(OBJECT_DATUM_ALIGN)) x
217 #define END ATTRIBUTE(aligned(OBJECT_DATUM_ALIGN))
218
OBJECT_ALIGNED(scm_pair_rec_t)219 OBJECT_ALIGNED(scm_pair_rec_t) {
220 scm_obj_t car;
221 scm_obj_t cdr;
222 } END;
223
OBJECT_ALIGNED(scm_symbol_rec_t)224 OBJECT_ALIGNED(scm_symbol_rec_t) {
225 scm_hdr_t hdr;
226 char* name; // uninterned symbol contains <prefix-size> after '\0'
227 } END;
228
OBJECT_ALIGNED(scm_string_rec_t)229 OBJECT_ALIGNED(scm_string_rec_t) {
230 scm_hdr_t hdr;
231 int size;
232 char* name;
233 } END;
234
OBJECT_ALIGNED(scm_flonum_rec_t)235 OBJECT_ALIGNED(scm_flonum_rec_t) {
236 scm_hdr_t hdr;
237 double value;
238 } END;
239
OBJECT_ALIGNED(scm_cont_rec_t)240 OBJECT_ALIGNED(scm_cont_rec_t) {
241 scm_hdr_t hdr;
242 scm_obj_t wind_rec;
243 void* cont;
244 } END;
245
OBJECT_ALIGNED(scm_closure_rec_t)246 OBJECT_ALIGNED(scm_closure_rec_t) {
247 scm_hdr_t hdr;
248 scm_obj_t doc;
249 void* env;
250 void* code;
251 } END;
252
OBJECT_ALIGNED(scm_subr_rec_t)253 OBJECT_ALIGNED(scm_subr_rec_t) {
254 scm_hdr_t hdr;
255 subr_proc_t adrs;
256 scm_obj_t doc;
257 #if PROFILE_SUBR
258 uint64_t c_push;
259 uint64_t c_load;
260 uint64_t c_apply;
261 #endif
262 } END;
263
OBJECT_ALIGNED(scm_vector_rec_t)264 OBJECT_ALIGNED(scm_vector_rec_t) {
265 scm_hdr_t hdr;
266 int count;
267 scm_obj_t* elts;
268 } END;
269
OBJECT_ALIGNED(scm_values_rec_t)270 OBJECT_ALIGNED(scm_values_rec_t) {
271 scm_hdr_t hdr;
272 scm_obj_t* elts;
273 } END;
274
OBJECT_ALIGNED(scm_tuple_rec_t)275 OBJECT_ALIGNED(scm_tuple_rec_t) {
276 scm_hdr_t hdr;
277 scm_obj_t* elts;
278 } END;
279
OBJECT_ALIGNED(scm_bvector_rec_t)280 OBJECT_ALIGNED(scm_bvector_rec_t) {
281 scm_hdr_t hdr;
282 int count;
283 uint8_t* elts;
284 } END;
285
OBJECT_ALIGNED(scm_weakmapping_rec_t)286 OBJECT_ALIGNED(scm_weakmapping_rec_t) {
287 scm_hdr_t hdr;
288 scm_obj_t key;
289 scm_obj_t value;
290 } END;
291
OBJECT_ALIGNED(scm_port_rec_t)292 OBJECT_ALIGNED(scm_port_rec_t) {
293 scm_hdr_t hdr;
294 mutex_t lock;
295 scm_obj_t handlers;
296 scm_obj_t bytes;
297 uint8_t lookahead[PORT_LOOKAHEAD_SIZE];
298 int lookahead_size;
299 uint8_t* buf;
300 uint8_t* buf_head;
301 uint8_t* buf_tail;
302 int buf_size;
303 int buf_state;
304 off64_t mark;
305 int line;
306 int column;
307 fd_t fd;
308 scm_obj_t name;
309 scm_obj_t transcoder;
310 uint8_t codec;
311 uint8_t eol_style;
312 uint8_t error_handling_mode;
313 uint8_t file_options;
314 uint8_t buffer_mode;
315 uint8_t type;
316 uint8_t subtype;
317 uint8_t direction;
318 bool force_sync;
319 bool bom_le;
320 bool bom_be;
321 bool track_line_column;
322 bool opened;
323 } END;
324
OBJECT_ALIGNED(hashtable_rec_t)325 OBJECT_ALIGNED(hashtable_rec_t) {
326 int capacity;
327 int used;
328 int live;
329 scm_obj_t elts[1]; // [ key ... val ... ]
330 } END;
331
OBJECT_ALIGNED(scm_hashtable_rec_t)332 OBJECT_ALIGNED(scm_hashtable_rec_t) {
333 scm_hdr_t hdr;
334 mutex_t lock;
335 int type;
336 hash_proc_t hash;
337 equiv_proc_t equiv;
338 hashtable_rec_t* datum; // [ key ... val ... ]
339 scm_obj_t handlers;
340 } END;
341
OBJECT_ALIGNED(weakhashtable_rec_t)342 OBJECT_ALIGNED(weakhashtable_rec_t) {
343 int capacity;
344 int used;
345 int live;
346 scm_obj_t elts[1]; // [ key ... val ... ]
347 } END;
348
OBJECT_ALIGNED(scm_weakhashtable_rec_t)349 OBJECT_ALIGNED(scm_weakhashtable_rec_t) {
350 scm_hdr_t hdr;
351 mutex_t lock;
352 weakhashtable_rec_t* datum; // [ weak-mapping ... ]
353 } END;
354
OBJECT_ALIGNED(scm_bignum_rec_t)355 OBJECT_ALIGNED(scm_bignum_rec_t) {
356 scm_hdr_t hdr;
357 digit_t* elts;
358 } END;
359
OBJECT_ALIGNED(scm_complex_rec_t)360 OBJECT_ALIGNED(scm_complex_rec_t) {
361 scm_hdr_t hdr;
362 scm_obj_t imag;
363 scm_obj_t real;
364 } END;
365
OBJECT_ALIGNED(scm_rational_rec_t)366 OBJECT_ALIGNED(scm_rational_rec_t) {
367 scm_hdr_t hdr;
368 scm_obj_t nume;
369 scm_obj_t deno;
370 } END;
371
OBJECT_ALIGNED(scm_environment_rec_t)372 OBJECT_ALIGNED(scm_environment_rec_t) {
373 scm_hdr_t hdr;
374 scm_hashtable_t variable; // key:symbol value:gloc
375 scm_hashtable_t macro;
376 scm_string_t name;
377 } END;
378
OBJECT_ALIGNED(scm_gloc_rec_t)379 OBJECT_ALIGNED(scm_gloc_rec_t) {
380 scm_hdr_t hdr;
381 scm_obj_t value;
382 scm_obj_t variable; // for error message
383 #if GLOC_DEBUG_INFO
384 scm_obj_t environment;
385 #endif
386 } END;
387
OBJECT_ALIGNED(scm_socket_rec_t)388 OBJECT_ALIGNED(scm_socket_rec_t) {
389 scm_hdr_t hdr;
390 mutex_t lock;
391 int mode;
392 int fd;
393 int family;
394 int socktype;
395 int protocol;
396 int addrlen;
397 struct sockaddr_storage addr;
398 } END;
399
OBJECT_ALIGNED(scm_sharedqueue_rec_t)400 OBJECT_ALIGNED(scm_sharedqueue_rec_t) {
401 scm_hdr_t hdr;
402 fifo_buffer_t buf;
403 queue_t<intptr_t> queue;
404 } END;
405
406 struct sharedbag_slot_t {
407 char* key;
408 fifo_buffer_t buf;
409 queue_t<intptr_t> queue;
410 };
411
OBJECT_ALIGNED(scm_sharedbag_rec_t)412 OBJECT_ALIGNED(scm_sharedbag_rec_t) {
413 scm_hdr_t hdr;
414 mutex_t lock;
415 int capacity;
416 int depth;
417 sharedbag_slot_t** datum;
418 } END;
419
420 #undef OBJECT_ALIGNED
421 #undef END
422
423 struct vm_cont_rec_t { // record size is variable
424 //scm_obj_t args[argc];
425 scm_obj_t trace;
426 scm_obj_t* fp;
427 scm_obj_t pc;
428 void* env;
429 void* up; // 'm_cont' and 'up' point here
430 };
431
432 struct vm_env_rec_t { // record size is variable
433 //scm_obj_t vars[count];
434 intptr_t count;
435 void* up; // 'm_env' and 'up' point here
436 };
437
438 #define HEAPFORWARDPTR(obj) ((intptr_t)(obj) & (~0x7))
439 #define HEAPFORWARDPTRP(obj) (((intptr_t)(obj) & 0x7) == 0x6)
440 #define MAKEHEAPFORWARDPTR(obj) ((intptr_t)(obj) | 0x6)
441
442 #define VMINSTP(obj) (((intptr_t)(obj) & 0x7) == 0x4)
443 #define MAKEVMINST(obj) ((scm_inst_t)((intptr_t)(obj) | 0x4))
444
445 #define FIXNUM_MAX (INTPTR_MAX / 2)
446 #define FIXNUM_MIN (INTPTR_MIN / 2)
447 #if ARCH_LP64
448 #define FIXNUM_BITS (64 - 1)
449 #else
450 #define FIXNUM_BITS (32 - 1)
451 #endif
452
453 #define FIXNUM(obj) ((intptr_t)(obj) >> 1)
454 #define CHAR(obj) ((uintptr_t)(obj) >> 8)
455 #define FLONUM(obj) (((scm_flonum_t)obj)->value)
456 #define BITS(obj) ((uintptr_t)(obj))
457 #define HDR(obj) (*(scm_hdr_t*)(obj))
458
459 #define BOOLP(obj) (((obj) == scm_true) | ((obj) == scm_false))
460 #define FIXNUMP(obj) ((BITS(obj) & 0x1))
461 #define CELLP(obj) ((BITS(obj) & 0x7) == 0)
462 #define CHARP(obj) ((BITS(obj) & 0xff) == 0x02)
463 #define PAIRP(obj) (CELLP(obj) && (HDR(obj) & 0xf) != 0xa)
464 #define FLONUMP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_flonum)
465 #define BVECTORP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_bvector)
466 #define BIGNUMP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_bignum)
467 #define SYMBOLP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_symbol)
468 #define STRINGP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_string)
469 #define VECTORP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_vector)
470 #define TUPLEP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_tuple)
471 #define VALUESP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_values)
472 #define HASHTABLEP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_hashtable)
473 #define WEAKHASHTABLEP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_weakhashtable)
474 #define PORTP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_port)
475 #define CLOSUREP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_closure)
476 #define CONTP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_cont)
477 #define GLOCP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_gloc)
478 #define SUBRP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_subr)
479 #define COMPLEXP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_complex)
480 #define RATIONALP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_rational)
481 #define HEAPENVP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_heapenv)
482 #define HEAPCONTP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_heapcont)
483 #define WEAKMAPPINGP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_weakmapping)
484 #define ENVIRONMENTP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_environment)
485 #define SOCKETP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_socket)
486 #define SHAREDQUEUEP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_sharedqueue)
487 #define SHAREDBAGP(obj) (CELLP(obj) && (HDR(obj) & HDR_TYPE_MASKBITS) == scm_hdr_sharedbag)
488
489 #define HDR_SYMBOL_INHERENT_SHIFT 11
490 #define HDR_SYMBOL_UNINTERNED_SHIFT 10
491 #define HDR_SYMBOL_CODE_SHIFT 12
492 #define HDR_SYMBOL_SIZE_SHIFT 20
493 #define HDR_STRING_LITERAL_SHIFT 11
494 #define HDR_STRING_TYPE_SHIFT 12
495 #define HDR_VALUES_COUNT_SHIFT 16
496 #define HDR_TUPLE_COUNT_SHIFT 16
497 #define HDR_HEAPENV_SIZE_SHIFT 16
498 #define HDR_HEAPCONT_SIZE_SHIFT 16
499 #define HDR_HASHTABLE_SHARED_SHIFT 10
500 #define HDR_HASHTABLE_IMMUTABLE_SHIFT 11
501 #define HDR_WEAKHASHTABLE_SHARED_SHIFT 10
502 #define HDR_WEAKHASHTABLE_IMMUTABLE_SHIFT 11
503 #define HDR_BVECTOR_MAPPING_SHIFT 10
504 #define HDR_BIGNUM_SIGN_SHIFT 10
505 #define HDR_BIGNUM_COUNT_SHIFT 16
506 #define HDR_CLOSURE_ARGS_SHIFT 16
507 #define HDR_FLONUM_32BIT_SHIFT 11
508 #define HDR_VECTOR_LITERAL_SHIFT 11
509 #define HDR_BVECTOR_LITERAL_SHIFT 11
510
511 #define HDR_TC(hdr) (((hdr) >> 4) & TC_MASKBITS)
512 #define HDR_CLOSURE_ARGS(hdr) (((intptr_t)(hdr)) >> HDR_CLOSURE_ARGS_SHIFT)
513 #define HDR_STRING_LITERAL(hdr) (((hdr) >> HDR_STRING_LITERAL_SHIFT) & 1)
514 #define HDR_STRING_TYPE(hdr) (((hdr) >> HDR_STRING_TYPE_SHIFT) & 1)
515 #define HDR_VALUES_COUNT(hdr) (((uintptr_t)(hdr)) >> HDR_VALUES_COUNT_SHIFT)
516 #define HDR_TUPLE_COUNT(hdr) (((uintptr_t)(hdr)) >> HDR_TUPLE_COUNT_SHIFT)
517 #define HDR_HEAPENV_SIZE(hdr) (((uintptr_t)(hdr)) >> HDR_HEAPENV_SIZE_SHIFT)
518 #define HDR_HEAPCONT_SIZE(hdr) (((uintptr_t)(hdr)) >> HDR_HEAPCONT_SIZE_SHIFT)
519 #define HDR_BIGNUM_COUNT(hdr) (((uintptr_t)(hdr)) >> HDR_BIGNUM_COUNT_SHIFT)
520 #define HDR_SYMBOL_SIZE(hdr) (((uintptr_t)(hdr)) >> HDR_SYMBOL_SIZE_SHIFT)
521 #define HDR_SYMBOL_CODE(hdr) (((hdr) >> HDR_SYMBOL_CODE_SHIFT) & 0xff)
522 #define HDR_BVECTOR_MAPPING(hdr) (((hdr) >> HDR_BVECTOR_MAPPING_SHIFT) & 1)
523 #define HDR_HASHTABLE_SHARED(hdr) (((hdr) >> HDR_HASHTABLE_SHARED_SHIFT) & 1)
524 #define HDR_HASHTABLE_IMMUTABLE(hdr) (((hdr) >> HDR_HASHTABLE_IMMUTABLE_SHIFT) & 1)
525 #define HDR_WEAKHASHTABLE_SHARED(hdr) (((hdr) >> HDR_WEAKHASHTABLE_SHARED_SHIFT) & 1)
526 #define HDR_WEAKHASHTABLE_IMMUTABLE(hdr) (((hdr) >> HDR_WEAKHASHTABLE_IMMUTABLE_SHIFT) & 1)
527 #define HDR_BIGNUM_SIGN(hdr) (((hdr) >> HDR_BIGNUM_SIGN_SHIFT) & 0x03)
528 #define HDR_FLONUM_32BIT(hdr) (((hdr) >> HDR_FLONUM_32BIT_SHIFT) & 1)
529 #define HDR_VECTOR_LITERAL(hdr) (((hdr) >> HDR_VECTOR_LITERAL_SHIFT) & 1)
530 #define HDR_BVECTOR_LITERAL(hdr) (((hdr) >> HDR_BVECTOR_LITERAL_SHIFT) & 1)
531
532 #define HDR_SYMBOL_INHERENT_BIT ((uintptr_t)1 << HDR_SYMBOL_INHERENT_SHIFT)
533 #define HDR_SYMBOL_UNINTERNED_BIT ((uintptr_t)1 << HDR_SYMBOL_UNINTERNED_SHIFT)
534
535 #define OPCODESYMBOLP(obj) (CELLP(obj) \
536 && ((HDR(obj) & 0xfff) == (scm_hdr_symbol | HDR_SYMBOL_INHERENT_BIT)) \
537 && (HDR_SYMBOL_CODE(HDR(obj)) < VMOP_INSTRUCTION_COUNT))
538 #define UNINTERNEDSYMBOLP(obj) (CELLP(obj) \
539 && ((HDR(obj) & 0xfff) == (scm_hdr_symbol | HDR_SYMBOL_UNINTERNED_BIT)))
540 #define BOTHFLONUMP(x, y) (CELLP((intptr_t)(x) | (intptr_t)(y)) \
541 && ((((scm_flonum_t)(x))->hdr == scm_hdr_flonum) & (((scm_flonum_t)(y))->hdr == scm_hdr_flonum)))
542
543 #define STRING_TYPE_UNKNOWN 0x0
544 #define STRING_TYPE_ASCII 0x1
545 #define STRING_TYPE_UTF8 0x2
546
547 #define CAR(obj) (((scm_pair_t)(obj))->car)
548 #define CDR(obj) (((scm_pair_t)(obj))->cdr)
549 #define CAAR(obj) (CAR(CAR(obj)))
550 #define CADR(obj) (CAR(CDR(obj)))
551 #define CDAR(obj) (CDR(CAR(obj)))
552 #define CDDR(obj) (CDR(CDR(obj)))
553 #define CADDR(obj) (CAR(CDR(CDR(obj))))
554 #define CADAR(obj) (CAR(CDR(CAR(obj))))
555 #define CDDDR(obj) (CDR(CDR(CDR(obj))))
556
557 #define MAKEFIXNUM(n) ((scm_fixnum_t)(((intptr_t)(n) << 1) + 1))
558 #define MAKECHAR(n) ((scm_char_t)(((uintptr_t)(n) << 8) + 0x02))
559 #define MAKEBITS(n, shift) (((intptr_t)(n)) << shift)
560
561 #define HASH_BUSY_THRESHOLD(n) ((n) - ((n) >> 3)) // 87.5%
562 #define HASH_DENSE_THRESHOLD(n) ((n) - ((n) >> 2)) // 75%
563 #define HASH_SPARSE_THRESHOLD(n) ((n) >> 2) // 25%
564 #define HASH_IMMUTABLE_SIZE(n) ((n) + ((n) >> 3)) // 112.5%
565 #define HASH_MUTABLE_SIZE(n) ((n) + ((n) >> 1) + ((n) >> 2)) // 175%
566 #define HASH_BOUND_MAX UINT32_MAX
567
568 #if ARCH_LP64
569 #define OBJECT_SLAB_SIZE (8192L)
570 #define OBJECT_SLAB_SIZE_SHIFT 13
571 #define OBJECT_SLAB_THRESHOLD (OBJECT_SLAB_SIZE / 8) // m_shared[] and m_atomic[] in ObjectFactory in effect this value
572 #define VM_STACK_BYTESIZE (8192L)
573 #else
574 #define OBJECT_SLAB_SIZE (4096L)
575 #define OBJECT_SLAB_SIZE_SHIFT 12
576 #define OBJECT_SLAB_THRESHOLD (OBJECT_SLAB_SIZE / 4) // m_shared[] and m_atomic[] in ObjectFactory in effect this value
577 #define VM_STACK_BYTESIZE (4096L)
578 #endif
579 #define VM_STACK_BUSY_THRESHOLD(n) ((n) - ((n) >> 2)) // 75%
580
581 #define IDENTIFIER_RENAME_DELIMITER '`'
582 #define IDENTIFIER_LIBRARY_SUFFIX '\''
583 #define IDENTIFIER_LIBRARY_INFIX '.'
584 #define IDENTIFIER_PRIMITIVE_PREFIX '.'
585 #define IDENTIFIER_CSTUB_MARK '@'
586
587 #define MAX_READ_SYMBOL_LENGTH 256
588 #define MAX_READ_STRING_LENGTH 2048
589 #define MAX_SOURCE_COLUMN 1024
590
591 struct reader_exception_t {
592 scm_string_t m_message;
reader_exception_treader_exception_t593 reader_exception_t(scm_string_t message) { m_message = message; }
594 };
595
596 struct io_exception_t {
597 int m_operation;
598 int m_err;
599 const char* m_message;
io_exception_tio_exception_t600 io_exception_t(int opration, int err) { m_operation = opration; m_err = err; m_message = strerror(err); }
io_exception_tio_exception_t601 io_exception_t(int opration, const char* message) { m_operation = opration; m_err = 0; m_message = message; }
602 };
603
604 struct io_codec_exception_t {
605 int m_operation;
606 scm_obj_t m_ch;
607 const char* m_message;
io_codec_exception_tio_codec_exception_t608 io_codec_exception_t(int opration, const char* message, scm_obj_t ch) { m_operation = opration; m_ch = ch; m_message = message; }
609 };
610
611 struct vm_exit_t {
612 int m_code;
vm_exit_tvm_exit_t613 vm_exit_t(int code) { m_code = code; }
614 };
615
616 struct vm_exception_t {
vm_exception_tvm_exception_t617 vm_exception_t() {}
618 };
619
620 struct vm_escape_t {
vm_escape_tvm_escape_t621 vm_escape_t() {}
622 };
623
624 struct vm_continue_t {
vm_continue_tvm_continue_t625 vm_continue_t() {}
626 };
627
628 inline const char*
get_tuple_type_name(scm_obj_t obj)629 get_tuple_type_name(scm_obj_t obj)
630 {
631 if (TUPLEP(obj)) {
632 scm_tuple_t tuple = (scm_tuple_t)obj;
633 scm_obj_t e0 = tuple->elts[0];
634 if (SYMBOLP(e0)) {
635 scm_symbol_t type = (scm_symbol_t)e0;
636 if (strncmp(type->name, "type:", 5) == 0) return type->name + 5;
637 }
638 }
639 return NULL;
640 }
641
642 #endif
643