diff options
Diffstat (limited to 'libguile/__scm.h')
-rw-r--r-- | libguile/__scm.h | 305 |
1 files changed, 25 insertions, 280 deletions
diff --git a/libguile/__scm.h b/libguile/__scm.h index a0b02b685..31e395285 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -146,37 +146,6 @@ #endif -/* {Supported Options} - * - * These may be defined or undefined. - */ - -/* #define GUILE_DEBUG_FREELIST */ - - -/* Use engineering notation when converting numbers strings? - */ -#undef ENGNOT - - -/* {Unsupported Options} - * - * These must be defined as given here. - */ - - -/* Guile Scheme supports the #f/() distinction; Guile Lisp won't. We - have horrible plans for their unification. */ -#undef SICP - - - -/* Random options (not yet supported or in final form). */ - -#define STACK_CHECKING -#undef NO_CEVAL_STACK_CHECKING - - /* SCM_API is a macro prepended to all function and data definitions which should be exported from libguile. */ @@ -279,14 +248,6 @@ #define SCM_DEBUG 0 #endif -/* For debugging purposes: define this is to ensure nobody is using - * the mark bits outside of the marking phase. This is meant for - * debugging purposes only. - */ -#ifndef SCM_DEBUG_MARKING_API -#define SCM_DEBUG_MARKING_API 0 -#endif - /* If SCM_DEBUG_CELL_ACCESSES is set to 1, cell accesses will perform * exhaustive parameter checking: It will be verified that cell parameters * actually point to a valid heap cell. Note: If this option is enabled, @@ -296,13 +257,6 @@ #define SCM_DEBUG_CELL_ACCESSES SCM_DEBUG #endif -/* If SCM_DEBUG_INTERRUPTS is set to 1, with every deferring and allowing of - * interrupts a consistency check will be performed. - */ -#ifndef SCM_DEBUG_INTERRUPTS -#define SCM_DEBUG_INTERRUPTS SCM_DEBUG -#endif - /* If SCM_DEBUG_PAIR_ACCESSES is set to 1, accesses to cons cells will be * exhaustively checked. Note: If this option is enabled, guile will run * slower than normally. @@ -345,22 +299,6 @@ #define SCM_DEBUG_TYPING_STRICTNESS 1 #endif -/* If SCM_DEBUG_DEBUGGING_SUPPORT is set to 1, guile will provide a set of - * special functions that support debugging with a debugger like gdb or - * debugging of guile internals on the scheme level. The behaviour of guile - * is not changed by this macro, only the set of functions that are available - * will differ. All functions that are introduced this way have the prefix - * 'scm_dbg_' on the C level and the prefix 'dbg-' on the scheme level. This - * allows to easily determine the set of support functions, given that your - * debugger or repl provide automatic name completion. Note that these - * functions are intended to be used during interactive debugging sessions - * only. They are not considered part of guile's official API. They may - * change or disappear without notice or deprecation phase. - */ -#ifndef SCM_DEBUG_DEBUGGING_SUPPORT -#define SCM_DEBUG_DEBUGGING_SUPPORT SCM_DEBUG -#endif - /* {Feature Options} @@ -456,12 +394,6 @@ #define SCM_T_INT64_MIN SCM_I_TYPE_MIN(scm_t_int64,SCM_T_UINT64_MAX) #define SCM_T_INT64_MAX SCM_I_TYPE_MAX(scm_t_int64,SCM_T_UINT64_MAX) -#if SCM_SIZEOF_LONG_LONG -#define SCM_I_ULLONG_MAX SCM_I_UTYPE_MAX(unsigned long long) -#define SCM_I_LLONG_MIN SCM_I_TYPE_MIN(long long,SCM_I_ULLONG_MAX) -#define SCM_I_LLONG_MAX SCM_I_TYPE_MAX(long long,SCM_I_ULLONG_MAX) -#endif - #define SCM_T_UINTMAX_MAX SCM_I_UTYPE_MAX(scm_t_uintmax) #define SCM_T_INTMAX_MIN SCM_I_TYPE_MIN(scm_t_intmax,SCM_T_UINTMAX_MAX) #define SCM_T_INTMAX_MAX SCM_I_TYPE_MAX(scm_t_intmax,SCM_T_UINTMAX_MAX) @@ -470,10 +402,6 @@ #define SCM_T_INTPTR_MIN SCM_I_TYPE_MIN(scm_t_intptr,SCM_T_UINTPTR_MAX) #define SCM_T_INTPTR_MAX SCM_I_TYPE_MAX(scm_t_intptr,SCM_T_UINTPTR_MAX) -#define SCM_I_SIZE_MAX SCM_I_UTYPE_MAX(size_t) -#define SCM_I_SSIZE_MIN SCM_I_TYPE_MIN(ssize_t,SCM_I_SIZE_MAX) -#define SCM_I_SSIZE_MAX SCM_I_TYPE_MAX(ssize_t,SCM_I_SIZE_MAX) - #include "libguile/tags.h" @@ -492,64 +420,35 @@ typedef void *scm_t_subr; #endif -#ifdef vms -# ifndef CHEAP_CONTINUATIONS - typedef int jmp_buf[17]; - extern int setjump(jmp_buf env); - extern int longjump(jmp_buf env, int ret); -# define setjmp setjump -# define longjmp longjump -# else -# include <setjmp.h> -# endif -#else /* ndef vms */ -# ifdef _CRAY1 - typedef int jmp_buf[112]; - extern int setjump(jmp_buf env); - extern int longjump(jmp_buf env, int ret); -# define setjmp setjump -# define longjmp longjump -# else /* ndef _CRAY1 */ -# if defined (__ia64__) -/* For IA64, emulate the setjmp API using getcontext. */ -# include <signal.h> -# include <ucontext.h> - typedef struct { - ucontext_t ctx; - int fresh; - } scm_i_jmp_buf; -# define SCM_I_SETJMP(JB) \ - ( (JB).fresh = 1, \ - getcontext (&((JB).ctx)), \ - ((JB).fresh ? ((JB).fresh = 0, 0) : 1) ) -# define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL) - void scm_ia64_longjmp (scm_i_jmp_buf *, int); -# else /* ndef __ia64__ */ -# include <setjmp.h> -# endif /* ndef __ia64__ */ -# endif /* ndef _CRAY1 */ -#endif /* ndef vms */ - -/* For any platform where SCM_I_SETJMP hasn't been defined in some - special way above, map SCM_I_SETJMP, SCM_I_LONGJMP and - scm_i_jmp_buf to setjmp, longjmp and jmp_buf. */ -#ifndef SCM_I_SETJMP -#define scm_i_jmp_buf jmp_buf -#define SCM_I_SETJMP setjmp -#define SCM_I_LONGJMP longjmp -#endif -/* James Clark came up with this neat one instruction fix for - * continuations on the SPARC. It flushes the register windows so - * that all the state of the process is contained in the stack. +/* scm_i_jmp_buf + * + * The corresponding SCM_I_SETJMP and SCM_I_LONGJMP are defined in the + * _scm.h private header. */ -#if defined (sparc) || defined (__sparc__) || defined (__sparc) -# define SCM_FLUSH_REGISTER_WINDOWS asm("ta 3") +#if defined (vms) +typedef int scm_i_jmp_buf[17]; + +#elif defined (_CRAY1) +typedef int scm_i_jmp_buf[112]; + +#elif defined (__ia64__) +# include <signal.h> +# include <ucontext.h> +typedef struct { + ucontext_t ctx; + int fresh; +} scm_i_jmp_buf; + #else -# define SCM_FLUSH_REGISTER_WINDOWS /* empty */ +# include <setjmp.h> +typedef jmp_buf scm_i_jmp_buf; #endif + + + /* If stack is not longword aligned then */ @@ -575,147 +474,14 @@ typedef long SCM_STACKITEM; #define SCM_STACK_PTR(ptr) ((SCM_STACKITEM *) (void *) (ptr)) -SCM_API void scm_async_tick (void); - #ifdef BUILDING_LIBGUILE - -/* FIXME: should change names */ -# define SCM_ASYNC_TICK \ - do \ - { \ - if (SCM_UNLIKELY (SCM_I_CURRENT_THREAD->pending_asyncs)) \ - scm_async_click (); \ - } \ - while (0) - -/* SCM_ASYNC_TICK_WITH_CODE is only available to Guile itself */ -# define SCM_ASYNC_TICK_WITH_CODE(thr, stmt) \ - do \ - { \ - if (SCM_UNLIKELY (thr->pending_asyncs)) \ - { \ - stmt; \ - scm_async_click (); \ - } \ - } \ - while (0) - -#else /* !BUILDING_LIBGUILE */ - -# define SCM_ASYNC_TICK (scm_async_tick ()) - -#endif /* !BUILDING_LIBGUILE */ - - -/* Anthony Green writes: - When the compiler sees... - DEFER_INTS; - [critical code here] - ALLOW_INTS; - ...it doesn't actually promise to keep the critical code within the - boundries of the DEFER/ALLOW_INTS instructions. It may very well - schedule it outside of the magic defined in those macros. - - However, GCC's volatile asm feature forms a barrier over which code is - never moved. So if you add... - asm (""); - ...to each of the DEFER_INTS and ALLOW_INTS macros, the critical - code will always remain in place. asm's without inputs or outputs - are implicitly volatile. */ -#ifdef __GNUC__ -#define SCM_FENCE asm /* volatile */ ("") -#elif defined (__INTEL_COMPILER) && defined (__ia64) -#define SCM_FENCE __memory_barrier() +#define SCM_TICK SCM_ASYNC_TICK #else -#define SCM_FENCE +#define SCM_TICK scm_async_tick () #endif -#define SCM_TICK \ -do { \ - SCM_ASYNC_TICK; \ - SCM_THREAD_SWITCHING_CODE; \ -} while (0) - -/** SCM_ASSERT - ** - **/ - - -#ifdef SCM_RECKLESS -#define SCM_ASSERT(_cond, _arg, _pos, _subr) -#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) -#else -#define SCM_ASSERT(_cond, _arg, _pos, _subr) \ - do { if (SCM_UNLIKELY (!(_cond))) \ - scm_wrong_type_arg (_subr, _pos, _arg); } while (0) -#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \ - do { if (SCM_UNLIKELY (!(_cond))) \ - scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg); } while (0) -#endif - -/* - * SCM_WTA_DISPATCH - */ - -/* Dirk:FIXME:: In all of the SCM_WTA_DISPATCH_* macros it is assumed that - * 'gf' is zero if uninitialized. It would be cleaner if some valid SCM value - * like SCM_BOOL_F or SCM_UNDEFINED was chosen. - */ - -SCM_API SCM scm_call_generic_0 (SCM gf); - -#define SCM_WTA_DISPATCH_0(gf, subr) \ - return (SCM_UNPACK (gf) \ - ? scm_call_generic_0 ((gf)) \ - : (scm_error_num_args_subr ((subr)), SCM_UNSPECIFIED)) -#define SCM_GASSERT0(cond, gf, subr) \ - if (SCM_UNLIKELY(!(cond))) \ - SCM_WTA_DISPATCH_0((gf), (subr)) - -SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1); - -#define SCM_WTA_DISPATCH_1(gf, a1, pos, subr) \ - return (SCM_UNPACK (gf) \ - ? scm_call_generic_1 ((gf), (a1)) \ - : (scm_wrong_type_arg ((subr), (pos), (a1)), SCM_UNSPECIFIED)) - -/* This form is for dispatching a subroutine. */ -#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos) \ - return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr))) \ - ? scm_call_generic_1 ((*SCM_SUBR_GENERIC (subr)), (a1)) \ - : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)), SCM_UNSPECIFIED)) - -#define SCM_GASSERT1(cond, gf, a1, pos, subr) \ - if (SCM_UNLIKELY (!(cond))) \ - SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr)) - -SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2); - -#define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr) \ - return (SCM_UNPACK (gf) \ - ? scm_call_generic_2 ((gf), (a1), (a2)) \ - : (scm_wrong_type_arg ((subr), (pos), \ - (pos) == SCM_ARG1 ? (a1) : (a2)), \ - SCM_UNSPECIFIED)) -#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \ - if (SCM_UNLIKELY (!(cond))) \ - SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr)) - -SCM_API SCM scm_apply_generic (SCM gf, SCM args); - -#define SCM_WTA_DISPATCH_n(gf, args, pos, subr) \ - return (SCM_UNPACK (gf) \ - ? scm_apply_generic ((gf), (args)) \ - : (scm_wrong_type_arg ((subr), (pos), \ - scm_list_ref ((args), \ - scm_from_int ((pos) - 1))), \ - SCM_UNSPECIFIED)) -#define SCM_GASSERTn(cond, gf, args, pos, subr) \ - if (SCM_UNLIKELY (!(cond))) \ - SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr)) - #ifndef SCM_MAGIC_SNARFER /* Let these macros pass through if we are snarfing; thus we can tell the @@ -738,27 +504,6 @@ SCM_API SCM scm_apply_generic (SCM gf, SCM args); -/* SCM_EXIT_SUCCESS is the default code to return from SCM if no errors - * were encountered. SCM_EXIT_FAILURE is the default code to return from - * SCM if errors were encountered. The return code can be explicitly - * specified in a SCM program with (scm_quit <n>). - */ - -#ifndef SCM_EXIT_SUCCESS -#ifdef vms -#define SCM_EXIT_SUCCESS 1 -#else -#define SCM_EXIT_SUCCESS 0 -#endif /* def vms */ -#endif /* ndef SCM_EXIT_SUCCESS */ -#ifndef SCM_EXIT_FAILURE -#ifdef vms -#define SCM_EXIT_FAILURE 2 -#else -#define SCM_EXIT_FAILURE 1 -#endif /* def vms */ -#endif /* ndef SCM_EXIT_FAILURE */ - /* Define SCM_C_INLINE_KEYWORD so that it can be used as a replacement for the "inline" keyword, expanding to nothing when "inline" is not available. |