wingo pushed a commit to branch wip-whippet
in repository guile.
commit c79d5bd0f7675bcd3c2d4bdf1a34f9a32316ee99
Author: Andy Wingo <wi...@pobox.com>
AuthorDate: Thu Jun 26 15:56:16 2025 +0200
Change to be less sloppy as regards functions without prototypes
* libguile/gsubr.h (scm_t_subr_0, scm_t_subr_1, etc): New precise
typedefs.
(SCM_AS_SUBR): Use C11's _Generic to cast subrs to the generic subr
type, while also producing a warning/error if the function isn't
compatible.
(SCM_DEFINE_GSUBR, SCM_PRIMITIVE_GENERIC, SCM_DEFINE_PUBLIC)
(SCM_DEFINE_STATIC, SCM_PROC, SCM_REGISTER_PROC, SCM_GPROC): Use
SCM_AS_SUBR.
* libguile/gsubr-internal.h (scm_t_subr_with_thread_0)
(scm_t_subr_with_thread_1, etc): New precise typedefs.
(SCM_AS_SUBR_WITH_THREAD): Like SCM_AS_SUBR.
* libguile/gsubr.c (scm_apply_subr): Cast callee to the right type
before calling.
* libguile/hash.c (floor): Remove weird unused declaration.
* libguile/init.c (scm_boot_guile): Fix type of main_func in definition.
* libguile/jit.c: Fix type of enter_mcode.
* libguile/smob.c (apply_0, apply_1, apply_2, apply_3): Cast callee to
right type.
(scm_smob_trampoline): Use SCM_AS_SUBR.
* libguile/smob.h (SCM_SMOB_APPLY): Use SCM_AS_SUBR.
* libguile/backtrace.c:
* libguile/control.c:
* libguile/dynl.c:
* libguile/eval.c:
* libguile/exceptions.c:
* libguile/expand.c:
* libguile/finalizers.c:
* libguile/fluids.c:
* libguile/fports.c:
* libguile/frames.c:
* libguile/gc.c:
* libguile/load.c:
* libguile/loader.c:
* libguile/macros.c:
* libguile/memoize.c:
* libguile/pairs.c:
* libguile/poll.c:
* libguile/ports.c:
* libguile/posix.c:
* libguile/rdelim.c:
* libguile/rw.c:
* libguile/vm.c: Adapt scm_c_make_gsubr / scm_c_define_gsubr callers to
use SCM_AS_SUBR.
---
libguile/backtrace.c | 3 +-
libguile/control.c | 2 +-
libguile/dynl.c | 10 +++---
libguile/eval.c | 4 +--
libguile/exceptions.c | 5 ++-
libguile/expand.c | 3 +-
libguile/finalizers.c | 5 +--
libguile/fluids.c | 4 +--
libguile/fports.c | 2 +-
libguile/frames.c | 8 ++---
libguile/gc.c | 7 ++--
libguile/gsubr-internal.h | 27 +++++++++++++++
libguile/gsubr.c | 88 +++++++++++++++++++++++------------------------
libguile/gsubr.h | 48 ++++++++++++++++++--------
libguile/hash.c | 4 ---
libguile/init.c | 3 +-
libguile/jit.c | 5 +--
libguile/load.c | 2 +-
libguile/loader.c | 4 +--
libguile/macros.c | 3 +-
libguile/memoize.c | 12 +++----
libguile/pairs.c | 6 ++--
libguile/poll.c | 3 +-
libguile/ports.c | 18 +++++-----
libguile/posix.c | 6 ++--
libguile/rdelim.c | 2 +-
libguile/rw.c | 3 +-
libguile/smob.c | 16 ++++-----
libguile/smob.h | 3 +-
libguile/vm.c | 4 +--
30 files changed, 180 insertions(+), 130 deletions(-)
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 569632ffa..fb34c3e54 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -323,6 +323,7 @@ scm_backtrace (void)
void
scm_init_backtrace ()
{
- scm_c_define_gsubr ("print-exception", 4, 0, 0, boot_print_exception);
+ scm_c_define_gsubr ("print-exception", 4, 0, 0,
+ SCM_AS_SUBR (boot_print_exception));
#include "backtrace.x"
}
diff --git a/libguile/control.c b/libguile/control.c
index e9bbd252e..772d93791 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -152,7 +152,7 @@ static void
scm_init_ice_9_control (void *unused)
{
scm_c_define_gsubr ("suspendable-continuation?", 1, 0, 0,
- scm_suspendable_continuation_p);
+ SCM_AS_SUBR (scm_suspendable_continuation_p));
}
void
diff --git a/libguile/dynl.c b/libguile/dynl.c
index de9324e39..03734d6f4 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -195,13 +195,13 @@ scm_init_dynamic_linking ()
// FIXME: Deprecate all of these, once (system foreign-library) has
// had enough time in the world.
scm_c_define_gsubr
- ("dynamic-link", 0, 1, 0, (scm_t_subr) scm_dynamic_link);
+ ("dynamic-link", 0, 1, 0, SCM_AS_SUBR (scm_dynamic_link));
scm_c_define_gsubr
- ("dynamic-object?", 1, 0, 0, (scm_t_subr) scm_dynamic_object_p);
+ ("dynamic-object?", 1, 0, 0, SCM_AS_SUBR (scm_dynamic_object_p));
scm_c_define_gsubr
- ("dynamic-func", 2, 0, 0, (scm_t_subr) scm_dynamic_func);
+ ("dynamic-func", 2, 0, 0, SCM_AS_SUBR (scm_dynamic_func));
scm_c_define_gsubr
- ("dynamic-pointer", 2, 0, 0, (scm_t_subr) scm_dynamic_pointer);
+ ("dynamic-pointer", 2, 0, 0, SCM_AS_SUBR (scm_dynamic_pointer));
scm_c_define_gsubr
- ("dynamic-call", 2, 0, 0, (scm_t_subr) scm_dynamic_call);
+ ("dynamic-call", 2, 0, 0, SCM_AS_SUBR (scm_dynamic_call));
}
diff --git a/libguile/eval.c b/libguile/eval.c
index e53d7c89f..1da6b9151 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1001,14 +1001,14 @@ scm_init_eval ()
{
SCM primitive_eval;
- f_apply = scm_c_define_gsubr ("apply", 2, 0, 1, scm_apply);
+ f_apply = scm_c_define_gsubr ("apply", 2, 0, 1, SCM_AS_SUBR (scm_apply));
apply_boot_closure_code =
scm_allocate_subr_code (scm_from_utf8_symbol ("boot-closure"), 0, 0, 1,
apply_boot_closure, SCM_F_SUBR_CLOSURE);
primitive_eval = scm_c_make_gsubr ("primitive-eval", 1, 0, 0,
- scm_c_primitive_eval);
+ SCM_AS_SUBR (scm_c_primitive_eval));
var_primitive_eval = scm_define (SCM_SUBR_NAME (primitive_eval),
primitive_eval);
diff --git a/libguile/exceptions.c b/libguile/exceptions.c
index 555af7a34..b965b5bc9 100644
--- a/libguile/exceptions.c
+++ b/libguile/exceptions.c
@@ -137,7 +137,6 @@ scm_c_with_exception_handler (SCM type,
scm_t_exception_handler handler,
SCM prompt_tag = scm_cons (SCM_INUM0, SCM_EOL);
scm_thread *t = SCM_I_CURRENT_THREAD;
scm_t_dynstack *dynstack = &t->dynstack;
- scm_t_dynamic_state *dynamic_state = &t->dynamic_state;
jmp_buf registers;
jmp_buf *prev_registers;
ptrdiff_t saved_stack_depth;
@@ -524,11 +523,11 @@ scm_init_exceptions ()
raise_exception_var =
scm_c_define ("raise-exception",
scm_c_make_gsubr ("raise-exception", 1, 0, 0,
- (scm_t_subr) pre_boot_raise));
+ SCM_AS_SUBR (pre_boot_raise)));
scm_c_define ("%init-exceptions!",
scm_c_make_gsubr ("%init-exceptions!", 3, 0, 0,
- (scm_t_subr) sys_init_exceptions_x));
+ SCM_AS_SUBR (sys_init_exceptions_x)));
#include "exceptions.x"
}
diff --git a/libguile/expand.c b/libguile/expand.c
index 7b28cb6d2..6eae9947f 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -1562,7 +1562,8 @@ scm_init_expand ()
const_unbound =
CONST_ (scm_list_1 (scm_from_latin1_symbol ("unbound")));
- scm_c_define_gsubr ("convert-assignment", 1, 0, 0, scm_convert_assignment);
+ scm_c_define_gsubr ("convert-assignment", 1, 0, 0,
+ SCM_AS_SUBR (scm_convert_assignment));
scm_c_define ("%expanded-vtables", scm_vector (exp_vtable_list));
diff --git a/libguile/finalizers.c b/libguile/finalizers.c
index 8849c5c47..70e45fc64 100644
--- a/libguile/finalizers.c
+++ b/libguile/finalizers.c
@@ -565,8 +565,9 @@ scm_init_finalizers (void)
{
/* When the async is to run, the cdr of the pair gets set to the
asyncs queue of the current thread. */
- run_finalizers_subr = scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
- run_finalizers_async_thunk);
+ run_finalizers_subr =
+ scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
+ SCM_AS_SUBR (run_finalizers_async_thunk));
if (automatic_finalization_p)
{
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 80437924b..1475ad474 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -491,7 +491,7 @@ SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
#undef FUNC_NAME
SCM
-scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
+scm_c_with_fluids (SCM fluids, SCM values, SCM (*cproc) (void *), void *cdata)
#define FUNC_NAME "scm_c_with_fluids"
{
SCM ans;
@@ -529,7 +529,7 @@ scm_with_fluid (SCM fluid, SCM value, SCM thunk)
}
SCM
-scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
+scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (void *), void *cdata)
#define FUNC_NAME "scm_c_with_fluid"
{
SCM ans;
diff --git a/libguile/fports.c b/libguile/fports.c
index 9e718fc8c..51740faa6 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -788,7 +788,7 @@ scm_init_fports ()
/* Used by `include' and also by `file-exists?' if `stat' is
unavailable. */
- scm_c_define_gsubr (s_scm_i_open_file, 2, 0, 1, (scm_t_subr)
scm_i_open_file);
+ scm_c_define_gsubr (s_scm_i_open_file, 2, 0, 1, SCM_AS_SUBR
(scm_i_open_file));
/* Used by `open-file.', also via C. */
sym_relative = scm_from_latin1_symbol ("relative");
diff --git a/libguile/frames.c b/libguile/frames.c
index 5d615608a..f1dc81f5b 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -478,13 +478,13 @@ static void
scm_init_frames_builtins (void *unused)
{
scm_c_define_gsubr (s_scm_frame_num_locals, 1, 0, 0,
- (scm_t_subr) scm_frame_num_locals);
+ SCM_AS_SUBR (scm_frame_num_locals));
scm_c_define_gsubr (s_scm_frame_local_ref, 3, 0, 0,
- (scm_t_subr) scm_frame_local_ref);
+ SCM_AS_SUBR (scm_frame_local_ref));
scm_c_define_gsubr (s_scm_frame_local_set_x, 4, 0, 0,
- (scm_t_subr) scm_frame_local_set_x);
+ SCM_AS_SUBR (scm_frame_local_set_x));
scm_c_define_gsubr (s_scm_frame_return_values, 1, 0, 0,
- (scm_t_subr) scm_frame_return_values);
+ SCM_AS_SUBR (scm_frame_return_values));
}
void
diff --git a/libguile/gc.c b/libguile/gc.c
index 6bbb32d26..d9d094210 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -712,9 +712,10 @@ scm_init_gc ()
{
/* When the async is to run, the cdr of the gc_async pair gets set to
the asyncs queue of the current thread. */
- after_gc_async_cell = scm_cons (scm_c_make_gsubr ("%after-gc-thunk", 0, 0, 0,
- after_gc_async_thunk),
- SCM_BOOL_F);
+ after_gc_async_cell =
+ scm_cons (scm_c_make_gsubr ("%after-gc-thunk", 0, 0, 0,
+ SCM_AS_SUBR (after_gc_async_thunk)),
+ SCM_BOOL_F);
gc_heap_set_allocation_failure_handler (the_gc_heap, scm_oom_fn);
diff --git a/libguile/gsubr-internal.h b/libguile/gsubr-internal.h
index f3303d41d..3793e31ba 100644
--- a/libguile/gsubr-internal.h
+++ b/libguile/gsubr-internal.h
@@ -33,6 +33,33 @@
#define SCM_PRIMITIVE_P(x) (scm_is_primitive (x))
#define SCM_PRIMITIVE_GENERIC_P(x) (scm_is_primitive_generic (x))
+typedef SCM (*scm_t_subr_with_thread_0) (scm_thread*);
+typedef SCM (*scm_t_subr_with_thread_1) (scm_thread*, SCM);
+typedef SCM (*scm_t_subr_with_thread_2) (scm_thread*, SCM, SCM);
+typedef SCM (*scm_t_subr_with_thread_3) (scm_thread*, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_with_thread_4) (scm_thread*, SCM, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_with_thread_5) (scm_thread*, SCM, SCM, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_with_thread_6) (scm_thread*, SCM, SCM, SCM, SCM, SCM,
SCM);
+typedef SCM (*scm_t_subr_with_thread_7) (scm_thread*, SCM, SCM, SCM, SCM, SCM,
SCM, SCM);
+typedef SCM (*scm_t_subr_with_thread_8) (scm_thread*, SCM, SCM, SCM, SCM, SCM,
SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_with_thread_9) (scm_thread*, SCM, SCM, SCM, SCM, SCM,
SCM, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_with_thread_10) (scm_thread*, SCM, SCM, SCM, SCM,
SCM, SCM, SCM, SCM, SCM, SCM);
+
+#define SCM_AS_SUBR_WITH_THREAD(fn) \
+ _Generic (fn, \
+ scm_t_subr_with_thread_0 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_1 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_2 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_3 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_4 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_5 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_6 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_7 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_8 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_9 : (scm_t_subr) fn, \
+ scm_t_subr_with_thread_10 : (scm_t_subr) fn, \
+ default: fn)
+
struct scm_program;
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index ce0df76b8..d45a5bce1 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -529,48 +529,43 @@ scm_apply_subr (struct scm_thread *t,
SCM (*subr)() = scm_subr_function_by_index (idx);
size_t nargs = scm_subr_has_closure_argument (idx) ? nslots : nslots - 1;
-#define ARG(i) (sp[i].as_scm)
+#define A(i) (sp[i].as_scm)
if (scm_subr_has_thread_argument (idx))
{
switch (nargs)
{
case 0:
- return subr (t);
+ return ((scm_t_subr_with_thread_0) subr) (t);
case 1:
- return subr (t,
- ARG (0));
+ return ((scm_t_subr_with_thread_1) subr)
+ (t, A (0));
case 2:
- return subr (t,
- ARG (1), ARG (0));
+ return ((scm_t_subr_with_thread_2) subr)
+ (t, A (1), A (0));
case 3:
- return subr (t,
- ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_with_thread_3) subr)
+ (t, A (2), A (1), A (0));
case 4:
- return subr (t,
- ARG (3), ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_with_thread_4) subr)
+ (t, A (3), A (2), A (1), A (0));
case 5:
- return subr (t,
- ARG (4), ARG (3), ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_with_thread_5) subr)
+ (t, A (4), A (3), A (2), A (1), A (0));
case 6:
- return subr (t,
- ARG (5), ARG (4), ARG (3), ARG (2), ARG (1),
- ARG (0));
+ return ((scm_t_subr_with_thread_6) subr)
+ (t, A (5), A (4), A (3), A (2), A (1), A (0));
case 7:
- return subr (t,
- ARG (6), ARG (5), ARG (4), ARG (3), ARG (2),
- ARG (1), ARG (0));
+ return ((scm_t_subr_with_thread_7) subr)
+ (t, A (6), A (5), A (4), A (3), A (2), A (1), A (0));
case 8:
- return subr (t,
- ARG (7), ARG (6), ARG (5), ARG (4), ARG (3),
- ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_with_thread_8) subr)
+ (t, A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
case 9:
- return subr (t,
- ARG (8), ARG (7), ARG (6), ARG (5), ARG (4),
- ARG (3), ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_with_thread_9) subr)
+ (t, A (8), A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
case 10:
- return subr (t,
- ARG (9), ARG (8), ARG (7), ARG (6), ARG (5),
- ARG (4), ARG (3), ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_with_thread_10) subr)
+ (t, A (9), A (8), A (7), A (6), A (5), A (4), A (3), A (2), A (1),
A (0));
default:
abort (); /* SCM_GSUBR_MAX */
}
@@ -580,37 +575,42 @@ scm_apply_subr (struct scm_thread *t,
switch (nargs)
{
case 0:
- return subr ();
+ return ((scm_t_subr_0) subr) ();
case 1:
- return subr (ARG (0));
+ return ((scm_t_subr_1) subr)
+ (A (0));
case 2:
- return subr (ARG (1), ARG (0));
+ return ((scm_t_subr_2) subr)
+ (A (1), A (0));
case 3:
- return subr (ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_3) subr)
+ (A (2), A (1), A (0));
case 4:
- return subr (ARG (3), ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_4) subr)
+ (A (3), A (2), A (1), A (0));
case 5:
- return subr (ARG (4), ARG (3), ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_5) subr)
+ (A (4), A (3), A (2), A (1), A (0));
case 6:
- return subr (ARG (5), ARG (4), ARG (3), ARG (2), ARG (1),
- ARG (0));
+ return ((scm_t_subr_6) subr)
+ (A (5), A (4), A (3), A (2), A (1), A (0));
case 7:
- return subr (ARG (6), ARG (5), ARG (4), ARG (3), ARG (2),
- ARG (1), ARG (0));
+ return ((scm_t_subr_7) subr)
+ (A (6), A (5), A (4), A (3), A (2), A (1), A (0));
case 8:
- return subr (ARG (7), ARG (6), ARG (5), ARG (4), ARG (3),
- ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_8) subr)
+ (A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
case 9:
- return subr (ARG (8), ARG (7), ARG (6), ARG (5), ARG (4),
- ARG (3), ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_9) subr)
+ (A (8), A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
case 10:
- return subr (ARG (9), ARG (8), ARG (7), ARG (6), ARG (5),
- ARG (4), ARG (3), ARG (2), ARG (1), ARG (0));
+ return ((scm_t_subr_10) subr)
+ (A (9), A (8), A (7), A (6), A (5), A (4), A (3), A (2), A (1), A
(0));
default:
abort (); /* SCM_GSUBR_MAX */
}
}
-#undef ARG
+#undef A
}
SCM
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index f214c46f9..c06188a0e 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -39,6 +39,33 @@
SCM_API scm_t_subr scm_subr_function (SCM subr);
SCM_API SCM scm_subr_name (SCM subr);
+typedef SCM (*scm_t_subr_0) (void);
+typedef SCM (*scm_t_subr_1) (SCM);
+typedef SCM (*scm_t_subr_2) (SCM, SCM);
+typedef SCM (*scm_t_subr_3) (SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_4) (SCM, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_5) (SCM, SCM, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_6) (SCM, SCM, SCM, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_7) (SCM, SCM, SCM, SCM, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_8) (SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_9) (SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM);
+typedef SCM (*scm_t_subr_10) (SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM,
SCM);
+
+#define SCM_AS_SUBR(fn) \
+ _Generic (fn, \
+ scm_t_subr_0 : (scm_t_subr) fn, \
+ scm_t_subr_1 : (scm_t_subr) fn, \
+ scm_t_subr_2 : (scm_t_subr) fn, \
+ scm_t_subr_3 : (scm_t_subr) fn, \
+ scm_t_subr_4 : (scm_t_subr) fn, \
+ scm_t_subr_5 : (scm_t_subr) fn, \
+ scm_t_subr_6 : (scm_t_subr) fn, \
+ scm_t_subr_7 : (scm_t_subr) fn, \
+ scm_t_subr_8 : (scm_t_subr) fn, \
+ scm_t_subr_9 : (scm_t_subr) fn, \
+ scm_t_subr_10 : (scm_t_subr) fn, \
+ default: fn)
+
SCM_API SCM scm_c_make_gsubr (const char *name,
int req, int opt, int rst, scm_t_subr fcn);
SCM_API SCM scm_c_make_gsubr_with_generic (const char *name,
@@ -61,8 +88,7 @@ SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
SCM FNAME ARGLIST\
)\
SCM_SNARF_INIT(\
-scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
- (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
+scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, SCM_AS_SUBR (FNAME)); \
)\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
@@ -78,8 +104,7 @@ SCM FNAME ARGLIST\
SCM_SNARF_INIT(\
g_ ## FNAME = SCM_PACK (0); \
scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \
- (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME, \
- &g_ ## FNAME); \
+ SCM_AS_SUBR (FNAME), &g_ ## FNAME); \
)\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
@@ -89,8 +114,7 @@ SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
SCM FNAME ARGLIST\
)\
SCM_SNARF_INIT(\
-scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
- (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
+scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, SCM_AS_SUBR (FNAME)); \
scm_c_export (s_ ## FNAME, NULL); \
)\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
@@ -101,20 +125,17 @@ static const char s_ ## FNAME [] = PRIMNAME; \
static SCM FNAME ARGLIST\
)\
SCM_SNARF_INIT(\
-scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
- (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
+scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, SCM_AS_SUBR (FNAME)); \
)\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
-SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
- (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
+SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, SCM_AS_SUBR (CFN)))
#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
-SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
- (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
+SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, SCM_AS_SUBR (CFN));)
\
SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
"implemented by the C function \"" #CFN "\"")
@@ -124,8 +145,7 @@ SCM_UNUSED static const char RANAME[]=STR;\
static SCM GF \
)SCM_SNARF_INIT(\
GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
-scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \
- (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
+scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, SCM_AS_SUBR (CFN),
&GF) \
)
diff --git a/libguile/hash.c b/libguile/hash.c
index e3643aee1..9f84557d4 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -48,10 +48,6 @@
-#ifndef floor
-extern double floor();
-#endif
-
/* This hash function is originally from
http://burtleburtle.net/bob/c/lookup3.c by Bob Jenkins, May 2006,
diff --git a/libguile/init.c b/libguile/init.c
index 2f7f9b3e7..460704203 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -266,7 +266,8 @@ static void *invoke_main_func(void *body_data);
void
-scm_boot_guile (int argc, char ** argv, void (*main_func) (), void *closure)
+scm_boot_guile (int argc, char ** argv,
+ void (*main_func) (void *, int, char **), void *closure)
{
void *res;
struct main_func_closure c;
diff --git a/libguile/jit.c b/libguile/jit.c
index b8f0e9593..a448de9f9 100644
--- a/libguile/jit.c
+++ b/libguile/jit.c
@@ -155,7 +155,8 @@ static int jit_log_level = 0;
/* Entry trampoline: saves registers, initializes THREAD and SP
registers, and jumps into mcode. */
-static void (*enter_mcode) (scm_thread *thread, const uint8_t *mcode);
+typedef void (*enter_mcode_t) (scm_thread *thread, const uint8_t *mcode);
+static enter_mcode_t enter_mcode;
/* Exit trampoline: restores registers and returns to interpreter. */
static void *exit_mcode;
@@ -6200,7 +6201,7 @@ initialize_jit (void)
jit_pointer_t enter_mcode_addr = emit_code (j, emit_entry_trampoline);
ASSERT (enter_mcode_addr);
- enter_mcode = jit_address_to_function_pointer (enter_mcode_addr);
+ enter_mcode = (enter_mcode_t) jit_address_to_function_pointer
(enter_mcode_addr);
handle_interrupts_trampoline =
emit_code (j, emit_handle_interrupts_trampoline);
diff --git a/libguile/load.c b/libguile/load.c
index 320c1e590..1939eb98b 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1369,7 +1369,7 @@ scm_init_load ()
scm_c_define ("load-compiled",
scm_c_make_gsubr ("load-compiled/vm", 1, 0, 0,
- scm_load_compiled_with_vm));
+ SCM_AS_SUBR (scm_load_compiled_with_vm)));
init_build_info ();
diff --git a/libguile/loader.c b/libguile/loader.c
index b9ddc6698..f4c0533fc 100644
--- a/libguile/loader.c
+++ b/libguile/loader.c
@@ -886,7 +886,7 @@ scm_init_loader (void)
#endif
scm_c_define_gsubr ("find-mapped-elf-image", 1, 0, 0,
- (scm_t_subr) scm_find_mapped_elf_image);
+ SCM_AS_SUBR (scm_find_mapped_elf_image));
scm_c_define_gsubr ("all-mapped-elf-images", 0, 0, 0,
- (scm_t_subr) scm_all_mapped_elf_images);
+ SCM_AS_SUBR (scm_all_mapped_elf_images));
}
diff --git a/libguile/macros.c b/libguile/macros.c
index 1a8a10dff..32a23ee04 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -252,5 +252,6 @@ scm_init_macros ()
#include "macros.x"
syntax_session_id = fresh_syntax_session_id();
- scm_c_define_gsubr ("syntax-session-id", 0, 0, 0, scm_syntax_session_id);
+ scm_c_define_gsubr ("syntax-session-id", 0, 0, 0,
+ SCM_AS_SUBR (scm_syntax_session_id));
}
diff --git a/libguile/memoize.c b/libguile/memoize.c
index e35ea5be2..b3a62b701 100644
--- a/libguile/memoize.c
+++ b/libguile/memoize.c
@@ -902,14 +902,14 @@ scm_init_memoize ()
{
#include "memoize.x"
- wind = scm_c_make_gsubr ("wind", 2, 0, 0, do_wind);
- unwind = scm_c_make_gsubr ("unwind", 0, 0, 0, do_unwind);
- push_fluid = scm_c_make_gsubr ("push-fluid", 2, 0, 0, do_push_fluid);
- pop_fluid = scm_c_make_gsubr ("pop-fluid", 0, 0, 0, do_pop_fluid);
+ wind = scm_c_make_gsubr ("wind", 2, 0, 0, SCM_AS_SUBR (do_wind));
+ unwind = scm_c_make_gsubr ("unwind", 0, 0, 0, SCM_AS_SUBR (do_unwind));
+ push_fluid = scm_c_make_gsubr ("push-fluid", 2, 0, 0, SCM_AS_SUBR
(do_push_fluid));
+ pop_fluid = scm_c_make_gsubr ("pop-fluid", 0, 0, 0, SCM_AS_SUBR
(do_pop_fluid));
push_dynamic_state = scm_c_make_gsubr ("push-dynamic_state", 1, 0, 0,
- do_push_dynamic_state);
+ SCM_AS_SUBR (do_push_dynamic_state));
pop_dynamic_state = scm_c_make_gsubr ("pop-dynamic_state", 0, 0, 0,
- do_pop_dynamic_state);
+ SCM_AS_SUBR (do_pop_dynamic_state));
list_of_guile = scm_list_1 (scm_from_latin1_symbol ("guile"));
}
diff --git a/libguile/pairs.c b/libguile/pairs.c
index 783077493..be9b8f034 100644
--- a/libguile/pairs.c
+++ b/libguile/pairs.c
@@ -358,8 +358,8 @@ void
scm_init_pairs ()
{
#include "pairs.x"
- scm_c_define_gsubr ("cons", 2, 0, 0, scm_cons);
- scm_c_define_gsubr ("car", 1, 0, 0, scm_car);
- scm_c_define_gsubr ("cdr", 1, 0, 0, scm_cdr);
+ scm_c_define_gsubr ("cons", 2, 0, 0, SCM_AS_SUBR (scm_cons));
+ scm_c_define_gsubr ("car", 1, 0, 0, SCM_AS_SUBR (scm_car));
+ scm_c_define_gsubr ("cdr", 1, 0, 0, SCM_AS_SUBR (scm_cdr));
}
diff --git a/libguile/poll.c b/libguile/poll.c
index efc52efc6..85a614306 100644
--- a/libguile/poll.c
+++ b/libguile/poll.c
@@ -192,7 +192,8 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM
timeout)
static void
scm_init_poll (void)
{
- scm_c_define_gsubr ("primitive-poll", 4, 0, 0, scm_primitive_poll);
+ scm_c_define_gsubr ("primitive-poll", 4, 0, 0,
+ SCM_AS_SUBR (scm_primitive_poll));
scm_c_define ("%sizeof-struct-pollfd", scm_from_size_t (sizeof (struct
pollfd)));
#ifdef POLLIN
diff --git a/libguile/ports.c b/libguile/ports.c
index d21786dc3..5058e73c3 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -4211,10 +4211,10 @@ scm_init_ports (void)
trampoline_to_c_read_subr =
scm_c_make_gsubr ("port-read", 4, 0, 0,
- (scm_t_subr) trampoline_to_c_read);
+ SCM_AS_SUBR (trampoline_to_c_read));
trampoline_to_c_write_subr =
scm_c_make_gsubr ("port-write", 4, 0, 0,
- (scm_t_subr) trampoline_to_c_write);
+ SCM_AS_SUBR (trampoline_to_c_write));
scm_void_port_type = scm_make_port_type ("void", void_port_read,
void_port_write);
@@ -4246,26 +4246,26 @@ scm_init_ports (void)
/* Used by `include'. */
scm_c_define_gsubr ("set-port-encoding!", 2, 0, 0,
- (scm_t_subr) scm_set_port_encoding_x);
+ SCM_AS_SUBR (scm_set_port_encoding_x));
scm_c_define_gsubr (s_scm_eof_object_p, 1, 0, 0,
- (scm_t_subr) scm_eof_object_p);
+ SCM_AS_SUBR (scm_eof_object_p));
/* Used by a number of error/warning-printing routines. */
scm_c_define_gsubr (s_scm_force_output, 0, 1, 0,
- (scm_t_subr) scm_force_output);
+ SCM_AS_SUBR (scm_force_output));
/* Used by `file-exists?' and related functions if `stat' is
unavailable. */
scm_c_define_gsubr (s_scm_close_port, 1, 0, 0,
- (scm_t_subr) scm_close_port);
+ SCM_AS_SUBR (scm_close_port));
/* Used by error routines. */
scm_c_define_gsubr (s_scm_current_error_port, 0, 0, 0,
- (scm_t_subr) scm_current_error_port);
+ SCM_AS_SUBR (scm_current_error_port));
scm_c_define_gsubr (s_scm_current_warning_port, 0, 0, 0,
- (scm_t_subr) scm_current_warning_port);
+ SCM_AS_SUBR (scm_current_warning_port));
/* Used by welcome and compiler routines. */
scm_c_define_gsubr (s_scm_current_info_port, 0, 0, 0,
- (scm_t_subr) scm_current_info_port);
+ SCM_AS_SUBR (scm_current_info_port));
}
diff --git a/libguile/posix.c b/libguile/posix.c
index 3e75b6992..39efe213f 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -980,9 +980,7 @@ SCM_DEFINE (scm_getpgrp, "getpgrp", 0, 0, 0,
"This is the POSIX definition, not BSD.")
#define FUNC_NAME s_scm_getpgrp
{
- int (*fn)();
- fn = (int (*) ()) getpgrp;
- return scm_from_int (fn (0));
+ return scm_from_int (getpgrp ());
}
#undef FUNC_NAME
#endif /* HAVE_GETPGRP */
@@ -2596,7 +2594,7 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
static void
scm_init_popen (void)
{
- scm_c_define_gsubr ("piped-process", 2, 2, 0, scm_piped_process);
+ scm_c_define_gsubr ("piped-process", 2, 2, 0, SCM_AS_SUBR
(scm_piped_process));
}
diff --git a/libguile/rdelim.c b/libguile/rdelim.c
index 9e96d73bd..e4f239b8c 100644
--- a/libguile/rdelim.c
+++ b/libguile/rdelim.c
@@ -213,5 +213,5 @@ void
scm_init_rdelim (void)
{
scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
- scm_init_rdelim_builtins);
+ SCM_AS_SUBR (scm_init_rdelim_builtins));
}
diff --git a/libguile/rw.c b/libguile/rw.c
index 624310dc0..4bb921e82 100644
--- a/libguile/rw.c
+++ b/libguile/rw.c
@@ -283,5 +283,6 @@ scm_init_rw_builtins ()
void
scm_init_rw ()
{
- scm_c_define_gsubr ("%init-rw-builtins", 0, 0, 0, scm_init_rw_builtins);
+ scm_c_define_gsubr ("%init-rw-builtins", 0, 0, 0,
+ SCM_AS_SUBR (scm_init_rw_builtins));
}
diff --git a/libguile/smob.c b/libguile/smob.c
index c1564315c..2d4cbaf31 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -95,28 +95,28 @@ static SCM scm_smob_trampolines[16];
static SCM
apply_0 (SCM smob)
{
- SCM (*subr)() = SCM_SMOB_DESCRIPTOR (smob).apply;
+ scm_t_subr_1 subr = (scm_t_subr_1) SCM_SMOB_DESCRIPTOR (smob).apply;
return subr (smob);
}
static SCM
apply_1 (SCM smob, SCM a)
{
- SCM (*subr)() = SCM_SMOB_DESCRIPTOR (smob).apply;
+ scm_t_subr_2 subr = (scm_t_subr_2) SCM_SMOB_DESCRIPTOR (smob).apply;
return subr (smob, a);
}
static SCM
apply_2 (SCM smob, SCM a, SCM b)
{
- SCM (*subr)() = SCM_SMOB_DESCRIPTOR (smob).apply;
+ scm_t_subr_3 subr = (scm_t_subr_3) SCM_SMOB_DESCRIPTOR (smob).apply;
return subr (smob, a, b);
}
static SCM
apply_3 (SCM smob, SCM a, SCM b, SCM c)
{
- SCM (*subr)() = SCM_SMOB_DESCRIPTOR (smob).apply;
+ scm_t_subr_4 subr = (scm_t_subr_4) SCM_SMOB_DESCRIPTOR (smob).apply;
return subr (smob, a, b, c);
}
@@ -139,19 +139,19 @@ scm_smob_trampoline (unsigned int nreq, unsigned int nopt,
/* The + 1 is for the smob itself. */
case 0:
trampoline = scm_c_make_gsubr ("apply-smob/0", nreq + 1, nopt, rest,
- apply_0);
+ SCM_AS_SUBR (apply_0));
break;
case 1:
trampoline = scm_c_make_gsubr ("apply-smob/1", nreq + 1, nopt, rest,
- apply_1);
+ SCM_AS_SUBR (apply_1));
break;
case 2:
trampoline = scm_c_make_gsubr ("apply-smob/2", nreq + 1, nopt, rest,
- apply_2);
+ SCM_AS_SUBR (apply_2));
break;
case 3:
trampoline = scm_c_make_gsubr ("apply-smob/3", nreq + 1, nopt, rest,
- apply_3);
+ SCM_AS_SUBR (apply_3));
break;
default:
abort ();
diff --git a/libguile/smob.h b/libguile/smob.h
index 091f5c66a..6df4db516 100644
--- a/libguile/smob.h
+++ b/libguile/smob.h
@@ -104,7 +104,8 @@ SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
#define SCM_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
SCM_SNARF_HERE(static SCM c_name arglist) \
-SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
+SCM_SNARF_INIT(scm_set_smob_apply((tag), SCM_AS_SUBR (c_name), \
+ (req), (opt), (rest));)
#define SCM_GLOBAL_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
SCM_SNARF_HERE(SCM c_name arglist) \
diff --git a/libguile/vm.c b/libguile/vm.c
index f879fd771..376b63937 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -418,9 +418,9 @@ static void
scm_init_vm_builtins (void)
{
scm_c_define_gsubr ("builtin-name->index", 1, 0, 0,
- scm_vm_builtin_name_to_index);
+ SCM_AS_SUBR (scm_vm_builtin_name_to_index));
scm_c_define_gsubr ("builtin-index->name", 1, 0, 0,
- scm_vm_builtin_index_to_name);
+ SCM_AS_SUBR (scm_vm_builtin_index_to_name));
}
static uint32_t*
