~ chicken-core (master) /chicken.h


   1/* chicken.h - General headerfile for compiler generated executables
   2;
   3; Copyright (c) 2008-2022, The CHICKEN Team
   4; Copyright (c) 2000-2007, Felix L. Winkelmann
   5; All rights reserved.
   6;
   7; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
   8; conditions are met:
   9;
  10;   Redistributions of source code must retain the above copyright notice, this list of conditions and the following
  11;     disclaimer.
  12;   Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
  13;     disclaimer in the documentation and/or other materials provided with the distribution.
  14;   Neither the name of the author nor the names of its contributors may be used to endorse or promote
  15;     products derived from this software without specific prior written permission.
  16;
  17; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS
  18; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  19; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
  20; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  21; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  22; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  23; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  24; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  25; POSSIBILITY OF SUCH DAMAGE.
  26*/
  27
  28/* Configuration: */
  29
  30#ifndef ___CHICKEN
  31#define ___CHICKEN
  32
  33#define C_MAJOR_VERSION   6
  34#define C_MINOR_VERSION   0
  35
  36#ifndef _ISOC99_SOURCE
  37# define _ISOC99_SOURCE
  38#endif
  39
  40#ifndef __C99FEATURES__
  41# define __C99FEATURES__
  42#endif
  43
  44/*
  45 * N.B. This file MUST not rely upon "chicken-config.h"
  46 */
  47#if defined(HAVE_CHICKEN_CONFIG_H)
  48# include "chicken-config.h"
  49#endif
  50
  51/* Some OSes really dislike feature macros for standard levels */
  52#ifdef C_USE_STD_FEATURE_MACROS
  53
  54# ifndef _XOPEN_SOURCE
  55#  define _XOPEN_SOURCE 700
  56# endif
  57
  58# ifndef _BSD_SOURCE
  59#  define _BSD_SOURCE
  60# endif
  61
  62# ifndef _NETBSD_SOURCE
  63#  define _NETBSD_SOURCE
  64# endif
  65
  66# ifndef _SVID_SOURCE
  67#  define _SVID_SOURCE
  68# endif
  69
  70/*
  71 * glibc >= 2.20 synonym for _BSD_SOURCE & _SVID_SOURCE.
  72 */
  73# ifndef _DEFAULT_SOURCE
  74#  define _DEFAULT_SOURCE
  75# endif
  76
  77#endif /* C_USE_STD_FEATURE_MACROS */
  78
  79/* Kind of platform */
  80
  81#if defined(__LP64__) || defined(_LP64) || defined(__MINGW64__) || defined(_WIN64)
  82# define C_SIXTY_FOUR
  83#endif
  84
  85#if defined(__APPLE__) && defined(__MACH__)
  86# define C_MACOSX
  87#endif
  88
  89#if defined(C_MACOSX) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__DragonFly__) || defined(__OpenBSD__)
  90# define C_XXXBSD
  91#endif
  92
  93#if /*defined(__GNUC__) &&*/ (defined(__linux__) || defined(C_XXXBSD) || defined(__HAIKU__))
  94# define C_GNU_ENV
  95#endif
  96
  97#if defined (__TINYC__)
  98# define __STDC_NO_COMPLEX__
  99#endif
 100
 101#if defined(__MINGW32__)
 102/*
 103 * XXX This should probably be renamed or changed because it's misleading.
 104 * For example, Haiku is not a Unix either, but this doesn't get defined there.
 105 */
 106# define C_NONUNIX
 107#endif
 108
 109#if defined(__sun) && defined(__SVR4)
 110# define C_SOLARIS
 111#endif
 112
 113#if defined(__MINGW64__) || defined(_WIN64)
 114# define C_LLP
 115#endif
 116
 117/* Declare base Win32 version: we require Vista or later */
 118
 119#ifdef __MINGW32__
 120# define _WIN32_WINNT 0x0600
 121#endif
 122
 123
 124/* Headers */
 125
 126#include <errno.h>
 127#include <inttypes.h>
 128#include <limits.h>
 129#include <math.h>
 130#include <setjmp.h>
 131#include <stdarg.h>
 132#include <stddef.h>
 133#include <stdio.h>
 134#include <stdlib.h>
 135#include <string.h>
 136#include <time.h>
 137#include <unistd.h>
 138#if !defined(__STDC_NO_COMPLEX__) && !defined(__cplusplus)
 139# include <complex.h>
 140# define C_complex	complex
 141#else
 142# define C_complex
 143#endif
 144#include <sys/types.h>
 145#include <sys/stat.h>
 146
 147
 148/* Byteorder in machine word */
 149
 150#if defined(__MINGW32__)
 151# include <sys/param.h>
 152#elif defined(__CYGWIN__)
 153# include <endian.h>
 154#elif defined(__linux__)
 155# include <endian.h>
 156#elif defined(C_XXXBSD)
 157# include <machine/endian.h>
 158#elif defined(__hpux__)
 159# include <arpa/nameser.h>
 160#elif defined(_AIX)
 161# include <sys/machine.h>
 162#elif defined(__sun)
 163# include <sys/isa_defs.h>
 164#elif defined(__SVR4)
 165# include <sys/byteorder.h>
 166#endif
 167
 168#if defined(__MINGW32__)
 169# include <malloc.h>
 170#endif
 171
 172/* Much better with stack allocation API */
 173
 174#ifdef HAVE_ALLOCA_H
 175# include <alloca.h>
 176#elif !defined(alloca) /* predefined by HP cc +Olibcalls */
 177void *alloca ();
 178#endif
 179
 180
 181/* CHICKEN Core C API */
 182
 183#if defined(__BYTE_ORDER) && __BYTE_ORDER == __BIG_ENDIAN
 184# define C_BIG_ENDIAN
 185#elif defined(BYTE_ORDER) && defined(BIG_ENDIAN) && BYTE_ORDER == BIG_ENDIAN
 186# define C_BIG_ENDIAN
 187#elif defined(__BIG_ENDIAN__)
 188# define C_BIG_ENDIAN
 189#elif defined(__MIPSEL__) || defined(__MIPSEL)
 190# define C_LITTLE_ENDIAN
 191#elif defined(__sparc__) || defined(__POWERPC__) || defined(__MC68K__) || defined(__mips__)
 192# define C_BIG_ENDIAN
 193#endif
 194
 195#if defined(__BYTE_ORDER) && defined(__LITTLE_ENDIAN) && __BYTE_ORDER == __LITTLE_ENDIAN
 196# define C_LITTLE_ENDIAN
 197#elif defined(BYTE_ORDER) && defined(LITTLE_ENDIAN) && BYTE_ORDER == LITTLE_ENDIAN
 198# define C_LITTLE_ENDIAN
 199#elif defined(__LITTLE_ENDIAN__)
 200# define C_LITTLE_ENDIAN
 201#elif defined (__alpha__) || defined(_M_IX86) || defined(__i386__) || defined(__x86_64__) || defined(__ia64__)
 202# define C_LITTLE_ENDIAN
 203#endif
 204
 205/* Make sure some common C identifiers are availble w/ Windows */
 206
 207/* Could be used by C++ source */
 208
 209#ifdef __cplusplus
 210# define C_extern                  extern "C"
 211# define C_BEGIN_C_DECLS           extern "C" {
 212# define C_END_C_DECLS             }
 213#else
 214# define C_extern                  extern
 215# define C_BEGIN_C_DECLS
 216# define C_END_C_DECLS
 217#endif
 218
 219
 220/* Function declaration modes */
 221
 222/* Visibility */
 223#define C_varextern                C_extern
 224#define C_fctimport
 225#define C_fctexport
 226#if defined(PIC)
 227# if defined(__CYGWIN__) || defined(__MINGW32__)
 228#  ifndef C_BUILDING_LIBCHICKEN
 229#   undef  C_varextern
 230#   define C_varextern             C_extern __declspec(dllimport)
 231#  endif
 232# endif
 233#endif
 234
 235/* Language specifics: */
 236#if defined(__GNUC__) || defined(__INTEL_COMPILER)
 237#define HAVE_STATEMENT_EXPRESSIONS 1
 238#endif
 239
 240#if !defined(__clang__) && !defined(__has_attribute)
 241/* Define so it won't error on other compilers with keywords like "noreturn" */
 242#define __has_attribute(x)        0
 243#endif
 244
 245#if defined(__GNUC__) || defined(__INTEL_COMPILER)
 246# define C_unlikely(x)             __builtin_expect((x), 0)
 247# define C_likely(x)               __builtin_expect((x), 1)
 248# ifndef __cplusplus
 249#  define C_cblock                ({
 250#  define C_cblockend             })
 251#  if defined(__clang__) && !__has_attribute(noreturn)
 252#   define C_noret
 253#  else
 254#   define C_noret                __attribute__ ((noreturn))
 255#  endif
 256#  define C_noret_decl(name)
 257#  define C_aligned               __attribute__ ((aligned))
 258# endif
 259# if defined(__i386__) && !defined(__clang__)
 260#  define C_regparm               __attribute__ ((regparm(3)))
 261# endif
 262#else
 263# define C_unlikely(x)             (x)
 264# define C_likely(x)               (x)
 265#endif
 266
 267#ifndef C_cblock
 268# define C_cblock                 do{
 269# define C_cblockend              }while(0)
 270# define C_noret
 271# define C_noret_decl(name)
 272#endif
 273
 274#ifndef C_regparm
 275# define C_regparm
 276#endif
 277
 278#ifndef C_ccall
 279# define C_ccall
 280#endif
 281
 282#ifndef C_aligned
 283# define C_aligned
 284#endif
 285
 286/* Stack growth direction; used to compute stack addresses */
 287#ifndef C_STACK_GROWS_DOWNWARD
 288# ifdef __hppa__
 289#  define C_STACK_GROWS_DOWNWARD 0
 290# else
 291#  define C_STACK_GROWS_DOWNWARD 1
 292# endif
 293#endif
 294
 295/* Have a GUI? */
 296
 297#if defined(C_GUI) || defined(C_PRIVATE_REPOSITORY)
 298# ifdef _WIN32
 299#  include <windows.h>
 300#  ifndef WINAPI
 301#   define WINAPI
 302#  endif
 303# endif
 304#endif
 305
 306/* Needed for pre-emptive threading */
 307
 308#define C_TIMER_INTERRUPTS
 309
 310
 311/* Constants: */
 312
 313#define C_STACK_RESERVE                   0x10000
 314#define C_DEFAULT_MAX_PENDING_FINALIZERS  2048
 315
 316#define C_IMMEDIATE_MARK_BITS     0x00000003
 317#define C_IMMEDIATE_TYPE_BITS     0x0000000f
 318
 319#define C_BOOLEAN_BITS            0x00000006
 320#define C_CHARACTER_BITS          0x0000000a
 321#define C_SPECIAL_BITS            0x0000000e
 322
 323#define C_SCHEME_FALSE            ((C_word)(C_BOOLEAN_BITS | 0x00000000))
 324#define C_SCHEME_TRUE             ((C_word)(C_BOOLEAN_BITS | 0x00000010))
 325
 326#define C_SCHEME_END_OF_LIST      ((C_word)(C_SPECIAL_BITS | 0x00000000))
 327#define C_SCHEME_UNDEFINED        ((C_word)(C_SPECIAL_BITS | 0x00000010))
 328#define C_SCHEME_UNBOUND          ((C_word)(C_SPECIAL_BITS | 0x00000020))
 329#define C_SCHEME_END_OF_FILE      ((C_word)(C_SPECIAL_BITS | 0x00000030))
 330#define C_SCHEME_BROKEN_WEAK_PTR  ((C_word)(C_SPECIAL_BITS | 0x00000040))
 331
 332#define C_FIXNUM_BIT              0x00000001
 333#define C_FIXNUM_SHIFT            1
 334
 335/* Character range is that of a UTF-8 codepoint, not representable range */
 336#define C_CHAR_BIT_MASK           0x1fffff
 337#define C_CHAR_SHIFT              8
 338
 339#ifdef C_SIXTY_FOUR
 340# define C_MOST_POSITIVE_FIXNUM   0x3fffffffffffffffL
 341# define C_WORD_SIZE              64
 342# define C_HALF_WORD_SIZE         32
 343#else
 344# define C_MOST_POSITIVE_FIXNUM   0x3fffffff
 345# define C_WORD_SIZE              32
 346# define C_HALF_WORD_SIZE         16
 347#endif
 348
 349/* Tunable performance-related constants */
 350#ifndef C_KARATSUBA_THRESHOLD
 351/* This defines when we'll switch from schoolbook to Karatsuba
 352 * multiplication.  The smallest of the two numbers determines the
 353 * switch.  It is pretty high right now because it generates a bit
 354 * more garbage and GC overhead dominates the algorithmic performance
 355 * gains.  If the GC is improved, this can be readjusted.
 356 */
 357# define C_KARATSUBA_THRESHOLD        70
 358#endif
 359#ifndef C_BURNIKEL_ZIEGLER_THRESHOLD
 360/* This defines when to switch from schoolbook to Burnikel-Ziegler
 361 * division.  It creates even more garbage than Karatsuba :(
 362 */
 363# define C_BURNIKEL_ZIEGLER_THRESHOLD 300
 364#endif
 365#ifndef C_RECURSIVE_TO_STRING_THRESHOLD
 366/* This threshold is in terms of the expected string length. */
 367# define C_RECURSIVE_TO_STRING_THRESHOLD 750
 368#endif
 369
 370/* These might fit better in runtime.c? */
 371#define C_fitsinbignumhalfdigitp(n)     (C_BIGNUM_DIGIT_HI_HALF(n) == 0)
 372#define C_BIGNUM_DIGIT_LENGTH           C_WORD_SIZE
 373#define C_BIGNUM_HALF_DIGIT_LENGTH      C_HALF_WORD_SIZE
 374#define C_BIGNUM_BITS_TO_DIGITS(n) \
 375        (((n) + (C_BIGNUM_DIGIT_LENGTH - 1)) / C_BIGNUM_DIGIT_LENGTH)
 376#define C_BIGNUM_DIGIT_LO_HALF(d)       (C_uhword)(d)
 377#define C_BIGNUM_DIGIT_HI_HALF(d)       (C_uhword)((d) >> C_BIGNUM_HALF_DIGIT_LENGTH)
 378#define C_BIGNUM_DIGIT_COMBINE(h,l)     ((C_uword)(h) << C_BIGNUM_HALF_DIGIT_LENGTH|(C_uhword)(l))
 379
 380#define C_MOST_POSITIVE_32_BIT_FIXNUM  0x3fffffff
 381#define C_MOST_NEGATIVE_FIXNUM    (-C_MOST_POSITIVE_FIXNUM - 1)
 382
 383/* Block object layout:
 384
 385    Bits:   B = BYTEBLOC_BIT
 386            S = SPECIALBLOCK_BIT
 387            A = 8ALIGN_BIT
 388
 389    Symbol  = [  1|3, Value, Name, Plist]   Name = bytevector, 0-terminated
 390    String  = [  2|4, Name, Count, Offset, Index]  Name = bytevector, 0-terminated
 391    Pair    = [  3|2, Car, Cdr]
 392    Closure = [ S4|1+N, Ptr, Slot, ...]
 393    Flonum  = [AB5|8, IEEEDouble]
 394    Bignum  = [  6|1, Bits]                 Bits = bytevector
 395    Port    = [ S7|15, Slots, ...]
 396    Structure = [  8|1+N, Tag, Slots, ...]
 397    Pointer = [ S9|1, Ptr]
 398    Locative = [ S0a|4*N, Slots, ...]
 399    Taggedpointer = [ S0b|2, Ptr, Tag]
 400    Ratnum  = [  0c|2, Num, Den]
 401    Lambdainfo = [ B0d|N, Bytes, ...]
 402    Cplxnum = [  0e|2, Imag, Real]
 403
 404*/
 405
 406#ifdef C_SIXTY_FOUR
 407# define C_INT_SIGN_BIT           0x8000000000000000L
 408# define C_INT_TOP_BIT            0x4000000000000000L
 409# define C_HEADER_BITS_MASK       0xff00000000000000L
 410# define C_HEADER_TYPE_BITS       0x0f00000000000000L
 411# define C_HEADER_SIZE_MASK       0x00ffffffffffffffL
 412# define C_GC_FORWARDING_BIT      0x8000000000000000L   /* header contains forwarding pointer */
 413# define C_BYTEBLOCK_BIT          0x4000000000000000L   /* block contains bytes instead of slots */
 414# define C_SPECIALBLOCK_BIT       0x2000000000000000L   /* 1st item is a non-value */
 415# define C_8ALIGN_BIT             0x1000000000000000L   /* data is aligned to 8-byte boundary */
 416
 417# define C_SYMBOL_TYPE            (0x0100000000000000L)
 418# define C_STRING_TYPE            (0x0200000000000000L)
 419# define C_PAIR_TYPE              (0x0300000000000000L)
 420# define C_CLOSURE_TYPE           (0x0400000000000000L | C_SPECIALBLOCK_BIT)
 421# define C_FLONUM_TYPE            (0x0500000000000000L | C_BYTEBLOCK_BIT | C_8ALIGN_BIT)
 422# define C_BIGNUM_TYPE            (0x0600000000000000L) /* Just the wrapper */
 423# define C_PORT_TYPE              (0x0700000000000000L | C_SPECIALBLOCK_BIT)
 424# define C_STRUCTURE_TYPE         (0x0800000000000000L)
 425# define C_POINTER_TYPE           (0x0900000000000000L | C_SPECIALBLOCK_BIT)
 426# define C_LOCATIVE_TYPE          (0x0a00000000000000L | C_SPECIALBLOCK_BIT)
 427# define C_TAGGED_POINTER_TYPE    (0x0b00000000000000L | C_SPECIALBLOCK_BIT)
 428# define C_RATNUM_TYPE            (0x0c00000000000000L)
 429# define C_LAMBDA_INFO_TYPE       (0x0d00000000000000L | C_BYTEBLOCK_BIT)
 430# define C_CPLXNUM_TYPE           (0x0e00000000000000L)
 431/*       unused                   (0x0f00000000000000L ...) */
 432#else
 433# define C_INT_SIGN_BIT           0x80000000
 434# define C_INT_TOP_BIT            0x40000000
 435# define C_HEADER_BITS_MASK       0xff000000
 436# define C_HEADER_TYPE_BITS       0x0f000000
 437# define C_HEADER_SIZE_MASK       0x00ffffff
 438# define C_GC_FORWARDING_BIT      0x80000000
 439# define C_BYTEBLOCK_BIT          0x40000000
 440# define C_SPECIALBLOCK_BIT       0x20000000
 441# define C_8ALIGN_BIT             0x10000000
 442
 443# define C_SYMBOL_TYPE            (0x01000000)
 444# define C_STRING_TYPE            (0x02000000)
 445# define C_PAIR_TYPE              (0x03000000)
 446# define C_CLOSURE_TYPE           (0x04000000 | C_SPECIALBLOCK_BIT)
 447# ifdef C_DOUBLE_IS_32_BITS
 448#  define C_FLONUM_TYPE           (0x05000000 | C_BYTEBLOCK_BIT)
 449# else
 450#  define C_FLONUM_TYPE           (0x05000000 | C_BYTEBLOCK_BIT | C_8ALIGN_BIT)
 451# endif
 452# define C_BIGNUM_TYPE            (0x06000000) /* Just the wrapper */
 453# define C_PORT_TYPE              (0x07000000 | C_SPECIALBLOCK_BIT)
 454# define C_STRUCTURE_TYPE         (0x08000000)
 455# define C_POINTER_TYPE           (0x09000000 | C_SPECIALBLOCK_BIT)
 456# define C_LOCATIVE_TYPE          (0x0a000000 | C_SPECIALBLOCK_BIT)
 457# define C_TAGGED_POINTER_TYPE    (0x0b000000 | C_SPECIALBLOCK_BIT)
 458# define C_RATNUM_TYPE            (0x0c000000)
 459# define C_LAMBDA_INFO_TYPE       (0x0d000000 | C_BYTEBLOCK_BIT)
 460# define C_CPLXNUM_TYPE           (0x0e000000)
 461/*       unused                   (0x0f000000 ...) */
 462#endif
 463#define C_VECTOR_TYPE             0x00000000
 464#define C_BYTEVECTOR_TYPE         (C_VECTOR_TYPE | C_BYTEBLOCK_BIT | C_8ALIGN_BIT)
 465
 466#define C_SIZEOF_LIST(n)          ((n) * 3 + 1)
 467#define C_SIZEOF_PAIR             3
 468#define C_SIZEOF_STRING(n)        (C_SIZEOF_BYTEVECTOR((n) * 4) + 1 + 5)
 469#define C_SIZEOF_SYMBOL           4
 470#define C_SIZEOF_INTERNED_SYMBOL(n) (C_SIZEOF_SYMBOL + C_SIZEOF_PAIR + C_SIZEOF_STRING(n))
 471#ifdef C_DOUBLE_IS_32_BITS
 472# define C_SIZEOF_FLONUM          2
 473#else
 474# define C_SIZEOF_FLONUM          4
 475#endif
 476#define C_SIZEOF_POINTER          2
 477#define C_SIZEOF_TAGGED_POINTER   3
 478#define C_SIZEOF_VECTOR(n)        ((n) + 1)
 479#define C_SIZEOF_LOCATIVE         5
 480#define C_SIZEOF_PORT             17
 481#define C_SIZEOF_RATNUM           3
 482#define C_SIZEOF_CPLXNUM          3
 483#define C_SIZEOF_STRUCTURE(n)     ((n)+1)
 484#define C_SIZEOF_CLOSURE(n)       ((n)+1)
 485#define C_SIZEOF_BYTEVECTOR(n)    (C_bytestowords(n) + 2)
 486#define C_SIZEOF_INTERNAL_BIGNUM_VECTOR(n) (C_SIZEOF_VECTOR((n)+1))
 487#define C_internal_bignum_vector(b)        (C_block_item(b,0))
 488
 489/* This is for convenience and allows flexibility in representation */
 490#define C_SIZEOF_FIX_BIGNUM       C_SIZEOF_BIGNUM(1)
 491#define C_SIZEOF_BIGNUM_WRAPPER   2
 492#define C_SIZEOF_BIGNUM(n)        (C_SIZEOF_INTERNAL_BIGNUM_VECTOR(n)+C_SIZEOF_BIGNUM_WRAPPER)
 493
 494/* Fixed size types have pre-computed header tags */
 495#define C_STRING_TAG              (C_STRING_TYPE | 4)
 496#define C_PAIR_TAG                (C_PAIR_TYPE | (C_SIZEOF_PAIR - 1))
 497#define C_WEAK_PAIR_TAG           (C_PAIR_TAG | C_SPECIALBLOCK_BIT)
 498#define C_POINTER_TAG             (C_POINTER_TYPE | (C_SIZEOF_POINTER - 1))
 499#define C_LOCATIVE_TAG            (C_LOCATIVE_TYPE | (C_SIZEOF_LOCATIVE - 1))
 500#define C_TAGGED_POINTER_TAG      (C_TAGGED_POINTER_TYPE | (C_SIZEOF_TAGGED_POINTER - 1))
 501#define C_SYMBOL_TAG              (C_SYMBOL_TYPE | (C_SIZEOF_SYMBOL - 1))
 502#define C_FLONUM_TAG              (C_FLONUM_TYPE | sizeof(double))
 503#define C_BIGNUM_TAG              (C_BIGNUM_TYPE | 1)
 504#define C_RATNUM_TAG              (C_RATNUM_TYPE | 2)
 505#define C_CPLXNUM_TAG             (C_CPLXNUM_TYPE | 2)
 506
 507/* Locative subtypes */
 508#define C_SLOT_LOCATIVE           0
 509#define C_CHAR_LOCATIVE           1
 510#define C_U8_LOCATIVE             2
 511#define C_S8_LOCATIVE             3
 512#define C_U16_LOCATIVE            4
 513#define C_S16_LOCATIVE            5
 514#define C_U32_LOCATIVE            6
 515#define C_S32_LOCATIVE            7
 516#define C_U64_LOCATIVE            8
 517#define C_S64_LOCATIVE            9
 518#define C_F32_LOCATIVE            10
 519#define C_F64_LOCATIVE            11
 520
 521#if defined (__MINGW32__)
 522# define C_s64                    __int64
 523# define C_u64                    unsigned __int64
 524#else
 525# define C_s64                    int64_t
 526# define C_u64                    uint64_t
 527#endif
 528
 529#ifdef C_SIXTY_FOUR
 530# ifdef C_LLP
 531#  define C_word                  C_s64
 532#  define C_hword                 long
 533# else
 534#  define C_word                  long
 535#  define C_hword                 int
 536# endif
 537# define C_u32                    uint32_t
 538# define C_s32                    int32_t
 539#else
 540# define C_word                   int
 541# define C_hword                  short
 542# define C_u32                    unsigned int
 543# define C_s32                    int
 544#endif
 545
 546#define C_char                    char
 547#define C_uchar                   unsigned C_char
 548#define C_byte                    char
 549#define C_uword                   unsigned C_word
 550#define C_uhword                  unsigned C_hword
 551#define C_header                  C_uword
 552
 553/* if all else fails, use these:
 554 #define UINT64_MAX (18446744073709551615ULL)
 555 #define INT64_MAX  (9223372036854775807LL)
 556 #define INT64_MIN  (-INT64_MAX - 1)
 557 #define UINT32_MAX (4294967295U)
 558 #define INT32_MAX  (2147483647)
 559 #define INT32_MIN  (-INT32_MAX - 1)
 560 #define UINT16_MAX (65535U)
 561 #define INT16_MAX  (32767)
 562 #define INT16_MIN  (-INT16_MAX - 1)
 563 #define UINT8_MAX  (255)
 564 #define INT8_MAX   (127)
 565 #define INT8_MIN   (-INT8_MAX - 1)
 566*/
 567
 568#define C_U64_MAX    UINT64_MAX
 569#define C_S64_MIN    INT64_MIN
 570#define C_S64_MAX    INT64_MAX
 571
 572#if defined(C_LLP)
 573# define C_wabs                   llabs
 574# define C_long                   C_s64
 575# ifndef LONG_LONG_MAX
 576#  define C_LONG_MAX              LLONG_MAX
 577#  define C_LONG_MIN              LLONG_MIN
 578# else
 579#  define C_LONG_MAX              LONG_LONG_MAX
 580#  define C_LONG_MIN              LONG_LONG_MIN
 581# endif
 582#else
 583# define C_wabs                   labs
 584# define C_long                   long
 585# define C_LONG_MAX               LONG_MAX
 586# define C_LONG_MIN               LONG_MIN
 587#endif
 588
 589#define C_ulong                   unsigned C_long
 590
 591#ifdef __cplusplus
 592# define C_text(x)                ((C_char *)(x))
 593#else
 594# define C_text(x)                (x)
 595#endif
 596
 597#define C_TIMER_INTERRUPT_NUMBER  255
 598
 599#define C_BAD_ARGUMENT_COUNT_ERROR                    1
 600#define C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR            2
 601#define C_BAD_ARGUMENT_TYPE_ERROR                     3
 602#define C_UNBOUND_VARIABLE_ERROR                      4
 603#define C_BAD_ARGUMENT_TYPE_NO_KEYWORD_ERROR          5
 604#define C_OUT_OF_MEMORY_ERROR                         6
 605#define C_DIVISION_BY_ZERO_ERROR                      7
 606#define C_OUT_OF_BOUNDS_ERROR                          8
 607#define C_NOT_A_CLOSURE_ERROR                         9
 608#define C_CONTINUATION_CANT_RECEIVE_VALUES_ERROR      10
 609#define C_BAD_ARGUMENT_TYPE_CYCLIC_LIST_ERROR         11
 610#define C_TOO_DEEP_RECURSION_ERROR                    12
 611#define C_CANT_REPRESENT_INEXACT_ERROR                13
 612#define C_NOT_A_PROPER_LIST_ERROR                     14
 613#define C_BAD_ARGUMENT_TYPE_NO_FIXNUM_ERROR           15
 614#define C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR           16
 615#define C_BAD_ARGUMENT_TYPE_NO_STRING_ERROR           17
 616#define C_BAD_ARGUMENT_TYPE_NO_PAIR_ERROR             18
 617#define C_BAD_ARGUMENT_TYPE_NO_LIST_ERROR             19
 618#define C_BAD_ARGUMENT_TYPE_NO_CHAR_ERROR             20
 619#define C_BAD_ARGUMENT_TYPE_NO_VECTOR_ERROR           21
 620#define C_BAD_ARGUMENT_TYPE_NO_SYMBOL_ERROR           22
 621#define C_STACK_OVERFLOW_ERROR                        23
 622#define C_BAD_ARGUMENT_TYPE_BAD_STRUCT_ERROR          24
 623#define C_BAD_ARGUMENT_TYPE_NO_BYTEVECTOR_ERROR       25
 624#define C_LOST_LOCATIVE_ERROR                         26
 625#define C_BAD_ARGUMENT_TYPE_NO_BLOCK_ERROR            27
 626#define C_BAD_ARGUMENT_TYPE_NO_NUMBER_VECTOR_ERROR    28
 627#define C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR          29
 628#define C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR         30
 629#define C_BAD_ARGUMENT_TYPE_NO_POINTER_ERROR          31
 630#define C_BAD_ARGUMENT_TYPE_NO_TAGGED_POINTER_ERROR   32
 631#define C_BAD_ARGUMENT_TYPE_NO_FLONUM_ERROR           33
 632#define C_BAD_ARGUMENT_TYPE_NO_CLOSURE_ERROR          34
 633#define C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR            35
 634#define C_CIRCULAR_DATA_ERROR                         36
 635#define C_BAD_ARGUMENT_TYPE_NO_BOOLEAN_ERROR          37
 636#define C_BAD_ARGUMENT_TYPE_NO_LOCATIVE_ERROR         38
 637#define C_BAD_ARGUMENT_TYPE_NO_PORT_ERROR             39
 638#define C_BAD_ARGUMENT_TYPE_PORT_DIRECTION_ERROR      40
 639#define C_BAD_ARGUMENT_TYPE_PORT_NO_INPUT_ERROR       41
 640#define C_BAD_ARGUMENT_TYPE_PORT_NO_OUTPUT_ERROR      42
 641#define C_PORT_CLOSED_ERROR                           43
 642#define C_ASCIIZ_REPRESENTATION_ERROR                 44
 643#define C_MEMORY_VIOLATION_ERROR                      45
 644#define C_FLOATING_POINT_EXCEPTION_ERROR              46
 645#define C_ILLEGAL_INSTRUCTION_ERROR                   47
 646#define C_BUS_ERROR                                   48
 647#define C_BAD_ARGUMENT_TYPE_NO_EXACT_ERROR            49
 648#define C_BAD_ARGUMENT_TYPE_NO_INEXACT_ERROR          50
 649#define C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR             51
 650#define C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR 52
 651#define C_BAD_ARGUMENT_TYPE_NO_EXACT_INTEGER_ERROR    53
 652#define C_BAD_ARGUMENT_TYPE_FOREIGN_LIMITATION        54
 653#define C_BAD_ARGUMENT_TYPE_COMPLEX_ABS               55
 654#define C_REST_ARG_OUT_OF_BOUNDS_ERROR                56
 655#define C_DECODING_ERROR                              57
 656#define C_BAD_ARGUMENT_TYPE_NUMERIC_RANGE_ERROR	58
 657
 658/* Platform information */
 659#if defined(C_BIG_ENDIAN)
 660# define C_MACHINE_BYTE_ORDER "big-endian"
 661#elif defined(C_LITTLE_ENDIAN)
 662# define C_MACHINE_BYTE_ORDER "little-endian"
 663#endif
 664
 665#if defined(__alpha__)
 666# define C_MACHINE_TYPE "alpha"
 667#elif defined(__mips__)
 668# define C_MACHINE_TYPE "mips"
 669#elif defined(__hppa__)
 670# define C_MACHINE_TYPE "hppa"
 671#elif defined(__sparc_v9__) || defined(__sparcv9)
 672# define C_MACHINE_TYPE "ultrasparc"
 673#elif defined(__sparc__)
 674# define C_MACHINE_TYPE "sparc"
 675#elif defined(__powerpc64__) || defined(_ARCH_PPC64)
 676# define C_MACHINE_TYPE "ppc64"
 677#elif defined(__ppc__) || defined(__powerpc__) || defined(_ARCH_PPC)
 678# define C_MACHINE_TYPE "ppc"
 679#elif defined(_M_IX86) || defined(__i386__)
 680# define C_MACHINE_TYPE "x86"
 681#elif defined(__ia64__)
 682# define C_MACHINE_TYPE "ia64"
 683#elif defined(__x86_64__)
 684# define C_MACHINE_TYPE "x86-64"
 685#elif defined(__riscv)
 686# if defined(__LP64__) || defined(_LP64)
 687#  define C_MACHINE_TYPE "riscv64"
 688# else
 689#  define C_MACHINE_TYPE "riscv"
 690# endif
 691#elif defined(__arm64__) || defined(__aarch64__)
 692# define C_MACHINE_TYPE "arm64"
 693#elif defined(__arm__)
 694# define C_MACHINE_TYPE "arm"
 695#else
 696# define C_MACHINE_TYPE "unknown"
 697#endif
 698
 699#if defined(__CYGWIN__) || defined(__MINGW32__) || defined(_WIN32) || defined(__WINNT__)
 700# define C_SOFTWARE_TYPE "windows"
 701#elif defined(__ANDROID__)
 702# define C_SOFTWARE_TYPE "android"
 703#elif defined(__unix__) || defined(C_XXXBSD) || defined(_AIX)
 704# define C_SOFTWARE_TYPE "unix"
 705#elif defined(ECOS)
 706# define C_SOFTWARE_TYPE "ecos"
 707#else
 708# define C_SOFTWARE_TYPE "unknown"
 709#endif
 710
 711#if defined(_WIN32) && !defined(__CYGWIN__)
 712# define C_WCHAR_FILENAMES
 713# define C_WCHAR wchar_t
 714#else
 715# define C_WCHAR C_char
 716#endif
 717
 718#if defined(__SUNPRO_C)
 719# define C_BUILD_PLATFORM "sun"
 720#elif defined(__clang__)
 721# define C_BUILD_PLATFORM "clang"
 722#elif defined(_AIX)
 723# define C_BUILD_PLATFORM "aix"
 724#elif defined(__GNUC__)
 725# define C_BUILD_PLATFORM "gnu"
 726#elif defined(__INTEL_COMPILER)
 727# define C_BUILD_PLATFORM "intel"
 728#else
 729# define C_BUILD_PLATFORM "unknown"
 730#endif
 731
 732#if defined(__linux__)
 733# define C_SOFTWARE_VERSION "linux"
 734#elif defined(__FreeBSD__)
 735# define C_SOFTWARE_VERSION "freebsd"
 736#elif defined(__NetBSD__)
 737# define C_SOFTWARE_VERSION "netbsd"
 738#elif defined(__OpenBSD__)
 739# define C_SOFTWARE_VERSION "openbsd"
 740#elif defined(C_MACOSX)
 741# define C_SOFTWARE_VERSION "macosx"
 742#elif defined(__hpux__)
 743# define C_SOFTWARE_VERSION "hpux"
 744#elif defined(__DragonFly__)
 745# define C_SOFTWARE_VERSION "dragonfly"
 746#elif defined(__HAIKU__)
 747# define C_SOFTWARE_VERSION "haiku"
 748#elif defined(__sun)
 749# if defined(__SVR4)
 750#   define C_SOFTWARE_VERSION "solaris"
 751# else
 752#   define C_SOFTWARE_VERSION "sunos"
 753# endif
 754#elif defined(_AIX)
 755# define C_SOFTWARE_VERSION "aix"
 756#elif defined(__GNU__)
 757# define C_SOFTWARE_VERSION "hurd"
 758#elif defined(__CYGWIN__)
 759# define C_SOFTWARE_VERSION "cygwin"
 760#elif defined(_WIN32) && !defined(__CYGWIN__)
 761# define C_SOFTWARE_VERSION "mingw"
 762#else
 763# define C_SOFTWARE_VERSION "unknown"
 764#endif
 765
 766/* There is no PATH_MAX in The Hurd. */
 767#ifdef PATH_MAX
 768# define C_MAX_PATH PATH_MAX
 769#else
 770# define C_MAX_PATH 1024
 771#endif
 772
 773#define C_RANDOM_STATE_SIZE               (16 * sizeof(C_uword))
 774
 775/* Types: */
 776
 777typedef struct C_block_struct
 778{
 779  C_header header;
 780  C_word data[];
 781} C_SCHEME_BLOCK;
 782
 783typedef struct C_symbol_table_struct
 784{
 785  char *name;
 786  unsigned int size;
 787  unsigned int rand;
 788  C_word *table;
 789  struct C_symbol_table_struct *next;
 790} C_SYMBOL_TABLE;
 791
 792typedef struct C_gc_root_struct
 793{
 794  C_word value;
 795  struct C_gc_root_struct *next, *prev;
 796  int finalizable;
 797} C_GC_ROOT;
 798
 799typedef struct C_ptable_entry_struct
 800{
 801  C_char *id;
 802  void *ptr;
 803} C_PTABLE_ENTRY;
 804
 805typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;
 806
 807
 808/* Macros: */
 809
 810#define C_cpsproc(name)   C_ccall void name(C_word c, C_word *av) C_noret
 811
 812#define CHICKEN_gc_root_ref(root)      (((C_GC_ROOT *)(root))->value)
 813#define CHICKEN_gc_root_set(root, x)   C_mutate(&((C_GC_ROOT *)(root))->value, (x))
 814
 815#define CHICKEN_global_ref(root)       C_u_i_car(((C_GC_ROOT *)(root))->value)
 816#define CHICKEN_global_set(root, x)    C_mutate(&C_u_i_car(((C_GC_ROOT *)(root))->value), (x))
 817
 818#define CHICKEN_default_toplevel       ((void *)C_default_5fstub_toplevel)
 819
 820#define C__STR1(x)                 #x
 821#define C__STR2(x)                 C__STR1(x)
 822
 823#define C_align4(n)                (((n) + 3) & ~3)
 824#define C_align8(n)                (((n) + 7) & ~7)
 825#define C_align16(n)               (((n) + 15) & ~15)
 826
 827#define C_aligned8(n)              ((((C_word)(n)) & 7) == 0)
 828
 829#define C_buf_end(b)               ((C_word *)((C_byte *)(b) + sizeof(b)))
 830
 831/* This is word-size dependent: */
 832#ifdef C_SIXTY_FOUR
 833# define C_align(n)                C_align8(n)
 834# define C_wordstobytes(n)         ((C_uword)(n) << 3)
 835# define C_bytestowords(n)         (((n) + 7) >> 3)
 836# define C_wordsperdouble(n)       (n)
 837# define C_WORD_MIN                LONG_MIN
 838# define C_WORD_MAX                LONG_MAX
 839# define C_UWORD_MAX               ULONG_MAX
 840#else
 841# define C_align(n)                C_align4(n)
 842# define C_wordstobytes(n)         ((C_uword)(n) << 2)
 843# define C_bytestowords(n)         (((n) + 3) >> 2)
 844# define C_wordsperdouble(n)       ((C_uword)(n) << 1)
 845# define C_WORD_MIN                INT_MIN
 846# define C_WORD_MAX                INT_MAX
 847# define C_UWORD_MAX               UINT_MAX
 848#endif
 849
 850/* Clang and G++ support statement expressions, but only in a limited way */
 851#if DEBUGBUILD && HAVE_STATEMENT_EXPRESSIONS && !defined(__cplusplus)
 852/* These are wrappers around the following idiom:
 853 *    assert(SOME_PRED(obj));
 854 *    do_something_with(obj);
 855 * This works around the fact obj may be an expression with side-effects.
 856 *
 857 * To make this work with nested expansions, we need semantics like
 858 * (let ((x 1)) (let ((x x)) x)) => 1, but in C, int x = x; results in
 859 * undefined behaviour because x refers to itself.  As a workaround,
 860 * we keep around a reference to the previous level (one scope up).
 861 * After initialisation, "previous" is redefined to mean "current".
 862 */
 863# define C_VAL1(x)                 C__PREV_TMPST.n1
 864# define C_VAL2(x)                 C__PREV_TMPST.n2
 865# define C__CHECK_panic(a,s,f,l)                                       \
 866  ((a) ? (void)0 :                                                     \
 867   C_panic_hook(C_text("Low-level type assertion " s " failed at " f ":" C__STR1(l))))
 868# define C__CHECK_core(v,a,s,x)                                         \
 869  ({ struct {                                                           \
 870      typeof(v) n1;                                                     \
 871  } C__TMPST = { .n1 = (v) };                                           \
 872    typeof(C__TMPST) C__PREV_TMPST=C__TMPST;                            \
 873    C__CHECK_panic(a,s,__FILE__,__LINE__);                              \
 874    x; })
 875# define C__CHECK2_core(v1,v2,a,s,x)                                    \
 876  ({ struct {                                                           \
 877      typeof(v1) n1;                                                    \
 878      typeof(v2) n2;                                                    \
 879  } C__TMPST = { .n1 = (v1), .n2 = (v2) };                              \
 880    typeof(C__TMPST) C__PREV_TMPST=C__TMPST;                            \
 881    C__CHECK_panic(a,s,__FILE__,__LINE__);                              \
 882    x; })
 883# define C_CHECK(v,a,x)            C__CHECK_core(v,a,#a,x)
 884# define C_CHECK2(v1,v2,a,x)       C__CHECK2_core(v1,v2,a,#a,x)
 885/*
 886 * Convenience for using Scheme-predicates.
 887 */
 888# define C_CHECKp(v,a,x)           C__CHECK_core(v,C_truep(a),#a"=#t",x)
 889# define C_CHECK2p(v1,v2,a,x)      C__CHECK2_core(v1,v2,C_truep(a),#a"=#t",x)
 890#else
 891# define C_VAL1(x)                 (x)
 892# define C_VAL2(x)                 (x)
 893# define C_CHECK(v,a,x)            (x)
 894# define C_CHECK2(v1,v2,a,x)       (x)
 895# define C_CHECKp(v,a,x)           (x)
 896# define C_CHECK2p(v1,v2,a,x)      (x)
 897#endif
 898
 899#ifndef C_PROVIDE_LIBC_STUBS
 900# define C_FILEPTR                  FILE *
 901
 902# define C_stdin                    stdin
 903# define C_stdout                   stdout
 904# define C_stderr                   stderr
 905
 906# define C_memcpy                   memcpy
 907# define C_memcmp                   memcmp
 908# define C_strncpy                  strncpy
 909# define C_strcmp                   strcmp
 910# define C_strncmp                  strncmp
 911# define C_strlen                   strlen
 912# define C_memchr                   memchr
 913# define C_memset                   memset
 914# define C_memmove                  memmove
 915# define C_malloc                   malloc
 916# define C_calloc                   calloc
 917# define C_free                     free
 918# define C_strchr                   strchr
 919# define C_realloc                  realloc
 920# define C_strdup                   strdup
 921# define C_strtol                   strtol
 922# define C_strtoll                  strtoll
 923# define C_strtod                   strtod
 924# define C_strtoul                  strtoul
 925# ifdef C_WCHAR_FILENAMES
 926#  define C_fopen			_wfopen
 927#  define C_system		_wsystem
 928#  define C_access                _waccess
 929# else
 930#  define C_fopen                    fopen
 931#  define C_system		   system
 932#  define C_access		   access
 933# endif
 934# define C_fclose                   fclose
 935# define C_strpbrk                  strpbrk
 936# define C_strcspn                  strcspn
 937# define C_snprintf                 snprintf
 938# define C_printf                   printf
 939# define C_fprintf                  fprintf
 940# define C_vfprintf                 vfprintf
 941# define C_fflush                   fflush
 942# define C_getchar                  getchar
 943# define C_exit                     exit
 944# define C__exit                    _exit
 945# define C_dlopen                   dlopen
 946# define C_dlclose                  dlclose
 947# define C_dlsym                    dlsym
 948# define C_fwrite                   fwrite
 949# define C_fread                    fread
 950# define C_fputs                    fputs
 951# define C_fputc                    fputc
 952# define C_putchar                  putchar
 953# if (defined getc_unlocked || _POSIX_C_SOURCE >= 199506L) && !defined(__MINGW32__)
 954#  define C_getc                    getc_unlocked
 955# else
 956#  define C_getc                    getc
 957# endif
 958# define C_fgetc                    fgetc
 959# define C_fgets                    fgets
 960# define C_ungetc                   ungetc
 961# define C_isatty                   isatty
 962# define C_fileno                   fileno
 963# define C_select                   select
 964# if defined(HAVE_SIGACTION)
 965# define C_sigaction                sigaction
 966# endif
 967# define C_signal                   signal
 968# define C_getrusage                getrusage
 969# define C_gettimeofday             gettimeofday
 970# define C_gmtime                   gmtime
 971# define C_localtime                localtime
 972/*
 973 * It is undefined whether regular setjmp/longjmp save/restore signal mask
 974 * so try to use versions that we know won't try to save & restore.
 975 */
 976# if defined(HAVE_SIGSETJMP)
 977#   define C_sigsetjmp              sigsetjmp
 978#   define C_siglongjmp             siglongjmp
 979# endif
 980# ifdef HAVE_SIGPROCMASK
 981#  define C_sigprocmask             sigprocmask
 982# endif
 983# define C_setjmp                   setjmp
 984# define C_longjmp                  longjmp
 985# define C_alloca                   alloca
 986# define C_strerror                 strerror
 987# define C_sin                      sin
 988# define C_cos                      cos
 989# define C_tan                      tan
 990# define C_asin                     asin
 991# define C_acos                     acos
 992# define C_atan                     atan
 993# define C_sinh                     sinh
 994# define C_cosh                     cosh
 995# define C_tanh                     tanh
 996# define C_asinh                    asinh
 997# define C_acosh                    acosh
 998# define C_atanh                    atanh
 999# define C_atan2                    atan2
 1000# define C_log                      log
1001# define C_exp                      exp
1002# define C_pow                      pow
1003# define C_sqrt                     sqrt
1004# define C_ceil                     ceil
1005# define C_floor                    floor
1006# define C_round                    round
1007# define C_trunc                    trunc
1008# define C_fabs                     fabs
1009# define C_modf                     modf
1010# define C_readlink                 readlink
1011# define C_getcwd                   getcwd
1012# define C_getpid                   getpid
1013# define C_fma                      fma
1014#else
1015/* provide this file and define C_PROVIDE_LIBC_STUBS if you want to use
1016   your own libc-replacements or -wrappers */
1017# include "chicken-libc-stubs.h"
1018#endif
1019
1020#ifdef C_LLP
1021# define C_strtow                  C_strtoll
1022#else
1023# define C_strtow                  C_strtol
1024#endif
1025
1026#define C_return(x)                return(x)
1027#define C_resize_stack(n)          C_do_resize_stack(n)
1028#define C_memcpy_slots(t, f, n)    C_memcpy((t), (f), (n) * sizeof(C_word))
1029/* Without check: initialisation of a newly allocated header */
1030#define C_block_header_init(x,h)   (((C_SCHEME_BLOCK *)(x))->header = (h))
1031/* These two must result in an lvalue, hence the (*foo(&bar)) faffery */
1032#define C_block_header(x)          (*C_CHECKp(x,C_blockp((C_word)C_VAL1(x)),&(((C_SCHEME_BLOCK *)(C_VAL1(x)))->header)))
1033#define C_block_item(x,i)          (*C_CHECK2(x,i,(C_header_size(C_VAL1(x))>(C_VAL2(i))),&(((C_SCHEME_BLOCK *)(C_VAL1(x)))->data [ C_VAL2(i) ])))
1034#define C_set_block_item(x,i,y)    (C_block_item(x, i) = (y))
1035#define C_header_bits(bh)          (C_block_header(bh) & C_HEADER_BITS_MASK)
1036#define C_header_type(bh)          (C_block_header(bh) & C_HEADER_TYPE_BITS)
1037#define C_header_size(bh)          (C_block_header(bh) & C_HEADER_SIZE_MASK)
1038#define C_bignum_size(b)           (C_bytestowords(C_header_size(C_internal_bignum_vector(b)))-1)
1039#define C_make_header(type, size)  ((C_header)(((type) & C_HEADER_BITS_MASK) | ((size) & C_HEADER_SIZE_MASK)))
1040#define C_symbol_value(x)          (C_block_item(x, 0))
1041#define C_symbol_name(x)           (C_block_item(x, 1))
1042#define C_symbol_plist(x)          (C_block_item(x, 2))
1043#define C_save(x)	                 (*(--C_temporary_stack) = (C_word)(x))
1044#define C_rescue(x, i)             (C_temporary_stack[ i ] = (x))
1045#define C_restore                  (*(C_temporary_stack++))
1046#define C_heaptop                  ((C_word **)(&C_fromspace_top))
1047#define C_drop(n)                  (C_temporary_stack += (n))
1048#define C_alloc(n)                 ((C_word *)C_alloca((n) * sizeof(C_word)))
1049#if (defined (__llvm__) && defined (__GNUC__)) || defined (__TINYC__)
1050# if defined (__i386__)
1051#  define C_stack_pointer ({C_word *sp; __asm__ __volatile__("movl %%esp,%0":"=r"(sp):);sp;})
1052# elif defined (__x86_64__)
1053#  define C_stack_pointer ({C_word *sp; __asm__ __volatile__("movq %%rsp,%0":"=r"(sp):);sp;})
1054# else
1055/* Not alloca(0) because:
1056 * - LLVM allocates anyways
1057 * - TCC always returns NULL
1058 */
1059#  define C_stack_pointer ((C_word *)C_alloca(1))
1060# endif
1061#else
1062# define C_stack_pointer ((C_word *)C_alloca(0))
1063#endif
1064#define C_stack_pointer_test       ((C_word *)C_alloca(1))
1065#define C_demand_2(n)              (((C_word *)C_fromspace_top + (n)) < (C_word *)C_fromspace_limit)
1066#define C_calculate_demand(n,c,m)  ((n) + (((c) > (m)) ? 0 : (m)))
1067#define C_fix(n)                   ((C_word)((C_uword)(n) << C_FIXNUM_SHIFT) | C_FIXNUM_BIT)
1068#define C_unfix(x)                 C_CHECKp(x,C_fixnump(C_VAL1(x)),((C_VAL1(x)) >> C_FIXNUM_SHIFT))
1069#define C_make_character(c)        (((((C_uword)(c)) & C_CHAR_BIT_MASK) << C_CHAR_SHIFT) | C_CHARACTER_BITS)
1070#define C_character_code(x)        C_CHECKp(x,C_charp(C_VAL1(x)),((C_word)(C_VAL1(x)) >> C_CHAR_SHIFT) & C_CHAR_BIT_MASK)
1071#define C_flonum_magnitude(x)      (*C_CHECKp(x,C_flonump(C_VAL1(x)),(double *)C_data_pointer(C_VAL1(x))))
1072#define C_c_string(x)              C_CHECK(x,(C_truep(C_bytevectorp(C_VAL1(x)))),(C_char *)C_data_pointer(C_VAL1(x)))
1073
1074#define C_c_pointer(x)             ((void *)(x))
1075#define C_c_pointer_nn(x)          ((void *)C_block_item(x, 0))
1076#define C_truep(x)                 ((x) != C_SCHEME_FALSE)
1077#define C_immediatep(x)            ((x) & C_IMMEDIATE_MARK_BITS)
1078#define C_mk_bool(x)               ((x) ? C_SCHEME_TRUE : C_SCHEME_FALSE)
1079#define C_mk_nbool(x)              ((x) ? C_SCHEME_FALSE : C_SCHEME_TRUE)
1080#define C_port_file(p)             C_CHECKp(p,C_portp(C_VAL1(p)),(C_FILEPTR)C_block_item(C_VAL1(p), 0))
1081#define C_port_fileno(p)           C_fix(C_fileno(C_port_file(p)))
1082#define C_data_pointer(b)          C_CHECKp(b,C_blockp((C_word)C_VAL1(b)),(void *)(((C_SCHEME_BLOCK *)(C_VAL1(b)))->data))
1083#define C_bignum_negativep(b)      C_CHECKp(b,C_bignump(C_VAL1(b)),(C_block_item(C_internal_bignum_vector(C_VAL1(b)),0)!=0))
1084#define C_bignum_digits(b)         C_CHECKp(b,C_bignump(C_VAL1(b)),(((C_uword *)C_data_pointer(C_internal_bignum_vector(C_VAL1(b))))+1))
1085#define C_fitsinbignumhalfdigitp(n)(C_BIGNUM_DIGIT_HI_HALF(n) == 0)
1086#define C_bignum_negated_fitsinfixnump(b) (C_bignum_size(b) == 1 && (C_bignum_negativep(b) ? C_ufitsinfixnump(*C_bignum_digits(b)) : !(*C_bignum_digits(b) & C_INT_SIGN_BIT) && C_fitsinfixnump(-(C_word)*C_bignum_digits(b))))
1087#define C_bignum_mutate_size(b, s) (C_block_header(C_internal_bignum_vector(b)) = (C_BYTEVECTOR_TYPE | C_wordstobytes((s)+1)))
1088#define C_fitsinfixnump(n)         (((n) & C_INT_SIGN_BIT) == (((C_uword)(n) & C_INT_TOP_BIT) << 1))
1089#define C_ufitsinfixnump(n)        (((n) & (C_INT_SIGN_BIT | (C_INT_SIGN_BIT >> 1))) == 0)
1090#define C_and(x, y)                (C_truep(x) ? (y) : C_SCHEME_FALSE)
1091#define C_c_bytevector(x)          ((unsigned char *)C_data_pointer(x))
1092#define C_c_bytevector_or_null(x)  ((unsigned char *)C_data_pointer_or_null(x))
1093#define C_srfi_4_vector(x)         C_data_pointer(C_block_item(x,1))
1094#define C_c_s8vector(x)            ((signed char *)C_srfi_4_vector(x))
1095#define C_c_s8vector_or_null(x)    ((signed char *)C_srfi_4_vector_or_null(x))
1096#define C_c_u16vector(x)           ((unsigned short *)C_srfi_4_vector(x))
1097#define C_c_u16vector_or_null(x)   ((unsigned short *)C_srfi_4_vector_or_null(x))
1098#define C_c_s16vector(x)           ((short *)C_srfi_4_vector(x))
1099#define C_c_s16vector_or_null(x)   ((short *)C_srfi_4_vector_or_null(x))
1100#define C_c_u32vector(x)           ((C_u32 *)C_srfi_4_vector(x))
1101#define C_c_u32vector_or_null(x)   ((C_u32 *)C_srfi_4_vector_or_null(x))
1102#define C_c_s32vector(x)           ((C_s32 *)C_srfi_4_vector(x))
1103#define C_c_s32vector_or_null(x)   ((C_s32 *)C_srfi_4_vector_or_null(x))
1104#define C_c_u64vector(x)           ((C_u64 *)C_srfi_4_vector(x))
1105#define C_c_u64vector_or_null(x)   ((C_u64 *)C_srfi_4_vector_or_null(x))
1106#define C_c_s64vector(x)           ((C_s64 *)C_srfi_4_vector(x))
1107#define C_c_s64vector_or_null(x)   ((C_s64 *)C_srfi_4_vector_or_null(x))
1108#define C_c_f32vector(x)           ((float *)C_srfi_4_vector(x))
1109#define C_c_f32vector_or_null(x)   ((float *)C_srfi_4_vector_or_null(x))
1110#define C_c_f64vector(x)           ((double *)C_srfi_4_vector(x))
1111#define C_c_f64vector_or_null(x)   ((double *)C_srfi_4_vector_or_null(x))
1112#define C_c_pointer_vector(x)      ((void **)C_data_pointer(C_block_item((x), 2)))
1113
1114#define C_isnan(f)                 isnan(f)
1115#define C_isinf(f)                 isinf(f)
1116#define C_isfinite(f)              isfinite(f)
1117
1118#define C_stack_overflow_check    C_stack_check1(C_stack_overflow(NULL))
1119
1120/* TODO: The C_scratch_usage checks should probably be moved.  Maybe
1121 * we should add a core#allocate_scratch_inline which will insert
1122 * C_demand/C_stack_probe-like checks to copy the result onto the
1123 * stack or reclaim, but in a clever way so it's only done at the
1124 * "end" of a C function.
1125 */
1126#if C_STACK_GROWS_DOWNWARD
1127# define C_demand(n)              ((C_word)(C_stack_pointer - C_stack_limit) > ((n)+C_scratch_usage))
1128# define C_stack_check1(err)      if(!C_disable_overflow_check) {	\
1129                                    do { C_byte *_sp = (C_byte*)(C_stack_pointer); \
1130				      if(_sp < (C_byte *)C_stack_hard_limit && \
1131					 ((C_byte *)C_stack_hard_limit - _sp) > C_STACK_RESERVE) \
1132					err; }				\
1133				    while(0);}
1134
1135#else
1136# define C_demand(n)              ((C_word)(C_stack_limit - C_stack_pointer) > ((n)+C_scratch_usage))
1137# define C_stack_check1(err)      if(!C_disable_overflow_check) {	\
1138                                    do { C_byte *_sp = (C_byte*)(C_stack_pointer); \
1139				      if(_sp > (C_byte *)C_stack_hard_limit && \
1140					 (_sp - (C_byte *)C_stack_hard_limit) > C_STACK_RESERVE) \
1141					err; }				\
1142				    while(0);}
1143
1144#endif
1145
1146#define C_zero_length_p(x)        C_mk_bool(C_header_size(x) == 0)
1147#define C_boundp(x)               C_mk_bool(C_block_item(x, 0) != C_SCHEME_UNBOUND)
1148#define C_unboundvaluep(x)        C_mk_bool((x) == C_SCHEME_UNBOUND)
1149#define C_blockp(x)               C_mk_bool(!C_immediatep(x))
1150#define C_forwardedp(x)           C_mk_bool((C_block_header(x) & C_GC_FORWARDING_BIT) != 0)
1151#define C_immp(x)                 C_mk_bool(C_immediatep(x))
1152#define C_flonump(x)              C_mk_bool(C_block_header(x) == C_FLONUM_TAG)
1153#define C_bignump(x)              C_mk_bool(C_block_header(x) == C_BIGNUM_TAG)
1154#define C_stringp(x)              C_mk_bool(C_header_bits(x) == C_STRING_TYPE)
1155#define C_symbolp(x)              C_mk_bool(C_block_header(x) == C_SYMBOL_TAG)
1156#define C_pairp(x)                C_mk_bool(C_header_type(x) == C_PAIR_TYPE)
1157#define C_weak_pairp(x)           C_mk_bool(C_block_header(x) == C_WEAK_PAIR_TAG)
1158#define C_closurep(x)             C_mk_bool(C_header_bits(x) == C_CLOSURE_TYPE)
1159#define C_vectorp(x)              C_mk_bool(C_header_bits(x) == C_VECTOR_TYPE)
1160#define C_bytevectorp(x)          C_mk_bool(C_header_bits(x) == C_BYTEVECTOR_TYPE)
1161#define C_portp(x)                C_mk_bool(C_header_bits(x) == C_PORT_TYPE)
1162#define C_structurep(x)           C_mk_bool(C_header_bits(x) == C_STRUCTURE_TYPE)
1163#define C_locativep(x)            C_mk_bool(C_block_header(x) == C_LOCATIVE_TAG)
1164#define C_charp(x)                C_mk_bool(((x) & C_IMMEDIATE_TYPE_BITS) == C_CHARACTER_BITS)
1165#define C_booleanp(x)             C_mk_bool(((x) & C_IMMEDIATE_TYPE_BITS) == C_BOOLEAN_BITS)
1166#define C_eofp(x)                 C_mk_bool((x) == C_SCHEME_END_OF_FILE)
1167#define C_undefinedp(x)           C_mk_bool((x) == C_SCHEME_UNDEFINED)
1168#define C_bwpp(x)                 C_mk_bool((x) == C_SCHEME_BROKEN_WEAK_PTR)
1169#define C_fixnump(x)              C_mk_bool((x) & C_FIXNUM_BIT)
1170#define C_nfixnump(x)             C_mk_nbool((x) & C_FIXNUM_BIT)
1171#define C_pointerp(x)             C_mk_bool(C_block_header(x) == C_POINTER_TAG)
1172#define C_taggedpointerp(x)       C_mk_bool(C_block_header(x) == C_TAGGED_POINTER_TAG)
1173#define C_lambdainfop(x)          C_mk_bool(C_header_bits(x) == C_LAMBDA_INFO_TYPE)
1174#define C_anypointerp(x)          C_mk_bool(C_block_header(x) == C_POINTER_TAG || C_block_header(x) == C_TAGGED_POINTER_TAG)
1175#define C_specialp(x)             C_mk_bool(C_header_bits(x) & C_SPECIALBLOCK_BIT)
1176#define C_byteblockp(x)           C_mk_bool(C_header_bits(x) & C_BYTEBLOCK_BIT)
1177#define C_sametypep(x, y)         C_mk_bool(C_header_bits(x) == C_header_bits(y))
1178#define C_eqp(x, y)               C_mk_bool((x) == (y))
1179#define C_vemptyp(x)              C_mk_bool(C_header_size(x) == 0)
1180#define C_notvemptyp(x)           C_mk_bool(C_header_size(x) > 0)
1181
1182#define C_port_typep(x, n)        C_mk_bool((C_block_item(x, 1) & n) == n)
1183#define C_input_portp(x)          C_and(C_portp(x), C_port_typep(x, 0x2))
1184#define C_output_portp(x)         C_and(C_portp(x), C_port_typep(x, 0x4))
1185
1186#define C_port_openp(port, n)     C_mk_bool((C_block_item(port, 8) & n) == n)
1187#define C_input_port_openp(port)  C_port_openp(port, 0x2)
1188#define C_output_port_openp(port) C_port_openp(port, 0x4)
1189
1190#define C_slot(x, i)              C_block_item(x, C_unfix(i))
1191#define C_subbyte(x, i)           C_fix(((C_byte *)C_data_pointer(x))[ C_unfix(i) ] & 0xff)
1192#define C_setsubbyte(x, i, n)     ((((C_byte *)C_data_pointer(x))[ C_unfix(i) ] = C_unfix(n) & 0xff), C_SCHEME_UNDEFINED)
1193
1194#define C_fixnum_times(n1, n2)          (C_fix(C_unfix(n1) * C_unfix(n2)))
1195#define C_u_fixnum_plus(n1, n2)         (((n1) - C_FIXNUM_BIT) + (n2))
1196#define C_fixnum_plus(n1, n2)           (C_u_fixnum_plus(n1, n2) | C_FIXNUM_BIT)
1197#define C_u_fixnum_difference(n1, n2)   ((n1) - (n2) + C_FIXNUM_BIT)
1198#define C_fixnum_difference(n1, n2)     (C_u_fixnum_difference(n1, n2) | C_FIXNUM_BIT)
1199#define C_u_fixnum_divide(n1, n2)       (C_fix(C_unfix(n1) / C_unfix(n2)))
1200#define C_u_fixnum_and(n1, n2)          ((n1) & (n2))
1201#define C_fixnum_and(n1, n2)            (C_u_fixnum_and(n1, n2) | C_FIXNUM_BIT)
1202#define C_u_fixnum_or(n1, n2)           ((n1) | (n2))
1203#define C_fixnum_or(n1, n2)             C_u_fixnum_or(n1, n2)
1204#define C_fixnum_xor(n1, n2)            (((n1) ^ (n2)) | C_FIXNUM_BIT)
1205#define C_fixnum_not(n)                 ((~(n)) | C_FIXNUM_BIT)
1206#define C_fixnum_shift_left(n1, n2)     (C_fix(((C_uword)C_unfix(n1) << (C_uword)C_unfix(n2))))
1207#define C_fixnum_shift_right(n1, n2)    (((n1) >> (C_uword)C_unfix(n2)) | C_FIXNUM_BIT)
1208#define C_u_fixnum_negate(n)            (-(n) + 2 * C_FIXNUM_BIT)
1209#define C_fixnum_negate(n)              (C_u_fixnum_negate(n) | C_FIXNUM_BIT)
1210#define C_fixnum_greaterp(n1, n2)       (C_mk_bool((C_word)(n1) > (C_word)(n2)))
1211#define C_fixnum_lessp(n1, n2)          (C_mk_bool((C_word)(n1) < (C_word)(n2)))
1212#define C_fixnum_greater_or_equal_p(n1, n2) (C_mk_bool((C_word)(n1) >= (C_word)(n2)))
1213#define C_fixnum_less_or_equal_p(n1, n2)(C_mk_bool((C_word)(n1) <= (C_word)(n2)))
1214#define C_u_fixnum_increase(n)          ((n) + (1 << C_FIXNUM_SHIFT))
1215#define C_fixnum_increase(n)            (C_u_fixnum_increase(n) | C_FIXNUM_BIT)
1216#define C_u_fixnum_decrease(n)          ((n) - (1 << C_FIXNUM_SHIFT))
1217#define C_fixnum_decrease(n)            (C_u_fixnum_decrease(n) | C_FIXNUM_BIT)
1218/* XXX TODO: This should probably be renamed C_u_fixnum_abs or something */
1219#define C_fixnum_abs(n)                 C_fix(abs(C_unfix(n)))
1220#define C_a_i_fixnum_abs(ptr, n, x)     (((x) & C_INT_SIGN_BIT) ? C_a_i_fixnum_negate((ptr), (n), (x)) : (x))
1221#define C_i_fixnum_signum(x)            ((x) == C_fix(0) ? (x) : (((x) & C_INT_SIGN_BIT) ? C_fix(-1) : C_fix(1)))
1222#define C_i_fixnum_length(x)            C_fix(C_ilen(((x) & C_INT_SIGN_BIT) ? ~C_unfix(x) : C_unfix(x)))
1223
1224#define C_flonum_equalp(n1, n2)         C_mk_bool(C_flonum_magnitude(n1) == C_flonum_magnitude(n2))
1225#define C_flonum_greaterp(n1, n2)       C_mk_bool(C_flonum_magnitude(n1) > C_flonum_magnitude(n2))
1226#define C_flonum_lessp(n1, n2)          C_mk_bool(C_flonum_magnitude(n1) < C_flonum_magnitude(n2))
1227#define C_flonum_greater_or_equal_p(n1, n2) C_mk_bool(C_flonum_magnitude(n1) >= C_flonum_magnitude(n2))
1228#define C_flonum_less_or_equal_p(n1, n2) C_mk_bool(C_flonum_magnitude(n1) <= C_flonum_magnitude(n2))
1229
1230#define C_a_i_flonum_plus(ptr, c, n1, n2) C_flonum(ptr, C_flonum_magnitude(n1) + C_flonum_magnitude(n2))
1231#define C_a_i_flonum_difference(ptr, c, n1, n2) C_flonum(ptr, C_flonum_magnitude(n1) - C_flonum_magnitude(n2))
1232#define C_a_i_flonum_times(ptr, c, n1, n2) C_flonum(ptr, C_flonum_magnitude(n1) * C_flonum_magnitude(n2))
1233#define C_a_i_flonum_multiply_add(ptr, c, n1, n2, n3) C_flonum(ptr, fma(C_flonum_magnitude(n1), C_flonum_magnitude(n2), C_flonum_magnitude(n3)))
1234#define C_a_i_flonum_quotient(ptr, c, n1, n2) C_flonum(ptr, C_flonum_magnitude(n1) / C_flonum_magnitude(n2))
1235#define C_a_i_flonum_negate(ptr, c, n)  C_flonum(ptr, -C_flonum_magnitude(n))
1236#define C_a_u_i_flonum_signum(ptr, n, x) (C_flonum_magnitude(x) == 0.0 ? (x) : ((C_flonum_magnitude(x) < 0.0) ? C_flonum(ptr, -1.0) : C_flonum(ptr, 1.0)))
1237
1238#define C_a_i_address_to_pointer(ptr, c, addr)  C_mpointer(ptr, (void *)C_num_to_unsigned_int(addr))
1239#define C_a_i_pointer_to_address(ptr, c, pptr)  C_unsigned_int_to_num(ptr, (unsigned int)C_c_pointer_nn(pptr))
1240
1241#define C_display_fixnum(p, n)          (C_fprintf(C_port_file(p), C_text("%d"), C_unfix(n)), C_SCHEME_UNDEFINED)
1242#define C_display_char(p, c)            (C_utf_putc(C_character_code(c), C_port_file(p)), C_SCHEME_UNDEFINED)
1243#define C_display_string(p, s, start, len)  \
1244                                         (C_fwrite(C_c_string(s) + C_unfix(start), sizeof(C_char), C_unfix(len), C_port_file(p)), C_SCHEME_UNDEFINED)
1245#define C_flush_output(port)            (C_fflush(C_port_file(port)), C_SCHEME_UNDEFINED)
1246
1247#define C_fix_to_char(x)                (C_make_character(C_unfix(x)))
1248#define C_char_to_fix(x)                (C_fix(C_character_code(x)))
1249#define C_u_i_char_equalp(x, y)         C_mk_bool(C_character_code(x) == C_character_code(y))
1250#define C_u_i_char_greaterp(x, y)       C_mk_bool(C_character_code(x) > C_character_code(y))
1251#define C_u_i_char_lessp(x, y)          C_mk_bool(C_character_code(x) < C_character_code(y))
1252#define C_u_i_char_greater_or_equal_p(x, y) C_mk_bool(C_character_code(x) >= C_character_code(y))
1253#define C_u_i_char_less_or_equal_p(x, y) C_mk_bool(C_character_code(x) <= C_character_code(y))
1254
1255#define C_bv_compare(x, y, n)           C_mk_bool(C_memcmp(C_data_pointer(x), C_data_pointer(y), C_unfix(n)) == 0)
1256#define C_u_i_string_equal_p(x, y)        C_utf_equal(x, y)
1257#define C_u_i_string_ci_equal_p(x, y)     C_utf_equal_ci(x, y)
1258
1259#define C_u_i_substring_equal_p(x, y, s1, s2, len) \
1260                                        C_mk_bool(C_utf_compare(x, y, s1, s2, len) == C_fix(0))
1261#define C_u_i_substring_ci_equal_p(x, y, s1, s2, len) \
1262                                        C_mk_bool(C_utf_compare_ci(x, y, s1, s2, len) == C_fix(0))
1263
1264/* this does not use C_mutate: */
1265#define C_copy_bytevector(b1, b2, len)  (C_memcpy(C_data_pointer(b2), C_data_pointer(b1), C_unfix(len)), (b2))
1266#define C_fill_bytevector(bv, code, start, len) \
1267                                        (C_memset(C_data_pointer(bv) + C_unfix(start), C_unfix(code), C_unfix(len)), \
1268                                            C_SCHEME_UNDEFINED)
1269#define C_subvector_copy(v1, v2, start1, end1, start2) \
1270                                        (C_memcpy_slots((C_char *)C_data_pointer(v2) + C_unfix(start2), \
1271                                                  (C_char *)C_data_pointer(v1) + C_unfix(start1), \
1272						  C_unfix(end1) - C_unfix(start1) ), C_SCHEME_UNDEFINED)
1273#define C_words(n)                      C_fix(C_bytestowords(C_unfix(n)))
1274#define C_bytes(n)                      C_fix(C_wordstobytes(C_unfix(n)))
1275#define C_rand(n)                      C_fix((C_word)(((double)C_fast_rand())/(32767 + 1.0) * C_unfix(n)))
1276#define C_block_size(x)                 C_fix(C_header_size(x))
1277#define C_u_i_bignum_size(b)            C_fix(C_bignum_size(b))
1278#define C_a_u_i_big_to_flo(p, n, b)     C_flonum(p, C_bignum_to_double(b))
1279#define C_u_i_ratnum_num(r)             C_block_item((r), 0)
1280#define C_u_i_ratnum_denom(r)           C_block_item((r), 1)
1281#define C_u_i_cplxnum_real(c)           C_block_item((c), 0)
1282#define C_u_i_cplxnum_imag(c)           C_block_item((c), 1)
1283#define C_pointer_address(x)            ((C_byte *)C_block_item((x), 0))
1284#define C_block_address(ptr, n, x)      C_a_unsigned_int_to_num(ptr, n, x)
1285#define C_offset_pointer(x, y)          (C_pointer_address(x) + (y))
1286#define C_do_apply(c, av)               ((C_proc)(void *)C_block_item((av)[0], 0))((c), (av))
1287#define C_kontinue(k, r)                do { C_word avk[ 2 ]; avk[ 0 ] = (k); avk[ 1 ] = (r); ((C_proc)(void *)C_block_item((k),0))(2, avk); } while(0)
1288#define C_get_rest_arg(c, n, av, ka, cl)((n) >= (c) ? (C_rest_arg_out_of_bounds_error_2(C_fix(c), C_fix(n), C_fix(ka), (cl)), C_SCHEME_UNDEFINED) : (av)[(n)])
1289#define C_rest_arg_out_of_bounds_error_value(c, n, ka) (C_rest_arg_out_of_bounds_error((c),(n),(ka)), C_SCHEME_UNDEFINED)
1290#define C_rest_nullp(c, n)              (C_mk_bool((n) >= (c)))
1291#define C_fetch_byte(x, p)              (((unsigned C_byte *)C_data_pointer(x))[ p ])
1292#define C_poke_integer(x, i, n)         (C_set_block_item(x, C_unfix(i), C_num_to_int(n)), C_SCHEME_UNDEFINED)
1293#define C_pointer_to_block(p, x)        (C_set_block_item(p, 0, (C_word)C_data_pointer(x)), C_SCHEME_UNDEFINED)
1294#define C_null_pointerp(x)              C_mk_bool((void *)C_block_item(x, 0) == NULL)
1295#define C_update_pointer(p, ptr)        (C_set_block_item(ptr, 0, C_num_to_unsigned_int(p)), C_SCHEME_UNDEFINED)
1296#define C_copy_pointer(from, to)        (C_set_block_item(to, 0, C_block_item(from, 0)), C_SCHEME_UNDEFINED)
1297#define C_pointer_to_object(ptr)        C_block_item(ptr, 0)
1298
1299#ifdef C_SIXTY_FOUR
1300# define C_poke_integer_32(x, i, n)     (((C_s32 *)C_data_pointer(x))[ C_unfix(i) ] = C_unfix(n), C_SCHEME_UNDEFINED)
1301#else
1302# define C_poke_integer_32              C_poke_integer
1303#endif
1304
1305#define C_copy_memory(to, from, n)      (C_memmove(C_data_pointer(to), C_data_pointer(from), C_unfix(n)), C_SCHEME_UNDEFINED)
1306#define C_copy_memory_with_offset(to, from, start1, start2, n) \
1307                                        (C_memmove(C_data_pointer(to) + C_unfix(start1), C_data_pointer(from) + C_unfix(start2), C_unfix(n)), C_SCHEME_UNDEFINED)
1308#define C_copy_ptr_memory(to, from, n, toff, foff) \
1309  (C_memmove(C_pointer_address(to) + C_unfix(toff), C_pointer_address(from) + C_unfix(foff), \
1310	     C_unfix(n)), C_SCHEME_UNDEFINED)
1311#define C_poke_double(b, i, n)          (((double *)C_data_pointer(b))[ C_unfix(i) ] = C_c_double(n), C_SCHEME_UNDEFINED)
1312#define C_poke_c_string(b, i, from, s)  (C_strlcpy((char *)C_block_item(b, C_unfix(i)), C_data_pointer(from), s), C_SCHEME_UNDEFINED)
1313#define C_peek_fixnum(b, i)             C_fix(C_block_item(b, C_unfix(i)))
1314#define C_peek_byte(ptr, i)             C_fix(((unsigned char *)C_u_i_car(ptr))[ C_unfix(i) ])
1315#define C_dupstr(s)                     C_strdup(C_data_pointer(s))
1316#define C_poke_pointer(b, i, x)         (C_set_block_item(b, C_unfix(i), (C_word)C_data_pointer(x)), C_SCHEME_UNDEFINED)
1317#define C_poke_pointer_or_null(b, i, x) (C_set_block_item(b, C_unfix(i), (C_word)C_data_pointer_or_null(x)), C_SCHEME_UNDEFINED)
1318#define C_qfree(ptr)                    (C_free(C_c_pointer_nn(ptr)), C_SCHEME_UNDEFINED)
1319
1320#define C_tty_portp(p)                  C_mk_bool(isatty(fileno(C_port_file(p))))
1321
1322#define C_emit_trace_info(l, x, y, z)   C_emit_trace_info2(NULL, l, x, y, z)
1323#define C_emit_eval_trace_info(x, y, z) C_emit_trace_info2(C_text("<eval>"), C_SCHEME_FALSE, x, y, z)
1324#define C_emit_syntax_trace_info(x, y, z) C_emit_trace_info2(C_text("<syntax>"), C_SCHEME_FALSE, x, y, z)
1325
1326/* These expect C_VECTOR_TYPE to be 0: */
1327#define C_vector_to_structure(v)        (C_block_header(v) |= C_STRUCTURE_TYPE, C_SCHEME_UNDEFINED)
1328#define C_vector_to_closure(v)          (C_block_header(v) |= C_CLOSURE_TYPE, C_SCHEME_UNDEFINED)
1329#define C_bytevector_to_lambdainfo(s)       (C_block_header(s) = C_header_size(s) | C_LAMBDA_INFO_TYPE, C_SCHEME_UNDEFINED)
1330
1331#ifdef C_TIMER_INTERRUPTS
1332# define C_check_for_interrupt         if(--C_timer_interrupt_counter <= 0) C_raise_interrupt(C_TIMER_INTERRUPT_NUMBER)
1333#else
1334# define C_check_for_interrupt
1335#endif
1336
1337#define C_set_initial_timer_interrupt_period(n) \
1338  (C_initial_timer_interrupt_period = C_unfix(n), C_SCHEME_UNDEFINED)
1339
1340
1341#ifdef HAVE_STATEMENT_EXPRESSIONS
1342# define C_a_i(a, n)                     ({C_word *tmp = *a; *a += (n); tmp;})
1343# define C_a_i_cons(a, n, car, cdr)      ({C_word tmp = (C_word)(*a); (*a)[0] = C_PAIR_TAG; *a += C_SIZEOF_PAIR; \
1344                                           C_set_block_item(tmp, 0, car); C_set_block_item(tmp, 1, cdr); tmp;})
1345# define C_a_i_weak_cons(a, n, car, cdr) ({C_word tmp = (C_word)(*a); (*a)[0] = C_WEAK_PAIR_TAG; *a += C_SIZEOF_PAIR; \
1346                                           C_set_block_item(tmp, 0, car); C_set_block_item(tmp, 1, cdr); tmp;})
1347#else
1348# define C_a_i_cons(a, n, car, cdr)      C_a_pair(a, car, cdr)
1349# define C_a_i_weak_cons(a, n, car, cdr) C_a_weak_pair(a, car, cdr)
1350#endif /* HAVE_STATEMENT_EXPRESSIONS */
1351
1352#define C_a_i_flonum(ptr, c, n)         C_flonum(ptr, n)
1353#define C_a_i_ratnum(ptr, c, n, d)      C_ratnum(ptr, n, d)
1354#define C_a_i_cplxnum(ptr, c, r, i)     C_cplxnum(ptr, r, i)
1355#define C_a_i_data_mpointer(ptr, n, x)  C_mpointer(ptr, C_data_pointer(x))
1356#define C_a_i_fix_to_flo(p, n, f)       C_flonum(p, C_unfix(f))
1357#define C_cast_to_flonum(n)             ((double)(n))
1358#define C_a_i_mpointer(ptr, n, x)       C_mpointer(ptr, (x))
1359#define C_a_u_i_pointer_inc(ptr, n, p, i) C_mpointer(ptr, (C_char *)(p) + C_unfix(i))
1360#define C_pointer_eqp(x, y)             C_mk_bool(C_c_pointer_nn(x) == C_c_pointer_nn(y))
1361#define C_a_int_to_num(ptr, n, i)       C_int_to_num(ptr, i)
1362#define C_a_unsigned_int_to_num(ptr, n, i)  C_unsigned_int_to_num(ptr, i)
1363#define C_a_i_vector                    C_vector
1364#define C_list                          C_a_i_list
1365#define C_i_setslot(x, i, y)            (C_mutate(&C_block_item(x, C_unfix(i)), y), C_SCHEME_UNDEFINED)
1366#define C_i_set_i_slot(x, i, y)         (C_set_block_item(x, C_unfix(i), y), C_SCHEME_UNDEFINED)
1367#define C_u_i_set_car(p, x)             (C_mutate(&C_u_i_car(p), x), C_SCHEME_UNDEFINED)
1368#define C_u_i_set_cdr(p, x)             (C_mutate(&C_u_i_cdr(p), x), C_SCHEME_UNDEFINED)
1369#define C_a_i_putprop(p, c, x, y, z)    C_putprop(p, x, y, z)
1370
1371#define C_i_not(x)                      (C_truep(x) ? C_SCHEME_FALSE : C_SCHEME_TRUE)
1372#define C_i_equalp(x, y)                C_mk_bool(C_equalp((x), (y)))
1373#define C_i_fixnumevenp(x)              C_mk_nbool((x) & 0x00000002)
1374#define C_i_fixnumoddp(x)               C_mk_bool((x) & 0x00000002)
1375#define C_i_fixnum_negativep(x)         C_mk_bool((x) & C_INT_SIGN_BIT)
1376#define C_i_fixnum_positivep(x)         C_mk_bool(!((x) & C_INT_SIGN_BIT) && (x) != C_fix(0))
1377#define C_i_nullp(x)                    C_mk_bool((x) == C_SCHEME_END_OF_LIST)
1378#define C_i_structurep(x, s)            C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_STRUCTURE_TYPE && C_block_item(x, 0) == (s))
1379
1380#define C_u_i_char_alphabeticp(x)       C_mk_bool(C_utf_isalpha(C_character_code(x)))
1381#define C_u_i_char_numericp(x)          C_mk_bool(C_utf_isdigit(C_character_code(x)))
1382#define C_u_i_char_whitespacep(x)       C_mk_bool(C_utf_isspace(C_character_code(x)))
1383#define C_u_i_char_upper_casep(x)       C_mk_bool(C_utf_isupper(C_character_code(x)))
1384#define C_u_i_char_lower_casep(x)       C_mk_bool(C_utf_islower(C_character_code(x)))
1385#define C_u_i_digit_value(x)			C_fix(C_utf_isdigit(C_character_code(x)))
1386
1387#define C_u_i_char_upcase(x)            C_make_character(C_utf_char_upcase(C_character_code(x)))
1388#define C_u_i_char_downcase(x)          C_make_character(C_utf_char_downcase(C_character_code(x)))
1389#define C_utf_length(bv)                C_fix(C_utf_count((C_char *)C_data_pointer(bv), C_header_size(bv) - 1))
1390#define C_utf_range_length(bv, from, to)    C_fix(C_utf_count((C_char *)C_data_pointer(bv) + C_unfix(from), C_unfix(to) - C_unfix(from)))
1391
1392#define C_i_list_ref(lst, i)            C_i_car(C_i_list_tail(lst, i))
1393#define C_u_i_list_ref(lst, i)          C_u_i_car(C_i_list_tail(lst, i))
1394
1395#define C_u_i_car(x)                    (*C_CHECKp(x,C_pairp(C_VAL1(x)),&C_block_item(C_VAL1(x), 0)))
1396#define C_u_i_cdr(x)                    (*C_CHECKp(x,C_pairp(C_VAL1(x)),&C_block_item(C_VAL1(x), 1)))
1397#define C_u_i_caar(x)                   C_u_i_car( C_u_i_car( x ) )
1398#define C_u_i_cadr(x)                   C_u_i_car( C_u_i_cdr( x ) )
1399#define C_u_i_cdar(x)                   C_u_i_cdr( C_u_i_car( x ) )
1400#define C_u_i_cddr(x)                   C_u_i_cdr( C_u_i_cdr( x ) )
1401#define C_u_i_caaar(x)                  C_u_i_car( C_u_i_caar( x ) )
1402#define C_u_i_caadr(x)                  C_u_i_car( C_u_i_cadr( x ) )
1403#define C_u_i_cadar(x)                  C_u_i_car( C_u_i_cdar( x ) )
1404#define C_u_i_caddr(x)                  C_u_i_car( C_u_i_cddr( x ) )
1405#define C_u_i_cdaar(x)                  C_u_i_cdr( C_u_i_caar( x ) )
1406#define C_u_i_cdadr(x)                  C_u_i_cdr( C_u_i_cadr( x ) )
1407#define C_u_i_cddar(x)                  C_u_i_cdr( C_u_i_cdar( x ) )
1408#define C_u_i_cdddr(x)                  C_u_i_cdr( C_u_i_cddr( x ) )
1409#define C_u_i_caaaar(x)                 C_u_i_car( C_u_i_caaar( x ) )
1410#define C_u_i_caaadr(x)                 C_u_i_car( C_u_i_caadr( x ) )
1411#define C_u_i_caadar(x)                 C_u_i_car( C_u_i_cadar( x ) )
1412#define C_u_i_caaddr(x)                 C_u_i_car( C_u_i_caddr( x ) )
1413#define C_u_i_cadaar(x)                 C_u_i_car( C_u_i_cdaar( x ) )
1414#define C_u_i_cadadr(x)                 C_u_i_car( C_u_i_cdadr( x ) )
1415#define C_u_i_caddar(x)                 C_u_i_car( C_u_i_cddar( x ) )
1416#define C_u_i_cadddr(x)                 C_u_i_car( C_u_i_cdddr( x ) )
1417#define C_u_i_cdaaar(x)                 C_u_i_cdr( C_u_i_caaar( x ) )
1418#define C_u_i_cdaadr(x)                 C_u_i_cdr( C_u_i_caadr( x ) )
1419#define C_u_i_cdadar(x)                 C_u_i_cdr( C_u_i_cadar( x ) )
1420#define C_u_i_cdaddr(x)                 C_u_i_cdr( C_u_i_caddr( x ) )
1421#define C_u_i_cddaar(x)                 C_u_i_cdr( C_u_i_cdaar( x ) )
1422#define C_u_i_cddadr(x)                 C_u_i_cdr( C_u_i_cdadr( x ) )
1423#define C_u_i_cdddar(x)                 C_u_i_cdr( C_u_i_cddar( x ) )
1424#define C_u_i_cddddr(x)                 C_u_i_cdr( C_u_i_cdddr( x ) )
1425
1426#ifdef HAVE_STATEMENT_EXPRESSIONS
1427# define C_i_not_pair_p(x)              ({C_word tmp = (x); C_mk_bool(C_immediatep(tmp) || C_header_type(tmp) != C_PAIR_TYPE);})
1428#else
1429# define C_i_not_pair_p                 C_i_not_pair_p_2
1430#endif
1431
1432#define C_i_check_closure(x)            C_i_check_closure_2(x, C_SCHEME_FALSE)
1433#define C_i_check_exact(x)              C_i_check_exact_2(x, C_SCHEME_FALSE) /* DEPRECATED */
1434#define C_i_check_fixnum(x)             C_i_check_fixnum_2(x, C_SCHEME_FALSE)
1435#define C_i_check_inexact(x)            C_i_check_inexact_2(x, C_SCHEME_FALSE)
1436#define C_i_check_number(x)             C_i_check_number_2(x, C_SCHEME_FALSE)
1437#define C_i_check_string(x)             C_i_check_string_2(x, C_SCHEME_FALSE)
1438#define C_i_check_bytevector(x)         C_i_check_bytevector_2(x, C_SCHEME_FALSE)
1439#define C_i_check_keyword(x)            C_i_check_keyword_2(x, C_SCHEME_FALSE)
1440#define C_i_check_symbol(x)             C_i_check_symbol_2(x, C_SCHEME_FALSE)
1441#define C_i_check_list(x)               C_i_check_list_2(x, C_SCHEME_FALSE)
1442#define C_i_check_pair(x)               C_i_check_pair_2(x, C_SCHEME_FALSE)
1443#define C_i_check_locative(x)           C_i_check_locative_2(x, C_SCHEME_FALSE)
1444#define C_i_check_boolean(x)            C_i_check_boolean_2(x, C_SCHEME_FALSE)
1445#define C_i_check_vector(x)             C_i_check_vector_2(x, C_SCHEME_FALSE)
1446#define C_i_check_structure(x, st)      C_i_check_structure_2(x, (st), C_SCHEME_FALSE)
1447#define C_i_check_char(x)               C_i_check_char_2(x, C_SCHEME_FALSE)
1448#define C_i_check_port(x, in, op)       C_i_check_port_2(x, in, op, C_SCHEME_FALSE)
1449#define C_i_check_range(i, f, t)     C_i_check_range_2(i, f, t, C_SCHEME_FALSE)
1450#define C_i_check_range_including(i, f, t)  C_i_check_range_including_2(i, f, t, C_SCHEME_FALSE)
1451
1452#define C_u_i_string_length(x)          C_block_item((x), 1)
1453#define C_u_i_bytevector_length(x)      C_block_size(x)
1454
1455#define C_u_i_8vector_length            C_u_i_bytevector_length
1456#define C_u_i_16vector_length(x)        C_fix(C_header_size(C_block_item(x, 1)) >> 1)
1457#define C_u_i_32vector_length(x)        C_fix(C_header_size(C_block_item(x, 1)) >> 2)
1458#define C_u_i_64vector_length(x)        C_fix(C_header_size(C_block_item(x, 1)) >> 3)
1459#define C_u_i_u8vector_length           C_u_i_8vector_length
1460#define C_u_i_s8vector_length(x)        C_fix(C_header_size(C_block_item(x, 1)))
1461#define C_u_i_u16vector_length          C_u_i_16vector_length
1462#define C_u_i_s16vector_length          C_u_i_16vector_length
1463#define C_u_i_u32vector_length          C_u_i_32vector_length
1464#define C_u_i_s32vector_length          C_u_i_32vector_length
1465#define C_u_i_u64vector_length          C_u_i_64vector_length
1466#define C_u_i_s64vector_length          C_u_i_64vector_length
1467#define C_u_i_f32vector_length          C_u_i_32vector_length
1468#define C_u_i_f64vector_length          C_u_i_64vector_length
1469
1470#define C_u_i_bytevector_ref(x, i)      C_fix(((unsigned char *)C_data_pointer(x))[ C_unfix(i) ])
1471#define C_u_i_u8vector_ref              C_u_i_bytevector_ref
1472#define C_u_i_s8vector_ref(x, i)        C_fix(((signed char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
1473#define C_u_i_u16vector_ref(x, i)       C_fix(((unsigned short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
1474#define C_u_i_s16vector_ref(x, i)       C_fix(((short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
1475
1476/* these assume fixnum mode */
1477#define C_u_i_u32vector_ref(x, i)       C_fix(((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
1478#define C_u_i_s32vector_ref(x, i)       C_fix(((C_s32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
1479
1480#define C_a_u_i_u32vector_ref(ptr, c, x, i)  C_unsigned_int_to_num(ptr, ((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
1481#define C_a_u_i_s32vector_ref(ptr, c, x, i)  C_int_to_num(ptr, ((C_s32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
1482
1483#define C_a_u_i_u64vector_ref(ptr, c, x, i)  C_uint64_to_num(ptr, ((C_u64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
1484#define C_a_u_i_s64vector_ref(ptr, c, x, i)  C_int64_to_num(ptr, ((C_s64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])
1485
1486#define C_u_i_bytevector_set(x, i, v)   ((((unsigned char *)C_data_pointer(x))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
1487#define C_u_i_u8vector_set              C_u_i_bytevector_set
1488#define C_i_u8vector_set                C_i_bytevector_set
1489#define C_u_i_s8vector_set(x, i, v)     ((((signed char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
1490#define C_u_i_u16vector_set(x, i, v)    ((((unsigned short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
1491#define C_u_i_s16vector_set(x, i, v)    ((((short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)
1492#define C_u_i_u32vector_set(x, i, v)    ((((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_unsigned_int(v)), C_SCHEME_UNDEFINED)
1493#define C_u_i_s32vector_set(x, i, v)    ((((C_s32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_int(v)), C_SCHEME_UNDEFINED)
1494#define C_u_i_u64vector_set(x, i, v)    ((((C_u64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_uint64(v)), C_SCHEME_UNDEFINED)
1495#define C_u_i_s64vector_set(x, i, v)    ((((C_s64 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_num_to_int64(v)), C_SCHEME_UNDEFINED)
1496
1497/* DEPRECATED */
1498#define C_u_i_bit_to_bool(x, i)         C_mk_bool((C_unfix(x) & (1 << C_unfix(i))) != 0)
1499
1500#define C_u_i_pointer_u8_ref(ptr)         C_fix(*((unsigned char *)C_block_item(ptr, 0)))
1501#define C_u_i_pointer_s8_ref(ptr)         C_fix(*((signed char *)C_block_item(ptr, 0)))
1502#define C_u_i_pointer_u16_ref(ptr)        C_fix(*((unsigned short *)C_block_item(ptr, 0)))
1503#define C_u_i_pointer_s16_ref(ptr)        C_fix(*((short *)C_block_item(ptr, 0)))
1504#define C_a_u_i_pointer_u32_ref(ap, n, ptr)  \
1505  C_unsigned_int_to_num(ap, *((C_u32 *)C_block_item(ptr, 0)))
1506#define C_a_u_i_pointer_s32_ref(ap, n, ptr)  \
1507  C_int_to_num(ap, *((C_s32 *)C_block_item(ptr, 0)))
1508#define C_a_u_i_pointer_u64_ref(ap, n, ptr)  \
1509  C_uint64_to_num(ap, *((C_u64 *)C_block_item(ptr, 0)))
1510#define C_a_u_i_pointer_s64_ref(ap, n, ptr)  \
1511  C_int64_to_num(ap, *((C_s64 *)C_block_item(ptr, 0)))
1512#define C_a_u_i_pointer_f32_ref(ap, n, ptr)  C_flonum(ap, *((float *)C_block_item(ptr, 0)))
1513#define C_a_u_i_pointer_f64_ref(ap, n, ptr)  C_flonum(ap, *((double *)C_block_item(ptr, 0)))
1514#define C_u_i_pointer_u8_set(ptr, x)  \
1515  (*((unsigned char *)C_block_item(ptr, 0)) = C_unfix(x), C_SCHEME_UNDEFINED)
1516#define C_u_i_pointer_s8_set(ptr, x)  \
1517  (*((signed char *)C_block_item(ptr, 0)) = C_unfix(x), C_SCHEME_UNDEFINED)
1518#define C_u_i_pointer_u16_set(ptr, x)  \
1519  (*((unsigned short *)C_block_item(ptr, 0)) = C_unfix(x), C_SCHEME_UNDEFINED)
1520#define C_u_i_pointer_s16_set(ptr, x)  \
1521  (*((short *)C_block_item(ptr, 0)) = C_unfix(x), C_SCHEME_UNDEFINED)
1522#define C_u_i_pointer_u32_set(ptr, x)  \
1523  (*((C_u32 *)C_block_item(ptr, 0)) = C_num_to_unsigned_int(x), C_SCHEME_UNDEFINED)
1524#define C_u_i_pointer_s32_set(ptr, x)  \
1525  (*((C_s32 *)C_block_item(ptr, 0)) = C_num_to_int(x), C_SCHEME_UNDEFINED)
1526#define C_u_i_pointer_u64_set(ptr, x)  \
1527  (*((C_u64 *)C_block_item(ptr, 0)) = C_num_to_uint64(x), C_SCHEME_UNDEFINED)
1528#define C_u_i_pointer_s64_set(ptr, x)  \
1529  (*((C_s64 *)C_block_item(ptr, 0)) = C_num_to_int64(x), C_SCHEME_UNDEFINED)
1530#define C_u_i_pointer_f32_set(ptr, x)  \
1531  (*((float *)C_block_item(ptr, 0)) = C_flonum_magnitude(x), C_SCHEME_UNDEFINED)
1532#define C_u_i_pointer_f64_set(ptr, x)  \
1533  (*((double *)C_block_item(ptr, 0)) = C_flonum_magnitude(x), C_SCHEME_UNDEFINED)
1534
1535#ifdef C_BIG_ENDIAN
1536# ifdef C_SIXTY_FOUR
1537#  define C_lihdr(x, y, z)              ((C_LAMBDA_INFO_TYPE >> 56) & 0xff), \
1538                                        0, 0, 0, 0, (x), (y), ((C_char)(z))
1539# else
1540#  define C_lihdr(x, y, z)              ((C_LAMBDA_INFO_TYPE >> 24) & 0xff), \
1541                                        (x), (y), ((C_char)(z))
1542# endif
1543#else
1544# ifdef C_SIXTY_FOUR
1545#  define C_lihdr(x, y, z)              ((C_char)(z)), (y), (x), 0, 0, 0, 0, \
1546                                        ((C_LAMBDA_INFO_TYPE >> 56) & 0xff)
1547# else
1548#  define C_lihdr(x, y, z)              ((C_char)(z)), (y), (x), \
1549                                        ((C_LAMBDA_INFO_TYPE >> 24) & 0xff)
1550# endif
1551#endif
1552
1553#define C_ub_i_flonum_plus(x, y)        ((x) + (y))
1554#define C_ub_i_flonum_difference(x, y)  ((x) - (y))
1555#define C_ub_i_flonum_times(x, y)       ((x) * (y))
1556#define C_ub_i_flonum_quotient(x, y)    ((x) / (y))
1557#define C_ub_i_flonum_multiply_add(x, y, z)    C_fma((x), (y), (z))
1558
1559#define C_ub_i_flonum_equalp(n1, n2)    C_mk_bool((n1) == (n2))
1560#define C_ub_i_flonum_greaterp(n1, n2)  C_mk_bool((n1) > (n2))
1561#define C_ub_i_flonum_lessp(n1, n2)     C_mk_bool((n1) < (n2))
1562#define C_ub_i_flonum_greater_or_equal_p(n1, n2)  C_mk_bool((n1) >= (n2))
1563#define C_ub_i_flonum_less_or_equal_p(n1, n2)  C_mk_bool((n1) <= (n2))
1564
1565#define C_ub_i_flonum_nanp(x)            C_mk_bool(C_isnan(x))
1566#define C_ub_i_flonum_infinitep(x)       C_mk_bool(C_isinf(x))
1567#define C_ub_i_flonum_finitep(x)         C_mk_bool(C_isfinite(x))
1568
1569#define C_ub_i_pointer_inc(p, n)        ((void *)((unsigned char *)(p) + (n)))
1570#define C_ub_i_pointer_eqp(p1, p2)      C_mk_bool((p1) == (p2))
1571#define C_ub_i_null_pointerp(p)         C_mk_bool((p) == NULL)
1572
1573#define C_ub_i_pointer_u8_ref(p)        (*((unsigned char *)(p)))
1574#define C_ub_i_pointer_s8_ref(p)        (*((signed char *)(p)))
1575#define C_ub_i_pointer_u16_ref(p)       (*((unsigned short *)(p)))
1576#define C_ub_i_pointer_s16_ref(p)       (*((short *)(p)))
1577#define C_ub_i_pointer_u32_ref(p)       (*((C_u32 *)(p)))
1578#define C_ub_i_pointer_s32_ref(p)       (*((C_s32 *)(p)))
1579#define C_ub_i_pointer_u64_ref(p)       (*((C_u64 *)(p)))
1580#define C_ub_i_pointer_s64_ref(p)       (*((C_s64 *)(p)))
1581#define C_ub_i_pointer_f32_ref(p)       (*((float *)(p)))
1582#define C_ub_i_pointer_f64_ref(p)       (*((double *)(p)))
1583#define C_ub_i_pointer_u8_set(p, n)     (*((unsigned char *)(p)) = (n))
1584#define C_ub_i_pointer_s8_set(p, n)     (*((signed char *)(p)) = (n))
1585#define C_ub_i_pointer_u16_set(p, n)    (*((unsigned short *)(p)) = (n))
1586#define C_ub_i_pointer_s16_set(p, n)    (*((short *)(p)) = (n))
1587#define C_ub_i_pointer_u32_set(p, n)    (*((C_u32 *)(p)) = (n))
1588#define C_ub_i_pointer_s32_set(p, n)    (*((C_s32 *)(p)) = (n))
1589#define C_ub_i_pointer_u64_set(p, n)    (*((C_u64 *)(p)) = (n))
1590#define C_ub_i_pointer_s64_set(p, n)    (*((C_s64 *)(p)) = (n))
1591#define C_ub_i_pointer_f32_set(p, n)    (*((float *)(p)) = (n))
1592#define C_ub_i_pointer_f64_set(p, n)    (*((double *)(p)) = (n))
1593
1594#ifdef C_PRIVATE_REPOSITORY
1595# define C_private_repository()         C_use_private_repository(C_executable_dirname())
1596#else
1597# define C_private_repository()
1598#endif
1599
1600#ifdef C_GUI
1601# define C_set_gui_mode                 C_gui_mode = 1
1602#else
1603# define C_set_gui_mode
1604#endif
1605
1606/**
1607 * SEARCH_EXE_PATH is defined on platforms on which we must search for
1608 * the current executable. Because this search is sensitive to things
1609 * like CWD, PATH, and so on, it's done once at startup and saved in
1610 * `C_main_exe`.
1611 *
1612 * On platforms where it's not defined, there's a simple way to
1613 * retrieve a path to the current executable (such as reading
1614 * "/proc/<pid>/exe" or some similar trick).
1615 */
1616#ifdef SEARCH_EXE_PATH
1617# define C_set_main_exe(fname)          C_main_exe = C_resolve_executable_pathname(fname)
1618#else
1619# define C_set_main_exe(fname)
1620#endif
1621
1622#if !defined(C_EMBEDDED) && !defined(C_SHARED)
1623# if defined(C_GUI) && defined(_WIN32)
1624#  define C_main_entry_point            \
1625  int WINAPI WinMain(HINSTANCE me, HINSTANCE you, LPSTR cmdline, int show) \
1626  { \
1627    C_gui_mode = 1; \
1628    C_set_main_exe(argv[0]);				\
1629    C_private_repository();				\
1630    return CHICKEN_main(0, NULL, (void *)C_toplevel); \
1631  }
1632# else
1633#  define C_main_entry_point            \
1634  int main(int argc, char *argv[]) \
1635 { \
1636    C_set_gui_mode; \
1637    C_set_main_exe(argv[0]);				\
1638    C_private_repository();				\
1639    return CHICKEN_main(argc, argv, (void*)C_toplevel); \
1640  }
1641# endif
1642#else
1643# define C_main_entry_point
1644#endif
1645
1646#define C_alloc_flonum                  C_word *___tmpflonum = C_alloc(WORDS_PER_FLONUM)
1647#define C_kontinue_flonum(k, n)         C_kontinue((k), C_flonum(&___tmpflonum, (n)))
1648
1649#define C_a_i_flonum_truncate(ptr, n, x)  C_flonum(ptr, C_trunc(C_flonum_magnitude(x)))
1650#define C_a_i_flonum_ceiling(ptr, n, x)  C_flonum(ptr, C_ceil(C_flonum_magnitude(x)))
1651#define C_a_i_flonum_floor(ptr, n, x)   C_flonum(ptr, C_floor(C_flonum_magnitude(x)))
1652#define C_a_i_flonum_round(ptr, n, x)   C_flonum(ptr, C_round(C_flonum_magnitude(x)))
1653
1654#define C_a_u_i_f32vector_ref(ptr, n, b, i)  C_flonum(ptr, ((float *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
1655#define C_a_u_i_f64vector_ref(ptr, n, b, i)  C_flonum(ptr, ((double *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
1656#define C_u_i_f32vector_set(v, i, x)    ((((float *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = C_flonum_magnitude(x)), C_SCHEME_UNDEFINED)
1657#define C_u_i_f64vector_set(v, i, x)    ((((double *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = C_flonum_magnitude(x)), C_SCHEME_UNDEFINED)
1658
1659#define C_ub_i_f32vector_ref(b, i)      (((float *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
1660#define C_ub_i_f64vector_ref(b, i)      (((double *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])
1661#define C_ub_i_f32vector_set(v, i, x)   ((((float *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = (x)), 0)
1662#define C_ub_i_f64vector_set(v, i, x)   ((((double *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = (x)), 0)
1663
1664#define C_a_i_flonum_sin(ptr, c, x)     C_flonum(ptr, C_sin(C_flonum_magnitude(x)))
1665#define C_a_i_flonum_cos(ptr, c, x)     C_flonum(ptr, C_cos(C_flonum_magnitude(x)))
1666#define C_a_i_flonum_tan(ptr, c, x)     C_flonum(ptr, C_tan(C_flonum_magnitude(x)))
1667#define C_a_i_flonum_asin(ptr, c, x)    C_flonum(ptr, C_asin(C_flonum_magnitude(x)))
1668#define C_a_i_flonum_acos(ptr, c, x)    C_flonum(ptr, C_acos(C_flonum_magnitude(x)))
1669#define C_a_i_flonum_atan(ptr, c, x)    C_flonum(ptr, C_atan(C_flonum_magnitude(x)))
1670#define C_a_i_flonum_atan2(ptr, c, x, y)  C_flonum(ptr, C_atan2(C_flonum_magnitude(x), C_flonum_magnitude(y)))
1671#define C_a_i_flonum_sinh(ptr, c, x)     C_flonum(ptr, C_sinh(C_flonum_magnitude(x)))
1672#define C_a_i_flonum_cosh(ptr, c, x)     C_flonum(ptr, C_cosh(C_flonum_magnitude(x)))
1673#define C_a_i_flonum_tanh(ptr, c, x)     C_flonum(ptr, C_tanh(C_flonum_magnitude(x)))
1674#define C_a_i_flonum_asinh(ptr, c, x)    C_flonum(ptr, C_asinh(C_flonum_magnitude(x)))
1675#define C_a_i_flonum_acosh(ptr, c, x)    C_flonum(ptr, C_acosh(C_flonum_magnitude(x)))
1676#define C_a_i_flonum_atanh(ptr, c, x)    C_flonum(ptr, C_atanh(C_flonum_magnitude(x)))
1677#define C_a_i_flonum_exp(ptr, c, x)     C_flonum(ptr, C_exp(C_flonum_magnitude(x)))
1678#define C_a_i_flonum_expt(ptr, c, x, y)  C_flonum(ptr, C_pow(C_flonum_magnitude(x), C_flonum_magnitude(y)))
1679#define C_a_i_flonum_log(ptr, c, x)     C_flonum(ptr, C_log(C_flonum_magnitude(x)))
1680#define C_a_i_flonum_sqrt(ptr, c, x)    C_flonum(ptr, C_sqrt(C_flonum_magnitude(x)))
1681#define C_a_i_flonum_abs(ptr, c, x)     C_flonum(ptr, C_fabs(C_flonum_magnitude(x)))
1682#define C_u_i_flonum_nanp(x)            C_mk_bool(C_isnan(C_flonum_magnitude(x)))
1683#define C_u_i_flonum_infinitep(x)       C_mk_bool(C_isinf(C_flonum_magnitude(x)))
1684#define C_u_i_flonum_finitep(x)         C_mk_bool(C_isfinite(C_flonum_magnitude(x)))
1685
1686#define C_a_i_current_process_milliseconds(ptr, c, dummy) C_uint64_to_num(ptr, C_current_process_milliseconds())
1687
1688#define C_i_noop1(dummy)               ((dummy), C_SCHEME_UNDEFINED)
1689#define C_i_noop2(dummy1, dummy2)      ((dummy1), (dummy2), C_SCHEME_UNDEFINED)
1690#define C_i_noop3(dummy1, dummy2, dummy3)  ((dummy1), (dummy2), (dummy3), C_SCHEME_UNDEFINED)
1691#define C_i_true1(dummy)               ((dummy), C_SCHEME_TRUE)
1692#define C_i_true2(dummy1, dummy2)      ((dummy1), (dummy2), C_SCHEME_TRUE)
1693#define C_i_true3(dummy1, dummy2, dummy3)  ((dummy1), (dummy2), (dummy3), C_SCHEME_TRUE)
1694
1695/* struct/union wrapping */
1696#define C_a_extract_struct(a, t, x)    ({t _r = (x); C_a_extract_struct_2(a, sizeof(t), &_r);})
1697#define C_build_struct(t, x)           ({t _a;_a = *((t *)C_data_pointer(x));_a;})
1698
1699/* debug client interface */
1700
1701typedef struct C_DEBUG_INFO {
1702  int event;
1703  int enabled;
1704  C_char *loc;
1705  C_char *val;
1706} C_DEBUG_INFO;
1707
1708#define C_DEBUG_CALL                1
1709#define C_DEBUG_GLOBAL_ASSIGN       2
1710#define C_DEBUG_GC                  3
1711#define C_DEBUG_ENTRY               4
1712#define C_DEBUG_SIGNAL              5
1713#define C_DEBUG_CONNECT             6
1714#define C_DEBUG_LISTEN              7
1715#define C_DEBUG_INTERRUPTED         8
1716
1717#define C_debugger(cell, c, av)     (C_debugger_hook != NULL ? C_debugger_hook(cell, c, av, C_text(__FILE__ ":" C__STR2(__LINE__))) : C_SCHEME_UNDEFINED)
1718
1719/* Variables: */
1720
1721C_varextern time_t C_startup_time_seconds;
1722C_varextern C_word
1723  *C_temporary_stack,
1724  *C_temporary_stack_bottom,
1725  *C_temporary_stack_limit,
1726  *C_stack_limit,
1727  *C_stack_hard_limit,
1728  *C_scratchspace_start,
1729  *C_scratchspace_top,
1730  *C_scratchspace_limit,
1731   C_scratch_usage;
1732C_varextern C_long
1733  C_timer_interrupt_counter,
1734  C_initial_timer_interrupt_period;
1735C_varextern C_byte
1736  *C_fromspace_top,
1737  *C_fromspace_limit;
1738#ifdef HAVE_SIGSETJMP
1739C_varextern sigjmp_buf C_restart;
1740#else
1741C_varextern jmp_buf C_restart;
1742#endif
1743C_varextern void *C_restart_address;
1744C_varextern int C_entry_point_status;
1745C_varextern int C_gui_mode;
1746
1747C_varextern void *C_restart_trampoline;
1748C_varextern void (*C_pre_gc_hook)(int mode);
1749C_varextern void (*C_post_gc_hook)(int mode, C_long ms);
1750C_varextern void (*C_panic_hook)(C_char *msg);
1751C_varextern C_word (*C_debugger_hook)(C_DEBUG_INFO *cell, C_word c, C_word *av, char *cloc);
1752
1753C_varextern int
1754  C_abort_on_thread_exceptions,
1755  C_interrupts_enabled,
1756  C_disable_overflow_check,
1757  C_heap_size_is_fixed,
1758  C_max_pending_finalizers,
1759  C_trace_buffer_size,
1760  C_debugging,
1761  C_main_argc;
1762C_varextern C_uword
1763  C_heap_growth,
1764  C_heap_shrinkage;
1765C_varextern C_char
1766  **C_main_argv,
1767#ifdef SEARCH_EXE_PATH
1768  *C_main_exe,
1769#endif
1770  *C_dlerror;
1771C_varextern C_uword C_maximal_heap_size;
1772C_varextern int (*C_gc_mutation_hook)(C_word *slot, C_word val);
1773C_varextern void (*C_gc_trace_hook)(C_word *var, int mode);
1774C_varextern C_word (*C_get_unbound_variable_value_hook)(C_word sym);
1775
1776
1777/* Prototypes: */
1778
1779C_BEGIN_C_DECLS
1780
1781C_fctexport void C_register_debug_info(C_DEBUG_INFO *);
1782C_fctexport int CHICKEN_main(int argc, C_char *argv[], void *toplevel);
1783C_fctexport int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel);
1784C_fctexport C_word CHICKEN_run(void *toplevel);
1785C_fctexport C_word CHICKEN_continue(C_word k);
1786C_fctexport void *CHICKEN_new_gc_root();
1787C_fctexport void *CHICKEN_new_finalizable_gc_root();
1788C_fctexport void *CHICKEN_new_gc_root_2(int finalizable);
1789C_fctexport void CHICKEN_delete_gc_root(void *root);
1790C_fctexport void *CHICKEN_global_lookup(char *name);
1791C_fctexport int CHICKEN_is_running();
1792C_fctexport void CHICKEN_interrupt();
1793
1794C_fctexport void C_check_nursery_minimum(C_word size);
1795C_fctexport int C_save_callback_continuation(C_word **ptr, C_word k);
1796C_fctexport C_word C_restore_callback_continuation(void);
1797C_fctexport C_word C_restore_callback_continuation2(int level);
1798C_fctexport C_word C_callback(C_word closure, int argc);
1799C_fctexport C_word C_callback_wrapper(void *proc, int argc);
1800C_fctexport void C_callback_adjust_stack(C_word *base, int size);
1801C_fctexport void CHICKEN_parse_command_line(int argc, char *argv[], C_word *heap, C_word *stack, C_word *symbols);
1802C_fctexport void C_toplevel_entry(C_char *name) C_regparm;
1803C_fctexport C_word C_a_i_provide(C_word **a, int c, C_word id) C_regparm;
1804C_fctexport C_word C_i_providedp(C_word id) C_regparm;
1805C_fctexport C_word C_enable_interrupts(void) C_regparm;
1806C_fctexport C_word C_disable_interrupts(void) C_regparm;
1807C_fctexport void C_set_or_change_heap_size(C_word heap, int reintern);
1808C_fctexport void C_do_resize_stack(C_word stack);
1809C_fctexport C_word C_resize_pending_finalizers(C_word size);
1810C_fctexport void C_initialize_lf(C_word *lf, int count);
1811C_fctexport void *C_register_lf(C_word *lf, int count);
1812C_fctexport void *C_register_lf2(C_word *lf, int count, C_PTABLE_ENTRY *ptable);
1813C_fctexport void C_unregister_lf(void *handle);
1814C_fctexport C_char *C_dump_trace(int start);
1815C_fctexport void C_clear_trace_buffer(void) C_regparm;
1816C_fctexport C_word C_resize_trace_buffer(C_word size);
1817C_fctexport C_word C_fetch_trace(C_word start, C_word buffer);
1818C_fctexport C_word C_string(C_word **ptr, int len, C_char *str) C_regparm;
1819C_fctexport C_word C_static_string(C_word **ptr, int len, C_char *str) C_regparm;
1820C_fctexport C_word C_static_bignum(C_word **ptr, int len, C_char *str) C_regparm;
1821C_fctexport C_word C_static_bytevector(C_word **ptr, int len, C_char *str) C_regparm;
1822C_fctexport C_word C_static_lambda_info(C_word **ptr, int len, C_char *str) C_regparm;
1823C_fctexport C_word C_bytevector(C_word **ptr, int len, C_char *str) C_regparm;
1824C_fctexport C_word C_pbytevector(int len, C_char *str) C_regparm;
1825C_fctexport C_word C_string2(C_word **ptr, C_char *str) C_regparm;
1826C_fctexport C_word C_string2_safe(C_word **ptr, int max, C_char *str) C_regparm;
1827C_fctexport C_word C_intern(C_word **ptr, int len, C_char *str) C_regparm;
1828C_fctexport C_word C_intern_kw(C_word **ptr, int len, C_char *str) C_regparm;
1829C_fctexport C_word C_intern_in(C_word **ptr, int len, C_char *str, C_SYMBOL_TABLE *stable) C_regparm;
1830C_fctexport C_word C_h_intern(C_word *slot, int len, C_char *str) C_regparm;
1831C_fctexport C_word C_h_intern_kw(C_word *slot, int len, C_char *str) C_regparm;
1832C_fctexport C_word C_h_intern_in(C_word *slot, int len, C_char *str, C_SYMBOL_TABLE *stable) C_regparm;
1833C_fctexport C_word C_intern2(C_word **ptr, C_char *str) C_regparm;
1834C_fctexport C_word C_intern3(C_word **ptr, C_char *str, C_word value) C_regparm;
1835C_fctexport C_word C_build_rest(C_word **ptr, C_word c, C_word n, C_word *av) C_regparm;
1836C_fctexport void C_bad_memory(void) C_noret;
1837C_fctexport void C_bad_memory_2(void) C_noret;
1838C_fctexport void C_bad_argc(int c, int n) C_noret;
1839C_fctexport void C_bad_min_argc(int c, int n) C_noret;
1840C_fctexport void C_bad_argc_2(int c, int n, C_word closure) C_noret;
1841C_fctexport void C_bad_min_argc_2(int c, int n, C_word closure) C_noret;
1842C_fctexport void C_stack_overflow(C_char *loc) C_noret;
1843C_fctexport void C_unbound_error(C_word sym) C_noret;
1844C_fctexport void C_no_closure_error(C_word x) C_noret;
1845C_fctexport void C_div_by_zero_error(C_char *loc) C_noret;
1846C_fctexport void C_unimplemented(C_char *msg) C_noret;
1847C_fctexport void C_not_an_integer_error(C_char *loc, C_word x) C_noret;
1848C_fctexport void C_not_an_uinteger_error(C_char *loc, C_word x) C_noret;
1849C_fctexport void C_rest_arg_out_of_bounds_error(C_word c, C_word n, C_word ka) C_noret;
1850C_fctexport void C_rest_arg_out_of_bounds_error_2(C_word c, C_word n, C_word ka, C_word closure) C_noret;
1851C_fctexport C_word C_closure(C_word **ptr, int cells, C_word proc, ...);
1852C_fctexport C_word C_pair(C_word **ptr, C_word car, C_word cdr) C_regparm;
1853C_fctexport C_word C_number(C_word **ptr, double n) C_regparm;
1854C_fctexport C_word C_mpointer(C_word **ptr, void *mp) C_regparm;
1855C_fctexport C_word C_mpointer_or_false(C_word **ptr, void *mp) C_regparm;
1856C_fctexport C_word C_taggedmpointer(C_word **ptr, C_word tag, void *mp) C_regparm;
1857C_fctexport C_word C_taggedmpointer_or_false(C_word **ptr, C_word tag, void *mp) C_regparm;
1858C_fctexport C_word C_vector(C_word **ptr, int n, ...);
1859C_fctexport C_word C_structure(C_word **ptr, int n, ...);
1860C_fctexport C_word C_mutate_slot(C_word *slot, C_word val) C_regparm;
1861C_fctexport C_word C_mutate_scratch_slot(C_word *slot, C_word val) C_regparm;
1862C_fctexport C_word C_scratch_alloc(C_uword size) C_regparm;
1863C_fctexport C_word C_migrate_buffer_object(C_word **ptr, C_word *start, C_word *end, C_word obj) C_regparm;
1864C_fctexport void C_reclaim(void *trampoline, C_word c) C_regparm C_noret;
1865C_fctexport void C_save_and_reclaim(void *trampoline, int n, C_word *av) C_noret;
1866C_fctexport void C_save_and_reclaim_args(void *trampoline, int n, ...) C_noret;
1867C_fctexport void C_rereclaim2(C_uword size, int relative_resize) C_regparm;
1868C_fctexport void C_unbound_variable(C_word sym);
1869C_fctexport void C_decoding_error(C_word str, C_word index);
1870C_fctexport C_word C_retrieve2(C_word val, char *name) C_regparm;
1871C_fctexport void *C_retrieve2_symbol_proc(C_word val, char *name) C_regparm;
1872C_fctexport int C_in_stackp(C_word x) C_regparm;
1873C_fctexport int C_in_heapp(C_word x) C_regparm;
1874C_fctexport int C_in_fromspacep(C_word x) C_regparm;
1875C_fctexport int C_in_scratchspacep(C_word x) C_regparm;
1876C_fctexport void C_trace(C_char *name) C_regparm;
1877C_fctexport C_word C_emit_trace_info2(char *raw, C_word l, C_word x, C_word y, C_word t) C_regparm;
1878C_fctexport C_word C_u_i_bytevector_hash(C_word str, C_word start, C_word end, C_word rnd) C_regparm;
1879C_fctexport C_word C_halt(C_word msg);
1880C_fctexport C_word C_message(C_word msg);
1881C_fctexport C_word C_equalp(C_word x, C_word y) C_regparm;
1882C_fctexport C_word C_set_gc_report(C_word flag) C_regparm;
1883C_fctexport C_word C_start_timer(void) C_regparm;
1884C_fctexport C_word C_exit_runtime(C_word code) C_noret;
1885C_fctexport C_word C_set_print_precision(C_word n) C_regparm;
1886C_fctexport C_word C_get_print_precision(void) C_regparm;
1887C_fctexport C_word C_read_char(C_word port) C_regparm;
1888C_fctexport C_word C_execute_shell_command(C_word string) C_regparm;
1889C_fctexport int C_check_fd_ready(int fd) C_regparm;
1890C_fctexport C_word C_char_ready_p(C_word port) C_regparm;
1891C_fctexport void C_raise_interrupt(int reason) C_regparm;
1892C_fctexport C_word C_establish_signal_handler(C_word signum, C_word reason) C_regparm;
1893C_fctexport C_word C_copy_block(C_word from, C_word to) C_regparm;
1894C_fctexport C_word C_evict_block(C_word from, C_word ptr) C_regparm;
1895C_fctexport void C_gc_protect(C_word **addr, int n) C_regparm;
1896C_fctexport void C_gc_unprotect(int n) C_regparm;
1897C_fctexport C_SYMBOL_TABLE *C_new_symbol_table(char *name, unsigned int size) C_regparm;
1898C_fctexport C_SYMBOL_TABLE *C_find_symbol_table(char *name) C_regparm;
1899C_fctexport C_word C_find_symbol(C_word str, C_SYMBOL_TABLE *stable) C_regparm;
1900C_fctexport C_word C_find_keyword(C_word str, C_SYMBOL_TABLE *stable) C_regparm;
1901C_fctexport C_word C_lookup_symbol(C_word sym) C_regparm;
1902C_fctexport void C_do_register_finalizer(C_word x, C_word proc);
1903C_fctexport int C_do_unregister_finalizer(C_word x);
1904C_fctexport C_word C_dbg_hook(C_word x);
1905C_fctexport void C_use_private_repository(C_char *path);
1906C_fctexport C_char *C_private_repository_path();
1907C_fctexport C_char *C_executable_dirname();
1908C_fctexport C_char *C_executable_pathname();
1909C_fctexport C_char *C_resolve_executable_pathname(C_char *fname);
1910C_fctexport C_char *C_getenv(C_word var);
1911C_fctexport C_char *C_getenventry(int i);
1912
1913/* utf.c: */
1914C_fctexport C_word C_utf_subchar(C_word s, C_word i) C_regparm;
1915C_fctexport C_word C_utf_setsubchar(C_word s, C_word i, C_word c) C_regparm;
1916C_fctexport C_word C_utf_compare(C_word s1, C_word s2, C_word start1, C_word start2, C_word len) C_regparm;
1917C_fctexport C_word C_utf_compare_ci(C_word s1, C_word s2, C_word start1, C_word start2, C_word len) C_regparm;
1918C_fctexport C_word C_utf_equal(C_word s1, C_word s2) C_regparm;
1919C_fctexport C_word C_utf_equal_ci(C_word s1, C_word s2) C_regparm;
1920C_fctexport C_word C_utf_copy(C_word from, C_word to, C_word start1, C_word end1, C_word start2) C_regparm;
1921C_fctexport C_word C_utf_position(C_word str, C_word start) C_regparm;
1922C_fctexport int C_utf_char_position(C_word bv, int pos) C_regparm;
1923C_fctexport C_word C_utf_range(C_word str, C_word start, C_word end) C_regparm;
1924C_fctexport int C_utf_count(C_char *str, int len) C_regparm;
1925C_fctexport int C_utf_fast_count(C_char *str, int len) C_regparm;
1926C_fctexport C_char * C_utf_encode(C_char *str, int chr) C_regparm;
1927C_fctexport C_word C_utf_decode_ptr(C_char *bv) C_regparm;
1928C_fctexport C_word C_utf_decode(C_word bv, C_word pos) C_regparm;
1929C_fctexport int C_utf_char_downcase(int c) C_regparm;
1930C_fctexport int C_utf_char_upcase(int c) C_regparm;
1931C_fctexport C_word C_utf_advance(C_word bv, C_word pos) C_regparm;
1932C_fctexport C_word C_utf_insert(C_word bv, C_word pos, C_word c) C_regparm;
1933C_fctexport C_word C_utf_bytes(C_word chr) C_regparm;
1934C_fctexport C_word C_utf_fill(C_word bv, C_word chr) C_regparm;
1935C_fctexport int C_utf_expect(int byte) C_regparm;
1936C_fctexport void C_utf_putc(int chr, C_FILEPTR fp) C_regparm;
1937C_fctexport C_word C_utf_fragment_counts(C_word bv, C_word pos, C_word len) C_regparm;
1938C_fctexport C_word C_utf_overwrite(C_word s, C_word i, C_word len, C_word bv, C_word c) C_regparm;
1939C_fctexport C_word C_utf_list_size(C_word lst) C_regparm;
1940C_fctexport int C_utf_isspace(int c) C_regparm;
1941C_fctexport int C_utf_isdigit(int c) C_regparm;
1942C_fctexport int C_utf_isalpha(int c) C_regparm;
1943C_fctexport int C_utf_isupper(int c) C_regparm;
1944C_fctexport int C_utf_islower(int c) C_regparm;
1945C_fctexport C_word C_utf_validate(C_word bv, C_word blen) C_regparm;
1946C_fctexport C_word C_latin_to_utf(C_word from, C_word to, C_word start, C_word len) C_regparm;
1947C_fctexport C_word C_utf_to_latin(C_word from, C_word to, C_word start, C_word len) C_regparm;
1948C_fctexport C_word C_utf_char_foldcase(C_word c) C_regparm;
1949C_fctexport C_word C_utf_string_foldcase(C_word from, C_word to, C_word len) C_regparm;
1950#ifdef C_WCHAR_FILENAMES
1951C_fctexport C_WCHAR *C_utf16(C_word bv, int cont) C_regparm;
1952C_fctexport C_char *C_utf8(C_WCHAR *str) C_regparm;
1953# define C_OS_FILENAME(bv, f)		C_utf16(bv, f)
1954#else
1955# define C_OS_FILENAME(bv, f)		C_c_string(bv)
1956#endif
1957
1958C_fctimport C_cpsproc(C_toplevel) C_noret;
1959C_fctimport C_cpsproc(C_invalid_procedure) C_noret;
1960C_fctexport C_cpsproc(C_stop_timer) C_noret;
1961C_fctexport C_cpsproc(C_signum) C_noret;
1962C_fctexport C_cpsproc(C_apply) C_noret;
1963C_fctexport C_cpsproc(C_call_cc) C_noret;
1964C_fctexport C_cpsproc(C_continuation_graft) C_noret;
1965C_fctexport C_cpsproc(C_values) C_noret;
1966C_fctexport C_cpsproc(C_apply_values) C_noret;
1967C_fctexport C_cpsproc(C_call_with_values) C_noret;
1968C_fctexport C_cpsproc(C_u_call_with_values) C_noret;
1969C_fctexport C_cpsproc(C_times) C_noret;
1970C_fctexport C_cpsproc(C_plus) C_noret;
1971C_fctexport C_cpsproc(C_minus) C_noret;
1972C_fctexport C_cpsproc(C_quotient_and_remainder) C_noret;
1973C_fctexport C_cpsproc(C_u_integer_quotient_and_remainder) C_noret;
1974C_fctexport C_cpsproc(C_bitwise_and) C_noret;
1975C_fctexport C_cpsproc(C_bitwise_ior) C_noret;
1976C_fctexport C_cpsproc(C_bitwise_xor) C_noret;
1977
1978C_fctexport C_cpsproc(C_nequalp) C_noret;
1979C_fctexport C_cpsproc(C_greaterp) C_noret;
1980C_fctexport C_cpsproc(C_lessp) C_noret;
1981C_fctexport C_cpsproc(C_greater_or_equal_p) C_noret;
1982C_fctexport C_cpsproc(C_less_or_equal_p) C_noret;
1983C_fctexport C_cpsproc(C_gc) C_noret;
1984C_fctexport C_cpsproc(C_open_file_port) C_noret;
1985C_fctexport C_cpsproc(C_allocate_vector) C_noret;
1986C_fctexport C_cpsproc(C_allocate_bytevector) C_noret;
1987C_fctexport C_cpsproc(C_string_to_symbol) C_noret;
1988C_fctexport C_cpsproc(C_string_to_keyword) C_noret;
1989C_fctexport C_cpsproc(C_build_symbol) C_noret;
1990C_fctexport C_cpsproc(C_number_to_string) C_noret;
1991C_fctexport C_cpsproc(C_fixnum_to_string) C_noret;
1992C_fctexport C_cpsproc(C_flonum_to_string) C_noret;
1993C_fctexport C_cpsproc(C_integer_to_string) C_noret;
1994C_fctexport C_cpsproc(C_make_structure) C_noret;
1995C_fctexport C_cpsproc(C_make_symbol) C_noret;
1996C_fctexport C_cpsproc(C_make_pointer) C_noret;
1997C_fctexport C_cpsproc(C_make_tagged_pointer) C_noret;
1998C_fctexport C_cpsproc(C_ensure_heap_reserve) C_noret;
1999C_fctexport C_cpsproc(C_return_to_host) C_noret;
2000C_fctexport C_cpsproc(C_get_symbol_table_info) C_noret;
2001C_fctexport C_cpsproc(C_get_memory_info) C_noret;
2002C_fctexport C_cpsproc(C_context_switch) C_noret;
2003C_fctexport C_cpsproc(C_peek_signed_integer) C_noret;
2004C_fctexport C_cpsproc(C_peek_unsigned_integer) C_noret;
2005C_fctexport C_cpsproc(C_peek_int64) C_noret;
2006C_fctexport C_cpsproc(C_peek_uint64) C_noret;
2007C_fctexport C_cpsproc(C_decode_seconds) C_noret;
2008C_fctexport C_cpsproc(C_software_type) C_noret;
2009C_fctexport C_cpsproc(C_machine_type) C_noret;
2010C_fctexport C_cpsproc(C_machine_byte_order) C_noret;
2011C_fctexport C_cpsproc(C_software_version) C_noret;
2012C_fctexport C_cpsproc(C_build_platform) C_noret;
2013C_fctexport C_cpsproc(C_register_finalizer) C_noret;
2014C_fctexport C_cpsproc(C_set_dlopen_flags) C_noret;
2015C_fctexport C_cpsproc(C_dload) C_noret;
2016C_fctexport C_cpsproc(C_become) C_noret;
2017C_fctexport C_cpsproc(C_call_with_cthulhu) C_noret;
2018C_fctexport C_cpsproc(C_copy_closure) C_noret;
2019C_fctexport C_cpsproc(C_dump_heap_state) C_noret;
2020C_fctexport C_cpsproc(C_filter_heap_objects) C_noret;
2021
2022C_fctexport time_t C_seconds(C_long *ms) C_regparm;
2023C_fctexport C_word C_bignum_simplify(C_word big) C_regparm;
2024C_fctexport C_word C_allocate_scratch_bignum(C_word **ptr, C_word size, C_word negp, C_word initp) C_regparm;
2025C_fctexport C_word C_bignum_rewrap(C_word **p, C_word big) C_regparm;
2026C_fctexport C_word C_i_dump_statistical_profile();
2027C_fctexport C_word C_a_i_list(C_word **a, int c, ...);
2028C_fctexport C_word C_a_i_string(C_word **a, int c, ...);
2029C_fctexport C_word C_a_i_record(C_word **a, int c, ...);
2030C_fctexport C_word C_a_i_port(C_word **a, int c);
2031C_fctexport C_word C_a_i_bytevector(C_word **a, int c, C_word x) C_regparm;
2032C_fctexport C_word C_i_listp(C_word x) C_regparm;
2033C_fctexport C_word C_i_s8vectorp(C_word x) C_regparm;
2034C_fctexport C_word C_i_u16vectorp(C_word x) C_regparm;
2035C_fctexport C_word C_i_s16vectorp(C_word x) C_regparm;
2036C_fctexport C_word C_i_u32vectorp(C_word x) C_regparm;
2037C_fctexport C_word C_i_s32vectorp(C_word x) C_regparm;
2038C_fctexport C_word C_i_u64vectorp(C_word x) C_regparm;
2039C_fctexport C_word C_i_s64vectorp(C_word x) C_regparm;
2040C_fctexport C_word C_i_f32vectorp(C_word x) C_regparm;
2041C_fctexport C_word C_i_f64vectorp(C_word x) C_regparm;
2042C_fctexport C_word C_i_string_equal_p(C_word x, C_word y) C_regparm;
2043C_fctexport C_word C_i_string_ci_equal_p(C_word x, C_word y) C_regparm;
2044C_fctexport C_word C_i_set_car(C_word p, C_word x) C_regparm;
2045C_fctexport C_word C_i_set_cdr(C_word p, C_word x) C_regparm;
2046C_fctexport C_word C_i_vector_set(C_word v, C_word i, C_word x) C_regparm;
2047C_fctexport C_word C_i_bytevector_set(C_word v, C_word i, C_word x) C_regparm;
2048C_fctexport C_word C_i_s8vector_set(C_word v, C_word i, C_word x) C_regparm;
2049C_fctexport C_word C_i_u16vector_set(C_word v, C_word i, C_word x) C_regparm;
2050C_fctexport C_word C_i_s16vector_set(C_word v, C_word i, C_word x) C_regparm;
2051C_fctexport C_word C_i_u32vector_set(C_word v, C_word i, C_word x) C_regparm;
2052C_fctexport C_word C_i_s32vector_set(C_word v, C_word i, C_word x) C_regparm;
2053C_fctexport C_word C_i_u64vector_set(C_word v, C_word i, C_word x) C_regparm;
2054C_fctexport C_word C_i_s64vector_set(C_word v, C_word i, C_word x) C_regparm;
2055C_fctexport C_word C_i_f32vector_set(C_word v, C_word i, C_word x) C_regparm;
2056C_fctexport C_word C_i_f64vector_set(C_word v, C_word i, C_word x) C_regparm;
2057C_fctexport C_word C_i_exactp(C_word x) C_regparm;
2058C_fctexport C_word C_i_inexactp(C_word x) C_regparm;
2059C_fctexport C_word C_i_nanp(C_word x) C_regparm;
2060C_fctexport C_word C_i_finitep(C_word x) C_regparm;
2061C_fctexport C_word C_i_infinitep(C_word x) C_regparm;
2062C_fctexport C_word C_i_zerop(C_word x) C_regparm;
2063C_fctexport C_word C_u_i_zerop(C_word x) C_regparm;  /* DEPRECATED */
2064C_fctexport C_word C_i_positivep(C_word x) C_regparm;
2065C_fctexport C_word C_i_integer_positivep(C_word x) C_regparm;
2066C_fctexport C_word C_i_negativep(C_word x) C_regparm;
2067C_fctexport C_word C_i_integer_negativep(C_word x) C_regparm;
2068C_fctexport C_word C_i_car(C_word x) C_regparm;
2069C_fctexport C_word C_i_cdr(C_word x) C_regparm;
2070C_fctexport C_word C_i_caar(C_word x) C_regparm;
2071C_fctexport C_word C_i_cadr(C_word x) C_regparm;
2072C_fctexport C_word C_i_cdar(C_word x) C_regparm;
2073C_fctexport C_word C_i_cddr(C_word x) C_regparm;
2074C_fctexport C_word C_i_caddr(C_word x) C_regparm;
2075C_fctexport C_word C_i_cdddr(C_word x) C_regparm;
2076C_fctexport C_word C_i_cadddr(C_word x) C_regparm;
2077C_fctexport C_word C_i_cddddr(C_word x) C_regparm;
2078C_fctexport C_word C_i_list_tail(C_word lst, C_word i) C_regparm;
2079C_fctexport C_word C_i_evenp(C_word x) C_regparm;
2080C_fctexport C_word C_i_integer_evenp(C_word x) C_regparm;
2081C_fctexport C_word C_i_oddp(C_word x) C_regparm;
2082C_fctexport C_word C_i_integer_oddp(C_word x) C_regparm;
2083C_fctexport C_word C_i_vector_ref(C_word v, C_word i) C_regparm;
2084C_fctexport C_word C_i_bytevector_ref(C_word v, C_word i) C_regparm;
2085C_fctexport C_word C_i_s8vector_ref(C_word v, C_word i) C_regparm;
2086C_fctexport C_word C_i_u16vector_ref(C_word v, C_word i) C_regparm;
2087C_fctexport C_word C_i_s16vector_ref(C_word v, C_word i) C_regparm;
2088C_fctexport C_word C_a_i_u32vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;
2089C_fctexport C_word C_a_i_s32vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;
2090C_fctexport C_word C_a_i_u64vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;
2091C_fctexport C_word C_a_i_s64vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;
2092C_fctexport C_word C_a_i_f32vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;
2093C_fctexport C_word C_a_i_f64vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;
2094C_fctexport C_word C_i_block_ref(C_word x, C_word i) C_regparm;
2095C_fctexport C_word C_i_string_set(C_word s, C_word i, C_word c) C_regparm;
2096C_fctexport C_word C_i_string_ref(C_word s, C_word i) C_regparm;
2097C_fctexport C_word C_i_vector_length(C_word v) C_regparm;
2098C_fctexport C_word C_i_bytevector_length(C_word v) C_regparm;
2099C_fctexport C_word C_i_s8vector_length(C_word v) C_regparm;
2100C_fctexport C_word C_i_u16vector_length(C_word v) C_regparm;
2101C_fctexport C_word C_i_s16vector_length(C_word v) C_regparm;
2102C_fctexport C_word C_i_u32vector_length(C_word v) C_regparm;
2103C_fctexport C_word C_i_s32vector_length(C_word v) C_regparm;
2104C_fctexport C_word C_i_u64vector_length(C_word v) C_regparm;
2105C_fctexport C_word C_i_s64vector_length(C_word v) C_regparm;
2106C_fctexport C_word C_i_f32vector_length(C_word v) C_regparm;
2107C_fctexport C_word C_i_f64vector_length(C_word v) C_regparm;
2108C_fctexport C_word C_i_string_length(C_word s) C_regparm;
2109C_fctexport C_word C_i_assq(C_word x, C_word lst) C_regparm;
2110C_fctexport C_word C_i_assv(C_word x, C_word lst) C_regparm;
2111C_fctexport C_word C_i_assoc(C_word x, C_word lst) C_regparm;
2112C_fctexport C_word C_i_memq(C_word x, C_word lst) C_regparm;
2113C_fctexport C_word C_u_i_memq(C_word x, C_word lst) C_regparm;
2114C_fctexport C_word C_i_memv(C_word x, C_word lst) C_regparm;
2115C_fctexport C_word C_i_member(C_word x, C_word lst) C_regparm;
2116C_fctexport C_word C_i_length(C_word lst) C_regparm;
2117C_fctexport C_word C_u_i_length(C_word lst) C_regparm;
2118C_fctexport C_word C_i_check_closure_2(C_word x, C_word loc) C_regparm;
2119C_fctexport C_word C_i_check_fixnum_2(C_word x, C_word loc) C_regparm;
2120C_fctexport C_word C_i_check_exact_2(C_word x, C_word loc) C_regparm; /* DEPRECATED */
2121C_fctexport C_word C_i_check_inexact_2(C_word x, C_word loc) C_regparm;
2122C_fctexport C_word C_i_check_number_2(C_word x, C_word loc) C_regparm;
2123C_fctexport C_word C_i_check_string_2(C_word x, C_word loc) C_regparm;
2124C_fctexport C_word C_i_check_bytevector_2(C_word x, C_word loc) C_regparm;
2125C_fctexport C_word C_i_check_symbol_2(C_word x, C_word loc) C_regparm;
2126C_fctexport C_word C_i_check_keyword_2(C_word x, C_word loc) C_regparm;
2127C_fctexport C_word C_i_check_list_2(C_word x, C_word loc) C_regparm;
2128C_fctexport C_word C_i_check_pair_2(C_word x, C_word loc) C_regparm;
2129C_fctexport C_word C_i_check_boolean_2(C_word x, C_word loc) C_regparm;
2130C_fctexport C_word C_i_check_locative_2(C_word x, C_word loc) C_regparm;
2131C_fctexport C_word C_i_check_vector_2(C_word x, C_word loc) C_regparm;
2132C_fctexport C_word C_i_check_structure_2(C_word x, C_word st, C_word loc) C_regparm;
2133C_fctexport C_word C_i_check_char_2(C_word x, C_word loc) C_regparm;
2134C_fctexport C_word C_i_check_port_2(C_word x, C_word in, C_word op, C_word loc) C_regparm;
2135C_fctexport C_word C_i_check_range_2(C_word i, C_word f, C_word t, C_word loc) C_regparm;
2136C_fctexport C_word C_i_check_range_including_2(C_word i, C_word f, C_word t, C_word loc) C_regparm;
2137C_fctexport C_word C_i_bignum_cmp(C_word x, C_word y) C_regparm;
2138C_fctexport C_word C_i_nequalp(C_word x, C_word y) C_regparm;
2139C_fctexport C_word C_i_integer_equalp(C_word x, C_word y) C_regparm;
2140C_fctexport C_word C_i_greaterp(C_word x, C_word y) C_regparm;
2141C_fctexport C_word C_i_integer_greaterp(C_word x, C_word y) C_regparm;
2142C_fctexport C_word C_i_lessp(C_word x, C_word y) C_regparm;
2143C_fctexport C_word C_i_integer_lessp(C_word x, C_word y) C_regparm;
2144C_fctexport C_word C_i_greater_or_equalp(C_word x, C_word y) C_regparm;
2145C_fctexport C_word C_i_integer_greater_or_equalp(C_word x, C_word y) C_regparm;
2146C_fctexport C_word C_i_less_or_equalp(C_word x, C_word y) C_regparm;
2147C_fctexport C_word C_i_integer_less_or_equalp(C_word x, C_word y) C_regparm;
2148C_fctexport C_word C_i_not_pair_p_2(C_word x) C_regparm;
2149C_fctexport C_word C_i_null_list_p(C_word x) C_regparm;
2150C_fctexport C_word C_i_string_null_p(C_word x) C_regparm;
2151C_fctexport C_word C_i_null_pointerp(C_word x) C_regparm;
2152C_fctexport C_word C_i_char_equalp(C_word x, C_word y) C_regparm;
2153C_fctexport C_word C_i_char_greaterp(C_word x, C_word y) C_regparm;
2154C_fctexport C_word C_i_char_lessp(C_word x, C_word y) C_regparm;
2155C_fctexport C_word C_i_char_greater_or_equal_p(C_word x, C_word y) C_regparm;
2156C_fctexport C_word C_i_char_less_or_equal_p(C_word x, C_word y) C_regparm;
2157C_fctexport C_word C_a_i_locative_ref(C_word **a, int c, C_word loc) C_regparm;
2158C_fctexport C_word C_i_locative_set(C_word loc, C_word x) C_regparm;
2159C_fctexport C_word C_i_locative_to_object(C_word loc) C_regparm;
2160C_fctexport C_word C_i_locative_index(C_word loc) C_regparm;
2161C_fctexport C_word C_a_i_make_locative(C_word **a, int c, C_word type, C_word object, C_word index, C_word weak) C_regparm;
2162C_fctexport C_word C_i_bit_to_bool(C_word n, C_word i) C_regparm; /* DEPRECATED */
2163C_fctexport C_word C_i_integer_length(C_word x) C_regparm;
2164C_fctexport C_word C_a_i_exp(C_word **a, int c, C_word n) C_regparm;
2165C_fctexport C_word C_a_i_log(C_word **a, int c, C_word n) C_regparm;
2166C_fctexport C_word C_a_i_sin(C_word **a, int c, C_word n) C_regparm;
2167C_fctexport C_word C_a_i_cos(C_word **a, int c, C_word n) C_regparm;
2168C_fctexport C_word C_a_i_tan(C_word **a, int c, C_word n) C_regparm;
2169C_fctexport C_word C_a_i_asin(C_word **a, int c, C_word n) C_regparm;
2170C_fctexport C_word C_a_i_acos(C_word **a, int c, C_word n) C_regparm;
2171C_fctexport C_word C_a_i_atan(C_word **a, int c, C_word n) C_regparm;
2172C_fctexport C_word C_a_i_atan2(C_word **a, int c, C_word n1, C_word n2) C_regparm;
2173C_fctexport C_word C_a_i_sinh(C_word **a, int c, C_word n) C_regparm;
2174C_fctexport C_word C_a_i_cosh(C_word **a, int c, C_word n) C_regparm;
2175C_fctexport C_word C_a_i_tanh(C_word **a, int c, C_word n) C_regparm;
2176C_fctexport C_word C_a_i_asinh(C_word **a, int c, C_word n) C_regparm;
2177C_fctexport C_word C_a_i_acosh(C_word **a, int c, C_word n) C_regparm;
2178C_fctexport C_word C_a_i_atanh(C_word **a, int c, C_word n) C_regparm;
2179C_fctexport C_word C_a_i_sqrt(C_word **a, int c, C_word n) C_regparm;
2180C_fctexport C_word C_i_o_fixnum_plus(C_word x, C_word y) C_regparm;
2181C_fctexport C_word C_i_o_fixnum_difference(C_word x, C_word y) C_regparm;
2182C_fctexport C_word C_i_o_fixnum_times(C_word x, C_word y) C_regparm;
2183C_fctexport C_word C_i_o_fixnum_quotient(C_word x, C_word y) C_regparm;
2184C_fctexport C_word C_i_o_fixnum_and(C_word x, C_word y) C_regparm;
2185C_fctexport C_word C_i_o_fixnum_ior(C_word x, C_word y) C_regparm;
2186C_fctexport C_word C_i_o_fixnum_xor(C_word x, C_word y) C_regparm;
2187C_fctexport C_word C_a_i_flonum_round_proper(C_word **a, int c, C_word n) C_regparm;
2188C_fctexport C_word C_a_i_flonum_gcd(C_word **p, C_word n, C_word x, C_word y) C_regparm;
2189
2190C_fctexport C_word C_i_getprop(C_word sym, C_word prop, C_word def) C_regparm;
2191C_fctexport C_word C_putprop(C_word **a, C_word sym, C_word prop, C_word val) C_regparm;
2192C_fctexport C_word C_i_persist_symbol(C_word sym) C_regparm;
2193C_fctexport C_word C_i_unpersist_symbol(C_word sym) C_regparm;
2194C_fctexport C_word C_i_get_keyword(C_word key, C_word args, C_word def) C_regparm;
2195C_fctexport C_word C_i_process_sleep(C_word n) C_regparm;
2196C_fctexport C_u64 C_milliseconds(void) C_regparm; /* DEPRECATED */
2197C_fctexport C_u64 C_current_process_milliseconds(void) C_regparm;
2198C_fctexport C_u64 C_cpu_milliseconds(void) C_regparm;
2199C_fctexport double C_bignum_to_double(C_word bignum) C_regparm;
2200C_fctexport C_word C_i_debug_modep(void) C_regparm;
2201C_fctexport C_word C_i_dump_heap_on_exitp(void) C_regparm;
2202C_fctexport C_word C_i_accumulated_gc_time(void) C_regparm;
2203C_fctexport C_word C_i_allocated_finalizer_count(void) C_regparm;
2204C_fctexport C_word C_i_live_finalizer_count(void) C_regparm;
2205C_fctexport C_word C_i_profilingp(void) C_regparm;
2206C_fctexport C_word C_i_tty_forcedp(void) C_regparm;
2207C_fctexport C_word C_i_setenv(C_word var, C_word val) C_regparm;
2208
2209C_fctexport C_word C_a_i_cpu_time(C_word **a, int c, C_word buf) C_regparm;
2210C_fctexport C_word C_a_i_exact_to_inexact(C_word **a, int c, C_word n) C_regparm;
2211C_fctexport C_word C_i_file_exists_p(C_word name, C_word file, C_word dir) C_regparm;
2212
2213C_fctexport C_word C_s_a_i_abs(C_word **ptr, C_word n, C_word x) C_regparm;
2214C_fctexport C_word C_s_a_i_negate(C_word **ptr, C_word n, C_word x) C_regparm;
2215C_fctexport C_word C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2216C_fctexport C_word C_s_a_u_i_integer_negate(C_word **ptr, C_word n, C_word x) C_regparm;
2217C_fctexport C_word C_s_a_u_i_integer_minus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2218C_fctexport C_word C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2219C_fctexport C_word C_s_a_u_i_integer_plus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2220C_fctexport C_word C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2221C_fctexport C_word C_s_a_u_i_integer_times(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2222C_fctexport C_word C_s_a_i_arithmetic_shift(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2223C_fctexport C_word C_s_a_u_i_integer_gcd(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2224C_fctexport C_word C_s_a_i_quotient(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2225C_fctexport C_word C_s_a_u_i_integer_quotient(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2226C_fctexport C_word C_s_a_i_remainder(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2227C_fctexport C_word C_s_a_u_i_integer_remainder(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2228C_fctexport C_word C_s_a_i_modulo(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2229C_fctexport C_word C_s_a_u_i_integer_modulo(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2230C_fctexport C_word C_s_a_i_bitwise_and(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2231C_fctexport C_word C_s_a_i_bitwise_ior(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2232C_fctexport C_word C_s_a_i_bitwise_xor(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;
2233C_fctexport C_word C_s_a_i_bitwise_not(C_word **ptr, C_word n, C_word x) C_regparm;
2234C_fctexport C_word C_s_a_i_digits_to_integer(C_word **ptr, C_word n, C_word str, C_word start, C_word end, C_word radix, C_word negp) C_regparm;
2235C_fctexport C_word C_s_a_u_i_flo_to_int(C_word **ptr, C_word n, C_word x) C_regparm;
2236
2237
2238C_fctexport C_word C_i_foreign_char_argumentp(C_word x) C_regparm;
2239C_fctexport C_word C_i_foreign_fixnum_argumentp(C_word x) C_regparm;
2240C_fctexport C_word C_i_foreign_flonum_argumentp(C_word x) C_regparm;
2241C_fctexport C_word C_i_foreign_cplxnum_argumentp(C_word x) C_regparm;
2242C_fctexport C_word C_i_foreign_block_argumentp(C_word x) C_regparm;
2243C_fctexport C_word C_i_foreign_struct_wrapper_argumentp(C_word t, C_word x) C_regparm;
2244C_fctexport C_word C_i_foreign_string_argumentp(C_word x) C_regparm;
2245C_fctexport C_word C_i_foreign_symbol_argumentp(C_word x) C_regparm;
2246C_fctexport C_word C_i_foreign_tagged_pointer_argumentp(C_word x, C_word t) C_regparm;
2247C_fctexport C_word C_i_foreign_pointer_argumentp(C_word x) C_regparm;
2248C_fctexport C_word C_i_foreign_scheme_or_c_pointer_argumentp(C_word x) C_regparm;
2249C_fctexport C_word C_i_foreign_ranged_integer_argumentp(C_word x, C_word bits) C_regparm;
2250C_fctexport C_word C_i_foreign_unsigned_ranged_integer_argumentp(C_word x, C_word bits) C_regparm;
2251
2252C_fctexport C_char *C_lookup_procedure_id(void *ptr);
2253C_fctexport void *C_lookup_procedure_ptr(C_char *id);
2254
2255C_fctexport int C_fast_rand(void);
2256C_fctexport void C_fast_srand(int seed);
2257C_fctexport C_word C_random_fixnum(C_word n) C_regparm;
2258C_fctexport C_word C_s_a_u_i_random_int(C_word **ptr, C_word n, C_word rn) C_regparm;
2259C_fctexport C_word C_a_i_random_real(C_word **ptr, C_word n) C_regparm;
2260C_fctexport C_word C_random_bytes(C_word buf, C_word size);
2261C_fctexport C_word C_set_random_seed(C_word buf, C_word n);
2262
2263#ifdef C_SIXTY_FOUR
2264C_fctexport C_cpsproc(C_peek_signed_integer_32);
2265C_fctexport C_cpsproc(C_peek_unsigned_integer_32);
2266#else
2267# define C_peek_signed_integer_32    C_peek_signed_integer
2268# define C_peek_unsigned_integer_32  C_peek_unsigned_integer
2269#endif
2270
2271C_fctexport C_word C_decode_literal(C_word **ptr, C_char *str) C_regparm;
2272C_fctexport C_word C_i_pending_interrupt(C_word dummy) C_regparm;
2273
2274C_fctexport void *C_get_statistics(void);
2275
2276/* defined in eval.scm: */
2277C_fctexport  void  CHICKEN_get_error_message(char *buf,int bufsize);
2278C_fctexport  int  CHICKEN_load(char * filename);
2279C_fctexport  int  CHICKEN_read(char * str,C_word *result);
2280C_fctexport  int  CHICKEN_apply_to_string(C_word func,C_word args,char *buf,int bufsize);
2281C_fctexport  int  CHICKEN_apply(C_word func,C_word args,C_word *result);
2282C_fctexport  int  CHICKEN_eval_string_to_string(char *str,char *buf,int bufsize);
2283C_fctexport  int  CHICKEN_eval_to_string(C_word exp,char *buf,int bufsize);
2284C_fctexport  int  CHICKEN_eval_string(char * str,C_word *result);
2285C_fctexport  int  CHICKEN_eval(C_word exp,C_word *result);
2286C_fctexport  int  CHICKEN_yield();
2287
2288C_fctexport C_cpsproc(C_default_5fstub_toplevel);
2289
2290C_fctexport C_word C_a_extract_struct_2(C_word **ptr, size_t sz, void *sp);
2291
2292
2293#ifndef HAVE_STATEMENT_EXPRESSIONS
2294
2295inline static C_word *C_a_i(C_word **a, int n)
2296{
2297  C_word *p = *a;
2298
2299  *a += n;
2300  return p;
2301}
2302
2303#endif
2304
2305inline static C_word
2306C_chop_bv(C_word bv)
2307{
2308    ((C_SCHEME_BLOCK *)bv)->header = C_make_header(C_BYTEVECTOR_TYPE, C_header_size(bv) - 1);
2309    return bv;
2310}
2311
2312inline static C_word
2313C_mutate(C_word *slot, C_word val)
2314{
2315  if(!C_immediatep(val)) return C_mutate_slot(slot, val);
2316  else return *slot = val;
2317}
2318
2319inline static C_word C_permanentp(C_word x)
2320{
2321  return C_mk_bool(!C_immediatep(x) &&
2322                   !C_in_stackp(x) &&
2323                   !C_in_heapp(x) &&
2324                   !C_in_scratchspacep(x));
2325}
2326
2327inline static C_word C_u_i_namespaced_symbolp(C_word x)
2328{
2329  C_word s = C_symbol_name(x);
2330  return C_mk_bool(C_memchr(C_data_pointer(s), '#', C_header_size(s)));
2331}
2332
2333inline static C_word C_flonum(C_word **ptr, double n)
2334{
2335  C_word
2336    *p = *ptr,
2337    *p0;
2338
2339#ifndef C_SIXTY_FOUR
2340#ifndef C_DOUBLE_IS_32_BITS
2341  /* Align double on 8-byte boundary: */
2342  if(C_aligned8(p)) ++p;
2343#endif
2344#endif
2345
2346  p0 = p;
2347  *(p++) = C_FLONUM_TAG;
2348  *((double *)p) = n;
2349  *ptr = p + sizeof(double) / sizeof(C_word);
2350  return (C_word)p0;
2351}
2352
2353
2354inline static C_word C_u_i_zerop2(C_word x)
2355{
2356  return C_mk_bool(x == C_fix(0) ||
2357                   (!C_immediatep(x) &&
2358                    C_block_header(x) == C_FLONUM_TAG &&
2359                    C_flonum_magnitude(x) == 0.0));
2360}
2361
2362
2363inline static C_word C_string_to_pbytevector(C_word s)
2364{
2365  return C_pbytevector(C_header_size(s), (C_char *)C_data_pointer(s));
2366}
2367
2368
2369inline static C_word C_a_i_record1(C_word **ptr, int n, C_word x1)
2370{
2371  C_word *p = *ptr, *p0 = p;
2372
2373  *(p++) = C_STRUCTURE_TYPE | 1;
2374  *(p++) = x1;
2375  *ptr = p;
2376  return (C_word)p0;
2377}
2378
2379
2380inline static C_word C_a_i_record2(C_word **ptr, int n, C_word x1, C_word x2)
2381{
2382  C_word *p = *ptr, *p0 = p;
2383
2384  *(p++) = C_STRUCTURE_TYPE | 2;
2385  *(p++) = x1;
2386  *(p++) = x2;
2387  *ptr = p;
2388  return (C_word)p0;
2389}
2390
2391
2392inline static C_word C_a_i_record3(C_word **ptr, int n, C_word x1, C_word x2, C_word x3)
2393{
2394  C_word *p = *ptr, *p0 = p;
2395
2396  *(p++) = C_STRUCTURE_TYPE | 3;
2397  *(p++) = x1;
2398  *(p++) = x2;
2399  *(p++) = x3;
2400  *ptr = p;
2401  return (C_word)p0;
2402}
2403
2404
2405inline static C_word C_a_i_record4(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4)
2406{
2407  C_word *p = *ptr, *p0 = p;
2408
2409  *(p++) = C_STRUCTURE_TYPE | 4;
2410  *(p++) = x1;
2411  *(p++) = x2;
2412  *(p++) = x3;
2413  *(p++) = x4;
2414  *ptr = p;
2415  return (C_word)p0;
2416}
2417
2418
2419inline static C_word C_a_i_record5(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,
2420				 C_word x5)
2421{
2422  C_word *p = *ptr, *p0 = p;
2423
2424  *(p++) = C_STRUCTURE_TYPE | 5;
2425  *(p++) = x1;
2426  *(p++) = x2;
2427  *(p++) = x3;
2428  *(p++) = x4;
2429  *(p++) = x5;
2430  *ptr = p;
2431  return (C_word)p0;
2432}
2433
2434
2435inline static C_word C_a_i_record6(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,
2436				 C_word x5, C_word x6)
2437{
2438  C_word *p = *ptr, *p0 = p;
2439
2440  *(p++) = C_STRUCTURE_TYPE | 6;
2441  *(p++) = x1;
2442  *(p++) = x2;
2443  *(p++) = x3;
2444  *(p++) = x4;
2445  *(p++) = x5;
2446  *(p++) = x6;
2447  *ptr = p;
2448  return (C_word)p0;
2449}
2450
2451
2452inline static C_word C_a_i_record7(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,
2453				 C_word x5, C_word x6, C_word x7)
2454{
2455  C_word *p = *ptr, *p0 = p;
2456
2457  *(p++) = C_STRUCTURE_TYPE | 7;
2458  *(p++) = x1;
2459  *(p++) = x2;
2460  *(p++) = x3;
2461  *(p++) = x4;
2462  *(p++) = x5;
2463  *(p++) = x6;
2464  *(p++) = x7;
2465  *ptr = p;
2466  return (C_word)p0;
2467}
2468
2469
2470inline static C_word C_a_i_record8(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,
2471				 C_word x5, C_word x6, C_word x7, C_word x8)
2472{
2473  C_word *p = *ptr, *p0 = p;
2474
2475  *(p++) = C_STRUCTURE_TYPE | 8;
2476  *(p++) = x1;
2477  *(p++) = x2;
2478  *(p++) = x3;
2479  *(p++) = x4;
2480  *(p++) = x5;
2481  *(p++) = x6;
2482  *(p++) = x7;
2483  *(p++) = x8;
2484  *ptr = p;
2485  return (C_word)p0;
2486}
2487
2488inline static C_word C_cplxnum(C_word **ptr, C_word r, C_word i)
2489{
2490  C_word *p = *ptr, *p0 = p;
2491
2492  *(p++) = C_CPLXNUM_TAG;
2493  *(p++) = r;
2494  *(p++) = i;
2495  *ptr = p;
2496  return (C_word)p0;
2497}
2498
2499inline static C_word C_inexact_cplxnum(C_word **ptr, double C_complex n)
2500{
2501#if defined(__STDC_NO_COMPLEX__) || defined(__cplusplus)
2502	C_unimplemented(C_text("native complex numbers"));
2503	return 0;
2504#else
2505  C_word r = C_flonum(ptr, creal(n));
2506  C_word i = C_flonum(ptr, cimag(n));
2507  C_word *p = *ptr, *p0 = p;
2508
2509  *(p++) = C_CPLXNUM_TAG;
2510  *(p++) = r;
2511  *(p++) = i;
2512  *ptr = p;
2513  return (C_word)p0;
2514#endif
2515}
2516
2517inline static C_word C_ratnum(C_word **ptr, C_word n, C_word d)
2518{
2519  C_word *p = *ptr, *p0 = p;
2520
2521  *(p++) = C_RATNUM_TAG;
2522  *(p++) = n;
2523  *(p++) = d;
2524  *ptr = p;
2525  return (C_word)p0;
2526}
2527
2528inline static C_word C_a_i_bignum_wrapper(C_word **ptr, C_word vec)
2529{
2530  C_word *p = *ptr, *p0 = p;
2531
2532  *(p++) = C_BIGNUM_TAG;
2533  *(p++) = vec;
2534  *ptr = p;
2535  return (C_word)p0;
2536}
2537
2538/* Silly (this is not normalized) but in some cases needed internally */
2539inline static C_word C_bignum0(C_word **ptr)
2540{
2541  C_word *p = *ptr, p0 = (C_word)p;
2542
2543  *(p++) = C_BYTEVECTOR_TYPE | C_wordstobytes(1);
2544  *(p++) = 0; /* zero is always positive */
2545  *ptr = p;
2546
2547  return C_a_i_bignum_wrapper(ptr, p0);
2548}
2549
2550inline static C_word C_bignum1(C_word **ptr, int negp, C_uword d1)
2551{
2552  C_word *p = *ptr, p0 = (C_word)p;
2553
2554  *(p++) = C_BYTEVECTOR_TYPE | C_wordstobytes(2);
2555  *(p++) = negp;
2556  *(p++) = d1;
2557  *ptr = p;
2558
2559  return C_a_i_bignum_wrapper(ptr, p0);
2560}
2561
2562/* Here d1, d2, ... are low to high (ie, little endian)! */
2563inline static C_word C_bignum2(C_word **ptr, int negp, C_uword d1, C_uword d2)
2564{
2565  C_word *p = *ptr, p0 = (C_word)p;
2566
2567  *(p++) = C_BYTEVECTOR_TYPE | C_wordstobytes(3);
2568  *(p++) = negp;
2569  *(p++) = d1;
2570  *(p++) = d2;
2571  *ptr = p;
2572
2573  return C_a_i_bignum_wrapper(ptr, p0);
2574}
2575
2576inline static C_word C_i_bignump(C_word x)
2577{
2578  return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_BIGNUM_TAG);
2579}
2580
2581inline static double C_complex C_c_cplxnum(C_word x)
2582{
2583#if defined(__STDC_NO_COMPLEX__) || defined(__cplusplus)
2584	C_unimplemented(C_text("native complex numbers"));
2585	return 0;
2586#else
2587  if(x & C_FIXNUM_BIT) return (double)C_unfix(x);
2588  else if(C_block_header(x) == C_CPLXNUM_TAG)
2589  	return C_flonum_magnitude(C_u_i_cplxnum_real(x)) + I *
2590  		C_flonum_magnitude(C_u_i_cplxnum_imag(x));
2591  else return C_flonum_magnitude(x);
2592#endif
2593}
2594
2595inline static double C_c_double(C_word x)
2596{
2597  if(x & C_FIXNUM_BIT) return (double)C_unfix(x);
2598  else return C_flonum_magnitude(x);
2599}
2600
2601inline static C_word C_a_u_i_int_to_flo(C_word **ptr, int n, C_word x)
2602{
2603  if(x & C_FIXNUM_BIT) return C_a_i_fix_to_flo(ptr, n, x);
2604  else return C_a_u_i_big_to_flo(ptr, n, x);
2605}
2606
2607inline static C_word C_num_to_int(C_word x)
2608{
2609  if(x & C_FIXNUM_BIT) {
2610    return C_unfix(x);
2611  } else {
2612#if DEBUGBUILD /* removes a warning with clang */
2613    (void)C_CHECKp(x,C_bignump(C_VAL1(x)),0);
2614#endif
2615    if (C_bignum_negativep(x)) return -(C_word)C_bignum_digits(x)[0];
2616    else return (C_word)C_bignum_digits(x)[0];  /* should never be larger */
2617  }
2618}
2619
2620
2621inline static C_s64 C_num_to_int64(C_word x)
2622{
2623  if(x & C_FIXNUM_BIT) {
2624    return (C_s64)C_unfix(x);
2625  } else {
2626    C_s64 num = C_bignum_digits(x)[0];
2627#ifndef C_SIXTY_FOUR
2628    if (C_bignum_size(x) > 1) num |= (C_s64)(((C_u64)C_bignum_digits(x)[1]) << 32);
2629#endif
2630    if (C_bignum_negativep(x)) return -num;
2631    else return num;
2632  }
2633}
2634
2635
2636inline static C_u64 C_num_to_uint64(C_word x)
2637{
2638  if(x & C_FIXNUM_BIT) {
2639    return (C_u64)C_unfix(x);
2640  } else {
2641    C_s64 num = C_bignum_digits(x)[0];
2642#ifndef C_SIXTY_FOUR
2643    if (C_bignum_size(x) > 1) num |= ((C_u64)C_bignum_digits(x)[1]) << 32;
2644#endif
2645    return num;
2646  }
2647}
2648
2649
2650inline static C_uword C_num_to_unsigned_int(C_word x)
2651{
2652  if(x & C_FIXNUM_BIT) {
2653    return (C_uword)C_unfix(x);
2654  } else {
2655    return C_bignum_digits(x)[0]; /* should never be larger */
2656  }
2657}
2658
2659
2660inline static C_word C_int_to_num(C_word **ptr, C_word n)
2661{
2662  if(C_fitsinfixnump(n)) return C_fix(n);
2663  else return C_bignum1(ptr, n < 0, C_wabs(n));
2664}
2665
2666
2667inline static C_word C_unsigned_int_to_num(C_word **ptr, C_uword n)
2668{
2669  if(C_ufitsinfixnump(n)) return C_fix(n);
2670  else return C_bignum1(ptr, 0, n);
2671}
2672
2673inline static C_word C_int64_to_num(C_word **ptr, C_s64 n)
2674{
2675#ifdef C_SIXTY_FOUR
2676  if(C_fitsinfixnump(n)) {
2677    return C_fix(n);
2678  } else {
2679    C_u64 un = n < 0 ? -n : n;
2680    return C_bignum1(ptr, n < 0, un);
2681  }
2682#else
2683  C_u64 un = n < 0 ? -n : n;
2684  C_word res = C_bignum2(ptr, n < 0, (C_uword)un, (C_uword)(un >> 32));
2685  return C_bignum_simplify(res);
2686#endif
2687}
2688
2689inline static C_word C_uint64_to_num(C_word **ptr, C_u64 n)
2690{
2691  if(C_ufitsinfixnump(n)) {
2692    return C_fix(n);
2693  } else {
2694#ifdef C_SIXTY_FOUR
2695    return C_bignum1(ptr, 0, n);
2696#else
2697    C_word res = C_bignum2(ptr, 0, (C_uword)n, (C_uword)(n >> 32));
2698    return C_bignum_simplify(res);
2699#endif
2700  }
2701}
2702
2703inline static C_word C_long_to_num(C_word **ptr, C_long n)
2704{
2705  if(C_fitsinfixnump(n)) {
2706    return C_fix(n);
2707  } else {
2708    return C_bignum1(ptr, n < 0, C_wabs(n));
2709  }
2710}
2711
2712inline static C_word C_unsigned_long_to_num(C_word **ptr, C_ulong n)
2713{
2714  if(C_ufitsinfixnump(n)) {
2715    return C_fix(n);
2716  } else {
2717    return C_bignum1(ptr, 0, n);
2718  }
2719}
2720
2721
2722inline static char *C_string_or_null(C_word x)
2723{
2724  return C_truep(x) ? C_c_string(x) : NULL;
2725}
2726
2727
2728inline static void *C_data_pointer_or_null(C_word x)
2729{
2730  return C_truep(x) ? C_data_pointer(x) : NULL;
2731}
2732
2733
2734inline static void *C_srfi_4_vector_or_null(C_word x)
2735{
2736  return C_truep(x) ? C_srfi_4_vector(x) : NULL;
2737}
2738
2739
2740inline static void *C_c_pointer_vector_or_null(C_word x)
2741{
2742  return C_truep(x) ? C_data_pointer(C_block_item(x, 2)) : NULL;
2743}
2744
2745
2746inline static void *C_c_pointer_or_null(C_word x)
2747{
2748  return C_truep(x) ? (void *)C_block_item(x, 0) : NULL;
2749}
2750
2751
2752inline static void *C_scheme_or_c_pointer(C_word x)
2753{
2754  return C_anypointerp(x) ? (void *)C_block_item(x, 0) : C_data_pointer(x);
2755}
2756
2757
2758inline static C_long C_num_to_long(C_word x)
2759{
2760  if(x & C_FIXNUM_BIT) {
2761    return (C_long)C_unfix(x);
2762  } else {
2763    if (C_bignum_negativep(x)) return -(C_long)C_bignum_digits(x)[0];
2764    else return (C_long)C_bignum_digits(x)[0];
2765  }
2766}
2767
2768
2769inline static C_ulong C_num_to_unsigned_long(C_word x)
2770{
2771  if(x & C_FIXNUM_BIT) {
2772    return (C_ulong)C_unfix(x);
2773  } else {
2774    return (C_ulong)C_bignum_digits(x)[0];
2775  }
2776}
2777
2778
2779inline static C_word C_ub_i_flonum_eqvp(double x, double y)
2780{
2781  /* This can distinguish between -0.0 and +0.0 */
2782  return x == y && signbit(x) == signbit(y);
2783}
2784
2785inline static C_word basic_eqvp(C_word x, C_word y)
2786{
2787  return (x == y ||
2788
2789          (!C_immediatep(x) && !C_immediatep(y) &&
2790           C_block_header(x) == C_block_header(y) &&
2791
2792           ((C_block_header(x) == C_FLONUM_TAG &&
2793             C_ub_i_flonum_eqvp(C_flonum_magnitude(x),
2794                                C_flonum_magnitude(y))) ||
2795
2796            (C_block_header(x) == C_BIGNUM_TAG &&
2797             C_block_header(y) == C_BIGNUM_TAG &&
2798             C_i_bignum_cmp(x, y) == C_fix(0)))));
2799}
2800
2801inline static C_word C_i_eqvp(C_word x, C_word y)
2802{
2803   return C_mk_bool(basic_eqvp(x, y) ||
2804                    (!C_immediatep(x) && !C_immediatep(y) &&
2805                     C_block_header(x) == C_block_header(y) &&
2806                     (C_block_header(x) == C_RATNUM_TAG ||
2807                      C_block_header(x) == C_CPLXNUM_TAG) &&
2808                     basic_eqvp(C_block_item(x, 0), C_block_item(y, 0)) &&
2809                     basic_eqvp(C_block_item(x, 1), C_block_item(y, 1))));
2810}
2811
2812inline static C_word C_i_symbolp(C_word x)
2813{
2814  return C_mk_bool(!C_immediatep(x) &&
2815                   C_block_header(x) == C_SYMBOL_TAG &&
2816                   C_symbol_plist(x) != C_SCHEME_FALSE);
2817}
2818
2819inline static C_word C_i_keywordp(C_word x)
2820{
2821  return C_mk_bool(!C_immediatep(x) &&
2822                   C_block_header(x) == C_SYMBOL_TAG &&
2823                   C_symbol_plist(x) == C_SCHEME_FALSE);
2824}
2825
2826inline static int C_persistable_symbol(C_word x)
2827{
2828  /* Symbol is bound, or has a non-empty plist (but is not a keyword) */
2829  return ((C_truep(C_boundp(x)) ||
2830           C_symbol_plist(x) != C_SCHEME_END_OF_LIST) &&
2831          C_symbol_plist(x) != C_SCHEME_FALSE);
2832}
2833
2834inline static C_word C_i_pairp(C_word x)
2835{
2836  return C_mk_bool(!C_immediatep(x) && C_header_type(x) == C_PAIR_TYPE);
2837}
2838
2839inline static C_word C_i_weak_pairp(C_word x)
2840{
2841  return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_WEAK_PAIR_TAG);
2842}
2843
2844inline static C_word C_i_stringp(C_word x)
2845{
2846  return C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_STRING_TYPE);
2847}
2848
2849
2850inline static C_word C_i_locativep(C_word x)
2851{
2852  return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_LOCATIVE_TAG);
2853}
2854
2855
2856inline static C_word C_i_vectorp(C_word x)
2857{
2858  return C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_VECTOR_TYPE);
2859}
2860
2861inline static C_word C_i_srfi_4_vectorp(C_word x)
2862{
2863  return C_mk_bool(!C_immediatep(x) &&
2864                   C_header_bits(x) == C_STRUCTURE_TYPE &&
2865                   (C_truep(C_i_s8vectorp(x)) ||
2866                    C_truep(C_i_u16vectorp(x)) ||
2867                    C_truep(C_i_s16vectorp(x)) ||
2868                    C_truep(C_i_u32vectorp(x)) ||
2869                    C_truep(C_i_s32vectorp(x)) ||
2870                    C_truep(C_i_u64vectorp(x)) ||
2871                    C_truep(C_i_s64vectorp(x)) ||
2872                    C_truep(C_i_f32vectorp(x)) ||
2873                    C_truep(C_i_f64vectorp(x))));
2874}
2875
2876inline static C_word C_i_portp(C_word x)
2877{
2878  return C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_PORT_TYPE);
2879}
2880
2881
2882inline static C_word C_i_closurep(C_word x)
2883{
2884  return C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_CLOSURE_TYPE);
2885}
2886
2887inline static C_word C_i_numberp(C_word x)
2888{
2889  return C_mk_bool((x & C_FIXNUM_BIT) ||
2890                   (!C_immediatep(x) &&
2891                    (C_block_header(x) == C_FLONUM_TAG ||
2892                     C_block_header(x) == C_BIGNUM_TAG ||
2893                     C_block_header(x) == C_RATNUM_TAG ||
2894                     C_block_header(x) == C_CPLXNUM_TAG)));
2895}
2896
2897/* All numbers are real, except for cplxnums */
2898inline static C_word C_i_realp(C_word x)
2899{
2900  return C_mk_bool((x & C_FIXNUM_BIT) ||
2901                   (!C_immediatep(x) &&
2902                    (C_block_header(x) == C_FLONUM_TAG ||
2903                     C_block_header(x) == C_BIGNUM_TAG ||
2904                     C_block_header(x) == C_RATNUM_TAG)));
2905}
2906
2907/* All finite real numbers are rational */
2908inline static C_word C_i_rationalp(C_word x)
2909{
2910  if(x & C_FIXNUM_BIT) {
2911    return C_SCHEME_TRUE;
2912  } else if (C_immediatep(x)) {
2913    return C_SCHEME_FALSE;
2914  } else if(C_block_header(x) == C_FLONUM_TAG) {
2915    double n = C_flonum_magnitude(x);
2916    return C_mk_bool(!C_isinf(n) && !C_isnan(n));
2917  } else {
2918    return C_mk_bool(C_block_header(x) == C_BIGNUM_TAG ||
2919                     C_block_header(x) == C_RATNUM_TAG);
2920  }
2921}
2922
2923
2924inline static C_word C_u_i_fpintegerp(C_word x)
2925{
2926  double dummy, val;
2927
2928  val = C_flonum_magnitude(x);
2929
2930  if(C_isnan(val) || C_isinf(val)) return C_SCHEME_FALSE;
2931
2932  return C_mk_bool(C_modf(val, &dummy) == 0.0);
2933}
2934
2935
2936inline static int C_ub_i_fpintegerp(double x)
2937{
2938  double dummy;
2939
2940  return C_modf(x, &dummy) == 0.0;
2941}
2942
2943inline static C_word C_i_exact_integerp(C_word x)
2944{
2945  return C_mk_bool((x) & C_FIXNUM_BIT || C_truep(C_i_bignump(x)));
2946}
2947
2948inline static C_word C_u_i_exactp(C_word x)
2949{
2950  if (C_truep(C_i_exact_integerp(x))) {
2951    return C_SCHEME_TRUE;
2952  } else if (C_block_header(x) == C_FLONUM_TAG) {
2953    return C_SCHEME_FALSE;
2954  } else if (C_block_header(x) == C_RATNUM_TAG) {
2955    return C_SCHEME_TRUE;
2956  } else if (C_block_header(x) == C_CPLXNUM_TAG) {
2957    x = C_u_i_cplxnum_real(x);
2958    /* r and i are always the same exactness, and we assume they
2959     * always store a number.
2960     */
2961    return C_mk_bool(C_immediatep(x) || (C_block_header(x) != C_FLONUM_TAG));
2962  } else {
2963    return C_SCHEME_FALSE;
2964  }
2965}
2966
2967inline static C_word C_u_i_inexactp(C_word x)
2968{
2969  if (C_immediatep(x)) {
2970    return C_SCHEME_FALSE;
2971  } else if (C_block_header(x) == C_FLONUM_TAG) {
2972    return C_SCHEME_TRUE;
2973  } else if (C_block_header(x) == C_CPLXNUM_TAG) {
2974    x = C_u_i_cplxnum_real(x); /* r and i are always the same exactness */
2975    return C_mk_bool(!C_immediatep(x) && (C_block_header(x) == C_FLONUM_TAG));
2976  } else {
2977    return C_SCHEME_FALSE;
2978  }
2979}
2980
2981inline static C_word C_i_integerp(C_word x)
2982{
2983  double dummy, val;
2984
2985  if (x & C_FIXNUM_BIT || C_truep(C_i_bignump(x)))
2986    return C_SCHEME_TRUE;
2987  if (C_immediatep(x) || C_block_header(x) != C_FLONUM_TAG)
2988    return C_SCHEME_FALSE;
2989
2990  val = C_flonum_magnitude(x);
2991  if(C_isnan(val) || C_isinf(val)) return C_SCHEME_FALSE;
2992
2993  return C_mk_bool(C_modf(val, &dummy) == 0.0);
2994}
2995
2996
2997inline static C_word C_i_flonump(C_word x)
2998{
2999  return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG);
3000}
3001
3002inline static C_word C_i_cplxnump(C_word x)
3003{
3004  return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_CPLXNUM_TAG);
3005}
3006
3007inline static C_word C_i_ratnump(C_word x)
3008{
3009  return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_RATNUM_TAG);
3010}
3011
3012/* TODO: Is this correctly named?  Shouldn't it accept an argcount? */
3013inline static C_word C_a_u_i_fix_to_big(C_word **ptr, C_word x)
3014{
3015  x = C_unfix(x);
3016  if (x < 0)
3017    return C_bignum1(ptr, 1, -x);
3018  else if (x == 0)
3019    return C_bignum0(ptr);
3020  else
3021    return C_bignum1(ptr, 0, x);
3022}
3023
3024inline static C_word C_i_fixnum_min(C_word x, C_word y)
3025{
3026  return ((C_word)x < (C_word)y) ? x : y;
3027}
3028
3029
3030inline static C_word C_i_fixnum_max(C_word x, C_word y)
3031{
3032  return ((C_word)x > (C_word)y) ? x : y;
3033}
3034
3035inline static C_word C_i_fixnum_gcd(C_word x, C_word y)
3036{
3037   x = (x & C_INT_SIGN_BIT) ? -C_unfix(x) : C_unfix(x);
3038   y = (y & C_INT_SIGN_BIT) ? -C_unfix(y) : C_unfix(y);
3039
3040   while(y != 0) {
3041     C_word r = x % y;
3042     x = y;
3043     y = r;
3044   }
3045   return C_fix(x);
3046}
3047
3048inline static C_word C_fixnum_divide(C_word x, C_word y)
3049{
3050  if(y == C_fix(0)) C_div_by_zero_error(C_text("fx/"));
3051  return C_u_fixnum_divide(x, y);
3052}
3053
3054
3055inline static C_word C_u_fixnum_modulo(C_word x, C_word y)
3056{
3057  y = C_unfix(y);
3058  x = C_unfix(x) % y;
3059  if ((y < 0 && x > 0) || (y > 0 && x < 0)) x += y;
3060  return C_fix(x);
3061}
3062
3063
3064inline static C_word C_fixnum_modulo(C_word x, C_word y)
3065{
3066  if(y == C_fix(0)) {
3067    C_div_by_zero_error(C_text("fxmod"));
3068  } else {
3069    return C_u_fixnum_modulo(x,y);
3070  }
3071}
3072
3073/* XXX: Naming convention is inconsistent!  There's C_fixnum_divide()
3074 * but also C_a_i_flonum_quotient_checked()
3075 */
3076inline static C_word
3077C_a_i_fixnum_quotient_checked(C_word **ptr, int c, C_word x, C_word y)
3078{
3079  if (y == C_fix(0)) {
3080    C_div_by_zero_error(C_text("fx/"));
3081  } else if (x == C_fix(C_MOST_NEGATIVE_FIXNUM) && y == C_fix(-1)) {
3082    return C_bignum1(ptr, 0, -C_MOST_NEGATIVE_FIXNUM); /* Special case */
3083  } else {
3084    return C_u_fixnum_divide(x, y); /* Inconsistent, too: missing _i_ */
3085  }
3086}
3087
3088inline static C_word C_i_fixnum_remainder_checked(C_word x, C_word y)
3089{
3090  if (y == C_fix(0)) {
3091    C_div_by_zero_error(C_text("fxrem"));
3092  } else {
3093    x = C_unfix(x);
3094    y = C_unfix(y);
3095    return C_fix(x - ((x / y) * y));
3096  }
3097}
3098
3099inline static C_word C_i_fixnum_arithmetic_shift(C_word n, C_word c)
3100{
3101  if(C_unfix(c) < 0) return C_fixnum_shift_right(n, C_u_fixnum_negate(c));
3102  else return C_fixnum_shift_left(n, c);
3103}
3104
3105inline static C_word C_a_i_fixnum_negate(C_word **ptr, C_word n, C_word x)
3106{
3107  /* Exceptional situation: this will cause an overflow to itself */
3108  if (x == C_fix(C_MOST_NEGATIVE_FIXNUM)) /* C_fitsinfixnump(x) */
3109    return C_bignum1(ptr, 0, -C_MOST_NEGATIVE_FIXNUM);
3110  else
3111    return C_fix(-C_unfix(x));
3112}
3113
3114inline static C_word C_s_a_u_i_integer_abs(C_word **ptr, C_word n, C_word x)
3115{
3116  if (x & C_FIXNUM_BIT) {
3117    return C_a_i_fixnum_abs(ptr, 1, x);
3118  } else if (C_bignum_negativep(x)) {
3119    return C_s_a_u_i_integer_negate(ptr, n, x);
3120  } else {
3121    return x;
3122  }
3123}
3124
3125/* DEPRECATED */
3126inline static C_word C_i_fixnum_bit_to_bool(C_word n, C_word i)
3127{
3128    if (i & C_INT_SIGN_BIT) {
3129      C_not_an_uinteger_error(C_text("bit->boolean"), i);
3130    } else {
3131      i = C_unfix(i);
3132      if (i >= C_WORD_SIZE) return C_mk_bool(n & C_INT_SIGN_BIT);
3133      else return C_mk_bool((C_unfix(n) & (C_word)((C_uword)1 << i)) != 0);
3134    }
3135}
3136
3137inline static C_word C_a_i_fixnum_difference(C_word **ptr, C_word n, C_word x, C_word y)
3138{
3139  C_word z = C_unfix(x) - C_unfix(y);
3140
3141  if(!C_fitsinfixnump(z)) {
3142    return C_bignum1(ptr, z < 0, C_wabs(z));
3143  } else {
3144    return C_fix(z);
3145  }
3146}
3147
3148inline static C_word C_a_i_fixnum_plus(C_word **ptr, C_word n, C_word x, C_word y)
3149{
3150  C_word z = C_unfix(x) + C_unfix(y);
3151
3152  if(!C_fitsinfixnump(z)) {
3153    return C_bignum1(ptr, z < 0, C_wabs(z));
3154  } else {
3155    return C_fix(z);
3156  }
3157}
3158
3159inline static C_word C_a_i_fixnum_times(C_word **ptr, C_word n, C_word x, C_word y)
3160{
3161  C_uword negp, xhi, xlo, yhi, ylo, p, rhi, rlo;
3162
3163  negp = ((x & C_INT_SIGN_BIT) ? !(y & C_INT_SIGN_BIT) : (y & C_INT_SIGN_BIT));
3164  x = (x & C_INT_SIGN_BIT) ? -C_unfix(x) : C_unfix(x);
3165  y = (y & C_INT_SIGN_BIT) ? -C_unfix(y) : C_unfix(y);
3166
3167  xhi = C_BIGNUM_DIGIT_HI_HALF(x); xlo = C_BIGNUM_DIGIT_LO_HALF(x);
3168  yhi = C_BIGNUM_DIGIT_HI_HALF(y); ylo = C_BIGNUM_DIGIT_LO_HALF(y);
3169
3170  /* This is simply bignum_digits_multiply unrolled for 2x2 halfdigits */
3171  p = xlo * ylo;
3172  rlo = C_BIGNUM_DIGIT_LO_HALF(p);
3173
3174  p = xhi * ylo + C_BIGNUM_DIGIT_HI_HALF(p);
3175  rhi = C_BIGNUM_DIGIT_HI_HALF(p);
3176
3177  p = xlo * yhi + C_BIGNUM_DIGIT_LO_HALF(p);
3178  rlo = C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(p), rlo);
3179
3180  rhi = xhi * yhi + C_BIGNUM_DIGIT_HI_HALF(p) + rhi;
3181
3182  if (rhi) {
3183    return C_bignum2(ptr, negp != 0, rlo, rhi);
3184  } else if (negp ?
3185             ((rlo & C_INT_SIGN_BIT) || !C_fitsinfixnump(-(C_word)rlo)) :
3186             !C_ufitsinfixnump(rlo)) {
3187    return C_bignum1(ptr, negp != 0, rlo);
3188  } else {
3189    return C_fix(negp ? -rlo : rlo);
3190  }
3191}
3192
3193inline static C_word C_i_flonum_min(C_word x, C_word y)
3194{
3195  double
3196    xf = C_flonum_magnitude(x),
3197    yf = C_flonum_magnitude(y);
3198
3199  return xf < yf ? x : y;
3200}
3201
3202
3203inline static C_word C_i_flonum_max(C_word x, C_word y)
3204{
3205  double
3206    xf = C_flonum_magnitude(x),
3207    yf = C_flonum_magnitude(y);
3208
3209  return xf > yf ? x : y;
3210}
3211
3212inline static C_word C_u_i_integer_signum(C_word x)
3213{
3214  if (x & C_FIXNUM_BIT) return C_i_fixnum_signum(x);
3215  else return (C_bignum_negativep(x) ? C_fix(-1) : C_fix(1));
3216}
3217
3218inline static C_word
3219C_a_i_flonum_quotient_checked(C_word **ptr, int c, C_word n1, C_word n2)
3220{
3221  double n3 = C_flonum_magnitude(n2);
3222
3223  if(n3 == 0.0) C_div_by_zero_error(C_text("fp/?"));
3224  return C_flonum(ptr, C_flonum_magnitude(n1) / n3);
3225}
3226
3227
3228inline static double
3229C_ub_i_flonum_quotient_checked(double n1, double n2)
3230{
3231  if(n2 == 0.0) C_div_by_zero_error(C_text("fp/?"));
3232  return n1 / n2;
3233}
3234
3235/* More weirdness: the other flonum_quotient macros and inline functions
3236 * do not compute the quotient but the "plain" division!
3237 */
3238inline static C_word
3239C_a_i_flonum_actual_quotient_checked(C_word **ptr, int c, C_word x, C_word y)
3240{
3241  double dy = C_flonum_magnitude(y), r;
3242
3243  if(dy == 0.0) {
3244    C_div_by_zero_error(C_text("quotient"));
3245  } else if (!C_truep(C_u_i_fpintegerp(x))) {
3246    C_not_an_integer_error(C_text("quotient"), x);
3247  } else if (!C_truep(C_u_i_fpintegerp(y))) {
3248    C_not_an_integer_error(C_text("quotient"), y);
3249  } else {
3250    modf(C_flonum_magnitude(x) / dy, &r);
3251    return C_flonum(ptr, r);
3252  }
3253}
3254
3255inline static C_word
3256C_a_i_flonum_remainder_checked(C_word **ptr, int c, C_word x, C_word y)
3257{
3258  double dx = C_flonum_magnitude(x),
3259         dy = C_flonum_magnitude(y), r;
3260
3261  if(dy == 0.0) {
3262    C_div_by_zero_error(C_text("remainder"));
3263  } else if (!C_truep(C_u_i_fpintegerp(x))) {
3264    C_not_an_integer_error(C_text("remainder"), x);
3265  } else if (!C_truep(C_u_i_fpintegerp(y))) {
3266    C_not_an_integer_error(C_text("remainder"), y);
3267  } else {
3268    modf(dx / dy, &r);
3269    return C_flonum(ptr, dx - r * dy);
3270  }
3271}
3272
3273inline static C_word
3274C_a_i_flonum_modulo_checked(C_word **ptr, int c, C_word x, C_word y)
3275{
3276  double dx = C_flonum_magnitude(x),
3277         dy = C_flonum_magnitude(y), r;
3278
3279  if(dy == 0.0) {
3280    C_div_by_zero_error(C_text("modulo"));
3281  } else if (!C_truep(C_u_i_fpintegerp(x))) {
3282    C_not_an_integer_error(C_text("modulo"), x);
3283  } else if (!C_truep(C_u_i_fpintegerp(y))) {
3284    C_not_an_integer_error(C_text("modulo"), y);
3285  } else {
3286    modf(dx / dy, &r);
3287    r = dx - r * dy;
3288    if ((dy < 0 && r > 0) || (dy > 0 && r < 0)) r += y;
3289    return C_flonum(ptr, r);
3290  }
3291}
3292
3293inline static C_word C_i_safe_pointerp(C_word x)
3294{
3295  if(C_immediatep(x)) return C_SCHEME_FALSE;
3296
3297  switch(C_block_header(x)) {
3298  case C_POINTER_TAG:
3299  case C_TAGGED_POINTER_TAG:
3300    return C_SCHEME_TRUE;
3301  }
3302
3303  return C_SCHEME_FALSE;
3304}
3305
3306
3307inline static C_word C_u_i_assq(C_word x, C_word lst)
3308{
3309  C_word a;
3310
3311  while(!C_immediatep(lst)) {
3312    a = C_u_i_car(lst);
3313
3314    if(C_u_i_car(a) == x) return a;
3315    else lst = C_u_i_cdr(lst);
3316  }
3317
3318  return C_SCHEME_FALSE;
3319}
3320
3321
3322inline static C_word
3323C_fast_retrieve(C_word sym)
3324{
3325  C_word val = C_block_item(sym, 0);
3326
3327  if(val == C_SCHEME_UNBOUND)
3328    C_unbound_variable(sym);
3329
3330  return val;
3331}
3332
3333inline static void *
3334C_fast_retrieve_proc(C_word closure)
3335{
3336  if(C_immediatep(closure) || C_header_bits(closure) != C_CLOSURE_TYPE)
3337    return (void *)C_invalid_procedure;
3338  else
3339    return (void *)C_block_item(closure, 0);
3340}
3341
3342
3343inline static void *
3344C_fast_retrieve_symbol_proc(C_word sym)
3345{
3346  return C_fast_retrieve_proc(C_fast_retrieve(sym));
3347}
3348
3349
3350inline static C_word C_a_i_vector1(C_word **ptr, int n, C_word x1)
3351{
3352  C_word *p = *ptr, *p0 = p;
3353
3354  *(p++) = C_VECTOR_TYPE | 1;
3355  *(p++) = x1;
3356  *ptr = p;
3357  return (C_word)p0;
3358}
3359
3360
3361inline static C_word C_a_i_vector2(C_word **ptr, int n, C_word x1, C_word x2)
3362{
3363  C_word *p = *ptr, *p0 = p;
3364
3365  *(p++) = C_VECTOR_TYPE | 2;
3366  *(p++) = x1;
3367  *(p++) = x2;
3368  *ptr = p;
3369  return (C_word)p0;
3370}
3371
3372
3373inline static C_word C_a_i_vector3(C_word **ptr, int n, C_word x1, C_word x2, C_word x3)
3374{
3375  C_word *p = *ptr, *p0 = p;
3376
3377  *(p++) = C_VECTOR_TYPE | 3;
3378  *(p++) = x1;
3379  *(p++) = x2;
3380  *(p++) = x3;
3381  *ptr = p;
3382  return (C_word)p0;
3383}
3384
3385
3386inline static C_word C_a_i_vector4(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4)
3387{
3388  C_word *p = *ptr, *p0 = p;
3389
3390  *(p++) = C_VECTOR_TYPE | 4;
3391  *(p++) = x1;
3392  *(p++) = x2;
3393  *(p++) = x3;
3394  *(p++) = x4;
3395  *ptr = p;
3396  return (C_word)p0;
3397}
3398
3399
3400inline static C_word C_a_i_vector5(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,
3401			      C_word x5)
3402{
3403  C_word *p = *ptr, *p0 = p;
3404
3405  *(p++) = C_VECTOR_TYPE | 5;
3406  *(p++) = x1;
3407  *(p++) = x2;
3408  *(p++) = x3;
3409  *(p++) = x4;
3410  *(p++) = x5;
3411  *ptr = p;
3412  return (C_word)p0;
3413}
3414
3415
3416inline static C_word C_a_i_vector6(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,
3417			      C_word x5, C_word x6)
3418{
3419  C_word *p = *ptr, *p0 = p;
3420
3421  *(p++) = C_VECTOR_TYPE | 6;
3422  *(p++) = x1;
3423  *(p++) = x2;
3424  *(p++) = x3;
3425  *(p++) = x4;
3426  *(p++) = x5;
3427  *(p++) = x6;
3428  *ptr = p;
3429  return (C_word)p0;
3430}
3431
3432
3433inline static C_word C_a_i_vector7(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,
3434			      C_word x5, C_word x6, C_word x7)
3435{
3436  C_word *p = *ptr, *p0 = p;
3437
3438  *(p++) = C_VECTOR_TYPE | 7;
3439  *(p++) = x1;
3440  *(p++) = x2;
3441  *(p++) = x3;
3442  *(p++) = x4;
3443  *(p++) = x5;
3444  *(p++) = x6;
3445  *(p++) = x7;
3446  *ptr = p;
3447  return (C_word)p0;
3448}
3449
3450
3451inline static C_word C_a_i_vector8(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,
3452			      C_word x5, C_word x6, C_word x7, C_word x8)
3453{
3454  C_word *p = *ptr, *p0 = p;
3455
3456  *(p++) = C_VECTOR_TYPE | 8;
3457  *(p++) = x1;
3458  *(p++) = x2;
3459  *(p++) = x3;
3460  *(p++) = x4;
3461  *(p++) = x5;
3462  *(p++) = x6;
3463  *(p++) = x7;
3464  *(p++) = x8;
3465  *ptr = p;
3466  return (C_word)p0;
3467}
3468
3469
3470inline static C_word C_a_ustring(C_word **ptr, int n, C_word bv, C_word c)
3471{
3472  C_word *p = *ptr, *p0 = p;
3473
3474  *(p++) = C_STRING_TAG;
3475  *(p++) = bv;
3476  *(p++) = c;
3477  *(p++) = C_fix(0);
3478  *(p++) = C_fix(0);
3479  *ptr = p;
3480  return (C_word)p0;
3481}
3482
3483
3484inline static C_word C_a_pair(C_word **ptr, C_word car, C_word cdr)
3485{
3486  C_word *p = *ptr, *p0 = p;
3487
3488  *(p++) = C_PAIR_TYPE | (C_SIZEOF_PAIR - 1);
3489  *(p++) = car;
3490  *(p++) = cdr;
3491  *ptr = p;
3492  return (C_word)p0;
3493}
3494
3495inline static C_word C_a_weak_pair(C_word **ptr, C_word head, C_word tail)
3496{
3497  C_word *p = *ptr, *p0 = p;
3498
3499  *(p++) = C_WEAK_PAIR_TAG; /* Changes to strong if sym is persisted */
3500  *(p++) = head;
3501  *(p++) = tail;
3502  *ptr = p;
3503  return (C_word)p0;
3504}
3505
3506
3507inline static C_word C_a_i_list1(C_word **a, int n, C_word x1)
3508{
3509  return C_a_pair(a, x1, C_SCHEME_END_OF_LIST);
3510}
3511
3512
3513inline static C_word C_a_i_list2(C_word **a, int n, C_word x1, C_word x2)
3514{
3515  C_word x = C_a_pair(a, x2, C_SCHEME_END_OF_LIST);
3516
3517  return C_a_pair(a, x1, x);
3518}
3519
3520
3521inline static C_word C_a_i_list3(C_word **a, int n, C_word x1, C_word x2, C_word x3)
3522{
3523  C_word x = C_a_pair(a, x3, C_SCHEME_END_OF_LIST);
3524
3525  x = C_a_pair(a, x2, x);
3526  return C_a_pair(a, x1, x);
3527}
3528
3529
3530inline static C_word C_a_i_list4(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4)
3531{
3532  C_word x = C_a_pair(a, x4, C_SCHEME_END_OF_LIST);
3533
3534  x = C_a_pair(a, x3, x);
3535  x = C_a_pair(a, x2, x);
3536  return C_a_pair(a, x1, x);
3537}
3538
3539
3540inline static C_word C_a_i_list5(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4,
3541			    C_word x5)
3542{
3543  C_word x = C_a_pair(a, x5, C_SCHEME_END_OF_LIST);
3544
3545  x = C_a_pair(a, x4, x);
3546  x = C_a_pair(a, x3, x);
3547  x = C_a_pair(a, x2, x);
3548  return C_a_pair(a, x1, x);
3549}
3550
3551
3552inline static C_word C_a_i_list6(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4,
3553			    C_word x5, C_word x6)
3554{
3555  C_word x = C_a_pair(a, x6, C_SCHEME_END_OF_LIST);
3556
3557  x = C_a_pair(a, x5, x);
3558  x = C_a_pair(a, x4, x);
3559  x = C_a_pair(a, x3, x);
3560  x = C_a_pair(a, x2, x);
3561  return C_a_pair(a, x1, x);
3562}
3563
3564
3565inline static C_word C_a_i_list7(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4,
3566			    C_word x5, C_word x6, C_word x7)
3567{
3568  C_word x = C_a_pair(a, x7, C_SCHEME_END_OF_LIST);
3569
3570  x = C_a_pair(a, x6, x);
3571  x = C_a_pair(a, x5, x);
3572  x = C_a_pair(a, x4, x);
3573  x = C_a_pair(a, x3, x);
3574  x = C_a_pair(a, x2, x);
3575  return C_a_pair(a, x1, x);
3576}
3577
3578
3579inline static C_word C_a_i_list8(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4,
3580			    C_word x5, C_word x6, C_word x7, C_word x8)
3581{
3582  C_word x = C_a_pair(a, x8, C_SCHEME_END_OF_LIST);
3583
3584  x = C_a_pair(a, x7, x);
3585  x = C_a_pair(a, x6, x);
3586  x = C_a_pair(a, x5, x);
3587  x = C_a_pair(a, x4, x);
3588  x = C_a_pair(a, x3, x);
3589  x = C_a_pair(a, x2, x);
3590  return C_a_pair(a, x1, x);
3591}
3592
3593
3594/*
3595 * From Hacker's Delight by Henry S. Warren
3596 * based on a modified nlz() from section 5-3 (fig. 5-7)
3597 */
3598inline static int C_ilen(C_uword x)
3599{
3600  C_uword y;
3601  C_word n = 0;
3602
3603#ifdef C_SIXTY_FOUR
3604  y = x >> 32; if (y != 0) { n += 32; x = y; }
3605#endif
3606  y = x >> 16; if (y != 0) { n += 16; x = y; }
3607  y = x >>  8; if (y != 0) { n +=  8; x = y; }
3608  y = x >>  4; if (y != 0) { n +=  4; x = y; }
3609  y = x >>  2; if (y != 0) { n +=  2; x = y; }
3610  y = x >>  1; if (y != 0) return n + 2;
3611  return n + x;
3612}
3613
3614/* These strl* functions are based on public domain code by C.B. Falconer */
3615#ifdef HAVE_STRLCPY
3616# define C_strlcpy                  strlcpy
3617#else
3618inline static size_t C_strlcpy(char *dst, const char *src, size_t sz)
3619{
3620   const char *start = src;
3621
3622   if (sz--) {
3623      while ((*dst++ = *src))
3624         if (sz--) src++;
3625         else {
3626            *(--dst) = '\0';
3627            break;
3628         }
3629   }
3630   while (*src++) continue;
3631   return src - start - 1;
3632}
3633#endif
3634
3635#ifdef HAVE_STRLCAT
3636# define C_strlcat                  strlcat
3637#else
3638inline static size_t C_strlcat(char *dst, const char *src, size_t sz)
3639{
3640   char  *start = dst;
3641
3642   while (*dst++)    /* assumes sz >= strlen(dst) */
3643      if (sz) sz--;    /* i.e. well formed string */
3644   dst--;
3645   return dst - start + C_strlcpy(dst, src, sz);
3646}
3647#endif
3648
3649/*
3650 * MinGW's stat() is less than ideal in a couple of ways, so we provide a
3651 * wrapper that:
3652 *
3653 *  1. Strips all trailing slashes and retries on failure, since stat() will
3654 *     yield ENOENT when given two (on MSYS) or more (on MinGW and MSYS2).
3655 *  2. Fails with ENOTDIR when given a path to a non-directory file that ends
3656 *     in a slash, since in this case MinGW's stat() will succeed but return a
3657 *     non-directory mode in buf.st_mode.
3658 */
3659#if defined(__MINGW32__)
3660inline static int C_stat(const C_WCHAR *path, struct _stat64i32 *buf)
3661{
3662  size_t len = wcslen(path);
3663  C_WCHAR slash = len && wcschr(L"\\/", path[len - 1]), *str;
3664
3665  if(_wstat(path, buf) == 0)
3666    goto dircheck;
3667
3668  if(slash && errno == ENOENT) {
3669    C_memcpy((str = (C_WCHAR *)C_alloca((len + 1) * sizeof(C_WCHAR))), path,
3670      (len + 1) * sizeof(C_WCHAR));
3671    while(len > 1 && wcschr(L"\\/", path[--len]))
3672      str[len] = '\0';
3673    if(_wstat(str, buf) == 0)
3674      goto dircheck;
3675  }
3676
3677  return -1;
3678
3679dircheck:
3680  if(slash && !S_ISDIR(buf->st_mode)) {
3681    errno = ENOTDIR;
3682    return -1;
3683  }
3684
3685  return 0;
3686}
3687/*
3688 * Haiku's stat() has a similar issue, where it will gladly succeed
3689 * when given a path to a filename with a trailing slash.
3690 */
3691#elif defined(__HAIKU__)
3692inline static int C_stat(const char *path, struct stat *buf)
3693{
3694  size_t len = C_strlen(path);
3695  char slash = len && path[len - 1] == '/';
3696
3697  if(stat(path, buf) != 0) {
3698    return -1;
3699  }
3700
3701  if (slash && !S_ISDIR(buf->st_mode)) {
3702    errno = ENOTDIR;
3703    return -1;
3704  }
3705
3706  return 0;
3707}
3708#else
3709# define C_stat stat
3710#endif
3711
3712/* Safe realpath usage depends on a reliable PATH_MAX. */
3713#ifdef PATH_MAX
3714# define C_realpath realpath
3715#else
3716inline static char *C_realpath(const char *path, char *resolved)
3717{
3718# if _POSIX_C_SOURCE >= 200809L
3719  char *p;
3720  size_t n;
3721  if((p = realpath(path, NULL)) == NULL)
3722    return NULL;
3723  n = C_strlcpy(resolved, p, C_MAX_PATH);
3724  C_free(p);
3725  if(n < C_MAX_PATH)
3726    return resolved;
3727# endif
3728  return NULL;
3729}
3730#endif
3731
3732C_END_C_DECLS
3733
3734#endif /* ___CHICKEN */
Trap