libguile/__scm.h

   1 /* classes: h_files */
   2
   3 #ifndef SCM___SCM_H
   4 #define SCM___SCM_H
   5
   6 /* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 Free Software Foundation, Inc.
   7  *
   8  * This program is free software; you can redistribute it and/or modify
   9  * it under the terms of the GNU General Public License as published by
  10  * the Free Software Foundation; either version 2, or (at your option)
  11  * any later version.
  12  *
  13  * This program is distributed in the hope that it will be useful,
  14  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  15  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16  * GNU General Public License for more details.
  17  *
  18  * You should have received a copy of the GNU General Public License
  19  * along with this software; see the file COPYING.  If not, write to
  20  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  21  * Boston, MA 02111-1307 USA
  22  *
  23  * As a special exception, the Free Software Foundation gives permission
  24  * for additional uses of the text contained in its release of GUILE.
  25  *
  26  * The exception is that, if you link the GUILE library with other files
  27  * to produce an executable, this does not by itself cause the
  28  * resulting executable to be covered by the GNU General Public License.
  29  * Your use of that executable is in no way restricted on account of
  30  * linking the GUILE library code into it.
  31  *
  32  * This exception does not however invalidate any other reasons why
  33  * the executable file might be covered by the GNU General Public License.
  34  *
  35  * This exception applies only to the code released by the
  36  * Free Software Foundation under the name GUILE.  If you copy
  37  * code from other Free Software Foundation releases into a copy of
  38  * GUILE, as the General Public License permits, the exception does
  39  * not apply to the code that you add in this way.  To avoid misleading
  40  * anyone as to the status of such modified files, you must delete
  41  * this exception notice from them.
  42  *
  43  * If you write modifications of your own for GUILE, it is your choice
  44  * whether to permit this exception to apply to your modifications.
  45  * If you do not wish that, delete this exception notice.  */
  46
  47 \f
  48
  49 /* "What's the difference between _scm.h and __scm.h?"
  50
  51    _scm.h is not installed; it's only visible to the libguile sources
  52    themselves.
  53
  54    __scm.h is installed, and is #included by <libguile.h>.  If both
  55    the client and libguile need some piece of information, and it
  56    doesn't fit well into the header file for any particular module, it
  57    should go in __scm.h.  */
  58
  59
  60 /* {Compiler hints}
  61  *
  62  * The following macros are used to provide additional information for the
  63  * compiler, which may help to do better error checking and code
  64  * optimization.  A second benefit of these macros is, that they also provide
  65  * additional information to the developers.
  66  */
  67
  68 /* The macro SCM_NORETURN indicates that a function will never return.
  69  * Examples:
  70  *   1) int foo (char arg) SCM_NORETURN;
  71  */
  72 #ifdef __GNUC__
  73 #define SCM_NORETURN __attribute__ ((noreturn))
  74 #else
  75 #define SCM_NORETURN
  76 #endif
  77
  78 /* The macro SCM_UNUSED indicates that a function, function argument or
  79  * variable may potentially be unused.
  80  * Examples:
  81  *   1) static int unused_function (char arg) SCM_UNUSED;
  82  *   2) int foo (char unused_argument SCM_UNUSED);
  83  *   3) int unused_variable SCM_UNUSED;
  84  */
  85 #ifdef __GNUC__
  86 #define SCM_UNUSED __attribute__ ((unused))
  87 #else
  88 #define SCM_UNUSED
  89 #endif
  90
  91
  92 /* {Supported Options}
  93  *
  94  * These may be defined or undefined.
  95  */
  96
  97 /* #define GUILE_DEBUG_FREELIST */
  98
  99 /* All the number support there is.
 100  */
 101 #define BIGNUMS
 102
 103 /* GC should relinquish empty cons-pair arenas. */
 104 /* cmm:FIXME look at this after done mangling the GC */
 105 /* #define GC_FREE_SEGMENTS */
 106
 107 /* Provide a scheme-accessible count-down timer that
 108  * generates a pseudo-interrupt.
 109  */
 110 #define TICKS
 111
 112
 113 /* Use engineering notation when converting numbers strings?
 114  */
 115 #undef ENGNOT
 116
 117 \f
 118 /* {Unsupported Options}
 119  *
 120  * These must be defined as given here.
 121  */
 122
 123
 124 #define CCLO
 125
 126 /* Guile Scheme supports the #f/() distinction; Guile Lisp won't.  We
 127    have horrible plans for their unification.  */
 128 #undef SICP
 129
 130 \f
 131
 132 /* Random options (not yet supported or in final form). */
 133
 134 #define STACK_CHECKING
 135 #undef NO_CEVAL_STACK_CHECKING
 136
 137 \f
 138
 139 /* SCM_API is a macro prepended to all function and data definitions
 140    which should be exported or imported in the resulting dynamic link
 141    library (DLL) in the Win32 port. */
 142
 143 #if defined (SCM_IMPORT)
 144 # define SCM_API __declspec (dllimport) extern
 145 #elif defined (SCM_EXPORT) || defined (DLL_EXPORT)
 146 # define SCM_API __declspec (dllexport) extern
 147 #else
 148 # define SCM_API extern
 149 #endif
 150
 151 \f
 152
 153 /* What did the configure script discover about the outside world?  */
 154 #include "libguile/scmconfig.h"
 155
 156 \f
 157
 158 /* {Debugging Options}
 159  *
 160  * These compile time options determine whether to include code that is only
 161  * useful for debugging guile itself or C level extensions to guile.  The
 162  * common prefix for all option macros of this kind is "SCM_DEBUG_".  It is
 163  * guaranteed that a macro named SCM_DEBUG_XXX is defined to be either 0 or 1,
 164  * i. e. there is no need to test for the undefined case.  This allows to use
 165  * these definitions comfortably within code, as in the following example:
 166  *   #define FOO do { if (SCM_DEBUG_XXX) bar(); else baz(); } while (0)
 167  * Any sane compiler will remove the unused branch without any performance
 168  * penalty for the resulting code.
 169  *
 170  * Note:  Some SCM_DEBUG_XXX options are not settable at configure time.
 171  * To change the value of such options you will have to edit this header
 172  * file or give suitable options to make, like:
 173  *   make all CFLAGS="-DSCM_DEBUG_XXX=1 ..."
 174  */
 175
 176
 177 /* The value of SCM_DEBUG determines the default for most of the not yet
 178  * defined debugging options.  This allows, for example, to enable most of the
 179  * debugging options by simply defining SCM_DEBUG as 1.
 180  */
 181 #ifndef SCM_DEBUG
 182 #define SCM_DEBUG 0
 183 #endif
 184
 185 /* If SCM_DEBUG_CELL_ACCESSES is set to 1, cell accesses will perform
 186  * exhaustive parameter checking:  It will be verified that cell parameters
 187  * actually point to a valid heap cell.  Note:  If this option is enabled,
 188  * guile will run about ten times slower than normally.
 189  */
 190 #ifndef SCM_DEBUG_CELL_ACCESSES
 191 #define SCM_DEBUG_CELL_ACCESSES SCM_DEBUG
 192 #endif
 193
 194 /* If SCM_DEBUG_INTERRUPTS is set to 1, with every deferring and allowing of
 195  * interrupts a consistency check will be performed.
 196  */
 197 #ifndef SCM_DEBUG_INTERRUPTS
 198 #define SCM_DEBUG_INTERRUPTS SCM_DEBUG
 199 #endif
 200
 201 /* If SCM_DEBUG_PAIR_ACCESSES is set to 1, accesses to cons cells will be
 202  * exhaustively checked.  Note:  If this option is enabled, guile will run
 203  * slower than normally.
 204  */
 205 #ifndef SCM_DEBUG_PAIR_ACCESSES
 206 #define SCM_DEBUG_PAIR_ACCESSES SCM_DEBUG
 207 #endif
 208
 209 /* If SCM_DEBUG_REST_ARGUMENT is set to 1, functions that take rest arguments
 210  * will check whether the rest arguments are actually passed as a proper list.
 211  * Otherwise, if SCM_DEBUG_REST_ARGUMENT is 0, functions that take rest
 212  * arguments will take it for granted that these are passed as a proper list.
 213  */
 214 #ifndef SCM_DEBUG_REST_ARGUMENT
 215 #define SCM_DEBUG_REST_ARGUMENT SCM_DEBUG
 216 #endif
 217
 218 /* Use this for _compile time_ type checking only, since the compiled result
 219  * will be quite inefficient.  The right way to make use of this option is to
 220  * do a 'make clean; make CFLAGS=-DSCM_DEBUG_TYPING_STRICTNESS=1', fix your
 221  * errors, and then do 'make clean; make'.
 222  */
 223 #ifndef SCM_DEBUG_TYPING_STRICTNESS
 224 #define SCM_DEBUG_TYPING_STRICTNESS 1
 225 #endif
 226
 227 \f
 228
 229 /* {Feature Options}
 230  *
 231  * These compile time options determine whether code for certain features
 232  * should be compiled into guile.  The common prefix for all option macros
 233  * of this kind is "SCM_ENABLE_".  It is guaranteed that a macro named
 234  * SCM_ENABLE_XXX is defined to be either 0 or 1, i. e. there is no need to
 235  * test for the undefined case.  This allows to use these definitions
 236  * comfortably within code, as in the following example:
 237  *   #define FOO do { if (SCM_ENABLE_XXX) bar(); else baz(); } while (0)
 238  * Any sane compiler will remove the unused branch without any performance
 239  * penalty for the resulting code.
 240  *
 241  * Note:  Some SCM_ENABLE_XXX options are not settable at configure time.
 242  * To change the value of such options you will have to edit this header
 243  * file or give suitable options to make, like:
 244  *   make all CFLAGS="-DSCM_ENABLE_XXX=1 ..."
 245  */
 246
 247 /* If SCM_ENABLE_DEPRECATED is set to 1, deprecated code will be included in
 248  * guile, as well as some functions to issue run-time warnings about uses of
 249  * deprecated functions.
 250  */
 251 #ifndef SCM_ENABLE_DEPRECATED
 252 #define SCM_ENABLE_DEPRECATED 0
 253 #endif
 254
 255 \f
 256
 257 /* {Architecture and compiler properties}
 258  *
 259  * Guile as of today can only work on systems which fulfill at least the
 260  * following requirements:
 261  * - long ints have at least 32 bits.
 262  *   Guile's type system is based on this assumption.
 263  * - long ints consist of at least four characters.
 264  *   It is assumed that cells, i. e. pairs of long ints, are eight character
 265  *   aligned, because three bits of a cell pointer are used for type data.
 266  * - sizeof (void*) == sizeof (long int)
 267  *   Pointers are stored in SCM objects, and sometimes SCM objects are passed
 268  *   as void*.  Thus, there has to be a one-to-one correspondence.
 269  * - numbers are encoded using two's complement.
 270  *   The implementation of the bitwise scheme level operations is based on
 271  *   this assumption.
 272  * - ... add more
 273  */
 274
 275 #if SIZEOF_UINTPTR_T != 0 && defined(UINTPTR_MAX) \
 276                           && defined(INTPTR_MAX) \
 277                           && defined(INTPTR_MIN)
 278 /* Used as SCM if available, so we bundle related attributes to avoid possible
 279    type incon[st][oi]n[ae]nce later.  Word in tags.h.  */
 280 #define HAVE_UINTPTR_T 1
 281 #endif
 282
 283 #if SIZEOF_PTRDIFF_T != 0
 284 #define HAVE_PTRDIFF_T 1
 285 #endif
 286
 287 #if SIZEOF_LONG_LONG != 0
 288 #define HAVE_LONG_LONGS 1
 289 #define HAVE_LONG_LONG 1
 290 #endif
 291
 292 #ifndef HAVE_PTRDIFF_T
 293 typedef long ptrdiff_t;
 294 #endif
 295
 296 #ifdef HAVE_LIMITS_H
 297 # include <limits.h>
 298 #endif
 299
 300 #ifdef CHAR_BIT
 301 # define SCM_CHAR_BIT CHAR_BIT
 302 #else
 303 # define SCM_CHAR_BIT 8
 304 #endif
 305
 306 #ifdef LONG_BIT
 307 # define SCM_LONG_BIT LONG_BIT
 308 #else
 309 # define SCM_LONG_BIT (SCM_CHAR_BIT * sizeof (long) / sizeof (char))
 310 #endif
 311
 312 #ifdef UCHAR_MAX
 313 # define SCM_CHAR_CODE_LIMIT (UCHAR_MAX + 1L)
 314 #else
 315 # define SCM_CHAR_CODE_LIMIT 256L
 316 #endif
 317
 318 \f
 319
 320 #ifdef STDC_HEADERS
 321 # include <stdlib.h>
 322 # if HAVE_SYS_TYPES_H
 323 #  include <sys/types.h>
 324 # endif
 325 # if HAVE_SYS_STDTYPES_H
 326 #  include <sys/stdtypes.h>
 327 # endif
 328 #  include <stddef.h>
 329 #endif /* def STDC_HEADERS */
 330
 331 \f
 332
 333 /* Define some additional CPP macros on Win32 platforms. */
 334 #if USE_DLL_IMPORT
 335 # define __REGEX_IMPORT__ 1
 336 # define __CRYPT_IMPORT__ 1
 337 # define __READLINE_IMPORT__ 1
 338 # define QT_IMPORT 1
 339 #endif
 340
 341 \f
 342
 343 #include "libguile/tags.h"
 344
 345 \f
 346 #ifdef vms
 347 # ifndef CHEAP_CONTINUATIONS
 348    typedef int jmp_buf[17];
 349    extern int setjump(jmp_buf env);
 350    extern int longjump(jmp_buf env, int ret);
 351 #  define setjmp setjump
 352 #  define longjmp longjump
 353 # else
 354 #  include <setjmp.h>
 355 # endif
 356 #else                           /* ndef vms */
 357 # ifdef _CRAY1
 358     typedef int jmp_buf[112];
 359     extern int setjump(jmp_buf env);
 360     extern int longjump(jmp_buf env, int ret);
 361 #  define setjmp setjump
 362 #  define longjmp longjump
 363 # else                          /* ndef _CRAY1 */
 364 #  include <setjmp.h>
 365 # endif                         /* ndef _CRAY1 */
 366 #endif                          /* ndef vms */
 367
 368 /* James Clark came up with this neat one instruction fix for
 369  * continuations on the SPARC.  It flushes the register windows so
 370  * that all the state of the process is contained in the stack.
 371  */
 372
 373 #ifdef sparc
 374 # define SCM_FLUSH_REGISTER_WINDOWS asm("ta 3")
 375 #else
 376 # define SCM_FLUSH_REGISTER_WINDOWS /* empty */
 377 #endif
 378
 379 /* If stack is not longword aligned then
 380  */
 381
 382 /* #define SHORT_ALIGN */
 383 #ifdef THINK_C
 384 # define SHORT_ALIGN
 385 #endif
 386 #ifdef MSDOS
 387 # define SHORT_ALIGN
 388 #endif
 389 #ifdef atarist
 390 # define SHORT_ALIGN
 391 #endif
 392
 393 #ifdef SHORT_ALIGN
 394 typedef short SCM_STACKITEM;
 395 #else
 396 typedef long SCM_STACKITEM;
 397 #endif
 398 \f
 399
 400 #define SCM_ASYNC_TICK /*fixme* should change names */ \
 401 do { \
 402   if (scm_root->pending_asyncs) \
 403     scm_async_click (); \
 404 } while (0)
 405
 406 #if (SCM_DEBUG_INTERRUPTS == 1)
 407 #include <stdio.h>
 408 #define SCM_CHECK_NOT_DISABLED \
 409   do { \
 410     if (scm_ints_disabled) \
 411       fprintf(stderr, "ints already disabled (at %s:%d)\n", \
 412               __FILE__, __LINE__); \
 413   } while (0)
 414
 415 #define SCM_CHECK_NOT_ENABLED \
 416   do { \
 417     if (!scm_ints_disabled) \
 418       fprintf(stderr, "ints already enabled (at %s:%d)\n", \
 419               __FILE__, __LINE__); \
 420   } while (0)
 421
 422 #else
 423 #define SCM_CHECK_NOT_DISABLED
 424 #define SCM_CHECK_NOT_ENABLED
 425 #endif
 426
 427
 428 /* Anthony Green writes:
 429    When the compiler sees...
 430            DEFER_INTS;
 431            [critical code here]
 432            ALLOW_INTS;
 433    ...it doesn't actually promise to keep the critical code within the
 434    boundries of the DEFER/ALLOW_INTS instructions. It may very well
 435    schedule it outside of the magic defined in those macros.
 436
 437    However, GCC's volatile asm feature forms a barrier over which code is
 438    never moved. So if you add...
 439            asm ("");
 440    ...to each of the DEFER_INTS and ALLOW_INTS macros, the critical
 441    code will always remain in place.  asm's without inputs or outputs
 442    are implicitly volatile. */
 443 #ifdef __GNUC__
 444 #define SCM_FENCE asm /* volatile */ ("")
 445 #else
 446 #define SCM_FENCE
 447 #endif
 448
 449 #define SCM_DEFER_INTS                          \
 450 do {                                            \
 451   SCM_FENCE;                                    \
 452   SCM_CHECK_NOT_DISABLED;                       \
 453   SCM_REC_CRITICAL_SECTION_START (scm_i_defer); \
 454   SCM_FENCE;                                    \
 455   scm_ints_disabled = 1;                        \
 456   SCM_FENCE;                                    \
 457 } while (0)
 458
 459
 460 #define SCM_ALLOW_INTS                          \
 461 do {                                            \
 462   SCM_FENCE;                                    \
 463   SCM_CHECK_NOT_ENABLED;                        \
 464   SCM_REC_CRITICAL_SECTION_END (scm_i_defer);   \
 465   SCM_FENCE;                                    \
 466   scm_ints_disabled = 0;                        \
 467   SCM_FENCE;                                    \
 468   SCM_THREAD_SWITCHING_CODE;                    \
 469   SCM_FENCE;                                    \
 470 } while (0)
 471
 472
 473 #define SCM_REDEFER_INTS                        \
 474 do {                                            \
 475   SCM_FENCE;                                    \
 476   SCM_REC_CRITICAL_SECTION_START (scm_i_defer); \
 477   ++scm_ints_disabled;                          \
 478   SCM_FENCE;                                    \
 479 } while (0)
 480
 481
 482 #define SCM_REALLOW_INTS                        \
 483 do {                                            \
 484   SCM_FENCE;                                    \
 485   SCM_REC_CRITICAL_SECTION_END (scm_i_defer);   \
 486   SCM_FENCE;                                    \
 487   --scm_ints_disabled;                          \
 488   SCM_FENCE;                                    \
 489 } while (0)
 490
 491
 492 #define SCM_TICK \
 493 do { \
 494   SCM_ASYNC_TICK; \
 495   SCM_THREAD_SWITCHING_CODE; \
 496 } while (0)
 497
 498 \f
 499
 500 /* Critical sections */
 501
 502 #define SCM_DECLARE_NONREC_CRITICAL_SECTION(prefix) \
 503   extern scm_t_mutex prefix ## _mutex
 504
 505 #define SCM_NONREC_CRITICAL_SECTION_START(prefix)       \
 506   do { scm_thread *t = scm_i_leave_guile ();            \
 507        scm_i_plugin_mutex_lock (&prefix ## _mutex);     \
 508        scm_i_enter_guile (t);                           \
 509   } while (0)
 510
 511 #define SCM_NONREC_CRITICAL_SECTION_END(prefix)         \
 512   do { scm_i_plugin_mutex_unlock (&prefix ## _mutex);   \
 513   } while (0)
 514
 515 /* This could be replaced by a single call to scm_i_plugin_mutex_lock
 516    on systems which support recursive mutecis (like LinuxThreads).
 517    We should test for the presence of recursive mutecis in
 518    configure.in.
 519
 520    Also, it is probably possible to replace recursive sections with
 521    non-recursive ones, so don't worry about the complexity.
 522  */
 523
 524 #define SCM_DECLARE_REC_CRITICAL_SECTION(prefix)        \
 525   extern scm_t_mutex prefix ## _mutex;                  \
 526   extern int prefix ## _count;                          \
 527   extern scm_thread *prefix ## _owner
 528
 529 #define SCM_REC_CRITICAL_SECTION_START(prefix)                          \
 530   do { scm_i_plugin_mutex_lock (&scm_i_section_mutex);                  \
 531        if (prefix ## _count && prefix ## _owner == SCM_CURRENT_THREAD)  \
 532          {                                                              \
 533            ++prefix ## _count;                                          \
 534            scm_i_plugin_mutex_unlock (&scm_i_section_mutex);            \
 535          }                                                              \
 536        else                                                             \
 537          {                                                              \
 538            scm_thread *t = scm_i_leave_guile ();                        \
 539            scm_i_plugin_mutex_unlock (&scm_i_section_mutex);            \
 540            scm_i_plugin_mutex_lock (&prefix ## _mutex);                 \
 541            prefix ## _count = 1;                                        \
 542            prefix ## _owner = t;                                        \
 543            scm_i_enter_guile (t);                                       \
 544          }                                                              \
 545   } while (0)
 546
 547 #define SCM_REC_CRITICAL_SECTION_END(prefix)                    \
 548   do { scm_i_plugin_mutex_lock (&scm_i_section_mutex);          \
 549        if (!--prefix ## _count)                                 \
 550          {                                                      \
 551            prefix ## _owner = 0;                                \
 552            scm_i_plugin_mutex_unlock (&prefix ## _mutex);       \
 553          }                                                      \
 554        scm_i_plugin_mutex_unlock (&scm_i_section_mutex);        \
 555   } while (0)
 556
 557 /* Note: The following needs updating. */
 558
 559 /* Classification of critical sections
 560  *
 561  * When Guile moves to POSIX threads, it won't be possible to prevent
 562  * context switching.  In fact, the whole idea of context switching is
 563  * bogus if threads are run by different processors.  Therefore, we
 564  * must ultimately eliminate all critical sections or enforce them by
 565  * use of mutecis.
 566  *
 567  * All instances of SCM_DEFER_INTS and SCM_ALLOW_INTS should therefore
 568  * be classified and replaced by one of the delimiters below.  If you
 569  * understand what this is all about, I'd like to encourage you to
 570  * help with this task.  The set of classes below must of course be
 571  * incrementally augmented.
 572  *
 573  * MDJ 980419 <djurfeldt@nada.kth.se>
 574  */
 575
 576 /* A sections
 577  *
 578  * Allocation of a cell with type tag in the CAR.
 579  *
 580  * With POSIX threads, each thread will have a private pool of free
 581  * cells.  Therefore, this type of section can be removed.  But!  It
 582  * is important that the CDR is initialized first (with the CAR still
 583  * indicating a free cell) so that we can guarantee a consistent heap
 584  * at all times.
 585  */
 586
 587 #define SCM_ENTER_A_SECTION SCM_CRITICAL_SECTION_START
 588 #define SCM_EXIT_A_SECTION SCM_CRITICAL_SECTION_END
 589
 590 \f
 591
 592 /** SCM_ASSERT
 593  **
 594  **/
 595
 596
 597 #ifdef SCM_RECKLESS
 598 #define SCM_ASSERT(_cond, _arg, _pos, _subr)
 599 #define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg)
 600 #define SCM_ASRTGO(_cond, _label)
 601 #else
 602 #define SCM_ASSERT(_cond, _arg, _pos, _subr) \
 603         if (!(_cond)) \
 604           scm_wrong_type_arg (_subr, _pos, _arg)
 605 #define SCM_ASSERT_TYPE(_cond, _arg, _pos, _subr, _msg) \
 606         if (!(_cond)) \
 607           scm_wrong_type_arg_msg(_subr, _pos, _arg, _msg)
 608 #define SCM_ASRTGO(_cond, _label) \
 609         if (!(_cond)) \
 610           goto _label
 611 #endif
 612
 613 /*
 614  * SCM_WTA_DISPATCH
 615  */
 616
 617 /* Dirk:FIXME:: In all of the SCM_WTA_DISPATCH_* macros it is assumed that
 618  * 'gf' is zero if uninitialized.  It would be cleaner if some valid SCM value
 619  * like SCM_BOOL_F or SCM_UNDEFINED was chosen.
 620  */
 621
 622 SCM_API SCM scm_call_generic_0 (SCM gf);
 623
 624 #define SCM_WTA_DISPATCH_0(gf, subr)                            \
 625   return (SCM_UNPACK (gf)                                       \
 626           ? scm_call_generic_0 ((gf))                           \
 627           : (scm_error_num_args_subr ((subr)), SCM_UNSPECIFIED))
 628 #define SCM_GASSERT0(cond, gf, subr) \
 629   if (!(cond)) SCM_WTA_DISPATCH_0((gf), (subr))
 630
 631 SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
 632
 633 #define SCM_WTA_DISPATCH_1(gf, a1, pos, subr)                   \
 634   return (SCM_UNPACK (gf)                                       \
 635           ? scm_call_generic_1 ((gf), (a1))                     \
 636           : (scm_wrong_type_arg ((subr), (pos), (a1)), SCM_UNSPECIFIED))
 637 #define SCM_GASSERT1(cond, gf, a1, pos, subr) \
 638   if (!(cond)) SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))
 639
 640 SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
 641
 642 #define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr)                       \
 643   return (SCM_UNPACK (gf)                                               \
 644           ? scm_call_generic_2 ((gf), (a1), (a2))                       \
 645           : (scm_wrong_type_arg ((subr), (pos),                         \
 646                                  (pos) == SCM_ARG1 ? (a1) : (a2)),      \
 647              SCM_UNSPECIFIED))
 648 #define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \
 649   if (!(cond)) SCM_WTA_DISPATCH_2((gf), (a1), (a2), (pos), (subr))
 650
 651 SCM_API SCM scm_apply_generic (SCM gf, SCM args);
 652
 653 #define SCM_WTA_DISPATCH_n(gf, args, pos, subr)                           \
 654   return (SCM_UNPACK (gf)                                                 \
 655           ? scm_apply_generic ((gf), (args))                              \
 656           : (scm_wrong_type_arg ((subr), (pos),                           \
 657                                  scm_list_ref ((args),                    \
 658                                                SCM_MAKINUM ((pos) - 1))), \
 659              SCM_UNSPECIFIED))
 660 #define SCM_GASSERTn(cond, gf, args, pos, subr) \
 661   if (!(cond)) SCM_WTA_DISPATCH_n((gf), (args), (pos), (subr))
 662
 663 #ifndef SCM_MAGIC_SNARFER
 664 /* Let these macros pass through if
 665    we are snarfing;  thus we can tell the
 666    difference between the use of an actual
 667    number vs. the use of one of these macros --
 668    actual numbers in SCM_VALIDATE_* and SCM_ASSERT
 669    constructs must match the formal argument name,
 670    but using SCM_ARG* avoids the test */
 671
 672 #define SCM_ARGn                0
 673 #define SCM_ARG1                1
 674 #define SCM_ARG2                2
 675 #define SCM_ARG3                3
 676 #define SCM_ARG4                4
 677 #define SCM_ARG5                5
 678 #define SCM_ARG6                6
 679 #define SCM_ARG7                7
 680
 681 #endif /* SCM_MAGIC_SNARFER */
 682
 683 \f
 684
 685 /* SCM_EXIT_SUCCESS is the default code to return from SCM if no errors
 686  * were encountered.  SCM_EXIT_FAILURE is the default code to return from
 687  * SCM if errors were encountered.  The return code can be explicitly
 688  * specified in a SCM program with (scm_quit <n>).
 689  */
 690
 691 #ifndef SCM_EXIT_SUCCESS
 692 #ifdef vms
 693 #define SCM_EXIT_SUCCESS 1
 694 #else
 695 #define SCM_EXIT_SUCCESS 0
 696 #endif /* def vms */
 697 #endif /* ndef SCM_EXIT_SUCCESS */
 698 #ifndef SCM_EXIT_FAILURE
 699 #ifdef vms
 700 #define SCM_EXIT_FAILURE 2
 701 #else
 702 #define SCM_EXIT_FAILURE 1
 703 #endif /* def vms */
 704 #endif /* ndef SCM_EXIT_FAILURE */
 705
 706 #endif  /* SCM___SCM_H */
 707
 708 /*
 709   Local Variables:
 710   c-file-style: "gnu"
 711   End:
 712 */