mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Allow the static initialization of subrs.
* libguile/Makefile.am (snarf-gsubr.h): New target. (BUILT_SOURCES, nodist_modinclude_HEADERS, MOSTLYCLEANFILES): Add `snarf-gsubr.h'. * libguile/procs.h (SCM_SUBR_ARITY_TO_TYPE): New macro. * libguile/snarf.h (SCM_DEFINE): Rename to... (SCM_DEFINE_GSUBR): this. (SCM_DEFINE_SUBR)[SCM_SUPPORT_STATIC_ALLOCATION]: New macro. (SCM_DEFINE_SUBR_reqX_optY_rstZ)[SCM_SUPPORT_STATIC_ALLOCATION]: New set of macros. (SCM_IMMUTABLE_SUBR): New macro.
This commit is contained in:
Ludovic Courtès
parent
6eca5d2b9b
commit
46f9baf49a
4 changed files with 124 additions and 6 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -74,3 +74,4 @@ libguile/stack-limit-calibration.scm
|
|||
cscope.out
|
||||
cscope.files
|
||||
*.log
|
||||
/libguile/snarf-gsubr.h
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
## Process this file with Automake to create Makefile.in
|
||||
##
|
||||
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
|
||||
##
|
||||
## This file is part of GUILE.
|
||||
##
|
||||
|
|
@ -77,6 +77,19 @@ scmconfig.h: ${top_builddir}/config.h gen-scmconfig$(EXEEXT)
|
|||
rm -f scmconfig.h
|
||||
mv scmconfig.h.tmp scmconfig.h
|
||||
|
||||
snarf-gsubr.h:
|
||||
( echo "/* Automatically generated, do not edit. */" ; \
|
||||
for req in `seq 0 16`; do \
|
||||
for opt in `seq 0 16`; do \
|
||||
for rst in 0 1; do \
|
||||
echo "#ifndef SCM_DEFINE_SUBR_req$${req}_opt$${opt}_rst$${rst}" ; \
|
||||
echo "# define SCM_DEFINE_SUBR_req$${req}_opt$${opt}_rst$${rst} SCM_DEFINE_GSUBR" ; \
|
||||
echo "#endif" ; \
|
||||
done ; \
|
||||
done ; \
|
||||
done ) > "$@.tmp"
|
||||
mv "$@.tmp" "$@"
|
||||
|
||||
guile_filter_doc_snarfage_SOURCES = c-tokenize.c
|
||||
|
||||
## Override default rule; this should be compiled for BUILD host.
|
||||
|
|
@ -166,8 +179,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \
|
|||
|
||||
EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
|
||||
|
||||
BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h \
|
||||
version.h scmconfig.h \
|
||||
BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h \
|
||||
version.h scmconfig.h snarf-gsubr.h \
|
||||
$(DOT_X_FILES) $(EXTRA_DOT_X_FILES)
|
||||
|
||||
EXTRA_libguile_la_SOURCES = _scm.h \
|
||||
|
|
@ -224,7 +237,7 @@ modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h \
|
|||
pthread-threads.h null-threads.h throw.h unif.h values.h \
|
||||
variable.h vectors.h vports.h weaks.h
|
||||
|
||||
nodist_modinclude_HEADERS = version.h scmconfig.h
|
||||
nodist_modinclude_HEADERS = version.h scmconfig.h snarf-gsubr.h
|
||||
|
||||
bin_SCRIPTS = guile-snarf
|
||||
|
||||
|
|
@ -409,7 +422,8 @@ MOSTLYCLEANFILES = \
|
|||
cpp_err_symbols_here cpp_err_symbols_diff cpp_err_symbols_new \
|
||||
cpp_sig_symbols_here cpp_sig_symbols_diff cpp_sig_symbols_new \
|
||||
version.h version.h.tmp \
|
||||
scmconfig.h scmconfig.h.tmp stack-limit-calibration.scm
|
||||
scmconfig.h scmconfig.h.tmp snarf-gsubr.h snarf-gsubr.h.tmp \
|
||||
stack-limit-calibration.scm
|
||||
|
||||
CLEANFILES = libpath.h *.x *.doc guile-procedures.txt guile-procedures.texi guile.texi
|
||||
|
||||
|
|
|
|||
|
|
@ -51,6 +51,40 @@
|
|||
#define SCM_CCLO_SUBR(x) (SCM_CCLO_REF ((x), 0))
|
||||
#define SCM_SET_CCLO_SUBR(x, v) (SCM_CCLO_SET ((x), 0, (v)))
|
||||
|
||||
/* Return the subr type corresponding to the given arity. If the arity
|
||||
doesn't match that of a subr (e.g., too many arguments), then -1 is
|
||||
returned. This has to be in sync with `create_gsubr ()'. */
|
||||
#define SCM_SUBR_ARITY_TO_TYPE(req, opt, rest) \
|
||||
((rest) == 0 \
|
||||
? ((opt) == 0 \
|
||||
? ((req) == 0 \
|
||||
? scm_tc7_subr_0 \
|
||||
: ((req) == 1 \
|
||||
? scm_tc7_subr_1 \
|
||||
: ((req) == 2 \
|
||||
? scm_tc7_subr_2 \
|
||||
: ((req) == 3 \
|
||||
? scm_tc7_subr_3 \
|
||||
: -1)))) \
|
||||
: ((opt) == 1 \
|
||||
? ((req) == 0 \
|
||||
? scm_tc7_subr_1o \
|
||||
: ((req) == 1 \
|
||||
? scm_tc7_subr_2o \
|
||||
: -1)) \
|
||||
: -1)) \
|
||||
: ((rest) == 1 \
|
||||
? ((opt) == 0 \
|
||||
? ((req) == 0 \
|
||||
? scm_tc7_lsubr \
|
||||
: ((req) == 2 \
|
||||
? scm_tc7_lsubr_2 \
|
||||
: -1)) \
|
||||
: -1) \
|
||||
: -1))
|
||||
|
||||
|
||||
|
||||
/* Closures
|
||||
*/
|
||||
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@ DOCSTRING ^^ }
|
|||
# endif
|
||||
#endif
|
||||
|
||||
#define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||||
#define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||||
SCM_SNARF_HERE(\
|
||||
static const char s_ ## FNAME [] = PRIMNAME; \
|
||||
SCM FNAME ARGLIST\
|
||||
|
|
@ -95,6 +95,63 @@ scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
|
|||
)\
|
||||
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
|
||||
|
||||
#ifdef SCM_SUPPORT_STATIC_ALLOCATION
|
||||
|
||||
/* Regular "subrs", i.e., few arguments. */
|
||||
#define SCM_DEFINE_SUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||||
SCM_SYMBOL (scm_i_paste (FNAME, __name), PRIMNAME); \
|
||||
SCM_SNARF_HERE( \
|
||||
static const char scm_i_paste (s_, FNAME) [] = PRIMNAME; \
|
||||
SCM_IMMUTABLE_SUBR (scm_i_paste (FNAME, __subr), \
|
||||
scm_i_paste (FNAME, __name), \
|
||||
REQ, OPT, VAR, &FNAME); \
|
||||
SCM FNAME ARGLIST \
|
||||
) \
|
||||
SCM_SNARF_INIT( \
|
||||
/* Initialize the procedure name (an interned symbol). */ \
|
||||
scm_i_paste (FNAME, __subr_meta_info)[0] = scm_i_paste (FNAME, __name); \
|
||||
\
|
||||
/* Define the subr. */ \
|
||||
scm_c_define (scm_i_paste (s_, FNAME), scm_i_paste (FNAME, __subr)); \
|
||||
) \
|
||||
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
|
||||
|
||||
/* XXX: Eventually, we could statically allocate gsubrs as well. */
|
||||
|
||||
/* These are the subrs whose arity makes it possible to define them as "raw
|
||||
subrs" (as opposed to "gsubrs"). This has to be consistent with
|
||||
`SCM_SUBR_ARITY_TO_TYPE ()' and `create_gsubr ()'. */
|
||||
#define SCM_DEFINE_SUBR_req0_opt0_rst0 SCM_DEFINE_SUBR
|
||||
#define SCM_DEFINE_SUBR_req1_opt0_rst0 SCM_DEFINE_SUBR
|
||||
#define SCM_DEFINE_SUBR_req0_opt1_rst0 SCM_DEFINE_SUBR
|
||||
#define SCM_DEFINE_SUBR_req1_opt1_rst0 SCM_DEFINE_SUBR
|
||||
#define SCM_DEFINE_SUBR_req2_opt0_rst0 SCM_DEFINE_SUBR
|
||||
#define SCM_DEFINE_SUBR_req3_opt0_rst0 SCM_DEFINE_SUBR
|
||||
#define SCM_DEFINE_SUBR_req0_opt0_rst1 SCM_DEFINE_SUBR
|
||||
#define SCM_DEFINE_SUBR_req2_opt0_rst1 SCM_DEFINE_SUBR
|
||||
|
||||
/* For any other combination of required/optional/rest arguments, use
|
||||
`SCM_DEFINE_GSUBR (). */
|
||||
#include "libguile/snarf-gsubr.h"
|
||||
|
||||
/* The generic subr definition macro. This macro dispatches to either
|
||||
`SCM_DEFINE_SUBR ()' or `SCM_DEFINE_GSUBR ()' depending on the arity of
|
||||
the subr being defined. */
|
||||
#define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||||
SCM_DEFINE_SUBR_req ## REQ ## _opt ## OPT ## _rst ## VAR \
|
||||
(FNAME, PRIMNAME, \
|
||||
REQ, OPT, VAR, \
|
||||
ARGLIST, DOCSTRING)
|
||||
|
||||
|
||||
#else /* !SCM_SUPPORT_STATIC_ALLOCATION */
|
||||
|
||||
/* Always use the generic subr case. */
|
||||
#define SCM_DEFINE SCM_DEFINE_GSUBR
|
||||
|
||||
#endif /* !SCM_SUPPORT_STATIC_ALLOCATION */
|
||||
|
||||
|
||||
#define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||||
SCM_SNARF_HERE(\
|
||||
static const char s_ ## FNAME [] = PRIMNAME; \
|
||||
|
|
@ -332,6 +389,18 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
|
|||
(scm_t_bits) 0, \
|
||||
(scm_t_bits) sizeof (contents) - 1)
|
||||
|
||||
#define SCM_IMMUTABLE_SUBR(c_name, name, req, opt, rest, fcn) \
|
||||
static SCM_UNUSED SCM scm_i_paste (c_name, _meta_info)[2] = \
|
||||
{ \
|
||||
SCM_BOOL_F, /* The name, initialized at run-time. */ \
|
||||
SCM_EOL /* The procedure properties. */ \
|
||||
}; \
|
||||
SCM_IMMUTABLE_DOUBLE_CELL (c_name, \
|
||||
SCM_SUBR_ARITY_TO_TYPE (req, opt, rest), \
|
||||
(scm_t_bits) fcn, \
|
||||
(scm_t_bits) 0 /* no generic */, \
|
||||
(scm_t_bits) & scm_i_paste (c_name, _meta_info));
|
||||
|
||||
#endif /* SCM_SUPPORT_STATIC_ALLOCATION */
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue