summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
Diffstat (limited to 'libguile')
-rw-r--r--libguile/Makefile.am24
-rw-r--r--libguile/procs.h34
-rw-r--r--libguile/snarf.h71
3 files changed, 123 insertions, 6 deletions
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index fe06c01c6..b2762e351 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -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
diff --git a/libguile/procs.h b/libguile/procs.h
index bdace4a9f..1e273512a 100644
--- a/libguile/procs.h
+++ b/libguile/procs.h
@@ -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
*/
diff --git a/libguile/snarf.h b/libguile/snarf.h
index 5e4c77c6e..451323c1b 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -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 */