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.

.gitignore

@@ -74,3 +74,4 @@ libguile/stack-limit-calibration.scm
 cscope.out
 cscope.files
 *.log
+/libguile/snarf-gsubr.h

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 \
+BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h	\
-    version.h scmconfig.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
 

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

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