Merge remote-tracking branch 'origin/stable-2.0'
[bpt/guile.git] / libguile / __scm.h
index b5db4dc..da11858 100644 (file)
@@ -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
 
 /* 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))
 
 \f
 
+/* 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
+
+\f
+
 /* {Debugging Options}
  *
  * These compile time options determine whether to include code that is only
 #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
+
 \f
 
 /* {Feature Options}
@@ -337,54 +421,33 @@ typedef void *scm_t_subr;
 
 \f
 
-/* 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 <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
-/* All other systems just use setjmp.h.  */
 # include <setjmp.h>
-
+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
+
+\f
 
 /* If stack is not longword aligned then
  */
@@ -411,151 +474,14 @@ typedef long SCM_STACKITEM;
 #define SCM_STACK_PTR(ptr) ((SCM_STACKITEM *) (void *) (ptr))
 \f
 
-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)
-
 \f
 
-/** 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);
 
 \f
 
-/* 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.