[bpt/guile.git] / libguile / __scm.h

/* classes: h_files */

#ifndef __SCMH
#define __SCMH
/*	Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
 * 
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for GUILE, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.  */
\f

/* "What's the difference between _scm.h and __scm.h?"

   _scm.h is not installed; it's only visible to the libguile sources
   themselves.

   __scm.h is installed, and is #included by <libguile.h>.  If both
   the client and libguile need some piece of information, and it
   doesn't fit well into the header file for any particular module, it
   should go in __scm.h.  */


/* {Supported Options}
 *
 * These may be defined or undefined.
 */

/* Old async mechanism */
/* #define GUILE_OLD_ASYNC_CLICK */

/* New scheme for garbage collection */
#define GUILE_NEW_GC_SCHEME

/* #define GUILE_DEBUG_FREELIST */

/* If the compile FLAG `SCM_CAUTIOUS' is #defined then the number of
 * arguments is always checked for application of closures.  If the
 * compile FLAG `SCM_RECKLESS' is #defined then they are not checked.
 * Otherwise, number of argument checks for closures are made only when
 * the function position (whose value is the closure) of a combination is
 * not an ILOC or GLOC.  When the function position of a combination is a
 * symbol it will be checked only the first time it is evaluated because
 * it will then be replaced with an ILOC or GLOC.
 */
#undef SCM_RECKLESS
#define SCM_CAUTIOUS

/* After looking up a local for the first time, rewrite the
 * code graph, caching its position.
 */
#define MEMOIZE_LOCALS

/* All the number support there is.
 */
#define BIGNUMS

/* GC should relinquish empty cons-pair arenas. 
 */
#ifndef GUILE_NEW_GC_SCHEME
#define GC_FREE_SEGMENTS
#endif

/* Provide a scheme-accessible count-down timer that
 * generates a pseudo-interrupt.
 */
#define TICKS


/* Use engineering notation when converting numbers strings?
 */
#undef ENGNOT

#undef SCM_CAREFUL_INTS
\f
/* {Unsupported Options}
 *
 * These must be defined as given here.
 */


#define CCLO

/* Guile Scheme supports the #f/() distinction; Guile Lisp won't.  We
   have horrible plans for their unification.  */
#undef SICP

\f

/* Random options (not yet supported or in final form). */

#define STACK_CHECKING
#undef NO_CEVAL_STACK_CHECKING

\f
/* What did the configure script discover about the outside world?  */
#include "libguile/scmconfig.h"

#ifdef HAVE_LONG_LONGS

/* Some auto-generated .h files contain unused prototypes
 * that need these typedefs.
 */
typedef long long long_long;
typedef unsigned long long ulong_long;

#endif /* HAVE_LONG_LONGS */

\f

/* Define
 *
 * SCM_CHAR_CODE_LIMIT		== UCHAR_MAX + 1
 * SCM_MOST_POSITIVE_FIXNUM 	(LONG_MAX>>2)
 * SCM_MOST_NEGATIVE_FIXNUM 	== SCM_SRS((long)LONG_MIN, 2)
 */

#ifdef HAVE_LIMITS_H
# include <limits.h>
# ifdef UCHAR_MAX
#  define SCM_CHAR_CODE_LIMIT (UCHAR_MAX+1L)
# else
#  define SCM_CHAR_CODE_LIMIT 256L
# endif /* def UCHAR_MAX */
# define SCM_MOST_POSITIVE_FIXNUM (LONG_MAX>>2)
# ifdef _UNICOS			/* Stupid cray bug */
#  define SCM_MOST_NEGATIVE_FIXNUM ((long)LONG_MIN/4)
# else
#  define SCM_MOST_NEGATIVE_FIXNUM SCM_SRS((long)LONG_MIN, 2)
# endif				/* UNICOS */
#else
# define SCM_CHAR_CODE_LIMIT 256L
# define SCM_MOST_POSITIVE_FIXNUM ((long)((unsigned long)~0L>>3))
# if (0 != ~0)
#  define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM-1)
# else
#  define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM)
# endif /*  (0 != ~0) */
#endif /* def HAVE_LIMITS_H */
\f

#ifdef STDC_HEADERS
# include <stdlib.h>
# ifdef AMIGA
#  include <stddef.h>
# endif /* def AMIGA */
# define scm_sizet size_t
#else
# ifdef _SIZE_T
#  define scm_sizet size_t
# else
#  define scm_sizet unsigned int
# endif /* def _SIZE_T */
#endif /* def STDC_HEADERS */

\f

#include "libguile/tags.h"

\f
#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 */
#  include <setjmp.h>
# endif				/* ndef _CRAY1 */
#endif				/* ndef vms */

/* 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. 
 */

#ifdef sparc
# define SCM_FLUSH_REGISTER_WINDOWS asm("ta 3")
#else
# define SCM_FLUSH_REGISTER_WINDOWS /* empty */
#endif

/* If stack is not longword aligned then 
 */

/* #define SHORT_ALIGN */
#ifdef THINK_C
# define SHORT_ALIGN
#endif
#ifdef MSDOS
# define SHORT_ALIGN
#endif
#ifdef atarist
# define SHORT_ALIGN
#endif

#ifdef SHORT_ALIGN
typedef short SCM_STACKITEM;
#else
typedef long SCM_STACKITEM;
#endif
\f

#ifndef USE_THREADS
#define SCM_THREAD_DEFER
#define SCM_THREAD_ALLOW
#define SCM_THREAD_REDEFER
#define SCM_THREAD_SWITCHING_CODE
#endif

#ifdef GUILE_OLD_ASYNC_CLICK
extern unsigned int scm_async_clock;

#define SCM_ASYNC_TICK \
do { \
  if (0 == --scm_async_clock) \
    scm_async_click (); \
} while(0)
#else
extern int scm_asyncs_pending_p;

#define SCM_ASYNC_TICK /*fixme* should change names */ \
do { \
  if (scm_asyncs_pending_p) \
    scm_async_click (); \
} while (0)
#endif

#ifdef SCM_CAREFUL_INTS
#define SCM_CHECK_NOT_DISABLED \
  if (scm_ints_disabled) \
    fputs("ints already disabled\n", stderr); \

#define SCM_CHECK_NOT_ENABLED \
  if (!scm_ints_disabled) \
    fputs("ints already enabled\n", stderr); \

#else
#define SCM_CHECK_NOT_DISABLED
#define SCM_CHECK_NOT_ENABLED
#endif


/* 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 */ ("")
#else
#define SCM_FENCE
#endif

#define SCM_DEFER_INTS \
do { \
  SCM_FENCE; \
  SCM_CHECK_NOT_DISABLED; \
  SCM_THREAD_DEFER; \
  SCM_FENCE; \
  scm_ints_disabled = 1; \
  SCM_FENCE; \
} while (0)


#define SCM_ALLOW_INTS_ONLY \
do { \
  SCM_THREAD_ALLOW; \
  scm_ints_disabled = 0; \
} while (0)


#define SCM_ALLOW_INTS \
do { \
  SCM_FENCE; \
  SCM_CHECK_NOT_ENABLED; \
  SCM_THREAD_SWITCHING_CODE; \
  SCM_FENCE; \
  scm_ints_disabled = 0; \
  SCM_FENCE; \
  SCM_THREAD_ALLOW; \
  SCM_FENCE; \
} while (0)


#define SCM_REDEFER_INTS  \
do { \
  SCM_FENCE; \
  SCM_THREAD_REDEFER; \
  ++scm_ints_disabled; \
  SCM_FENCE; \
} while (0)


#define SCM_REALLOW_INTS \
do { \
  SCM_FENCE; \
  SCM_THREAD_SWITCHING_CODE; \
  SCM_FENCE; \
  --scm_ints_disabled; \
  SCM_FENCE; \
} while (0)


#define SCM_TICK \
do { \
  SCM_DEFER_INTS; \
  SCM_ALLOW_INTS; \
  SCM_ASYNC_TICK; \
} while (0)

\f

/* Classification of critical sections
 *
 * When Guile moves to POSIX threads, it won't be possible to prevent
 * context switching.  In fact, the whole idea of context switching is
 * bogus if threads are run by different processors.  Therefore, we
 * must ultimately eliminate all critical sections or enforce them by
 * use of mutecis.
 *
 * All instances of SCM_DEFER_INTS and SCM_ALLOW_INTS should therefore
 * be classified and replaced by one of the delimiters below.  If you
 * understand what this is all about, I'd like to encourage you to
 * help with this task.  The set of classes below must of course be
 * incrementally augmented.
 *
 * MDJ 980419 <djurfeldt@nada.kth.se>
 */

/* A sections
 *
 * Allocation of a cell with type tag in the CAR.
 *
 * With POSIX threads, each thread will have a private pool of free
 * cells.  Therefore, this type of section can be removed.  But!  It
 * is important that the CDR is initialized first (with the CAR still
 * indicating a free cell) so that we can guarantee a consistent heap
 * at all times.
 */

#ifdef SCM_POSIX_THREADS
#define SCM_ENTER_A_SECTION
#define SCM_EXIT_A_SECTION
#else
#define SCM_ENTER_A_SECTION SCM_DEFER_INTS
#define SCM_EXIT_A_SECTION SCM_ALLOW_INTS
#endif

\f

/** SCM_ASSERT
 ** 
 **/


#ifdef SCM_RECKLESS
#define SCM_ASSERT(_cond, _arg, _pos, _subr)
#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr)
#define SCM_ASRTGO(_cond, _label)
#else
#define SCM_ASSERT(_cond, _arg, _pos, _subr) \
	if (!(_cond)) \
          scm_wta(_arg, (char *)(_pos), _subr)
#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \
	if (!(_cond)) \
          scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg)
#define SCM_ASRTGO(_cond, _label) \
        if (!(_cond)) \
          goto _label
#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.
 */

extern SCM scm_call_generic_0 (SCM gf);

#define SCM_WTA_DISPATCH_0(gf, arg, pos, subr) \
  return (SCM_UNPACK (gf) \
          ? scm_call_generic_0 ((gf)) \
          : scm_wta ((arg), (char *) (pos), (subr)))
#define SCM_GASSERT0(cond, gf, arg, pos, subr) \
  if (!(cond)) SCM_WTA_DISPATCH_0((gf), (arg), (pos), (subr))

extern 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_wta ((a1), (char *) (pos), (subr)))
#define SCM_GASSERT1(cond, gf, a1, pos, subr) \
  if (!(cond)) SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))

extern 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_wta ((pos) == SCM_ARG1 ? (a1) : (a2), (char *) (pos), (subr)))
#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \
  if (!(cond)) SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr))

extern 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_wta (scm_list_ref ((args), SCM_MAKINUM ((pos) - 1)), \
		     (char *) (pos), \
		     (subr)))
#define SCM_GASSERTn(cond, gf, args, pos, subr) \
  if (!(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
   difference between the use of an actual
   number vs. the use of one of these macros --
   actual numbers in SCM_VALIDATE_* and SCM_ASSERT
   constructs must match the formal argument name,
   but using SCM_ARG* avoids the test */

#define SCM_ARGn 		0
#define SCM_ARG1 		1
#define SCM_ARG2 		2
#define SCM_ARG3 		3
#define SCM_ARG4 		4
#define SCM_ARG5 		5
#define SCM_ARG6 		6
#define SCM_ARG7 		7 
     /* #define SCM_ARGERR(X) 		((X) < SCM_WNA \
				 ? (char *)(X) \
				 : "wrong type argument")
				 */

/* Following must match entry indexes in scm_errmsgs[].
 * Also, SCM_WNA must follow the last SCM_ARGn in sequence.
 */
#define SCM_WNA 		8
     /* #define SCM_OVSCM_FLOW 		9 */
#define SCM_OUTOFRANGE 		10
#define SCM_NALLOC 		11
     /* #define SCM_STACK_OVFLOW	12 */
     /* #define SCM_EXIT 		13 */

#endif /* SCM_MAGIC_SNARFER */

/* (...still matching scm_errmsgs)  These
 * are signals.  Signals may become errors
 * but are distinguished because they first
 * try to invoke a handler that can resume
 * the interrupted routine.
 */
#define SCM_HUP_SIGNAL 		14
#define SCM_INT_SIGNAL 		15
#define SCM_FPE_SIGNAL 		16
#define SCM_BUS_SIGNAL 		17
#define SCM_SEGV_SIGNAL 	18
#define SCM_ALRM_SIGNAL 	19
#define SCM_GC_SIGNAL		20
#define SCM_TICK_SIGNAL		21

#define SCM_SIG_ORD(X)		((X) - SCM_HUP_SIGNAL)
#define SCM_ORD_SIG(X)		((X) + SCM_HUP_SIGNAL)
#define SCM_NUM_SIGS		(SCM_SIG_ORD (SCM_TICK_SIGNAL) + 1)

#if 0
struct errdesc
{
  char *msg;
  char *s_response;
  short parent_err;
};


extern struct errdesc scm_errmsgs[];
#endif

\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 */


\f

#endif  /* __SCMH */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
0f2d19dd JB	1	/* classes: h_files */
	2
	3	#ifndef __SCMH
	4	#define __SCMH
cd911565	5	/* Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
0f2d19dd JB	6	*
	7	* This program is free software; you can redistribute it and/or modify
	8	* it under the terms of the GNU General Public License as published by
	9	* the Free Software Foundation; either version 2, or (at your option)
	10	* any later version.
	11	*
	12	* This program is distributed in the hope that it will be useful,
	13	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	* GNU General Public License for more details.
	16	*
	17	* You should have received a copy of the GNU General Public License
	18	* along with this software; see the file COPYING. If not, write to
82892bed JB	19	* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
82892bed JB	20	* Boston, MA 02111-1307 USA
0f2d19dd JB	21	*
	22	* As a special exception, the Free Software Foundation gives permission
	23	* for additional uses of the text contained in its release of GUILE.
	24	*
	25	* The exception is that, if you link the GUILE library with other files
	26	* to produce an executable, this does not by itself cause the
	27	* resulting executable to be covered by the GNU General Public License.
	28	* Your use of that executable is in no way restricted on account of
	29	* linking the GUILE library code into it.
	30	*
	31	* This exception does not however invalidate any other reasons why
	32	* the executable file might be covered by the GNU General Public License.
	33	*
	34	* This exception applies only to the code released by the
	35	* Free Software Foundation under the name GUILE. If you copy
	36	* code from other Free Software Foundation releases into a copy of
	37	* GUILE, as the General Public License permits, the exception does
	38	* not apply to the code that you add in this way. To avoid misleading
	39	* anyone as to the status of such modified files, you must delete
	40	* this exception notice from them.
	41	*
	42	* If you write modifications of your own for GUILE, it is your choice
	43	* whether to permit this exception to apply to your modifications.
82892bed	44	* If you do not wish that, delete this exception notice. */
0f2d19dd	45	\f
176067df JB	46
	47	/* "What's the difference between _scm.h and __scm.h?"
	48
	49	_scm.h is not installed; it's only visible to the libguile sources
	50	themselves.
	51
	52	__scm.h is installed, and is #included by <libguile.h>. If both
	53	the client and libguile need some piece of information, and it
	54	doesn't fit well into the header file for any particular module, it
	55	should go in __scm.h. */
	56
	57
0f2d19dd JB	58	/* {Supported Options}
	59	*
	60	* These may be defined or undefined.
	61	*/
	62
9f0e55a6 MD	63	/* Old async mechanism */
	64	/* #define GUILE_OLD_ASYNC_CLICK */
	65
83c4c29d	66	/* New scheme for garbage collection */
d2f51eaf	67	#define GUILE_NEW_GC_SCHEME
83c4c29d	68
16d35552	69	/* #define GUILE_DEBUG_FREELIST */
70d63753	70
cf7c17e9	71	/* If the compile FLAG `SCM_CAUTIOUS' is #defined then the number of
0f2d19dd	72	* arguments is always checked for application of closures. If the
cf7c17e9	73	* compile FLAG `SCM_RECKLESS' is #defined then they are not checked.
0f2d19dd JB	74	* Otherwise, number of argument checks for closures are made only when
	75	* the function position (whose value is the closure) of a combination is
	76	* not an ILOC or GLOC. When the function position of a combination is a
	77	* symbol it will be checked only the first time it is evaluated because
	78	* it will then be replaced with an ILOC or GLOC.
	79	*/
cf7c17e9 JB	80	#undef SCM_RECKLESS
cf7c17e9 JB	81	#define SCM_CAUTIOUS
0f2d19dd JB	82
	83	/* After looking up a local for the first time, rewrite the
	84	* code graph, caching its position.
	85	*/
	86	#define MEMOIZE_LOCALS
	87
	88	/* All the number support there is.
	89	*/
0f2d19dd JB	90	#define BIGNUMS
	91
	92	/* GC should relinquish empty cons-pair arenas.
	93	*/
d2f51eaf	94	#ifndef GUILE_NEW_GC_SCHEME
0f2d19dd	95	#define GC_FREE_SEGMENTS
d2f51eaf	96	#endif
0f2d19dd JB	97
	98	/* Provide a scheme-accessible count-down timer that
	99	* generates a pseudo-interrupt.
	100	*/
	101	#define TICKS
	102
	103
	104	/* Use engineering notation when converting numbers strings?
	105	*/
	106	#undef ENGNOT
	107
0f2d19dd JB	108	#undef SCM_CAREFUL_INTS
	109	\f
	110	/* {Unsupported Options}
	111	*
3c205827	112	* These must be defined as given here.
0f2d19dd JB	113	*/
	114
	115
	116	#define CCLO
3c205827 JB	117
	118	/* Guile Scheme supports the #f/() distinction; Guile Lisp won't. We
	119	have horrible plans for their unification. */
	120	#undef SICP
0f2d19dd JB	121
	122	\f
	123
80c78696	124	/* Random options (not yet supported or in final form). */
0f2d19dd	125
80c78696 MD	126	#define STACK_CHECKING
80c78696 MD	127	#undef NO_CEVAL_STACK_CHECKING
0f2d19dd	128
43ff3170 GH	129	\f
	130	/* What did the configure script discover about the outside world? */
	131	#include "libguile/scmconfig.h"
	132
	133	#ifdef HAVE_LONG_LONGS
	134
0f2d19dd JB	135	/* Some auto-generated .h files contain unused prototypes
	136	* that need these typedefs.
	137	*/
afe5177e GH	138	typedef long long long_long;
afe5177e GH	139	typedef unsigned long long ulong_long;
0f2d19dd	140
43ff3170	141	#endif /* HAVE_LONG_LONGS */
b971d089 JB	142
b971d089 JB	143	\f
0f2d19dd JB	144
	145	/* Define
	146	*
e2806c10	147	* SCM_CHAR_CODE_LIMIT == UCHAR_MAX + 1
0f2d19dd JB	148	* SCM_MOST_POSITIVE_FIXNUM (LONG_MAX>>2)
	149	* SCM_MOST_NEGATIVE_FIXNUM == SCM_SRS((long)LONG_MIN, 2)
	150	*/
	151
b971d089	152	#ifdef HAVE_LIMITS_H
0f2d19dd JB	153	# include <limits.h>
0f2d19dd JB	154	# ifdef UCHAR_MAX
e2806c10	155	# define SCM_CHAR_CODE_LIMIT (UCHAR_MAX+1L)
0f2d19dd	156	# else
e2806c10	157	# define SCM_CHAR_CODE_LIMIT 256L
0f2d19dd JB	158	# endif /* def UCHAR_MAX */
	159	# define SCM_MOST_POSITIVE_FIXNUM (LONG_MAX>>2)
	160	# ifdef _UNICOS /* Stupid cray bug */
	161	# define SCM_MOST_NEGATIVE_FIXNUM ((long)LONG_MIN/4)
	162	# else
	163	# define SCM_MOST_NEGATIVE_FIXNUM SCM_SRS((long)LONG_MIN, 2)
	164	# endif /* UNICOS */
	165	#else
e2806c10	166	# define SCM_CHAR_CODE_LIMIT 256L
0f2d19dd JB	167	# define SCM_MOST_POSITIVE_FIXNUM ((long)((unsigned long)~0L>>3))
	168	# if (0 != ~0)
	169	# define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM-1)
	170	# else
	171	# define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM)
	172	# endif /* (0 != ~0) */
b971d089	173	#endif /* def HAVE_LIMITS_H */
0f2d19dd JB	174	\f
0f2d19dd JB	175
2a1d8241 JB	176	#ifdef STDC_HEADERS
	177	# include <stdlib.h>
	178	# ifdef AMIGA
	179	# include <stddef.h>
	180	# endif /* def AMIGA */
	181	# define scm_sizet size_t
	182	#else
	183	# ifdef _SIZE_T
	184	# define scm_sizet size_t
	185	# else
	186	# define scm_sizet unsigned int
	187	# endif /* def _SIZE_T */
	188	#endif /* def STDC_HEADERS */
	189
	190	\f
	191
	192	#include "libguile/tags.h"
0f2d19dd JB	193
	194	\f
	195	#ifdef vms
	196	# ifndef CHEAP_CONTINUATIONS
	197	typedef int jmp_buf[17];
	198	extern int setjump(jmp_buf env);
	199	extern int longjump(jmp_buf env, int ret);
	200	# define setjmp setjump
	201	# define longjmp longjump
	202	# else
	203	# include <setjmp.h>
	204	# endif
	205	#else /* ndef vms */
	206	# ifdef _CRAY1
	207	typedef int jmp_buf[112];
	208	extern int setjump(jmp_buf env);
	209	extern int longjump(jmp_buf env, int ret);
	210	# define setjmp setjump
	211	# define longjmp longjump
	212	# else /* ndef _CRAY1 */
	213	# include <setjmp.h>
	214	# endif /* ndef _CRAY1 */
	215	#endif /* ndef vms */
	216
0f2d19dd JB	217	/* James Clark came up with this neat one instruction fix for
	218	* continuations on the SPARC. It flushes the register windows so
	219	* that all the state of the process is contained in the stack.
	220	*/
	221
	222	#ifdef sparc
	223	# define SCM_FLUSH_REGISTER_WINDOWS asm("ta 3")
	224	#else
	225	# define SCM_FLUSH_REGISTER_WINDOWS /* empty */
	226	#endif
	227
	228	/* If stack is not longword aligned then
	229	*/
	230
	231	/* #define SHORT_ALIGN */
	232	#ifdef THINK_C
	233	# define SHORT_ALIGN
	234	#endif
	235	#ifdef MSDOS
	236	# define SHORT_ALIGN
	237	#endif
	238	#ifdef atarist
	239	# define SHORT_ALIGN
	240	#endif
	241
	242	#ifdef SHORT_ALIGN
	243	typedef short SCM_STACKITEM;
	244	#else
	245	typedef long SCM_STACKITEM;
	246	#endif
	247	\f
	248
82339094	249	#ifndef USE_THREADS
25d3ee9d MD	250	#define SCM_THREAD_DEFER
	251	#define SCM_THREAD_ALLOW
	252	#define SCM_THREAD_REDEFER
25d3ee9d	253	#define SCM_THREAD_SWITCHING_CODE
82339094 MD	254	#endif
82339094 MD	255
9f0e55a6	256	#ifdef GUILE_OLD_ASYNC_CLICK
0f2d19dd	257	extern unsigned int scm_async_clock;
82339094	258
25d3ee9d	259	#define SCM_ASYNC_TICK \
bfc69694	260	do { \
25d3ee9d MD	261	if (0 == --scm_async_clock) \
25d3ee9d MD	262	scm_async_click (); \
bfc69694	263	} while(0)
9f0e55a6 MD	264	#else
	265	extern int scm_asyncs_pending_p;
	266
	267	#define SCM_ASYNC_TICK /fixme should change names */ \
	268	do { \
	269	if (scm_asyncs_pending_p) \
	270	scm_async_click (); \
	271	} while (0)
	272	#endif
25d3ee9d	273
0f2d19dd JB	274	#ifdef SCM_CAREFUL_INTS
	275	#define SCM_CHECK_NOT_DISABLED \
	276	if (scm_ints_disabled) \
	277	fputs("ints already disabled\n", stderr); \
	278
	279	#define SCM_CHECK_NOT_ENABLED \
	280	if (!scm_ints_disabled) \
	281	fputs("ints already enabled\n", stderr); \
	282
	283	#else
	284	#define SCM_CHECK_NOT_DISABLED
	285	#define SCM_CHECK_NOT_ENABLED
	286	#endif
	287
	288
8417b665 JB	289	/* Anthony Green writes:
	290	When the compiler sees...
	291	DEFER_INTS;
	292	[critical code here]
	293	ALLOW_INTS;
	294	...it doesn't actually promise to keep the critical code within the
	295	boundries of the DEFER/ALLOW_INTS instructions. It may very well
	296	schedule it outside of the magic defined in those macros.
	297
	298	However, GCC's volatile asm feature forms a barrier over which code is
	299	never moved. So if you add...
35eec738 JB	300	asm ("");
	301	...to each of the DEFER_INTS and ALLOW_INTS macros, the critical
	302	code will always remain in place. asm's without inputs or outputs
	303	are implicitly volatile. */
8417b665	304	#ifdef __GNUC__
35eec738	305	#define SCM_FENCE asm /* volatile */ ("")
8417b665 JB	306	#else
	307	#define SCM_FENCE
	308	#endif
	309
0f2d19dd	310	#define SCM_DEFER_INTS \
bfc69694	311	do { \
8417b665	312	SCM_FENCE; \
0f2d19dd	313	SCM_CHECK_NOT_DISABLED; \
25d3ee9d	314	SCM_THREAD_DEFER; \
8417b665	315	SCM_FENCE; \
0f2d19dd	316	scm_ints_disabled = 1; \
8417b665	317	SCM_FENCE; \
bfc69694	318	} while (0)
0f2d19dd JB	319
	320
	321	#define SCM_ALLOW_INTS_ONLY \
bfc69694	322	do { \
25d3ee9d	323	SCM_THREAD_ALLOW; \
0f2d19dd	324	scm_ints_disabled = 0; \
bfc69694	325	} while (0)
0f2d19dd JB	326
	327
	328	#define SCM_ALLOW_INTS \
bfc69694	329	do { \
8417b665	330	SCM_FENCE; \
0f2d19dd	331	SCM_CHECK_NOT_ENABLED; \
c72cc5fb MD	332	SCM_THREAD_SWITCHING_CODE; \
c72cc5fb MD	333	SCM_FENCE; \
0f2d19dd	334	scm_ints_disabled = 0; \
8417b665 JB	335	SCM_FENCE; \
8417b665 JB	336	SCM_THREAD_ALLOW; \
8417b665	337	SCM_FENCE; \
bfc69694	338	} while (0)
0f2d19dd JB	339
	340
	341	#define SCM_REDEFER_INTS \
bfc69694	342	do { \
c72cc5fb	343	SCM_FENCE; \
25d3ee9d	344	SCM_THREAD_REDEFER; \
0f2d19dd	345	++scm_ints_disabled; \
c72cc5fb	346	SCM_FENCE; \
bfc69694	347	} while (0)
0f2d19dd JB	348
	349
	350	#define SCM_REALLOW_INTS \
bfc69694	351	do { \
c72cc5fb	352	SCM_FENCE; \
c72cc5fb MD	353	SCM_THREAD_SWITCHING_CODE; \
c72cc5fb MD	354	SCM_FENCE; \
0f2d19dd	355	--scm_ints_disabled; \
c72cc5fb	356	SCM_FENCE; \
bfc69694	357	} while (0)
0f2d19dd JB	358
0f2d19dd JB	359
c72cc5fb	360	#define SCM_TICK \
bfc69694	361	do { \
c72cc5fb MD	362	SCM_DEFER_INTS; \
c72cc5fb MD	363	SCM_ALLOW_INTS; \
cd911565	364	SCM_ASYNC_TICK; \
bfc69694	365	} while (0)
0f2d19dd JB	366
	367	\f
	368
f83e2737 MD	369	/* Classification of critical sections
	370	*
	371	* When Guile moves to POSIX threads, it won't be possible to prevent
	372	* context switching. In fact, the whole idea of context switching is
	373	* bogus if threads are run by different processors. Therefore, we
	374	* must ultimately eliminate all critical sections or enforce them by
	375	* use of mutecis.
	376	*
	377	* All instances of SCM_DEFER_INTS and SCM_ALLOW_INTS should therefore
	378	* be classified and replaced by one of the delimiters below. If you
	379	* understand what this is all about, I'd like to encourage you to
	380	* help with this task. The set of classes below must of course be
	381	* incrementally augmented.
	382	*
	383	* MDJ 980419 <djurfeldt@nada.kth.se>
	384	*/
	385
	386	/* A sections
	387	*
	388	* Allocation of a cell with type tag in the CAR.
	389	*
	390	* With POSIX threads, each thread will have a private pool of free
	391	* cells. Therefore, this type of section can be removed. But! It
	392	* is important that the CDR is initialized first (with the CAR still
	393	* indicating a free cell) so that we can guarantee a consistent heap
	394	* at all times.
	395	*/
	396
	397	#ifdef SCM_POSIX_THREADS
	398	#define SCM_ENTER_A_SECTION
	399	#define SCM_EXIT_A_SECTION
	400	#else
	401	#define SCM_ENTER_A_SECTION SCM_DEFER_INTS
	402	#define SCM_EXIT_A_SECTION SCM_ALLOW_INTS
	403	#endif
	404
	405	\f
	406
0f2d19dd JB	407	/** SCM_ASSERT
	408	**
	409	**/
	410
	411
	412	#ifdef SCM_RECKLESS
	413	#define SCM_ASSERT(_cond, _arg, _pos, _subr)
b6791b2e	414	#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr)
0f2d19dd JB	415	#define SCM_ASRTGO(_cond, _label)
	416	#else
	417	#define SCM_ASSERT(_cond, _arg, _pos, _subr) \
	418	if (!(_cond)) \
	419	scm_wta(_arg, (char *)(_pos), _subr)
b6791b2e GB	420	#define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \
	421	if (!(_cond)) \
	422	scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg)
0f2d19dd JB	423	#define SCM_ASRTGO(_cond, _label) \
	424	if (!(_cond)) \
	425	goto _label
	426	#endif
95b88819	427
9de33deb MD	428	/*
	429	* SCM_WTA_DISPATCH
	430	*/
	431
451e591c DH	432	/* Dirk:FIXME:: In all of the SCM_WTA_DISPATCH_* macros it is assumed that
	433	* 'gf' is zero if uninitialized. It would be cleaner if some valid SCM value
	434	* like SCM_BOOL_F or SCM_UNDEFINED was chosen.
	435	*/
	436
b3c8a0f5 MD	437	extern SCM scm_call_generic_0 (SCM gf);
	438
	439	#define SCM_WTA_DISPATCH_0(gf, arg, pos, subr) \
451e591c	440	return (SCM_UNPACK (gf) \
b3c8a0f5 MD	441	? scm_call_generic_0 ((gf)) \
	442	: scm_wta ((arg), (char *) (pos), (subr)))
	443	#define SCM_GASSERT0(cond, gf, arg, pos, subr) \
ff725a17	444	if (!(cond)) SCM_WTA_DISPATCH_0((gf), (arg), (pos), (subr))
b3c8a0f5	445
9de33deb MD	446	extern SCM scm_call_generic_1 (SCM gf, SCM a1);
	447
	448	#define SCM_WTA_DISPATCH_1(gf, a1, pos, subr) \
451e591c	449	return (SCM_UNPACK (gf) \
9de33deb MD	450	? scm_call_generic_1 ((gf), (a1)) \
	451	: scm_wta ((a1), (char *) (pos), (subr)))
	452	#define SCM_GASSERT1(cond, gf, a1, pos, subr) \
	453	if (!(cond)) SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))
	454
	455	extern SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
	456
	457	#define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr) \
451e591c	458	return (SCM_UNPACK (gf) \
9de33deb MD	459	? scm_call_generic_2 ((gf), (a1), (a2)) \
	460	: scm_wta ((pos) == SCM_ARG1 ? (a1) : (a2), (char *) (pos), (subr)))
	461	#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \
	462	if (!(cond)) SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr))
	463
89c358b1 MD	464	extern SCM scm_apply_generic (SCM gf, SCM args);
	465
	466	#define SCM_WTA_DISPATCH_n(gf, args, pos, subr) \
451e591c	467	return (SCM_UNPACK (gf) \
89c358b1 MD	468	? scm_apply_generic ((gf), (args)) \
	469	: scm_wta (scm_list_ref ((args), SCM_MAKINUM ((pos) - 1)), \
	470	(char *) (pos), \
	471	(subr)))
	472	#define SCM_GASSERTn(cond, gf, args, pos, subr) \
	473	if (!(cond)) SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr))
	474
c751e5e3 GB	475	#ifndef SCM_MAGIC_SNARFER
	476	/* Let these macros pass through if
	477	we are snarfing; thus we can tell the
	478	difference between the use of an actual
	479	number vs. the use of one of these macros --
f5421cfc	480	actual numbers in SCM_VALIDATE_* and SCM_ASSERT
c751e5e3 GB	481	constructs must match the formal argument name,
	482	but using SCM_ARG* avoids the test */
	483
0f2d19dd JB	484	#define SCM_ARGn 0
	485	#define SCM_ARG1 1
	486	#define SCM_ARG2 2
	487	#define SCM_ARG3 3
	488	#define SCM_ARG4 4
	489	#define SCM_ARG5 5
1146b6cd GH	490	#define SCM_ARG6 6
1146b6cd GH	491	#define SCM_ARG7 7
f5bf2977	492	/* #define SCM_ARGERR(X) ((X) < SCM_WNA \
0f2d19dd JB	493	? (char *)(X) \
0f2d19dd JB	494	: "wrong type argument")
f5bf2977	495	*/
0f2d19dd JB	496
	497	/* Following must match entry indexes in scm_errmsgs[].
	498	* Also, SCM_WNA must follow the last SCM_ARGn in sequence.
	499	*/
	500	#define SCM_WNA 8
e1724d20	501	/* #define SCM_OVSCM_FLOW 9 */
0f2d19dd JB	502	#define SCM_OUTOFRANGE 10
0f2d19dd JB	503	#define SCM_NALLOC 11
f5bf2977 GH	504	/* #define SCM_STACK_OVFLOW 12 */
f5bf2977 GH	505	/* #define SCM_EXIT 13 */
0f2d19dd	506
c751e5e3	507	#endif /* SCM_MAGIC_SNARFER */
0f2d19dd JB	508
	509	/* (...still matching scm_errmsgs) These
	510	* are signals. Signals may become errors
	511	* but are distinguished because they first
	512	* try to invoke a handler that can resume
	513	* the interrupted routine.
	514	*/
	515	#define SCM_HUP_SIGNAL 14
	516	#define SCM_INT_SIGNAL 15
	517	#define SCM_FPE_SIGNAL 16
	518	#define SCM_BUS_SIGNAL 17
	519	#define SCM_SEGV_SIGNAL 18
	520	#define SCM_ALRM_SIGNAL 19
	521	#define SCM_GC_SIGNAL 20
	522	#define SCM_TICK_SIGNAL 21
	523
	524	#define SCM_SIG_ORD(X) ((X) - SCM_HUP_SIGNAL)
	525	#define SCM_ORD_SIG(X) ((X) + SCM_HUP_SIGNAL)
	526	#define SCM_NUM_SIGS (SCM_SIG_ORD (SCM_TICK_SIGNAL) + 1)
	527
82339094	528	#if 0
0f2d19dd JB	529	struct errdesc
	530	{
	531	char *msg;
	532	char *s_response;
	533	short parent_err;
	534	};
	535
	536
	537	extern struct errdesc scm_errmsgs[];
82339094	538	#endif
0f2d19dd JB	539
	540	\f
	541
	542	/* SCM_EXIT_SUCCESS is the default code to return from SCM if no errors
	543	* were encountered. SCM_EXIT_FAILURE is the default code to return from
	544	* SCM if errors were encountered. The return code can be explicitly
	545	* specified in a SCM program with (scm_quit <n>).
	546	*/
	547
	548	#ifndef SCM_EXIT_SUCCESS
	549	#ifdef vms
	550	#define SCM_EXIT_SUCCESS 1
	551	#else
	552	#define SCM_EXIT_SUCCESS 0
	553	#endif /* def vms */
	554	#endif /* ndef SCM_EXIT_SUCCESS */
	555	#ifndef SCM_EXIT_FAILURE
	556	#ifdef vms
	557	#define SCM_EXIT_FAILURE 2
	558	#else
	559	#define SCM_EXIT_FAILURE 1
	560	#endif /* def vms */
	561	#endif /* ndef SCM_EXIT_FAILURE */
	562
	563
	564
	565	\f
0f2d19dd JB	566
0f2d19dd JB	567	#endif /* __SCMH */
89e00824 ML	568
	569	/*
	570	Local Variables:
	571	c-file-style: "gnu"
	572	End:
	573	*/