mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-01 15:20:34 +02:00
Code Activity

Change to be less sloppy as regards functions without prototypes

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2025-06-26 15:56:16 +02:00
parent a7d7ff5019
commit c79d5bd0f7
30 changed files with 180 additions and 130 deletions
Download patch file Download diff file Expand all files Collapse all files

3
libguile/backtrace.c
View file

@ -323,6 +323,7 @@ scm_backtrace (void)
void void
scm_init_backtrace () 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" #include "backtrace.x"
} }

2
libguile/control.c
View file

@ -152,7 +152,7 @@ static void
scm_init_ice_9_control (void *unused) scm_init_ice_9_control (void *unused)
{ {
scm_c_define_gsubr ("suspendable-continuation?", 1, 0, 0, scm_c_define_gsubr ("suspendable-continuation?", 1, 0, 0,
scm_suspendable_continuation_p); SCM_AS_SUBR (scm_suspendable_continuation_p));
} }
void void

10
libguile/dynl.c
View file

@ -195,13 +195,13 @@ scm_init_dynamic_linking ()
// FIXME: Deprecate all of these, once (system foreign-library) has // FIXME: Deprecate all of these, once (system foreign-library) has
// had enough time in the world. // had enough time in the world.
scm_c_define_gsubr 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 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 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 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 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));
} }

4
libguile/eval.c
View file

@ -1001,14 +1001,14 @@ scm_init_eval ()
{ {
SCM primitive_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 = apply_boot_closure_code =
scm_allocate_subr_code (scm_from_utf8_symbol ("boot-closure"), 0, 0, 1, scm_allocate_subr_code (scm_from_utf8_symbol ("boot-closure"), 0, 0, 1,
apply_boot_closure, SCM_F_SUBR_CLOSURE); apply_boot_closure, SCM_F_SUBR_CLOSURE);
primitive_eval = scm_c_make_gsubr ("primitive-eval", 1, 0, 0, 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), var_primitive_eval = scm_define (SCM_SUBR_NAME (primitive_eval),
primitive_eval); primitive_eval);

5
libguile/exceptions.c
View file

@ -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 prompt_tag = scm_cons (SCM_INUM0, SCM_EOL);
scm_thread *t = SCM_I_CURRENT_THREAD; scm_thread *t = SCM_I_CURRENT_THREAD;
scm_t_dynstack *dynstack = &t->dynstack; scm_t_dynstack *dynstack = &t->dynstack;
scm_t_dynamic_state *dynamic_state = &t->dynamic_state;
jmp_buf registers; jmp_buf registers;
jmp_buf *prev_registers; jmp_buf *prev_registers;
ptrdiff_t saved_stack_depth; ptrdiff_t saved_stack_depth;
@ -524,11 +523,11 @@ scm_init_exceptions ()
raise_exception_var = raise_exception_var =
scm_c_define ("raise-exception", scm_c_define ("raise-exception",
scm_c_make_gsubr ("raise-exception", 1, 0, 0, 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_define ("%init-exceptions!",
scm_c_make_gsubr ("%init-exceptions!", 3, 0, 0, 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" #include "exceptions.x"
} }

3
libguile/expand.c
View file

@ -1562,7 +1562,8 @@ scm_init_expand ()
const_unbound = const_unbound =
CONST_ (scm_list_1 (scm_from_latin1_symbol ("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)); scm_c_define ("%expanded-vtables", scm_vector (exp_vtable_list));

5
libguile/finalizers.c
View file

@ -565,8 +565,9 @@ scm_init_finalizers (void)
{ {
/* When the async is to run, the cdr of the pair gets set to the /* When the async is to run, the cdr of the pair gets set to the
asyncs queue of the current thread. */ asyncs queue of the current thread. */
run_finalizers_subr = scm_c_make_gsubr ("%run-finalizers", 0, 0, 0, run_finalizers_subr =
run_finalizers_async_thunk); scm_c_make_gsubr ("%run-finalizers", 0, 0, 0,
SCM_AS_SUBR (run_finalizers_async_thunk));
if (automatic_finalization_p) if (automatic_finalization_p)
{ {

4
libguile/fluids.c
View file

@ -491,7 +491,7 @@ SCM_DEFINE (scm_with_fluids, "with-fluids*", 3, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
SCM 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" #define FUNC_NAME "scm_c_with_fluids"
{ {
SCM ans; SCM ans;
@ -529,7 +529,7 @@ scm_with_fluid (SCM fluid, SCM value, SCM thunk)
} }
SCM 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" #define FUNC_NAME "scm_c_with_fluid"
{ {
SCM ans; SCM ans;

2
libguile/fports.c
View file

@ -788,7 +788,7 @@ scm_init_fports ()
/* Used by `include' and also by `file-exists?' if `stat' is /* Used by `include' and also by `file-exists?' if `stat' is
unavailable. */ 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. */ /* Used by `open-file.', also via C. */
sym_relative = scm_from_latin1_symbol ("relative"); sym_relative = scm_from_latin1_symbol ("relative");

8
libguile/frames.c
View file

@ -478,13 +478,13 @@ static void
scm_init_frames_builtins (void *unused) scm_init_frames_builtins (void *unused)
{ {
scm_c_define_gsubr (s_scm_frame_num_locals, 1, 0, 0, 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_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_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_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 void

7
libguile/gc.c
View file

@ -712,9 +712,10 @@ scm_init_gc ()
{ {
/* When the async is to run, the cdr of the gc_async pair gets set to /* When the async is to run, the cdr of the gc_async pair gets set to
the asyncs queue of the current thread. */ 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_cell =
after_gc_async_thunk), scm_cons (scm_c_make_gsubr ("%after-gc-thunk", 0, 0, 0,
SCM_BOOL_F); SCM_AS_SUBR (after_gc_async_thunk)),
SCM_BOOL_F);
gc_heap_set_allocation_failure_handler (the_gc_heap, scm_oom_fn); gc_heap_set_allocation_failure_handler (the_gc_heap, scm_oom_fn);

27
libguile/gsubr-internal.h
View file

@ -33,6 +33,33 @@
#define SCM_PRIMITIVE_P(x) (scm_is_primitive (x)) #define SCM_PRIMITIVE_P(x) (scm_is_primitive (x))
#define SCM_PRIMITIVE_GENERIC_P(x) (scm_is_primitive_generic (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; struct scm_program;

88
libguile/gsubr.c
View file

@ -529,48 +529,43 @@ scm_apply_subr (struct scm_thread *t,
SCM (*subr)() = scm_subr_function_by_index (idx); SCM (*subr)() = scm_subr_function_by_index (idx);
size_t nargs = scm_subr_has_closure_argument (idx) ? nslots : nslots - 1; 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)) if (scm_subr_has_thread_argument (idx))
{ {
switch (nargs) switch (nargs)
{ {
case 0: case 0:
return subr (t); return ((scm_t_subr_with_thread_0) subr) (t);
case 1: case 1:
return subr (t, return ((scm_t_subr_with_thread_1) subr)
ARG (0)); (t, A (0));
case 2: case 2:
return subr (t, return ((scm_t_subr_with_thread_2) subr)
ARG (1), ARG (0)); (t, A (1), A (0));
case 3: case 3:
return subr (t, return ((scm_t_subr_with_thread_3) subr)
ARG (2), ARG (1), ARG (0)); (t, A (2), A (1), A (0));
case 4: case 4:
return subr (t, return ((scm_t_subr_with_thread_4) subr)
ARG (3), ARG (2), ARG (1), ARG (0)); (t, A (3), A (2), A (1), A (0));
case 5: case 5:
return subr (t, return ((scm_t_subr_with_thread_5) subr)
ARG (4), ARG (3), ARG (2), ARG (1), ARG (0)); (t, A (4), A (3), A (2), A (1), A (0));
case 6: case 6:
return subr (t, return ((scm_t_subr_with_thread_6) subr)
ARG (5), ARG (4), ARG (3), ARG (2), ARG (1), (t, A (5), A (4), A (3), A (2), A (1), A (0));
ARG (0));
case 7: case 7:
return subr (t, return ((scm_t_subr_with_thread_7) subr)
ARG (6), ARG (5), ARG (4), ARG (3), ARG (2), (t, A (6), A (5), A (4), A (3), A (2), A (1), A (0));
ARG (1), ARG (0));
case 8: case 8:
return subr (t, return ((scm_t_subr_with_thread_8) subr)
ARG (7), ARG (6), ARG (5), ARG (4), ARG (3), (t, A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
ARG (2), ARG (1), ARG (0));
case 9: case 9:
return subr (t, return ((scm_t_subr_with_thread_9) subr)
ARG (8), ARG (7), ARG (6), ARG (5), ARG (4), (t, A (8), A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
ARG (3), ARG (2), ARG (1), ARG (0));
case 10: case 10:
return subr (t, return ((scm_t_subr_with_thread_10) subr)
ARG (9), ARG (8), ARG (7), ARG (6), ARG (5), (t, A (9), A (8), A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
ARG (4), ARG (3), ARG (2), ARG (1), ARG (0));
default: default:
abort (); /* SCM_GSUBR_MAX */ abort (); /* SCM_GSUBR_MAX */
} }
@ -580,37 +575,42 @@ scm_apply_subr (struct scm_thread *t,
switch (nargs) switch (nargs)
{ {
case 0: case 0:
return subr (); return ((scm_t_subr_0) subr) ();
case 1: case 1:
return subr (ARG (0)); return ((scm_t_subr_1) subr)
(A (0));
case 2: case 2:
return subr (ARG (1), ARG (0)); return ((scm_t_subr_2) subr)
(A (1), A (0));
case 3: case 3:
return subr (ARG (2), ARG (1), ARG (0)); return ((scm_t_subr_3) subr)
(A (2), A (1), A (0));
case 4: 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: 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: case 6:
return subr (ARG (5), ARG (4), ARG (3), ARG (2), ARG (1), return ((scm_t_subr_6) subr)
ARG (0)); (A (5), A (4), A (3), A (2), A (1), A (0));
case 7: case 7:
return subr (ARG (6), ARG (5), ARG (4), ARG (3), ARG (2), return ((scm_t_subr_7) subr)
ARG (1), ARG (0)); (A (6), A (5), A (4), A (3), A (2), A (1), A (0));
case 8: case 8:
return subr (ARG (7), ARG (6), ARG (5), ARG (4), ARG (3), return ((scm_t_subr_8) subr)
ARG (2), ARG (1), ARG (0)); (A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
case 9: case 9:
return subr (ARG (8), ARG (7), ARG (6), ARG (5), ARG (4), return ((scm_t_subr_9) subr)
ARG (3), ARG (2), ARG (1), ARG (0)); (A (8), A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
case 10: case 10:
return subr (ARG (9), ARG (8), ARG (7), ARG (6), ARG (5), return ((scm_t_subr_10) subr)
ARG (4), ARG (3), ARG (2), ARG (1), ARG (0)); (A (9), A (8), A (7), A (6), A (5), A (4), A (3), A (2), A (1), A (0));
default: default:
abort (); /* SCM_GSUBR_MAX */ abort (); /* SCM_GSUBR_MAX */
} }
} }
#undef ARG #undef A
} }
SCM SCM

48
libguile/gsubr.h
View file

@ -39,6 +39,33 @@
SCM_API scm_t_subr scm_subr_function (SCM subr); SCM_API scm_t_subr scm_subr_function (SCM subr);
SCM_API SCM scm_subr_name (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, SCM_API SCM scm_c_make_gsubr (const char *name,
int req, int opt, int rst, scm_t_subr fcn); int req, int opt, int rst, scm_t_subr fcn);
SCM_API SCM scm_c_make_gsubr_with_generic (const char *name, 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 FNAME ARGLIST\
)\ )\
SCM_SNARF_INIT(\ SCM_SNARF_INIT(\
scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \ scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, SCM_AS_SUBR (FNAME)); \
(SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
)\ )\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
@ -78,8 +104,7 @@ SCM FNAME ARGLIST\
SCM_SNARF_INIT(\ SCM_SNARF_INIT(\
g_ ## FNAME = SCM_PACK (0); \ g_ ## FNAME = SCM_PACK (0); \
scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \ scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \
(SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME, \ SCM_AS_SUBR (FNAME), &g_ ## FNAME); \
&g_ ## FNAME); \
)\ )\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) 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 FNAME ARGLIST\
)\ )\
SCM_SNARF_INIT(\ SCM_SNARF_INIT(\
scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \ scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, SCM_AS_SUBR (FNAME)); \
(SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
scm_c_export (s_ ## FNAME, NULL); \ scm_c_export (s_ ## FNAME, NULL); \
)\ )\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) 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\ static SCM FNAME ARGLIST\
)\ )\
SCM_SNARF_INIT(\ SCM_SNARF_INIT(\
scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \ scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, SCM_AS_SUBR (FNAME)); \
(SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
)\ )\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ #define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \ SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \ SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, SCM_AS_SUBR (CFN)))
(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \ SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \ SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, SCM_AS_SUBR (CFN));) \
(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \ SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
"implemented by the C function \"" #CFN "\"") "implemented by the C function \"" #CFN "\"")
@ -124,8 +145,7 @@ SCM_UNUSED static const char RANAME[]=STR;\
static SCM GF \ static SCM GF \
)SCM_SNARF_INIT(\ )SCM_SNARF_INIT(\
GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \ 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_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, SCM_AS_SUBR (CFN), &GF) \
(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
) )

4
libguile/hash.c
View file

@ -48,10 +48,6 @@
#ifndef floor
extern double floor();
#endif
/* This hash function is originally from /* This hash function is originally from
http://burtleburtle.net/bob/c/lookup3.c by Bob Jenkins, May 2006, http://burtleburtle.net/bob/c/lookup3.c by Bob Jenkins, May 2006,

3
libguile/init.c
View file

@ -266,7 +266,8 @@ static void *invoke_main_func(void *body_data);
void 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; void *res;
struct main_func_closure c; struct main_func_closure c;

5
libguile/jit.c
View file

@ -155,7 +155,8 @@ static int jit_log_level = 0;
/* Entry trampoline: saves registers, initializes THREAD and SP /* Entry trampoline: saves registers, initializes THREAD and SP
registers, and jumps into mcode. */ 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. */ /* Exit trampoline: restores registers and returns to interpreter. */
static void *exit_mcode; static void *exit_mcode;
@ -6200,7 +6201,7 @@ initialize_jit (void)
jit_pointer_t enter_mcode_addr = emit_code (j, emit_entry_trampoline); jit_pointer_t enter_mcode_addr = emit_code (j, emit_entry_trampoline);
ASSERT (enter_mcode_addr); 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 = handle_interrupts_trampoline =
emit_code (j, emit_handle_interrupts_trampoline); emit_code (j, emit_handle_interrupts_trampoline);

2
libguile/load.c
View file

@ -1369,7 +1369,7 @@ scm_init_load ()
scm_c_define ("load-compiled", scm_c_define ("load-compiled",
scm_c_make_gsubr ("load-compiled/vm", 1, 0, 0, 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 (); init_build_info ();

4
libguile/loader.c
View file

@ -886,7 +886,7 @@ scm_init_loader (void)
#endif #endif
scm_c_define_gsubr ("find-mapped-elf-image", 1, 0, 0, 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_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));
} }

3
libguile/macros.c
View file

@ -252,5 +252,6 @@ scm_init_macros ()
#include "macros.x" #include "macros.x"
syntax_session_id = fresh_syntax_session_id(); 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));
} }

12
libguile/memoize.c
View file

@ -902,14 +902,14 @@ scm_init_memoize ()
{ {
#include "memoize.x" #include "memoize.x"
wind = scm_c_make_gsubr ("wind", 2, 0, 0, do_wind); wind = scm_c_make_gsubr ("wind", 2, 0, 0, SCM_AS_SUBR (do_wind));
unwind = scm_c_make_gsubr ("unwind", 0, 0, 0, do_unwind); 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, do_push_fluid); 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, do_pop_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, 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, 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")); list_of_guile = scm_list_1 (scm_from_latin1_symbol ("guile"));
} }

6
libguile/pairs.c
View file

@ -358,8 +358,8 @@ void
scm_init_pairs () scm_init_pairs ()
{ {
#include "pairs.x" #include "pairs.x"
scm_c_define_gsubr ("cons", 2, 0, 0, scm_cons); scm_c_define_gsubr ("cons", 2, 0, 0, SCM_AS_SUBR (scm_cons));
scm_c_define_gsubr ("car", 1, 0, 0, scm_car); scm_c_define_gsubr ("car", 1, 0, 0, SCM_AS_SUBR (scm_car));
scm_c_define_gsubr ("cdr", 1, 0, 0, scm_cdr); scm_c_define_gsubr ("cdr", 1, 0, 0, SCM_AS_SUBR (scm_cdr));
} }

3
libguile/poll.c
View file

@ -192,7 +192,8 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM timeout)
static void static void
scm_init_poll (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))); scm_c_define ("%sizeof-struct-pollfd", scm_from_size_t (sizeof (struct pollfd)));
#ifdef POLLIN #ifdef POLLIN

18
libguile/ports.c
View file

@ -4211,10 +4211,10 @@ scm_init_ports (void)
trampoline_to_c_read_subr = trampoline_to_c_read_subr =
scm_c_make_gsubr ("port-read", 4, 0, 0, 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 = trampoline_to_c_write_subr =
scm_c_make_gsubr ("port-write", 4, 0, 0, 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, scm_void_port_type = scm_make_port_type ("void", void_port_read,
void_port_write); void_port_write);
@ -4246,26 +4246,26 @@ scm_init_ports (void)
/* Used by `include'. */ /* Used by `include'. */
scm_c_define_gsubr ("set-port-encoding!", 2, 0, 0, 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_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. */ /* Used by a number of error/warning-printing routines. */
scm_c_define_gsubr (s_scm_force_output, 0, 1, 0, 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 /* Used by `file-exists?' and related functions if `stat' is
unavailable. */ unavailable. */
scm_c_define_gsubr (s_scm_close_port, 1, 0, 0, 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. */ /* Used by error routines. */
scm_c_define_gsubr (s_scm_current_error_port, 0, 0, 0, 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_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. */ /* Used by welcome and compiler routines. */
scm_c_define_gsubr (s_scm_current_info_port, 0, 0, 0, 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));
} }

6
libguile/posix.c
View file

@ -980,9 +980,7 @@ SCM_DEFINE (scm_getpgrp, "getpgrp", 0, 0, 0,
"This is the POSIX definition, not BSD.") "This is the POSIX definition, not BSD.")
#define FUNC_NAME s_scm_getpgrp #define FUNC_NAME s_scm_getpgrp
{ {
int (*fn)(); return scm_from_int (getpgrp ());
fn = (int (*) ()) getpgrp;
return scm_from_int (fn (0));
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_GETPGRP */ #endif /* HAVE_GETPGRP */
@ -2596,7 +2594,7 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
static void static void
scm_init_popen (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));
} }

2
libguile/rdelim.c
View file

@ -213,5 +213,5 @@ void
scm_init_rdelim (void) scm_init_rdelim (void)
{ {
scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0, scm_c_define_gsubr ("%init-rdelim-builtins", 0, 0, 0,
scm_init_rdelim_builtins); SCM_AS_SUBR (scm_init_rdelim_builtins));
} }

3
libguile/rw.c
View file

@ -283,5 +283,6 @@ scm_init_rw_builtins ()
void void
scm_init_rw () 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));
} }

16
libguile/smob.c
View file

@ -95,28 +95,28 @@ static SCM scm_smob_trampolines[16];
static SCM static SCM
apply_0 (SCM smob) 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); return subr (smob);
} }
static SCM static SCM
apply_1 (SCM smob, SCM a) 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); return subr (smob, a);
} }
static SCM static SCM
apply_2 (SCM smob, SCM a, SCM b) 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); return subr (smob, a, b);
} }
static SCM static SCM
apply_3 (SCM smob, SCM a, SCM b, SCM c) 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); 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. */ /* The + 1 is for the smob itself. */
case 0: case 0:
trampoline = scm_c_make_gsubr ("apply-smob/0", nreq + 1, nopt, rest, trampoline = scm_c_make_gsubr ("apply-smob/0", nreq + 1, nopt, rest,
apply_0); SCM_AS_SUBR (apply_0));
break; break;
case 1: case 1:
trampoline = scm_c_make_gsubr ("apply-smob/1", nreq + 1, nopt, rest, trampoline = scm_c_make_gsubr ("apply-smob/1", nreq + 1, nopt, rest,
apply_1); SCM_AS_SUBR (apply_1));
break; break;
case 2: case 2:
trampoline = scm_c_make_gsubr ("apply-smob/2", nreq + 1, nopt, rest, trampoline = scm_c_make_gsubr ("apply-smob/2", nreq + 1, nopt, rest,
apply_2); SCM_AS_SUBR (apply_2));
break; break;
case 3: case 3:
trampoline = scm_c_make_gsubr ("apply-smob/3", nreq + 1, nopt, rest, trampoline = scm_c_make_gsubr ("apply-smob/3", nreq + 1, nopt, rest,
apply_3); SCM_AS_SUBR (apply_3));
break; break;
default: default:
abort (); abort ();

3
libguile/smob.h
View file

@ -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) \ #define SCM_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
SCM_SNARF_HERE(static SCM c_name 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) \ #define SCM_GLOBAL_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
SCM_SNARF_HERE(SCM c_name arglist) \ SCM_SNARF_HERE(SCM c_name arglist) \

4
libguile/vm.c
View file

@ -418,9 +418,9 @@ static void
scm_init_vm_builtins (void) scm_init_vm_builtins (void)
{ {
scm_c_define_gsubr ("builtin-name->index", 1, 0, 0, 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_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* static uint32_t*