X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/2acdd822fb2fa788eec06938415e3b0348ea815b..e0c211bb2e80605b4ae3fb121c34136f6e266b70:/libguile/__scm.h diff --git a/libguile/__scm.h b/libguile/__scm.h index b5db4dcb4..da118588d 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -4,7 +4,7 @@ #define SCM___SCM_H /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2006, - * 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. + * 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -126,7 +126,8 @@ /* The SCM_ALIGNED macro, when defined, can be used to instruct the compiler * to honor the given alignment constraint. */ -#if defined __GNUC__ +/* Sun Studio supports alignment since Sun Studio 12 */ +#if defined __GNUC__ || (defined( __SUNPRO_C ) && (__SUNPRO_C - 0 >= 0x590)) # define SCM_ALIGNED(x) __attribute__ ((aligned (x))) #elif defined __INTEL_COMPILER # define SCM_ALIGNED(x) __declspec (align (x)) @@ -161,6 +162,64 @@ +/* We would like gnu89 extern inline semantics, not C99 extern inline + semantics, so that we can be sure to avoid reifying definitions of + inline functions in all compilation units, which is a possibility at + low optimization levels, or if a user takes the address of an inline + function. + + Hence the `__gnu_inline__' attribute, in accordance with: + http://gcc.gnu.org/gcc-4.3/porting_to.html . + + With GCC 4.2, `__GNUC_STDC_INLINE__' is never defined (because C99 inline + semantics are not supported), but a warning is issued in C99 mode if + `__gnu_inline__' is not used. + + Apple's GCC build >5400 (since Xcode 3.0) doesn't support GNU inline in + C99 mode and doesn't define `__GNUC_STDC_INLINE__'. Fall back to "static + inline" in that case. */ + +# if (defined __GNUC__) && (!(((defined __APPLE_CC__) && (__APPLE_CC__ > 5400)) && __STDC_VERSION__ >= 199901L)) +# if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2) +# define SCM_C_EXTERN_INLINE \ + extern __inline__ __attribute__ ((__gnu_inline__)) +# else +# define SCM_C_EXTERN_INLINE extern __inline__ +# endif +# endif + +/* SCM_INLINE is a macro prepended to all public inline function + declarations. Implementations of those functions should also be in + the header file, prefixed by SCM_INLINE_IMPLEMENTATION, and protected + by SCM_CAN_INLINE and a CPP define for the C file in question, like + SCM_INLINE_C_INCLUDING_INLINE_H. See inline.h for an example + usage. */ + +#if defined SCM_IMPLEMENT_INLINES +/* Reifying functions to a file, whether or not inlining is available. */ +# define SCM_CAN_INLINE 0 +# define SCM_INLINE SCM_API +# define SCM_INLINE_IMPLEMENTATION +#elif defined SCM_C_INLINE +/* Declarations when inlining is available. */ +# define SCM_CAN_INLINE 1 +# ifdef SCM_C_EXTERN_INLINE +# define SCM_INLINE SCM_C_EXTERN_INLINE +# else +/* Fall back to static inline if GNU "extern inline" is unavailable. */ +# define SCM_INLINE static SCM_C_INLINE +# endif +# define SCM_INLINE_IMPLEMENTATION SCM_INLINE +#else +/* Declarations when inlining is not available. */ +# define SCM_CAN_INLINE 0 +# define SCM_INLINE SCM_API +/* Don't define SCM_INLINE_IMPLEMENTATION; it should never be seen in + this case. */ +#endif + + + /* {Debugging Options} * * These compile time options determine whether to include code that is only @@ -215,6 +274,31 @@ #define SCM_DEBUG_REST_ARGUMENT SCM_DEBUG #endif +/* The macro SCM_DEBUG_TYPING_STRICTNESS indicates what level of type checking + * shall be performed with respect to the use of the SCM datatype. The macro + * may be defined to one of the values 0, 1 and 2. + * + * A value of 0 means that there will be no compile time type checking, since + * the SCM datatype will be declared as an integral type. This setting should + * only be used on systems, where casting from integral types to pointers may + * lead to loss of bit information. + * + * A value of 1 means that there will an intermediate level of compile time + * type checking, since the SCM datatype will be declared as a pointer to an + * undefined struct. This setting is the default, since it does not cost + * anything in terms of performance or code size. + * + * A value of 2 provides a maximum level of compile time type checking since + * the SCM datatype will be declared as a struct. This setting should be used + * for _compile time_ type checking only, since the compiled result is likely + * to be quite inefficient. The right way to make use of this option is to do + * a 'make clean; make CFLAGS=-DSCM_DEBUG_TYPING_STRICTNESS=2', fix your + * errors, and then do 'make clean; make'. + */ +#ifndef SCM_DEBUG_TYPING_STRICTNESS +#define SCM_DEBUG_TYPING_STRICTNESS 1 +#endif + /* {Feature Options} @@ -337,54 +421,33 @@ typedef void *scm_t_subr; -/* Setjmp and longjmp +/* scm_i_jmp_buf + * + * The corresponding SCM_I_SETJMP and SCM_I_LONGJMP are defined in the + * _scm.h private header. */ #if defined (vms) -/* VMS: Implement setjmp in terms of setjump. */ -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 +typedef int scm_i_jmp_buf[17]; #elif defined (_CRAY1) -/* Cray: Implement setjmp in terms of setjump. */ -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 +typedef int scm_i_jmp_buf[112]; #elif defined (__ia64__) -/* IA64: Implement setjmp in terms of getcontext. */ # include # include 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 -/* All other systems just use setjmp.h. */ # include - +typedef jmp_buf scm_i_jmp_buf; #endif -/* 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 + + /* If stack is not longword aligned then */ @@ -411,151 +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) -#define SCM_ASRTGO(_cond, _label) -#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) -#define SCM_ASRTGO(_cond, _label) \ - do { if (SCM_UNLIKELY (!(_cond))) \ - goto _label; } 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 @@ -578,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 ). - */ - -#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.