1 /*  sexp.h -- header for sexp library                         */
2 /*  Copyright (c) 2009-2015 Alex Shinn.  All rights reserved. */
3 /*  BSD-style license: http://synthcode.com/license.txt       */
4 
5 #ifndef SEXP_H
6 #define SEXP_H
7 
8 #ifdef __cplusplus
9 extern "C" {
10 #define SEXP_FLEXIBLE_ARRAY [1]
11 #else
12 #define SEXP_FLEXIBLE_ARRAY []
13 #endif
14 
15 #define SEXP_MODULE_PATH_VAR "CHIBI_MODULE_PATH"
16 #define SEXP_NO_SYSTEM_PATH_VAR "CHIBI_IGNORE_SYSTEM_PATH"
17 
18 #include "chibi/features.h"
19 #include "chibi/install.h"
20 
21 #ifdef _WIN32
22 #include <windows.h>
23 #include <errno.h>
24 #define sexp_isalpha(x) (isalpha(x))
25 #define sexp_isxdigit(x) (isxdigit(x))
26 #define sexp_isdigit(x) (isdigit(x))
27 #define sexp_tolower(x) (tolower(x))
28 #define sexp_toupper(x) (toupper(x))
29 #define SEXP_USE_POLL_PORT 0
30 #define sexp_poll_input(ctx, port) usleep(SEXP_POLL_SLEEP_TIME)
31 #define sexp_poll_output(ctx, port) usleep(SEXP_POLL_SLEEP_TIME)
32 #else
33 #if SEXP_USE_DL
34 #include <dlfcn.h>
35 #endif
36 #ifndef PLAN9
37 #include <errno.h>
38 #include <unistd.h>
39 #define SEXP_USE_POLL_PORT 1
40 #define sexp_poll_input(ctx, port) sexp_poll_port(ctx, port, 1)
41 #define sexp_poll_output(ctx, port) sexp_poll_port(ctx, port, 0)
42 #else
43 #define SEXP_USE_POLL_PORT 0
44 #define sexp_poll_input(ctx, port) sleep(SEXP_POLL_SLEEP_TIME_MS)
45 #define sexp_poll_output(ctx, port) sleep(SEXP_POLL_SLEEP_TIME_MS)
46 #endif
47 #if SEXP_USE_GREEN_THREADS
48 #include <sys/time.h>
49 #include <sys/select.h>
50 #include <fcntl.h>
51 #include <poll.h>
52 #endif
53 #define sexp_isalpha(x) (isalpha(x))
54 #define sexp_isxdigit(x) (isxdigit(x))
55 #define sexp_isdigit(x) (isdigit(x))
56 #define sexp_tolower(x) (tolower(x))
57 #define sexp_toupper(x) (toupper(x))
58 #endif
59 
60 #if SEXP_USE_GC_FILE_DESCRIPTORS
61 #define sexp_out_of_file_descriptors() (errno == EMFILE)
62 #else
63 #define sexp_out_of_file_descriptors() (0)
64 #endif
65 
66 #ifdef __GNUC__
67 #define SEXP_NO_WARN_UNUSED __attribute__((unused))
68 #else
69 #define SEXP_NO_WARN_UNUSED
70 #endif
71 
72 #ifdef PLAN9
73 #include <u.h>
74 #include <libc.h>
75 #include <fcall.h>
76 #include <thread.h>
77 #include <9p.h>
78 typedef unsigned long size_t;
79 typedef long long off_t;
80 #define STRINGIFY(x) #x
81 #define TOSTRING(x) STRINGIFY(x)
82 #define exit(x)           exits(TOSTRING(x))
83 #define fabsl          fabs
84 #define M_LN10         2.30258509299404568402  /* log_e 10 */
85 #define FLT_RADIX 2
86 #define isfinite(x) !(isNaN(x) || isInf(x,0))
87 typedef u32int uint32_t;
88 typedef s32int int32_t;
89 typedef u64int uint64_t;
90 typedef s64int int64_t;
91 #else
92 #include <stddef.h>
93 #include <stdlib.h>
94 #include <string.h>
95 #include <stdarg.h>
96 #if !(defined _WIN32) || defined(__CYGWIN__)
97 #include <sys/socket.h>
98 #endif
99 #include <sys/stat.h>
100 #include <sys/types.h>
101 #define _REENTRANT 1
102 #include <math.h>
103 #if SEXP_USE_FLONUMS
104 #include <float.h>
105 #include <limits.h>
106 #endif
107 #endif
108 
109 #if SEXP_USE_TRACK_ALLOC_BACKTRACE
110 #include <execinfo.h>
111 #endif
112 
113 #include <ctype.h>
114 #include <stdio.h>
115 
116 /* tagging system
117  *   bits end in     1:  fixnum
118  *                  00:  pointer
119  *                 010:  string cursor (optional)
120  *                0110:  immediate symbol (optional)
121  *            00001110:  immediate flonum (optional)
122  *            00011110:  char
123  *            00101110:  reader label (optional)
124  *            00111110:  unique immediate (NULL, TRUE, FALSE)
125  */
126 
127 #define SEXP_FIXNUM_BITS 1
128 #define SEXP_POINTER_BITS 2
129 #define SEXP_STRING_CURSOR_BITS 3
130 #define SEXP_IMMEDIATE_BITS 4
131 #define SEXP_EXTENDED_BITS 8
132 
133 #define SEXP_FIXNUM_MASK ((1<<SEXP_FIXNUM_BITS)-1)
134 #define SEXP_POINTER_MASK ((1<<SEXP_POINTER_BITS)-1)
135 #define SEXP_STRING_CURSOR_MASK ((1<<SEXP_STRING_CURSOR_BITS)-1)
136 #define SEXP_IMMEDIATE_MASK ((1<<SEXP_IMMEDIATE_BITS)-1)
137 #define SEXP_EXTENDED_MASK ((1<<SEXP_EXTENDED_BITS)-1)
138 
139 #define SEXP_POINTER_TAG 0
140 #define SEXP_FIXNUM_TAG 1
141 #define SEXP_STRING_CURSOR_TAG 2
142 #define SEXP_ISYMBOL_TAG 6
143 #define SEXP_IFLONUM_TAG 14
144 #define SEXP_CHAR_TAG 30
145 #define SEXP_READER_LABEL_TAG 46
146 #define SEXP_EXTENDED_TAG 62
147 
148 #ifndef SEXP_POINTER_MAGIC
149 #define SEXP_POINTER_MAGIC 0xFDCA9764uL /* arbitrary */
150 #endif
151 
152 #if SEXP_USE_HASH_SYMS
153 #define SEXP_SYMBOL_TABLE_SIZE 389
154 #else
155 #define SEXP_SYMBOL_TABLE_SIZE 1
156 #endif
157 
158 enum sexp_types {
159   SEXP_OBJECT,
160   SEXP_TYPE,
161   SEXP_FIXNUM,
162   SEXP_NUMBER,
163   SEXP_CHAR,
164   SEXP_BOOLEAN,
165   SEXP_PAIR,
166   SEXP_SYMBOL,
167   SEXP_BYTES,
168   SEXP_STRING,
169   SEXP_VECTOR,
170   SEXP_FLONUM,
171   SEXP_BIGNUM,
172 #if SEXP_USE_STABLE_ABI || SEXP_USE_RATIOS
173   SEXP_RATIO,
174 #endif
175 #if SEXP_USE_STABLE_ABI || SEXP_USE_COMPLEX
176   SEXP_COMPLEX,
177 #endif
178 #if SEXP_USE_STABLE_ABI || SEXP_USE_DISJOINT_STRING_CURSORS
179   SEXP_STRING_CURSOR,
180 #endif
181   SEXP_IPORT,
182   SEXP_OPORT,
183   SEXP_FILENO,
184   SEXP_EXCEPTION,
185   SEXP_PROCEDURE,
186   SEXP_MACRO,
187   SEXP_SYNCLO,
188   SEXP_ENV,
189   SEXP_BYTECODE,
190   SEXP_CORE,
191 #if SEXP_USE_STABLE_ABI || SEXP_USE_DL
192   SEXP_DL,
193 #endif
194   SEXP_OPCODE,
195   SEXP_LAMBDA,
196   SEXP_CND,
197   SEXP_REF,
198   SEXP_SET,
199   SEXP_SET_SYN,
200   SEXP_SEQ,
201   SEXP_LIT,
202   SEXP_STACK,
203   SEXP_CONTEXT,
204   SEXP_CPOINTER,
205   SEXP_UNIFORM_VECTOR,
206 #if SEXP_USE_STABLE_ABI || SEXP_USE_AUTO_FORCE
207   SEXP_PROMISE,
208 #endif
209 #if SEXP_USE_STABLE_ABI || SEXP_USE_WEAK_REFERENCES
210   SEXP_EPHEMERON,
211 #endif
212   SEXP_NUM_CORE_TYPES
213 };
214 
215 #if !SEXP_USE_DISJOINT_STRING_CURSORS
216 #define SEXP_STRING_CURSOR SEXP_FIXNUM
217 #endif
218 
219 #ifdef _WIN32
220 #if SEXP_64_BIT
221 typedef unsigned int sexp_tag_t;
222 typedef unsigned long long sexp_uint_t;
223 typedef long long sexp_sint_t;
224 #define SEXP_PRIdFIXNUM "lld"
225 #else
226 typedef unsigned short sexp_tag_t;
227 typedef unsigned int sexp_uint_t;
228 typedef int sexp_sint_t;
229 #define SEXP_PRIdFIXNUM "d"
230 #endif
231 #define sexp_heap_align(n) sexp_align(n, 5)
232 #define sexp_heap_chunks(n) (sexp_heap_align(n)>>5)
233 #elif SEXP_64_BIT
234 #if PLAN9
235 typedef uintptr sexp_tag_t;
236 typedef uintptr sexp_uint_t;
237 typedef intptr sexp_sint_t;
238 #else
239 typedef unsigned int sexp_tag_t;
240 typedef unsigned long sexp_uint_t;
241 typedef long sexp_sint_t;
242 #endif
243 #define SEXP_PRIdFIXNUM "ld"
244 #define sexp_heap_align(n) sexp_align(n, 5)
245 #define sexp_heap_chunks(n) (sexp_heap_align(n)>>5)
246 #elif defined(__CYGWIN__)
247 typedef unsigned short sexp_tag_t;
248 typedef unsigned int sexp_uint_t;
249 typedef int sexp_sint_t;
250 #define SEXP_PRIdFIXNUM "d"
251 #define sexp_heap_align(n) sexp_align(n, 5)
252 #define sexp_heap_chunks(n) (sexp_heap_align(n)>>5)
253 #elif PLAN9
254 typedef uintptr sexp_tag_t;
255 typedef unsigned int sexp_uint_t;
256 typedef int sexp_sint_t;
257 #define SEXP_PRIdFIXNUM "d"
258 #define sexp_heap_align(n) sexp_align(n, 4)
259 #define sexp_heap_chunks(n) (sexp_heap_align(n)>>4)
260 #else
261 typedef unsigned short sexp_tag_t;
262 typedef unsigned int sexp_uint_t;
263 typedef int sexp_sint_t;
264 #define SEXP_PRIdFIXNUM "d"
265 #define sexp_heap_align(n) sexp_align(n, 4)
266 #define sexp_heap_chunks(n) (sexp_heap_align(n)>>4)
267 #endif
268 
269 /* procedure flags */
270 #define SEXP_PROC_NONE ((sexp_uint_t)0)
271 #define SEXP_PROC_VARIADIC ((sexp_uint_t)1)
272 #define SEXP_PROC_UNUSED_REST ((sexp_uint_t)2)
273 
274 
275 #ifdef SEXP_USE_INTTYPES
276 #ifdef PLAN9
277 #include <ape/stdint.h>
278 #else
279 #include <stdint.h>
280 #endif
281 # ifdef UINT8_MAX
282 #  define SEXP_UINT8_DEFINED 1
283 typedef uint8_t  sexp_uint8_t;
284 # endif
285 # ifdef UINT32_MAX
286 #  define SEXP_UINT32_DEFINED 1
287 typedef uint32_t sexp_uint32_t;
288 typedef int32_t sexp_int32_t;
289 # endif
290 #else
291 # ifdef PLAN9
292 # include <ape/limits.h>
293 # else
294 # include <limits.h>
295 # if SEXP_USE_UNIFORM_VECTOR_LITERALS
296 # ifdef PLAN9
297 # include <ape/stdint.h>
298 # else
299 # include <stdint.h>
300 # endif
301 # endif
302 # endif
303 # if UCHAR_MAX == 255
304 #  define SEXP_UINT8_DEFINED 1
305 typedef unsigned char sexp_uint8_t;
306 # endif
307 # if UINT_MAX == 4294967295U
308 #  define SEXP_UINT32_DEFINED 1
309 typedef unsigned int sexp_uint32_t;
310 typedef int sexp_int32_t;
311 # elif ULONG_MAX == 4294967295UL
312 #  define SEXP_UINT32_DEFINED 1
313 typedef unsigned long sexp_uint32_t;
314 typedef long sexp_int32_t;
315 # elif USHRT_MAX == 4294967295U
316 #  define SEXP_UINT32_DEFINED 1
317 typedef unsigned short sexp_uint32_t;
318 typedef short sexp_int32_t;
319 # endif
320 #endif  /* SEXP_USE_INTTYPES */
321 
322 #if defined(__APPLE__) || defined(_WIN64) || (defined(__CYGWIN__) && __SIZEOF_POINTER__ == 8)
323 #define SEXP_PRIdOFF "lld"
324 #else
325 #define SEXP_PRIdOFF "ld"
326 #endif
327 
328 #if SEXP_USE_LONG_PROCEDURE_ARGS
329 typedef int sexp_proc_num_args_t;
330 #else
331 typedef short sexp_proc_num_args_t;
332 #endif
333 
334 typedef struct sexp_struct *sexp;
335 
336 #define sexp_heap_pad_size(s) (sizeof(struct sexp_heap_t) + (s) + sexp_heap_align(1))
337 #define sexp_free_chunk_size (sizeof(struct sexp_free_list_t))
338 #define sexp_heap_first_block(h) ((sexp)(h->data + sexp_heap_align(sexp_free_chunk_size)))
339 #define sexp_heap_last_block(h) ((sexp)((char*)h->data + h->size - sexp_heap_align(sexp_free_chunk_size)))
340 #define sexp_heap_end(h) ((sexp)((char*)h->data + h->size))
341 
342 #define __HALF_MAX_SIGNED(type) ((type)1 << (sizeof(type)*8-2))
343 #define __MAX_SIGNED(type) (__HALF_MAX_SIGNED(type) - 1 + __HALF_MAX_SIGNED(type))
344 #define __MIN_SIGNED(type) (-1 - __MAX_SIGNED(type))
345 
346 #define SEXP_UINT_T_MAX ((sexp_uint_t)-1)
347 #define SEXP_UINT_T_MIN (0)
348 #define SEXP_SINT_T_MAX __MAX_SIGNED(sexp_sint_t)
349 #define SEXP_SINT_T_MIN __MIN_SIGNED(sexp_sint_t)
350 
351 #define SEXP_MAX_FIXNUM ((((sexp_sint_t)1)<<(sizeof(sexp_sint_t)*8-SEXP_FIXNUM_BITS-1))-1)
352 #define SEXP_MIN_FIXNUM (-SEXP_MAX_FIXNUM-1)
353 
354 #if SEXP_USE_SELF_PARAMETER
355 #define sexp_api_params(self, n) , sexp self, sexp_sint_t n
356 #define sexp_api_pass(self, n) , self, n
357 #else
358 #define sexp_api_params(self, n)
359 #define sexp_api_pass(self, n)
360 #endif
361 
362 /* procedure types */
363 typedef sexp (*sexp_proc1) (sexp, sexp, sexp_sint_t);
364 typedef sexp (*sexp_proc2) (sexp, sexp, sexp_sint_t, sexp);
365 typedef sexp (*sexp_proc3) (sexp, sexp, sexp_sint_t, sexp, sexp);
366 typedef sexp (*sexp_proc4) (sexp, sexp, sexp_sint_t, sexp, sexp, sexp);
367 typedef sexp (*sexp_proc5) (sexp, sexp, sexp_sint_t, sexp, sexp, sexp, sexp);
368 typedef sexp (*sexp_proc6) (sexp, sexp, sexp_sint_t, sexp, sexp, sexp, sexp, sexp);
369 typedef sexp (*sexp_proc7) (sexp, sexp, sexp_sint_t, sexp, sexp, sexp, sexp, sexp, sexp);
370 typedef sexp (*sexp_init_proc)(sexp, sexp, sexp_sint_t, sexp, const char*, const sexp_abi_identifier_t);
371 SEXP_API sexp sexp_init_library(sexp, sexp, sexp_sint_t, sexp, const char*, const sexp_abi_identifier_t);
372 
373 typedef struct sexp_free_list_t *sexp_free_list;
374 struct sexp_free_list_t {
375   sexp_uint_t size;
376   sexp_free_list next;
377 };
378 
379 typedef struct sexp_heap_t *sexp_heap;
380 struct sexp_heap_t {
381   sexp_uint_t size, max_size, chunk_size;
382   sexp_free_list free_list;
383   sexp_heap next;
384   /* note this must be aligned on a proper heap boundary, */
385   /* so we can't just use char data[] */
386   char *data;
387 };
388 
389 struct sexp_gc_var_t {
390   sexp *var;
391 #if SEXP_USE_DEBUG_GC
392   char *name;
393 #endif
394   struct sexp_gc_var_t *next;
395 };
396 
397 struct sexp_library_entry_t {   /* for static builds */
398   const char *name;
399   sexp_init_proc init;
400 };
401 
402 struct sexp_type_struct {
403   sexp name, cpl, slots, getters, setters, id, print, dl, finalize_name;
404   sexp_tag_t tag;
405   short field_base, field_eq_len_base, field_len_base, field_len_off;
406   unsigned short field_len_scale;
407   short size_base, size_off;
408   unsigned short size_scale;
409   short weak_base, weak_len_base, weak_len_off, weak_len_scale, weak_len_extra;
410   short depth;
411   sexp_proc2 finalize;
412 };
413 
414 struct sexp_opcode_struct {
415   sexp name, data, data2, proc, ret_type, arg1_type, arg2_type, arg3_type,
416     argn_type, methods, dl;
417   unsigned char op_class, code, num_args, flags, inverse;
418   sexp_proc1 func;
419 };
420 
421 struct sexp_core_form_struct {
422   char code;
423   sexp name;
424 };
425 
426 struct sexp_mark_stack_ptr_t {
427   sexp *start, *end;
428   struct sexp_mark_stack_ptr_t *prev; /* TODO: remove for allocations on stack */
429 };
430 
431 /* Note this must be kept in sync with the _sexp_type_specs type            */
432 /* registry in sexp.c.  The structure of a sexp type is:                    */
433 /*   [ HEADER [[EQ_FIELDS... ] GC_FIELDS...] [WEAK_FIELDS...] [OTHER...] ]  */
434 /* Thus all sexp's must be contiguous and align at the start of the type.   */
435 /* This is used by the gc, equal? and slot-ref (although only the latter    */
436 /* expects the alignment at the start of the type). */
437 struct sexp_struct {
438   sexp_tag_t tag;
439   char markedp;
440   unsigned int immutablep:1;
441   unsigned int freep:1;
442   unsigned int brokenp:1;
443   unsigned int syntacticp:1;
444 #if SEXP_USE_TRACK_ALLOC_SOURCE
445   const char* source;
446   void* backtrace[SEXP_BACKTRACE_SIZE];
447 #endif
448 #if SEXP_USE_HEADER_MAGIC
449   unsigned int magic;
450 #endif
451   union {
452     /* basic types */
453     double flonum;
454     char flonum_bits[sizeof(double)];  /* for eqv? comparison on flonums */
455     struct sexp_type_struct type;
456     struct {
457       sexp car, cdr;
458       sexp source;
459     } pair;
460     struct {
461       sexp_uint_t length;
462       sexp data SEXP_FLEXIBLE_ARRAY;
463     } vector;
464     struct {
465       sexp_uint_t length;
466       char data SEXP_FLEXIBLE_ARRAY;
467     } bytes;
468     struct {
469       sexp bytes;
470       unsigned char element_type;
471       sexp_sint_t length;
472     } uvector;
473     struct {
474 #if SEXP_USE_PACKED_STRINGS
475 #if SEXP_USE_STRING_INDEX_TABLE
476       sexp charlens;
477 #endif
478       sexp_uint_t length;
479       char data SEXP_FLEXIBLE_ARRAY;
480 #else
481       sexp bytes;
482 #if SEXP_USE_STRING_INDEX_TABLE
483       sexp charlens;
484 #endif
485       sexp_uint_t offset, length;
486 #endif
487     } string;
488     struct {
489       sexp_uint_t length;
490       char data SEXP_FLEXIBLE_ARRAY;
491     } symbol;
492     struct {
493       sexp name;
494       sexp cookie;
495       sexp fd;
496       FILE *stream;
497       char *buf;
498       char openp, bidirp, binaryp, shutdownp, no_closep, sourcep,
499         blockedp, fold_casep;
500       sexp_uint_t offset, line, flags;
501       size_t size;
502     } port;
503     struct {
504       char openp, no_closep;
505       sexp_sint_t fd, count;
506     } fileno;
507     struct {
508       sexp kind, message, irritants, procedure, source, stack_trace;
509     } exception;
510     struct {
511       signed char sign;
512       sexp_uint_t length;
513       sexp_uint_t data SEXP_FLEXIBLE_ARRAY;
514     } bignum;
515     struct {
516       sexp numerator, denominator;
517     } ratio;
518     struct {
519       sexp real, imag;
520     } complex;
521     struct {
522       sexp parent;
523       sexp_uint_t length;
524       void *value;
525       char body SEXP_FLEXIBLE_ARRAY;
526     } cpointer;
527     /* runtime types */
528     struct {
529       sexp parent, lambda, bindings;
530 #if SEXP_USE_STABLE_ABI || SEXP_USE_RENAME_BINDINGS
531       sexp renames;
532 #endif
533     } env;
534     struct {
535       sexp name, literals, source;
536       sexp_uint_t length, max_depth;
537       unsigned char data SEXP_FLEXIBLE_ARRAY;
538     } bytecode;
539     struct {
540       sexp bc, vars;
541       char flags;
542       sexp_proc_num_args_t num_args;
543     } procedure;
544     struct {
545       sexp proc, env, source, aux;
546     } macro;
547     struct {
548       sexp env, free_vars, expr, rename;
549     } synclo;
550     struct {
551       sexp file;
552       void* handle;
553     } dl;
554     struct sexp_opcode_struct opcode;
555     struct sexp_core_form_struct core;
556     /* ast types */
557     struct {
558       sexp name, params, body, defs, locals, flags, fv, sv, ret, types, source;
559     } lambda;
560     struct {
561       sexp test, pass, fail, source;
562     } cnd;
563     struct {
564       sexp var, value, source;
565     } set;
566     struct {
567       sexp var, value, source;
568     } set_syn;
569     struct {
570       sexp name, cell, source;
571     } ref;
572     struct {
573       sexp ls, source;
574     } seq;
575     struct {
576       sexp value, source;
577     } lit;
578     /* compiler state */
579     struct {
580       sexp_uint_t length, top;
581       sexp data SEXP_FLEXIBLE_ARRAY;
582     } stack;
583     struct {
584       sexp stack, env, parent, child,
585         globals, dk, params, proc, name, specific, event, result;
586 #if SEXP_USE_STABLE_ABI || SEXP_USE_DL
587       sexp dl;
588 #endif
589       sexp_heap heap;
590       struct sexp_mark_stack_ptr_t mark_stack[SEXP_MARK_STACK_COUNT];
591       struct sexp_mark_stack_ptr_t *mark_stack_ptr;
592       struct sexp_gc_var_t *saves;
593 #if SEXP_USE_GREEN_THREADS
594       sexp_sint_t refuel;
595       unsigned char* ip;
596       struct timeval tval;
597 #endif
598       char tailp, tracep, timeoutp, waitp, errorp, interruptp;
599       sexp_uint_t last_fp;
600       sexp_uint_t gc_count;
601 #if SEXP_USE_TIME_GC
602       sexp_uint_t gc_usecs;
603 #endif
604 #if SEXP_USE_TRACK_ALLOC_TIMES
605       sexp_uint_t alloc_count, alloc_usecs;
606       double alloc_usecs_sq;
607 #endif
608 #if SEXP_USE_TRACK_ALLOC_SIZES
609       sexp_uint_t alloc_histogram[SEXP_ALLOC_HISTOGRAM_BUCKETS];
610 #endif
611     } context;
612 #if SEXP_USE_STABLE_ABI || SEXP_USE_AUTO_FORCE
613     struct {
614       sexp value;
615       int donep;
616     } promise;
617 #endif
618 #if SEXP_USE_STABLE_ABI || SEXP_USE_WEAK_REFERENCES
619     struct {
620       sexp key, value;
621     } ephemeron;
622 #endif
623   } value;
624 };
625 
626 #define SEXP_MAKE_IMMEDIATE(n)  ((sexp) ((n<<SEXP_EXTENDED_BITS) \
627                                           + SEXP_EXTENDED_TAG))
628 
629 #define SEXP_FALSE  SEXP_MAKE_IMMEDIATE(0) /* 14 0x0e */
630 #define SEXP_TRUE   SEXP_MAKE_IMMEDIATE(1) /* 30 0x1e */
631 #define SEXP_NULL   SEXP_MAKE_IMMEDIATE(2) /* 46 0x2e */
632 #define SEXP_EOF    SEXP_MAKE_IMMEDIATE(3) /* 62 0x3e */
633 #define SEXP_VOID   SEXP_MAKE_IMMEDIATE(4) /* the unspecified value */
634 #define SEXP_UNDEF  SEXP_MAKE_IMMEDIATE(5) /* internal use */
635 #define SEXP_CLOSE  SEXP_MAKE_IMMEDIATE(6) /* internal use */
636 #define SEXP_RAWDOT SEXP_MAKE_IMMEDIATE(7) /* internal use */
637 #define SEXP_STRING_OPORT SEXP_MAKE_IMMEDIATE(8)  /* internal use */
638 #define SEXP_TRAMPOLINE   SEXP_MAKE_IMMEDIATE(9)  /* internal use */
639 #define SEXP_UNCAUGHT     SEXP_MAKE_IMMEDIATE(10) /* internal use */
640 #define SEXP_ABI_ERROR    SEXP_MAKE_IMMEDIATE(11) /* internal use */
641 #if SEXP_USE_OBJECT_BRACE_LITERALS
642 #define SEXP_CLOSE_BRACE  SEXP_MAKE_IMMEDIATE(12) /* internal use */
643 #endif
644 
645 #if SEXP_USE_LIMITED_MALLOC
646 void* sexp_malloc(size_t size);
647 void sexp_free(void* ptr);
648 #else
649 #define sexp_malloc malloc
650 #define sexp_free free
651 #endif
652 
653 #if SEXP_USE_BOEHM
654 
655 #define sexp_gc(ctx, sum)
656 
657 #define sexp_gc_var(x, y)            sexp x = SEXP_VOID;
658 #define sexp_gc_preserve(ctx, x, y)
659 #define sexp_gc_release(ctx, x, y)
660 
661 #define sexp_preserve_object(ctx, x)
662 #define sexp_release_object(ctx, x)
663 
664 #include "gc/gc.h"
665 #define sexp_alloc(ctx, size)        GC_malloc(size)
666 #define sexp_alloc_atomic(ctx, size) GC_malloc_atomic(size)
667 
668 #else
669 
670 SEXP_API sexp sexp_gc(sexp ctx, size_t *sum_freed);
671 
672 #define sexp_gc_var(x, y)                       \
673   sexp x = SEXP_VOID;                           \
674   struct sexp_gc_var_t y = {NULL, NULL};
675 
676 #if SEXP_USE_DEBUG_GC
677 #define sexp_gc_preserve_name(ctx, x, y) (y).name = #x
678 #else
679 #define sexp_gc_preserve_name(ctx, x, y)
680 #endif
681 
682 #define sexp_gc_preserve(ctx, x, y)     \
683   do {                                  \
684     sexp_gc_preserve_name(ctx, x, y);   \
685     (y).var = &(x);                     \
686     (y).next = sexp_context_saves(ctx); \
687     sexp_context_saves(ctx) = &(y);     \
688   } while (0)
689 
690 #define sexp_gc_release(ctx, x, y)   (sexp_context_saves(ctx) = y.next)
691 
692 SEXP_API void sexp_preserve_object(sexp ctx, sexp x);
693 SEXP_API void sexp_release_object(sexp ctx, sexp x);
694 
695 #if SEXP_USE_MALLOC
696 #define sexp_alloc(ctx, size)        sexp_malloc(size)
697 #define sexp_alloc_atomic(ctx, size) sexp_malloc(size)
698 #else  /* native gc */
699 void* sexp_alloc(sexp ctx, size_t size);
700 #define sexp_alloc_atomic            sexp_alloc
701 #endif
702 #endif
703 
704 #define sexp_gc_var1(x) sexp_gc_var(x, __sexp_gc_preserver1)
705 #define sexp_gc_var2(x, y) sexp_gc_var1(x) sexp_gc_var(y, __sexp_gc_preserver2)
706 #define sexp_gc_var3(x, y, z) sexp_gc_var2(x, y) sexp_gc_var(z, __sexp_gc_preserver3)
707 #define sexp_gc_var4(x, y, z, w) sexp_gc_var3(x, y, z) sexp_gc_var(w, __sexp_gc_preserver4)
708 #define sexp_gc_var5(x, y, z, w, v) sexp_gc_var4(x, y, z, w) sexp_gc_var(v, __sexp_gc_preserver5)
709 #define sexp_gc_var6(x, y, z, w, v, u) sexp_gc_var5(x, y, z, w, v) sexp_gc_var(u, __sexp_gc_preserver6)
710 #define sexp_gc_var7(x, y, z, w, v, u, t) sexp_gc_var6(x, y, z, w, v, u) sexp_gc_var(t, __sexp_gc_preserver7)
711 
712 #define sexp_gc_preserve1(ctx, x) sexp_gc_preserve(ctx, x, __sexp_gc_preserver1)
713 #define sexp_gc_preserve2(ctx, x, y) sexp_gc_preserve1(ctx, x); sexp_gc_preserve(ctx, y, __sexp_gc_preserver2)
714 #define sexp_gc_preserve3(ctx, x, y, z) sexp_gc_preserve2(ctx, x, y); sexp_gc_preserve(ctx, z, __sexp_gc_preserver3)
715 #define sexp_gc_preserve4(ctx, x, y, z, w) sexp_gc_preserve3(ctx, x, y, z); sexp_gc_preserve(ctx, w, __sexp_gc_preserver4)
716 #define sexp_gc_preserve5(ctx, x, y, z, w, v) sexp_gc_preserve4(ctx, x, y, z, w); sexp_gc_preserve(ctx, v, __sexp_gc_preserver5)
717 #define sexp_gc_preserve6(ctx, x, y, z, w, v, u) sexp_gc_preserve5(ctx, x, y, z, w, v); sexp_gc_preserve(ctx, u, __sexp_gc_preserver6)
718 #define sexp_gc_preserve7(ctx, x, y, z, w, v, u, t) sexp_gc_preserve6(ctx, x, y, z, w, v, u); sexp_gc_preserve(ctx, t, __sexp_gc_preserver7)
719 
720 #define sexp_gc_release1(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
721 #define sexp_gc_release2(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
722 #define sexp_gc_release3(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
723 #define sexp_gc_release4(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
724 #define sexp_gc_release5(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
725 #define sexp_gc_release6(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
726 #define sexp_gc_release7(ctx) sexp_gc_release(ctx, NULL, __sexp_gc_preserver1)
727 
728 #define sexp_align(n, bits) (((n)+(1<<(bits))-1)&(((sexp_uint_t)-1)-((1<<(bits))-1)))
729 
730 #if SEXP_64_BIT
731 #define sexp_word_align(n) sexp_align((n), 3)
732 #else
733 #define sexp_word_align(n) sexp_align((n), 2)
734 #endif
735 
736 #define sexp_sizeof(x) (offsetof(struct sexp_struct, value) \
737                          + sizeof(((sexp)0)->value.x))
738 #define sexp_offsetof(type, f) (offsetof(struct sexp_struct, value.type.f))
739 #define sexp_offsetof_slot0 (offsetof(struct sexp_struct, value))
740 #define sexp_sizeof_header (sexp_sizeof(flonum) - sizeof(double))
741 
742 #if SEXP_USE_TRACK_ALLOC_SOURCE
743 #define sexp_with_current_source0(file, line) file ": " #line
744 #define sexp_with_current_source(file, line) , sexp_with_current_source0(file, line)
745 #else
746 #define sexp_with_current_source(file, line)
747 #endif
748 
749 #define sexp_alloc_tagged(ctx, size, tag) sexp_alloc_tagged_aux(ctx, size, tag sexp_with_current_source(__FILE__, __LINE__))
750 
751 #define sexp_alloc_type(ctx, type, tag) sexp_alloc_tagged(ctx, sexp_sizeof(type), tag)
752 #define sexp_alloc_bytecode(ctx, i) sexp_alloc_tagged(ctx, sexp_sizeof(bytecode) + i, SEXP_BYTECODE)
753 
754 #if SEXP_USE_BIGNUMS
755 #include "chibi/bignum.h"
756 #endif
757 
758 /***************************** predicates *****************************/
759 
760 #define sexp_truep(x)    ((x) != SEXP_FALSE)
761 #define sexp_not(x)      ((x) == SEXP_FALSE)
762 
763 #define sexp_nullp(x)    ((x) == SEXP_NULL)
764 #define sexp_pointerp(x) (((sexp_uint_t)(x) & SEXP_POINTER_MASK) == SEXP_POINTER_TAG)
765 #define sexp_fixnump(x)  (((sexp_uint_t)(x) & SEXP_FIXNUM_MASK) == SEXP_FIXNUM_TAG)
766 #if SEXP_USE_DISJOINT_STRING_CURSORS
767 #define sexp_string_cursorp(x)  (((sexp_uint_t)(x) & SEXP_STRING_CURSOR_MASK) == SEXP_STRING_CURSOR_TAG)
768 #else
769 #define sexp_string_cursorp(x) sexp_fixnump(x)
770 #endif
771 #define sexp_isymbolp(x) (((sexp_uint_t)(x) & SEXP_IMMEDIATE_MASK) == SEXP_ISYMBOL_TAG)
772 #define sexp_charp(x)    (((sexp_uint_t)(x) & SEXP_EXTENDED_MASK) == SEXP_CHAR_TAG)
773 #define sexp_reader_labelp(x) (((sexp_uint_t)(x) & SEXP_EXTENDED_MASK) == SEXP_READER_LABEL_TAG)
774 #define sexp_booleanp(x) (((x) == SEXP_TRUE) || ((x) == SEXP_FALSE))
775 
776 #define sexp_pointer_tag(x)      ((x)->tag)
777 #define sexp_markedp(x)          ((x)->markedp)
778 #define sexp_flags(x)            ((x)->flags)
779 #define sexp_immutablep(x)       ((x)->immutablep)
780 #define sexp_freep(x)            ((x)->freep)
781 #define sexp_brokenp(x)          ((x)->brokenp)
782 #define sexp_pointer_magic(x)    ((x)->magic)
783 
784 #if SEXP_USE_TRACK_ALLOC_SOURCE
785 #define sexp_pointer_source(x)   ((x)->source)
786 #else
787 #define sexp_pointer_source(x)   ""
788 #endif
789 
790 #define sexp_check_tag(x,t)  (sexp_pointerp(x) && (sexp_pointer_tag(x) == (t)))
791 
792 #define sexp_slot_ref(x,i)   (((sexp*)&((x)->value))[i])
793 #define sexp_slot_set(x,i,v) (((sexp*)&((x)->value))[i] = (v))
794 
795 #define sexp_isa(a, b) (sexp_pointerp(a) && sexp_typep(b) && (sexp_pointer_tag(a) == sexp_type_tag(b)))
796 
797 #if SEXP_USE_IMMEDIATE_FLONUMS
798 union sexp_flonum_conv {
799   float flonum;
800   unsigned int bits;
801 };
802 #define sexp_flonump(x)      (((sexp_uint_t)(x) & SEXP_EXTENDED_MASK) == SEXP_IFLONUM_TAG)
803 SEXP_API sexp sexp_flonum_predicate (sexp ctx, sexp x);
804 #if SEXP_64_BIT
805 SEXP_API float sexp_flonum_value (sexp x);
806 #define sexp_flonum_value_set(f, x) (f = sexp_make_flonum(NULL, x))
807 #define sexp_flonum_bits(f) ((char*)&f)
808 SEXP_API sexp sexp_make_flonum(sexp ctx, float f);
809 #else
810 #define sexp_make_flonum(ctx, x)  ((sexp) ((((union sexp_flonum_conv)((float)(x))).bits & ~SEXP_EXTENDED_MASK) + SEXP_IFLONUM_TAG))
811 #define sexp_flonum_value(x) (((union sexp_flonum_conv)(((unsigned int)(x)) & ~SEXP_EXTENDED_MASK)).flonum)
812 #endif
813 #else
814 #define sexp_flonump(x)      (sexp_check_tag(x, SEXP_FLONUM))
815 #define sexp_flonum_value(f) ((f)->value.flonum)
816 #define sexp_flonum_value_set(f, x) ((f)->value.flonum = x)
817 #define sexp_flonum_bits(f) ((f)->value.flonum_bits)
818 SEXP_API sexp sexp_make_flonum(sexp ctx, double f);
819 #endif
820 
821 #define sexp_typep(x)       (sexp_check_tag(x, SEXP_TYPE))
822 #define sexp_pairp(x)       (sexp_check_tag(x, SEXP_PAIR))
823 #define sexp_stringp(x)     (sexp_check_tag(x, SEXP_STRING))
824 #define sexp_lsymbolp(x)    (sexp_check_tag(x, SEXP_SYMBOL))
825 #define sexp_bytesp(x)      (sexp_check_tag(x, SEXP_BYTES))
826 #define sexp_vectorp(x)     (sexp_check_tag(x, SEXP_VECTOR))
827 #define sexp_iportp(x)      (sexp_check_tag(x, SEXP_IPORT))
828 #if SEXP_USE_BIDIRECTIONAL_PORTS
829 #define sexp_oportp(x)      (sexp_check_tag(x, SEXP_OPORT) || (sexp_check_tag(x, SEXP_IPORT) && sexp_port_bidirp(x)))
830 #else
831 #define sexp_oportp(x)      (sexp_check_tag(x, SEXP_OPORT))
832 #endif
833 #define sexp_filenop(x)     (sexp_check_tag(x, SEXP_FILENO))
834 #if SEXP_USE_BIGNUMS
835 #define sexp_bignump(x)     (sexp_check_tag(x, SEXP_BIGNUM))
836 #else
837 #define sexp_bignump(x)     0
838 #endif
839 #if SEXP_USE_RATIOS
840 #define sexp_ratiop(x)      (sexp_check_tag(x, SEXP_RATIO))
841 #else
842 #define sexp_ratiop(x)      0
843 #endif
844 #if SEXP_USE_COMPLEX
845 #define sexp_complexp(x)    (sexp_check_tag(x, SEXP_COMPLEX))
846 #else
847 #define sexp_complexp(x)    0
848 #endif
849 #define sexp_cpointerp(x)   (sexp_check_tag(x, SEXP_CPOINTER))
850 #define sexp_exceptionp(x)  (sexp_check_tag(x, SEXP_EXCEPTION))
851 #define sexp_procedurep(x)  (sexp_check_tag(x, SEXP_PROCEDURE))
852 #define sexp_envp(x)        (sexp_check_tag(x, SEXP_ENV))
853 #define sexp_bytecodep(x)   (sexp_check_tag(x, SEXP_BYTECODE))
854 #define sexp_corep(x)       (sexp_check_tag(x, SEXP_CORE))
855 #define sexp_dlp(x)         (sexp_check_tag(x, SEXP_DL))
856 #define sexp_opcodep(x)     (sexp_check_tag(x, SEXP_OPCODE))
857 #define sexp_macrop(x)      (sexp_check_tag(x, SEXP_MACRO))
858 #define sexp_syntacticp(x)  (sexp_corep(x) || sexp_macrop(x))
859 #define sexp_synclop(x)     (sexp_check_tag(x, SEXP_SYNCLO))
860 #define sexp_lambdap(x)     (sexp_check_tag(x, SEXP_LAMBDA))
861 #define sexp_cndp(x)        (sexp_check_tag(x, SEXP_CND))
862 #define sexp_refp(x)        (sexp_check_tag(x, SEXP_REF))
863 #define sexp_setp(x)        (sexp_check_tag(x, SEXP_SET))
864 #define sexp_set_synp(x)    (sexp_check_tag(x, SEXP_SET_SYN))
865 #define sexp_seqp(x)        (sexp_check_tag(x, SEXP_SEQ))
866 #define sexp_litp(x)        (sexp_check_tag(x, SEXP_LIT))
867 #define sexp_contextp(x)    (sexp_check_tag(x, SEXP_CONTEXT))
868 #define sexp_promisep(x)    (sexp_check_tag(x, SEXP_PROMISE))
869 #define sexp_ephemeronp(x)  (sexp_check_tag(x, SEXP_EPHEMERON))
870 
871 #if SEXP_USE_UNIFORM_VECTOR_LITERALS
872 #define sexp_uvectorp(x)    (sexp_check_tag(x, SEXP_UNIFORM_VECTOR))
873 #define sexp_u1vectorp(x)   (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_U1)
874 #define sexp_u8vectorp(x)   (sexp_bytesp(x))
875 #define sexp_s8vectorp(x)   (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_S8)
876 #define sexp_u16vectorp(x)  (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_U16)
877 #define sexp_s16vectorp(x)  (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_S16)
878 #define sexp_u32vectorp(x)  (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_U32)
879 #define sexp_s32vectorp(x)  (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_S32)
880 #define sexp_u64vectorp(x)  (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_U64)
881 #define sexp_s64vectorp(x)  (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_S64)
882 #define sexp_f32vectorp(x)  (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_F32)
883 #define sexp_f64vectorp(x)  (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_F64)
884 #define sexp_c64vectorp(x)  (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_C64)
885 #define sexp_c128vectorp(x) (sexp_uvectorp(x) && sexp_uvector_type(x)==SEXP_C128)
886 #else
887 #define sexp_uvectorp(x)    (sexp_vectorp(x))
888 #define sexp_u1vectorp(x)   (sexp_vectorp(x))
889 #define sexp_u8vectorp(x)   (sexp_bytesp(x))
890 #define sexp_s8vectorp(x)   (sexp_vectorp(x))
891 #define sexp_u16vectorp(x)  (sexp_vectorp(x))
892 #define sexp_s16vectorp(x)  (sexp_vectorp(x))
893 #define sexp_u32vectorp(x)  (sexp_vectorp(x))
894 #define sexp_s32vectorp(x)  (sexp_vectorp(x))
895 #define sexp_u64vectorp(x)  (sexp_vectorp(x))
896 #define sexp_s64vectorp(x)  (sexp_vectorp(x))
897 #define sexp_f32vectorp(x)  (sexp_vectorp(x))
898 #define sexp_f64vectorp(x)  (sexp_vectorp(x))
899 #define sexp_c64vectorp(x)  (sexp_vectorp(x))
900 #define sexp_c128vectorp(x) (sexp_vectorp(x))
901 #endif
902 
903 #define sexp_applicablep(x) (sexp_procedurep(x) || sexp_opcodep(x))
904 
905 #if SEXP_USE_HUFF_SYMS
906 #define sexp_symbolp(x)     (sexp_isymbolp(x) || sexp_lsymbolp(x))
907 #else
908 #define sexp_symbolp(x)     (sexp_lsymbolp(x))
909 #endif
910 
911 SEXP_API sexp sexp_id_name(sexp x);
912 SEXP_API int sexp_idp(sexp x);
913 
914 #define sexp_portp(x) (sexp_check_tag(x, SEXP_IPORT) || sexp_check_tag(x, SEXP_OPORT))
915 
916 #define sexp_stream_portp(x) (sexp_port_stream(x) != NULL)
917 
918 #define sexp_port_customp(x) (sexp_vectorp(sexp_port_cookie(x)) && sexp_vector_length(sexp_port_cookie(x)) == 6)
919 
920 /* only valid on custom ports */
921 #define sexp_port_buffer(x)  (sexp_vector_ref(sexp_port_cookie(x), SEXP_ONE))
922 #define sexp_port_reader(x)  (sexp_vector_ref(sexp_port_cookie(x), SEXP_TWO))
923 #define sexp_port_writer(x)  (sexp_vector_ref(sexp_port_cookie(x), SEXP_THREE))
924 #define sexp_port_seeker(x)  (sexp_vector_ref(sexp_port_cookie(x), SEXP_FOUR))
925 #define sexp_port_closer(x)  (sexp_vector_ref(sexp_port_cookie(x), SEXP_FIVE))
926 
927 /***************************** constructors ****************************/
928 
929 #define sexp_make_boolean(x) ((x) ? SEXP_TRUE : SEXP_FALSE)
930 #define sexp_unbox_boolean(x) (((x) == SEXP_FALSE) ? 0 : 1)
931 
932 #if SEXP_USE_SIGNED_SHIFTS
933 #define sexp_make_fixnum(n)    ((sexp) ((((sexp_sint_t)(n))<<SEXP_FIXNUM_BITS) + SEXP_FIXNUM_TAG))
934 #define sexp_unbox_fixnum(n)   (((sexp_sint_t)(n))>>SEXP_FIXNUM_BITS)
935 #else
936 #define sexp_make_fixnum(n)    ((sexp) ((((sexp_sint_t)(n))*(sexp_sint_t)((sexp_sint_t)1<<SEXP_FIXNUM_BITS)) | SEXP_FIXNUM_TAG))
937 #define sexp_unbox_fixnum(n)   (((sexp_sint_t)((sexp_uint_t)(n) & ~SEXP_FIXNUM_TAG))/(sexp_sint_t)((sexp_sint_t)1<<SEXP_FIXNUM_BITS))
938 #endif
939 
940 #define SEXP_NEG_ONE sexp_make_fixnum(-1)
941 #define SEXP_ZERO    sexp_make_fixnum(0)
942 #define SEXP_ONE     sexp_make_fixnum(1)
943 #define SEXP_TWO     sexp_make_fixnum(2)
944 #define SEXP_THREE   sexp_make_fixnum(3)
945 #define SEXP_FOUR    sexp_make_fixnum(4)
946 #define SEXP_FIVE    sexp_make_fixnum(5)
947 #define SEXP_SIX     sexp_make_fixnum(6)
948 #define SEXP_SEVEN   sexp_make_fixnum(7)
949 #define SEXP_EIGHT   sexp_make_fixnum(8)
950 #define SEXP_NINE    sexp_make_fixnum(9)
951 #define SEXP_TEN     sexp_make_fixnum(10)
952 
953 #if SEXP_USE_DISJOINT_STRING_CURSORS
954 #if SEXP_USE_SIGNED_SHIFTS
955 #define sexp_make_string_cursor(n)    ((sexp) ((((sexp_sint_t)(n))<<SEXP_STRING_CURSOR_BITS) + SEXP_STRING_CURSOR_TAG))
956 #define sexp_unbox_string_cursor(n)   (((sexp_sint_t)(n))>>SEXP_STRING_CURSOR_BITS)
957 #else
958 #define sexp_make_string_cursor(n)    ((sexp) ((((sexp_sint_t)(n))*(sexp_sint_t)(1uL<<SEXP_STRING_CURSOR_BITS)) | SEXP_STRING_CURSOR_TAG))
959 #define sexp_unbox_string_cursor(n)   (((sexp_sint_t)((sexp_uint_t)(n) & ~SEXP_STRING_CURSOR_TAG))/(sexp_sint_t)(1uL<<SEXP_STRING_CURSOR_BITS))
960 #endif
961 #define sexp_string_cursor_to_fixnum(n) sexp_make_fixnum(sexp_unbox_string_cursor(n))
962 #define sexp_fixnum_to_string_cursor(n) sexp_make_string_cursor(sexp_unbox_fixnum(n))
963 #else
964 #define sexp_make_string_cursor(n)    sexp_make_fixnum(n)
965 #define sexp_unbox_string_cursor(n)   sexp_unbox_fixnum(n)
966 #define sexp_string_cursor_to_fixnum(n) (n)
967 #define sexp_fixnum_to_string_cursor(n) (n)
968 #endif
969 
970 #define sexp_make_character(n)  ((sexp) ((((sexp_sint_t)(n))<<SEXP_EXTENDED_BITS) + SEXP_CHAR_TAG))
971 #define sexp_unbox_character(n) ((int) (((sexp_sint_t)(n))>>SEXP_EXTENDED_BITS))
972 
973 #define sexp_make_reader_label(n)  ((sexp) ((((sexp_sint_t)(n))<<SEXP_EXTENDED_BITS) + SEXP_READER_LABEL_TAG))
974 #define sexp_unbox_reader_label(n) ((int) (((sexp_sint_t)(n))>>SEXP_EXTENDED_BITS))
975 
976 #define sexp_fixnum_to_double(x) ((double)sexp_unbox_fixnum(x))
977 
978 #if SEXP_USE_PLACEHOLDER_DIGITS
979 #define sexp_placeholder_digit_p(c) ((c) == SEXP_PLACEHOLDER_DIGIT)
980 #else
981 #define sexp_placeholder_digit_p(c) 0
982 #endif
983 
984 #define sexp_placeholder_digit_value(base) ((base)/2)
985 
986 #if SEXP_USE_FLONUMS
987 #define sexp_fp_integerp(x) (sexp_flonum_value(x) == trunc(sexp_flonum_value(x)))
988 #define _or_integer_flonump(x) || (sexp_flonump(x) && sexp_fp_integerp(x))
989 #else
990 #define _or_integer_flonump(x)
991 #endif
992 
993 #if SEXP_USE_BIGNUMS
994 SEXP_API sexp sexp_make_integer_from_lsint(sexp ctx, sexp_lsint_t x);
995 SEXP_API sexp sexp_make_unsigned_integer_from_luint(sexp ctx, sexp_luint_t x);
996 #if SEXP_USE_CUSTOM_LONG_LONGS
997 SEXP_API sexp sexp_make_integer(sexp ctx, long long x);
998 SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, unsigned long long x);
999 #else
1000 SEXP_API sexp sexp_make_integer(sexp ctx, sexp_lsint_t x);
1001 SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
1002 #endif
1003 #define sexp_exact_integerp(x) (sexp_fixnump(x) || sexp_bignump(x))
1004 #else
1005 #define sexp_make_integer(ctx, x) sexp_make_fixnum(x)
1006 #define sexp_make_unsigned_integer(ctx, x) sexp_make_fixnum(x)
1007 #define sexp_exact_integerp(x) sexp_fixnump(x)
1008 #endif
1009 
1010 #define sexp_integerp(x) (sexp_exact_integerp(x) _or_integer_flonump(x))
1011 
1012 #if SEXP_USE_RATIOS
1013 #define sexp_exactp(x) (sexp_exact_integerp(x) || sexp_ratiop(x))
1014 #else
1015 #define sexp_exactp(x) sexp_exact_integerp(x)
1016 #endif
1017 
1018 #if SEXP_USE_FLONUMS
1019 #define sexp_fixnum_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_fixnum(x)))
1020 #if SEXP_USE_RATIOS
1021 #define sexp_realp(x) (sexp_exact_integerp(x) || sexp_flonump(x) || sexp_ratiop(x))
1022 #else
1023 #define sexp_realp(x) (sexp_exact_integerp(x) || sexp_flonump(x))
1024 #endif
1025 #else
1026 #define sexp_fixnum_to_flonum(ctx, x) (x)
1027 #define sexp_realp(x) sexp_exact_integerp(x)
1028 #endif
1029 
1030 #if SEXP_USE_COMPLEX
1031 #define sexp_numberp(x) (sexp_realp(x) || sexp_complexp(x))
1032 #define sexp_real_part(x) (sexp_complexp(x) ? sexp_complex_real(x) : x)
1033 #define sexp_imag_part(x) (sexp_complexp(x) ? sexp_complex_imag(x) : SEXP_ZERO)
1034 #else
1035 #define sexp_numberp(x) (sexp_realp(x))
1036 #define sexp_real_part(x) (x)
1037 #define sexp_imag_part(x) SEXP_ZERO
1038 #endif
1039 
1040 #define sexp_exact_negativep(x) (sexp_fixnump(x) ? (sexp_unbox_fixnum(x) < 0) \
1041                                  : ((SEXP_USE_BIGNUMS && sexp_bignump(x)) \
1042                                     && (sexp_bignum_sign(x) < 0)))
1043 #define sexp_exact_positivep(x) (sexp_fixnump(x) ? (sexp_unbox_fixnum(x) > 0) \
1044                                  : ((SEXP_USE_BIGNUMS && sexp_bignump(x)) \
1045                                     && (sexp_bignum_sign(x) > 0)))
1046 #define sexp_negativep(x) (sexp_exact_negativep(x) ||                   \
1047                            (sexp_flonump(x) && sexp_flonum_value(x) < 0))
1048 #define sexp_positivep(x) (!(sexp_negativep(x)))
1049 #define sexp_pedantic_negativep(x) (sexp_exact_negativep(x) ||          \
1050                                     (sexp_flonump(x) &&                 \
1051                                      ((sexp_flonum_value(x) < 0) ||     \
1052                                       (sexp_flonum_value(x) == 0 && \
1053                                        1.0 / sexp_flonum_value(x) < 0))))
1054 
1055 #if SEXP_USE_BIGNUMS
1056 #define sexp_oddp(x) (sexp_fixnump(x) ? sexp_unbox_fixnum(x) & 1 : \
1057                       sexp_bignump(x) && (sexp_bignum_data(x)[0] & 1))
1058 #else
1059 #define sexp_oddp(x) (sexp_fixnump(x) && (sexp_unbox_fixnum(x) & 1))
1060 #endif
1061 #define sexp_evenp(x) (!(sexp_oddp(x)))
1062 
1063 #define sexp_negate_exact(x)                            \
1064   if (sexp_bignump(x))                                  \
1065     sexp_bignum_sign(x) = -sexp_bignum_sign(x);         \
1066   else if (sexp_fixnump(x))                             \
1067     x = sexp_fx_neg(x);
1068 
1069 #if SEXP_USE_IMMEDIATE_FLONUMS
1070 #define sexp_negate_flonum(x) (x) = sexp_make_flonum(NULL, -(sexp_flonum_value(x)))
1071 #else
1072 #define sexp_negate_flonum(x) sexp_flonum_value(x) = -(sexp_flonum_value(x))
1073 #endif
1074 
1075 #define sexp_negate(x)                                  \
1076   if (sexp_flonump(x))                                  \
1077     sexp_negate_flonum(x);                              \
1078   else                                                  \
1079     sexp_negate_exact(x)
1080 
1081 #if SEXP_USE_FLONUMS || SEXP_USE_BIGNUMS
1082 
1083 #if SEXP_64_BIT
1084 #define sexp_bignum_to_sint(x) (sexp_bignum_sign(x)*sexp_bignum_data(x)[0])
1085 #define sexp_bignum_to_uint(x) (sexp_bignum_data(x)[0])
1086 #else
1087 SEXP_API long long sexp_bignum_to_sint(sexp x);
1088 SEXP_API unsigned long long sexp_bignum_to_uint(sexp x);
1089 #endif
1090 
1091 #define sexp_uint_value(x) ((unsigned long long)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignump(x) ? sexp_bignum_to_uint(x) : 0))
1092 #define sexp_sint_value(x) ((long long)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignump(x) ? sexp_bignum_to_sint(x) : 0))
1093 
1094 #else
1095 
1096 #define sexp_uint_value(x) ((sexp_uint_t)sexp_unbox_fixnum(x))
1097 #define sexp_sint_value(x) ((sexp_sint_t)sexp_unbox_fixnum(x))
1098 
1099 #endif	/* SEXP_USE_FLONUMS || SEXP_USE_BIGNUMS */
1100 
1101 #define sexp_shift_epoch(x) ((x)-SEXP_EPOCH_OFFSET)
1102 #define sexp_unshift_epoch(x) ((x)+SEXP_EPOCH_OFFSET)
1103 
1104 #define sexp_infp(x) (sexp_flonump(x) && isinf(sexp_flonum_value(x)))
1105 #define sexp_nanp(x) (sexp_flonump(x) && isnan(sexp_flonum_value(x)))
1106 
1107 #if SEXP_USE_IEEE_EQV
1108 #define sexp_flonum_eqv(x, y) (memcmp(sexp_flonum_bits(x), sexp_flonum_bits(y), sizeof(double)) == 0)
1109 #else
1110 #define sexp_flonum_eqv(x, y) (sexp_flonum_value(x) == sexp_flonum_value(y))
1111 #endif
1112 
1113 /*************************** field accessors **************************/
1114 
1115 #if SEXP_USE_SAFE_ACCESSORS
1116 #if 0
1117 #define sexp_field(x, type, id, field) (*(((x) && sexp_check_tag(x, id)) ? &((x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, x, (int)(sexp_pointerp(x) ? sexp_pointer_tag(x) : -1)), &(((sexp)NULL)->value.type.field))))
1118 #define sexp_pred_field(x, type, pred, field) (*(((x) && pred(x)) ? &((x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, x, (int)(sexp_pointerp(x) ? sexp_pointer_tag(x) : -1)), &(((sexp)NULL)->value.type.field))))
1119 #define sexp_cpointer_field(x, field) (*(((x) && sexp_pointerp(x) && sexp_pointer_tag(x) >= SEXP_CPOINTER) ? &((x)->value.cpointer.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a cpointer\n", __FILE__, __LINE__, x, (int)(sexp_pointerp(x) ? sexp_pointer_tag(x) : -1)), &(((sexp)NULL)->value.cpointer.field))))
1120 #else
1121 #define sexp_field(x, type, id, field) (*({sexp _x=x; (((_x) && sexp_check_tag(_x, id)) ? &((_x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, _x, (int)(sexp_pointerp(_x) ? sexp_pointer_tag(_x) : -1)), &(((sexp)NULL)->value.type.field)));}))
1122 #define sexp_pred_field(x, type, pred, field) (*({sexp _x=x; (((_x) && pred(_x)) ? &((_x)->value.type.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a "#type"\n", __FILE__, __LINE__, _x, (int)(sexp_pointerp(_x) ? sexp_pointer_tag(_x) : -1)), &(((sexp)NULL)->value.type.field)));}))
1123 #define sexp_cpointer_field(x, field) (*({sexp _x=x; (((_x) && sexp_pointerp(_x) && sexp_pointer_tag(_x) >= SEXP_CPOINTER) ? &((_x)->value.cpointer.field) : (fprintf(stderr, "invalid field access in %s line %d: %p (%d) isn't a cpointer\n", __FILE__, __LINE__, _x, (int)(sexp_pointerp(_x) ? sexp_pointer_tag(_x) : -1)), &(((sexp)NULL)->value.cpointer.field)));}))
1124 #endif
1125 #else
1126 #define sexp_field(x, type, id, field) ((x)->value.type.field)
1127 #define sexp_pred_field(x, type, pred, field) ((x)->value.type.field)
1128 #define sexp_cpointer_field(x, field) ((x)->value.cpointer.field)
1129 #endif
1130 
1131 #define sexp_vector_length(x) (sexp_field(x, vector, SEXP_VECTOR, length))
1132 #define sexp_vector_data(x)   (sexp_field(x, vector, SEXP_VECTOR, data))
1133 
1134 #if SEXP_USE_SAFE_VECTOR_ACCESSORS
1135 #define sexp_vector_ref(x,i)   (sexp_unbox_fixnum(i)>=0 && sexp_unbox_fixnum(i)<sexp_vector_length(x) ? sexp_vector_data(x)[sexp_unbox_fixnum(i)] : (fprintf(stderr, "vector-ref length out of range %s on line %d: vector %p (length %lu): %ld\n", __FILE__, __LINE__, x, sexp_vector_length(x), sexp_unbox_fixnum(i)), SEXP_VOID))
1136 #define sexp_vector_set(x,i,v) (sexp_unbox_fixnum(i)>=0 && sexp_unbox_fixnum(i)<sexp_vector_length(x) ? sexp_vector_data(x)[sexp_unbox_fixnum(i)]=(v) : (fprintf(stderr, "vector-set! length out of range in %s on line %d: vector %p (length %lu): %ld\n", __FILE__, __LINE__, x, sexp_vector_length(x), sexp_unbox_fixnum(i)), SEXP_VOID))
1137 #else
1138 #define sexp_vector_ref(x,i)   (sexp_vector_data(x)[sexp_unbox_fixnum(i)])
1139 #define sexp_vector_set(x,i,v) (sexp_vector_data(x)[sexp_unbox_fixnum(i)]=(v))
1140 #endif
1141 
1142 #define sexp_procedure_num_args(x)   (sexp_field(x, procedure, SEXP_PROCEDURE, num_args))
1143 #define sexp_procedure_flags(x)      (sexp_field(x, procedure, SEXP_PROCEDURE, flags))
1144 #define sexp_procedure_variadic_p(x) (sexp_unbox_fixnum(sexp_procedure_flags(x)) & SEXP_PROC_VARIADIC)
1145 #define sexp_procedure_unused_rest_p(x) (sexp_unbox_fixnum(sexp_procedure_flags(x)) & SEXP_PROC_UNUSED_REST)
1146 #define sexp_procedure_code(x)       (sexp_field(x, procedure, SEXP_PROCEDURE, bc))
1147 #define sexp_procedure_vars(x)       (sexp_field(x, procedure, SEXP_PROCEDURE, vars))
1148 #define sexp_procedure_source(x)     sexp_bytecode_source(sexp_procedure_code(x))
1149 
1150 #define sexp_bytes_length(x)  (sexp_field(x, bytes, SEXP_BYTES, length))
1151 #define sexp_bytes_data(x)    (sexp_field(x, bytes, SEXP_BYTES, data))
1152 #define sexp_bytes_maybe_null_data(x) (sexp_not(x) ? NULL : sexp_bytes_data(x))
1153 
1154 static const unsigned char sexp_uvector_sizes[] = {
1155   0, 1, 8, 8, 16, 16, 32, 32, 64, 64, 32, 64, 64, 128};
1156 static const unsigned char sexp_uvector_chars[] = "#ususususuffcc";
1157 
1158 enum sexp_uniform_vector_type {
1159   SEXP_NOT_A_UNIFORM_TYPE,
1160   SEXP_U1,
1161   SEXP_S8,
1162   SEXP_U8,
1163   SEXP_S16,
1164   SEXP_U16,
1165   SEXP_S32,
1166   SEXP_U32,
1167   SEXP_S64,
1168   SEXP_U64,
1169   SEXP_F32,
1170   SEXP_F64,
1171   SEXP_C64,
1172   SEXP_C128
1173 };
1174 
1175 #define sexp_uvector_freep(x) (sexp_freep(x))
1176 #define sexp_uvector_element_size(uvt) (sexp_uvector_sizes[uvt])
1177 #define sexp_uvector_prefix(uvt) (sexp_uvector_chars[uvt])
1178 
1179 #define sexp_uvector_length(x) (sexp_field(x, uvector, SEXP_UNIFORM_VECTOR, length))
1180 #define sexp_uvector_type(x)   (sexp_field(x, uvector, SEXP_UNIFORM_VECTOR, element_type))
1181 #define sexp_uvector_data(x) sexp_bytes_data(sexp_uvector_bytes(x))
1182 #define sexp_uvector_maybe_null_data(x) (sexp_not(x) ? NULL : sexp_uvector_data(x))
1183 #define sexp_uvector_bytes(x)  (sexp_field(x, uvector, SEXP_UNIFORM_VECTOR, bytes))
1184 
1185 #define sexp_bit_ref(u1v, i)    (((sexp_uvector_data(u1v)[i/8])>>(i%8))&1)
1186 #define sexp_bit_set(u1v, i, x) (x ? (sexp_uvector_data(u1v)[i/8]|=(1<<(i%8))) : (sexp_uvector_data(u1v)[i/8]&=~(1<<(i%8))))
1187 
1188 #define sexp_string_size(x)     (sexp_field(x, string, SEXP_STRING, length))
1189 #define sexp_string_charlens(x) (sexp_field(x, string, SEXP_STRING, charlens))
1190 #if SEXP_USE_PACKED_STRINGS
1191 #define sexp_string_data(x)   (sexp_field(x, string, SEXP_STRING, data))
1192 #define sexp_string_bytes(x)  (x)
1193 #else
1194 #define sexp_string_bytes(x)  (sexp_field(x, string, SEXP_STRING, bytes))
1195 #define sexp_string_offset(x) (sexp_field(x, string, SEXP_STRING, offset))
1196 #define sexp_string_data(x)   (sexp_bytes_data(sexp_string_bytes(x))+sexp_string_offset(x))
1197 #endif
1198 #define sexp_string_maybe_null_data(x) (sexp_not(x) ? NULL : sexp_string_data(x))
1199 
1200 #if SEXP_USE_PACKED_STRINGS
1201 #define sexp_string_to_bytes(ctx, x)  ((x)->tag = SEXP_BYTES, x)
1202 #else
1203 #define sexp_string_to_bytes(ctx, x)  sexp_string_bytes(x)
1204 #endif
1205 
1206 #define sexp_bytes_ref(x, i)    (sexp_make_fixnum((unsigned char)sexp_bytes_data(x)[sexp_unbox_fixnum(i)]))
1207 #define sexp_bytes_set(x, i, v) (sexp_bytes_data(x)[sexp_unbox_fixnum(i)] = sexp_unbox_fixnum(v))
1208 
1209 #define sexp_lsymbol_data(x)   (sexp_field(x, symbol, SEXP_SYMBOL, data))
1210 #define sexp_lsymbol_length(x) (sexp_field(x, symbol, SEXP_SYMBOL, length))
1211 
1212 #define sexp_port_stream(p)     (sexp_pred_field(p, port, sexp_portp, stream))
1213 #define sexp_port_name(p)       (sexp_pred_field(p, port, sexp_portp, name))
1214 #define sexp_port_line(p)       (sexp_pred_field(p, port, sexp_portp, line))
1215 #define sexp_port_openp(p)      (sexp_pred_field(p, port, sexp_portp, openp))
1216 #define sexp_port_bidirp(p)     (sexp_pred_field(p, port, sexp_portp, bidirp))
1217 #define sexp_port_binaryp(p)    (sexp_pred_field(p, port, sexp_portp, binaryp))
1218 #define sexp_port_shutdownp(p)  (sexp_pred_field(p, port, sexp_portp, shutdownp))
1219 #define sexp_port_no_closep(p)  (sexp_pred_field(p, port, sexp_portp, no_closep))
1220 #define sexp_port_sourcep(p)    (sexp_pred_field(p, port, sexp_portp, sourcep))
1221 #define sexp_port_blockedp(p)   (sexp_pred_field(p, port, sexp_portp, blockedp))
1222 #define sexp_port_fold_casep(p) (sexp_pred_field(p, port, sexp_portp, fold_casep))
1223 #define sexp_port_cookie(p)     (sexp_pred_field(p, port, sexp_portp, cookie))
1224 #define sexp_port_buf(p)        (sexp_pred_field(p, port, sexp_portp, buf))
1225 #define sexp_port_size(p)       (sexp_pred_field(p, port, sexp_portp, size))
1226 #define sexp_port_offset(p)     (sexp_pred_field(p, port, sexp_portp, offset))
1227 #define sexp_port_flags(p)      (sexp_pred_field(p, port, sexp_portp, flags))
1228 #define sexp_port_fd(p)         (sexp_pred_field(p, port, sexp_portp, fd))
1229 
1230 #define sexp_fileno_fd(f)        (sexp_pred_field(f, fileno, sexp_filenop, fd))
1231 #define sexp_fileno_count(f)     (sexp_pred_field(f, fileno, sexp_filenop, count))
1232 #define sexp_fileno_openp(f)     (sexp_pred_field(f, fileno, sexp_filenop, openp))
1233 #define sexp_fileno_socketp(f)   (sexp_pred_field(f, fileno, sexp_filenop, socketp))
1234 #define sexp_fileno_no_closep(f) (sexp_pred_field(f, fileno, sexp_filenop, no_closep))
1235 
1236 #define sexp_ratio_numerator(q)   (sexp_pred_field(q, ratio, sexp_ratiop, numerator))
1237 #define sexp_ratio_denominator(q) (sexp_pred_field(q, ratio, sexp_ratiop, denominator))
1238 
1239 #define sexp_complex_real(q)   (sexp_pred_field(q, complex, sexp_complexp, real))
1240 #define sexp_complex_imag(q)   (sexp_pred_field(q, complex, sexp_complexp, imag))
1241 
1242 #define sexp_exception_kind(x)      (sexp_field(x, exception, SEXP_EXCEPTION, kind))
1243 #define sexp_exception_message(x)   (sexp_field(x, exception, SEXP_EXCEPTION, message))
1244 #define sexp_exception_irritants(x) (sexp_field(x, exception, SEXP_EXCEPTION, irritants))
1245 #define sexp_exception_procedure(x) (sexp_field(x, exception, SEXP_EXCEPTION, procedure))
1246 #define sexp_exception_source(x)    (sexp_field(x, exception, SEXP_EXCEPTION, source))
1247 #define sexp_exception_stack_trace(x) (sexp_field(x, exception, SEXP_EXCEPTION, stack_trace))
1248 
1249 #define sexp_trampolinep(x) (sexp_exceptionp(x) && sexp_exception_kind(x) == SEXP_TRAMPOLINE)
1250 #define sexp_trampoline_procedure(x) sexp_exception_procedure(x)
1251 #define sexp_trampoline_args(x) sexp_exception_irritants(x)
1252 #define sexp_trampoline_abortp(x) (sexp_exception_message(x) == SEXP_TRAMPOLINE)
1253 
1254 #define sexp_cpointer_freep(x)      (sexp_freep(x))
1255 #define sexp_cpointer_length(x)     (sexp_cpointer_field(x, length))
1256 #define sexp_cpointer_body(x)       (sexp_cpointer_field(x, body))
1257 #define sexp_cpointer_parent(x)     (sexp_cpointer_field(x, parent))
1258 #define sexp_cpointer_value(x)      (sexp_cpointer_field(x, value))
1259 #define sexp_cpointer_maybe_null_value(x) (sexp_not(x) ? NULL : sexp_cpointer_value(x))
1260 
1261 #define sexp_bytecode_length(x)   (sexp_field(x, bytecode, SEXP_BYTECODE, length))
1262 #define sexp_bytecode_max_depth(x) (sexp_field(x, bytecode, SEXP_BYTECODE, max_depth))
1263 #define sexp_bytecode_name(x)     (sexp_field(x, bytecode, SEXP_BYTECODE, name))
1264 #define sexp_bytecode_literals(x) (sexp_field(x, bytecode, SEXP_BYTECODE, literals))
1265 #define sexp_bytecode_source(x)   (sexp_field(x, bytecode, SEXP_BYTECODE, source))
1266 #define sexp_bytecode_data(x)     (sexp_field(x, bytecode, SEXP_BYTECODE, data))
1267 
1268 #define sexp_env_cell_syntactic_p(x)   ((x)->syntacticp)
1269 
1270 #define sexp_env_syntactic_p(x)   ((x)->syntacticp)
1271 #define sexp_env_parent(x)        (sexp_field(x, env, SEXP_ENV, parent))
1272 #define sexp_env_bindings(x)      (sexp_field(x, env, SEXP_ENV, bindings))
1273 #define sexp_env_renames(x)       (sexp_field(x, env, SEXP_ENV, renames))
1274 #define sexp_env_local_p(x)       (sexp_env_parent(x))
1275 #define sexp_env_global_p(x)      (! sexp_env_local_p(x))
1276 #define sexp_env_lambda(x)        (sexp_field(x, env, SEXP_ENV, lambda))
1277 
1278 #define sexp_macro_proc(x)        (sexp_field(x, macro, SEXP_MACRO, proc))
1279 #define sexp_macro_env(x)         (sexp_field(x, macro, SEXP_MACRO, env))
1280 #define sexp_macro_source(x)      (sexp_field(x, macro, SEXP_MACRO, source))
1281 #define sexp_macro_aux(x)         (sexp_field(x, macro, SEXP_MACRO, aux))
1282 
1283 #define sexp_synclo_env(x)        (sexp_field(x, synclo, SEXP_SYNCLO, env))
1284 #define sexp_synclo_free_vars(x)  (sexp_field(x, synclo, SEXP_SYNCLO, free_vars))
1285 #define sexp_synclo_expr(x)       (sexp_field(x, synclo, SEXP_SYNCLO, expr))
1286 #define sexp_synclo_rename(x)     (sexp_field(x, synclo, SEXP_SYNCLO, rename))
1287 
1288 #define sexp_core_code(x)         (sexp_field(x, core, SEXP_CORE, code))
1289 #define sexp_core_name(x)         (sexp_field(x, core, SEXP_CORE, name))
1290 
1291 #define sexp_dl_file(x)            (sexp_field(x, dl, SEXP_DL, file))
1292 #define sexp_dl_handle(x)          (sexp_field(x, dl, SEXP_DL, handle))
1293 
1294 #define sexp_opcode_class(x)       (sexp_field(x, opcode, SEXP_OPCODE, op_class))
1295 #define sexp_opcode_code(x)        (sexp_field(x, opcode, SEXP_OPCODE, code))
1296 #define sexp_opcode_num_args(x)    (sexp_field(x, opcode, SEXP_OPCODE, num_args))
1297 #define sexp_opcode_flags(x)       (sexp_field(x, opcode, SEXP_OPCODE, flags))
1298 #define sexp_opcode_inverse(x)     (sexp_field(x, opcode, SEXP_OPCODE, inverse))
1299 #define sexp_opcode_dl(x)          (sexp_field(x, opcode, SEXP_OPCODE, dl))
1300 #define sexp_opcode_name(x)        (sexp_field(x, opcode, SEXP_OPCODE, name))
1301 #define sexp_opcode_data(x)        (sexp_field(x, opcode, SEXP_OPCODE, data))
1302 #define sexp_opcode_data2(x)       (sexp_field(x, opcode, SEXP_OPCODE, data2))
1303 #define sexp_opcode_proc(x)        (sexp_field(x, opcode, SEXP_OPCODE, proc))
1304 #define sexp_opcode_return_type(x) (sexp_field(x, opcode, SEXP_OPCODE, ret_type))
1305 #define sexp_opcode_arg1_type(x)   (sexp_field(x, opcode, SEXP_OPCODE, arg1_type))
1306 #define sexp_opcode_arg2_type(x)   (sexp_field(x, opcode, SEXP_OPCODE, arg2_type))
1307 #define sexp_opcode_arg3_type(x)   (sexp_field(x, opcode, SEXP_OPCODE, arg3_type))
1308 #define sexp_opcode_argn_type(x)   (sexp_field(x, opcode, SEXP_OPCODE, argn_type))
1309 #define sexp_opcode_methods(x)     (sexp_field(x, opcode, SEXP_OPCODE, methods))
1310 #define sexp_opcode_func(x)        (sexp_field(x, opcode, SEXP_OPCODE, func))
1311 
1312 #define sexp_opcode_variadic_p(x)  (sexp_opcode_flags(x) & 1)
1313 #define sexp_opcode_opt_param_p(x) (sexp_opcode_flags(x) & 2)
1314 #define sexp_opcode_ref_trans_p(x) (sexp_opcode_flags(x) & 4)
1315 #define sexp_opcode_static_param_p(x) (sexp_opcode_flags(x) & 8)
1316 #define sexp_opcode_tail_call_p(x) (sexp_opcode_flags(x) & 16)
1317 
1318 #define sexp_lambda_name(x)        (sexp_field(x, lambda, SEXP_LAMBDA, name))
1319 #define sexp_lambda_params(x)      (sexp_field(x, lambda, SEXP_LAMBDA, params))
1320 #define sexp_lambda_locals(x)      (sexp_field(x, lambda, SEXP_LAMBDA, locals))
1321 #define sexp_lambda_defs(x)        (sexp_field(x, lambda, SEXP_LAMBDA, defs))
1322 #define sexp_lambda_flags(x)       (sexp_field(x, lambda, SEXP_LAMBDA, flags))
1323 #define sexp_lambda_body(x)        (sexp_field(x, lambda, SEXP_LAMBDA, body))
1324 #define sexp_lambda_fv(x)          (sexp_field(x, lambda, SEXP_LAMBDA, fv))
1325 #define sexp_lambda_sv(x)          (sexp_field(x, lambda, SEXP_LAMBDA, sv))
1326 #define sexp_lambda_return_type(x) (sexp_field(x, lambda, SEXP_LAMBDA, ret))
1327 #define sexp_lambda_param_types(x) (sexp_field(x, lambda, SEXP_LAMBDA, types))
1328 #define sexp_lambda_source(x)      (sexp_field(x, lambda, SEXP_LAMBDA, source))
1329 
1330 #define sexp_cnd_test(x)      (sexp_field(x, cnd, SEXP_CND, test))
1331 #define sexp_cnd_pass(x)      (sexp_field(x, cnd, SEXP_CND, pass))
1332 #define sexp_cnd_fail(x)      (sexp_field(x, cnd, SEXP_CND, fail))
1333 #define sexp_cnd_source(x)    (sexp_field(x, cnd, SEXP_CND, source))
1334 
1335 #define sexp_set_var(x)       (sexp_field(x, set, SEXP_SET, var))
1336 #define sexp_set_value(x)     (sexp_field(x, set, SEXP_SET, value))
1337 #define sexp_set_source(x)    (sexp_field(x, set, SEXP_SET, source))
1338 
1339 #define sexp_set_syn_var(x)    (sexp_field(x, set, SEXP_SET_SYN, var))
1340 #define sexp_set_syn_value(x)  (sexp_field(x, set, SEXP_SET_SYN, value))
1341 #define sexp_set_syn_source(x) (sexp_field(x, set, SEXP_SET_SYN, source))
1342 
1343 #define sexp_ref_name(x)      (sexp_field(x, ref, SEXP_REF, name))
1344 #define sexp_ref_cell(x)      ((x)->value.ref.cell)
1345 #define sexp_ref_loc(x)       (sexp_cdr(sexp_ref_cell(x)))
1346 #define sexp_ref_source(x)    (sexp_field(x, ref, SEXP_REF, source))
1347 
1348 #define sexp_seq_ls(x)        (sexp_field(x, seq, SEXP_SEQ, ls))
1349 #define sexp_seq_source(x)    (sexp_field(x, seq, SEXP_SEQ, source))
1350 
1351 #define sexp_lit_value(x)     (sexp_field(x, lit, SEXP_LIT, value))
1352 #define sexp_lit_source(x)    (sexp_field(x, lit, SEXP_LIT, source))
1353 
1354 #define sexp_stack_length(x)  (sexp_field(x, stack, SEXP_STACK, length))
1355 #define sexp_stack_top(x)     (sexp_field(x, stack, SEXP_STACK, top))
1356 #define sexp_stack_data(x)    (sexp_field(x, stack, SEXP_STACK, data))
1357 
1358 #define sexp_promise_donep(x) (sexp_field(x, promise, SEXP_PROMISE, donep))
1359 #define sexp_promise_value(x) (sexp_field(x, promise, SEXP_PROMISE, value))
1360 
1361 #define sexp_ephemeron_key(x)   (sexp_field(x, ephemeron, SEXP_EPHEMERON, key))
1362 #define sexp_ephemeron_value(x) (sexp_field(x, ephemeron, SEXP_EPHEMERON, value))
1363 
1364 #define sexp_context_env(x)      (sexp_field(x, context, SEXP_CONTEXT, env))
1365 #define sexp_context_stack(x)    (sexp_field(x, context, SEXP_CONTEXT, stack))
1366 #define sexp_context_parent(x)   (sexp_field(x, context, SEXP_CONTEXT, parent))
1367 #define sexp_context_child(x)    (sexp_field(x, context, SEXP_CONTEXT, child))
1368 #define sexp_context_mark_stack(x)     (sexp_field(x, context, SEXP_CONTEXT, mark_stack))
1369 #define sexp_context_mark_stack_ptr(x) (sexp_field(x, context, SEXP_CONTEXT, mark_stack_ptr))
1370 #define sexp_context_saves(x)    (sexp_field(x, context, SEXP_CONTEXT, saves))
1371 #define sexp_context_tailp(x)    (sexp_field(x, context, SEXP_CONTEXT, tailp))
1372 #define sexp_context_tracep(x)   (sexp_field(x, context, SEXP_CONTEXT, tracep))
1373 #define sexp_context_globals(x)  (sexp_field(x, context, SEXP_CONTEXT, globals))
1374 #define sexp_context_dk(x)       (sexp_field(x, context, SEXP_CONTEXT, dk))
1375 #define sexp_context_params(x)   (sexp_field(x, context, SEXP_CONTEXT, params))
1376 #define sexp_context_last_fp(x)  (sexp_field(x, context, SEXP_CONTEXT, last_fp))
1377 #define sexp_context_gc_count(x) (sexp_field(x, context, SEXP_CONTEXT, gc_count))
1378 #if SEXP_USE_TIME_GC
1379 #define sexp_context_gc_usecs(x) (sexp_field(x, context, SEXP_CONTEXT, gc_usecs))
1380 #else
1381 #define sexp_context_gc_usecs(x) 0
1382 #endif
1383 #if SEXP_USE_TRACK_ALLOC_TIMES
1384 #define sexp_context_alloc_count(x) (sexp_field(x, context, SEXP_CONTEXT, alloc_count))
1385 #define sexp_context_alloc_usecs(x) (sexp_field(x, context, SEXP_CONTEXT, alloc_usecs))
1386 #define sexp_context_alloc_usecs_sq(x) (sexp_field(x, context, SEXP_CONTEXT, alloc_usecs_sq))
1387 #endif
1388 #if SEXP_USE_TRACK_ALLOC_SIZES
1389 #define sexp_context_alloc_histogram(x) (sexp_field(x, context, SEXP_CONTEXT, alloc_histogram))
1390 #endif
1391 #define sexp_context_refuel(x)   (sexp_field(x, context, SEXP_CONTEXT, refuel))
1392 #define sexp_context_ip(x)       (sexp_field(x, context, SEXP_CONTEXT, ip))
1393 #define sexp_context_proc(x)     (sexp_field(x, context, SEXP_CONTEXT, proc))
1394 #define sexp_context_timeval(x)  (sexp_field(x, context, SEXP_CONTEXT, tval))
1395 #define sexp_context_name(x)     (sexp_field(x, context, SEXP_CONTEXT, name))
1396 #define sexp_context_specific(x) (sexp_field(x, context, SEXP_CONTEXT, specific))
1397 #define sexp_context_event(x)    (sexp_field(x, context, SEXP_CONTEXT, event))
1398 #define sexp_context_timeoutp(x) (sexp_field(x, context, SEXP_CONTEXT, timeoutp))
1399 #define sexp_context_waitp(x)    (sexp_field(x, context, SEXP_CONTEXT, waitp))
1400 #define sexp_context_dl(x)       (sexp_field(x, context, SEXP_CONTEXT, dl))
1401 
1402 #define sexp_context_result(x)   (sexp_field(x, context, SEXP_CONTEXT, result))
1403 #define sexp_context_errorp(x)   (sexp_field(x, context, SEXP_CONTEXT, errorp))
1404 #define sexp_context_interruptp(x) (sexp_field(x, context, SEXP_CONTEXT, interruptp))
1405 
1406 /* during compilation, sexp_context_specific is set to a vector */
1407 /* containing the following elements: */
1408 
1409 #define sexp_context_bc(x)       (sexp_vector_ref(sexp_context_specific(x), SEXP_ZERO))
1410 #define sexp_context_fv(x)       (sexp_vector_ref(sexp_context_specific(x), SEXP_ONE))
1411 #define sexp_context_lambda(x)   (sexp_vector_ref(sexp_context_specific(x), SEXP_TWO))
1412 #define sexp_context_pos(x)      (sexp_vector_ref(sexp_context_specific(x), SEXP_THREE))
1413 #define sexp_context_depth(x)    (sexp_vector_ref(sexp_context_specific(x), SEXP_FOUR))
1414 #define sexp_context_max_depth(x) (sexp_vector_ref(sexp_context_specific(x), SEXP_FIVE))
1415 #define sexp_context_exception(x) (sexp_vector_ref(sexp_context_specific(x), SEXP_SIX))
1416 
1417 #if SEXP_USE_ALIGNED_BYTECODE
1418 SEXP_API void sexp_context_align_pos(sexp ctx);
1419 #else
1420 #define sexp_context_align_pos(ctx)
1421 #endif
1422 
1423 #define sexp_global(ctx,x)      (sexp_vector_data(sexp_context_globals(ctx))[x])
1424 
1425 #if SEXP_USE_GLOBAL_HEAP
1426 #if ! SEXP_USE_BOEHM
1427 SEXP_API sexp_heap sexp_global_heap;
1428 #endif
1429 #define sexp_context_heap(ctx)     sexp_global_heap
1430 #define sexp_context_max_size(ctx) 0
1431 #else
1432 #define sexp_context_heap(ctx)     ((ctx)->value.context.heap)
1433 #define sexp_context_max_size(ctx) sexp_context_heap(ctx)->max_size
1434 #endif
1435 
1436 #if SEXP_USE_GLOBAL_SYMBOLS
1437 #define sexp_context_symbols(ctx) sexp_symbol_table
1438 SEXP_API sexp sexp_symbol_table[SEXP_SYMBOL_TABLE_SIZE];
1439 #else
1440 #define sexp_context_symbols(ctx) sexp_vector_data(sexp_global(ctx, SEXP_G_SYMBOLS))
1441 #endif
1442 
1443 #define sexp_context_types(ctx)    sexp_vector_data(sexp_global(ctx, SEXP_G_TYPES))
1444 #define sexp_type_by_index(ctx,i)  (sexp_context_types(ctx)[i])
1445 #define sexp_context_num_types(ctx)             \
1446   sexp_unbox_fixnum(sexp_global(ctx, SEXP_G_NUM_TYPES))
1447 #define sexp_context_type_array_size(ctx)                               \
1448   sexp_vector_length(sexp_global(ctx, SEXP_G_TYPES))
1449 
1450 #define sexp_object_type(ctx,x)        (sexp_type_by_index(ctx, ((x)->tag)))
1451 #define sexp_object_type_name(ctx,x)   (sexp_type_name(sexp_object_type(ctx, x)))
1452 #define sexp_type_name_by_index(ctx,i) (sexp_type_name(sexp_type_by_index(ctx,i)))
1453 
1454 #define sexp_type_size_of_object(t, x)                                  \
1455   (((sexp_uint_t*)((char*)x + sexp_type_size_off(t)))[0]                \
1456    * sexp_type_size_scale(t)                                            \
1457    + sexp_type_size_base(t))
1458 #define sexp_type_num_slots_of_object(t, x)                             \
1459   (((sexp_uint_t*)((char*)x + sexp_type_field_len_off(t)))[0]           \
1460    * sexp_type_field_len_scale(t)                                       \
1461    + sexp_type_field_len_base(t))
1462 #define sexp_type_num_eq_slots_of_object(t, x)                          \
1463   (((sexp_uint_t*)((char*)x + sexp_type_field_len_off(t)))[0]           \
1464    * sexp_type_field_len_scale(t)                                       \
1465    + sexp_type_field_eq_len_base(t))
1466 #define sexp_type_num_weak_slots_of_object(t, x)                        \
1467   (((sexp_uint_t*)((char*)x + sexp_type_weak_len_off(t)))[0]            \
1468    * sexp_type_weak_len_scale(t)                                        \
1469    + sexp_type_weak_len_base(t))
1470 
1471 #define sexp_context_top(x)     (sexp_stack_top(sexp_context_stack(x)))
1472 
1473 #define sexp_type_tag(x)               (sexp_field(x, type, SEXP_TYPE, tag))
1474 #define sexp_type_field_base(x)        (sexp_field(x, type, SEXP_TYPE, field_base))
1475 #define sexp_type_field_eq_len_base(x) (sexp_field(x, type, SEXP_TYPE, field_eq_len_base))
1476 #define sexp_type_field_len_base(x)    (sexp_field(x, type, SEXP_TYPE, field_len_base))
1477 #define sexp_type_field_len_off(x)     (sexp_field(x, type, SEXP_TYPE, field_len_off))
1478 #define sexp_type_field_len_scale(x)   (sexp_field(x, type, SEXP_TYPE, field_len_scale))
1479 #define sexp_type_size_base(x)         (sexp_field(x, type, SEXP_TYPE, size_base))
1480 #define sexp_type_size_off(x)          (sexp_field(x, type, SEXP_TYPE, size_off))
1481 #define sexp_type_size_scale(x)        (sexp_field(x, type, SEXP_TYPE, size_scale))
1482 #define sexp_type_weak_base(x)         (sexp_field(x, type, SEXP_TYPE, weak_base))
1483 #define sexp_type_weak_len_base(x)     (sexp_field(x, type, SEXP_TYPE, weak_len_base))
1484 #define sexp_type_weak_len_off(x)      (sexp_field(x, type, SEXP_TYPE, weak_len_off))
1485 #define sexp_type_weak_len_scale(x)    (sexp_field(x, type, SEXP_TYPE, weak_len_scale))
1486 #define sexp_type_weak_len_extra(x)    (sexp_field(x, type, SEXP_TYPE, weak_len_extra))
1487 #define sexp_type_depth(x)             (sexp_field(x, type, SEXP_TYPE, depth))
1488 #define sexp_type_name(x)              (sexp_field(x, type, SEXP_TYPE, name))
1489 #define sexp_type_cpl(x)               (sexp_field(x, type, SEXP_TYPE, cpl))
1490 #define sexp_type_slots(x)             (sexp_field(x, type, SEXP_TYPE, slots))
1491 #define sexp_type_getters(x)           (sexp_field(x, type, SEXP_TYPE, getters))
1492 #define sexp_type_setters(x)           (sexp_field(x, type, SEXP_TYPE, setters))
1493 #define sexp_type_finalize(x)          (sexp_field(x, type, SEXP_TYPE, finalize))
1494 #define sexp_type_finalize_name(x)     (sexp_field(x, type, SEXP_TYPE, finalize_name))
1495 #define sexp_type_print(x)             (sexp_field(x, type, SEXP_TYPE, print))
1496 #define sexp_type_dl(x)                (sexp_field(x, type, SEXP_TYPE, dl))
1497 #define sexp_type_id(x)                (sexp_field(x, type, SEXP_TYPE, id))
1498 
1499 #define sexp_bignum_sign(x)            (sexp_field(x, bignum, SEXP_BIGNUM, sign))
1500 #define sexp_bignum_length(x)          (sexp_field(x, bignum, SEXP_BIGNUM, length))
1501 #define sexp_bignum_data(x)            (sexp_field(x, bignum, SEXP_BIGNUM, data))
1502 
1503 /****************************** arithmetic ****************************/
1504 
1505 #define sexp_fx_add(a, b) ((sexp)(((sexp_sint_t)a)+((sexp_sint_t)b)-SEXP_FIXNUM_TAG))
1506 #define sexp_fx_sub(a, b) ((sexp)(((sexp_sint_t)a)-((sexp_sint_t)b)+SEXP_FIXNUM_TAG))
1507 #define sexp_fx_mul(a, b) ((sexp)((((((sexp_sint_t)a)-SEXP_FIXNUM_TAG)*(((sexp_sint_t)b)>>SEXP_FIXNUM_BITS))+SEXP_FIXNUM_TAG)))
1508 #define sexp_fx_div(a, b) (sexp_make_fixnum(sexp_unbox_fixnum(a) / sexp_unbox_fixnum(b)))
1509 #define sexp_fx_rem(a, b) (sexp_make_fixnum(sexp_unbox_fixnum(a) % sexp_unbox_fixnum(b)))
1510 #define sexp_fx_sign(a)   (+1 | (((sexp_sint_t)(a)) >> (sizeof(sexp_sint_t)*8 - 1)))
1511 #define sexp_fx_neg(a)    (sexp_make_fixnum(-(sexp_unbox_fixnum(a))))
1512 #define sexp_fx_abs(a)    ((((sexp_sint_t)a) < 0) ? sexp_fx_neg(a) : a)
1513 
1514 #define sexp_unbox_fx_abs(a) ((((sexp_sint_t)a) < 0) ? -sexp_unbox_fixnum(a) : sexp_unbox_fixnum(a))
1515 
1516 #define sexp_fp_add(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) + sexp_flonum_value(b)))
1517 #define sexp_fp_sub(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) - sexp_flonum_value(b)))
1518 #define sexp_fp_mul(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) * sexp_flonum_value(b)))
1519 #define sexp_fp_div(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) / sexp_flonum_value(b)))
1520 
1521 #if ! (SEXP_USE_FLONUMS || SEXP_USE_BIGNUMS)
1522 #define sexp_add(ctx, a, b) sexp_fx_add(a, b)
1523 #define sexp_sub(ctx, a, b) sexp_fx_sub(a, b)
1524 #define sexp_mul(ctx, a, b) sexp_fx_mul(a, b)
1525 #define sexp_div(ctx, a, b) sexp_fx_div(a, b)
1526 #endif
1527 
1528 /****************************** utilities *****************************/
1529 
1530 enum sexp_context_globals {
1531 #if SEXP_USE_STABLE_ABI || ! SEXP_USE_GLOBAL_SYMBOLS
1532   SEXP_G_SYMBOLS,
1533 #endif
1534   SEXP_G_ENDIANNESS,
1535   SEXP_G_TYPES,
1536   SEXP_G_FEATURES,
1537   SEXP_G_NUM_TYPES,
1538   SEXP_G_OOM_ERROR,             /* out of memory exception object */
1539   SEXP_G_OOS_ERROR,             /* out of stack exception object */
1540   SEXP_G_ABI_ERROR,             /* incompatible ABI loading library */
1541   SEXP_G_INTERRUPT_ERROR,       /* C-c in the repl */
1542   SEXP_G_OPTIMIZATIONS,
1543   SEXP_G_SIGNAL_HANDLERS,
1544   SEXP_G_META_ENV,
1545   SEXP_G_MODULE_PATH,
1546   SEXP_G_QUOTE_SYMBOL,
1547   SEXP_G_QUASIQUOTE_SYMBOL,
1548   SEXP_G_UNQUOTE_SYMBOL,
1549   SEXP_G_UNQUOTE_SPLICING_SYMBOL,
1550   SEXP_G_SYNTAX_SYMBOL,
1551   SEXP_G_QUASISYNTAX_SYMBOL,
1552   SEXP_G_UNSYNTAX_SYMBOL,
1553   SEXP_G_UNSYNTAX_SPLICING_SYMBOL,
1554   SEXP_G_EMPTY_VECTOR,
1555   SEXP_G_CUR_IN_SYMBOL,
1556   SEXP_G_CUR_OUT_SYMBOL,
1557   SEXP_G_CUR_ERR_SYMBOL,
1558   SEXP_G_INTERACTION_ENV_SYMBOL,
1559   SEXP_G_CONTINUABLE_SYMBOL,
1560   SEXP_G_ERR_HANDLER,
1561   SEXP_G_RESUMECC_BYTECODE,
1562   SEXP_G_FINAL_RESUMER,
1563   SEXP_G_RANDOM_SOURCE,
1564   SEXP_G_STRICT_P,
1565   SEXP_G_NO_TAIL_CALLS_P,
1566 #if SEXP_USE_STABLE_ABI || SEXP_USE_FOLD_CASE_SYMS
1567   SEXP_G_FOLD_CASE_P,
1568 #endif
1569 #if SEXP_USE_STABLE_ABI || SEXP_USE_WEAK_REFERENCES
1570   SEXP_G_WEAK_OBJECTS_PRESENT,
1571   SEXP_G_FILE_DESCRIPTORS,
1572   SEXP_G_NUM_FILE_DESCRIPTORS,
1573 #endif
1574 #if SEXP_USE_STABLE_ABI || ! SEXP_USE_BOEHM
1575   SEXP_G_PRESERVATIVES,
1576 #endif
1577 #if SEXP_USE_STABLE_ABI || SEXP_USE_GREEN_THREADS
1578   SEXP_G_IO_BLOCK_ERROR,
1579   SEXP_G_IO_BLOCK_ONCE_ERROR,
1580   SEXP_G_THREAD_TERMINATE_ERROR,
1581   SEXP_G_THREADS_SCHEDULER,
1582   SEXP_G_THREADS_FRONT,
1583   SEXP_G_THREADS_BACK,
1584   SEXP_G_THREADS_PAUSED,
1585   SEXP_G_THREADS_SIGNALS,
1586   SEXP_G_THREADS_SIGNAL_RUNNER,
1587   SEXP_G_THREADS_POLL_FDS,
1588   SEXP_G_THREADS_FD_THREADS,
1589   SEXP_G_THREADS_BLOCKER,
1590   SEXP_G_THREADS_MUTEX_ID,
1591   SEXP_G_THREADS_POLLFDS_ID,
1592   SEXP_G_ATOMIC_P,
1593 #endif
1594   SEXP_G_NUM_GLOBALS
1595 };
1596 
1597 #define sexp_list1(x,a)        sexp_cons((x), (a), SEXP_NULL)
1598 
1599 SEXP_API sexp sexp_push_op(sexp ctx, sexp* loc, sexp x);
1600 
1601 #if SEXP_USE_UNSAFE_PUSH
1602 #define sexp_push(ctx, ls, x)    ((ls) = sexp_cons((ctx), (x), (ls)))
1603 #else
1604 #define sexp_push(ctx, ls, x)    (sexp_push_op((ctx), &(ls), (x)))
1605 #endif
1606 #define sexp_insert(ctx, ls, x)  ((sexp_memq(ctx, (x), (ls)) != SEXP_FALSE) ? (ls) : sexp_push((ctx), (ls), (x)))
1607 
1608 #define sexp_pair_source(x) (sexp_field(x, pair, SEXP_PAIR, source))
1609 
1610 #define sexp_car(x)         (sexp_field(x, pair, SEXP_PAIR, car))
1611 #define sexp_cdr(x)         (sexp_field(x, pair, SEXP_PAIR, cdr))
1612 
1613 #define sexp_caar(x)      (sexp_car(sexp_car(x)))
1614 #define sexp_cadr(x)      (sexp_car(sexp_cdr(x)))
1615 #define sexp_cdar(x)      (sexp_cdr(sexp_car(x)))
1616 #define sexp_cddr(x)      (sexp_cdr(sexp_cdr(x)))
1617 #define sexp_caaar(x)     (sexp_car(sexp_caar(x)))
1618 #define sexp_caadr(x)     (sexp_car(sexp_cadr(x)))
1619 #define sexp_cadar(x)     (sexp_car(sexp_cdar(x)))
1620 #define sexp_caddr(x)     (sexp_car(sexp_cddr(x)))
1621 #define sexp_cdaar(x)     (sexp_cdr(sexp_caar(x)))
1622 #define sexp_cdadr(x)     (sexp_cdr(sexp_cadr(x)))
1623 #define sexp_cddar(x)     (sexp_cdr(sexp_cdar(x)))
1624 #define sexp_cdddr(x)     (sexp_cdr(sexp_cddr(x)))
1625 #define sexp_cadddr(x)    (sexp_cadr(sexp_cddr(x))) /* just these two */
1626 #define sexp_cddddr(x)    (sexp_cddr(sexp_cddr(x)))
1627 
1628 /***************************** general API ****************************/
1629 
1630 #define sexp_read_char(x, p) (sexp_port_buf(p) ? ((sexp_port_offset(p) < sexp_port_size(p)) ? ((unsigned char*)sexp_port_buf(p))[sexp_port_offset(p)++] : sexp_buffered_read_char(x, p)) : getc(sexp_port_stream(p)))
1631 #define sexp_push_char(x, c, p) ((c!=EOF) && (sexp_port_buf(p) ? (sexp_port_buf(p)[--sexp_port_offset(p)] = ((char)(c))) : ungetc(c, sexp_port_stream(p))))
1632 #define sexp_write_char(x, c, p) (sexp_port_buf(p) ? ((sexp_port_offset(p) < sexp_port_size(p)) ? ((((sexp_port_buf(p))[sexp_port_offset(p)++]) = (char)(c)), 0) : sexp_buffered_write_char(x, c, p)) : putc(c, sexp_port_stream(p)))
1633 #define sexp_write_string(x, s, p) (sexp_port_buf(p) ? sexp_buffered_write_string(x, s, p) : fputs(s, sexp_port_stream(p)))
1634 #define sexp_write_string_n(x, s, n, p) (sexp_port_buf(p) ? sexp_buffered_write_string_n(x, s, n, p) : fwrite(s, 1, n, sexp_port_stream(p)))
1635 #define sexp_flush(x, p) (sexp_port_buf(p) ? sexp_buffered_flush(x, p, 0) : fflush(sexp_port_stream(p)))
1636 #define sexp_flush_forced(x, p) (sexp_port_buf(p) ? sexp_buffered_flush(x, p, 1) : fflush(sexp_port_stream(p)))
1637 
1638 SEXP_API int sexp_buffered_read_char (sexp ctx, sexp p);
1639 SEXP_API int sexp_buffered_write_char (sexp ctx, int c, sexp p);
1640 SEXP_API int sexp_buffered_write_string_n (sexp ctx, const char *str, sexp_uint_t len, sexp p);
1641 SEXP_API int sexp_buffered_write_string (sexp ctx, const char *str, sexp p);
1642 SEXP_API int sexp_buffered_flush (sexp ctx, sexp p, int forcep);
1643 
1644 #define sexp_newline(ctx, p) sexp_write_char((ctx), '\n', (p))
1645 #define sexp_at_eofp(p)      (feof(sexp_port_stream(p)))
1646 #define sexp_port_fileno(p)  (sexp_port_stream(p) ? fileno(sexp_port_stream(p)) : sexp_filenop(sexp_port_fd(p)) ? sexp_fileno_fd(sexp_port_fd(p)) : -1)
1647 
1648 #if SEXP_USE_AUTOCLOSE_PORTS
1649 #define SEXP_FINALIZE_PORT sexp_finalize_port
1650 #define SEXP_FINALIZE_PORTN (sexp)"sexp_finalize_port"
1651 #define SEXP_FINALIZE_FILENO sexp_finalize_fileno
1652 #define SEXP_FINALIZE_FILENON (sexp)"sexp_finalize_fileno"
1653 #else
1654 #define SEXP_FINALIZE_PORT NULL
1655 #define SEXP_FINALIZE_PORTN NULL
1656 #define SEXP_FINALIZE_FILENO NULL
1657 #define SEXP_FINALIZE_FILENON NULL
1658 #endif
1659 
1660 #if SEXP_USE_DL
1661 sexp sexp_finalize_dl (sexp ctx, sexp self, sexp_sint_t n, sexp dl);
1662 #define SEXP_FINALIZE_DL sexp_finalize_dl
1663 #define SEXP_FINALIZE_DLN (sexp)"sexp_finalize_dl"
1664 #else
1665 #define SEXP_FINALIZE_DL NULL
1666 #define SEXP_FINALIZE_DLN NULL
1667 #endif
1668 
1669 #if SEXP_USE_TRACK_ALLOC_SOURCE
1670 #define sexp_current_source_param , const char* source
1671 #else
1672 #define sexp_current_source_param
1673 #endif
1674 
1675 SEXP_API sexp sexp_alloc_tagged_aux(sexp ctx, size_t size, sexp_uint_t tag sexp_current_source_param);
1676 SEXP_API sexp sexp_make_context(sexp ctx, size_t size, size_t max_size);
1677 SEXP_API sexp sexp_cons_op(sexp ctx, sexp self, sexp_sint_t n, sexp head, sexp tail);
1678 SEXP_API sexp sexp_list2(sexp ctx, sexp a, sexp b);
1679 SEXP_API sexp sexp_list3(sexp ctx, sexp a, sexp b, sexp c);
1680 SEXP_API sexp sexp_equalp_bound (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp depth, sexp bound);
1681 SEXP_API sexp sexp_equalp_op (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b);
1682 SEXP_API sexp sexp_listp_op(sexp ctx, sexp self, sexp_sint_t n, sexp obj);
1683 SEXP_API sexp sexp_reverse_op(sexp ctx, sexp self, sexp_sint_t n, sexp ls);
1684 SEXP_API sexp sexp_nreverse_op(sexp ctx, sexp self, sexp_sint_t n, sexp ls);
1685 SEXP_API sexp sexp_copy_list_op(sexp ctx, sexp self, sexp_sint_t n, sexp ls);
1686 SEXP_API sexp sexp_append2_op(sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b);
1687 SEXP_API sexp sexp_memq_op(sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp ls);
1688 SEXP_API sexp sexp_assq_op(sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp ls);
1689 SEXP_API sexp sexp_length_op(sexp ctx, sexp self, sexp_sint_t n, sexp ls);
1690 SEXP_API sexp sexp_c_string(sexp ctx, const char *str, sexp_sint_t slen);
1691 SEXP_API sexp sexp_make_ephemeron_op(sexp ctx, sexp self, sexp_sint_t n, sexp key, sexp value);
1692 SEXP_API sexp sexp_make_bytes_op(sexp ctx, sexp self, sexp_sint_t n, sexp len, sexp i);
1693 SEXP_API sexp sexp_make_uvector_op(sexp ctx, sexp self, sexp_sint_t n, sexp elt_type, sexp len);
1694 SEXP_API sexp sexp_make_string_op(sexp ctx, sexp self, sexp_sint_t n, sexp len, sexp ch);
1695 SEXP_API sexp sexp_substring_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp start, sexp end);
1696 SEXP_API sexp sexp_subbytes_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp start, sexp end);
1697 SEXP_API sexp sexp_string_concatenate_op (sexp ctx, sexp self, sexp_sint_t n, sexp str_ls, sexp sep);
1698 SEXP_API sexp sexp_intern (sexp ctx, const char *str, sexp_sint_t len);
1699 SEXP_API sexp sexp_string_to_symbol_op (sexp ctx, sexp self, sexp_sint_t n, sexp str);
1700 SEXP_API sexp sexp_symbol_to_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp sym);
1701 SEXP_API sexp sexp_string_to_number_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp b);
1702 SEXP_API sexp sexp_flonump_op (sexp ctx, sexp self, sexp_sint_t n, sexp x);
1703 SEXP_API sexp sexp_make_vector_op (sexp ctx, sexp self, sexp_sint_t n, sexp len, sexp dflt);
1704 SEXP_API sexp sexp_list_to_vector_op (sexp ctx, sexp self, sexp_sint_t n, sexp ls);
1705 SEXP_API sexp sexp_list_to_uvector_op (sexp ctx, sexp self, sexp_sint_t n, sexp etype, sexp ls);
1706 SEXP_API sexp sexp_make_cpointer (sexp ctx, sexp_uint_t type_id, void* value, sexp parent, int freep);
1707 SEXP_API int sexp_is_separator(int c);
1708 SEXP_API sexp sexp_write_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp out);
1709 SEXP_API sexp sexp_flush_output_op (sexp ctx, sexp self, sexp_sint_t n, sexp out);
1710 SEXP_API sexp sexp_read_string (sexp ctx, sexp in, int sentinel);
1711 SEXP_API sexp sexp_read_symbol (sexp ctx, sexp in, int init, int internp);
1712 SEXP_API sexp sexp_read_number (sexp ctx, sexp in, int base, int exactp);
1713 #if SEXP_USE_BIGNUMS
1714 SEXP_API sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init,
1715                                 signed char sign, sexp_uint_t base);
1716 SEXP_API sexp sexp_write_bignum (sexp ctx, sexp a, sexp out, sexp_uint_t base);
1717 #endif
1718 SEXP_API sexp sexp_read_float_tail(sexp ctx, sexp in, double whole, int negp);
1719 #if SEXP_USE_COMPLEX
1720 SEXP_API sexp sexp_read_complex_tail(sexp ctx, sexp in, sexp res);
1721 #endif
1722 SEXP_API sexp sexp_read_raw (sexp ctx, sexp in, sexp *shares);
1723 SEXP_API sexp sexp_read_op (sexp ctx, sexp self, sexp_sint_t n, sexp in);
1724 SEXP_API sexp sexp_char_ready_p (sexp ctx, sexp self, sexp_sint_t n, sexp in);
1725 SEXP_API sexp sexp_read_from_string (sexp ctx, const char *str, sexp_sint_t len);
1726 SEXP_API sexp sexp_read_error (sexp ctx, const char *msg, sexp ir, sexp port);
1727 SEXP_API sexp sexp_write_to_string (sexp ctx, sexp obj);
1728 SEXP_API sexp sexp_write_simple_object (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp writer, sexp out);
1729 SEXP_API sexp sexp_finalize_port (sexp ctx, sexp self, sexp_sint_t n, sexp port);
1730 SEXP_API sexp sexp_make_fileno_op (sexp ctx, sexp self, sexp_sint_t n, sexp fd, sexp no_closep);
1731 SEXP_API sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name);
1732 SEXP_API sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name);
1733 SEXP_API sexp sexp_open_input_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp fileno, sexp socketp);
1734 SEXP_API sexp sexp_open_output_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp fileno, sexp socketp);
1735 SEXP_API sexp sexp_make_non_null_input_port (sexp ctx, FILE* in, sexp name);
1736 SEXP_API sexp sexp_make_non_null_output_port (sexp ctx, FILE* out, sexp name);
1737 SEXP_API sexp sexp_make_non_null_input_output_port (sexp ctx, FILE* io, sexp name);
1738 SEXP_API sexp sexp_port_outputp_op (sexp ctx, sexp self, sexp_sint_t n, sexp port);
1739 SEXP_API sexp sexp_port_binaryp_op (sexp ctx, sexp self, sexp_sint_t n, sexp port);
1740 SEXP_API sexp sexp_port_openp_op (sexp ctx, sexp self, sexp_sint_t n, sexp port);
1741 #if SEXP_USE_FOLD_CASE_SYMS
1742 SEXP_API sexp sexp_get_port_fold_case (sexp ctx, sexp self, sexp_sint_t n, sexp in);
1743 SEXP_API sexp sexp_set_port_fold_case (sexp ctx, sexp self, sexp_sint_t n, sexp in, sexp x);
1744 #endif
1745 #if SEXP_USE_OBJECT_BRACE_LITERALS
1746 SEXP_API sexp sexp_lookup_type_op (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp id);
1747 #endif
1748 SEXP_API sexp sexp_open_input_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp str);
1749 SEXP_API sexp sexp_open_output_string_op (sexp ctx, sexp self, sexp_sint_t n);
1750 SEXP_API sexp sexp_get_output_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp port);
1751 SEXP_API sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp source);
1752 SEXP_API sexp sexp_user_exception (sexp ctx, sexp self, const char *msg, sexp x);
1753 SEXP_API sexp sexp_user_exception_ls (sexp ctx, sexp self, const char *msg, int n, ...);
1754 SEXP_API sexp sexp_file_exception (sexp ctx, sexp self, const char *msg, sexp x);
1755 SEXP_API sexp sexp_type_exception (sexp ctx, sexp self, sexp_uint_t type_id, sexp x);
1756 SEXP_API sexp sexp_xtype_exception (sexp ctx, sexp self, const char *msg, sexp x);
1757 SEXP_API sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end);
1758 SEXP_API sexp sexp_print_exception_op (sexp ctx, sexp self, sexp_sint_t n, sexp exn, sexp out);
1759 SEXP_API sexp sexp_stack_trace_op (sexp ctx, sexp self, sexp_sint_t n, sexp out);
1760 SEXP_API sexp sexp_print_exception_stack_trace_op (sexp ctx, sexp self, sexp_sint_t n, sexp exn, sexp out);
1761 SEXP_API sexp sexp_apply (sexp context, sexp proc, sexp args);
1762 SEXP_API sexp sexp_apply1 (sexp ctx, sexp f, sexp x);
1763 SEXP_API sexp sexp_apply2 (sexp ctx, sexp f, sexp x, sexp y);
1764 SEXP_API sexp sexp_apply3 (sexp ctx, sexp f, sexp x, sexp y, sexp z);
1765 SEXP_API sexp sexp_apply_no_err_handler (sexp ctx, sexp proc, sexp args);
1766 SEXP_API sexp sexp_make_trampoline (sexp ctx, sexp proc, sexp args);
1767 SEXP_API sexp sexp_make_foreign (sexp ctx, const char *name, int num_args, int flags, const char *fname, sexp_proc1 f, sexp data);
1768 SEXP_API void sexp_init(void);
1769 
1770 #if SEXP_USE_UTF8_STRINGS
1771 SEXP_API int sexp_utf8_initial_byte_count (int c);
1772 SEXP_API int sexp_utf8_char_byte_count (int c);
1773 SEXP_API sexp_uint_t sexp_string_utf8_length (unsigned char *p, long len);
1774 SEXP_API char* sexp_string_utf8_prev (unsigned char *p);
1775 SEXP_API sexp sexp_string_utf8_ref (sexp ctx, sexp str, sexp i);
1776 SEXP_API sexp sexp_string_utf8_index_ref (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp i);
1777 SEXP_API sexp sexp_string_index_to_cursor (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp index);
1778 SEXP_API sexp sexp_string_cursor_to_index (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp offset);
1779 SEXP_API sexp sexp_string_cursor_offset (sexp ctx, sexp self, sexp_sint_t n, sexp cur);
1780 SEXP_API sexp sexp_utf8_substring_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp start, sexp end);
1781 SEXP_API void sexp_utf8_encode_char (unsigned char* p, int len, int c);
1782 SEXP_API int sexp_write_utf8_char (sexp ctx, int c, sexp out);
1783 #define sexp_string_ref(ctx, s, i)    (sexp_string_utf8_index_ref(ctx, NULL, 2, s, i))
1784 #define sexp_string_set(ctx, s, i, ch) (sexp_string_utf8_index_set(ctx, NULL, 3, s, i, ch))
1785 #define sexp_string_cursor_ref(ctx, s, i)    (sexp_string_utf8_ref(ctx, s, i))
1786 #define sexp_string_cursor_set(ctx, s, i)    (sexp_string_utf8_set(ctx, s, i))
1787 #define sexp_string_cursor_next(s, i) sexp_make_string_cursor(sexp_unbox_string_cursor(i) + sexp_utf8_initial_byte_count(((unsigned char*)sexp_string_data(s))[sexp_unbox_string_cursor(i)]))
1788 #define sexp_string_cursor_prev(s, i) sexp_make_string_cursor(sexp_string_utf8_prev((unsigned char*)sexp_string_data(s)+sexp_unbox_string_cursor(i)) - sexp_string_data(s))
1789 #define sexp_string_length(s) sexp_string_utf8_length((unsigned char*)sexp_string_data(s), sexp_string_size(s))
1790 #define sexp_substring(ctx, s, i, j) sexp_utf8_substring_op(ctx, NULL, 3, s, i, j)
1791 #define sexp_substring_cursor(ctx, s, i, j) sexp_substring_op(ctx, NULL, 3, s, i, j)
1792 #else  /* ASCII strings */
1793 #define sexp_string_ref(ctx, s, i)    (sexp_make_character((unsigned char)sexp_string_data(s)[sexp_unbox_fixnum(i)]))
1794 #define sexp_string_set(ctx, s, i, ch) (sexp_string_data(s)[sexp_unbox_fixnum(i)] = sexp_unbox_character(ch))
1795 #define sexp_string_cursor_ref(ctx, s, i) sexp_string_ref(ctx, s, i)
1796 #define sexp_string_cursor_set(ctx, s, i, ch) sexp_string_set(ctx, s, i, ch)
1797 #define sexp_string_cursor_next(s, i) sexp_make_fixnum(sexp_unbox_fixnum(i) + 1)
1798 #define sexp_string_cursor_prev(s, i) sexp_make_fixnum(sexp_unbox_fixnum(i) - 1)
1799 #define sexp_string_length(s) sexp_string_size(s)
1800 #define sexp_substring(ctx, s, i, j) sexp_substring_op(ctx, NULL, 3, s, i, j)
1801 #define sexp_substring_cursor(ctx, s, i, j) sexp_substring_op(ctx, NULL, 3, s, i, j)
1802 #endif
1803 
1804 #if SEXP_USE_STRING_INDEX_TABLE
1805 SEXP_API void sexp_update_string_index_lookup(sexp ctx, sexp s);
1806 #else
1807 #define sexp_update_string_index_lookup(ctx, s)
1808 #endif
1809 
1810 #if SEXP_USE_GREEN_THREADS
1811 SEXP_API int sexp_maybe_block_port (sexp ctx, sexp in, int forcep);
1812 SEXP_API void sexp_maybe_unblock_port (sexp ctx, sexp in);
1813 #define sexp_check_block_port(ctx, in, forcep)          \
1814   if (sexp_maybe_block_port(ctx, in, forcep))           \
1815     return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR)
1816 #else
1817 #define sexp_maybe_block_port(ctx, in, forcep)
1818 #define sexp_maybe_unblock_port(ctx, in)
1819 #define sexp_check_block_port(ctx, in, forcep)
1820 #endif
1821 
1822 #define SEXP_PORT_UNKNOWN_FLAGS -1uL
1823 
1824 #define sexp_assert_type(ctx, pred, type_id, obj) if (! pred(obj)) return sexp_type_exception(ctx, self, type_id, obj)
1825 
1826 #define SEXP_COPY_DEFAULT SEXP_ZERO
1827 #define SEXP_COPY_FREEP   SEXP_ONE
1828 #define SEXP_COPY_LOADP   SEXP_TWO
1829 
1830 #if ! SEXP_USE_BOEHM && ! SEXP_USE_MALLOC
1831 SEXP_API void sexp_gc_init (void);
1832 SEXP_API int sexp_grow_heap (sexp ctx, size_t size, size_t chunk_size);
1833 SEXP_API sexp_heap sexp_make_heap (size_t size, size_t max_size, size_t chunk_size);
1834 SEXP_API void sexp_mark (sexp ctx, sexp x);
1835 SEXP_API sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr);
1836 #if SEXP_USE_FINALIZERS
1837 SEXP_API sexp sexp_finalize (sexp ctx);
1838 #else
1839 #define sexp_finalize(ctx) SEXP_ZERO
1840 #endif
1841 #endif
1842 
1843 #if SEXP_USE_GLOBAL_HEAP
1844 #define sexp_free_heap(heap)
1845 #define sexp_debug_heap_stats(heap)
1846 #define sexp_destroy_context(ctx) SEXP_TRUE
1847 #else
1848 SEXP_API void sexp_free_heap (sexp_heap heap);
1849 SEXP_API void sexp_debug_heap_stats (sexp_heap heap);
1850 SEXP_API void sexp_debug_alloc_times(sexp ctx);
1851 SEXP_API void sexp_debug_alloc_sizes(sexp ctx);
1852 SEXP_API sexp sexp_destroy_context (sexp ctx);
1853 SEXP_API sexp sexp_copy_context (sexp ctx, sexp dst, sexp flags);
1854 #endif
1855 
1856 #if SEXP_USE_SAFE_GC_MARK
1857 SEXP_API int sexp_in_heap_p(sexp ctx, sexp x);
1858 #else
1859 #define sexp_in_heap_p(ctx, x) 1
1860 #endif
1861 
1862 #if SEXP_DEBUG_GC > 1 || SEXP_USE_SAFE_GC_MARK || SEXP_USE_HEADER_MAGIC
1863 SEXP_API int sexp_valid_object_p(sexp ctx, sexp x);
1864 #else
1865 #define sexp_valid_object_p(ctx, x) 1
1866 #endif
1867 
1868 #if SEXP_USE_TYPE_DEFS
1869 SEXP_API sexp sexp_register_type_op (sexp, sexp, sexp_sint_t, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, const char*, sexp_proc2);
1870 SEXP_API sexp sexp_register_simple_type_op (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp parent, sexp slots);
1871 SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj);
1872 #define sexp_register_c_type(ctx, name, finalizer)                      \
1873   sexp_register_type(ctx, name, SEXP_FALSE, SEXP_FALSE, SEXP_ZERO, SEXP_ZERO, \
1874                      SEXP_ZERO, SEXP_ZERO, SEXP_ZERO,                   \
1875                      sexp_make_fixnum(sexp_sizeof(cpointer)),           \
1876                      SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO,        \
1877                      SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, NULL,             \
1878                      #finalizer, (sexp_proc2)finalizer)
1879 #endif
1880 
1881 #define sexp_current_input_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(ctx, sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_IN_SYMBOL), SEXP_FALSE))
1882 #define sexp_current_output_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(ctx, sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_OUT_SYMBOL), SEXP_FALSE))
1883 #define sexp_current_error_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(ctx, sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL), SEXP_FALSE))
1884 #define sexp_debug(ctx, msg, obj) (sexp_portp(sexp_current_error_port(ctx)) ? (sexp_write_string(ctx, msg, sexp_current_error_port(ctx)), sexp_write(ctx, obj, sexp_current_error_port(ctx)), sexp_write_char(ctx, '\n', sexp_current_error_port(ctx))) : 0)
1885 
1886 #if SEXP_USE_POLL_PORT
1887 SEXP_API int sexp_poll_port(sexp ctx, sexp port, int inputp);
1888 #endif
1889 
1890 /* simplify primitive API interface */
1891 
1892 #define sexp_read(ctx, in) sexp_read_op(ctx, NULL, 1, in)
1893 #define sexp_write(ctx, obj, out) sexp_write_op(ctx, NULL, 2, obj, out)
1894 #define sexp_print_exception(ctx, e, out) sexp_print_exception_op(ctx, NULL, 2, e, out)
1895 #define sexp_print_exception_stack_trace(ctx, e, out) sexp_print_exception_stack_trace_op(ctx, NULL, 2, e, out)
1896 #define sexp_flush_output(ctx, out) sexp_flush_output_op(ctx, NULL, 1, out)
1897 #define sexp_equalp(ctx, a, b) sexp_equalp_op(ctx, NULL, 2, a, b)
1898 #define sexp_listp(ctx, x) sexp_listp_op(ctx, NULL, 1, x)
1899 #define sexp_length(ctx, x) sexp_length_op(ctx, NULL, 1, x)
1900 #define sexp_length_unboxed(x) sexp_unbox_fixnum(sexp_length(NULL, x))
1901 #define sexp_reverse(ctx, x) sexp_reverse_op(ctx, NULL, 1, x)
1902 #define sexp_nreverse(ctx, x) sexp_nreverse_op(ctx, NULL, 1, x)
1903 #define sexp_copy_list(ctx, x) sexp_copy_list_op(ctx, NULL, 1, x)
1904 #define sexp_cons(ctx, a, b) sexp_cons_op(ctx, NULL, 2, a, b)
1905 #define sexp_append2(ctx, a, b) sexp_append2_op(ctx, NULL, 2, a, b)
1906 #define sexp_make_vector(ctx, a, b) sexp_make_vector_op(ctx, NULL, 2, a, b)
1907 #define sexp_list_to_vector(ctx, x) sexp_list_to_vector_op(ctx, NULL, 1, x)
1908 #define sexp_list_to_uvector(ctx, etype, ls) sexp_list_to_uvector_op(ctx, NULL, 2, etype, ls)
1909 #define sexp_exception_type(ctx, x) sexp_exception_type_op(ctx, NULL, 1, x)
1910 #define sexp_string_to_symbol(ctx, s) sexp_string_to_symbol_op(ctx, NULL, 1, s)
1911 #define sexp_string_to_number(ctx, s, b) sexp_string_to_number_op(ctx, NULL, 2, s, b)
1912 #define sexp_symbol_to_string(ctx, s) sexp_symbol_to_string_op(ctx, NULL, 1, s)
1913 #define sexp_make_ephemeron(ctx, k, v) sexp_make_ephemeron_op(ctx, NULL, 2, k, v)
1914 #define sexp_make_bytes(ctx, l, i) sexp_make_bytes_op(ctx, NULL, 2, l, i)
1915 #if SEXP_USE_UNIFORM_VECTOR_LITERALS
1916 #define sexp_make_uvector(ctx, et, l) sexp_make_uvector_op(ctx, NULL, 2, et, l)
1917 #else
1918 #define sexp_make_uvector(ctx, et, l) sexp_make_vector(ctx, l, SEXP_ZERO)
1919 #define sexp_write_uvector NULL
1920 #define sexp_finalize_uvector NULL
1921 #endif
1922 #define sexp_make_string(ctx, l, c) sexp_make_string_op(ctx, NULL, 2, l, c)
1923 #define sexp_subbytes(ctx, a, b, c) sexp_subbytes_op(ctx, NULL, 3, a, b, c)
1924 #define sexp_string_concatenate(ctx, ls, s) sexp_string_concatenate_op(ctx, NULL, 2, ls, s)
1925 #define sexp_memq(ctx, a, b) sexp_memq_op(ctx, NULL, 2, a, b)
1926 #define sexp_assq(ctx, a, b) sexp_assq_op(ctx, NULL, 2, a, b)
1927 #define sexp_open_output_string(ctx) sexp_open_output_string_op(ctx, NULL, 0)
1928 #define sexp_open_input_string(ctx, s) sexp_open_input_string_op(ctx, NULL, 1, s)
1929 #define sexp_get_output_string(ctx, out) sexp_get_output_string_op(ctx, NULL, 1, out)
1930 #define sexp_expt(ctx, a, b) sexp_expt_op(ctx, NULL, 2, a, b)
1931 #define sexp_register_simple_type(ctx, a, b, c) sexp_register_simple_type_op(ctx, NULL, 3, a, b, c)
1932 #define sexp_register_type(ctx, a, b, c, d, e, f, g, h, i, j, k, l, m, o, p, q, r, sn, s) sexp_register_type_op(ctx, NULL, 18, a, b, c, d, e, f, g, h, i, j, k, l, m, o, p, q, r, sn, s)
1933 #define sexp_make_type_predicate(ctx, a, b) sexp_make_type_predicate_op(ctx, NULL, 2, a, b)
1934 #define sexp_make_constructor(ctx, a, b) sexp_make_constructor_op(ctx, NULL, 2, a, b)
1935 #define sexp_make_getter(ctx, a, b, c) sexp_make_getter_op(ctx, NULL, 3, a, b, c)
1936 #define sexp_make_setter(ctx, a, b, c) sexp_make_setter_op(ctx, NULL, 3, a, b, c)
1937 #define sexp_lookup_type(ctx, name, id) sexp_lookup_type_op(ctx, NULL, 2, name, id)
1938 #define sexp_make_fileno(ctx, fd, no_closep) sexp_make_fileno_op(ctx, NULL, 2, fd, no_closep)
1939 
1940 enum sexp_opcode_names {
1941   /*  0 00 */ SEXP_OP_NOOP,
1942   /*  1 01 */ SEXP_OP_RAISE,
1943   /*  2 02 */ SEXP_OP_RESUMECC,
1944   /*  3 03 */ SEXP_OP_CALLCC,
1945   /*  4 04 */ SEXP_OP_APPLY1,
1946   /*  5 05 */ SEXP_OP_TAIL_CALL,
1947   /*  6 06 */ SEXP_OP_CALL,
1948   /*  7 07 */ SEXP_OP_FCALL0,
1949   /*  8 08 */ SEXP_OP_FCALL1,
1950   /*  9 09 */ SEXP_OP_FCALL2,
1951   /* 10 0A */ SEXP_OP_FCALL3,
1952   /* 11 0B */ SEXP_OP_FCALL4,
1953   /* 12 0C */ SEXP_OP_FCALLN,
1954   /* 13 0D */ SEXP_OP_JUMP_UNLESS,
1955   /* 14 0E */ SEXP_OP_JUMP,
1956   /* 15 0F */ SEXP_OP_PUSH,
1957   /* 16 10 */ SEXP_OP_RESERVE,
1958   /* 17 11 */ SEXP_OP_DROP,
1959   /* 18 12 */ SEXP_OP_GLOBAL_REF,
1960   /* 19 13 */ SEXP_OP_GLOBAL_KNOWN_REF,
1961   /* 20 14 */ SEXP_OP_PARAMETER_REF,
1962   /* 21 15 */ SEXP_OP_STACK_REF,
1963   /* 22 16 */ SEXP_OP_LOCAL_REF,
1964   /* 23 17 */ SEXP_OP_LOCAL_SET,
1965   /* 24 18 */ SEXP_OP_CLOSURE_REF,
1966   /* 25 19 */ SEXP_OP_CLOSURE_VARS,
1967   /* 26 1A */ SEXP_OP_VECTOR_REF,
1968   /* 27 1B */ SEXP_OP_VECTOR_SET,
1969   /* 28 1C */ SEXP_OP_VECTOR_LENGTH,
1970   /* 29 1D */ SEXP_OP_BYTES_REF,
1971   /* 30 1E */ SEXP_OP_BYTES_SET,
1972   /* 31 1F */ SEXP_OP_BYTES_LENGTH,
1973   /* 32 20 */ SEXP_OP_STRING_REF,
1974   /* 33 21 */ SEXP_OP_STRING_SET,
1975   /* 34 22 */ SEXP_OP_STRING_LENGTH,
1976   /* 35 23 */ SEXP_OP_STRING_CURSOR_NEXT,
1977   /* 36 24 */ SEXP_OP_STRING_CURSOR_PREV,
1978   /* 37 25 */ SEXP_OP_STRING_CURSOR_END,
1979   /* 38 26 */ SEXP_OP_MAKE_PROCEDURE,
1980   /* 39 27 */ SEXP_OP_MAKE_VECTOR,
1981   /* 40 28 */ SEXP_OP_MAKE_EXCEPTION,
1982   /* 41 29 */ SEXP_OP_AND,
1983   /* 42 2A */ SEXP_OP_NULLP,
1984   /* 43 2B */ SEXP_OP_FIXNUMP,
1985   /* 44 2C */ SEXP_OP_SYMBOLP,
1986   /* 45 2D */ SEXP_OP_CHARP,
1987   /* 46 2E */ SEXP_OP_EOFP,
1988   /* 47 2F */ SEXP_OP_TYPEP,
1989   /* 48 30 */ SEXP_OP_MAKE,
1990   /* 49 31 */ SEXP_OP_SLOT_REF,
1991   /* 50 32 */ SEXP_OP_SLOT_SET,
1992   /* 51 33 */ SEXP_OP_ISA,
1993   /* 52 34 */ SEXP_OP_SLOTN_REF,
1994   /* 53 35 */ SEXP_OP_SLOTN_SET,
1995   /* 54 36 */ SEXP_OP_CAR,
1996   /* 55 37 */ SEXP_OP_CDR,
1997   /* 56 38 */ SEXP_OP_SET_CAR,
1998   /* 57 39 */ SEXP_OP_SET_CDR,
1999   /* 58 3A */ SEXP_OP_CONS,
2000   /* 59 3B */ SEXP_OP_ADD,
2001   /* 60 3C */ SEXP_OP_SUB,
2002   /* 61 3D */ SEXP_OP_MUL,
2003   /* 62 3E */ SEXP_OP_DIV,
2004   /* 63 3F */ SEXP_OP_QUOTIENT,
2005   /* 64 40 */ SEXP_OP_REMAINDER,
2006   /* 65 41 */ SEXP_OP_LT,
2007   /* 66 42 */ SEXP_OP_LE,
2008   /* 67 43 */ SEXP_OP_EQN,
2009   /* 68 44 */ SEXP_OP_EQ,
2010   /* 69 45 */ SEXP_OP_CHAR2INT,
2011   /* 70 46 */ SEXP_OP_INT2CHAR,
2012   /* 71 47 */ SEXP_OP_CHAR_UPCASE,
2013   /* 72 48 */ SEXP_OP_CHAR_DOWNCASE,
2014   /* 73 49 */ SEXP_OP_WRITE_CHAR,
2015   /* 74 4A */ SEXP_OP_WRITE_STRING,
2016   /* 75 4B */ SEXP_OP_READ_CHAR,
2017   /* 76 4C */ SEXP_OP_PEEK_CHAR,
2018   /* 77 4D */ SEXP_OP_YIELD,
2019   /* 78 4E */ SEXP_OP_FORCE,
2020   /* 79 4F */ SEXP_OP_RET,
2021   /* 80 50 */ SEXP_OP_DONE,
2022   SEXP_OP_SCP,
2023   SEXP_OP_SC_LT,
2024   SEXP_OP_SC_LE,
2025   SEXP_OP_NUM_OPCODES
2026 };
2027 
2028 #ifdef __cplusplus
2029 } /* extern "C" */
2030 #endif
2031 
2032 #endif /* ! SEXP_H */
2033