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