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
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"
}

2
libguile/control.c
View file

@ -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

10
libguile/dynl.c
View file

@ -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));
}

4
libguile/eval.c
View file

@ -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);

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_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"
}

3
libguile/expand.c
View file

@ -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));

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
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)
{

4
libguile/fluids.c
View file

@ -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;

2
libguile/fports.c
View file

@ -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");

8
libguile/frames.c
View file

@ -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

5
libguile/gc.c
View file

@ -712,8 +712,9 @@ 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),
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);

27
libguile/gsubr-internal.h
View file

@ -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;

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);
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

48
libguile/gsubr.h
View file

@ -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) \
)

4
libguile/hash.c
View file

@ -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,

3
libguile/init.c
View file

@ -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;

5
libguile/jit.c
View file

@ -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);

2
libguile/load.c
View file

@ -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 ();

4
libguile/loader.c
View file

@ -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));
}

3
libguile/macros.c
View file

@ -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));
}

12
libguile/memoize.c
View file

@ -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"));
}

6
libguile/pairs.c
View file

@ -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));
}

3
libguile/poll.c
View file

@ -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

18
libguile/ports.c
View file

@ -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));
}

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.")
#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));
}

2
libguile/rdelim.c
View file

@ -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));
}

3
libguile/rw.c
View file

@ -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));
}

16
libguile/smob.c
View file

@ -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 ();

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) \
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) \

4
libguile/vm.c
View file

@ -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*