[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-45-g44e5b41
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-45-g44e5b41 |
|
Date: |
Sun, 15 May 2011 14:18:20 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=44e5b410bd19655f14c7e50f7a823fcc8c6ec97f
The branch, master has been updated
via 44e5b410bd19655f14c7e50f7a823fcc8c6ec97f (commit)
via 4765b28f702a42da770a13861d1035ec8c939304 (commit)
via fa075d40dca32c7706f6e81763a96fc85e4daafd (commit)
via 6703caf7265602951ffcc932bddc64fc37769b19 (commit)
via cb5b7677a2df77cecd9cd8a7a19b5d4433d908b0 (commit)
via 6dae2c589b3a6e033cb2109011100d832191a51f (commit)
via 27c6ebcb164e2001306dd6cf82f6beca96133c63 (commit)
via f311754e17983afe1dc6f8f4d829f3a1e8b7f437 (commit)
via 8b8723b3071c42158ced50f4af16680a7659f8ad (commit)
via 04245bb72ff6f59ddd0a293a1cbf2a1a2fb643bb (commit)
via 2acdd822fb2fa788eec06938415e3b0348ea815b (commit)
via 5c838a97598051c04d35452652147f7a85d4090d (commit)
via 8e450381bfc777569a98dd4971bc0510dc3ced92 (commit)
via 4f1ce27a368a776dad8334824e92aeadfce998ab (commit)
via 871054f08e062f44ed668a2ae6b4df6500f54672 (commit)
via 7b347203466c64dff76d6ea075eca883b564d7f9 (commit)
via e0c332ed410c2d93c5d888e72aaa56dff9539bb1 (commit)
via b2f38e4f45307c593d17d7069495ae59f8ceb5b7 (commit)
via b9b9a028042f1d2e2ff4d89c2389ac08549e67ae (commit)
via 2572c8067310d3cf5fc0dd61672c9bf2b2ac48db (commit)
via 412ccea6c986da28b28f4b822483f779263eb138 (commit)
via 80125469ef95f6d8d46a26619fb2f85151f32719 (commit)
via 8787d7a17029a8add20bb8e652ec744bc5d4e6c4 (commit)
via 6bc898466b7ba398bb8ddf71e2cffb7082de0216 (commit)
from 931b4a6ddc7348ed828f525b3f0d35c10795d440 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 44e5b410bd19655f14c7e50f7a823fcc8c6ec97f
Author: Andy Wingo <address@hidden>
Date: Sun May 15 15:28:50 2011 +0200
remove SCM_EXIT_SUCCESS and SCM_EXIT_FAILURE definitions
* libguile/__scm.h: Remove unused SCM_EXIT_SUCCESS and SCM_EXIT_FAILURE
definitions.
commit 4765b28f702a42da770a13861d1035ec8c939304
Author: Andy Wingo <address@hidden>
Date: Sun May 15 15:27:30 2011 +0200
use of EXIT_SUCCESS and EXIT_FAILURE
* libguile/threads.c (scm_init_guile):
* libguile/throw.c (scm_exit_status): Use EXIT_SUCCESS and EXIT_FAILURE
instead of 0 and 1.
commit fa075d40dca32c7706f6e81763a96fc85e4daafd
Author: Andy Wingo <address@hidden>
Date: Sun May 15 15:18:18 2011 +0200
scm_wta_* procedures replace SCM_WTA_* macros
* libguile/__scm.h: Move all the SCM_WTA and SCM_GASSERT macros out of
here. Also remove the scm_call_generic declarations.
* libguile/deprecated.h (SCM_WTA_DISPATCH_0, SCM_WTA_DISPATCH_1):
(SCM_WTA_DISPATCH_2, SCM_WTA_DISPATCH_N): Deprecate. See below for
their replacements.
(SCM_GASSERT0, SCM_GASSERT1, SCM_GASSERT2, SCM_GASSERTn): Deprecate
these too.
(SCM_WTA_DISPATCH_1_SUBR): Deprecate this strange thing.
(scm_call_generic_0, scm_call_generic_1, scm_call_generic_2):
(scm_call_generic_3, scm_apply_generic): Remove, indicating their
replacements.
* libguile/print.c (iprin1):
* libguile/eq.c (scm_equal_p): Use scm_call_2 instead of
scm_call_generic_2.
* libguile/goops.h:
* libguile/goops.c: Remove scm_{call,apply}_generic definitions.
(scm_wta_dispatch_0, scm_wta_dispatch_1, scm_wta_dispatch_2):
(scm_wta_dispatch_n): New procedures, replacing the SCM_WTA macros.
* libguile/numbers.c (scm_lcm):
* libguile/procs.c (scm_setter): Remove uses of SCM_GASSERT.
* libguile/numbers.c (scm_lcm):
* libguile/procs.c (scm_setter):
* libguile/vectors.c: Use the procedural scm_wta routines instead of the
SCM_WTA macros.
commit 6703caf7265602951ffcc932bddc64fc37769b19
Author: Andy Wingo <address@hidden>
Date: Sun May 15 13:34:07 2011 +0200
SCM_ASSERT to error.h
* libguile/error.h (SCM_ASSERT, SCM_ASSERT_TYPE): Move definition here.
Remove SCM_RECKLESS case.
* libguile/__scm.h: (From here.)
commit cb5b7677a2df77cecd9cd8a7a19b5d4433d908b0
Author: Andy Wingo <address@hidden>
Date: Sun May 15 13:29:45 2011 +0200
remove SCM_ASRTGO
* libguile/__scm.h (SCM_ASRTGO): Remove unused macro.
commit 6dae2c589b3a6e033cb2109011100d832191a51f
Author: Andy Wingo <address@hidden>
Date: Sun May 15 13:22:25 2011 +0200
remove unused SCM_FENCE definition
* libguile/__scm.h (SCM_FENCE): Remove unused definition.
commit 27c6ebcb164e2001306dd6cf82f6beca96133c63
Author: Andy Wingo <address@hidden>
Date: Sun May 15 13:11:03 2011 +0200
rename scm_async_click() to scm_async_tick(); privatize SCM_ASYNC_TICK
* libguile/_scm.h (SCM_ASYNC_TICK, SCM_ASYNC_TICK_WITH_CODE): Make these
definitions private. Call the tick() function instead of click().
* libguile/__scm.h:
* libguile/async.h (scm_async_tick): Move declaration here. Remove
scm_async_click declaration. Tick is the new (and old!) click, you
see.
(SCM_CRITICAL_SECTION_END): Call tick() instead of click().
* libguile/async.c (scm_async_tick): Remove old definition, and rename
scm_async_click to scm_async_tick.
(decrease_block): Adapt to click() -> tick() name change.
* libguile/deprecated.h (scm_async_click, SCM_ASYNC_TICK): Define some
GONE macros.
* libguile/threads.c (fat_mutex_unlock): Tick() instead of click().
commit f311754e17983afe1dc6f8f4d829f3a1e8b7f437
Author: Andy Wingo <address@hidden>
Date: Sun May 15 13:20:56 2011 +0200
simplify SCM_TICK
* libguile/__scm.h (SCM_TICK): Define to simply scm_async_tick (or
SCM_ASYNC_TICK when building Guile).
commit 8b8723b3071c42158ced50f4af16680a7659f8ad
Author: Andy Wingo <address@hidden>
Date: Sun May 15 13:16:37 2011 +0200
remove SCM_THREAD_SWITCHING_CODE
* libguile/deprecated.h (SCM_THREAD_SWITCHING_CODE):
* libguile/threads.h: Remove SCM_THREAD_SWITCHING_CODE, adding in a
deprecation note.
* libguile/__scm.h (SCM_TICK): Remove SCM_THREAD_SWITCHING_CODE.
commit 04245bb72ff6f59ddd0a293a1cbf2a1a2fb643bb
Author: Andy Wingo <address@hidden>
Date: Sun May 15 12:28:55 2011 +0200
make SCM_I_SETJMP and SCM_I_LONGJMP private
* libguile/_scm.h (SCM_I_SETJMP, SCM_I_LONGJMP): Move to this private
header.
* libguile/__scm.h (scm_i_jmp_buf): Only define the scm_i_jmp_buf type
in this public header.
commit 2acdd822fb2fa788eec06938415e3b0348ea815b
Author: Andy Wingo <address@hidden>
Date: Sun May 15 12:09:20 2011 +0200
move SCM_FLUSH_REGISTER_WINDOWS to continuations.c
* libguile/continuations.c: Move SCM_FLUSH_REGISTER_WINDOWS define
here...
* libguile/__scm.h: ...from here.
commit 5c838a97598051c04d35452652147f7a85d4090d
Author: Andy Wingo <address@hidden>
Date: Sun May 15 12:06:41 2011 +0200
minor __scm.h cleanup
* libguile/__scm.h: Clean up setjmp/longjmp portability defines.
commit 8e450381bfc777569a98dd4971bc0510dc3ced92
Author: Andy Wingo <address@hidden>
Date: Sun May 15 11:34:38 2011 +0200
remove mention of cheap continuations
* libguile/__scm.h: Inline an #ifndef CHEAP_CONTINUATIONS block for
VMS, as we always have full continuations.
* libguile/feature.c (scm_init_feature): Don't bother defining the
"full-continuation" feature.
commit 4f1ce27a368a776dad8334824e92aeadfce998ab
Author: Andy Wingo <address@hidden>
Date: Sun May 15 11:27:52 2011 +0200
remove SCM_I_LLONG and SCM_I_ULLONG limit defines
* test-suite/standalone/test-num2integral.c (test_long_long):
(test_ulong_long): Replace SCM_I_LLONG and SCM_I_ULLONG defines with
their counterparts from limits.h.
* libguile/__scm.h: Remove SCM_I_LLONG and SCM_I_ULLONG limit defines.
commit 871054f08e062f44ed668a2ae6b4df6500f54672
Author: Andy Wingo <address@hidden>
Date: Sun May 15 11:23:22 2011 +0200
remove SCM_I_SIZE limits defines
* libguile/__scm.h: Remove defines for SCM_I_SIZE_MAX, SCM_I_SSIZE_MIN,
and SCM_I_SSIZE_MAX, as there is no longer a scm_t_size / scm_size_t
type.
* libguile/bytevectors.c (make_bytevector): Replace a use of
SCM_I_SIZE_MAX with ((size_t) -1).
commit 7b347203466c64dff76d6ea075eca883b564d7f9
Author: Andy Wingo <address@hidden>
Date: Sun May 15 11:13:03 2011 +0200
remove SCM_CHAR_CODE_LIMIT define
* libguile/__scm.h: Remove SCM_CHAR_CODE_LIMIT define.
* libguile/feature.c (scm_init_feature): Remove char-code-limit define,
which was sure to be 256: a bogus value.
commit e0c332ed410c2d93c5d888e72aaa56dff9539bb1
Author: Andy Wingo <address@hidden>
Date: Sun May 15 11:10:06 2011 +0200
remove more unused __scm.h options
* libguile/__scm.h: Remove unused SCM_DEBUG_MARKING_API,
SCM_DEBUG_INTERRUPTS, and SCM_DEBUG_DEBUGGING_SUPPORT defines.
commit b2f38e4f45307c593d17d7069495ae59f8ceb5b7
Author: Andy Wingo <address@hidden>
Date: Sun May 15 11:00:17 2011 +0200
remove mention of GUILE_DEBUG_FREELIST
* libguile/__scm.h: Remove commented-out GUILE_DEBUG_FREELIST define.
* libguile/gen-scmconfig.c: Remove mention of GUILE_DEBUG_FREELIST.
commit b9b9a028042f1d2e2ff4d89c2389ac08549e67ae
Author: Andy Wingo <address@hidden>
Date: Sun May 15 10:58:24 2011 +0200
remove #define STACK_CHECKING from __scm.h.
* libguile/__scm.h: Remove #define STACK_CHECKING and #undef
NO_CEVAL_STACK_CHECKING.
* libguile/debug.c (scm_debug_options)
* libguile/init.c (scm_i_init_guile):
* libguile/stackchk.c (scm_report_stack_overflow):
* libguile/stackchk.h: Always enable stack checking.
commit 2572c8067310d3cf5fc0dd61672c9bf2b2ac48db
Author: Andy Wingo <address@hidden>
Date: Sun May 15 10:54:00 2011 +0200
remove SICP from __scm.h
* libguile/__scm.h: Remove #undef SICP.
* libguile/feature.c (scm_init_feature): Never add the sicp feature.
commit 412ccea6c986da28b28f4b822483f779263eb138
Author: Andy Wingo <address@hidden>
Date: Sun May 15 10:52:37 2011 +0200
remove ENGNOT from __scm.h
* libguile/__scm.h: Remove #undef ENGNOT.
* libguile/numbers.c (idbl2str): Remove #ifdef ENGNOT sections.
commit 80125469ef95f6d8d46a26619fb2f85151f32719
Author: Andy Wingo <address@hidden>
Date: Sun May 15 10:49:44 2011 +0200
SCM is either a union or scm_t_bits
* libguile/tags.h: Elide the SCM_DEBUG_TYPING_STRICTNESS==1 case.
Instead just have a flag, SCM_USING_PREHISTORIC_COMPILER, which if set
uses what was SCM_DEBUG_TYPING_STRICTNESS==0.
* libguile/__scm.h: Remove SCM_DEBUG_TYPING_STRICTNESS block.
commit 8787d7a17029a8add20bb8e652ec744bc5d4e6c4
Author: Andy Wingo <address@hidden>
Date: Fri May 13 16:21:11 2011 +0200
SCM is a union
* libguile/tags.h (SCM): Change to simply be a union containing
scm_t_bits.
(SCM_PACK, SCM_UNPACK): Adapt accordingly.
commit 6bc898466b7ba398bb8ddf71e2cffb7082de0216
Author: Andy Wingo <address@hidden>
Date: Sun May 15 15:32:50 2011 +0200
fix type errors in test suite
* test-suite/standalone/test-num2integral.c (out_of_range_handler): Fix
SCM used as a truth value.
* test-suite/standalone/test-scm-spawn-thread.c (inner_main): Use
SCM2PTR here.
-----------------------------------------------------------------------
Summary of changes:
libguile/__scm.h | 340 ++-----------------
libguile/_scm.h | 56 +++
libguile/async.c | 10 +-
libguile/async.h | 4 +-
libguile/bytevectors.c | 2 +-
libguile/continuations.c | 11 +
libguile/debug.c | 2 -
libguile/deprecated.h | 44 +++
libguile/eq.c | 2 +-
libguile/error.h | 12 +-
libguile/feature.c | 10 +-
libguile/gen-scmconfig.c | 6 +-
libguile/goops.c | 71 +++--
libguile/goops.h | 15 +-
libguile/init.c | 2 -
libguile/numbers.c | 471 +++++++++++++------------
libguile/print.c | 2 +-
libguile/procs.c | 5 +-
libguile/stackchk.c | 5 +-
libguile/stackchk.h | 4 +-
libguile/tags.h | 56 +--
libguile/threads.c | 4 +-
libguile/threads.h | 3 -
libguile/throw.c | 4 +-
libguile/vectors.c | 11 +-
test-suite/standalone/test-num2integral.c | 24 +-
test-suite/standalone/test-scm-spawn-thread.c | 2 +-
27 files changed, 495 insertions(+), 683 deletions(-)
diff --git a/libguile/__scm.h b/libguile/__scm.h
index 7458a10..19fcce8 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -145,37 +145,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. */
@@ -220,14 +189,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,
@@ -237,13 +198,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.
@@ -261,47 +215,6 @@
#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 2
-#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}
@@ -377,12 +290,6 @@
# define SCM_LONG_BIT (SCM_CHAR_BIT * sizeof (long) / sizeof (char))
#endif
-#ifdef UCHAR_MAX
-# define SCM_CHAR_CODE_LIMIT (UCHAR_MAX + 1L)
-#else
-# define SCM_CHAR_CODE_LIMIT 256L
-#endif
-
#define SCM_I_UTYPE_MAX(type) ((type)-1)
#define SCM_I_TYPE_MAX(type,umax) ((type)((umax)/2))
#define SCM_I_TYPE_MIN(type,umax) (-((type)((umax)/2))-1)
@@ -403,12 +310,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)
@@ -417,10 +318,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"
@@ -439,64 +336,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
*/
@@ -522,151 +390,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
@@ -689,27 +420,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.
diff --git a/libguile/_scm.h b/libguile/_scm.h
index 2842130..255c5e3 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -191,6 +191,62 @@
#define scm_from_off64_t scm_from_int64
+
+
+#if defined (vms)
+/* VMS: Implement SCM_I_SETJMP in terms of setjump. */
+extern int setjump(scm_i_jmp_buf env);
+extern int longjump(scm_i_jmp_buf env, int ret);
+#define SCM_I_SETJMP setjump
+#define SCM_I_LONGJMP longjump
+
+#elif defined (_CRAY1)
+/* Cray: Implement SCM_I_SETJMP in terms of setjump. */
+extern int setjump(scm_i_jmp_buf env);
+extern int longjump(scm_i_jmp_buf env, int ret);
+#define SCM_I_SETJMP setjump
+#define SCM_I_LONGJMP longjump
+
+#elif defined (__ia64__)
+/* IA64: Implement SCM_I_SETJMP in terms of getcontext. */
+# 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 and longjmp. */
+
+#define SCM_I_SETJMP setjmp
+#define SCM_I_LONGJMP longjmp
+#endif
+
+
+
+#define SCM_ASYNC_TICK \
+ do \
+ { \
+ if (SCM_UNLIKELY (SCM_I_CURRENT_THREAD->pending_asyncs)) \
+ scm_async_tick (); \
+ } \
+ while (0)
+
+#define SCM_ASYNC_TICK_WITH_CODE(thr, stmt) \
+ do \
+ { \
+ if (SCM_UNLIKELY (thr->pending_asyncs)) \
+ { \
+ stmt; \
+ scm_async_tick (); \
+ } \
+ } \
+ while (0)
+
+
+
+
/* The endianness marker in objcode. */
#ifdef WORDS_BIGENDIAN
# define SCM_OBJCODE_ENDIANNESS "BE"
diff --git a/libguile/async.c b/libguile/async.c
index ad14101..80f561d 100644
--- a/libguile/async.c
+++ b/libguile/async.c
@@ -137,7 +137,7 @@ static scm_i_pthread_mutex_t async_mutex =
SCM_I_PTHREAD_MUTEX_INITIALIZER;
/* System asyncs. */
void
-scm_async_click ()
+scm_async_tick (void)
{
scm_i_thread *t = SCM_I_CURRENT_THREAD;
SCM asyncs;
@@ -334,7 +334,7 @@ decrease_block (void *data)
{
scm_i_thread *t = data;
if (--t->block_asyncs == 0)
- scm_async_click ();
+ scm_async_tick ();
}
void
@@ -444,12 +444,6 @@ scm_critical_section_end (void)
SCM_CRITICAL_SECTION_END;
}
-void
-scm_async_tick (void)
-{
- SCM_ASYNC_TICK;
-}
-
void
diff --git a/libguile/async.h b/libguile/async.h
index 2214f67..68952b0 100644
--- a/libguile/async.h
+++ b/libguile/async.h
@@ -29,7 +29,7 @@
-SCM_API void scm_async_click (void);
+SCM_API void scm_async_tick (void);
SCM_API void scm_switch (void);
SCM_API SCM scm_async (SCM thunk);
SCM_API SCM scm_async_mark (SCM a);
@@ -75,7 +75,7 @@ SCM_API void scm_critical_section_end (void);
SCM_I_CURRENT_THREAD->critical_section_level--; \
SCM_I_CURRENT_THREAD->block_asyncs--; \
scm_i_pthread_mutex_unlock (&scm_i_critical_section_mutex); \
- scm_async_click (); \
+ scm_async_tick (); \
} while (0)
#else /* !BUILDING_LIBGUILE */
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index b9403ea..90252a7 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -213,7 +213,7 @@ make_bytevector (size_t len, scm_t_array_element_type
element_type)
if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
|| scm_i_array_element_type_sizes[element_type] < 8
- || len >= (SCM_I_SIZE_MAX
+ || len >= (((size_t) -1)
/
(scm_i_array_element_type_sizes[element_type]/8))))
/* This would be an internal Guile programming error */
abort ();
diff --git a/libguile/continuations.c b/libguile/continuations.c
index cf8b6ac..7e20966 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -182,6 +182,17 @@ continuation_print (SCM obj, SCM port, scm_print_state
*state SCM_UNUSED)
return 1;
}
+/* 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.
+ */
+
+#if defined (sparc) || defined (__sparc__) || defined (__sparc)
+# define SCM_FLUSH_REGISTER_WINDOWS asm("ta 3")
+#else
+# define SCM_FLUSH_REGISTER_WINDOWS /* empty */
+#endif
+
/* this may return more than once: the first time with the escape
procedure, then subsequently with SCM_UNDEFINED (the vals already having
been
placed on the VM stack). */
diff --git a/libguile/debug.c b/libguile/debug.c
index 88a01d6..1a5c197 100644
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -108,9 +108,7 @@ SCM_DEFINE (scm_debug_options, "debug-options-interface",
0, 1, 0,
scm_dynwind_critical_section (SCM_BOOL_F);
ans = scm_options (setting, scm_debug_opts, FUNC_NAME);
-#ifdef STACK_CHECKING
scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
-#endif
scm_dynwind_end ();
return ans;
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index d17be08..ca7f141 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -42,6 +42,38 @@ SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard
before,
void *guard_data);
+/* Deprecated 15-05-2011 because it's better to be explicit with the
+ `return'. Code is more readable that way. */
+#define SCM_WTA_DISPATCH_0(gf, subr) \
+ return scm_wta_dispatch_0 ((gf), (subr))
+#define SCM_WTA_DISPATCH_1(gf, a1, pos, subr) \
+ return scm_wta_dispatch_1 ((gf), (a1), (pos), (subr))
+#define SCM_WTA_DISPATCH_2(gf, a1, a2, pos, subr) \
+ return scm_wta_dispatch_2 ((gf), (a1), (a2), (pos), (subr))
+#define SCM_WTA_DISPATCH_N(gf, args, pos, subr) \
+ return scm_wta_dispatch_n ((gf), (args), (pos), (subr))
+
+/* Deprecated 15-05-2011 because this idiom is not very readable. */
+#define SCM_GASSERT0(cond, gf, subr) \
+ if (SCM_UNLIKELY (!(cond))) \
+ return scm_wta_dispatch_0 ((gf), (subr))
+#define SCM_GASSERT1(cond, gf, a1, pos, subr) \
+ if (SCM_UNLIKELY (!(cond))) \
+ return scm_wta_dispatch_1 ((gf), (a1), (pos), (subr))
+#define SCM_GASSERT2(cond, gf, a1, a2, pos, subr) \
+ if (SCM_UNLIKELY (!(cond))) \
+ return scm_wta_dispatch_2 ((gf), (a1), (a2), (pos), (subr))
+#define SCM_GASSERTn(cond, gf, args, pos, subr) \
+ if (SCM_UNLIKELY (!(cond))) \
+ return scm_wta_dispatch_n ((gf), (args), (pos), (subr))
+
+/* Deprecated 15-05-2011 because this is a one-off macro that does
+ strange things. */
+#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos) \
+ return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr))) \
+ ? scm_call_1 ((*SCM_SUBR_GENERIC (subr)), (a1)) \
+ : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)),
SCM_UNSPECIFIED))
+
#define SCM_LIST0 SCM_EOL
#define SCM_LIST1(e0) scm_cons ((e0), SCM_EOL)
#define SCM_LIST2(e0, e1) scm_cons2 ((e0), (e1), SCM_EOL)
@@ -64,6 +96,7 @@ SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard
before,
#define SCM_PROCEDURE SCM_PROCEDURE__GONE__REPLACE_WITH__scm_procedure
#define SCM_PROCEDURE_WITH_SETTER_P
SCM_PROCEDURE_WITH_SETTER_P__GONE__REPLACE_WITH__scm_is_true__scm_procedure_with_setter_p
#define SCM_SETTER SCM_SETTER__GONE__REPLACE_WITH__scm_setter
+#define SCM_THREAD_SWITCHING_CODE
SCM_THREAD_SWITCHING_CODE__GONE__REMOVE_FROM_YOUR_CODE
#define SCM_VALIDATE_NUMBER_COPY
SCM_VALIDATE_NUMBER_COPY__GONE__REPLACE_WITH__SCM_VALIDATE_DOUBLE_COPY
#define SCM_VALIDATE_NUMBER_DEF_COPY
SCM_VALIDATE_NUMBER_DEF_COPY__GONE__REPLACE_WITH__SCM_UNBNDP_and_SCM_VALIDATE_DOUBLE_COPY
#define SCM_VALIDATE_OPDIR SCM_VALIDATE_OPDIR__GONE
@@ -71,6 +104,12 @@ SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard
before,
#define SCM_VALIDATE_SUBSTRING_SPEC_COPY SCM_VALIDATE_SUBSTRING_SPEC_COPY__GONE
#define scm_array scm_array__GONE__REPLACE_WITH__scm_t_array
#define scm_array_dim scm_array_dim__GONE__REPLACE_WITH__scm_t_array_dim
+#define scm_async_click scm_async_click__GONE__REPLACE_WITH__scm_async_tick
+#define scm_call_generic_0 scm_call_generic_0__GONE__REPLACE_WITH__scm_call_0
+#define scm_call_generic_1 scm_call_generic_1__GONE__REPLACE_WITH__scm_call_1
+#define scm_call_generic_2 scm_call_generic_2__GONE__REPLACE_WITH__scm_call_2
+#define scm_call_generic_3 scm_call_generic_3__GONE__REPLACE_WITH__scm_call_3
+#define scm_apply_generic scm_apply_generic__GONE__REPLACE_WITH__scm_apply_0
#define scm_fport scm_fport__GONE__REPLACE_WITH__scm_t_fport
#define scm_listify scm_listify__GONE__REPLACE_WITH__scm_list_n
#define scm_option scm_option__GONE__REPLACE_WITH__scm_t_option
@@ -91,6 +130,11 @@ SCM_DEPRECATED SCM scm_internal_dynamic_wind (scm_t_guard
before,
#define scm_vtable_index_vtable
scm_vtable_index_vtable__GONE__REPLACE_WITH__scm_vtable_index_self
typedef scm_i_t_array scm_i_t_array__GONE__REPLACE_WITH__scm_t_array;
+#ifndef BUILDING_LIBGUILE
+#define SCM_ASYNC_TICK SCM_ASYNC_TICK__GONE__REPLACE_WITH__scm_async_tick
+#endif
+
+
void scm_i_init_deprecated (void);
diff --git a/libguile/eq.c b/libguile/eq.c
index 11dce99..5e270a2 100644
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -365,7 +365,7 @@ scm_equal_p (SCM x, SCM y)
generic_equal:
if (SCM_UNPACK (g_scm_i_equal_p))
- return scm_call_generic_2 (g_scm_i_equal_p, x, y);
+ return scm_call_2 (g_scm_i_equal_p, x, y);
else
return SCM_BOOL_F;
}
diff --git a/libguile/error.h b/libguile/error.h
index 8cc68b7..1611fd5 100644
--- a/libguile/error.h
+++ b/libguile/error.h
@@ -3,7 +3,7 @@
#ifndef SCM_ERROR_H
#define SCM_ERROR_H
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006, 2008 Free Software
Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006, 2008, 2011 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
@@ -36,6 +36,16 @@ SCM_API SCM scm_misc_error_key;
+#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)
+
+
+
+
SCM_API void scm_error (SCM key, const char *subr, const char *message,
SCM args, SCM rest) SCM_NORETURN;
SCM_API SCM scm_error_scm (SCM key, SCM subr, SCM message,
diff --git a/libguile/feature.c b/libguile/feature.c
index 7007403..ebb77cb 100644
--- a/libguile/feature.c
+++ b/libguile/feature.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2004, 2006, 2007,
2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2004, 2006, 2007,
2009, 2011 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
@@ -108,21 +108,13 @@ scm_init_feature()
#ifdef vms
scm_add_feature(s_ed);
#endif
-#ifdef SICP
- scm_add_feature("sicp");
-#endif
#ifndef GO32
scm_add_feature("char-ready?");
#endif
-#ifndef CHEAP_CONTINUATIONS
- scm_add_feature ("full-continuation");
-#endif
#if SCM_USE_PTHREAD_THREADS
scm_add_feature ("threads");
#endif
- scm_c_define ("char-code-limit", scm_from_int (SCM_CHAR_CODE_LIMIT));
-
#include "libguile/feature.x"
}
diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c
index 1d38eea..422f826 100644
--- a/libguile/gen-scmconfig.c
+++ b/libguile/gen-scmconfig.c
@@ -37,9 +37,9 @@
- use 1 and 0 for public #defines instead of "def and undef",
i.e. use #define SCM_HAVE_FOO rather than just not defining
SCM_HAVE_FOO whenever possible. See GNU Coding Guidelines for
- rationale. The only notable non-deprecated exceptions to this
- rule are GUILE_DEBUG and GUILE_DEBUG_FREELIST which do not follow
- this convention in order to retain backward compatibility.
+ rationale. The only notable non-deprecated exception to this rule
+ is GUILE_DEBUG which does not follow this convention in order to
+ retain backward compatibility.
- in the code below, be *VERY* careful not to use or rely on any
runtime-dynamic information below. For example, you cannot use
diff --git a/libguile/goops.c b/libguile/goops.c
index 899ba73..925f094 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1667,36 +1667,6 @@ SCM_KEYWORD (k_name, "name");
SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
-SCM
-scm_apply_generic (SCM gf, SCM args)
-{
- return scm_apply (SCM_STRUCT_PROCEDURE (gf), args, SCM_EOL);
-}
-
-SCM
-scm_call_generic_0 (SCM gf)
-{
- return scm_call_0 (SCM_STRUCT_PROCEDURE (gf));
-}
-
-SCM
-scm_call_generic_1 (SCM gf, SCM a1)
-{
- return scm_call_1 (SCM_STRUCT_PROCEDURE (gf), a1);
-}
-
-SCM
-scm_call_generic_2 (SCM gf, SCM a1, SCM a2)
-{
- return scm_call_2 (SCM_STRUCT_PROCEDURE (gf), a1, a2);
-}
-
-SCM
-scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
-{
- return scm_call_3 (SCM_STRUCT_PROCEDURE (gf), a1, a2, a3);
-}
-
SCM_SYMBOL (sym_delayed_compile, "delayed-compile");
static SCM
make_dispatch_procedure (SCM gf)
@@ -1840,6 +1810,47 @@ setup_extended_primitive_generics ()
}
}
+/* Dirk:FIXME:: In all of these scm_wta_dispatch_* routines 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 were chosen.
+ */
+
+SCM
+scm_wta_dispatch_0 (SCM gf, const char *subr)
+{
+ if (!SCM_UNPACK (gf))
+ scm_error_num_args_subr (subr);
+
+ return scm_call_0 (gf);
+}
+
+SCM
+scm_wta_dispatch_1 (SCM gf, SCM a1, int pos, const char *subr)
+{
+ if (!SCM_UNPACK (gf))
+ scm_wrong_type_arg (subr, pos, a1);
+
+ return scm_call_1 (gf, a1);
+}
+
+SCM
+scm_wta_dispatch_2 (SCM gf, SCM a1, SCM a2, int pos, const char *subr)
+{
+ if (!SCM_UNPACK (gf))
+ scm_wrong_type_arg (subr, pos, (pos == SCM_ARG1) ? a1 : a2);
+
+ return scm_call_2 (gf, a1, a2);
+}
+
+SCM
+scm_wta_dispatch_n (SCM gf, SCM args, int pos, const char *subr)
+{
+ if (!SCM_UNPACK (gf))
+ scm_wrong_type_arg (subr, pos, scm_list_ref (args, scm_from_int (pos)));
+
+ return scm_apply_0 (gf, args);
+}
+
/******************************************************************************
*
* Protocol for calling a generic fumction
diff --git a/libguile/goops.h b/libguile/goops.h
index 47a6e4e..fcb8968 100644
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -299,13 +299,14 @@ SCM_API SCM scm_make (SCM args);
SCM_API SCM scm_find_method (SCM args);
SCM_API SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs);
SCM_API void scm_change_object_class (SCM, SCM, SCM);
-/* The following are declared in __scm.h
-SCM_API SCM scm_call_generic_0 (SCM gf);
-SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
-SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
-SCM_API SCM scm_apply_generic (SCM gf, SCM args);
-*/
-SCM_API SCM scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3);
+
+/* These procedures are for dispatching to a generic when a primitive
+ fails to apply. They raise a wrong-type-arg error if the primitive's
+ generic has not been initialized yet. */
+SCM_API SCM scm_wta_dispatch_0 (SCM gf, const char *subr);
+SCM_API SCM scm_wta_dispatch_1 (SCM gf, SCM a1, int pos, const char *subr);
+SCM_API SCM scm_wta_dispatch_2 (SCM gf, SCM a1, SCM a2, int pos, const char
*subr);
+SCM_API SCM scm_wta_dispatch_n (SCM gf, SCM args, int pos, const char *subr);
SCM_INTERNAL SCM scm_i_define_class_for_vtable (SCM vtable);
diff --git a/libguile/init.c b/libguile/init.c
index 94de5c9..a541eeb 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -513,9 +513,7 @@ scm_i_init_guile (void *base)
scm_initialized_p = 1;
-#ifdef STACK_CHECKING
scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
-#endif
scm_init_rdelim ();
scm_init_rw ();
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 057a69c..24ae2bc 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -532,7 +532,7 @@ SCM_PRIMITIVE_GENERIC (scm_exact_p, "exact?", 1, 0, 0,
else if (SCM_NUMBERP (x))
return SCM_BOOL_T;
else
- SCM_WTA_DISPATCH_1 (g_scm_exact_p, x, 1, s_scm_exact_p);
+ return scm_wta_dispatch_1 (g_scm_exact_p, x, 1, s_scm_exact_p);
}
#undef FUNC_NAME
@@ -548,7 +548,7 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_p, "inexact?", 1, 0, 0,
else if (SCM_NUMBERP (x))
return SCM_BOOL_F;
else
- SCM_WTA_DISPATCH_1 (g_scm_inexact_p, x, 1, s_scm_inexact_p);
+ return scm_wta_dispatch_1 (g_scm_inexact_p, x, 1, s_scm_inexact_p);
}
#undef FUNC_NAME
@@ -582,7 +582,7 @@ SCM_PRIMITIVE_GENERIC (scm_odd_p, "odd?", 1, 0, 0,
return SCM_BOOL_F;
}
}
- SCM_WTA_DISPATCH_1 (g_scm_odd_p, n, 1, s_scm_odd_p);
+ return scm_wta_dispatch_1 (g_scm_odd_p, n, 1, s_scm_odd_p);
}
#undef FUNC_NAME
@@ -616,7 +616,7 @@ SCM_PRIMITIVE_GENERIC (scm_even_p, "even?", 1, 0, 0,
return SCM_BOOL_T;
}
}
- SCM_WTA_DISPATCH_1 (g_scm_even_p, n, 1, s_scm_even_p);
+ return scm_wta_dispatch_1 (g_scm_even_p, n, 1, s_scm_even_p);
}
#undef FUNC_NAME
@@ -631,7 +631,7 @@ SCM_PRIMITIVE_GENERIC (scm_finite_p, "finite?", 1, 0, 0,
else if (scm_is_real (x))
return SCM_BOOL_T;
else
- SCM_WTA_DISPATCH_1 (g_scm_finite_p, x, 1, s_scm_finite_p);
+ return scm_wta_dispatch_1 (g_scm_finite_p, x, 1, s_scm_finite_p);
}
#undef FUNC_NAME
@@ -646,7 +646,7 @@ SCM_PRIMITIVE_GENERIC (scm_inf_p, "inf?", 1, 0, 0,
else if (scm_is_real (x))
return SCM_BOOL_F;
else
- SCM_WTA_DISPATCH_1 (g_scm_inf_p, x, 1, s_scm_inf_p);
+ return scm_wta_dispatch_1 (g_scm_inf_p, x, 1, s_scm_inf_p);
}
#undef FUNC_NAME
@@ -661,7 +661,7 @@ SCM_PRIMITIVE_GENERIC (scm_nan_p, "nan?", 1, 0, 0,
else if (scm_is_real (x))
return SCM_BOOL_F;
else
- SCM_WTA_DISPATCH_1 (g_scm_nan_p, x, 1, s_scm_nan_p);
+ return scm_wta_dispatch_1 (g_scm_nan_p, x, 1, s_scm_nan_p);
}
#undef FUNC_NAME
@@ -788,7 +788,7 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0,
SCM_FRACTION_DENOMINATOR (x));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_abs, x, 1, s_scm_abs);
+ return scm_wta_dispatch_1 (g_scm_abs, x, 1, s_scm_abs);
}
#undef FUNC_NAME
@@ -803,10 +803,10 @@ SCM_PRIMITIVE_GENERIC (scm_quotient, "quotient", 2, 0, 0,
if (SCM_LIKELY (scm_is_integer (y)))
return scm_truncate_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG2, s_scm_quotient);
+ return scm_wta_dispatch_2 (g_scm_quotient, x, y, SCM_ARG2,
s_scm_quotient);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG1, s_scm_quotient);
+ return scm_wta_dispatch_2 (g_scm_quotient, x, y, SCM_ARG1, s_scm_quotient);
}
#undef FUNC_NAME
@@ -824,10 +824,10 @@ SCM_PRIMITIVE_GENERIC (scm_remainder, "remainder", 2, 0,
0,
if (SCM_LIKELY (scm_is_integer (y)))
return scm_truncate_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG2, s_scm_remainder);
+ return scm_wta_dispatch_2 (g_scm_remainder, x, y, SCM_ARG2,
s_scm_remainder);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG1, s_scm_remainder);
+ return scm_wta_dispatch_2 (g_scm_remainder, x, y, SCM_ARG1,
s_scm_remainder);
}
#undef FUNC_NAME
@@ -846,10 +846,10 @@ SCM_PRIMITIVE_GENERIC (scm_modulo, "modulo", 2, 0, 0,
if (SCM_LIKELY (scm_is_integer (y)))
return scm_floor_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG2, s_scm_modulo);
+ return scm_wta_dispatch_2 (g_scm_modulo, x, y, SCM_ARG2, s_scm_modulo);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG1, s_scm_modulo);
+ return scm_wta_dispatch_2 (g_scm_modulo, x, y, SCM_ARG1, s_scm_modulo);
}
#undef FUNC_NAME
@@ -870,10 +870,9 @@ static void
two_valued_wta_dispatch_2 (SCM gf, SCM a1, SCM a2, int pos,
const char *subr, SCM *rp1, SCM *rp2)
{
- if (SCM_UNPACK (gf))
- scm_i_extract_values_2 (scm_call_generic_2 (gf, a1, a2), rp1, rp2);
- else
- scm_wrong_type_arg (subr, pos, (pos == SCM_ARG1) ? a1 : a2);
+ SCM vals = scm_wta_dispatch_2 (gf, a1, a2, pos, subr);
+
+ scm_i_extract_values_2 (vals, rp1, rp2);
}
SCM_DEFINE (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0,
@@ -1005,8 +1004,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient,
"floor-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_floor_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2,
- s_scm_floor_quotient);
+ return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2,
+ s_scm_floor_quotient);
}
else if (SCM_BIGP (x))
{
@@ -1046,8 +1045,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient,
"floor-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_floor_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2,
- s_scm_floor_quotient);
+ return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2,
+ s_scm_floor_quotient);
}
else if (SCM_REALP (x))
{
@@ -1056,8 +1055,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient,
"floor-quotient", 2, 0, 0,
return scm_i_inexact_floor_quotient
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2,
- s_scm_floor_quotient);
+ return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2,
+ s_scm_floor_quotient);
}
else if (SCM_FRACTIONP (x))
{
@@ -1067,12 +1066,12 @@ SCM_PRIMITIVE_GENERIC (scm_floor_quotient,
"floor-quotient", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_floor_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2,
- s_scm_floor_quotient);
+ return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2,
+ s_scm_floor_quotient);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG1,
- s_scm_floor_quotient);
+ return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG1,
+ s_scm_floor_quotient);
}
#undef FUNC_NAME
@@ -1165,8 +1164,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder,
"floor-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_floor_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2,
- s_scm_floor_remainder);
+ return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2,
+ s_scm_floor_remainder);
}
else if (SCM_BIGP (x))
{
@@ -1201,8 +1200,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder,
"floor-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_floor_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2,
- s_scm_floor_remainder);
+ return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2,
+ s_scm_floor_remainder);
}
else if (SCM_REALP (x))
{
@@ -1211,8 +1210,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder,
"floor-remainder", 2, 0, 0,
return scm_i_inexact_floor_remainder
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2,
- s_scm_floor_remainder);
+ return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2,
+ s_scm_floor_remainder);
}
else if (SCM_FRACTIONP (x))
{
@@ -1222,12 +1221,12 @@ SCM_PRIMITIVE_GENERIC (scm_floor_remainder,
"floor-remainder", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_floor_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2,
- s_scm_floor_remainder);
+ return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2,
+ s_scm_floor_remainder);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG1,
- s_scm_floor_remainder);
+ return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG1,
+ s_scm_floor_remainder);
}
#undef FUNC_NAME
@@ -1540,8 +1539,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient,
"ceiling-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_ceiling_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2,
- s_scm_ceiling_quotient);
+ return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2,
+ s_scm_ceiling_quotient);
}
else if (SCM_BIGP (x))
{
@@ -1581,8 +1580,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient,
"ceiling-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_ceiling_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2,
- s_scm_ceiling_quotient);
+ return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2,
+ s_scm_ceiling_quotient);
}
else if (SCM_REALP (x))
{
@@ -1591,8 +1590,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient,
"ceiling-quotient", 2, 0, 0,
return scm_i_inexact_ceiling_quotient
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2,
- s_scm_ceiling_quotient);
+ return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2,
+ s_scm_ceiling_quotient);
}
else if (SCM_FRACTIONP (x))
{
@@ -1602,12 +1601,12 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quotient,
"ceiling-quotient", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_ceiling_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2,
- s_scm_ceiling_quotient);
+ return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2,
+ s_scm_ceiling_quotient);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG1,
- s_scm_ceiling_quotient);
+ return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG1,
+ s_scm_ceiling_quotient);
}
#undef FUNC_NAME
@@ -1710,8 +1709,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder,
"ceiling-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_ceiling_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2,
- s_scm_ceiling_remainder);
+ return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2,
+ s_scm_ceiling_remainder);
}
else if (SCM_BIGP (x))
{
@@ -1746,8 +1745,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder,
"ceiling-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_ceiling_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2,
- s_scm_ceiling_remainder);
+ return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2,
+ s_scm_ceiling_remainder);
}
else if (SCM_REALP (x))
{
@@ -1756,8 +1755,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder,
"ceiling-remainder", 2, 0, 0,
return scm_i_inexact_ceiling_remainder
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2,
- s_scm_ceiling_remainder);
+ return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2,
+ s_scm_ceiling_remainder);
}
else if (SCM_FRACTIONP (x))
{
@@ -1767,12 +1766,12 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling_remainder,
"ceiling-remainder", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_ceiling_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2,
- s_scm_ceiling_remainder);
+ return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2,
+ s_scm_ceiling_remainder);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG1,
- s_scm_ceiling_remainder);
+ return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG1,
+ s_scm_ceiling_remainder);
}
#undef FUNC_NAME
@@ -2072,8 +2071,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient,
"truncate-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_truncate_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2,
- s_scm_truncate_quotient);
+ return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2,
+ s_scm_truncate_quotient);
}
else if (SCM_BIGP (x))
{
@@ -2113,8 +2112,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient,
"truncate-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_truncate_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2,
- s_scm_truncate_quotient);
+ return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2,
+ s_scm_truncate_quotient);
}
else if (SCM_REALP (x))
{
@@ -2123,8 +2122,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient,
"truncate-quotient", 2, 0, 0,
return scm_i_inexact_truncate_quotient
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2,
- s_scm_truncate_quotient);
+ return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2,
+ s_scm_truncate_quotient);
}
else if (SCM_FRACTIONP (x))
{
@@ -2134,12 +2133,12 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_quotient,
"truncate-quotient", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_truncate_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2,
- s_scm_truncate_quotient);
+ return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2,
+ s_scm_truncate_quotient);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG1,
- s_scm_truncate_quotient);
+ return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG1,
+ s_scm_truncate_quotient);
}
#undef FUNC_NAME
@@ -2207,8 +2206,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder,
"truncate-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_truncate_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2,
- s_scm_truncate_remainder);
+ return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2,
+ s_scm_truncate_remainder);
}
else if (SCM_BIGP (x))
{
@@ -2241,8 +2240,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder,
"truncate-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_truncate_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2,
- s_scm_truncate_remainder);
+ return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2,
+ s_scm_truncate_remainder);
}
else if (SCM_REALP (x))
{
@@ -2251,8 +2250,8 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder,
"truncate-remainder", 2, 0, 0,
return scm_i_inexact_truncate_remainder
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2,
- s_scm_truncate_remainder);
+ return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2,
+ s_scm_truncate_remainder);
}
else if (SCM_FRACTIONP (x))
{
@@ -2262,12 +2261,12 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_remainder,
"truncate-remainder", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_truncate_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2,
- s_scm_truncate_remainder);
+ return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2,
+ s_scm_truncate_remainder);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG1,
- s_scm_truncate_remainder);
+ return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG1,
+ s_scm_truncate_remainder);
}
#undef FUNC_NAME
@@ -2554,8 +2553,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient,
"centered-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_centered_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2,
- s_scm_centered_quotient);
+ return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2,
+ s_scm_centered_quotient);
}
else if (SCM_BIGP (x))
{
@@ -2603,8 +2602,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient,
"centered-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_centered_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2,
- s_scm_centered_quotient);
+ return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2,
+ s_scm_centered_quotient);
}
else if (SCM_REALP (x))
{
@@ -2613,8 +2612,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient,
"centered-quotient", 2, 0, 0,
return scm_i_inexact_centered_quotient
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2,
- s_scm_centered_quotient);
+ return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2,
+ s_scm_centered_quotient);
}
else if (SCM_FRACTIONP (x))
{
@@ -2624,12 +2623,12 @@ SCM_PRIMITIVE_GENERIC (scm_centered_quotient,
"centered-quotient", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_centered_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2,
- s_scm_centered_quotient);
+ return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2,
+ s_scm_centered_quotient);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG1,
- s_scm_centered_quotient);
+ return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG1,
+ s_scm_centered_quotient);
}
#undef FUNC_NAME
@@ -2768,8 +2767,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder,
"centered-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_centered_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2,
- s_scm_centered_remainder);
+ return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2,
+ s_scm_centered_remainder);
}
else if (SCM_BIGP (x))
{
@@ -2809,8 +2808,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder,
"centered-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_centered_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2,
- s_scm_centered_remainder);
+ return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2,
+ s_scm_centered_remainder);
}
else if (SCM_REALP (x))
{
@@ -2819,8 +2818,8 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder,
"centered-remainder", 2, 0, 0,
return scm_i_inexact_centered_remainder
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2,
- s_scm_centered_remainder);
+ return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2,
+ s_scm_centered_remainder);
}
else if (SCM_FRACTIONP (x))
{
@@ -2830,12 +2829,12 @@ SCM_PRIMITIVE_GENERIC (scm_centered_remainder,
"centered-remainder", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_centered_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2,
- s_scm_centered_remainder);
+ return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2,
+ s_scm_centered_remainder);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG1,
- s_scm_centered_remainder);
+ return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG1,
+ s_scm_centered_remainder);
}
#undef FUNC_NAME
@@ -3250,8 +3249,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient,
"round-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_round_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2,
- s_scm_round_quotient);
+ return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2,
+ s_scm_round_quotient);
}
else if (SCM_BIGP (x))
{
@@ -3301,8 +3300,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient,
"round-quotient", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_round_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2,
- s_scm_round_quotient);
+ return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2,
+ s_scm_round_quotient);
}
else if (SCM_REALP (x))
{
@@ -3311,8 +3310,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient,
"round-quotient", 2, 0, 0,
return scm_i_inexact_round_quotient
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2,
- s_scm_round_quotient);
+ return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2,
+ s_scm_round_quotient);
}
else if (SCM_FRACTIONP (x))
{
@@ -3322,12 +3321,12 @@ SCM_PRIMITIVE_GENERIC (scm_round_quotient,
"round-quotient", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_round_quotient (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2,
- s_scm_round_quotient);
+ return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2,
+ s_scm_round_quotient);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG1,
- s_scm_round_quotient);
+ return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG1,
+ s_scm_round_quotient);
}
#undef FUNC_NAME
@@ -3454,8 +3453,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder,
"round-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_round_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2,
- s_scm_round_remainder);
+ return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2,
+ s_scm_round_remainder);
}
else if (SCM_BIGP (x))
{
@@ -3502,8 +3501,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder,
"round-remainder", 2, 0, 0,
else if (SCM_FRACTIONP (y))
return scm_i_exact_rational_round_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2,
- s_scm_round_remainder);
+ return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2,
+ s_scm_round_remainder);
}
else if (SCM_REALP (x))
{
@@ -3512,8 +3511,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder,
"round-remainder", 2, 0, 0,
return scm_i_inexact_round_remainder
(SCM_REAL_VALUE (x), scm_to_double (y));
else
- SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2,
- s_scm_round_remainder);
+ return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2,
+ s_scm_round_remainder);
}
else if (SCM_FRACTIONP (x))
{
@@ -3523,12 +3522,12 @@ SCM_PRIMITIVE_GENERIC (scm_round_remainder,
"round-remainder", 2, 0, 0,
else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y))
return scm_i_exact_rational_round_remainder (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2,
- s_scm_round_remainder);
+ return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2,
+ s_scm_round_remainder);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG1,
- s_scm_round_remainder);
+ return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG1,
+ s_scm_round_remainder);
}
#undef FUNC_NAME
@@ -3912,7 +3911,7 @@ scm_gcd (SCM x, SCM y)
goto big_inum;
}
else
- SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
+ return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
}
else if (SCM_BIGP (x))
{
@@ -3942,10 +3941,10 @@ scm_gcd (SCM x, SCM y)
return scm_i_normbig (result);
}
else
- SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
+ return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd);
}
else
- SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG1, s_gcd);
+ return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG1, s_gcd);
}
SCM_PRIMITIVE_GENERIC (scm_i_lcm, "lcm", 0, 2, 1,
@@ -3976,10 +3975,11 @@ scm_lcm (SCM n1, SCM n2)
n2 = SCM_I_MAKINUM (1L);
}
- SCM_GASSERT2 (SCM_I_INUMP (n1) || SCM_BIGP (n1),
- g_lcm, n1, n2, SCM_ARG1, s_lcm);
- SCM_GASSERT2 (SCM_I_INUMP (n2) || SCM_BIGP (n2),
- g_lcm, n1, n2, SCM_ARGn, s_lcm);
+ if (SCM_UNLIKELY (!(SCM_I_INUMP (n1) || SCM_BIGP (n1))))
+ return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG1, s_lcm);
+
+ if (SCM_UNLIKELY (!(SCM_I_INUMP (n2) || SCM_BIGP (n2))))
+ return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm);
if (SCM_I_INUMP (n1))
{
@@ -5109,12 +5109,6 @@ idbl2str (double f, char *a, int radix)
exp++;
}
zero:
-#ifdef ENGNOT
- /* adding 9999 makes this equivalent to abs(x) % 3 */
- dpt = (exp + 9999) % 3;
- exp -= dpt++;
- efmt = 1;
-#else
efmt = (exp < -3) || (exp > wp + 2);
if (!efmt)
{
@@ -5131,7 +5125,6 @@ idbl2str (double f, char *a, int radix)
}
else
dpt = 1;
-#endif
do
{
@@ -5153,7 +5146,6 @@ idbl2str (double f, char *a, int radix)
if (dpt > 0)
{
-#ifndef ENGNOT
if ((dpt > 4) && (exp > 6))
{
d = (a[0] == '-' ? 2 : 1);
@@ -5163,7 +5155,6 @@ idbl2str (double f, char *a, int radix)
efmt = 1;
}
else
-#endif
{
while (--dpt)
a[ch++] = '0';
@@ -6186,7 +6177,8 @@ scm_num_eq_p (SCM x, SCM y)
else if (SCM_FRACTIONP (y))
return SCM_BOOL_F;
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn,
+ s_scm_i_num_eq_p);
}
else if (SCM_BIGP (x))
{
@@ -6221,7 +6213,8 @@ scm_num_eq_p (SCM x, SCM y)
else if (SCM_FRACTIONP (y))
return SCM_BOOL_F;
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn,
+ s_scm_i_num_eq_p);
}
else if (SCM_REALP (x))
{
@@ -6259,7 +6252,8 @@ scm_num_eq_p (SCM x, SCM y)
goto again;
}
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn,
+ s_scm_i_num_eq_p);
}
else if (SCM_COMPLEXP (x))
{
@@ -6297,7 +6291,8 @@ scm_num_eq_p (SCM x, SCM y)
goto again;
}
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn,
+ s_scm_i_num_eq_p);
}
else if (SCM_FRACTIONP (x))
{
@@ -6331,10 +6326,12 @@ scm_num_eq_p (SCM x, SCM y)
else if (SCM_FRACTIONP (y))
return scm_i_fraction_equalp (x, y);
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn,
+ s_scm_i_num_eq_p);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARG1, s_scm_i_num_eq_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARG1,
+ s_scm_i_num_eq_p);
}
@@ -6393,7 +6390,8 @@ scm_less_p (SCM x, SCM y)
goto again;
}
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn,
s_scm_i_num_less_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn,
+ s_scm_i_num_less_p);
}
else if (SCM_BIGP (x))
{
@@ -6421,7 +6419,8 @@ scm_less_p (SCM x, SCM y)
else if (SCM_FRACTIONP (y))
goto int_frac;
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn,
s_scm_i_num_less_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn,
+ s_scm_i_num_less_p);
}
else if (SCM_REALP (x))
{
@@ -6449,7 +6448,8 @@ scm_less_p (SCM x, SCM y)
goto again;
}
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn,
s_scm_i_num_less_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn,
+ s_scm_i_num_less_p);
}
else if (SCM_FRACTIONP (x))
{
@@ -6482,10 +6482,12 @@ scm_less_p (SCM x, SCM y)
goto again;
}
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn,
s_scm_i_num_less_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn,
+ s_scm_i_num_less_p);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARG1,
s_scm_i_num_less_p);
+ return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARG1,
+ s_scm_i_num_less_p);
}
@@ -6514,9 +6516,9 @@ SCM
scm_gr_p (SCM x, SCM y)
{
if (!SCM_NUMBERP (x))
- SCM_WTA_DISPATCH_2 (g_scm_i_num_gr_p, x, y, SCM_ARG1, FUNC_NAME);
+ return scm_wta_dispatch_2 (g_scm_i_num_gr_p, x, y, SCM_ARG1, FUNC_NAME);
else if (!SCM_NUMBERP (y))
- SCM_WTA_DISPATCH_2 (g_scm_i_num_gr_p, x, y, SCM_ARG2, FUNC_NAME);
+ return scm_wta_dispatch_2 (g_scm_i_num_gr_p, x, y, SCM_ARG2, FUNC_NAME);
else
return scm_less_p (y, x);
}
@@ -6548,9 +6550,9 @@ SCM
scm_leq_p (SCM x, SCM y)
{
if (!SCM_NUMBERP (x))
- SCM_WTA_DISPATCH_2 (g_scm_i_num_leq_p, x, y, SCM_ARG1, FUNC_NAME);
+ return scm_wta_dispatch_2 (g_scm_i_num_leq_p, x, y, SCM_ARG1, FUNC_NAME);
else if (!SCM_NUMBERP (y))
- SCM_WTA_DISPATCH_2 (g_scm_i_num_leq_p, x, y, SCM_ARG2, FUNC_NAME);
+ return scm_wta_dispatch_2 (g_scm_i_num_leq_p, x, y, SCM_ARG2, FUNC_NAME);
else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y)))
return SCM_BOOL_F;
else
@@ -6584,9 +6586,9 @@ SCM
scm_geq_p (SCM x, SCM y)
{
if (!SCM_NUMBERP (x))
- SCM_WTA_DISPATCH_2 (g_scm_i_num_geq_p, x, y, SCM_ARG1, FUNC_NAME);
+ return scm_wta_dispatch_2 (g_scm_i_num_geq_p, x, y, SCM_ARG1, FUNC_NAME);
else if (!SCM_NUMBERP (y))
- SCM_WTA_DISPATCH_2 (g_scm_i_num_geq_p, x, y, SCM_ARG2, FUNC_NAME);
+ return scm_wta_dispatch_2 (g_scm_i_num_geq_p, x, y, SCM_ARG2, FUNC_NAME);
else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y)))
return SCM_BOOL_F;
else
@@ -6613,7 +6615,7 @@ SCM_PRIMITIVE_GENERIC (scm_zero_p, "zero?", 1, 0, 0,
else if (SCM_FRACTIONP (z))
return SCM_BOOL_F;
else
- SCM_WTA_DISPATCH_1 (g_scm_zero_p, z, SCM_ARG1, s_scm_zero_p);
+ return scm_wta_dispatch_1 (g_scm_zero_p, z, SCM_ARG1, s_scm_zero_p);
}
#undef FUNC_NAME
@@ -6637,7 +6639,7 @@ SCM_PRIMITIVE_GENERIC (scm_positive_p, "positive?", 1, 0,
0,
else if (SCM_FRACTIONP (x))
return scm_positive_p (SCM_FRACTION_NUMERATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_scm_positive_p, x, SCM_ARG1, s_scm_positive_p);
+ return scm_wta_dispatch_1 (g_scm_positive_p, x, SCM_ARG1,
s_scm_positive_p);
}
#undef FUNC_NAME
@@ -6661,7 +6663,7 @@ SCM_PRIMITIVE_GENERIC (scm_negative_p, "negative?", 1, 0,
0,
else if (SCM_FRACTIONP (x))
return scm_negative_p (SCM_FRACTION_NUMERATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_scm_negative_p, x, SCM_ARG1, s_scm_negative_p);
+ return scm_wta_dispatch_1 (g_scm_negative_p, x, SCM_ARG1,
s_scm_negative_p);
}
#undef FUNC_NAME
@@ -6695,11 +6697,11 @@ scm_max (SCM x, SCM y)
if (SCM_UNBNDP (y))
{
if (SCM_UNBNDP (x))
- SCM_WTA_DISPATCH_0 (g_max, s_max);
+ return scm_wta_dispatch_0 (g_max, s_max);
else if (SCM_I_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) ||
SCM_FRACTIONP(x))
return x;
else
- SCM_WTA_DISPATCH_1 (g_max, x, SCM_ARG1, s_max);
+ return scm_wta_dispatch_1 (g_max, x, SCM_ARG1, s_max);
}
if (SCM_I_INUMP (x))
@@ -6738,7 +6740,7 @@ scm_max (SCM x, SCM y)
return (scm_is_false (scm_less_p (x, y)) ? x : y);
}
else
- SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
+ return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max);
}
else if (SCM_BIGP (x))
{
@@ -6768,7 +6770,7 @@ scm_max (SCM x, SCM y)
goto use_less;
}
else
- SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
+ return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max);
}
else if (SCM_REALP (x))
{
@@ -6823,7 +6825,7 @@ scm_max (SCM x, SCM y)
return (xx < yy) ? scm_from_double (yy) : x;
}
else
- SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
+ return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max);
}
else if (SCM_FRACTIONP (x))
{
@@ -6846,10 +6848,10 @@ scm_max (SCM x, SCM y)
goto use_less;
}
else
- SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
+ return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max);
}
else
- SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARG1, s_max);
+ return scm_wta_dispatch_2 (g_max, x, y, SCM_ARG1, s_max);
}
@@ -6876,11 +6878,11 @@ scm_min (SCM x, SCM y)
if (SCM_UNBNDP (y))
{
if (SCM_UNBNDP (x))
- SCM_WTA_DISPATCH_0 (g_min, s_min);
+ return scm_wta_dispatch_0 (g_min, s_min);
else if (SCM_I_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) ||
SCM_FRACTIONP(x))
return x;
else
- SCM_WTA_DISPATCH_1 (g_min, x, SCM_ARG1, s_min);
+ return scm_wta_dispatch_1 (g_min, x, SCM_ARG1, s_min);
}
if (SCM_I_INUMP (x))
@@ -6909,7 +6911,7 @@ scm_min (SCM x, SCM y)
return (scm_is_false (scm_less_p (x, y)) ? y : x);
}
else
- SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
+ return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min);
}
else if (SCM_BIGP (x))
{
@@ -6939,7 +6941,7 @@ scm_min (SCM x, SCM y)
goto use_less;
}
else
- SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
+ return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min);
}
else if (SCM_REALP (x))
{
@@ -6983,7 +6985,7 @@ scm_min (SCM x, SCM y)
return (yy < xx) ? scm_from_double (yy) : x;
}
else
- SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
+ return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min);
}
else if (SCM_FRACTIONP (x))
{
@@ -7006,10 +7008,10 @@ scm_min (SCM x, SCM y)
goto use_less;
}
else
- SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
+ return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min);
}
else
- SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARG1, s_min);
+ return scm_wta_dispatch_2 (g_min, x, y, SCM_ARG1, s_min);
}
@@ -7038,7 +7040,7 @@ scm_sum (SCM x, SCM y)
{
if (SCM_NUMBERP (x)) return x;
if (SCM_UNBNDP (x)) return SCM_INUM0;
- SCM_WTA_DISPATCH_1 (g_sum, x, SCM_ARG1, s_sum);
+ return scm_wta_dispatch_1 (g_sum, x, SCM_ARG1, s_sum);
}
if (SCM_LIKELY (SCM_I_INUMP (x)))
@@ -7071,7 +7073,7 @@ scm_sum (SCM x, SCM y)
scm_product (x,
SCM_FRACTION_DENOMINATOR (y))),
SCM_FRACTION_DENOMINATOR (y));
else
- SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
+ return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
} else if (SCM_BIGP (x))
{
if (SCM_I_INUMP (y))
@@ -7136,7 +7138,7 @@ scm_sum (SCM x, SCM y)
scm_product (x,
SCM_FRACTION_DENOMINATOR (y))),
SCM_FRACTION_DENOMINATOR (y));
else
- SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
+ return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else if (SCM_REALP (x))
{
@@ -7156,7 +7158,7 @@ scm_sum (SCM x, SCM y)
else if (SCM_FRACTIONP (y))
return scm_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double (y));
else
- SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
+ return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else if (SCM_COMPLEXP (x))
{
@@ -7180,7 +7182,7 @@ scm_sum (SCM x, SCM y)
return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) +
scm_i_fraction2double (y),
SCM_COMPLEX_IMAG (x));
else
- SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
+ return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else if (SCM_FRACTIONP (x))
{
@@ -7203,10 +7205,10 @@ scm_sum (SCM x, SCM y)
scm_product (SCM_FRACTION_NUMERATOR
(y), SCM_FRACTION_DENOMINATOR (x))),
scm_product (SCM_FRACTION_DENOMINATOR (x),
SCM_FRACTION_DENOMINATOR (y)));
else
- SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum);
+ return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum);
}
else
- SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARG1, s_sum);
+ return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG1, s_sum);
}
@@ -7246,7 +7248,7 @@ scm_difference (SCM x, SCM y)
if (SCM_UNLIKELY (SCM_UNBNDP (y)))
{
if (SCM_UNBNDP (x))
- SCM_WTA_DISPATCH_0 (g_difference, s_difference);
+ return scm_wta_dispatch_0 (g_difference, s_difference);
else
if (SCM_I_INUMP (x))
{
@@ -7269,7 +7271,7 @@ scm_difference (SCM x, SCM y)
return scm_i_make_ratio (scm_difference (SCM_FRACTION_NUMERATOR (x),
SCM_UNDEFINED),
SCM_FRACTION_DENOMINATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_difference, x, SCM_ARG1, s_difference);
+ return scm_wta_dispatch_1 (g_difference, x, SCM_ARG1, s_difference);
}
if (SCM_LIKELY (SCM_I_INUMP (x)))
@@ -7356,7 +7358,7 @@ scm_difference (SCM x, SCM y)
SCM_FRACTION_NUMERATOR (y)),
SCM_FRACTION_DENOMINATOR (y));
else
- SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
+ return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
}
else if (SCM_BIGP (x))
{
@@ -7420,7 +7422,8 @@ scm_difference (SCM x, SCM y)
return scm_i_make_ratio (scm_difference (scm_product (x,
SCM_FRACTION_DENOMINATOR (y)),
SCM_FRACTION_NUMERATOR (y)),
SCM_FRACTION_DENOMINATOR (y));
- else SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
+ else
+ return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
}
else if (SCM_REALP (x))
{
@@ -7440,7 +7443,7 @@ scm_difference (SCM x, SCM y)
else if (SCM_FRACTIONP (y))
return scm_from_double (SCM_REAL_VALUE (x) - scm_i_fraction2double (y));
else
- SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
+ return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
}
else if (SCM_COMPLEXP (x))
{
@@ -7464,7 +7467,7 @@ scm_difference (SCM x, SCM y)
return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) -
scm_i_fraction2double (y),
SCM_COMPLEX_IMAG (x));
else
- SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
+ return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
}
else if (SCM_FRACTIONP (x))
{
@@ -7488,10 +7491,10 @@ scm_difference (SCM x, SCM y)
scm_product
(SCM_FRACTION_NUMERATOR (y), SCM_FRACTION_DENOMINATOR (x))),
scm_product (SCM_FRACTION_DENOMINATOR (x),
SCM_FRACTION_DENOMINATOR (y)));
else
- SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference);
+ return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference);
}
else
- SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARG1, s_difference);
+ return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARG1, s_difference);
}
#undef FUNC_NAME
@@ -7534,7 +7537,7 @@ scm_product (SCM x, SCM y)
else if (SCM_NUMBERP (x))
return x;
else
- SCM_WTA_DISPATCH_1 (g_product, x, SCM_ARG1, s_product);
+ return scm_wta_dispatch_1 (g_product, x, SCM_ARG1, s_product);
}
if (SCM_LIKELY (SCM_I_INUMP (x)))
@@ -7567,7 +7570,7 @@ scm_product (SCM x, SCM y)
else if (SCM_NUMP (y))
return SCM_INUM0;
else
- SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+ return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product);
break;
case -1:
/*
@@ -7612,7 +7615,7 @@ scm_product (SCM x, SCM y)
return scm_i_make_ratio (scm_product (x, SCM_FRACTION_NUMERATOR (y)),
SCM_FRACTION_DENOMINATOR (y));
else
- SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+ return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product);
}
else if (SCM_BIGP (x))
{
@@ -7647,7 +7650,7 @@ scm_product (SCM x, SCM y)
return scm_i_make_ratio (scm_product (x, SCM_FRACTION_NUMERATOR (y)),
SCM_FRACTION_DENOMINATOR (y));
else
- SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+ return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product);
}
else if (SCM_REALP (x))
{
@@ -7670,7 +7673,7 @@ scm_product (SCM x, SCM y)
else if (SCM_FRACTIONP (y))
return scm_from_double (SCM_REAL_VALUE (x) * scm_i_fraction2double (y));
else
- SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+ return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product);
}
else if (SCM_COMPLEXP (x))
{
@@ -7703,7 +7706,7 @@ scm_product (SCM x, SCM y)
yy * SCM_COMPLEX_IMAG (x));
}
else
- SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+ return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product);
}
else if (SCM_FRACTIONP (x))
{
@@ -7728,10 +7731,10 @@ scm_product (SCM x, SCM y)
scm_product (SCM_FRACTION_DENOMINATOR (x),
SCM_FRACTION_DENOMINATOR (y)));
else
- SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product);
+ return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product);
}
else
- SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARG1, s_product);
+ return scm_wta_dispatch_2 (g_product, x, y, SCM_ARG1, s_product);
}
#if ((defined (HAVE_ISINF) && defined (HAVE_ISNAN)) \
@@ -7795,7 +7798,7 @@ do_divide (SCM x, SCM y, int inexact)
if (SCM_UNLIKELY (SCM_UNBNDP (y)))
{
if (SCM_UNBNDP (x))
- SCM_WTA_DISPATCH_0 (g_divide, s_divide);
+ return scm_wta_dispatch_0 (g_divide, s_divide);
else if (SCM_I_INUMP (x))
{
scm_t_inum xx = SCM_I_INUM (x);
@@ -7849,7 +7852,7 @@ do_divide (SCM x, SCM y, int inexact)
return scm_i_make_ratio (SCM_FRACTION_DENOMINATOR (x),
SCM_FRACTION_NUMERATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_divide, x, SCM_ARG1, s_divide);
+ return scm_wta_dispatch_1 (g_divide, x, SCM_ARG1, s_divide);
}
if (SCM_LIKELY (SCM_I_INUMP (x)))
@@ -7923,7 +7926,7 @@ do_divide (SCM x, SCM y, int inexact)
return scm_i_make_ratio (scm_product (x, SCM_FRACTION_DENOMINATOR (y)),
SCM_FRACTION_NUMERATOR (y));
else
- SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
+ return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide);
}
else if (SCM_BIGP (x))
{
@@ -8022,7 +8025,7 @@ do_divide (SCM x, SCM y, int inexact)
return scm_i_make_ratio (scm_product (x, SCM_FRACTION_DENOMINATOR (y)),
SCM_FRACTION_NUMERATOR (y));
else
- SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
+ return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide);
}
else if (SCM_REALP (x))
{
@@ -8061,7 +8064,7 @@ do_divide (SCM x, SCM y, int inexact)
else if (SCM_FRACTIONP (y))
return scm_from_double (rx / scm_i_fraction2double (y));
else
- SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
+ return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide);
}
else if (SCM_COMPLEXP (x))
{
@@ -8119,7 +8122,7 @@ do_divide (SCM x, SCM y, int inexact)
return scm_c_make_rectangular (rx / yy, ix / yy);
}
else
- SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
+ return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide);
}
else if (SCM_FRACTIONP (x))
{
@@ -8158,10 +8161,10 @@ do_divide (SCM x, SCM y, int inexact)
return scm_i_make_ratio (scm_product (SCM_FRACTION_NUMERATOR (x),
SCM_FRACTION_DENOMINATOR (y)),
scm_product (SCM_FRACTION_NUMERATOR (y),
SCM_FRACTION_DENOMINATOR (x)));
else
- SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide);
+ return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide);
}
else
- SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARG1, s_divide);
+ return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARG1, s_divide);
}
SCM
@@ -8238,7 +8241,7 @@ SCM_PRIMITIVE_GENERIC (scm_truncate_number, "truncate",
1, 0, 0,
return scm_truncate_quotient (SCM_FRACTION_NUMERATOR (x),
SCM_FRACTION_DENOMINATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_scm_truncate_number, x, SCM_ARG1,
+ return scm_wta_dispatch_1 (g_scm_truncate_number, x, SCM_ARG1,
s_scm_truncate_number);
}
#undef FUNC_NAME
@@ -8258,8 +8261,8 @@ SCM_PRIMITIVE_GENERIC (scm_round_number, "round", 1, 0, 0,
return scm_round_quotient (SCM_FRACTION_NUMERATOR (x),
SCM_FRACTION_DENOMINATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_scm_round_number, x, SCM_ARG1,
- s_scm_round_number);
+ return scm_wta_dispatch_1 (g_scm_round_number, x, SCM_ARG1,
+ s_scm_round_number);
}
#undef FUNC_NAME
@@ -8276,7 +8279,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0,
return scm_floor_quotient (SCM_FRACTION_NUMERATOR (x),
SCM_FRACTION_DENOMINATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_scm_floor, x, 1, s_scm_floor);
+ return scm_wta_dispatch_1 (g_scm_floor, x, 1, s_scm_floor);
}
#undef FUNC_NAME
@@ -8293,7 +8296,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0,
return scm_ceiling_quotient (SCM_FRACTION_NUMERATOR (x),
SCM_FRACTION_DENOMINATOR (x));
else
- SCM_WTA_DISPATCH_1 (g_scm_ceiling, x, 1, s_scm_ceiling);
+ return scm_wta_dispatch_1 (g_scm_ceiling, x, 1, s_scm_ceiling);
}
#undef FUNC_NAME
@@ -8332,9 +8335,9 @@ SCM_PRIMITIVE_GENERIC (scm_expt, "expt", 2, 0, 0,
else if (scm_is_complex (x) && scm_is_complex (y))
return scm_exp (scm_product (scm_log (x), y));
else if (scm_is_complex (x))
- SCM_WTA_DISPATCH_2 (g_scm_expt, x, y, SCM_ARG2, s_scm_expt);
+ return scm_wta_dispatch_2 (g_scm_expt, x, y, SCM_ARG2, s_scm_expt);
else
- SCM_WTA_DISPATCH_2 (g_scm_expt, x, y, SCM_ARG1, s_scm_expt);
+ return scm_wta_dispatch_2 (g_scm_expt, x, y, SCM_ARG1, s_scm_expt);
}
#undef FUNC_NAME
@@ -8361,7 +8364,7 @@ SCM_PRIMITIVE_GENERIC (scm_sin, "sin", 1, 0, 0,
cos (x) * sinh (y));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_sin, z, 1, s_scm_sin);
+ return scm_wta_dispatch_1 (g_scm_sin, z, 1, s_scm_sin);
}
#undef FUNC_NAME
@@ -8382,7 +8385,7 @@ SCM_PRIMITIVE_GENERIC (scm_cos, "cos", 1, 0, 0,
-sin (x) * sinh (y));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_cos, z, 1, s_scm_cos);
+ return scm_wta_dispatch_1 (g_scm_cos, z, 1, s_scm_cos);
}
#undef FUNC_NAME
@@ -8407,7 +8410,7 @@ SCM_PRIMITIVE_GENERIC (scm_tan, "tan", 1, 0, 0,
return scm_c_make_rectangular (sin (x) / w, sinh (y) / w);
}
else
- SCM_WTA_DISPATCH_1 (g_scm_tan, z, 1, s_scm_tan);
+ return scm_wta_dispatch_1 (g_scm_tan, z, 1, s_scm_tan);
}
#undef FUNC_NAME
@@ -8428,7 +8431,7 @@ SCM_PRIMITIVE_GENERIC (scm_sinh, "sinh", 1, 0, 0,
cosh (x) * sin (y));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_sinh, z, 1, s_scm_sinh);
+ return scm_wta_dispatch_1 (g_scm_sinh, z, 1, s_scm_sinh);
}
#undef FUNC_NAME
@@ -8449,7 +8452,7 @@ SCM_PRIMITIVE_GENERIC (scm_cosh, "cosh", 1, 0, 0,
sinh (x) * sin (y));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_cosh, z, 1, s_scm_cosh);
+ return scm_wta_dispatch_1 (g_scm_cosh, z, 1, s_scm_cosh);
}
#undef FUNC_NAME
@@ -8474,7 +8477,7 @@ SCM_PRIMITIVE_GENERIC (scm_tanh, "tanh", 1, 0, 0,
return scm_c_make_rectangular (sinh (x) / w, sin (y) / w);
}
else
- SCM_WTA_DISPATCH_1 (g_scm_tanh, z, 1, s_scm_tanh);
+ return scm_wta_dispatch_1 (g_scm_tanh, z, 1, s_scm_tanh);
}
#undef FUNC_NAME
@@ -8502,7 +8505,7 @@ SCM_PRIMITIVE_GENERIC (scm_asin, "asin", 1, 0, 0,
scm_sys_asinh (scm_c_make_rectangular (-y, x)));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_asin, z, 1, s_scm_asin);
+ return scm_wta_dispatch_1 (g_scm_asin, z, 1, s_scm_asin);
}
#undef FUNC_NAME
@@ -8532,7 +8535,7 @@ SCM_PRIMITIVE_GENERIC (scm_acos, "acos", 1, 0, 0,
scm_sys_asinh (scm_c_make_rectangular (-y,
x))));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_acos, z, 1, s_scm_acos);
+ return scm_wta_dispatch_1 (g_scm_acos, z, 1, s_scm_acos);
}
#undef FUNC_NAME
@@ -8559,17 +8562,17 @@ SCM_PRIMITIVE_GENERIC (scm_atan, "atan", 1, 1, 0,
scm_c_make_rectangular (0, 2));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_atan, z, SCM_ARG1, s_scm_atan);
+ return scm_wta_dispatch_1 (g_scm_atan, z, SCM_ARG1, s_scm_atan);
}
else if (scm_is_real (z))
{
if (scm_is_real (y))
return scm_from_double (atan2 (scm_to_double (z), scm_to_double (y)));
else
- SCM_WTA_DISPATCH_2 (g_scm_atan, z, y, SCM_ARG2, s_scm_atan);
+ return scm_wta_dispatch_2 (g_scm_atan, z, y, SCM_ARG2, s_scm_atan);
}
else
- SCM_WTA_DISPATCH_2 (g_scm_atan, z, y, SCM_ARG1, s_scm_atan);
+ return scm_wta_dispatch_2 (g_scm_atan, z, y, SCM_ARG1, s_scm_atan);
}
#undef FUNC_NAME
@@ -8587,7 +8590,7 @@ SCM_PRIMITIVE_GENERIC (scm_sys_asinh, "asinh", 1, 0, 0,
scm_sqrt (scm_sum (scm_product (z, z),
SCM_INUM1))));
else
- SCM_WTA_DISPATCH_1 (g_scm_sys_asinh, z, 1, s_scm_sys_asinh);
+ return scm_wta_dispatch_1 (g_scm_sys_asinh, z, 1, s_scm_sys_asinh);
}
#undef FUNC_NAME
@@ -8605,7 +8608,7 @@ SCM_PRIMITIVE_GENERIC (scm_sys_acosh, "acosh", 1, 0, 0,
scm_sqrt (scm_difference (scm_product (z, z),
SCM_INUM1))));
else
- SCM_WTA_DISPATCH_1 (g_scm_sys_acosh, z, 1, s_scm_sys_acosh);
+ return scm_wta_dispatch_1 (g_scm_sys_acosh, z, 1, s_scm_sys_acosh);
}
#undef FUNC_NAME
@@ -8623,7 +8626,7 @@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, "atanh", 1, 0, 0,
scm_difference (SCM_INUM1, z))),
SCM_I_MAKINUM (2));
else
- SCM_WTA_DISPATCH_1 (g_scm_sys_atanh, z, 1, s_scm_sys_atanh);
+ return scm_wta_dispatch_1 (g_scm_sys_atanh, z, 1, s_scm_sys_atanh);
}
#undef FUNC_NAME
@@ -8724,7 +8727,7 @@ SCM_PRIMITIVE_GENERIC (scm_real_part, "real-part", 1, 0,
0,
else if (SCM_I_INUMP (z) || SCM_BIGP (z) || SCM_REALP (z) || SCM_FRACTIONP
(z))
return z;
else
- SCM_WTA_DISPATCH_1 (g_scm_real_part, z, SCM_ARG1, s_scm_real_part);
+ return scm_wta_dispatch_1 (g_scm_real_part, z, SCM_ARG1, s_scm_real_part);
}
#undef FUNC_NAME
@@ -8739,7 +8742,7 @@ SCM_PRIMITIVE_GENERIC (scm_imag_part, "imag-part", 1, 0,
0,
else if (SCM_I_INUMP (z) || SCM_REALP (z) || SCM_BIGP (z) || SCM_FRACTIONP
(z))
return SCM_INUM0;
else
- SCM_WTA_DISPATCH_1 (g_scm_imag_part, z, SCM_ARG1, s_scm_imag_part);
+ return scm_wta_dispatch_1 (g_scm_imag_part, z, SCM_ARG1, s_scm_imag_part);
}
#undef FUNC_NAME
@@ -8755,7 +8758,7 @@ SCM_PRIMITIVE_GENERIC (scm_numerator, "numerator", 1, 0,
0,
else if (SCM_REALP (z))
return scm_exact_to_inexact (scm_numerator (scm_inexact_to_exact (z)));
else
- SCM_WTA_DISPATCH_1 (g_scm_numerator, z, SCM_ARG1, s_scm_numerator);
+ return scm_wta_dispatch_1 (g_scm_numerator, z, SCM_ARG1, s_scm_numerator);
}
#undef FUNC_NAME
@@ -8772,7 +8775,8 @@ SCM_PRIMITIVE_GENERIC (scm_denominator, "denominator", 1,
0, 0,
else if (SCM_REALP (z))
return scm_exact_to_inexact (scm_denominator (scm_inexact_to_exact (z)));
else
- SCM_WTA_DISPATCH_1 (g_scm_denominator, z, SCM_ARG1, s_scm_denominator);
+ return scm_wta_dispatch_1 (g_scm_denominator, z, SCM_ARG1,
+ s_scm_denominator);
}
#undef FUNC_NAME
@@ -8814,7 +8818,8 @@ SCM_PRIMITIVE_GENERIC (scm_magnitude, "magnitude", 1, 0,
0,
SCM_FRACTION_DENOMINATOR (z));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_magnitude, z, SCM_ARG1, s_scm_magnitude);
+ return scm_wta_dispatch_1 (g_scm_magnitude, z, SCM_ARG1,
+ s_scm_magnitude);
}
#undef FUNC_NAME
@@ -8860,7 +8865,7 @@ SCM_PRIMITIVE_GENERIC (scm_angle, "angle", 1, 0, 0,
else return scm_from_double (atan2 (0.0, -1.0));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_angle, z, SCM_ARG1, s_scm_angle);
+ return scm_wta_dispatch_1 (g_scm_angle, z, SCM_ARG1, s_scm_angle);
}
#undef FUNC_NAME
@@ -8879,7 +8884,8 @@ SCM_PRIMITIVE_GENERIC (scm_exact_to_inexact,
"exact->inexact", 1, 0, 0,
else if (SCM_INEXACTP (z))
return z;
else
- SCM_WTA_DISPATCH_1 (g_scm_exact_to_inexact, z, 1, s_scm_exact_to_inexact);
+ return scm_wta_dispatch_1 (g_scm_exact_to_inexact, z, 1,
+ s_scm_exact_to_inexact);
}
#undef FUNC_NAME
@@ -8900,7 +8906,8 @@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_exact,
"inexact->exact", 1, 0, 0,
else if (SCM_COMPLEXP (z) && SCM_COMPLEX_IMAG (z) == 0.0)
val = SCM_COMPLEX_REAL (z);
else
- SCM_WTA_DISPATCH_1 (g_scm_inexact_to_exact, z, 1,
s_scm_inexact_to_exact);
+ return scm_wta_dispatch_1 (g_scm_inexact_to_exact, z, 1,
+ s_scm_inexact_to_exact);
if (!SCM_LIKELY (DOUBLE_IS_FINITE (val)))
SCM_OUT_OF_RANGE (1, z);
@@ -9437,7 +9444,7 @@ SCM_PRIMITIVE_GENERIC (scm_log, "log", 1, 0, 0,
return log_of_fraction (SCM_FRACTION_NUMERATOR (z),
SCM_FRACTION_DENOMINATOR (z));
else
- SCM_WTA_DISPATCH_1 (g_scm_log, z, 1, s_scm_log);
+ return scm_wta_dispatch_1 (g_scm_log, z, 1, s_scm_log);
}
#undef FUNC_NAME
@@ -9484,7 +9491,7 @@ SCM_PRIMITIVE_GENERIC (scm_log10, "log10", 1, 0, 0,
log_of_fraction (SCM_FRACTION_NUMERATOR (z),
SCM_FRACTION_DENOMINATOR (z)));
else
- SCM_WTA_DISPATCH_1 (g_scm_log10, z, 1, s_scm_log10);
+ return scm_wta_dispatch_1 (g_scm_log10, z, 1, s_scm_log10);
}
#undef FUNC_NAME
@@ -9512,7 +9519,7 @@ SCM_PRIMITIVE_GENERIC (scm_exp, "exp", 1, 0, 0,
return scm_from_double (exp (scm_to_double (z)));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_exp, z, 1, s_scm_exp);
+ return scm_wta_dispatch_1 (g_scm_exp, z, 1, s_scm_exp);
}
#undef FUNC_NAME
@@ -9617,7 +9624,7 @@ SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt", 1, 0, 0,
return scm_from_double (sqrt (xx));
}
else
- SCM_WTA_DISPATCH_1 (g_scm_sqrt, z, 1, s_scm_sqrt);
+ return scm_wta_dispatch_1 (g_scm_sqrt, z, 1, s_scm_sqrt);
}
#undef FUNC_NAME
diff --git a/libguile/print.c b/libguile/print.c
index 4afd12c..31e17f1 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -529,7 +529,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
goto print_struct;
pwps = scm_i_port_with_print_state (port, pstate->handle);
pstate->revealed = 1;
- scm_call_generic_2 (print, exp, pwps);
+ scm_call_2 (print, exp, pwps);
}
else
{
diff --git a/libguile/procs.c b/libguile/procs.c
index a096591..0018dc9 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -146,14 +146,15 @@ SCM_PRIMITIVE_GENERIC (scm_setter, "setter", 1, 0, 0,
"applicable struct with a setter.")
#define FUNC_NAME s_scm_setter
{
- SCM_GASSERT1 (SCM_STRUCTP (proc), g_scm_setter, proc, SCM_ARG1, FUNC_NAME);
+ if (SCM_UNLIKELY (!SCM_STRUCTP (proc)))
+ return scm_wta_dispatch_1 (g_scm_setter, proc, SCM_ARG1, FUNC_NAME);
if (SCM_STRUCT_SETTER_P (proc))
return SCM_STRUCT_SETTER (proc);
if (SCM_PUREGENERICP (proc)
&& SCM_IS_A_P (proc, scm_class_generic_with_setter))
/* FIXME: might not be an accessor */
return SCM_GENERIC_SETTER (proc);
- SCM_WTA_DISPATCH_1 (g_scm_setter, proc, SCM_ARG1, FUNC_NAME);
+ return scm_wta_dispatch_1 (g_scm_setter, proc, SCM_ARG1, FUNC_NAME);
return SCM_BOOL_F; /* not reached */
}
#undef FUNC_NAME
diff --git a/libguile/stackchk.c b/libguile/stackchk.c
index 6cfb783..7b9b4c4 100644
--- a/libguile/stackchk.c
+++ b/libguile/stackchk.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997, 2000, 2001, 2006, 2008, 2010 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997, 2000, 2001, 2006, 2008, 2010, 2011 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
@@ -34,7 +34,6 @@
/* {Stack Checking}
*/
-#ifdef STACK_CHECKING
int scm_stack_checking_enabled_p;
SCM_SYMBOL (scm_stack_overflow_key, "stack-overflow");
@@ -65,8 +64,6 @@ scm_report_stack_overflow ()
scm_dynwind_end ();
}
-#endif
-
long
scm_stack_size (SCM_STACKITEM *start)
{
diff --git a/libguile/stackchk.h b/libguile/stackchk.h
index aa6a1d4..1ed170f 100644
--- a/libguile/stackchk.h
+++ b/libguile/stackchk.h
@@ -3,7 +3,7 @@
#ifndef SCM_STACKCHK_H
#define SCM_STACKCHK_H
-/* Copyright (C) 1995,1996,1998,2000, 2003, 2006, 2008, 2009, 2010 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000, 2003, 2006, 2008, 2009, 2010, 2011 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
@@ -34,7 +34,7 @@
*/
#define SCM_STACK_CHECKING_P SCM_STACK_LIMIT
-#if defined BUILDING_LIBGUILE && defined STACK_CHECKING
+#if defined BUILDING_LIBGUILE
#include "libguile/private-options.h"
# if SCM_STACK_GROWS_UP
# define SCM_STACK_OVERFLOW_P(s)\
diff --git a/libguile/tags.h b/libguile/tags.h
index c90838e..c03f43d 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -61,7 +61,6 @@
/* For dealing with the bit level representation of scheme objects we define
* scm_t_bits:
*/
-
typedef scm_t_intptr scm_t_signed_bits;
typedef scm_t_uintptr scm_t_bits;
@@ -70,47 +69,28 @@ typedef scm_t_uintptr scm_t_bits;
#define SCM_T_BITS_MAX SCM_T_UINTPTR_MAX
-/* But as external interface, we define SCM, which may, according to the
- * desired level of type checking, be defined in several ways:
- */
-#if (SCM_DEBUG_TYPING_STRICTNESS == 2)
-typedef union SCM { struct { scm_t_bits n; } n; } SCM;
-# define SCM_UNPACK(x) ((x).n.n)
-# define SCM_PACK(x) ((SCM) { { (scm_t_bits) (x) } })
-#elif (SCM_DEBUG_TYPING_STRICTNESS == 1)
-/* This is the default, which provides an intermediate level of compile time
- * type checking while still resulting in very efficient code.
+/* But as external interface, we pack the bits in a union. This makes
+ * the compiler treat SCM values as a disjoint type, allowing the
+ * detection of many common errors.
*/
- typedef struct scm_unused_struct { char scm_unused_field; } *SCM;
-
-/*
- The 0?: constructions makes sure that the code is never executed,
- and that there is no performance hit. However, the alternative is
- compiled, and does generate a warning when used with the wrong
- pointer type.
-
- The Tru64 and ia64-hp-hpux11.23 compilers fail on `case (0?0=0:x)'
- statements, so for them type-checking is disabled. */
-#if defined __DECC || defined __HP_cc
-# define SCM_UNPACK(x) ((scm_t_bits) (x))
-#else
-# define SCM_UNPACK(x) ((scm_t_bits) (0? (*(SCM*)0=(x)): x))
-#endif
+union SCM
+{
+ scm_t_bits n;
+};
-/*
- There is no typechecking on SCM_PACK, since all kinds of types
- (unsigned long, void*) go in SCM_PACK
+#ifndef SCM_USING_PREHISTORIC_COMPILER
+/* With GCC at least, wrapping the bits in a union provides no
+ * performance penalty.
*/
-# define SCM_PACK(x) ((SCM) (x))
-
+typedef union SCM SCM;
+#define SCM_UNPACK(x) ((x).n)
+#define SCM_PACK(x) ((SCM) { (scm_t_bits) (x) })
#else
-/* This should be used as a fall back solution for machines on which casting
- * to a pointer may lead to loss of bit information, e. g. in the three least
- * significant bits.
+/* But we do provide an escape valve for less capable compilers.
*/
- typedef scm_t_bits SCM;
-# define SCM_UNPACK(x) (x)
-# define SCM_PACK(x) ((SCM) (x))
+typedef scm_t_bits SCM;
+#define SCM_UNPACK(x) (x)
+#define SCM_PACK(x) ((SCM) (x))
#endif
diff --git a/libguile/threads.c b/libguile/threads.c
index def9281..468d1f8 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -821,7 +821,7 @@ scm_init_guile ()
else
{
fprintf (stderr, "Failed to get stack base for current thread.\n");
- exit (1);
+ exit (EXIT_FAILURE);
}
}
@@ -1575,7 +1575,7 @@ fat_mutex_unlock (SCM mutex, SCM cond,
}
t->block_asyncs--;
- scm_async_click ();
+ scm_async_tick ();
scm_remember_upto_here_2 (cond, mutex);
diff --git a/libguile/threads.h b/libguile/threads.h
index 609262a..34d63d1 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -142,9 +142,6 @@ SCM_INTERNAL void scm_init_thread_procs (void);
SCM_INTERNAL void scm_init_threads_default_dynamic_state (void);
-#define SCM_THREAD_SWITCHING_CODE \
- do { } while (0)
-
SCM_API SCM scm_call_with_new_thread (SCM thunk, SCM handler);
SCM_API SCM scm_yield (void);
SCM_API SCM scm_cancel_thread (SCM t);
diff --git a/libguile/throw.c b/libguile/throw.c
index 9c29351..4b3c75e 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -329,9 +329,9 @@ scm_exit_status (SCM args)
if (scm_is_integer (cqa))
return (scm_to_int (cqa));
else if (scm_is_false (cqa))
- return 1;
+ return EXIT_FAILURE;
}
- return 0;
+ return EXIT_SUCCESS;
}
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 2805278..e43fa0e 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -123,7 +123,7 @@ scm_vector_length (SCM v)
return scm_from_size_t (dim->ubnd - dim->lbnd + 1);
}
else
- SCM_WTA_DISPATCH_1 (g_vector_length, v, 1, NULL);
+ return scm_wta_dispatch_1 (g_vector_length, v, 1, "vector-length");
}
size_t
@@ -241,7 +241,8 @@ scm_c_vector_ref (SCM v, size_t k)
scm_wrong_type_arg_msg (NULL, 0, v, "non-uniform vector");
}
else
- SCM_WTA_DISPATCH_2 (g_vector_ref, v, scm_from_size_t (k), 2, NULL);
+ return scm_wta_dispatch_2 (g_vector_ref, v, scm_from_size_t (k), 2,
+ "vector-ref");
}
SCM_GPROC (s_vector_set_x, "vector-set!", 3, 0, 0, scm_vector_set_x,
g_vector_set_x);
@@ -307,8 +308,10 @@ scm_c_vector_set_x (SCM v, size_t k, SCM obj)
else
{
if (SCM_UNPACK (g_vector_set_x))
- scm_apply_generic (g_vector_set_x,
- scm_list_3 (v, scm_from_size_t (k), obj));
+ scm_wta_dispatch_n (g_vector_set_x,
+ scm_list_3 (v, scm_from_size_t (k), obj),
+ 0,
+ "vector-set!");
else
scm_wrong_type_arg_msg (NULL, 0, v, "vector");
}
diff --git a/test-suite/standalone/test-num2integral.c
b/test-suite/standalone/test-num2integral.c
index 6a44fb7..d210a19 100644
--- a/test-suite/standalone/test-num2integral.c
+++ b/test-suite/standalone/test-num2integral.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2008, 2010 Free Software
Foundation, Inc.
+/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2008, 2010, 2011 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
@@ -24,6 +24,7 @@
#include <stdio.h>
#include <assert.h>
+#include <limits.h>
SCM out_of_range_handler (void *data, SCM key, SCM args);
SCM call_num2long_long_body (void *data);
@@ -33,7 +34,8 @@ SCM call_num2ulong_long_body (void *data);
SCM
out_of_range_handler (void *data, SCM key, SCM args)
{
- assert (scm_equal_p (key, scm_from_locale_symbol ("out-of-range")));
+ assert (scm_is_true
+ (scm_equal_p (key, scm_from_locale_symbol ("out-of-range"))));
return SCM_BOOL_T;
}
@@ -55,14 +57,14 @@ static void
test_long_long ()
{
{
- SCM n = scm_from_long_long (SCM_I_LLONG_MIN);
+ SCM n = scm_from_long_long (LLONG_MIN);
long long result = scm_to_long_long(n);
- assert (result == SCM_I_LLONG_MIN);
+ assert (result == LLONG_MIN);
}
/* LLONG_MIN - 1 */
{
- SCM n = scm_difference (scm_from_long_long (SCM_I_LLONG_MIN), scm_from_int
(1));
+ SCM n = scm_difference (scm_from_long_long (LLONG_MIN), scm_from_int (1));
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
out_of_range_handler, NULL);
assert (scm_is_true (caught));
@@ -70,8 +72,8 @@ test_long_long ()
/* SCM_I_LLONG_MIN + SCM_I_LLONG_MIN/2 */
{
- SCM n = scm_sum (scm_from_long_long (SCM_I_LLONG_MIN),
- scm_from_long_long (SCM_I_LLONG_MIN / 2));
+ SCM n = scm_sum (scm_from_long_long (LLONG_MIN),
+ scm_from_long_long (LLONG_MIN / 2));
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
out_of_range_handler, NULL);
assert (scm_is_true (caught));
@@ -79,7 +81,7 @@ test_long_long ()
/* SCM_I_LLONG_MAX + 1 */
{
- SCM n = scm_sum (scm_from_long_long (SCM_I_LLONG_MAX), scm_from_int (1));
+ SCM n = scm_sum (scm_from_long_long (LLONG_MAX), scm_from_int (1));
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2long_long_body, &n,
out_of_range_handler, NULL);
assert (scm_is_true (caught));
@@ -107,9 +109,9 @@ static void
test_ulong_long ()
{
{
- SCM n = scm_from_ulong_long (SCM_I_ULLONG_MAX);
+ SCM n = scm_from_ulong_long (ULLONG_MAX);
unsigned long long result = scm_to_ulong_long(n);
- assert (result == SCM_I_ULLONG_MAX);
+ assert (result == ULLONG_MAX);
}
/* -1 */
@@ -122,7 +124,7 @@ test_ulong_long ()
/* SCM_I_ULLONG_MAX + 1 */
{
- SCM n = scm_sum (scm_from_ulong_long (SCM_I_ULLONG_MAX), scm_from_int (1));
+ SCM n = scm_sum (scm_from_ulong_long (ULLONG_MAX), scm_from_int (1));
SCM caught = scm_internal_catch (SCM_BOOL_T, call_num2ulong_long_body, &n,
out_of_range_handler, NULL);
assert (scm_is_true (caught));
diff --git a/test-suite/standalone/test-scm-spawn-thread.c
b/test-suite/standalone/test-scm-spawn-thread.c
index b632ab0..aa790cd 100644
--- a/test-suite/standalone/test-scm-spawn-thread.c
+++ b/test-suite/standalone/test-scm-spawn-thread.c
@@ -48,7 +48,7 @@ inner_main (void *data)
thread = scm_spawn_thread (thread_main, 0, thread_handler, 0);
timeout = scm_from_unsigned_integer (time (NULL) + 10);
- return (void *) scm_join_thread_timed (thread, timeout, SCM_BOOL_F);
+ return SCM2PTR (scm_join_thread_timed (thread, timeout, SCM_BOOL_F));
}
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-45-g44e5b41,
Andy Wingo <=