diff --git a/.gitignore b/.gitignore index 3df721c2b..0da4af79b 100644 --- a/.gitignore +++ b/.gitignore @@ -74,3 +74,4 @@ libguile/stack-limit-calibration.scm cscope.out cscope.files *.log +/libguile/snarf-gsubr.h 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 */