~ chicken-core (chicken-5) /chicken.h
Trap1/* chicken.h - General headerfile for compiler generated executables2;3; Copyright (c) 2008-2022, The CHICKEN Team4; Copyright (c) 2000-2007, Felix L. Winkelmann5; All rights reserved.6;7; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following8; conditions are met:9;10; Redistributions of source code must retain the above copyright notice, this list of conditions and the following11; disclaimer.12; Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following13; 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 promote15; 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 EXPRESS18; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY19; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR20; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR21; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR22; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY23; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR24; OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE25; POSSIBILITY OF SUCH DAMAGE.26*/2728/* Configuration: */2930#ifndef ___CHICKEN31#define ___CHICKEN3233#define C_MAJOR_VERSION 534#define C_MINOR_VERSION 43536#ifndef _ISOC99_SOURCE37# define _ISOC99_SOURCE38#endif3940#ifndef __C99FEATURES__41# define __C99FEATURES__42#endif4344/*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#endif5051/* Some OSes really dislike feature macros for standard levels */52#ifdef C_USE_STD_FEATURE_MACROS5354# ifndef _XOPEN_SOURCE55# define _XOPEN_SOURCE 70056# endif5758# ifndef _BSD_SOURCE59# define _BSD_SOURCE60# endif6162# ifndef _NETBSD_SOURCE63# define _NETBSD_SOURCE64# endif6566# ifndef _SVID_SOURCE67# define _SVID_SOURCE68# endif6970/*71 * glibc >= 2.20 synonym for _BSD_SOURCE & _SVID_SOURCE.72 */73# ifndef _DEFAULT_SOURCE74# define _DEFAULT_SOURCE75# endif7677#endif /* C_USE_STD_FEATURE_MACROS */7879/* Kind of platform */8081#if defined(__LP64__) || defined(_LP64) || defined(__MINGW64__) || defined(_WIN64)82# define C_SIXTY_FOUR83#endif8485#if defined(__APPLE__) && defined(__MACH__)86# define C_MACOSX87#endif8889#if defined(C_MACOSX) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__DragonFly__) || defined(__OpenBSD__)90# define C_XXXBSD91#endif9293#if /*defined(__GNUC__) &&*/ (defined(__linux__) || defined(C_XXXBSD) || defined(__HAIKU__))94# define C_GNU_ENV95#endif9697#if defined(__MINGW32__)98/*99 * XXX This should probably be renamed or changed because it's misleading.100 * For example, Haiku is not a Unix either, but this doesn't get defined there.101 */102# define C_NONUNIX103#endif104105#if defined(__sun) && defined(__SVR4)106# define C_SOLARIS107#endif108109#if defined(__MINGW64__) || defined(_WIN64)110# define C_LLP111#endif112113/* Declare base Win32 version: we require Vista or later */114115#ifdef __MINGW32__116# define _WIN32_WINNT 0x0600117#endif118119120/* Headers */121122#include <ctype.h>123#include <errno.h>124#include <inttypes.h>125#include <limits.h>126#include <math.h>127#include <setjmp.h>128#include <stdarg.h>129#include <stddef.h>130#include <stdio.h>131#include <stdlib.h>132#include <string.h>133#include <time.h>134#include <unistd.h>135#include <sys/types.h>136#include <sys/stat.h>137138139/* Byteorder in machine word */140141#if defined(__MINGW32__)142# include <sys/param.h>143#elif defined(__CYGWIN__)144# include <endian.h>145#elif defined(__linux__)146# include <endian.h>147#elif defined(C_XXXBSD)148# include <machine/endian.h>149#elif defined(__hpux__)150# include <arpa/nameser.h>151#elif defined(_AIX)152# include <sys/machine.h>153#elif defined(__sun)154# include <sys/isa_defs.h>155#elif defined(__SVR4)156# include <sys/byteorder.h>157#endif158159#if defined(__MINGW32__)160# include <malloc.h>161#endif162163/* Much better with stack allocation API */164165#ifdef HAVE_ALLOCA_H166# include <alloca.h>167#elif !defined(alloca) /* predefined by HP cc +Olibcalls */168void *alloca ();169#endif170171172/* CHICKEN Core C API */173174#if defined(__BYTE_ORDER) && __BYTE_ORDER == __BIG_ENDIAN175# define C_BIG_ENDIAN176#elif defined(BYTE_ORDER) && defined(BIG_ENDIAN) && BYTE_ORDER == BIG_ENDIAN177# define C_BIG_ENDIAN178#elif defined(__BIG_ENDIAN__)179# define C_BIG_ENDIAN180#elif defined(__MIPSEL__) || defined(__MIPSEL)181# define C_LITTLE_ENDIAN182#elif defined(__sparc__) || defined(__POWERPC__) || defined(__MC68K__) || defined(__mips__)183# define C_BIG_ENDIAN184#endif185186#if defined(__BYTE_ORDER) && defined(__LITTLE_ENDIAN) && __BYTE_ORDER == __LITTLE_ENDIAN187# define C_LITTLE_ENDIAN188#elif defined(BYTE_ORDER) && defined(LITTLE_ENDIAN) && BYTE_ORDER == LITTLE_ENDIAN189# define C_LITTLE_ENDIAN190#elif defined(__LITTLE_ENDIAN__)191# define C_LITTLE_ENDIAN192#elif defined (__alpha__) || defined(_M_IX86) || defined(__i386__) || defined(__x86_64__) || defined(__ia64__)193# define C_LITTLE_ENDIAN194#endif195196/* Make sure some common C identifiers are availble w/ Windows */197198/* Could be used by C++ source */199200#ifdef __cplusplus201# define C_extern extern "C"202# define C_BEGIN_C_DECLS extern "C" {203# define C_END_C_DECLS }204#else205# define C_extern extern206# define C_BEGIN_C_DECLS207# define C_END_C_DECLS208#endif209210211/* Function declaration modes */212213/* Visibility */214#define C_varextern C_extern215#define C_fctimport216#define C_fctexport217#define C_externimport C_extern218#define C_externexport C_extern219#if defined(PIC)220# if defined(__CYGWIN__) || defined(__MINGW32__)221# ifndef C_BUILDING_LIBCHICKEN222# undef C_varextern223# define C_varextern C_extern __declspec(dllimport)224# endif225# endif226#endif227228/* Language specifics: */229#if defined(__GNUC__) || defined(__INTEL_COMPILER)230#define HAVE_STATEMENT_EXPRESSIONS 1231#endif232233#if !defined(__clang__) && !defined(__has_attribute)234/* Define so it won't error on other compilers with keywords like "noreturn" */235#define __has_attribute(x) 0236#endif237238#if defined(__GNUC__) || defined(__INTEL_COMPILER)239# define C_unlikely(x) __builtin_expect((x), 0)240# define C_likely(x) __builtin_expect((x), 1)241# ifndef __cplusplus242# define C_cblock ({243# define C_cblockend })244# if defined(__clang__) && !__has_attribute(noreturn)245# define C_noret246# else247# define C_noret __attribute__ ((noreturn))248# endif249# define C_noret_decl(name)250# define C_aligned __attribute__ ((aligned))251# endif252# if defined(__i386__) && !defined(__clang__)253# define C_regparm __attribute__ ((regparm(3)))254# endif255#else256# define C_unlikely(x) (x)257# define C_likely(x) (x)258#endif259260#ifndef C_cblock261# define C_cblock do{262# define C_cblockend }while(0)263# define C_noret264# define C_noret_decl(name)265#endif266267#ifndef C_regparm268# define C_regparm269#endif270271#ifndef C_fcall272# define C_fcall273#endif274275#ifndef C_ccall276# define C_ccall277#endif278279#ifndef C_aligned280# define C_aligned281#endif282283/* Thread Local Storage */284#ifdef C_ENABLE_TLS285# if defined(__GNUC__)286# define C_TLS __thread287# endif288#endif289290#ifndef C_TLS291# define C_TLS292#endif293294295/* Stack growth direction; used to compute stack addresses */296#ifndef C_STACK_GROWS_DOWNWARD297# ifdef __hppa__298# define C_STACK_GROWS_DOWNWARD 0299# else300# define C_STACK_GROWS_DOWNWARD 1301# endif302#endif303304/* Have a GUI? */305306#if defined(C_GUI) || defined(C_PRIVATE_REPOSITORY)307# ifdef _WIN32308# include <windows.h>309# ifndef WINAPI310# define WINAPI311# endif312# endif313#endif314315/* Needed for pre-emptive threading */316317#define C_TIMER_INTERRUPTS318319320/* Constants: */321322#define C_STACK_RESERVE 0x10000323#define C_DEFAULT_MAX_PENDING_FINALIZERS 2048324325#define C_IMMEDIATE_MARK_BITS 0x00000003326#define C_IMMEDIATE_TYPE_BITS 0x0000000f327328#define C_BOOLEAN_BITS 0x00000006329#define C_CHARACTER_BITS 0x0000000a330#define C_SPECIAL_BITS 0x0000000e331332#define C_SCHEME_FALSE ((C_word)(C_BOOLEAN_BITS | 0x00000000))333#define C_SCHEME_TRUE ((C_word)(C_BOOLEAN_BITS | 0x00000010))334335#define C_SCHEME_END_OF_LIST ((C_word)(C_SPECIAL_BITS | 0x00000000))336#define C_SCHEME_UNDEFINED ((C_word)(C_SPECIAL_BITS | 0x00000010))337#define C_SCHEME_UNBOUND ((C_word)(C_SPECIAL_BITS | 0x00000020))338#define C_SCHEME_END_OF_FILE ((C_word)(C_SPECIAL_BITS | 0x00000030))339#define C_SCHEME_BROKEN_WEAK_PTR ((C_word)(C_SPECIAL_BITS | 0x00000040))340341#define C_FIXNUM_BIT 0x00000001342#define C_FIXNUM_SHIFT 1343344/* Character range is that of a UTF-8 codepoint, not representable range */345#define C_CHAR_BIT_MASK 0x1fffff346#define C_CHAR_SHIFT 8347348#ifdef C_SIXTY_FOUR349# define C_MOST_POSITIVE_FIXNUM 0x3fffffffffffffffL350# define C_WORD_SIZE 64351# define C_HALF_WORD_SIZE 32352#else353# define C_MOST_POSITIVE_FIXNUM 0x3fffffff354# define C_WORD_SIZE 32355# define C_HALF_WORD_SIZE 16356#endif357358/* Tunable performance-related constants */359#ifndef C_KARATSUBA_THRESHOLD360/* This defines when we'll switch from schoolbook to Karatsuba361 * multiplication. The smallest of the two numbers determines the362 * switch. It is pretty high right now because it generates a bit363 * more garbage and GC overhead dominates the algorithmic performance364 * gains. If the GC is improved, this can be readjusted.365 */366# define C_KARATSUBA_THRESHOLD 70367#endif368#ifndef C_BURNIKEL_ZIEGLER_THRESHOLD369/* This defines when to switch from schoolbook to Burnikel-Ziegler370 * division. It creates even more garbage than Karatsuba :(371 */372# define C_BURNIKEL_ZIEGLER_THRESHOLD 300373#endif374#ifndef C_RECURSIVE_TO_STRING_THRESHOLD375/* This threshold is in terms of the expected string length. */376# define C_RECURSIVE_TO_STRING_THRESHOLD 750377#endif378379/* These might fit better in runtime.c? */380#define C_fitsinbignumhalfdigitp(n) (C_BIGNUM_DIGIT_HI_HALF(n) == 0)381#define C_BIGNUM_DIGIT_LENGTH C_WORD_SIZE382#define C_BIGNUM_HALF_DIGIT_LENGTH C_HALF_WORD_SIZE383#define C_BIGNUM_BITS_TO_DIGITS(n) \384 (((n) + (C_BIGNUM_DIGIT_LENGTH - 1)) / C_BIGNUM_DIGIT_LENGTH)385#define C_BIGNUM_DIGIT_LO_HALF(d) (C_uhword)(d)386#define C_BIGNUM_DIGIT_HI_HALF(d) (C_uhword)((d) >> C_BIGNUM_HALF_DIGIT_LENGTH)387#define C_BIGNUM_DIGIT_COMBINE(h,l) ((C_uword)(h) << C_BIGNUM_HALF_DIGIT_LENGTH|(C_uhword)(l))388389#define C_MOST_POSITIVE_32_BIT_FIXNUM 0x3fffffff390#define C_MOST_NEGATIVE_FIXNUM (-C_MOST_POSITIVE_FIXNUM - 1)391392#ifdef C_SIXTY_FOUR393# define C_INT_SIGN_BIT 0x8000000000000000L394# define C_INT_TOP_BIT 0x4000000000000000L395# define C_HEADER_BITS_MASK 0xff00000000000000L396# define C_HEADER_TYPE_BITS 0x0f00000000000000L397# define C_HEADER_SIZE_MASK 0x00ffffffffffffffL398# define C_GC_FORWARDING_BIT 0x8000000000000000L /* header contains forwarding pointer */399# define C_BYTEBLOCK_BIT 0x4000000000000000L /* block contains bytes instead of slots */400# define C_SPECIALBLOCK_BIT 0x2000000000000000L /* 1st item is a non-value */401# define C_8ALIGN_BIT 0x1000000000000000L /* data is aligned to 8-byte boundary */402403# define C_SYMBOL_TYPE (0x0100000000000000L)404# define C_STRING_TYPE (0x0200000000000000L | C_BYTEBLOCK_BIT)405# define C_PAIR_TYPE (0x0300000000000000L)406# define C_CLOSURE_TYPE (0x0400000000000000L | C_SPECIALBLOCK_BIT)407# define C_FLONUM_TYPE (0x0500000000000000L | C_BYTEBLOCK_BIT | C_8ALIGN_BIT)408# define C_BIGNUM_TYPE (0x0600000000000000L) /* Just the wrapper */409# define C_PORT_TYPE (0x0700000000000000L | C_SPECIALBLOCK_BIT)410# define C_STRUCTURE_TYPE (0x0800000000000000L)411# define C_POINTER_TYPE (0x0900000000000000L | C_SPECIALBLOCK_BIT)412# define C_LOCATIVE_TYPE (0x0a00000000000000L | C_SPECIALBLOCK_BIT)413# define C_TAGGED_POINTER_TYPE (0x0b00000000000000L | C_SPECIALBLOCK_BIT)414# define C_RATNUM_TYPE (0x0c00000000000000L)415# define C_LAMBDA_INFO_TYPE (0x0d00000000000000L | C_BYTEBLOCK_BIT)416# define C_CPLXNUM_TYPE (0x0e00000000000000L)417/* unused (0x0f00000000000000L ...) */418#else419# define C_INT_SIGN_BIT 0x80000000420# define C_INT_TOP_BIT 0x40000000421# define C_HEADER_BITS_MASK 0xff000000422# define C_HEADER_TYPE_BITS 0x0f000000423# define C_HEADER_SIZE_MASK 0x00ffffff424# define C_GC_FORWARDING_BIT 0x80000000425# define C_BYTEBLOCK_BIT 0x40000000426# define C_SPECIALBLOCK_BIT 0x20000000427# define C_8ALIGN_BIT 0x10000000428429# define C_SYMBOL_TYPE (0x01000000)430# define C_STRING_TYPE (0x02000000 | C_BYTEBLOCK_BIT)431# define C_PAIR_TYPE (0x03000000)432# define C_CLOSURE_TYPE (0x04000000 | C_SPECIALBLOCK_BIT)433# ifdef C_DOUBLE_IS_32_BITS434# define C_FLONUM_TYPE (0x05000000 | C_BYTEBLOCK_BIT)435# else436# define C_FLONUM_TYPE (0x05000000 | C_BYTEBLOCK_BIT | C_8ALIGN_BIT)437# endif438# define C_BIGNUM_TYPE (0x06000000) /* Just the wrapper */439# define C_PORT_TYPE (0x07000000 | C_SPECIALBLOCK_BIT)440# define C_STRUCTURE_TYPE (0x08000000)441# define C_POINTER_TYPE (0x09000000 | C_SPECIALBLOCK_BIT)442# define C_LOCATIVE_TYPE (0x0a000000 | C_SPECIALBLOCK_BIT)443# define C_TAGGED_POINTER_TYPE (0x0b000000 | C_SPECIALBLOCK_BIT)444# define C_RATNUM_TYPE (0x0c000000)445# define C_LAMBDA_INFO_TYPE (0x0d000000 | C_BYTEBLOCK_BIT)446# define C_CPLXNUM_TYPE (0x0e000000)447/* unused (0x0f000000 ...) */448#endif449#define C_VECTOR_TYPE 0x00000000450#define C_BYTEVECTOR_TYPE (C_VECTOR_TYPE | C_BYTEBLOCK_BIT | C_8ALIGN_BIT)451452#define C_SIZEOF_LIST(n) ((n) * 3 + 1)453#define C_SIZEOF_PAIR 3454#define C_SIZEOF_STRING(n) (C_bytestowords(n) + 2)455#define C_SIZEOF_SYMBOL 4456#define C_SIZEOF_INTERNED_SYMBOL(n) (C_SIZEOF_SYMBOL + C_SIZEOF_PAIR + C_SIZEOF_STRING(n))457#ifdef C_DOUBLE_IS_32_BITS458# define C_SIZEOF_FLONUM 2459#else460# define C_SIZEOF_FLONUM 4461#endif462#define C_SIZEOF_POINTER 2463#define C_SIZEOF_TAGGED_POINTER 3464#define C_SIZEOF_VECTOR(n) ((n) + 1)465#define C_SIZEOF_LOCATIVE 5466#define C_SIZEOF_PORT 16467#define C_SIZEOF_RATNUM 3468#define C_SIZEOF_CPLXNUM 3469#define C_SIZEOF_STRUCTURE(n) ((n)+1)470#define C_SIZEOF_CLOSURE(n) ((n)+1)471#define C_SIZEOF_BYTEVECTOR C_SIZEOF_STRING472#define C_SIZEOF_INTERNAL_BIGNUM_VECTOR(n) (C_SIZEOF_VECTOR((n)+1))473#define C_internal_bignum_vector(b) (C_block_item(b,0))474475/* This is for convenience and allows flexibility in representation */476#define C_SIZEOF_FIX_BIGNUM C_SIZEOF_BIGNUM(1)477#define C_SIZEOF_BIGNUM_WRAPPER 2478#define C_SIZEOF_BIGNUM(n) (C_SIZEOF_INTERNAL_BIGNUM_VECTOR(n)+C_SIZEOF_BIGNUM_WRAPPER)479480/* Fixed size types have pre-computed header tags */481#define C_PAIR_TAG (C_PAIR_TYPE | (C_SIZEOF_PAIR - 1))482#define C_WEAK_PAIR_TAG (C_PAIR_TAG | C_SPECIALBLOCK_BIT)483#define C_POINTER_TAG (C_POINTER_TYPE | (C_SIZEOF_POINTER - 1))484#define C_LOCATIVE_TAG (C_LOCATIVE_TYPE | (C_SIZEOF_LOCATIVE - 1))485#define C_TAGGED_POINTER_TAG (C_TAGGED_POINTER_TYPE | (C_SIZEOF_TAGGED_POINTER - 1))486#define C_SYMBOL_TAG (C_SYMBOL_TYPE | (C_SIZEOF_SYMBOL - 1))487#define C_FLONUM_TAG (C_FLONUM_TYPE | sizeof(double))488#define C_BIGNUM_TAG (C_BIGNUM_TYPE | 1)489#define C_RATNUM_TAG (C_RATNUM_TYPE | 2)490#define C_CPLXNUM_TAG (C_CPLXNUM_TYPE | 2)491492/* Locative subtypes */493#define C_SLOT_LOCATIVE 0494#define C_CHAR_LOCATIVE 1495#define C_U8_LOCATIVE 2496#define C_S8_LOCATIVE 3497#define C_U16_LOCATIVE 4498#define C_S16_LOCATIVE 5499#define C_U32_LOCATIVE 6500#define C_S32_LOCATIVE 7501#define C_U64_LOCATIVE 8502#define C_S64_LOCATIVE 9503#define C_F32_LOCATIVE 10504#define C_F64_LOCATIVE 11505506#if defined (__MINGW32__)507# define C_s64 __int64508# define C_u64 unsigned __int64509#else510# define C_s64 int64_t511# define C_u64 uint64_t512#endif513514#ifdef C_SIXTY_FOUR515# ifdef C_LLP516# define C_word C_s64517# define C_hword long518# else519# define C_word long520# define C_hword int521# endif522# define C_u32 uint32_t523# define C_s32 int32_t524#else525# define C_word int526# define C_hword short527# define C_u32 unsigned int528# define C_s32 int529#endif530531#define C_char char532#define C_uchar unsigned C_char533#define C_byte char534#define C_uword unsigned C_word535#define C_uhword unsigned C_hword536#define C_header C_uword537538/* if all else fails, use these:539 #define UINT64_MAX (18446744073709551615ULL)540 #define INT64_MAX (9223372036854775807LL)541 #define INT64_MIN (-INT64_MAX - 1)542 #define UINT32_MAX (4294967295U)543 #define INT32_MAX (2147483647)544 #define INT32_MIN (-INT32_MAX - 1)545 #define UINT16_MAX (65535U)546 #define INT16_MAX (32767)547 #define INT16_MIN (-INT16_MAX - 1)548 #define UINT8_MAX (255)549 #define INT8_MAX (127)550 #define INT8_MIN (-INT8_MAX - 1)551*/552553#define C_U64_MAX UINT64_MAX554#define C_S64_MIN INT64_MIN555#define C_S64_MAX INT64_MAX556557#if defined(C_LLP)558# define C_wabs llabs559# define C_long C_s64560# ifndef LONG_LONG_MAX561# define C_LONG_MAX LLONG_MAX562# define C_LONG_MIN LLONG_MIN563# else564# define C_LONG_MAX LONG_LONG_MAX565# define C_LONG_MIN LONG_LONG_MIN566# endif567#else568# define C_wabs labs569# define C_long long570# define C_LONG_MAX LONG_MAX571# define C_LONG_MIN LONG_MIN572#endif573574#define C_ulong unsigned C_long575576#ifdef __cplusplus577# define C_text(x) ((C_char *)(x))578#else579# define C_text(x) (x)580#endif581582#define C_TIMER_INTERRUPT_NUMBER 255583584#define C_BAD_ARGUMENT_COUNT_ERROR 1585#define C_BAD_MINIMUM_ARGUMENT_COUNT_ERROR 2586#define C_BAD_ARGUMENT_TYPE_ERROR 3587#define C_UNBOUND_VARIABLE_ERROR 4588#define C_BAD_ARGUMENT_TYPE_NO_KEYWORD_ERROR 5589#define C_OUT_OF_MEMORY_ERROR 6590#define C_DIVISION_BY_ZERO_ERROR 7591#define C_OUT_OF_RANGE_ERROR 8592#define C_NOT_A_CLOSURE_ERROR 9593#define C_CONTINUATION_CANT_RECEIVE_VALUES_ERROR 10594#define C_BAD_ARGUMENT_TYPE_CYCLIC_LIST_ERROR 11595#define C_TOO_DEEP_RECURSION_ERROR 12596#define C_CANT_REPRESENT_INEXACT_ERROR 13597#define C_NOT_A_PROPER_LIST_ERROR 14598#define C_BAD_ARGUMENT_TYPE_NO_FIXNUM_ERROR 15599#define C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR 16600#define C_BAD_ARGUMENT_TYPE_NO_STRING_ERROR 17601#define C_BAD_ARGUMENT_TYPE_NO_PAIR_ERROR 18602#define C_BAD_ARGUMENT_TYPE_NO_LIST_ERROR 19603#define C_BAD_ARGUMENT_TYPE_NO_CHAR_ERROR 20604#define C_BAD_ARGUMENT_TYPE_NO_VECTOR_ERROR 21605#define C_BAD_ARGUMENT_TYPE_NO_SYMBOL_ERROR 22606#define C_STACK_OVERFLOW_ERROR 23607#define C_BAD_ARGUMENT_TYPE_BAD_STRUCT_ERROR 24608#define C_BAD_ARGUMENT_TYPE_NO_BYTEVECTOR_ERROR 25609#define C_LOST_LOCATIVE_ERROR 26610#define C_BAD_ARGUMENT_TYPE_NO_BLOCK_ERROR 27611#define C_BAD_ARGUMENT_TYPE_NO_NUMBER_VECTOR_ERROR 28612#define C_BAD_ARGUMENT_TYPE_NO_INTEGER_ERROR 29613#define C_BAD_ARGUMENT_TYPE_NO_UINTEGER_ERROR 30614#define C_BAD_ARGUMENT_TYPE_NO_POINTER_ERROR 31615#define C_BAD_ARGUMENT_TYPE_NO_TAGGED_POINTER_ERROR 32616#define C_BAD_ARGUMENT_TYPE_NO_FLONUM_ERROR 33617#define C_BAD_ARGUMENT_TYPE_NO_CLOSURE_ERROR 34618#define C_BAD_ARGUMENT_TYPE_BAD_BASE_ERROR 35619#define C_CIRCULAR_DATA_ERROR 36620#define C_BAD_ARGUMENT_TYPE_NO_BOOLEAN_ERROR 37621#define C_BAD_ARGUMENT_TYPE_NO_LOCATIVE_ERROR 38622#define C_BAD_ARGUMENT_TYPE_NO_PORT_ERROR 39623#define C_BAD_ARGUMENT_TYPE_PORT_DIRECTION_ERROR 40624#define C_BAD_ARGUMENT_TYPE_PORT_NO_INPUT_ERROR 41625#define C_BAD_ARGUMENT_TYPE_PORT_NO_OUTPUT_ERROR 42626#define C_PORT_CLOSED_ERROR 43627#define C_ASCIIZ_REPRESENTATION_ERROR 44628#define C_MEMORY_VIOLATION_ERROR 45629#define C_FLOATING_POINT_EXCEPTION_ERROR 46630#define C_ILLEGAL_INSTRUCTION_ERROR 47631#define C_BUS_ERROR 48632#define C_BAD_ARGUMENT_TYPE_NO_EXACT_ERROR 49633#define C_BAD_ARGUMENT_TYPE_NO_INEXACT_ERROR 50634#define C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR 51635#define C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR 52636#define C_BAD_ARGUMENT_TYPE_NO_EXACT_INTEGER_ERROR 53637#define C_BAD_ARGUMENT_TYPE_FOREIGN_LIMITATION 54638#define C_BAD_ARGUMENT_TYPE_COMPLEX_ABS 55639#define C_REST_ARG_OUT_OF_BOUNDS_ERROR 56640641/* Platform information */642#if defined(C_BIG_ENDIAN)643# define C_MACHINE_BYTE_ORDER "big-endian"644#elif defined(C_LITTLE_ENDIAN)645# define C_MACHINE_BYTE_ORDER "little-endian"646#endif647648#if defined(__alpha__)649# define C_MACHINE_TYPE "alpha"650#elif defined(__mips__)651# define C_MACHINE_TYPE "mips"652#elif defined(__hppa__)653# define C_MACHINE_TYPE "hppa"654#elif defined(__sparc_v9__) || defined(__sparcv9)655# define C_MACHINE_TYPE "ultrasparc"656#elif defined(__sparc__)657# define C_MACHINE_TYPE "sparc"658#elif defined(__powerpc64__) || defined(_ARCH_PPC64)659# define C_MACHINE_TYPE "ppc64"660#elif defined(__ppc__) || defined(__powerpc__) || defined(_ARCH_PPC)661# define C_MACHINE_TYPE "ppc"662#elif defined(_M_IX86) || defined(__i386__)663# define C_MACHINE_TYPE "x86"664#elif defined(__ia64__)665# define C_MACHINE_TYPE "ia64"666#elif defined(__x86_64__)667# define C_MACHINE_TYPE "x86-64"668#elif defined(__riscv)669# if defined(__LP64__) || defined(_LP64)670# define C_MACHINE_TYPE "riscv64"671# else672# define C_MACHINE_TYPE "riscv"673# endif674#elif defined(__arm64__) || defined(__aarch64__)675# define C_MACHINE_TYPE "arm64"676#elif defined(__arm__)677# define C_MACHINE_TYPE "arm"678#else679# define C_MACHINE_TYPE "unknown"680#endif681682#if defined(__CYGWIN__) || defined(__MINGW32__) || defined(_WIN32) || defined(__WINNT__)683# define C_SOFTWARE_TYPE "windows"684#elif defined(__ANDROID__)685# define C_SOFTWARE_TYPE "android"686#elif defined(__unix__) || defined(C_XXXBSD) || defined(_AIX)687# define C_SOFTWARE_TYPE "unix"688#elif defined(ECOS)689# define C_SOFTWARE_TYPE "ecos"690#else691# define C_SOFTWARE_TYPE "unknown"692#endif693694#if defined(__SUNPRO_C)695# define C_BUILD_PLATFORM "sun"696#elif defined(__clang__)697# define C_BUILD_PLATFORM "clang"698#elif defined(_AIX)699# define C_BUILD_PLATFORM "aix"700#elif defined(__GNUC__)701# define C_BUILD_PLATFORM "gnu"702#elif defined(__INTEL_COMPILER)703# define C_BUILD_PLATFORM "intel"704#else705# define C_BUILD_PLATFORM "unknown"706#endif707708#if defined(__linux__)709# define C_SOFTWARE_VERSION "linux"710#elif defined(__FreeBSD__)711# define C_SOFTWARE_VERSION "freebsd"712#elif defined(__NetBSD__)713# define C_SOFTWARE_VERSION "netbsd"714#elif defined(__OpenBSD__)715# define C_SOFTWARE_VERSION "openbsd"716#elif defined(C_MACOSX)717# define C_SOFTWARE_VERSION "macosx"718#elif defined(__hpux__)719# define C_SOFTWARE_VERSION "hpux"720#elif defined(__DragonFly__)721# define C_SOFTWARE_VERSION "dragonfly"722#elif defined(__HAIKU__)723# define C_SOFTWARE_VERSION "haiku"724#elif defined(__sun)725# if defined(__SVR4)726# define C_SOFTWARE_VERSION "solaris"727# else728# define C_SOFTWARE_VERSION "sunos"729# endif730#elif defined(_AIX)731# define C_SOFTWARE_VERSION "aix"732#elif defined(__GNU__)733# define C_SOFTWARE_VERSION "hurd"734#elif defined(__CYGWIN__)735# define C_SOFTWARE_VERSION "cygwin"736#elif defined(__MINGW32__)737# define C_SOFTWARE_VERSION "mingw32"738#else739# define C_SOFTWARE_VERSION "unknown"740#endif741742/* There is no PATH_MAX in The Hurd. */743#ifdef PATH_MAX744# define C_MAX_PATH PATH_MAX745#else746# define C_MAX_PATH 1024747#endif748749#define C_RANDOM_STATE_SIZE (16 * sizeof(C_uword))750751/* Types: */752753typedef struct C_block_struct754{755 C_header header;756 C_word data[];757} C_SCHEME_BLOCK;758759typedef struct C_symbol_table_struct760{761 char *name;762 unsigned int size;763 unsigned int rand;764 C_word *table;765 struct C_symbol_table_struct *next;766} C_SYMBOL_TABLE;767768typedef struct C_gc_root_struct769{770 C_word value;771 struct C_gc_root_struct *next, *prev;772 int finalizable;773} C_GC_ROOT;774775typedef struct C_ptable_entry_struct776{777 C_char *id;778 void *ptr;779} C_PTABLE_ENTRY;780781typedef void (C_ccall *C_proc)(C_word, C_word *) C_noret;782783784/* Macros: */785786#define C_cpsproc(name) C_ccall void name(C_word c, C_word *av) C_noret787788#define CHICKEN_gc_root_ref(root) (((C_GC_ROOT *)(root))->value)789#define CHICKEN_gc_root_set(root, x) C_mutate(&((C_GC_ROOT *)(root))->value, (x))790791#define CHICKEN_global_ref(root) C_u_i_car(((C_GC_ROOT *)(root))->value)792#define CHICKEN_global_set(root, x) C_mutate(&C_u_i_car(((C_GC_ROOT *)(root))->value), (x))793794#define CHICKEN_default_toplevel ((void *)C_default_5fstub_toplevel)795796#define C__STR1(x) #x797#define C__STR2(x) C__STR1(x)798799#define C_align4(n) (((n) + 3) & ~3)800#define C_align8(n) (((n) + 7) & ~7)801#define C_align16(n) (((n) + 15) & ~15)802803#define C_aligned8(n) ((((C_word)(n)) & 7) == 0)804805#define C_buf_end(b) ((C_word *)((C_byte *)(b) + sizeof(b)))806807/* This is word-size dependent: */808#ifdef C_SIXTY_FOUR809# define C_align(n) C_align8(n)810# define C_wordstobytes(n) ((C_uword)(n) << 3)811# define C_bytestowords(n) (((n) + 7) >> 3)812# define C_wordsperdouble(n) (n)813# define C_WORD_MIN LONG_MIN814# define C_WORD_MAX LONG_MAX815# define C_UWORD_MAX ULONG_MAX816#else817# define C_align(n) C_align4(n)818# define C_wordstobytes(n) ((C_uword)(n) << 2)819# define C_bytestowords(n) (((n) + 3) >> 2)820# define C_wordsperdouble(n) ((C_uword)(n) << 1)821# define C_WORD_MIN INT_MIN822# define C_WORD_MAX INT_MAX823# define C_UWORD_MAX UINT_MAX824#endif825826/* Clang and G++ support statement expressions, but only in a limited way */827#if DEBUGBUILD && HAVE_STATEMENT_EXPRESSIONS && !defined(__clang__) && !defined(__cplusplus)828/* These are wrappers around the following idiom:829 * assert(SOME_PRED(obj));830 * do_something_with(obj);831 * This works around the fact obj may be an expression with side-effects.832 *833 * To make this work with nested expansions, we need semantics like834 * (let ((x 1)) (let ((x x)) x)) => 1, but in C, int x = x; results in835 * undefined behaviour because x refers to itself. As a workaround,836 * we keep around a reference to the previous level (one scope up).837 * After initialisation, "previous" is redefined to mean "current".838 */839# define C_VAL1(x) C__PREV_TMPST.n1840# define C_VAL2(x) C__PREV_TMPST.n2841# define C__CHECK_panic(a,s,f,l) \842 ((a) ? (void)0 : \843 C_panic_hook(C_text("Low-level type assertion " s " failed at " f ":" C__STR1(l))))844# define C__CHECK_core(v,a,s,x) \845 ({ struct { \846 typeof(v) n1; \847 } C__TMPST = { .n1 = (v) }; \848 typeof(C__TMPST) C__PREV_TMPST=C__TMPST; \849 C__CHECK_panic(a,s,__FILE__,__LINE__); \850 x; })851# define C__CHECK2_core(v1,v2,a,s,x) \852 ({ struct { \853 typeof(v1) n1; \854 typeof(v2) n2; \855 } C__TMPST = { .n1 = (v1), .n2 = (v2) }; \856 typeof(C__TMPST) C__PREV_TMPST=C__TMPST; \857 C__CHECK_panic(a,s,__FILE__,__LINE__); \858 x; })859# define C_CHECK(v,a,x) C__CHECK_core(v,a,#a,x)860# define C_CHECK2(v1,v2,a,x) C__CHECK2_core(v1,v2,a,#a,x)861/*862 * Convenience for using Scheme-predicates.863 */864# define C_CHECKp(v,a,x) C__CHECK_core(v,C_truep(a),#a"=#t",x)865# define C_CHECK2p(v1,v2,a,x) C__CHECK2_core(v1,v2,C_truep(a),#a"=#t",x)866#else867# define C_VAL1(x) (x)868# define C_VAL2(x) (x)869# define C_CHECK(v,a,x) (x)870# define C_CHECK2(v1,v2,a,x) (x)871# define C_CHECKp(v,a,x) (x)872# define C_CHECK2p(v1,v2,a,x) (x)873#endif874875#ifndef C_PROVIDE_LIBC_STUBS876# define C_FILEPTR FILE *877878# define C_stdin stdin879# define C_stdout stdout880# define C_stderr stderr881882# define C_memcpy memcpy883# define C_memcmp memcmp884# define C_strncpy strncpy885# define C_strcmp strcmp886# define C_strncmp strncmp887# define C_strlen strlen888# define C_memchr memchr889# define C_memset memset890# define C_memmove memmove891# define C_strncasecmp strncasecmp892# define C_malloc malloc893# define C_calloc calloc894# define C_free free895# define C_strchr strchr896# define C_realloc realloc897# define C_strdup strdup898# define C_strtol strtol899# define C_strtoll strtoll900# define C_strtod strtod901# define C_strtoul strtoul902# define C_fopen fopen903# define C_fclose fclose904# define C_strpbrk strpbrk905# define C_strcspn strcspn906# define C_snprintf snprintf907# define C_printf printf908# define C_fprintf fprintf909# define C_vfprintf vfprintf910# define C_fflush fflush911# define C_getchar getchar912# define C_exit exit913# define C__exit _exit914# define C_dlopen dlopen915# define C_dlclose dlclose916# define C_dlsym dlsym917# define C_fwrite fwrite918# define C_fread fread919# define C_fputs fputs920# define C_fputc fputc921# define C_putchar putchar922# if (defined getc_unlocked || _POSIX_C_SOURCE >= 199506L) && !defined(__MINGW32__)923# define C_getc getc_unlocked924# else925# define C_getc getc926# endif927# define C_fgetc fgetc928# define C_fgets fgets929# define C_ungetc ungetc930# define C_system system931# define C_isatty isatty932# define C_fileno fileno933# define C_select select934# if defined(HAVE_SIGACTION)935# define C_sigaction sigaction936# endif937# define C_signal signal938# define C_getrusage getrusage939# define C_tolower tolower940# define C_toupper toupper941# define C_gettimeofday gettimeofday942# define C_gmtime gmtime943# define C_localtime localtime944/*945 * It is undefined whether regular setjmp/longjmp save/restore signal mask946 * so try to use versions that we know won't try to save & restore.947 */948# if defined(HAVE_SIGSETJMP)949# define C_sigsetjmp sigsetjmp950# define C_siglongjmp siglongjmp951# endif952# ifdef HAVE_SIGPROCMASK953# define C_sigprocmask sigprocmask954# endif955# define C_setjmp setjmp956# define C_longjmp longjmp957# define C_alloca alloca958# define C_strerror strerror959# define C_isalpha isalpha960# define C_isdigit isdigit961# define C_isspace isspace962# define C_islower islower963# define C_isupper isupper964# define C_sin sin965# define C_cos cos966# define C_tan tan967# define C_asin asin968# define C_acos acos969# define C_atan atan970# define C_sinh sinh971# define C_cosh cosh972# define C_tanh tanh973# define C_asinh asinh974# define C_acosh acosh975# define C_atanh atanh976# define C_atan2 atan2977# define C_log log978# define C_exp exp979# define C_pow pow980# define C_sqrt sqrt981# define C_ceil ceil982# define C_floor floor983# define C_round round984# define C_trunc trunc985# define C_fabs fabs986# define C_modf modf987# define C_readlink readlink988# define C_getcwd getcwd989# define C_access access990# define C_getpid getpid991# define C_getenv getenv992# define C_fma fma993#else994/* provide this file and define C_PROVIDE_LIBC_STUBS if you want to use995 your own libc-replacements or -wrappers */996# include "chicken-libc-stubs.h"997#endif998999#ifdef C_LLP1000# define C_strtow C_strtoll1001#else1002# define C_strtow C_strtol1003#endif10041005#define C_return(x) return(x)1006#define C_resize_stack(n) C_do_resize_stack(n)1007#define C_memcpy_slots(t, f, n) C_memcpy((t), (f), (n) * sizeof(C_word))1008/* Without check: initialisation of a newly allocated header */1009#define C_block_header_init(x,h) (((C_SCHEME_BLOCK *)(x))->header = (h))1010/* These two must result in an lvalue, hence the (*foo(&bar)) faffery */1011#define C_block_header(x) (*C_CHECKp(x,C_blockp((C_word)C_VAL1(x)),&(((C_SCHEME_BLOCK *)(C_VAL1(x)))->header)))1012#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) ])))1013#define C_set_block_item(x,i,y) (C_block_item(x, i) = (y))1014#define C_header_bits(bh) (C_block_header(bh) & C_HEADER_BITS_MASK)1015#define C_header_type(bh) (C_block_header(bh) & C_HEADER_TYPE_BITS)1016#define C_header_size(bh) (C_block_header(bh) & C_HEADER_SIZE_MASK)1017#define C_bignum_size(b) (C_bytestowords(C_header_size(C_internal_bignum_vector(b)))-1)1018#define C_make_header(type, size) ((C_header)(((type) & C_HEADER_BITS_MASK) | ((size) & C_HEADER_SIZE_MASK)))1019#define C_symbol_value(x) (C_block_item(x, 0))1020#define C_symbol_name(x) (C_block_item(x, 1))1021#define C_symbol_plist(x) (C_block_item(x, 2))1022#define C_save(x) (*(--C_temporary_stack) = (C_word)(x))1023#define C_rescue(x, i) (C_temporary_stack[ i ] = (x))1024#define C_restore (*(C_temporary_stack++))1025#define C_heaptop ((C_word **)(&C_fromspace_top))1026#define C_drop(n) (C_temporary_stack += (n))1027#define C_alloc(n) ((C_word *)C_alloca((n) * sizeof(C_word)))1028#if (defined (__llvm__) && defined (__GNUC__)) || defined (__TINYC__)1029# if defined (__i386__)1030# define C_stack_pointer ({C_word *sp; __asm__ __volatile__("movl %%esp,%0":"=r"(sp):);sp;})1031# elif defined (__x86_64__)1032# define C_stack_pointer ({C_word *sp; __asm__ __volatile__("movq %%rsp,%0":"=r"(sp):);sp;})1033# else1034/* Not alloca(0) because:1035 * - LLVM allocates anyways1036 * - TCC always returns NULL1037 */1038# define C_stack_pointer ((C_word *)C_alloca(1))1039# endif1040#else1041# define C_stack_pointer ((C_word *)C_alloca(0))1042#endif1043#define C_stack_pointer_test ((C_word *)C_alloca(1))1044#define C_demand_2(n) (((C_word *)C_fromspace_top + (n)) < (C_word *)C_fromspace_limit)1045#define C_calculate_demand(n,c,m) ((n) + (((c) > (m)) ? 0 : (m)))1046#define C_fix(n) ((C_word)((C_uword)(n) << C_FIXNUM_SHIFT) | C_FIXNUM_BIT)1047#define C_unfix(x) C_CHECKp(x,C_fixnump(C_VAL1(x)),((C_VAL1(x)) >> C_FIXNUM_SHIFT))1048#define C_make_character(c) (((((C_uword)(c)) & C_CHAR_BIT_MASK) << C_CHAR_SHIFT) | C_CHARACTER_BITS)1049#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)1050#define C_flonum_magnitude(x) (*C_CHECKp(x,C_flonump(C_VAL1(x)),(double *)C_data_pointer(C_VAL1(x))))1051/* XXX Sometimes this is (ab)used on bytevectors (ie, blob=? uses string_compare) */1052#define C_c_string(x) C_CHECK(x,(C_truep(C_stringp(C_VAL1(x))) || C_truep(C_bytevectorp(C_VAL1(x)))),(C_char *)C_data_pointer(C_VAL1(x)))10531054#define C_c_pointer(x) ((void *)(x))1055#define C_c_pointer_nn(x) ((void *)C_block_item(x, 0))1056#define C_truep(x) ((x) != C_SCHEME_FALSE)1057#define C_immediatep(x) ((x) & C_IMMEDIATE_MARK_BITS)1058#define C_mk_bool(x) ((x) ? C_SCHEME_TRUE : C_SCHEME_FALSE)1059#define C_mk_nbool(x) ((x) ? C_SCHEME_FALSE : C_SCHEME_TRUE)1060#define C_port_file(p) C_CHECKp(p,C_portp(C_VAL1(p)),(C_FILEPTR)C_block_item(C_VAL1(p), 0))1061#define C_port_fileno(p) C_fix(C_fileno(C_port_file(p)))1062#define C_data_pointer(b) C_CHECKp(b,C_blockp((C_word)C_VAL1(b)),(void *)(((C_SCHEME_BLOCK *)(C_VAL1(b)))->data))1063#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))1064#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))1065#define C_fitsinbignumhalfdigitp(n)(C_BIGNUM_DIGIT_HI_HALF(n) == 0)1066#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))))1067#define C_bignum_mutate_size(b, s) (C_block_header(C_internal_bignum_vector(b)) = (C_STRING_TYPE | C_wordstobytes((s)+1)))1068#define C_fitsinfixnump(n) (((n) & C_INT_SIGN_BIT) == (((C_uword)(n) & C_INT_TOP_BIT) << 1))1069#define C_ufitsinfixnump(n) (((n) & (C_INT_SIGN_BIT | (C_INT_SIGN_BIT >> 1))) == 0)1070#define C_and(x, y) (C_truep(x) ? (y) : C_SCHEME_FALSE)1071#define C_c_bytevector(x) ((unsigned char *)C_data_pointer(x))1072#define C_c_bytevector_or_null(x) ((unsigned char *)C_data_pointer_or_null(x))1073#define C_srfi_4_vector(x) C_data_pointer(C_block_item(x,1))1074#define C_c_u8vector(x) ((unsigned char *)C_srfi_4_vector(x))1075#define C_c_u8vector_or_null(x) ((unsigned char *)C_srfi_4_vector_or_null(x))1076#define C_c_s8vector(x) ((signed char *)C_srfi_4_vector(x))1077#define C_c_s8vector_or_null(x) ((signed char *)C_srfi_4_vector_or_null(x))1078#define C_c_u16vector(x) ((unsigned short *)C_srfi_4_vector(x))1079#define C_c_u16vector_or_null(x) ((unsigned short *)C_srfi_4_vector_or_null(x))1080#define C_c_s16vector(x) ((short *)C_srfi_4_vector(x))1081#define C_c_s16vector_or_null(x) ((short *)C_srfi_4_vector_or_null(x))1082#define C_c_u32vector(x) ((C_u32 *)C_srfi_4_vector(x))1083#define C_c_u32vector_or_null(x) ((C_u32 *)C_srfi_4_vector_or_null(x))1084#define C_c_s32vector(x) ((C_s32 *)C_srfi_4_vector(x))1085#define C_c_s32vector_or_null(x) ((C_s32 *)C_srfi_4_vector_or_null(x))1086#define C_c_u64vector(x) ((C_u64 *)C_srfi_4_vector(x))1087#define C_c_u64vector_or_null(x) ((C_u64 *)C_srfi_4_vector_or_null(x))1088#define C_c_s64vector(x) ((C_s64 *)C_srfi_4_vector(x))1089#define C_c_s64vector_or_null(x) ((C_s64 *)C_srfi_4_vector_or_null(x))1090#define C_c_f32vector(x) ((float *)C_srfi_4_vector(x))1091#define C_c_f32vector_or_null(x) ((float *)C_srfi_4_vector_or_null(x))1092#define C_c_f64vector(x) ((double *)C_srfi_4_vector(x))1093#define C_c_f64vector_or_null(x) ((double *)C_srfi_4_vector_or_null(x))1094#define C_c_pointer_vector(x) ((void **)C_data_pointer(C_block_item((x), 2)))10951096#define C_isnan(f) isnan(f)1097#define C_isinf(f) isinf(f)1098#define C_isfinite(f) isfinite(f)10991100#define C_stack_overflow_check C_stack_check1(C_stack_overflow(NULL))11011102/* TODO: The C_scratch_usage checks should probably be moved. Maybe1103 * we should add a core#allocate_scratch_inline which will insert1104 * C_demand/C_stack_probe-like checks to copy the result onto the1105 * stack or reclaim, but in a clever way so it's only done at the1106 * "end" of a C function.1107 */1108#if C_STACK_GROWS_DOWNWARD1109# define C_demand(n) ((C_word)(C_stack_pointer - C_stack_limit) > ((n)+C_scratch_usage))1110# define C_stack_check1(err) if(!C_disable_overflow_check) { \1111 do { C_byte *_sp = (C_byte*)(C_stack_pointer); \1112 if(_sp < (C_byte *)C_stack_hard_limit && \1113 ((C_byte *)C_stack_hard_limit - _sp) > C_STACK_RESERVE) \1114 err; } \1115 while(0);}11161117#else1118# define C_demand(n) ((C_word)(C_stack_limit - C_stack_pointer) > ((n)+C_scratch_usage))1119# define C_stack_check1(err) if(!C_disable_overflow_check) { \1120 do { C_byte *_sp = (C_byte*)(C_stack_pointer); \1121 if(_sp > (C_byte *)C_stack_hard_limit && \1122 (_sp - (C_byte *)C_stack_hard_limit) > C_STACK_RESERVE) \1123 err; } \1124 while(0);}11251126#endif11271128#define C_zero_length_p(x) C_mk_bool(C_header_size(x) == 0)1129#define C_boundp(x) C_mk_bool(C_block_item(x, 0) != C_SCHEME_UNBOUND)1130#define C_unboundvaluep(x) C_mk_bool((x) == C_SCHEME_UNBOUND)1131#define C_blockp(x) C_mk_bool(!C_immediatep(x))1132#define C_forwardedp(x) C_mk_bool((C_block_header(x) & C_GC_FORWARDING_BIT) != 0)1133#define C_immp(x) C_mk_bool(C_immediatep(x))1134#define C_flonump(x) C_mk_bool(C_block_header(x) == C_FLONUM_TAG)1135#define C_bignump(x) C_mk_bool(C_block_header(x) == C_BIGNUM_TAG)1136#define C_stringp(x) C_mk_bool(C_header_bits(x) == C_STRING_TYPE)1137#define C_symbolp(x) C_mk_bool(C_block_header(x) == C_SYMBOL_TAG)1138#define C_pairp(x) C_mk_bool(C_header_type(x) == C_PAIR_TYPE)1139#define C_weak_pairp(x) C_mk_bool(C_block_header(x) == C_WEAK_PAIR_TAG)1140#define C_closurep(x) C_mk_bool(C_header_bits(x) == C_CLOSURE_TYPE)1141#define C_vectorp(x) C_mk_bool(C_header_bits(x) == C_VECTOR_TYPE)1142#define C_bytevectorp(x) C_mk_bool(C_header_bits(x) == C_BYTEVECTOR_TYPE)1143#define C_portp(x) C_mk_bool(C_header_bits(x) == C_PORT_TYPE)1144#define C_structurep(x) C_mk_bool(C_header_bits(x) == C_STRUCTURE_TYPE)1145#define C_locativep(x) C_mk_bool(C_block_header(x) == C_LOCATIVE_TAG)1146#define C_charp(x) C_mk_bool(((x) & C_IMMEDIATE_TYPE_BITS) == C_CHARACTER_BITS)1147#define C_booleanp(x) C_mk_bool(((x) & C_IMMEDIATE_TYPE_BITS) == C_BOOLEAN_BITS)1148#define C_eofp(x) C_mk_bool((x) == C_SCHEME_END_OF_FILE)1149#define C_undefinedp(x) C_mk_bool((x) == C_SCHEME_UNDEFINED)1150#define C_bwpp(x) C_mk_bool((x) == C_SCHEME_BROKEN_WEAK_PTR)1151#define C_fixnump(x) C_mk_bool((x) & C_FIXNUM_BIT)1152#define C_nfixnump(x) C_mk_nbool((x) & C_FIXNUM_BIT)1153#define C_pointerp(x) C_mk_bool(C_block_header(x) == C_POINTER_TAG)1154#define C_taggedpointerp(x) C_mk_bool(C_block_header(x) == C_TAGGED_POINTER_TAG)1155#define C_lambdainfop(x) C_mk_bool(C_header_bits(x) == C_LAMBDA_INFO_TYPE)1156#define C_anypointerp(x) C_mk_bool(C_block_header(x) == C_POINTER_TAG || C_block_header(x) == C_TAGGED_POINTER_TAG)1157#define C_specialp(x) C_mk_bool(C_header_bits(x) & C_SPECIALBLOCK_BIT)1158#define C_byteblockp(x) C_mk_bool(C_header_bits(x) & C_BYTEBLOCK_BIT)1159#define C_sametypep(x, y) C_mk_bool(C_header_bits(x) == C_header_bits(y))1160#define C_eqp(x, y) C_mk_bool((x) == (y))1161#define C_vemptyp(x) C_mk_bool(C_header_size(x) == 0)1162#define C_notvemptyp(x) C_mk_bool(C_header_size(x) > 0)11631164#define C_port_typep(x, n) C_mk_bool((C_block_item(x, 1) & n) == n)1165#define C_input_portp(x) C_and(C_portp(x), C_port_typep(x, 0x2))1166#define C_output_portp(x) C_and(C_portp(x), C_port_typep(x, 0x4))11671168#define C_port_openp(port, n) C_mk_bool((C_block_item(port, 8) & n) == n)1169#define C_input_port_openp(port) C_port_openp(port, 0x2)1170#define C_output_port_openp(port) C_port_openp(port, 0x4)11711172#define C_slot(x, i) C_block_item(x, C_unfix(i))1173#define C_subbyte(x, i) C_fix(((C_byte *)C_data_pointer(x))[ C_unfix(i) ] & 0xff)1174#define C_subchar(x, i) C_make_character(((C_uchar *)C_data_pointer(x))[ C_unfix(i) ])1175#define C_setbyte(x, i, n) (((C_byte *)C_data_pointer(x))[ C_unfix(i) ] = C_unfix(n), C_SCHEME_UNDEFINED)1176#define C_setsubchar(x, i, n) (((C_char *)C_data_pointer(x))[ C_unfix(i) ] = C_character_code(n), C_SCHEME_UNDEFINED)1177#define C_setsubbyte(x, i, n) (((C_char *)C_data_pointer(x))[ C_unfix(i) ] = C_unfix(n), C_SCHEME_UNDEFINED)11781179#define C_fixnum_times(n1, n2) (C_fix(C_unfix(n1) * C_unfix(n2)))1180#define C_u_fixnum_plus(n1, n2) (((n1) - C_FIXNUM_BIT) + (n2))1181#define C_fixnum_plus(n1, n2) (C_u_fixnum_plus(n1, n2) | C_FIXNUM_BIT)1182#define C_u_fixnum_difference(n1, n2) ((n1) - (n2) + C_FIXNUM_BIT)1183#define C_fixnum_difference(n1, n2) (C_u_fixnum_difference(n1, n2) | C_FIXNUM_BIT)1184#define C_u_fixnum_divide(n1, n2) (C_fix(C_unfix(n1) / C_unfix(n2)))1185#define C_u_fixnum_and(n1, n2) ((n1) & (n2))1186#define C_fixnum_and(n1, n2) (C_u_fixnum_and(n1, n2) | C_FIXNUM_BIT)1187#define C_u_fixnum_or(n1, n2) ((n1) | (n2))1188#define C_fixnum_or(n1, n2) C_u_fixnum_or(n1, n2)1189#define C_fixnum_xor(n1, n2) (((n1) ^ (n2)) | C_FIXNUM_BIT)1190#define C_fixnum_not(n) ((~(n)) | C_FIXNUM_BIT)1191#define C_fixnum_shift_left(n1, n2) (C_fix(((C_uword)C_unfix(n1) << (C_uword)C_unfix(n2))))1192#define C_fixnum_shift_right(n1, n2) (((n1) >> (C_uword)C_unfix(n2)) | C_FIXNUM_BIT)1193#define C_u_fixnum_negate(n) (-(n) + 2 * C_FIXNUM_BIT)1194#define C_fixnum_negate(n) (C_u_fixnum_negate(n) | C_FIXNUM_BIT)1195#define C_fixnum_greaterp(n1, n2) (C_mk_bool((C_word)(n1) > (C_word)(n2)))1196#define C_fixnum_lessp(n1, n2) (C_mk_bool((C_word)(n1) < (C_word)(n2)))1197#define C_fixnum_greater_or_equal_p(n1, n2) (C_mk_bool((C_word)(n1) >= (C_word)(n2)))1198#define C_fixnum_less_or_equal_p(n1, n2)(C_mk_bool((C_word)(n1) <= (C_word)(n2)))1199#define C_u_fixnum_increase(n) ((n) + (1 << C_FIXNUM_SHIFT))1200#define C_fixnum_increase(n) (C_u_fixnum_increase(n) | C_FIXNUM_BIT)1201#define C_u_fixnum_decrease(n) ((n) - (1 << C_FIXNUM_SHIFT))1202#define C_fixnum_decrease(n) (C_u_fixnum_decrease(n) | C_FIXNUM_BIT)1203/* XXX TODO: This should probably be renamed C_u_fixnum_abs or something */1204#define C_fixnum_abs(n) C_fix(abs(C_unfix(n)))1205#define C_a_i_fixnum_abs(ptr, n, x) (((x) & C_INT_SIGN_BIT) ? C_a_i_fixnum_negate((ptr), (n), (x)) : (x))1206#define C_i_fixnum_signum(x) ((x) == C_fix(0) ? (x) : (((x) & C_INT_SIGN_BIT) ? C_fix(-1) : C_fix(1)))1207#define C_i_fixnum_length(x) C_fix(C_ilen(((x) & C_INT_SIGN_BIT) ? ~C_unfix(x) : C_unfix(x)))12081209#define C_flonum_equalp(n1, n2) C_mk_bool(C_flonum_magnitude(n1) == C_flonum_magnitude(n2))1210#define C_flonum_greaterp(n1, n2) C_mk_bool(C_flonum_magnitude(n1) > C_flonum_magnitude(n2))1211#define C_flonum_lessp(n1, n2) C_mk_bool(C_flonum_magnitude(n1) < C_flonum_magnitude(n2))1212#define C_flonum_greater_or_equal_p(n1, n2) C_mk_bool(C_flonum_magnitude(n1) >= C_flonum_magnitude(n2))1213#define C_flonum_less_or_equal_p(n1, n2) C_mk_bool(C_flonum_magnitude(n1) <= C_flonum_magnitude(n2))12141215#define C_a_i_flonum_plus(ptr, c, n1, n2) C_flonum(ptr, C_flonum_magnitude(n1) + C_flonum_magnitude(n2))1216#define C_a_i_flonum_difference(ptr, c, n1, n2) C_flonum(ptr, C_flonum_magnitude(n1) - C_flonum_magnitude(n2))1217#define C_a_i_flonum_times(ptr, c, n1, n2) C_flonum(ptr, C_flonum_magnitude(n1) * C_flonum_magnitude(n2))1218#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)))1219#define C_a_i_flonum_quotient(ptr, c, n1, n2) C_flonum(ptr, C_flonum_magnitude(n1) / C_flonum_magnitude(n2))1220#define C_a_i_flonum_negate(ptr, c, n) C_flonum(ptr, -C_flonum_magnitude(n))1221#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)))12221223#define C_a_i_address_to_pointer(ptr, c, addr) C_mpointer(ptr, (void *)C_num_to_unsigned_int(addr))1224#define C_a_i_pointer_to_address(ptr, c, pptr) C_unsigned_int_to_num(ptr, (unsigned int)C_c_pointer_nn(pptr))12251226#define C_display_fixnum(p, n) (C_fprintf(C_port_file(p), C_text("%d"), C_unfix(n)), C_SCHEME_UNDEFINED)1227#define C_display_char(p, c) (C_fputc(C_character_code(c), C_port_file(p)), C_SCHEME_UNDEFINED)1228#define C_display_string(p, s) (C_fwrite(C_data_pointer(s), sizeof(C_char), C_header_size(s), \1229 C_port_file(p)), C_SCHEME_UNDEFINED)1230#define C_flush_output(port) (C_fflush(C_port_file(port)), C_SCHEME_UNDEFINED)12311232#define C_fix_to_char(x) (C_make_character(C_unfix(x)))1233#define C_char_to_fix(x) (C_fix(C_character_code(x)))1234#define C_u_i_char_equalp(x, y) C_mk_bool(C_character_code(x) == C_character_code(y))1235#define C_u_i_char_greaterp(x, y) C_mk_bool(C_character_code(x) > C_character_code(y))1236#define C_u_i_char_lessp(x, y) C_mk_bool(C_character_code(x) < C_character_code(y))1237#define C_u_i_char_greater_or_equal_p(x, y) C_mk_bool(C_character_code(x) >= C_character_code(y))1238#define C_u_i_char_less_or_equal_p(x, y) C_mk_bool(C_character_code(x) <= C_character_code(y))1239#define C_substring_copy(s1, s2, start1, end1, start2) \1240 (C_memmove((C_char *)C_data_pointer(s2) + C_unfix(start2), \1241 (C_char *)C_data_pointer(s1) + C_unfix(start1), \1242 C_unfix(end1) - C_unfix(start1) ), C_SCHEME_UNDEFINED)1243#define C_substring_compare(s1, s2, start1, start2, len) \1244 C_mk_bool(C_memcmp((C_char *)C_data_pointer(s1) + C_unfix(start1), \1245 (C_char *)C_data_pointer(s2) + C_unfix(start2), \1246 C_unfix(len) ) == 0)1247#define C_substring_compare_case_insensitive(s1, s2, start1, start2, len) \1248 C_mk_bool(C_memcasecmp((C_char *)C_data_pointer(s1) + C_unfix(start1), \1249 (C_char *)C_data_pointer(s2) + C_unfix(start2), \1250 C_unfix(len) ) == 0)1251/* this does not use C_mutate: */1252#define C_subvector_copy(v1, v2, start1, end1, start2) \1253 (C_memcpy_slots((C_char *)C_data_pointer(v2) + C_unfix(start2), \1254 (C_char *)C_data_pointer(v1) + C_unfix(start1), \1255 C_unfix(end1) - C_unfix(start1) ), C_SCHEME_UNDEFINED)1256#define C_words(n) C_fix(C_bytestowords(C_unfix(n)))1257#define C_bytes(n) C_fix(C_wordstobytes(C_unfix(n)))1258#define C_rand(n) C_fix((C_word)(((double)rand())/(RAND_MAX + 1.0) * C_unfix(n)))1259#define C_block_size(x) C_fix(C_header_size(x))1260#define C_u_i_bignum_size(b) C_fix(C_bignum_size(b))1261#define C_a_u_i_big_to_flo(p, n, b) C_flonum(p, C_bignum_to_double(b))1262#define C_u_i_ratnum_num(r) C_block_item((r), 0)1263#define C_u_i_ratnum_denom(r) C_block_item((r), 1)1264#define C_u_i_cplxnum_real(c) C_block_item((c), 0)1265#define C_u_i_cplxnum_imag(c) C_block_item((c), 1)1266#define C_pointer_address(x) ((C_byte *)C_block_item((x), 0))1267#define C_block_address(ptr, n, x) C_a_unsigned_int_to_num(ptr, n, x)1268#define C_offset_pointer(x, y) (C_pointer_address(x) + (y))1269#define C_do_apply(c, av) ((C_proc)(void *)C_block_item((av)[0], 0))((c), (av))1270#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)1271#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)])1272#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)1273#define C_rest_nullp(c, n) (C_mk_bool((n) >= (c)))1274#define C_fetch_byte(x, p) (((unsigned C_byte *)C_data_pointer(x))[ p ])1275#define C_poke_integer(x, i, n) (C_set_block_item(x, C_unfix(i), C_num_to_int(n)), C_SCHEME_UNDEFINED)1276#define C_pointer_to_block(p, x) (C_set_block_item(p, 0, (C_word)C_data_pointer(x)), C_SCHEME_UNDEFINED)1277#define C_null_pointerp(x) C_mk_bool((void *)C_block_item(x, 0) == NULL)1278#define C_update_pointer(p, ptr) (C_set_block_item(ptr, 0, C_num_to_unsigned_int(p)), C_SCHEME_UNDEFINED)1279#define C_copy_pointer(from, to) (C_set_block_item(to, 0, C_block_item(from, 0)), C_SCHEME_UNDEFINED)1280#define C_pointer_to_object(ptr) C_block_item(ptr, 0)12811282#ifdef C_SIXTY_FOUR1283# define C_poke_integer_32(x, i, n) (((C_s32 *)C_data_pointer(x))[ C_unfix(i) ] = C_unfix(n), C_SCHEME_UNDEFINED)1284#else1285# define C_poke_integer_32 C_poke_integer1286#endif12871288#define C_copy_memory(to, from, n) (C_memcpy(C_data_pointer(to), C_data_pointer(from), C_unfix(n)), C_SCHEME_UNDEFINED)1289#define C_copy_ptr_memory(to, from, n, toff, foff) \1290 (C_memmove(C_pointer_address(to) + C_unfix(toff), C_pointer_address(from) + C_unfix(foff), \1291 C_unfix(n)), C_SCHEME_UNDEFINED)1292#define C_set_memory(to, c, n) (C_memset(C_data_pointer(to), C_character_code(c), C_unfix(n)), C_SCHEME_UNDEFINED)1293#define C_string_compare(to, from, n) C_fix(C_memcmp(C_c_string(to), C_c_string(from), C_unfix(n)))1294#define C_string_compare_case_insensitive(from, to, n) \1295 C_fix(C_memcasecmp(C_c_string(from), C_c_string(to), C_unfix(n)))1296#define C_poke_double(b, i, n) (((double *)C_data_pointer(b))[ C_unfix(i) ] = C_c_double(n), C_SCHEME_UNDEFINED)1297#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)1298#define C_peek_fixnum(b, i) C_fix(C_block_item(b, C_unfix(i)))1299#define C_peek_byte(ptr, i) C_fix(((unsigned char *)C_u_i_car(ptr))[ C_unfix(i) ])1300#define C_dupstr(s) C_strdup(C_data_pointer(s))1301#define C_poke_pointer(b, i, x) (C_set_block_item(b, C_unfix(i), (C_word)C_data_pointer(x)), C_SCHEME_UNDEFINED)1302#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)1303#define C_qfree(ptr) (C_free(C_c_pointer_nn(ptr)), C_SCHEME_UNDEFINED)13041305#define C_tty_portp(p) C_mk_bool(isatty(fileno(C_port_file(p))))13061307#define C_emit_trace_info(l, x, y, z) C_emit_trace_info2(NULL, l, x, y, z)1308#define C_emit_eval_trace_info(x, y, z) C_emit_trace_info2(C_text("<eval>"), C_SCHEME_FALSE, x, y, z)1309#define C_emit_syntax_trace_info(x, y, z) C_emit_trace_info2(C_text("<syntax>"), C_SCHEME_FALSE, x, y, z)13101311/* These expect C_VECTOR_TYPE to be 0: */1312#define C_vector_to_structure(v) (C_block_header(v) |= C_STRUCTURE_TYPE, C_SCHEME_UNDEFINED)1313#define C_vector_to_closure(v) (C_block_header(v) |= C_CLOSURE_TYPE, C_SCHEME_UNDEFINED)1314#define C_string_to_bytevector(s) (C_block_header(s) = C_header_size(s) | C_BYTEVECTOR_TYPE, C_SCHEME_UNDEFINED)1315#define C_string_to_lambdainfo(s) (C_block_header(s) = C_header_size(s) | C_LAMBDA_INFO_TYPE, C_SCHEME_UNDEFINED)13161317#ifdef C_TIMER_INTERRUPTS1318# define C_check_for_interrupt if(--C_timer_interrupt_counter <= 0) C_raise_interrupt(C_TIMER_INTERRUPT_NUMBER)1319#else1320# define C_check_for_interrupt1321#endif13221323#define C_set_initial_timer_interrupt_period(n) \1324 (C_initial_timer_interrupt_period = C_unfix(n), C_SCHEME_UNDEFINED)132513261327#ifdef HAVE_STATEMENT_EXPRESSIONS1328# define C_a_i(a, n) ({C_word *tmp = *a; *a += (n); tmp;})1329# define C_a_i_cons(a, n, car, cdr) ({C_word tmp = (C_word)(*a); (*a)[0] = C_PAIR_TAG; *a += C_SIZEOF_PAIR; \1330 C_set_block_item(tmp, 0, car); C_set_block_item(tmp, 1, cdr); tmp;})1331# 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; \1332 C_set_block_item(tmp, 0, car); C_set_block_item(tmp, 1, cdr); tmp;})1333#else1334# define C_a_i_cons(a, n, car, cdr) C_a_pair(a, car, cdr)1335# define C_a_i_weak_cons(a, n, car, cdr) C_a_weak_pair(a, car, cdr)1336#endif /* HAVE_STATEMENT_EXPRESSIONS */13371338#define C_a_i_flonum(ptr, c, n) C_flonum(ptr, n)1339#define C_a_i_ratnum(ptr, c, n, d) C_ratnum(ptr, n, d)1340#define C_a_i_cplxnum(ptr, c, r, i) C_cplxnum(ptr, r, i)1341#define C_a_i_data_mpointer(ptr, n, x) C_mpointer(ptr, C_data_pointer(x))1342#define C_a_i_fix_to_flo(p, n, f) C_flonum(p, C_unfix(f))1343#define C_cast_to_flonum(n) ((double)(n))1344#define C_a_i_mpointer(ptr, n, x) C_mpointer(ptr, (x))1345#define C_a_u_i_pointer_inc(ptr, n, p, i) C_mpointer(ptr, (C_char *)(p) + C_unfix(i))1346#define C_pointer_eqp(x, y) C_mk_bool(C_c_pointer_nn(x) == C_c_pointer_nn(y))1347#define C_a_int_to_num(ptr, n, i) C_int_to_num(ptr, i)1348#define C_a_unsigned_int_to_num(ptr, n, i) C_unsigned_int_to_num(ptr, i)1349#define C_a_i_vector C_vector1350#define C_list C_a_i_list1351#define C_i_setslot(x, i, y) (C_mutate(&C_block_item(x, C_unfix(i)), y), C_SCHEME_UNDEFINED)1352#define C_i_set_i_slot(x, i, y) (C_set_block_item(x, C_unfix(i), y), C_SCHEME_UNDEFINED)1353#define C_u_i_set_car(p, x) (C_mutate(&C_u_i_car(p), x), C_SCHEME_UNDEFINED)1354#define C_u_i_set_cdr(p, x) (C_mutate(&C_u_i_cdr(p), x), C_SCHEME_UNDEFINED)1355#define C_a_i_putprop(p, c, x, y, z) C_putprop(p, x, y, z)13561357#define C_i_not(x) (C_truep(x) ? C_SCHEME_FALSE : C_SCHEME_TRUE)1358#define C_i_equalp(x, y) C_mk_bool(C_equalp((x), (y)))1359#define C_i_fixnumevenp(x) C_mk_nbool((x) & 0x00000002)1360#define C_i_fixnumoddp(x) C_mk_bool((x) & 0x00000002)1361#define C_i_fixnum_negativep(x) C_mk_bool((x) & C_INT_SIGN_BIT)1362#define C_i_fixnum_positivep(x) C_mk_bool(!((x) & C_INT_SIGN_BIT) && (x) != C_fix(0))1363#define C_i_nullp(x) C_mk_bool((x) == C_SCHEME_END_OF_LIST)1364#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))13651366#define C_u_i_char_alphabeticp(x) C_mk_bool(C_character_code(x) < 0x100 && C_isalpha(C_character_code(x)))1367#define C_u_i_char_numericp(x) C_mk_bool(C_character_code(x) < 0x100 && C_isdigit(C_character_code(x)))1368#define C_u_i_char_whitespacep(x) C_mk_bool(C_character_code(x) < 0x100 && C_isspace(C_character_code(x)))1369#define C_u_i_char_upper_casep(x) C_mk_bool(C_character_code(x) < 0x100 && C_isupper(C_character_code(x)))1370#define C_u_i_char_lower_casep(x) C_mk_bool(C_character_code(x) < 0x100 && C_islower(C_character_code(x)))13711372#define C_u_i_char_upcase(x) (C_character_code(x) < 0x100 ? C_make_character(C_toupper(C_character_code(x))) : (x))1373#define C_u_i_char_downcase(x) (C_character_code(x) < 0x100 ? C_make_character(C_tolower(C_character_code(x))) : (x))13741375#define C_i_list_ref(lst, i) C_i_car(C_i_list_tail(lst, i))1376#define C_u_i_list_ref(lst, i) C_u_i_car(C_i_list_tail(lst, i))13771378#define C_u_i_car(x) (*C_CHECKp(x,C_pairp(C_VAL1(x)),&C_block_item(C_VAL1(x), 0)))1379#define C_u_i_cdr(x) (*C_CHECKp(x,C_pairp(C_VAL1(x)),&C_block_item(C_VAL1(x), 1)))1380#define C_u_i_caar(x) C_u_i_car( C_u_i_car( x ) )1381#define C_u_i_cadr(x) C_u_i_car( C_u_i_cdr( x ) )1382#define C_u_i_cdar(x) C_u_i_cdr( C_u_i_car( x ) )1383#define C_u_i_cddr(x) C_u_i_cdr( C_u_i_cdr( x ) )1384#define C_u_i_caaar(x) C_u_i_car( C_u_i_caar( x ) )1385#define C_u_i_caadr(x) C_u_i_car( C_u_i_cadr( x ) )1386#define C_u_i_cadar(x) C_u_i_car( C_u_i_cdar( x ) )1387#define C_u_i_caddr(x) C_u_i_car( C_u_i_cddr( x ) )1388#define C_u_i_cdaar(x) C_u_i_cdr( C_u_i_caar( x ) )1389#define C_u_i_cdadr(x) C_u_i_cdr( C_u_i_cadr( x ) )1390#define C_u_i_cddar(x) C_u_i_cdr( C_u_i_cdar( x ) )1391#define C_u_i_cdddr(x) C_u_i_cdr( C_u_i_cddr( x ) )1392#define C_u_i_caaaar(x) C_u_i_car( C_u_i_caaar( x ) )1393#define C_u_i_caaadr(x) C_u_i_car( C_u_i_caadr( x ) )1394#define C_u_i_caadar(x) C_u_i_car( C_u_i_cadar( x ) )1395#define C_u_i_caaddr(x) C_u_i_car( C_u_i_caddr( x ) )1396#define C_u_i_cadaar(x) C_u_i_car( C_u_i_cdaar( x ) )1397#define C_u_i_cadadr(x) C_u_i_car( C_u_i_cdadr( x ) )1398#define C_u_i_caddar(x) C_u_i_car( C_u_i_cddar( x ) )1399#define C_u_i_cadddr(x) C_u_i_car( C_u_i_cdddr( x ) )1400#define C_u_i_cdaaar(x) C_u_i_cdr( C_u_i_caaar( x ) )1401#define C_u_i_cdaadr(x) C_u_i_cdr( C_u_i_caadr( x ) )1402#define C_u_i_cdadar(x) C_u_i_cdr( C_u_i_cadar( x ) )1403#define C_u_i_cdaddr(x) C_u_i_cdr( C_u_i_caddr( x ) )1404#define C_u_i_cddaar(x) C_u_i_cdr( C_u_i_cdaar( x ) )1405#define C_u_i_cddadr(x) C_u_i_cdr( C_u_i_cdadr( x ) )1406#define C_u_i_cdddar(x) C_u_i_cdr( C_u_i_cddar( x ) )1407#define C_u_i_cddddr(x) C_u_i_cdr( C_u_i_cdddr( x ) )14081409#ifdef HAVE_STATEMENT_EXPRESSIONS1410# define C_i_not_pair_p(x) ({C_word tmp = (x); C_mk_bool(C_immediatep(tmp) || C_header_type(tmp) != C_PAIR_TYPE);})1411#else1412# define C_i_not_pair_p C_i_not_pair_p_21413#endif14141415#define C_i_check_closure(x) C_i_check_closure_2(x, C_SCHEME_FALSE)1416#define C_i_check_exact(x) C_i_check_exact_2(x, C_SCHEME_FALSE) /* DEPRECATED */1417#define C_i_check_fixnum(x) C_i_check_fixnum_2(x, C_SCHEME_FALSE)1418#define C_i_check_inexact(x) C_i_check_inexact_2(x, C_SCHEME_FALSE)1419#define C_i_check_number(x) C_i_check_number_2(x, C_SCHEME_FALSE)1420#define C_i_check_string(x) C_i_check_string_2(x, C_SCHEME_FALSE)1421#define C_i_check_bytevector(x) C_i_check_bytevector_2(x, C_SCHEME_FALSE)1422#define C_i_check_keyword(x) C_i_check_keyword_2(x, C_SCHEME_FALSE)1423#define C_i_check_symbol(x) C_i_check_symbol_2(x, C_SCHEME_FALSE)1424#define C_i_check_list(x) C_i_check_list_2(x, C_SCHEME_FALSE)1425#define C_i_check_pair(x) C_i_check_pair_2(x, C_SCHEME_FALSE)1426#define C_i_check_locative(x) C_i_check_locative_2(x, C_SCHEME_FALSE)1427#define C_i_check_boolean(x) C_i_check_boolean_2(x, C_SCHEME_FALSE)1428#define C_i_check_vector(x) C_i_check_vector_2(x, C_SCHEME_FALSE)1429#define C_i_check_structure(x, st) C_i_check_structure_2(x, (st), C_SCHEME_FALSE)1430#define C_i_check_char(x) C_i_check_char_2(x, C_SCHEME_FALSE)1431#define C_i_check_port(x, in, op) C_i_check_port_2(x, in, op, C_SCHEME_FALSE)14321433#define C_u_i_8vector_length(x) C_fix(C_header_size(C_block_item(x, 1)))1434#define C_u_i_16vector_length(x) C_fix(C_header_size(C_block_item(x, 1)) >> 1)1435#define C_u_i_32vector_length(x) C_fix(C_header_size(C_block_item(x, 1)) >> 2)1436#define C_u_i_64vector_length(x) C_fix(C_header_size(C_block_item(x, 1)) >> 3)1437#define C_u_i_u8vector_length C_u_i_8vector_length1438#define C_u_i_s8vector_length C_u_i_8vector_length1439#define C_u_i_u16vector_length C_u_i_16vector_length1440#define C_u_i_s16vector_length C_u_i_16vector_length1441#define C_u_i_u32vector_length C_u_i_32vector_length1442#define C_u_i_s32vector_length C_u_i_32vector_length1443#define C_u_i_u64vector_length C_u_i_64vector_length1444#define C_u_i_s64vector_length C_u_i_64vector_length1445#define C_u_i_f32vector_length C_u_i_32vector_length1446#define C_u_i_f64vector_length C_u_i_64vector_length14471448#define C_u_i_u8vector_ref(x, i) C_fix(((unsigned char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])1449#define C_u_i_s8vector_ref(x, i) C_fix(((signed char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])1450#define C_u_i_u16vector_ref(x, i) C_fix(((unsigned short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])1451#define C_u_i_s16vector_ref(x, i) C_fix(((short *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])14521453/* these assume fixnum mode */1454#define C_u_i_u32vector_ref(x, i) C_fix(((C_u32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])1455#define C_u_i_s32vector_ref(x, i) C_fix(((C_s32 *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ])14561457#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) ])1458#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) ])14591460#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) ])1461#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) ])14621463#define C_u_i_u8vector_set(x, i, v) ((((unsigned char *)C_data_pointer(C_block_item((x), 1)))[ C_unfix(i) ] = C_unfix(v)), C_SCHEME_UNDEFINED)1464#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)1465#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)1466#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)1467#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)1468#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)1469#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)1470#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)14711472/* DEPRECATED */1473#define C_u_i_bit_to_bool(x, i) C_mk_bool((C_unfix(x) & (1 << C_unfix(i))) != 0)14741475#define C_u_i_pointer_u8_ref(ptr) C_fix(*((unsigned char *)C_block_item(ptr, 0)))1476#define C_u_i_pointer_s8_ref(ptr) C_fix(*((signed char *)C_block_item(ptr, 0)))1477#define C_u_i_pointer_u16_ref(ptr) C_fix(*((unsigned short *)C_block_item(ptr, 0)))1478#define C_u_i_pointer_s16_ref(ptr) C_fix(*((short *)C_block_item(ptr, 0)))1479#define C_a_u_i_pointer_u32_ref(ap, n, ptr) \1480 C_unsigned_int_to_num(ap, *((C_u32 *)C_block_item(ptr, 0)))1481#define C_a_u_i_pointer_s32_ref(ap, n, ptr) \1482 C_int_to_num(ap, *((C_s32 *)C_block_item(ptr, 0)))1483#define C_a_u_i_pointer_u64_ref(ap, n, ptr) \1484 C_uint64_to_num(ap, *((C_u64 *)C_block_item(ptr, 0)))1485#define C_a_u_i_pointer_s64_ref(ap, n, ptr) \1486 C_int64_to_num(ap, *((C_s64 *)C_block_item(ptr, 0)))1487#define C_a_u_i_pointer_f32_ref(ap, n, ptr) C_flonum(ap, *((float *)C_block_item(ptr, 0)))1488#define C_a_u_i_pointer_f64_ref(ap, n, ptr) C_flonum(ap, *((double *)C_block_item(ptr, 0)))1489#define C_u_i_pointer_u8_set(ptr, x) \1490 (*((unsigned char *)C_block_item(ptr, 0)) = C_unfix(x), C_SCHEME_UNDEFINED)1491#define C_u_i_pointer_s8_set(ptr, x) \1492 (*((signed char *)C_block_item(ptr, 0)) = C_unfix(x), C_SCHEME_UNDEFINED)1493#define C_u_i_pointer_u16_set(ptr, x) \1494 (*((unsigned short *)C_block_item(ptr, 0)) = C_unfix(x), C_SCHEME_UNDEFINED)1495#define C_u_i_pointer_s16_set(ptr, x) \1496 (*((short *)C_block_item(ptr, 0)) = C_unfix(x), C_SCHEME_UNDEFINED)1497#define C_u_i_pointer_u32_set(ptr, x) \1498 (*((C_u32 *)C_block_item(ptr, 0)) = C_num_to_unsigned_int(x), C_SCHEME_UNDEFINED)1499#define C_u_i_pointer_s32_set(ptr, x) \1500 (*((C_s32 *)C_block_item(ptr, 0)) = C_num_to_int(x), C_SCHEME_UNDEFINED)1501#define C_u_i_pointer_u64_set(ptr, x) \1502 (*((C_u64 *)C_block_item(ptr, 0)) = C_num_to_uint64(x), C_SCHEME_UNDEFINED)1503#define C_u_i_pointer_s64_set(ptr, x) \1504 (*((C_s64 *)C_block_item(ptr, 0)) = C_num_to_int64(x), C_SCHEME_UNDEFINED)1505#define C_u_i_pointer_f32_set(ptr, x) \1506 (*((float *)C_block_item(ptr, 0)) = C_flonum_magnitude(x), C_SCHEME_UNDEFINED)1507#define C_u_i_pointer_f64_set(ptr, x) \1508 (*((double *)C_block_item(ptr, 0)) = C_flonum_magnitude(x), C_SCHEME_UNDEFINED)15091510#ifdef C_BIG_ENDIAN1511# ifdef C_SIXTY_FOUR1512# define C_lihdr(x, y, z) ((C_LAMBDA_INFO_TYPE >> 56) & 0xff), \1513 0, 0, 0, 0, (x), (y), ((C_char)(z))1514# else1515# define C_lihdr(x, y, z) ((C_LAMBDA_INFO_TYPE >> 24) & 0xff), \1516 (x), (y), ((C_char)(z))1517# endif1518#else1519# ifdef C_SIXTY_FOUR1520# define C_lihdr(x, y, z) ((C_char)(z)), (y), (x), 0, 0, 0, 0, \1521 ((C_LAMBDA_INFO_TYPE >> 56) & 0xff)1522# else1523# define C_lihdr(x, y, z) ((C_char)(z)), (y), (x), \1524 ((C_LAMBDA_INFO_TYPE >> 24) & 0xff)1525# endif1526#endif15271528#define C_ub_i_flonum_plus(x, y) ((x) + (y))1529#define C_ub_i_flonum_difference(x, y) ((x) - (y))1530#define C_ub_i_flonum_times(x, y) ((x) * (y))1531#define C_ub_i_flonum_quotient(x, y) ((x) / (y))1532#define C_ub_i_flonum_multiply_add(x, y, z) C_fma((x), (y), (z))15331534#define C_ub_i_flonum_equalp(n1, n2) C_mk_bool((n1) == (n2))1535#define C_ub_i_flonum_greaterp(n1, n2) C_mk_bool((n1) > (n2))1536#define C_ub_i_flonum_lessp(n1, n2) C_mk_bool((n1) < (n2))1537#define C_ub_i_flonum_greater_or_equal_p(n1, n2) C_mk_bool((n1) >= (n2))1538#define C_ub_i_flonum_less_or_equal_p(n1, n2) C_mk_bool((n1) <= (n2))15391540#define C_ub_i_flonum_nanp(x) C_mk_bool(C_isnan(x))1541#define C_ub_i_flonum_infinitep(x) C_mk_bool(C_isinf(x))1542#define C_ub_i_flonum_finitep(x) C_mk_bool(C_isfinite(x))15431544#define C_ub_i_pointer_inc(p, n) ((void *)((unsigned char *)(p) + (n)))1545#define C_ub_i_pointer_eqp(p1, p2) C_mk_bool((p1) == (p2))1546#define C_ub_i_null_pointerp(p) C_mk_bool((p) == NULL)15471548#define C_ub_i_pointer_u8_ref(p) (*((unsigned char *)(p)))1549#define C_ub_i_pointer_s8_ref(p) (*((signed char *)(p)))1550#define C_ub_i_pointer_u16_ref(p) (*((unsigned short *)(p)))1551#define C_ub_i_pointer_s16_ref(p) (*((short *)(p)))1552#define C_ub_i_pointer_u32_ref(p) (*((C_u32 *)(p)))1553#define C_ub_i_pointer_s32_ref(p) (*((C_s32 *)(p)))1554#define C_ub_i_pointer_u64_ref(p) (*((C_u64 *)(p)))1555#define C_ub_i_pointer_s64_ref(p) (*((C_s64 *)(p)))1556#define C_ub_i_pointer_f32_ref(p) (*((float *)(p)))1557#define C_ub_i_pointer_f64_ref(p) (*((double *)(p)))1558#define C_ub_i_pointer_u8_set(p, n) (*((unsigned char *)(p)) = (n))1559#define C_ub_i_pointer_s8_set(p, n) (*((signed char *)(p)) = (n))1560#define C_ub_i_pointer_u16_set(p, n) (*((unsigned short *)(p)) = (n))1561#define C_ub_i_pointer_s16_set(p, n) (*((short *)(p)) = (n))1562#define C_ub_i_pointer_u32_set(p, n) (*((C_u32 *)(p)) = (n))1563#define C_ub_i_pointer_s32_set(p, n) (*((C_s32 *)(p)) = (n))1564#define C_ub_i_pointer_u64_set(p, n) (*((C_u64 *)(p)) = (n))1565#define C_ub_i_pointer_s64_set(p, n) (*((C_s64 *)(p)) = (n))1566#define C_ub_i_pointer_f32_set(p, n) (*((float *)(p)) = (n))1567#define C_ub_i_pointer_f64_set(p, n) (*((double *)(p)) = (n))15681569#ifdef C_PRIVATE_REPOSITORY1570# define C_private_repository() C_use_private_repository(C_executable_dirname())1571#else1572# define C_private_repository()1573#endif15741575#ifdef C_GUI1576# define C_set_gui_mode C_gui_mode = 11577#else1578# define C_set_gui_mode1579#endif15801581/**1582 * SEARCH_EXE_PATH is defined on platforms on which we must search for1583 * the current executable. Because this search is sensitive to things1584 * like CWD, PATH, and so on, it's done once at startup and saved in1585 * `C_main_exe`.1586 *1587 * On platforms where it's not defined, there's a simple way to1588 * retrieve a path to the current executable (such as reading1589 * "/proc/<pid>/exe" or some similar trick).1590 */1591#ifdef SEARCH_EXE_PATH1592# define C_set_main_exe(fname) C_main_exe = C_resolve_executable_pathname(fname)1593#else1594# define C_set_main_exe(fname)1595#endif15961597#if !defined(C_EMBEDDED) && !defined(C_SHARED)1598# if defined(C_GUI) && defined(_WIN32)1599# define C_main_entry_point \1600 int WINAPI WinMain(HINSTANCE me, HINSTANCE you, LPSTR cmdline, int show) \1601 { \1602 C_gui_mode = 1; \1603 C_set_main_exe(argv[0]); \1604 C_private_repository(); \1605 return CHICKEN_main(0, NULL, (void *)C_toplevel); \1606 }1607# else1608# define C_main_entry_point \1609 int main(int argc, char *argv[]) \1610 { \1611 C_set_gui_mode; \1612 C_set_main_exe(argv[0]); \1613 C_private_repository(); \1614 return CHICKEN_main(argc, argv, (void*)C_toplevel); \1615 }1616# endif1617#else1618# define C_main_entry_point1619#endif16201621#define C_alloc_flonum C_word *___tmpflonum = C_alloc(WORDS_PER_FLONUM)1622#define C_kontinue_flonum(k, n) C_kontinue((k), C_flonum(&___tmpflonum, (n)))16231624#define C_a_i_flonum_truncate(ptr, n, x) C_flonum(ptr, C_trunc(C_flonum_magnitude(x)))1625#define C_a_i_flonum_ceiling(ptr, n, x) C_flonum(ptr, C_ceil(C_flonum_magnitude(x)))1626#define C_a_i_flonum_floor(ptr, n, x) C_flonum(ptr, C_floor(C_flonum_magnitude(x)))1627#define C_a_i_flonum_round(ptr, n, x) C_flonum(ptr, C_round(C_flonum_magnitude(x)))16281629#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) ])1630#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) ])1631#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)1632#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)16331634#define C_ub_i_f32vector_ref(b, i) (((float *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])1635#define C_ub_i_f64vector_ref(b, i) (((double *)C_data_pointer(C_block_item((b), 1)))[ C_unfix(i) ])1636#define C_ub_i_f32vector_set(v, i, x) ((((float *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = (x)), 0)1637#define C_ub_i_f64vector_set(v, i, x) ((((double *)C_data_pointer(C_block_item((v), 1)))[ C_unfix(i) ] = (x)), 0)16381639#define C_a_i_flonum_sin(ptr, c, x) C_flonum(ptr, C_sin(C_flonum_magnitude(x)))1640#define C_a_i_flonum_cos(ptr, c, x) C_flonum(ptr, C_cos(C_flonum_magnitude(x)))1641#define C_a_i_flonum_tan(ptr, c, x) C_flonum(ptr, C_tan(C_flonum_magnitude(x)))1642#define C_a_i_flonum_asin(ptr, c, x) C_flonum(ptr, C_asin(C_flonum_magnitude(x)))1643#define C_a_i_flonum_acos(ptr, c, x) C_flonum(ptr, C_acos(C_flonum_magnitude(x)))1644#define C_a_i_flonum_atan(ptr, c, x) C_flonum(ptr, C_atan(C_flonum_magnitude(x)))1645#define C_a_i_flonum_atan2(ptr, c, x, y) C_flonum(ptr, C_atan2(C_flonum_magnitude(x), C_flonum_magnitude(y)))1646#define C_a_i_flonum_sinh(ptr, c, x) C_flonum(ptr, C_sinh(C_flonum_magnitude(x)))1647#define C_a_i_flonum_cosh(ptr, c, x) C_flonum(ptr, C_cosh(C_flonum_magnitude(x)))1648#define C_a_i_flonum_tanh(ptr, c, x) C_flonum(ptr, C_tanh(C_flonum_magnitude(x)))1649#define C_a_i_flonum_asinh(ptr, c, x) C_flonum(ptr, C_asinh(C_flonum_magnitude(x)))1650#define C_a_i_flonum_acosh(ptr, c, x) C_flonum(ptr, C_acosh(C_flonum_magnitude(x)))1651#define C_a_i_flonum_atanh(ptr, c, x) C_flonum(ptr, C_atanh(C_flonum_magnitude(x)))1652#define C_a_i_flonum_exp(ptr, c, x) C_flonum(ptr, C_exp(C_flonum_magnitude(x)))1653#define C_a_i_flonum_expt(ptr, c, x, y) C_flonum(ptr, C_pow(C_flonum_magnitude(x), C_flonum_magnitude(y)))1654#define C_a_i_flonum_log(ptr, c, x) C_flonum(ptr, C_log(C_flonum_magnitude(x)))1655#define C_a_i_flonum_sqrt(ptr, c, x) C_flonum(ptr, C_sqrt(C_flonum_magnitude(x)))1656#define C_a_i_flonum_abs(ptr, c, x) C_flonum(ptr, C_fabs(C_flonum_magnitude(x)))1657#define C_u_i_flonum_nanp(x) C_mk_bool(C_isnan(C_flonum_magnitude(x)))1658#define C_u_i_flonum_infinitep(x) C_mk_bool(C_isinf(C_flonum_magnitude(x)))1659#define C_u_i_flonum_finitep(x) C_mk_bool(C_isfinite(C_flonum_magnitude(x)))16601661/* DEPRECATED */1662#define C_a_i_current_milliseconds(ptr, c, dummy) C_uint64_to_num(ptr, C_milliseconds())1663#define C_a_i_current_process_milliseconds(ptr, c, dummy) C_uint64_to_num(ptr, C_current_process_milliseconds())16641665#define C_i_noop1(dummy) ((dummy), C_SCHEME_UNDEFINED)1666#define C_i_noop2(dummy1, dummy2) ((dummy1), (dummy2), C_SCHEME_UNDEFINED)1667#define C_i_noop3(dummy1, dummy2, dummy3) ((dummy1), (dummy2), (dummy3), C_SCHEME_UNDEFINED)1668#define C_i_true1(dummy) ((dummy), C_SCHEME_TRUE)1669#define C_i_true2(dummy1, dummy2) ((dummy1), (dummy2), C_SCHEME_TRUE)1670#define C_i_true3(dummy1, dummy2, dummy3) ((dummy1), (dummy2), (dummy3), C_SCHEME_TRUE)16711672/* debug client interface */16731674typedef struct C_DEBUG_INFO {1675 int event;1676 int enabled;1677 C_char *loc;1678 C_char *val;1679} C_DEBUG_INFO;16801681#define C_DEBUG_CALL 11682#define C_DEBUG_GLOBAL_ASSIGN 21683#define C_DEBUG_GC 31684#define C_DEBUG_ENTRY 41685#define C_DEBUG_SIGNAL 51686#define C_DEBUG_CONNECT 61687#define C_DEBUG_LISTEN 71688#define C_DEBUG_INTERRUPTED 816891690#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)16911692/* Variables: */16931694C_varextern C_TLS time_t C_startup_time_seconds;1695C_varextern C_TLS C_word1696 *C_temporary_stack,1697 *C_temporary_stack_bottom,1698 *C_temporary_stack_limit,1699 *C_stack_limit,1700 *C_stack_hard_limit,1701 *C_scratchspace_start,1702 *C_scratchspace_top,1703 *C_scratchspace_limit,1704 C_scratch_usage;1705C_varextern C_TLS C_long1706 C_timer_interrupt_counter,1707 C_initial_timer_interrupt_period;1708C_varextern C_TLS C_byte1709 *C_fromspace_top,1710 *C_fromspace_limit;1711#ifdef HAVE_SIGSETJMP1712C_varextern C_TLS sigjmp_buf C_restart;1713#else1714C_varextern C_TLS jmp_buf C_restart;1715#endif1716C_varextern C_TLS void *C_restart_address;1717C_varextern C_TLS int C_entry_point_status;1718C_varextern C_TLS int C_gui_mode;17191720C_varextern C_TLS void *C_restart_trampoline;1721C_varextern C_TLS void (*C_pre_gc_hook)(int mode);1722C_varextern C_TLS void (*C_post_gc_hook)(int mode, C_long ms);1723C_varextern C_TLS void (*C_panic_hook)(C_char *msg);1724C_varextern C_TLS C_word (*C_debugger_hook)(C_DEBUG_INFO *cell, C_word c, C_word *av, char *cloc);17251726C_varextern C_TLS int1727 C_abort_on_thread_exceptions,1728 C_interrupts_enabled,1729 C_disable_overflow_check,1730 C_heap_size_is_fixed,1731 C_max_pending_finalizers,1732 C_trace_buffer_size,1733 C_debugging,1734 C_main_argc;1735C_varextern C_TLS C_uword1736 C_heap_growth,1737 C_heap_shrinkage;1738C_varextern C_TLS char1739 **C_main_argv,1740#ifdef SEARCH_EXE_PATH1741 *C_main_exe,1742#endif1743 *C_dlerror;1744C_varextern C_TLS C_uword C_maximal_heap_size;1745C_varextern C_TLS int (*C_gc_mutation_hook)(C_word *slot, C_word val);1746C_varextern C_TLS void (*C_gc_trace_hook)(C_word *var, int mode);1747C_varextern C_TLS C_word (*C_get_unbound_variable_value_hook)(C_word sym);174817491750/* Prototypes: */17511752C_BEGIN_C_DECLS17531754C_fctexport void C_register_debug_info(C_DEBUG_INFO *);1755C_fctexport int CHICKEN_main(int argc, char *argv[], void *toplevel);1756C_fctexport int CHICKEN_initialize(int heap, int stack, int symbols, void *toplevel);1757C_fctexport C_word CHICKEN_run(void *toplevel);1758C_fctexport C_word CHICKEN_continue(C_word k);1759C_fctexport void *CHICKEN_new_gc_root();1760C_fctexport void *CHICKEN_new_finalizable_gc_root();1761C_fctexport void *CHICKEN_new_gc_root_2(int finalizable);1762C_fctexport void CHICKEN_delete_gc_root(void *root);1763C_fctexport void *CHICKEN_global_lookup(char *name);1764C_fctexport int CHICKEN_is_running();1765C_fctexport void CHICKEN_interrupt();17661767C_fctexport void C_check_nursery_minimum(C_word size);1768C_fctexport int C_fcall C_save_callback_continuation(C_word **ptr, C_word k);1769C_fctexport C_word C_fcall C_restore_callback_continuation(void);1770C_fctexport C_word C_fcall C_restore_callback_continuation2(int level);1771C_fctexport C_word C_fcall C_callback(C_word closure, int argc);1772C_fctexport C_word C_fcall C_callback_wrapper(void *proc, int argc);1773C_fctexport void C_fcall C_callback_adjust_stack(C_word *base, int size);1774C_fctexport void CHICKEN_parse_command_line(int argc, char *argv[], C_word *heap, C_word *stack, C_word *symbols);1775C_fctexport void C_fcall C_toplevel_entry(C_char *name) C_regparm;1776C_fctexport C_word C_fcall C_a_i_provide(C_word **a, int c, C_word id) C_regparm;1777C_fctexport C_word C_fcall C_i_providedp(C_word id) C_regparm;1778C_fctexport C_word C_fcall C_enable_interrupts(void) C_regparm;1779C_fctexport C_word C_fcall C_disable_interrupts(void) C_regparm;1780C_fctexport void C_set_or_change_heap_size(C_word heap, int reintern);1781C_fctexport void C_do_resize_stack(C_word stack);1782C_fctexport C_word C_resize_pending_finalizers(C_word size);1783C_fctexport void C_initialize_lf(C_word *lf, int count);1784C_fctexport void *C_register_lf(C_word *lf, int count);1785C_fctexport void *C_register_lf2(C_word *lf, int count, C_PTABLE_ENTRY *ptable);1786C_fctexport void C_unregister_lf(void *handle);1787C_fctexport C_char *C_dump_trace(int start);1788C_fctexport void C_fcall C_clear_trace_buffer(void) C_regparm;1789C_fctexport C_word C_resize_trace_buffer(C_word size);1790C_fctexport C_word C_fetch_trace(C_word start, C_word buffer);1791C_fctexport C_word C_fcall C_string(C_word **ptr, int len, C_char *str) C_regparm;1792C_fctexport C_word C_fcall C_static_string(C_word **ptr, int len, C_char *str) C_regparm;1793C_fctexport C_word C_fcall C_static_bignum(C_word **ptr, int len, C_char *str) C_regparm;1794C_fctexport C_word C_fcall C_static_bytevector(C_word **ptr, int len, C_char *str) C_regparm;1795C_fctexport C_word C_fcall C_static_lambda_info(C_word **ptr, int len, C_char *str) C_regparm;1796C_fctexport C_word C_fcall C_bytevector(C_word **ptr, int len, C_char *str) C_regparm;1797C_fctexport C_word C_fcall C_pbytevector(int len, C_char *str) C_regparm;1798C_fctexport C_word C_fcall C_string_aligned8(C_word **ptr, int len, C_char *str) C_regparm;1799C_fctexport C_word C_fcall C_string2(C_word **ptr, C_char *str) C_regparm;1800C_fctexport C_word C_fcall C_string2_safe(C_word **ptr, int max, C_char *str) C_regparm;1801C_fctexport C_word C_fcall C_intern(C_word **ptr, int len, C_char *str) C_regparm;1802C_fctexport C_word C_fcall C_intern_kw(C_word **ptr, int len, C_char *str) C_regparm;1803C_fctexport C_word C_fcall C_intern_in(C_word **ptr, int len, C_char *str, C_SYMBOL_TABLE *stable) C_regparm;1804C_fctexport C_word C_fcall C_h_intern(C_word *slot, int len, C_char *str) C_regparm;1805C_fctexport C_word C_fcall C_h_intern_kw(C_word *slot, int len, C_char *str) C_regparm;1806C_fctexport C_word C_fcall C_h_intern_in(C_word *slot, int len, C_char *str, C_SYMBOL_TABLE *stable) C_regparm;1807C_fctexport C_word C_fcall C_intern2(C_word **ptr, C_char *str) C_regparm;1808C_fctexport C_word C_fcall C_intern3(C_word **ptr, C_char *str, C_word value) C_regparm;1809C_fctexport C_word C_fcall C_build_rest(C_word **ptr, C_word c, C_word n, C_word *av) C_regparm;1810C_fctexport void C_bad_memory(void) C_noret;1811C_fctexport void C_bad_memory_2(void) C_noret;1812C_fctexport void C_bad_argc(int c, int n) C_noret;1813C_fctexport void C_bad_min_argc(int c, int n) C_noret;1814C_fctexport void C_bad_argc_2(int c, int n, C_word closure) C_noret;1815C_fctexport void C_bad_min_argc_2(int c, int n, C_word closure) C_noret;1816C_fctexport void C_stack_overflow(C_char *loc) C_noret;1817C_fctexport void C_unbound_error(C_word sym) C_noret;1818C_fctexport void C_no_closure_error(C_word x) C_noret;1819C_fctexport void C_div_by_zero_error(char *loc) C_noret;1820C_fctexport void C_not_an_integer_error(char *loc, C_word x) C_noret;1821C_fctexport void C_not_an_uinteger_error(char *loc, C_word x) C_noret;1822C_fctexport void C_rest_arg_out_of_bounds_error(C_word c, C_word n, C_word ka) C_noret;1823C_fctexport void C_rest_arg_out_of_bounds_error_2(C_word c, C_word n, C_word ka, C_word closure) C_noret;1824C_fctexport C_word C_closure(C_word **ptr, int cells, C_word proc, ...);1825C_fctexport C_word C_fcall C_pair(C_word **ptr, C_word car, C_word cdr) C_regparm;1826C_fctexport C_word C_fcall C_number(C_word **ptr, double n) C_regparm;1827C_fctexport C_word C_fcall C_mpointer(C_word **ptr, void *mp) C_regparm;1828C_fctexport C_word C_fcall C_mpointer_or_false(C_word **ptr, void *mp) C_regparm;1829C_fctexport C_word C_fcall C_taggedmpointer(C_word **ptr, C_word tag, void *mp) C_regparm;1830C_fctexport C_word C_fcall C_taggedmpointer_or_false(C_word **ptr, C_word tag, void *mp) C_regparm;1831C_fctexport C_word C_vector(C_word **ptr, int n, ...);1832C_fctexport C_word C_structure(C_word **ptr, int n, ...);1833C_fctexport C_word C_fcall C_mutate_slot(C_word *slot, C_word val) C_regparm;1834C_fctexport C_word C_fcall C_scratch_alloc(C_uword size) C_regparm;1835C_fctexport C_word C_fcall C_migrate_buffer_object(C_word **ptr, C_word *start, C_word *end, C_word obj) C_regparm;1836C_fctexport void C_fcall C_reclaim(void *trampoline, C_word c) C_regparm C_noret;1837C_fctexport void C_save_and_reclaim(void *trampoline, int n, C_word *av) C_noret;1838C_fctexport void C_save_and_reclaim_args(void *trampoline, int n, ...) C_noret;1839C_fctexport void C_fcall C_rereclaim2(C_uword size, int relative_resize) C_regparm;1840C_fctexport void C_unbound_variable(C_word sym);1841C_fctexport C_word C_fcall C_retrieve2(C_word val, char *name) C_regparm;1842C_fctexport void *C_fcall C_retrieve2_symbol_proc(C_word val, char *name) C_regparm;1843C_fctexport int C_in_stackp(C_word x) C_regparm;1844C_fctexport int C_fcall C_in_heapp(C_word x) C_regparm;1845C_fctexport int C_fcall C_in_fromspacep(C_word x) C_regparm;1846C_fctexport int C_fcall C_in_scratchspacep(C_word x) C_regparm;1847C_fctexport void C_fcall C_trace(C_char *name) C_regparm;1848C_fctexport C_word C_fcall C_emit_trace_info2(char *raw, C_word l, C_word x, C_word y, C_word t) C_regparm;1849C_fctexport C_word C_fcall C_u_i_string_hash(C_word str, C_word rnd) C_regparm;1850C_fctexport C_word C_fcall C_u_i_string_ci_hash(C_word str, C_word rnd) C_regparm;1851C_fctexport C_word C_halt(C_word msg);1852C_fctexport C_word C_message(C_word msg);1853C_fctexport C_word C_fcall C_equalp(C_word x, C_word y) C_regparm;1854C_fctexport C_word C_fcall C_set_gc_report(C_word flag) C_regparm;1855C_fctexport C_word C_fcall C_start_timer(void) C_regparm;1856C_fctexport C_word C_exit_runtime(C_word code) C_noret;1857C_fctexport C_word C_fcall C_set_print_precision(C_word n) C_regparm;1858C_fctexport C_word C_fcall C_get_print_precision(void) C_regparm;1859C_fctexport C_word C_fcall C_read_char(C_word port) C_regparm;1860C_fctexport C_word C_fcall C_peek_char(C_word port) C_regparm;1861C_fctexport C_word C_fcall C_execute_shell_command(C_word string) C_regparm;1862C_fctexport int C_fcall C_check_fd_ready(int fd) C_regparm;1863C_fctexport C_word C_fcall C_char_ready_p(C_word port) C_regparm;1864C_fctexport void C_fcall C_raise_interrupt(int reason) C_regparm;1865C_fctexport C_word C_fcall C_establish_signal_handler(C_word signum, C_word reason) C_regparm;1866C_fctexport C_word C_fcall C_copy_block(C_word from, C_word to) C_regparm;1867C_fctexport C_word C_fcall C_evict_block(C_word from, C_word ptr) C_regparm;1868C_fctexport void C_fcall C_gc_protect(C_word **addr, int n) C_regparm;1869C_fctexport void C_fcall C_gc_unprotect(int n) C_regparm;1870C_fctexport C_SYMBOL_TABLE *C_new_symbol_table(char *name, unsigned int size) C_regparm;1871C_fctexport C_SYMBOL_TABLE *C_find_symbol_table(char *name) C_regparm;1872C_fctexport C_word C_find_symbol(C_word str, C_SYMBOL_TABLE *stable) C_regparm;1873C_fctexport C_word C_find_keyword(C_word str, C_SYMBOL_TABLE *stable) C_regparm;1874C_fctexport C_word C_fcall C_lookup_symbol(C_word sym) C_regparm;1875C_fctexport void C_do_register_finalizer(C_word x, C_word proc);1876C_fctexport int C_do_unregister_finalizer(C_word x);1877C_fctexport C_word C_dbg_hook(C_word x);1878C_fctexport void C_use_private_repository(C_char *path);1879C_fctexport C_char *C_private_repository_path();1880C_fctexport C_char *C_executable_dirname();1881C_fctexport C_char *C_executable_pathname();1882C_fctexport C_char *C_resolve_executable_pathname(C_char *fname);18831884C_fctimport C_cpsproc(C_toplevel) C_noret;1885C_fctimport C_cpsproc(C_invalid_procedure) C_noret;1886C_fctexport C_cpsproc(C_stop_timer) C_noret;1887C_fctexport C_cpsproc(C_signum) C_noret;1888C_fctexport C_cpsproc(C_apply) C_noret;1889C_fctexport C_cpsproc(C_call_cc) C_noret;1890C_fctexport C_cpsproc(C_continuation_graft) C_noret;1891C_fctexport C_cpsproc(C_values) C_noret;1892C_fctexport C_cpsproc(C_apply_values) C_noret;1893C_fctexport C_cpsproc(C_call_with_values) C_noret;1894C_fctexport C_cpsproc(C_u_call_with_values) C_noret;1895C_fctexport C_cpsproc(C_times) C_noret;1896C_fctexport C_cpsproc(C_plus) C_noret;1897C_fctexport C_cpsproc(C_minus) C_noret;1898C_fctexport C_cpsproc(C_quotient_and_remainder) C_noret;1899C_fctexport C_cpsproc(C_u_integer_quotient_and_remainder) C_noret;1900C_fctexport C_cpsproc(C_bitwise_and) C_noret;1901C_fctexport C_cpsproc(C_bitwise_ior) C_noret;1902C_fctexport C_cpsproc(C_bitwise_xor) C_noret;19031904C_fctexport C_cpsproc(C_nequalp) C_noret;1905C_fctexport C_cpsproc(C_greaterp) C_noret;1906C_fctexport C_cpsproc(C_lessp) C_noret;1907C_fctexport C_cpsproc(C_greater_or_equal_p) C_noret;1908C_fctexport C_cpsproc(C_less_or_equal_p) C_noret;1909C_fctexport C_cpsproc(C_gc) C_noret;1910C_fctexport C_cpsproc(C_open_file_port) C_noret;1911C_fctexport C_cpsproc(C_allocate_vector) C_noret;1912C_fctexport C_cpsproc(C_string_to_symbol) C_noret;1913C_fctexport C_cpsproc(C_string_to_keyword) C_noret;1914C_fctexport C_cpsproc(C_build_symbol) C_noret;1915C_fctexport C_cpsproc(C_number_to_string) C_noret;1916C_fctexport C_cpsproc(C_fixnum_to_string) C_noret;1917C_fctexport C_cpsproc(C_flonum_to_string) C_noret;1918C_fctexport C_cpsproc(C_integer_to_string) C_noret;1919C_fctexport C_cpsproc(C_make_structure) C_noret;1920C_fctexport C_cpsproc(C_make_symbol) C_noret;1921C_fctexport C_cpsproc(C_make_pointer) C_noret;1922C_fctexport C_cpsproc(C_make_tagged_pointer) C_noret;1923C_fctexport C_cpsproc(C_ensure_heap_reserve) C_noret;1924C_fctexport C_cpsproc(C_return_to_host) C_noret;1925C_fctexport C_cpsproc(C_get_symbol_table_info) C_noret;1926C_fctexport C_cpsproc(C_get_memory_info) C_noret;1927C_fctexport C_cpsproc(C_context_switch) C_noret;1928C_fctexport C_cpsproc(C_peek_signed_integer) C_noret;1929C_fctexport C_cpsproc(C_peek_unsigned_integer) C_noret;1930C_fctexport C_cpsproc(C_peek_int64) C_noret;1931C_fctexport C_cpsproc(C_peek_uint64) C_noret;1932C_fctexport C_cpsproc(C_decode_seconds) C_noret;1933C_fctexport C_cpsproc(C_software_type) C_noret;1934C_fctexport C_cpsproc(C_machine_type) C_noret;1935C_fctexport C_cpsproc(C_machine_byte_order) C_noret;1936C_fctexport C_cpsproc(C_software_version) C_noret;1937C_fctexport C_cpsproc(C_build_platform) C_noret;1938C_fctexport C_cpsproc(C_register_finalizer) C_noret;1939C_fctexport C_cpsproc(C_set_dlopen_flags) C_noret;1940C_fctexport C_cpsproc(C_dload) C_noret;1941C_fctexport C_cpsproc(C_become) C_noret;1942C_fctexport C_cpsproc(C_call_with_cthulhu) C_noret;1943C_fctexport C_cpsproc(C_copy_closure) C_noret;1944C_fctexport C_cpsproc(C_dump_heap_state) C_noret;1945C_fctexport C_cpsproc(C_filter_heap_objects) C_noret;19461947C_fctexport time_t C_fcall C_seconds(C_long *ms) C_regparm;1948C_fctexport C_word C_fcall C_bignum_simplify(C_word big) C_regparm;1949C_fctexport C_word C_fcall C_allocate_scratch_bignum(C_word **ptr, C_word size, C_word negp, C_word initp) C_regparm;1950C_fctexport C_word C_fcall C_bignum_rewrap(C_word **p, C_word big) C_regparm;1951C_fctexport C_word C_i_dump_statistical_profile();1952C_fctexport C_word C_a_i_list(C_word **a, int c, ...);1953C_fctexport C_word C_a_i_string(C_word **a, int c, ...);1954C_fctexport C_word C_a_i_record(C_word **a, int c, ...);1955C_fctexport C_word C_a_i_port(C_word **a, int c);1956C_fctexport C_word C_fcall C_a_i_bytevector(C_word **a, int c, C_word x) C_regparm;1957C_fctexport C_word C_fcall C_i_listp(C_word x) C_regparm;1958C_fctexport C_word C_fcall C_i_u8vectorp(C_word x) C_regparm;1959C_fctexport C_word C_fcall C_i_s8vectorp(C_word x) C_regparm;1960C_fctexport C_word C_fcall C_i_u16vectorp(C_word x) C_regparm;1961C_fctexport C_word C_fcall C_i_s16vectorp(C_word x) C_regparm;1962C_fctexport C_word C_fcall C_i_u32vectorp(C_word x) C_regparm;1963C_fctexport C_word C_fcall C_i_s32vectorp(C_word x) C_regparm;1964C_fctexport C_word C_fcall C_i_u64vectorp(C_word x) C_regparm;1965C_fctexport C_word C_fcall C_i_s64vectorp(C_word x) C_regparm;1966C_fctexport C_word C_fcall C_i_f32vectorp(C_word x) C_regparm;1967C_fctexport C_word C_fcall C_i_f64vectorp(C_word x) C_regparm;1968C_fctexport C_word C_fcall C_i_string_equal_p(C_word x, C_word y) C_regparm;1969C_fctexport C_word C_fcall C_i_string_ci_equal_p(C_word x, C_word y) C_regparm;1970C_fctexport C_word C_fcall C_i_set_car(C_word p, C_word x) C_regparm;1971C_fctexport C_word C_fcall C_i_set_cdr(C_word p, C_word x) C_regparm;1972C_fctexport C_word C_fcall C_i_vector_set(C_word v, C_word i, C_word x) C_regparm;1973C_fctexport C_word C_fcall C_i_u8vector_set(C_word v, C_word i, C_word x) C_regparm;1974C_fctexport C_word C_fcall C_i_s8vector_set(C_word v, C_word i, C_word x) C_regparm;1975C_fctexport C_word C_fcall C_i_u16vector_set(C_word v, C_word i, C_word x) C_regparm;1976C_fctexport C_word C_fcall C_i_s16vector_set(C_word v, C_word i, C_word x) C_regparm;1977C_fctexport C_word C_fcall C_i_u32vector_set(C_word v, C_word i, C_word x) C_regparm;1978C_fctexport C_word C_fcall C_i_s32vector_set(C_word v, C_word i, C_word x) C_regparm;1979C_fctexport C_word C_fcall C_i_u64vector_set(C_word v, C_word i, C_word x) C_regparm;1980C_fctexport C_word C_fcall C_i_s64vector_set(C_word v, C_word i, C_word x) C_regparm;1981C_fctexport C_word C_fcall C_i_f32vector_set(C_word v, C_word i, C_word x) C_regparm;1982C_fctexport C_word C_fcall C_i_f64vector_set(C_word v, C_word i, C_word x) C_regparm;1983C_fctexport C_word C_fcall C_i_exactp(C_word x) C_regparm;1984C_fctexport C_word C_fcall C_i_inexactp(C_word x) C_regparm;1985C_fctexport C_word C_fcall C_i_nanp(C_word x) C_regparm;1986C_fctexport C_word C_fcall C_i_finitep(C_word x) C_regparm;1987C_fctexport C_word C_fcall C_i_infinitep(C_word x) C_regparm;1988C_fctexport C_word C_fcall C_i_zerop(C_word x) C_regparm;1989C_fctexport C_word C_fcall C_u_i_zerop(C_word x) C_regparm; /* DEPRECATED */1990C_fctexport C_word C_fcall C_i_positivep(C_word x) C_regparm;1991C_fctexport C_word C_fcall C_i_integer_positivep(C_word x) C_regparm;1992C_fctexport C_word C_fcall C_i_negativep(C_word x) C_regparm;1993C_fctexport C_word C_fcall C_i_integer_negativep(C_word x) C_regparm;1994C_fctexport C_word C_fcall C_i_car(C_word x) C_regparm;1995C_fctexport C_word C_fcall C_i_cdr(C_word x) C_regparm;1996C_fctexport C_word C_fcall C_i_caar(C_word x) C_regparm;1997C_fctexport C_word C_fcall C_i_cadr(C_word x) C_regparm;1998C_fctexport C_word C_fcall C_i_cdar(C_word x) C_regparm;1999C_fctexport C_word C_fcall C_i_cddr(C_word x) C_regparm;2000C_fctexport C_word C_fcall C_i_caddr(C_word x) C_regparm;2001C_fctexport C_word C_fcall C_i_cdddr(C_word x) C_regparm;2002C_fctexport C_word C_fcall C_i_cadddr(C_word x) C_regparm;2003C_fctexport C_word C_fcall C_i_cddddr(C_word x) C_regparm;2004C_fctexport C_word C_fcall C_i_list_tail(C_word lst, C_word i) C_regparm;2005C_fctexport C_word C_fcall C_i_evenp(C_word x) C_regparm;2006C_fctexport C_word C_fcall C_i_integer_evenp(C_word x) C_regparm;2007C_fctexport C_word C_fcall C_i_oddp(C_word x) C_regparm;2008C_fctexport C_word C_fcall C_i_integer_oddp(C_word x) C_regparm;2009C_fctexport C_word C_fcall C_i_vector_ref(C_word v, C_word i) C_regparm;2010C_fctexport C_word C_fcall C_i_u8vector_ref(C_word v, C_word i) C_regparm;2011C_fctexport C_word C_fcall C_i_s8vector_ref(C_word v, C_word i) C_regparm;2012C_fctexport C_word C_fcall C_i_u16vector_ref(C_word v, C_word i) C_regparm;2013C_fctexport C_word C_fcall C_i_s16vector_ref(C_word v, C_word i) C_regparm;2014C_fctexport C_word C_fcall C_a_i_u32vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;2015C_fctexport C_word C_fcall C_a_i_s32vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;2016C_fctexport C_word C_fcall C_a_i_u64vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;2017C_fctexport C_word C_fcall C_a_i_s64vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;2018C_fctexport C_word C_fcall C_a_i_f32vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;2019C_fctexport C_word C_fcall C_a_i_f64vector_ref(C_word **ptr, C_word c, C_word v, C_word i) C_regparm;2020C_fctexport C_word C_fcall C_i_block_ref(C_word x, C_word i) C_regparm;2021C_fctexport C_word C_fcall C_i_string_set(C_word s, C_word i, C_word c) C_regparm;2022C_fctexport C_word C_fcall C_i_string_ref(C_word s, C_word i) C_regparm;2023C_fctexport C_word C_fcall C_i_vector_length(C_word v) C_regparm;2024C_fctexport C_word C_fcall C_i_u8vector_length(C_word v) C_regparm;2025C_fctexport C_word C_fcall C_i_s8vector_length(C_word v) C_regparm;2026C_fctexport C_word C_fcall C_i_u16vector_length(C_word v) C_regparm;2027C_fctexport C_word C_fcall C_i_s16vector_length(C_word v) C_regparm;2028C_fctexport C_word C_fcall C_i_u32vector_length(C_word v) C_regparm;2029C_fctexport C_word C_fcall C_i_s32vector_length(C_word v) C_regparm;2030C_fctexport C_word C_fcall C_i_u64vector_length(C_word v) C_regparm;2031C_fctexport C_word C_fcall C_i_s64vector_length(C_word v) C_regparm;2032C_fctexport C_word C_fcall C_i_f32vector_length(C_word v) C_regparm;2033C_fctexport C_word C_fcall C_i_f64vector_length(C_word v) C_regparm;2034C_fctexport C_word C_fcall C_i_string_length(C_word s) C_regparm;2035C_fctexport C_word C_fcall C_i_assq(C_word x, C_word lst) C_regparm;2036C_fctexport C_word C_fcall C_i_assv(C_word x, C_word lst) C_regparm;2037C_fctexport C_word C_fcall C_i_assoc(C_word x, C_word lst) C_regparm;2038C_fctexport C_word C_fcall C_i_memq(C_word x, C_word lst) C_regparm;2039C_fctexport C_word C_fcall C_u_i_memq(C_word x, C_word lst) C_regparm;2040C_fctexport C_word C_fcall C_i_memv(C_word x, C_word lst) C_regparm;2041C_fctexport C_word C_fcall C_i_member(C_word x, C_word lst) C_regparm;2042C_fctexport C_word C_fcall C_i_length(C_word lst) C_regparm;2043C_fctexport C_word C_fcall C_u_i_length(C_word lst) C_regparm;2044C_fctexport C_word C_fcall C_i_check_closure_2(C_word x, C_word loc) C_regparm;2045C_fctexport C_word C_fcall C_i_check_fixnum_2(C_word x, C_word loc) C_regparm;2046C_fctexport C_word C_fcall C_i_check_exact_2(C_word x, C_word loc) C_regparm; /* DEPRECATED */2047C_fctexport C_word C_fcall C_i_check_inexact_2(C_word x, C_word loc) C_regparm;2048C_fctexport C_word C_fcall C_i_check_number_2(C_word x, C_word loc) C_regparm;2049C_fctexport C_word C_fcall C_i_check_string_2(C_word x, C_word loc) C_regparm;2050C_fctexport C_word C_fcall C_i_check_bytevector_2(C_word x, C_word loc) C_regparm;2051C_fctexport C_word C_fcall C_i_check_symbol_2(C_word x, C_word loc) C_regparm;2052C_fctexport C_word C_fcall C_i_check_keyword_2(C_word x, C_word loc) C_regparm;2053C_fctexport C_word C_fcall C_i_check_list_2(C_word x, C_word loc) C_regparm;2054C_fctexport C_word C_fcall C_i_check_pair_2(C_word x, C_word loc) C_regparm;2055C_fctexport C_word C_fcall C_i_check_boolean_2(C_word x, C_word loc) C_regparm;2056C_fctexport C_word C_fcall C_i_check_locative_2(C_word x, C_word loc) C_regparm;2057C_fctexport C_word C_fcall C_i_check_vector_2(C_word x, C_word loc) C_regparm;2058C_fctexport C_word C_fcall C_i_check_structure_2(C_word x, C_word st, C_word loc) C_regparm;2059C_fctexport C_word C_fcall C_i_check_char_2(C_word x, C_word loc) C_regparm;2060C_fctexport C_word C_fcall C_i_check_port_2(C_word x, C_word in, C_word op, C_word loc) C_regparm;2061C_fctexport C_word C_fcall C_i_bignum_cmp(C_word x, C_word y) C_regparm;2062C_fctexport C_word C_fcall C_i_nequalp(C_word x, C_word y) C_regparm;2063C_fctexport C_word C_fcall C_i_integer_equalp(C_word x, C_word y) C_regparm;2064C_fctexport C_word C_fcall C_i_greaterp(C_word x, C_word y) C_regparm;2065C_fctexport C_word C_fcall C_i_integer_greaterp(C_word x, C_word y) C_regparm;2066C_fctexport C_word C_fcall C_i_lessp(C_word x, C_word y) C_regparm;2067C_fctexport C_word C_fcall C_i_integer_lessp(C_word x, C_word y) C_regparm;2068C_fctexport C_word C_fcall C_i_greater_or_equalp(C_word x, C_word y) C_regparm;2069C_fctexport C_word C_fcall C_i_integer_greater_or_equalp(C_word x, C_word y) C_regparm;2070C_fctexport C_word C_fcall C_i_less_or_equalp(C_word x, C_word y) C_regparm;2071C_fctexport C_word C_fcall C_i_integer_less_or_equalp(C_word x, C_word y) C_regparm;2072C_fctexport C_word C_fcall C_i_not_pair_p_2(C_word x) C_regparm;2073C_fctexport C_word C_fcall C_i_null_list_p(C_word x) C_regparm;2074C_fctexport C_word C_fcall C_i_string_null_p(C_word x) C_regparm;2075C_fctexport C_word C_fcall C_i_null_pointerp(C_word x) C_regparm;2076C_fctexport C_word C_fcall C_i_char_equalp(C_word x, C_word y) C_regparm;2077C_fctexport C_word C_fcall C_i_char_greaterp(C_word x, C_word y) C_regparm;2078C_fctexport C_word C_fcall C_i_char_lessp(C_word x, C_word y) C_regparm;2079C_fctexport C_word C_fcall C_i_char_greater_or_equal_p(C_word x, C_word y) C_regparm;2080C_fctexport C_word C_fcall C_i_char_less_or_equal_p(C_word x, C_word y) C_regparm;2081C_fctexport C_word C_fcall C_a_i_locative_ref(C_word **a, int c, C_word loc) C_regparm;2082C_fctexport C_word C_fcall C_i_locative_set(C_word loc, C_word x) C_regparm;2083C_fctexport C_word C_fcall C_i_locative_to_object(C_word loc) C_regparm;2084C_fctexport C_word C_fcall C_i_locative_index(C_word loc) C_regparm;2085C_fctexport C_word C_fcall C_a_i_make_locative(C_word **a, int c, C_word type, C_word object, C_word index, C_word weak) C_regparm;2086C_fctexport C_word C_fcall C_i_bit_to_bool(C_word n, C_word i) C_regparm; /* DEPRECATED */2087C_fctexport C_word C_fcall C_i_integer_length(C_word x) C_regparm;2088C_fctexport C_word C_fcall C_a_i_exp(C_word **a, int c, C_word n) C_regparm;2089C_fctexport C_word C_fcall C_a_i_log(C_word **a, int c, C_word n) C_regparm;2090C_fctexport C_word C_fcall C_a_i_sin(C_word **a, int c, C_word n) C_regparm;2091C_fctexport C_word C_fcall C_a_i_cos(C_word **a, int c, C_word n) C_regparm;2092C_fctexport C_word C_fcall C_a_i_tan(C_word **a, int c, C_word n) C_regparm;2093C_fctexport C_word C_fcall C_a_i_asin(C_word **a, int c, C_word n) C_regparm;2094C_fctexport C_word C_fcall C_a_i_acos(C_word **a, int c, C_word n) C_regparm;2095C_fctexport C_word C_fcall C_a_i_atan(C_word **a, int c, C_word n) C_regparm;2096C_fctexport C_word C_fcall C_a_i_atan2(C_word **a, int c, C_word n1, C_word n2) C_regparm;2097C_fctexport C_word C_fcall C_a_i_sinh(C_word **a, int c, C_word n) C_regparm;2098C_fctexport C_word C_fcall C_a_i_cosh(C_word **a, int c, C_word n) C_regparm;2099C_fctexport C_word C_fcall C_a_i_tanh(C_word **a, int c, C_word n) C_regparm;2100C_fctexport C_word C_fcall C_a_i_asinh(C_word **a, int c, C_word n) C_regparm;2101C_fctexport C_word C_fcall C_a_i_acosh(C_word **a, int c, C_word n) C_regparm;2102C_fctexport C_word C_fcall C_a_i_atanh(C_word **a, int c, C_word n) C_regparm;2103C_fctexport C_word C_fcall C_a_i_sqrt(C_word **a, int c, C_word n) C_regparm;2104C_fctexport C_word C_fcall C_i_o_fixnum_plus(C_word x, C_word y) C_regparm;2105C_fctexport C_word C_fcall C_i_o_fixnum_difference(C_word x, C_word y) C_regparm;2106C_fctexport C_word C_fcall C_i_o_fixnum_times(C_word x, C_word y) C_regparm;2107C_fctexport C_word C_fcall C_i_o_fixnum_quotient(C_word x, C_word y) C_regparm;2108C_fctexport C_word C_fcall C_i_o_fixnum_and(C_word x, C_word y) C_regparm;2109C_fctexport C_word C_fcall C_i_o_fixnum_ior(C_word x, C_word y) C_regparm;2110C_fctexport C_word C_fcall C_i_o_fixnum_xor(C_word x, C_word y) C_regparm;2111C_fctexport C_word C_fcall C_a_i_flonum_round_proper(C_word **a, int c, C_word n) C_regparm;2112C_fctexport C_word C_fcall C_a_i_flonum_gcd(C_word **p, C_word n, C_word x, C_word y) C_regparm;21132114C_fctexport C_word C_fcall C_i_getprop(C_word sym, C_word prop, C_word def) C_regparm;2115C_fctexport C_word C_fcall C_putprop(C_word **a, C_word sym, C_word prop, C_word val) C_regparm;2116C_fctexport C_word C_fcall C_i_persist_symbol(C_word sym) C_regparm;2117C_fctexport C_word C_fcall C_i_unpersist_symbol(C_word sym) C_regparm;2118C_fctexport C_word C_fcall C_i_get_keyword(C_word key, C_word args, C_word def) C_regparm;2119C_fctexport C_word C_fcall C_i_process_sleep(C_word n) C_regparm;2120C_fctexport C_u64 C_fcall C_milliseconds(void) C_regparm; /* DEPRECATED */2121C_fctexport C_u64 C_fcall C_current_process_milliseconds(void) C_regparm;2122C_fctexport C_u64 C_fcall C_cpu_milliseconds(void) C_regparm;2123C_fctexport double C_fcall C_bignum_to_double(C_word bignum) C_regparm;2124C_fctexport C_word C_fcall C_i_debug_modep(void) C_regparm;2125C_fctexport C_word C_fcall C_i_dump_heap_on_exitp(void) C_regparm;2126C_fctexport C_word C_fcall C_i_accumulated_gc_time(void) C_regparm;2127C_fctexport C_word C_fcall C_i_allocated_finalizer_count(void) C_regparm;2128C_fctexport C_word C_fcall C_i_live_finalizer_count(void) C_regparm;2129C_fctexport C_word C_fcall C_i_profilingp(void) C_regparm;2130C_fctexport C_word C_fcall C_i_tty_forcedp(void) C_regparm;213121322133C_fctexport C_word C_fcall C_a_i_cpu_time(C_word **a, int c, C_word buf) C_regparm;2134C_fctexport C_word C_fcall C_a_i_exact_to_inexact(C_word **a, int c, C_word n) C_regparm;2135C_fctexport C_word C_fcall C_i_file_exists_p(C_word name, C_word file, C_word dir) C_regparm;21362137C_fctexport C_word C_fcall C_s_a_i_abs(C_word **ptr, C_word n, C_word x) C_regparm;2138C_fctexport C_word C_fcall C_s_a_i_negate(C_word **ptr, C_word n, C_word x) C_regparm;2139C_fctexport C_word C_fcall C_s_a_i_minus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2140C_fctexport C_word C_fcall C_s_a_u_i_integer_negate(C_word **ptr, C_word n, C_word x) C_regparm;2141C_fctexport C_word C_fcall C_s_a_u_i_integer_minus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2142C_fctexport C_word C_fcall C_s_a_i_plus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2143C_fctexport C_word C_fcall C_s_a_u_i_integer_plus(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2144C_fctexport C_word C_fcall C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2145C_fctexport C_word C_fcall C_s_a_u_i_integer_times(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2146C_fctexport C_word C_fcall C_s_a_i_arithmetic_shift(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2147C_fctexport C_word C_fcall C_s_a_u_i_integer_gcd(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2148C_fctexport C_word C_fcall C_s_a_i_quotient(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2149C_fctexport C_word C_fcall C_s_a_u_i_integer_quotient(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2150C_fctexport C_word C_fcall C_s_a_i_remainder(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2151C_fctexport C_word C_fcall C_s_a_u_i_integer_remainder(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2152C_fctexport C_word C_fcall C_s_a_i_modulo(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2153C_fctexport C_word C_fcall C_s_a_u_i_integer_modulo(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2154C_fctexport C_word C_fcall C_s_a_i_bitwise_and(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2155C_fctexport C_word C_fcall C_s_a_i_bitwise_ior(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2156C_fctexport C_word C_fcall C_s_a_i_bitwise_xor(C_word **ptr, C_word n, C_word x, C_word y) C_regparm;2157C_fctexport C_word C_fcall C_s_a_i_bitwise_not(C_word **ptr, C_word n, C_word x) C_regparm;2158C_fctexport C_word C_fcall 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;2159C_fctexport C_word C_fcall C_s_a_u_i_flo_to_int(C_word **ptr, C_word n, C_word x) C_regparm;216021612162C_fctexport C_word C_fcall C_i_foreign_char_argumentp(C_word x) C_regparm;2163C_fctexport C_word C_fcall C_i_foreign_fixnum_argumentp(C_word x) C_regparm;2164C_fctexport C_word C_fcall C_i_foreign_flonum_argumentp(C_word x) C_regparm;2165C_fctexport C_word C_fcall C_i_foreign_block_argumentp(C_word x) C_regparm;2166C_fctexport C_word C_fcall C_i_foreign_struct_wrapper_argumentp(C_word t, C_word x) C_regparm;2167C_fctexport C_word C_fcall C_i_foreign_string_argumentp(C_word x) C_regparm;2168C_fctexport C_word C_fcall C_i_foreign_symbol_argumentp(C_word x) C_regparm;2169C_fctexport C_word C_fcall C_i_foreign_tagged_pointer_argumentp(C_word x, C_word t) C_regparm;2170C_fctexport C_word C_fcall C_i_foreign_pointer_argumentp(C_word x) C_regparm;2171C_fctexport C_word C_fcall C_i_foreign_scheme_or_c_pointer_argumentp(C_word x) C_regparm;2172C_fctexport C_word C_fcall C_i_foreign_ranged_integer_argumentp(C_word x, C_word bits) C_regparm;2173C_fctexport C_word C_fcall C_i_foreign_unsigned_ranged_integer_argumentp(C_word x, C_word bits) C_regparm;21742175C_fctexport C_char *C_lookup_procedure_id(void *ptr);2176C_fctexport void *C_lookup_procedure_ptr(C_char *id);21772178C_fctexport C_word C_random_fixnum(C_word n) C_regparm;2179C_fctexport C_word C_fcall C_s_a_u_i_random_int(C_word **ptr, C_word n, C_word rn) C_regparm;2180C_fctexport C_word C_fcall C_a_i_random_real(C_word **ptr, C_word n) C_regparm;2181C_fctexport C_word C_random_bytes(C_word buf, C_word size);2182C_fctexport C_word C_set_random_seed(C_word buf, C_word n);21832184#ifdef C_SIXTY_FOUR2185C_fctexport C_cpsproc(C_peek_signed_integer_32);2186C_fctexport C_cpsproc(C_peek_unsigned_integer_32);2187#else2188# define C_peek_signed_integer_32 C_peek_signed_integer2189# define C_peek_unsigned_integer_32 C_peek_unsigned_integer2190#endif21912192C_fctexport C_word C_fcall C_decode_literal(C_word **ptr, C_char *str) C_regparm;2193C_fctexport C_word C_fcall C_i_pending_interrupt(C_word dummy) C_regparm;21942195C_fctexport void *C_get_statistics(void);21962197/* defined in eval.scm: */2198C_fctexport void CHICKEN_get_error_message(char *buf,int bufsize);2199C_fctexport int CHICKEN_load(char * filename);2200C_fctexport int CHICKEN_read(char * str,C_word *result);2201C_fctexport int CHICKEN_apply_to_string(C_word func,C_word args,char *buf,int bufsize);2202C_fctexport int CHICKEN_apply(C_word func,C_word args,C_word *result);2203C_fctexport int CHICKEN_eval_string_to_string(char *str,char *buf,int bufsize);2204C_fctexport int CHICKEN_eval_to_string(C_word exp,char *buf,int bufsize);2205C_fctexport int CHICKEN_eval_string(char * str,C_word *result);2206C_fctexport int CHICKEN_eval(C_word exp,C_word *result);2207C_fctexport int CHICKEN_yield();22082209C_fctexport C_cpsproc(C_default_5fstub_toplevel);221022112212/* Inline functions: */22132214#ifndef HAVE_STATEMENT_EXPRESSIONS22152216inline static C_word *C_a_i(C_word **a, int n)2217{2218 C_word *p = *a;22192220 *a += n;2221 return p;2222}22232224#endif22252226inline static C_word2227C_mutate(C_word *slot, C_word val)2228{2229 if(!C_immediatep(val)) return C_mutate_slot(slot, val);2230 else return *slot = val;2231}22322233inline static C_word C_permanentp(C_word x)2234{2235 return C_mk_bool(!C_immediatep(x) &&2236 !C_in_stackp(x) &&2237 !C_in_heapp(x) &&2238 !C_in_scratchspacep(x));2239}22402241inline static C_word C_u_i_namespaced_symbolp(C_word x)2242{2243 C_word s = C_symbol_name(x);2244 return C_mk_bool(C_memchr(C_data_pointer(s), '#', C_header_size(s)));2245}22462247inline static C_word C_flonum(C_word **ptr, double n)2248{2249 C_word2250 *p = *ptr,2251 *p0;22522253#ifndef C_SIXTY_FOUR2254#ifndef C_DOUBLE_IS_32_BITS2255 /* Align double on 8-byte boundary: */2256 if(C_aligned8(p)) ++p;2257#endif2258#endif22592260 p0 = p;2261 *(p++) = C_FLONUM_TAG;2262 *((double *)p) = n;2263 *ptr = p + sizeof(double) / sizeof(C_word);2264 return (C_word)p0;2265}226622672268inline static C_word C_fcall C_u_i_zerop2(C_word x)2269{2270 return C_mk_bool(x == C_fix(0) ||2271 (!C_immediatep(x) &&2272 C_block_header(x) == C_FLONUM_TAG &&2273 C_flonum_magnitude(x) == 0.0));2274}227522762277inline static C_word C_string_to_pbytevector(C_word s)2278{2279 return C_pbytevector(C_header_size(s), (C_char *)C_data_pointer(s));2280}228122822283inline static C_word C_a_i_record1(C_word **ptr, int n, C_word x1)2284{2285 C_word *p = *ptr, *p0 = p;22862287 *(p++) = C_STRUCTURE_TYPE | 1;2288 *(p++) = x1;2289 *ptr = p;2290 return (C_word)p0;2291}229222932294inline static C_word C_a_i_record2(C_word **ptr, int n, C_word x1, C_word x2)2295{2296 C_word *p = *ptr, *p0 = p;22972298 *(p++) = C_STRUCTURE_TYPE | 2;2299 *(p++) = x1;2300 *(p++) = x2;2301 *ptr = p;2302 return (C_word)p0;2303}230423052306inline static C_word C_a_i_record3(C_word **ptr, int n, C_word x1, C_word x2, C_word x3)2307{2308 C_word *p = *ptr, *p0 = p;23092310 *(p++) = C_STRUCTURE_TYPE | 3;2311 *(p++) = x1;2312 *(p++) = x2;2313 *(p++) = x3;2314 *ptr = p;2315 return (C_word)p0;2316}231723182319inline static C_word C_a_i_record4(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4)2320{2321 C_word *p = *ptr, *p0 = p;23222323 *(p++) = C_STRUCTURE_TYPE | 4;2324 *(p++) = x1;2325 *(p++) = x2;2326 *(p++) = x3;2327 *(p++) = x4;2328 *ptr = p;2329 return (C_word)p0;2330}233123322333inline static C_word C_a_i_record5(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,2334 C_word x5)2335{2336 C_word *p = *ptr, *p0 = p;23372338 *(p++) = C_STRUCTURE_TYPE | 5;2339 *(p++) = x1;2340 *(p++) = x2;2341 *(p++) = x3;2342 *(p++) = x4;2343 *(p++) = x5;2344 *ptr = p;2345 return (C_word)p0;2346}234723482349inline static C_word C_a_i_record6(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,2350 C_word x5, C_word x6)2351{2352 C_word *p = *ptr, *p0 = p;23532354 *(p++) = C_STRUCTURE_TYPE | 6;2355 *(p++) = x1;2356 *(p++) = x2;2357 *(p++) = x3;2358 *(p++) = x4;2359 *(p++) = x5;2360 *(p++) = x6;2361 *ptr = p;2362 return (C_word)p0;2363}236423652366inline static C_word C_a_i_record7(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,2367 C_word x5, C_word x6, C_word x7)2368{2369 C_word *p = *ptr, *p0 = p;23702371 *(p++) = C_STRUCTURE_TYPE | 7;2372 *(p++) = x1;2373 *(p++) = x2;2374 *(p++) = x3;2375 *(p++) = x4;2376 *(p++) = x5;2377 *(p++) = x6;2378 *(p++) = x7;2379 *ptr = p;2380 return (C_word)p0;2381}238223832384inline static C_word C_a_i_record8(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,2385 C_word x5, C_word x6, C_word x7, C_word x8)2386{2387 C_word *p = *ptr, *p0 = p;23882389 *(p++) = C_STRUCTURE_TYPE | 8;2390 *(p++) = x1;2391 *(p++) = x2;2392 *(p++) = x3;2393 *(p++) = x4;2394 *(p++) = x5;2395 *(p++) = x6;2396 *(p++) = x7;2397 *(p++) = x8;2398 *ptr = p;2399 return (C_word)p0;2400}24012402inline static C_word C_cplxnum(C_word **ptr, C_word r, C_word i)2403{2404 C_word *p = *ptr, *p0 = p;24052406 *(p++) = C_CPLXNUM_TAG;2407 *(p++) = r;2408 *(p++) = i;2409 *ptr = p;2410 return (C_word)p0;2411}24122413inline static C_word C_ratnum(C_word **ptr, C_word n, C_word d)2414{2415 C_word *p = *ptr, *p0 = p;24162417 *(p++) = C_RATNUM_TAG;2418 *(p++) = n;2419 *(p++) = d;2420 *ptr = p;2421 return (C_word)p0;2422}24232424inline static C_word C_a_i_bignum_wrapper(C_word **ptr, C_word vec)2425{2426 C_word *p = *ptr, *p0 = p;24272428 *(p++) = C_BIGNUM_TAG;2429 *(p++) = vec;2430 *ptr = p;2431 return (C_word)p0;2432}24332434/* Silly (this is not normalized) but in some cases needed internally */2435inline static C_word C_bignum0(C_word **ptr)2436{2437 C_word *p = *ptr, p0 = (C_word)p;24382439 *(p++) = C_STRING_TYPE | C_wordstobytes(1);2440 *(p++) = 0; /* zero is always positive */2441 *ptr = p;24422443 return C_a_i_bignum_wrapper(ptr, p0);2444}24452446inline static C_word C_bignum1(C_word **ptr, int negp, C_uword d1)2447{2448 C_word *p = *ptr, p0 = (C_word)p;24492450 *(p++) = C_STRING_TYPE | C_wordstobytes(2);2451 *(p++) = negp;2452 *(p++) = d1;2453 *ptr = p;24542455 return C_a_i_bignum_wrapper(ptr, p0);2456}24572458/* Here d1, d2, ... are low to high (ie, little endian)! */2459inline static C_word C_bignum2(C_word **ptr, int negp, C_uword d1, C_uword d2)2460{2461 C_word *p = *ptr, p0 = (C_word)p;24622463 *(p++) = C_STRING_TYPE | C_wordstobytes(3);2464 *(p++) = negp;2465 *(p++) = d1;2466 *(p++) = d2;2467 *ptr = p;24682469 return C_a_i_bignum_wrapper(ptr, p0);2470}24712472inline static C_word C_i_bignump(C_word x)2473{2474 return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_BIGNUM_TAG);2475}247624772478inline static double C_c_double(C_word x)2479{2480 if(x & C_FIXNUM_BIT) return (double)C_unfix(x);2481 else return C_flonum_magnitude(x);2482}24832484inline static C_word C_a_u_i_int_to_flo(C_word **ptr, int n, C_word x)2485{2486 if(x & C_FIXNUM_BIT) return C_a_i_fix_to_flo(ptr, n, x);2487 else return C_a_u_i_big_to_flo(ptr, n, x);2488}24892490inline static C_word C_num_to_int(C_word x)2491{2492 if(x & C_FIXNUM_BIT) {2493 return C_unfix(x);2494 } else {2495#if DEBUGBUILD /* removes a warning with clang */2496 C_CHECKp(x,C_bignump(C_VAL1(x)),0);2497#endif2498 if (C_bignum_negativep(x)) return -(C_word)C_bignum_digits(x)[0];2499 else return (C_word)C_bignum_digits(x)[0]; /* should never be larger */2500 }2501}250225032504inline static C_s64 C_num_to_int64(C_word x)2505{2506 if(x & C_FIXNUM_BIT) {2507 return (C_s64)C_unfix(x);2508 } else {2509 C_s64 num = C_bignum_digits(x)[0];2510#ifndef C_SIXTY_FOUR2511 if (C_bignum_size(x) > 1) num |= (C_s64)(((C_u64)C_bignum_digits(x)[1]) << 32);2512#endif2513 if (C_bignum_negativep(x)) return -num;2514 else return num;2515 }2516}251725182519inline static C_u64 C_num_to_uint64(C_word x)2520{2521 if(x & C_FIXNUM_BIT) {2522 return (C_u64)C_unfix(x);2523 } else {2524 C_s64 num = C_bignum_digits(x)[0];2525#ifndef C_SIXTY_FOUR2526 if (C_bignum_size(x) > 1) num |= ((C_u64)C_bignum_digits(x)[1]) << 32;2527#endif2528 return num;2529 }2530}253125322533inline static C_uword C_num_to_unsigned_int(C_word x)2534{2535 if(x & C_FIXNUM_BIT) {2536 return (C_uword)C_unfix(x);2537 } else {2538 return C_bignum_digits(x)[0]; /* should never be larger */2539 }2540}254125422543inline static C_word C_int_to_num(C_word **ptr, C_word n)2544{2545 if(C_fitsinfixnump(n)) return C_fix(n);2546 else return C_bignum1(ptr, n < 0, C_wabs(n));2547}254825492550inline static C_word C_unsigned_int_to_num(C_word **ptr, C_uword n)2551{2552 if(C_ufitsinfixnump(n)) return C_fix(n);2553 else return C_bignum1(ptr, 0, n);2554}25552556inline static C_word C_int64_to_num(C_word **ptr, C_s64 n)2557{2558#ifdef C_SIXTY_FOUR2559 if(C_fitsinfixnump(n)) {2560 return C_fix(n);2561 } else {2562 C_u64 un = n < 0 ? -n : n;2563 return C_bignum1(ptr, n < 0, un);2564 }2565#else2566 C_u64 un = n < 0 ? -n : n;2567 C_word res = C_bignum2(ptr, n < 0, (C_uword)un, (C_uword)(un >> 32));2568 return C_bignum_simplify(res);2569#endif2570}25712572inline static C_word C_uint64_to_num(C_word **ptr, C_u64 n)2573{2574 if(C_ufitsinfixnump(n)) {2575 return C_fix(n);2576 } else {2577#ifdef C_SIXTY_FOUR2578 return C_bignum1(ptr, 0, n);2579#else2580 C_word res = C_bignum2(ptr, 0, (C_uword)n, (C_uword)(n >> 32));2581 return C_bignum_simplify(res);2582#endif2583 }2584}25852586inline static C_word C_long_to_num(C_word **ptr, C_long n)2587{2588 if(C_fitsinfixnump(n)) {2589 return C_fix(n);2590 } else {2591 return C_bignum1(ptr, n < 0, C_wabs(n));2592 }2593}25942595inline static C_word C_unsigned_long_to_num(C_word **ptr, C_ulong n)2596{2597 if(C_ufitsinfixnump(n)) {2598 return C_fix(n);2599 } else {2600 return C_bignum1(ptr, 0, n);2601 }2602}260326042605inline static char *C_string_or_null(C_word x)2606{2607 return C_truep(x) ? C_c_string(x) : NULL;2608}260926102611inline static void *C_data_pointer_or_null(C_word x)2612{2613 return C_truep(x) ? C_data_pointer(x) : NULL;2614}261526162617inline static void *C_srfi_4_vector_or_null(C_word x)2618{2619 return C_truep(x) ? C_srfi_4_vector(x) : NULL;2620}262126222623inline static void *C_c_pointer_vector_or_null(C_word x)2624{2625 return C_truep(x) ? C_data_pointer(C_block_item(x, 2)) : NULL;2626}262726282629inline static void *C_c_pointer_or_null(C_word x)2630{2631 return C_truep(x) ? (void *)C_block_item(x, 0) : NULL;2632}263326342635inline static void *C_scheme_or_c_pointer(C_word x)2636{2637 return C_anypointerp(x) ? (void *)C_block_item(x, 0) : C_data_pointer(x);2638}263926402641inline static C_long C_num_to_long(C_word x)2642{2643 if(x & C_FIXNUM_BIT) {2644 return (C_long)C_unfix(x);2645 } else {2646 if (C_bignum_negativep(x)) return -(C_long)C_bignum_digits(x)[0];2647 else return (C_long)C_bignum_digits(x)[0];2648 }2649}265026512652inline static C_ulong C_num_to_unsigned_long(C_word x)2653{2654 if(x & C_FIXNUM_BIT) {2655 return (C_ulong)C_unfix(x);2656 } else {2657 return (C_ulong)C_bignum_digits(x)[0];2658 }2659}266026612662inline static C_word C_u_i_string_equal_p(C_word x, C_word y)2663{2664 C_uword n = C_header_size(x);2665 return C_mk_bool(n == C_header_size(y)2666 && !C_memcmp((char *)C_data_pointer(x), (char *)C_data_pointer(y), n));2667}26682669/* Like memcmp but case insensitive (to strncasecmp as memcmp is to strncmp) */2670inline static int C_memcasecmp(const char *x, const char *y, unsigned int len)2671{2672 const unsigned char *ux = (const unsigned char *)x;2673 const unsigned char *uy = (const unsigned char *)y;26742675 while (len--) {2676 if (tolower(*ux++) != tolower(*uy++))2677 return (tolower(*--ux) - tolower(*--uy));2678 }2679 return 0;2680}26812682inline static C_word C_ub_i_flonum_eqvp(double x, double y)2683{2684 /* This can distinguish between -0.0 and +0.0 */2685 return x == y && signbit(x) == signbit(y);2686}26872688inline static C_word basic_eqvp(C_word x, C_word y)2689{2690 return (x == y ||26912692 (!C_immediatep(x) && !C_immediatep(y) &&2693 C_block_header(x) == C_block_header(y) &&26942695 ((C_block_header(x) == C_FLONUM_TAG &&2696 C_ub_i_flonum_eqvp(C_flonum_magnitude(x),2697 C_flonum_magnitude(y))) ||26982699 (C_block_header(x) == C_BIGNUM_TAG &&2700 C_block_header(y) == C_BIGNUM_TAG &&2701 C_i_bignum_cmp(x, y) == C_fix(0)))));2702}27032704inline static C_word C_i_eqvp(C_word x, C_word y)2705{2706 return C_mk_bool(basic_eqvp(x, y) ||2707 (!C_immediatep(x) && !C_immediatep(y) &&2708 C_block_header(x) == C_block_header(y) &&2709 (C_block_header(x) == C_RATNUM_TAG ||2710 C_block_header(x) == C_CPLXNUM_TAG) &&2711 basic_eqvp(C_block_item(x, 0), C_block_item(y, 0)) &&2712 basic_eqvp(C_block_item(x, 1), C_block_item(y, 1))));2713}27142715inline static C_word C_i_symbolp(C_word x)2716{2717 return C_mk_bool(!C_immediatep(x) &&2718 C_block_header(x) == C_SYMBOL_TAG &&2719 C_symbol_plist(x) != C_SCHEME_FALSE);2720}27212722inline static C_word C_i_keywordp(C_word x)2723{2724 return C_mk_bool(!C_immediatep(x) &&2725 C_block_header(x) == C_SYMBOL_TAG &&2726 C_symbol_plist(x) == C_SCHEME_FALSE);2727}27282729inline static int C_persistable_symbol(C_word x)2730{2731 /* Symbol is bound, or has a non-empty plist (but is not a keyword) */2732 return ((C_truep(C_boundp(x)) ||2733 C_symbol_plist(x) != C_SCHEME_END_OF_LIST) &&2734 C_symbol_plist(x) != C_SCHEME_FALSE);2735}27362737inline static C_word C_i_pairp(C_word x)2738{2739 return C_mk_bool(!C_immediatep(x) && C_header_type(x) == C_PAIR_TYPE);2740}27412742inline static C_word C_i_weak_pairp(C_word x)2743{2744 return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_WEAK_PAIR_TAG);2745}27462747inline static C_word C_i_stringp(C_word x)2748{2749 return C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_STRING_TYPE);2750}275127522753inline static C_word C_i_locativep(C_word x)2754{2755 return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_LOCATIVE_TAG);2756}275727582759inline static C_word C_i_vectorp(C_word x)2760{2761 return C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_VECTOR_TYPE);2762}27632764inline static C_word C_i_srfi_4_vectorp(C_word x)2765{2766 return C_mk_bool(!C_immediatep(x) &&2767 C_header_bits(x) == C_STRUCTURE_TYPE &&2768 (C_truep(C_i_u8vectorp(x)) ||2769 C_truep(C_i_s8vectorp(x)) ||2770 C_truep(C_i_u16vectorp(x)) ||2771 C_truep(C_i_s16vectorp(x)) ||2772 C_truep(C_i_u32vectorp(x)) ||2773 C_truep(C_i_s32vectorp(x)) ||2774 C_truep(C_i_u64vectorp(x)) ||2775 C_truep(C_i_s64vectorp(x)) ||2776 C_truep(C_i_f32vectorp(x)) ||2777 C_truep(C_i_f64vectorp(x))));2778}27792780inline static C_word C_i_portp(C_word x)2781{2782 return C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_PORT_TYPE);2783}278427852786inline static C_word C_i_closurep(C_word x)2787{2788 return C_mk_bool(!C_immediatep(x) && C_header_bits(x) == C_CLOSURE_TYPE);2789}27902791inline static C_word C_i_numberp(C_word x)2792{2793 return C_mk_bool((x & C_FIXNUM_BIT) ||2794 (!C_immediatep(x) &&2795 (C_block_header(x) == C_FLONUM_TAG ||2796 C_block_header(x) == C_BIGNUM_TAG ||2797 C_block_header(x) == C_RATNUM_TAG ||2798 C_block_header(x) == C_CPLXNUM_TAG)));2799}28002801/* All numbers are real, except for cplxnums */2802inline static C_word C_i_realp(C_word x)2803{2804 return C_mk_bool((x & C_FIXNUM_BIT) ||2805 (!C_immediatep(x) &&2806 (C_block_header(x) == C_FLONUM_TAG ||2807 C_block_header(x) == C_BIGNUM_TAG ||2808 C_block_header(x) == C_RATNUM_TAG)));2809}28102811/* All finite real numbers are rational */2812inline static C_word C_i_rationalp(C_word x)2813{2814 if(x & C_FIXNUM_BIT) {2815 return C_SCHEME_TRUE;2816 } else if (C_immediatep(x)) {2817 return C_SCHEME_FALSE;2818 } else if(C_block_header(x) == C_FLONUM_TAG) {2819 double n = C_flonum_magnitude(x);2820 return C_mk_bool(!C_isinf(n) && !C_isnan(n));2821 } else {2822 return C_mk_bool(C_block_header(x) == C_BIGNUM_TAG ||2823 C_block_header(x) == C_RATNUM_TAG);2824 }2825}282628272828inline static C_word C_u_i_fpintegerp(C_word x)2829{2830 double dummy, val;28312832 val = C_flonum_magnitude(x);28332834 if(C_isnan(val) || C_isinf(val)) return C_SCHEME_FALSE;28352836 return C_mk_bool(C_modf(val, &dummy) == 0.0);2837}283828392840inline static int C_ub_i_fpintegerp(double x)2841{2842 double dummy;28432844 return C_modf(x, &dummy) == 0.0;2845}28462847inline static C_word C_i_exact_integerp(C_word x)2848{2849 return C_mk_bool((x) & C_FIXNUM_BIT || C_truep(C_i_bignump(x)));2850}28512852inline static C_word C_u_i_exactp(C_word x)2853{2854 if (C_truep(C_i_exact_integerp(x))) {2855 return C_SCHEME_TRUE;2856 } else if (C_block_header(x) == C_FLONUM_TAG) {2857 return C_SCHEME_FALSE;2858 } else if (C_block_header(x) == C_RATNUM_TAG) {2859 return C_SCHEME_TRUE;2860 } else if (C_block_header(x) == C_CPLXNUM_TAG) {2861 x = C_u_i_cplxnum_real(x);2862 /* r and i are always the same exactness, and we assume they2863 * always store a number.2864 */2865 return C_mk_bool(C_immediatep(x) || (C_block_header(x) != C_FLONUM_TAG));2866 } else {2867 return C_SCHEME_FALSE;2868 }2869}28702871inline static C_word C_u_i_inexactp(C_word x)2872{2873 if (C_immediatep(x)) {2874 return C_SCHEME_FALSE;2875 } else if (C_block_header(x) == C_FLONUM_TAG) {2876 return C_SCHEME_TRUE;2877 } else if (C_block_header(x) == C_CPLXNUM_TAG) {2878 x = C_u_i_cplxnum_real(x); /* r and i are always the same exactness */2879 return C_mk_bool(!C_immediatep(x) && (C_block_header(x) == C_FLONUM_TAG));2880 } else {2881 return C_SCHEME_FALSE;2882 }2883}28842885inline static C_word C_i_integerp(C_word x)2886{2887 double dummy, val;28882889 if (x & C_FIXNUM_BIT || C_truep(C_i_bignump(x)))2890 return C_SCHEME_TRUE;2891 if (C_immediatep(x) || C_block_header(x) != C_FLONUM_TAG)2892 return C_SCHEME_FALSE;28932894 val = C_flonum_magnitude(x);2895 if(C_isnan(val) || C_isinf(val)) return C_SCHEME_FALSE;28962897 return C_mk_bool(C_modf(val, &dummy) == 0.0);2898}289929002901inline static C_word C_i_flonump(C_word x)2902{2903 return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_FLONUM_TAG);2904}29052906inline static C_word C_i_cplxnump(C_word x)2907{2908 return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_CPLXNUM_TAG);2909}29102911inline static C_word C_i_ratnump(C_word x)2912{2913 return C_mk_bool(!C_immediatep(x) && C_block_header(x) == C_RATNUM_TAG);2914}29152916/* TODO: Is this correctly named? Shouldn't it accept an argcount? */2917inline static C_word C_a_u_i_fix_to_big(C_word **ptr, C_word x)2918{2919 x = C_unfix(x);2920 if (x < 0)2921 return C_bignum1(ptr, 1, -x);2922 else if (x == 0)2923 return C_bignum0(ptr);2924 else2925 return C_bignum1(ptr, 0, x);2926}29272928inline static C_word C_i_fixnum_min(C_word x, C_word y)2929{2930 return ((C_word)x < (C_word)y) ? x : y;2931}293229332934inline static C_word C_i_fixnum_max(C_word x, C_word y)2935{2936 return ((C_word)x > (C_word)y) ? x : y;2937}29382939inline static C_word C_i_fixnum_gcd(C_word x, C_word y)2940{2941 x = (x & C_INT_SIGN_BIT) ? -C_unfix(x) : C_unfix(x);2942 y = (y & C_INT_SIGN_BIT) ? -C_unfix(y) : C_unfix(y);29432944 while(y != 0) {2945 C_word r = x % y;2946 x = y;2947 y = r;2948 }2949 return C_fix(x);2950}29512952inline static C_word C_fixnum_divide(C_word x, C_word y)2953{2954 if(y == C_fix(0)) C_div_by_zero_error(C_text("fx/"));2955 return C_u_fixnum_divide(x, y);2956}295729582959inline static C_word C_u_fixnum_modulo(C_word x, C_word y)2960{2961 y = C_unfix(y);2962 x = C_unfix(x) % y;2963 if ((y < 0 && x > 0) || (y > 0 && x < 0)) x += y;2964 return C_fix(x);2965}296629672968inline static C_word C_fixnum_modulo(C_word x, C_word y)2969{2970 if(y == C_fix(0)) {2971 C_div_by_zero_error(C_text("fxmod"));2972 } else {2973 return C_u_fixnum_modulo(x,y);2974 }2975}29762977/* XXX: Naming convention is inconsistent! There's C_fixnum_divide()2978 * but also C_a_i_flonum_quotient_checked()2979 */2980inline static C_word2981C_a_i_fixnum_quotient_checked(C_word **ptr, int c, C_word x, C_word y)2982{2983 if (y == C_fix(0)) {2984 C_div_by_zero_error(C_text("fx/"));2985 } else if (x == C_fix(C_MOST_NEGATIVE_FIXNUM) && y == C_fix(-1)) {2986 return C_bignum1(ptr, 0, -C_MOST_NEGATIVE_FIXNUM); /* Special case */2987 } else {2988 return C_u_fixnum_divide(x, y); /* Inconsistent, too: missing _i_ */2989 }2990}29912992inline static C_word C_i_fixnum_remainder_checked(C_word x, C_word y)2993{2994 if (y == C_fix(0)) {2995 C_div_by_zero_error(C_text("fxrem"));2996 } else {2997 x = C_unfix(x);2998 y = C_unfix(y);2999 return C_fix(x - ((x / y) * y));3000 }3001}30023003inline static C_word C_i_fixnum_arithmetic_shift(C_word n, C_word c)3004{3005 if(C_unfix(c) < 0) return C_fixnum_shift_right(n, C_u_fixnum_negate(c));3006 else return C_fixnum_shift_left(n, c);3007}30083009inline static C_word C_a_i_fixnum_negate(C_word **ptr, C_word n, C_word x)3010{3011 /* Exceptional situation: this will cause an overflow to itself */3012 if (x == C_fix(C_MOST_NEGATIVE_FIXNUM)) /* C_fitsinfixnump(x) */3013 return C_bignum1(ptr, 0, -C_MOST_NEGATIVE_FIXNUM);3014 else3015 return C_fix(-C_unfix(x));3016}30173018inline static C_word C_s_a_u_i_integer_abs(C_word **ptr, C_word n, C_word x)3019{3020 if (x & C_FIXNUM_BIT) {3021 return C_a_i_fixnum_abs(ptr, 1, x);3022 } else if (C_bignum_negativep(x)) {3023 return C_s_a_u_i_integer_negate(ptr, n, x);3024 } else {3025 return x;3026 }3027}30283029/* DEPRECATED */3030inline static C_word C_i_fixnum_bit_to_bool(C_word n, C_word i)3031{3032 if (i & C_INT_SIGN_BIT) {3033 C_not_an_uinteger_error(C_text("bit->boolean"), i);3034 } else {3035 i = C_unfix(i);3036 if (i >= C_WORD_SIZE) return C_mk_bool(n & C_INT_SIGN_BIT);3037 else return C_mk_bool((C_unfix(n) & (C_word)((C_uword)1 << i)) != 0);3038 }3039}30403041inline static C_word C_a_i_fixnum_difference(C_word **ptr, C_word n, C_word x, C_word y)3042{3043 C_word z = C_unfix(x) - C_unfix(y);30443045 if(!C_fitsinfixnump(z)) {3046 return C_bignum1(ptr, z < 0, C_wabs(z));3047 } else {3048 return C_fix(z);3049 }3050}30513052inline static C_word C_a_i_fixnum_plus(C_word **ptr, C_word n, C_word x, C_word y)3053{3054 C_word z = C_unfix(x) + C_unfix(y);30553056 if(!C_fitsinfixnump(z)) {3057 return C_bignum1(ptr, z < 0, C_wabs(z));3058 } else {3059 return C_fix(z);3060 }3061}30623063inline static C_word C_a_i_fixnum_times(C_word **ptr, C_word n, C_word x, C_word y)3064{3065 C_uword negp, xhi, xlo, yhi, ylo, p, rhi, rlo;30663067 negp = ((x & C_INT_SIGN_BIT) ? !(y & C_INT_SIGN_BIT) : (y & C_INT_SIGN_BIT));3068 x = (x & C_INT_SIGN_BIT) ? -C_unfix(x) : C_unfix(x);3069 y = (y & C_INT_SIGN_BIT) ? -C_unfix(y) : C_unfix(y);30703071 xhi = C_BIGNUM_DIGIT_HI_HALF(x); xlo = C_BIGNUM_DIGIT_LO_HALF(x);3072 yhi = C_BIGNUM_DIGIT_HI_HALF(y); ylo = C_BIGNUM_DIGIT_LO_HALF(y);30733074 /* This is simply bignum_digits_multiply unrolled for 2x2 halfdigits */3075 p = xlo * ylo;3076 rlo = C_BIGNUM_DIGIT_LO_HALF(p);30773078 p = xhi * ylo + C_BIGNUM_DIGIT_HI_HALF(p);3079 rhi = C_BIGNUM_DIGIT_HI_HALF(p);30803081 p = xlo * yhi + C_BIGNUM_DIGIT_LO_HALF(p);3082 rlo = C_BIGNUM_DIGIT_COMBINE(C_BIGNUM_DIGIT_LO_HALF(p), rlo);30833084 rhi = xhi * yhi + C_BIGNUM_DIGIT_HI_HALF(p) + rhi;30853086 if (rhi) {3087 return C_bignum2(ptr, negp != 0, rlo, rhi);3088 } else if (negp ?3089 ((rlo & C_INT_SIGN_BIT) || !C_fitsinfixnump(-(C_word)rlo)) :3090 !C_ufitsinfixnump(rlo)) {3091 return C_bignum1(ptr, negp != 0, rlo);3092 } else {3093 return C_fix(negp ? -rlo : rlo);3094 }3095}30963097inline static C_word C_i_flonum_min(C_word x, C_word y)3098{3099 double3100 xf = C_flonum_magnitude(x),3101 yf = C_flonum_magnitude(y);31023103 return xf < yf ? x : y;3104}310531063107inline static C_word C_i_flonum_max(C_word x, C_word y)3108{3109 double3110 xf = C_flonum_magnitude(x),3111 yf = C_flonum_magnitude(y);31123113 return xf > yf ? x : y;3114}31153116inline static C_word C_u_i_integer_signum(C_word x)3117{3118 if (x & C_FIXNUM_BIT) return C_i_fixnum_signum(x);3119 else return (C_bignum_negativep(x) ? C_fix(-1) : C_fix(1));3120}31213122inline static C_word3123C_a_i_flonum_quotient_checked(C_word **ptr, int c, C_word n1, C_word n2)3124{3125 double n3 = C_flonum_magnitude(n2);31263127 if(n3 == 0.0) C_div_by_zero_error(C_text("fp/?"));3128 return C_flonum(ptr, C_flonum_magnitude(n1) / n3);3129}313031313132inline static double3133C_ub_i_flonum_quotient_checked(double n1, double n2)3134{3135 if(n2 == 0.0) C_div_by_zero_error(C_text("fp/?"));3136 return n1 / n2;3137}31383139/* More weirdness: the other flonum_quotient macros and inline functions3140 * do not compute the quotient but the "plain" division!3141 */3142inline static C_word3143C_a_i_flonum_actual_quotient_checked(C_word **ptr, int c, C_word x, C_word y)3144{3145 double dy = C_flonum_magnitude(y), r;31463147 if(dy == 0.0) {3148 C_div_by_zero_error(C_text("quotient"));3149 } else if (!C_truep(C_u_i_fpintegerp(x))) {3150 C_not_an_integer_error(C_text("quotient"), x);3151 } else if (!C_truep(C_u_i_fpintegerp(y))) {3152 C_not_an_integer_error(C_text("quotient"), y);3153 } else {3154 modf(C_flonum_magnitude(x) / dy, &r);3155 return C_flonum(ptr, r);3156 }3157}31583159inline static C_word3160C_a_i_flonum_remainder_checked(C_word **ptr, int c, C_word x, C_word y)3161{3162 double dx = C_flonum_magnitude(x),3163 dy = C_flonum_magnitude(y), r;31643165 if(dy == 0.0) {3166 C_div_by_zero_error(C_text("remainder"));3167 } else if (!C_truep(C_u_i_fpintegerp(x))) {3168 C_not_an_integer_error(C_text("remainder"), x);3169 } else if (!C_truep(C_u_i_fpintegerp(y))) {3170 C_not_an_integer_error(C_text("remainder"), y);3171 } else {3172 modf(dx / dy, &r);3173 return C_flonum(ptr, dx - r * dy);3174 }3175}31763177inline static C_word3178C_a_i_flonum_modulo_checked(C_word **ptr, int c, C_word x, C_word y)3179{3180 double dx = C_flonum_magnitude(x),3181 dy = C_flonum_magnitude(y), r;31823183 if(dy == 0.0) {3184 C_div_by_zero_error(C_text("modulo"));3185 } else if (!C_truep(C_u_i_fpintegerp(x))) {3186 C_not_an_integer_error(C_text("modulo"), x);3187 } else if (!C_truep(C_u_i_fpintegerp(y))) {3188 C_not_an_integer_error(C_text("modulo"), y);3189 } else {3190 modf(dx / dy, &r);3191 r = dx - r * dy;3192 if ((dy < 0 && r > 0) || (dy > 0 && r < 0)) r += y;3193 return C_flonum(ptr, r);3194 }3195}31963197inline static C_word C_i_safe_pointerp(C_word x)3198{3199 if(C_immediatep(x)) return C_SCHEME_FALSE;32003201 switch(C_block_header(x)) {3202 case C_POINTER_TAG:3203 case C_TAGGED_POINTER_TAG:3204 return C_SCHEME_TRUE;3205 }32063207 return C_SCHEME_FALSE;3208}320932103211inline static C_word C_u_i_assq(C_word x, C_word lst)3212{3213 C_word a;32143215 while(!C_immediatep(lst)) {3216 a = C_u_i_car(lst);32173218 if(C_u_i_car(a) == x) return a;3219 else lst = C_u_i_cdr(lst);3220 }32213222 return C_SCHEME_FALSE;3223}322432253226inline static C_word3227C_fast_retrieve(C_word sym)3228{3229 C_word val = C_block_item(sym, 0);32303231 if(val == C_SCHEME_UNBOUND)3232 C_unbound_variable(sym);32333234 return val;3235}32363237inline static void *3238C_fast_retrieve_proc(C_word closure)3239{3240 if(C_immediatep(closure) || C_header_bits(closure) != C_CLOSURE_TYPE)3241 return (void *)C_invalid_procedure;3242 else3243 return (void *)C_block_item(closure, 0);3244}324532463247inline static void *3248C_fast_retrieve_symbol_proc(C_word sym)3249{3250 return C_fast_retrieve_proc(C_fast_retrieve(sym));3251}325232533254inline static C_word C_a_i_vector1(C_word **ptr, int n, C_word x1)3255{3256 C_word *p = *ptr, *p0 = p;32573258 *(p++) = C_VECTOR_TYPE | 1;3259 *(p++) = x1;3260 *ptr = p;3261 return (C_word)p0;3262}326332643265inline static C_word C_a_i_vector2(C_word **ptr, int n, C_word x1, C_word x2)3266{3267 C_word *p = *ptr, *p0 = p;32683269 *(p++) = C_VECTOR_TYPE | 2;3270 *(p++) = x1;3271 *(p++) = x2;3272 *ptr = p;3273 return (C_word)p0;3274}327532763277inline static C_word C_a_i_vector3(C_word **ptr, int n, C_word x1, C_word x2, C_word x3)3278{3279 C_word *p = *ptr, *p0 = p;32803281 *(p++) = C_VECTOR_TYPE | 3;3282 *(p++) = x1;3283 *(p++) = x2;3284 *(p++) = x3;3285 *ptr = p;3286 return (C_word)p0;3287}328832893290inline static C_word C_a_i_vector4(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4)3291{3292 C_word *p = *ptr, *p0 = p;32933294 *(p++) = C_VECTOR_TYPE | 4;3295 *(p++) = x1;3296 *(p++) = x2;3297 *(p++) = x3;3298 *(p++) = x4;3299 *ptr = p;3300 return (C_word)p0;3301}330233033304inline static C_word C_a_i_vector5(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,3305 C_word x5)3306{3307 C_word *p = *ptr, *p0 = p;33083309 *(p++) = C_VECTOR_TYPE | 5;3310 *(p++) = x1;3311 *(p++) = x2;3312 *(p++) = x3;3313 *(p++) = x4;3314 *(p++) = x5;3315 *ptr = p;3316 return (C_word)p0;3317}331833193320inline static C_word C_a_i_vector6(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,3321 C_word x5, C_word x6)3322{3323 C_word *p = *ptr, *p0 = p;33243325 *(p++) = C_VECTOR_TYPE | 6;3326 *(p++) = x1;3327 *(p++) = x2;3328 *(p++) = x3;3329 *(p++) = x4;3330 *(p++) = x5;3331 *(p++) = x6;3332 *ptr = p;3333 return (C_word)p0;3334}333533363337inline static C_word C_a_i_vector7(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,3338 C_word x5, C_word x6, C_word x7)3339{3340 C_word *p = *ptr, *p0 = p;33413342 *(p++) = C_VECTOR_TYPE | 7;3343 *(p++) = x1;3344 *(p++) = x2;3345 *(p++) = x3;3346 *(p++) = x4;3347 *(p++) = x5;3348 *(p++) = x6;3349 *(p++) = x7;3350 *ptr = p;3351 return (C_word)p0;3352}335333543355inline static C_word C_a_i_vector8(C_word **ptr, int n, C_word x1, C_word x2, C_word x3, C_word x4,3356 C_word x5, C_word x6, C_word x7, C_word x8)3357{3358 C_word *p = *ptr, *p0 = p;33593360 *(p++) = C_VECTOR_TYPE | 8;3361 *(p++) = x1;3362 *(p++) = x2;3363 *(p++) = x3;3364 *(p++) = x4;3365 *(p++) = x5;3366 *(p++) = x6;3367 *(p++) = x7;3368 *(p++) = x8;3369 *ptr = p;3370 return (C_word)p0;3371}337233733374inline static C_word C_fcall C_a_pair(C_word **ptr, C_word car, C_word cdr)3375{3376 C_word *p = *ptr, *p0 = p;33773378 *(p++) = C_PAIR_TYPE | (C_SIZEOF_PAIR - 1);3379 *(p++) = car;3380 *(p++) = cdr;3381 *ptr = p;3382 return (C_word)p0;3383}33843385inline static C_word C_fcall C_a_weak_pair(C_word **ptr, C_word head, C_word tail)3386{3387 C_word *p = *ptr, *p0 = p;33883389 *(p++) = C_WEAK_PAIR_TAG; /* Changes to strong if sym is persisted */3390 *(p++) = head;3391 *(p++) = tail;3392 *ptr = p;3393 return (C_word)p0;3394}339533963397inline static C_word C_a_i_list1(C_word **a, int n, C_word x1)3398{3399 return C_a_pair(a, x1, C_SCHEME_END_OF_LIST);3400}340134023403inline static C_word C_a_i_list2(C_word **a, int n, C_word x1, C_word x2)3404{3405 C_word x = C_a_pair(a, x2, C_SCHEME_END_OF_LIST);34063407 return C_a_pair(a, x1, x);3408}340934103411inline static C_word C_a_i_list3(C_word **a, int n, C_word x1, C_word x2, C_word x3)3412{3413 C_word x = C_a_pair(a, x3, C_SCHEME_END_OF_LIST);34143415 x = C_a_pair(a, x2, x);3416 return C_a_pair(a, x1, x);3417}341834193420inline static C_word C_a_i_list4(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4)3421{3422 C_word x = C_a_pair(a, x4, C_SCHEME_END_OF_LIST);34233424 x = C_a_pair(a, x3, x);3425 x = C_a_pair(a, x2, x);3426 return C_a_pair(a, x1, x);3427}342834293430inline static C_word C_a_i_list5(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4,3431 C_word x5)3432{3433 C_word x = C_a_pair(a, x5, C_SCHEME_END_OF_LIST);34343435 x = C_a_pair(a, x4, x);3436 x = C_a_pair(a, x3, x);3437 x = C_a_pair(a, x2, x);3438 return C_a_pair(a, x1, x);3439}344034413442inline static C_word C_a_i_list6(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4,3443 C_word x5, C_word x6)3444{3445 C_word x = C_a_pair(a, x6, C_SCHEME_END_OF_LIST);34463447 x = C_a_pair(a, x5, x);3448 x = C_a_pair(a, x4, x);3449 x = C_a_pair(a, x3, x);3450 x = C_a_pair(a, x2, x);3451 return C_a_pair(a, x1, x);3452}345334543455inline static C_word C_a_i_list7(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4,3456 C_word x5, C_word x6, C_word x7)3457{3458 C_word x = C_a_pair(a, x7, C_SCHEME_END_OF_LIST);34593460 x = C_a_pair(a, x6, x);3461 x = C_a_pair(a, x5, x);3462 x = C_a_pair(a, x4, x);3463 x = C_a_pair(a, x3, x);3464 x = C_a_pair(a, x2, x);3465 return C_a_pair(a, x1, x);3466}346734683469inline static C_word C_a_i_list8(C_word **a, int n, C_word x1, C_word x2, C_word x3, C_word x4,3470 C_word x5, C_word x6, C_word x7, C_word x8)3471{3472 C_word x = C_a_pair(a, x8, C_SCHEME_END_OF_LIST);34733474 x = C_a_pair(a, x7, x);3475 x = C_a_pair(a, x6, x);3476 x = C_a_pair(a, x5, x);3477 x = C_a_pair(a, x4, x);3478 x = C_a_pair(a, x3, x);3479 x = C_a_pair(a, x2, x);3480 return C_a_pair(a, x1, x);3481}348234833484/*3485 * From Hacker's Delight by Henry S. Warren3486 * based on a modified nlz() from section 5-3 (fig. 5-7)3487 */3488inline static int C_ilen(C_uword x)3489{3490 C_uword y;3491 C_word n = 0;34923493#ifdef C_SIXTY_FOUR3494 y = x >> 32; if (y != 0) { n += 32; x = y; }3495#endif3496 y = x >> 16; if (y != 0) { n += 16; x = y; }3497 y = x >> 8; if (y != 0) { n += 8; x = y; }3498 y = x >> 4; if (y != 0) { n += 4; x = y; }3499 y = x >> 2; if (y != 0) { n += 2; x = y; }3500 y = x >> 1; if (y != 0) return n + 2;3501 return n + x;3502}35033504/* These strl* functions are based on public domain code by C.B. Falconer */3505#ifdef HAVE_STRLCPY3506# define C_strlcpy strlcpy3507#else3508inline static size_t C_strlcpy(char *dst, const char *src, size_t sz)3509{3510 const char *start = src;35113512 if (sz--) {3513 while ((*dst++ = *src))3514 if (sz--) src++;3515 else {3516 *(--dst) = '\0';3517 break;3518 }3519 }3520 while (*src++) continue;3521 return src - start - 1;3522}3523#endif35243525#ifdef HAVE_STRLCAT3526# define C_strlcat strlcat3527#else3528inline static size_t C_strlcat(char *dst, const char *src, size_t sz)3529{3530 char *start = dst;35313532 while (*dst++) /* assumes sz >= strlen(dst) */3533 if (sz) sz--; /* i.e. well formed string */3534 dst--;3535 return dst - start + C_strlcpy(dst, src, sz);3536}3537#endif35383539/*3540 * MinGW's stat() is less than ideal in a couple of ways, so we provide a3541 * wrapper that:3542 *3543 * 1. Strips all trailing slashes and retries on failure, since stat() will3544 * yield ENOENT when given two (on MSYS) or more (on MinGW and MSYS2).3545 * 2. Fails with ENOTDIR when given a path to a non-directory file that ends3546 * in a slash, since in this case MinGW's stat() will succeed but return a3547 * non-directory mode in buf.st_mode.3548 */3549#if defined(__MINGW32__)3550inline static int C_stat(const char *path, struct stat *buf)3551{3552 size_t len = C_strlen(path);3553 char slash = len && C_strchr("\\/", path[len - 1]), *str;35543555 if(stat(path, buf) == 0)3556 goto dircheck;35573558 if(slash && errno == ENOENT) {3559 C_strlcpy((str = (char *)C_alloca(len + 1)), path, len + 1);3560 while(len > 1 && C_strchr("\\/", path[--len]))3561 str[len] = '\0';3562 if(stat(str, buf) == 0)3563 goto dircheck;3564 }35653566 return -1;35673568dircheck:3569 if(slash && !S_ISDIR(buf->st_mode)) {3570 errno = ENOTDIR;3571 return -1;3572 }35733574 return 0;3575}3576/*3577 * Haiku's stat() has a similar issue, where it will gladly succeed3578 * when given a path to a filename with a trailing slash.3579 */3580#elif defined(__HAIKU__)3581inline static int C_stat(const char *path, struct stat *buf)3582{3583 size_t len = C_strlen(path);3584 char slash = len && path[len - 1] == '/';35853586 if(stat(path, buf) != 0) {3587 return -1;3588 }35893590 if (slash && !S_ISDIR(buf->st_mode)) {3591 errno = ENOTDIR;3592 return -1;3593 }35943595 return 0;3596}3597#else3598# define C_stat stat3599#endif36003601/* Safe realpath usage depends on a reliable PATH_MAX. */3602#ifdef PATH_MAX3603# define C_realpath realpath3604#else3605inline static char *C_realpath(const char *path, char *resolved)3606{3607# if _POSIX_C_SOURCE >= 200809L3608 char *p;3609 size_t n;3610 if((p = realpath(path, NULL)) == NULL)3611 return NULL;3612 n = C_strlcpy(resolved, p, C_MAX_PATH);3613 C_free(p);3614 if(n < C_MAX_PATH)3615 return resolved;3616# endif3617 return NULL;3618}3619#endif36203621C_END_C_DECLS36223623#endif /* ___CHICKEN */