From c79d5bd0f7675bcd3c2d4bdf1a34f9a32316ee99 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 26 Jun 2025 15:56:16 +0200 Subject: [PATCH] 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*