From 499b5dfa3eff74f525ba07b6c865a970c056a6cb Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 20 Jan 2009 23:29:09 +0100 Subject: Add `SCM_SET_SUBR_GENERIC ()' to replace `SCM_SUBR_GENERIC ()' as an lvalue. * libguile/goops.c (scm_c_extend_primitive_generic): Use `SCM_SET_SUBR_GENERIC ()' instead of using `SCM_SUBR_GENERIC ()' as an lvalue. * libguile/procs.c (scm_c_make_subr_with_generic): Use `SCM_SET_SUBR_GENERIC_LOC ()'. * libguile/procs.h (SCM_SET_SUBR_GENERIC, SCM_SET_SUBR_GENERIC_LOC): New macros. --- libguile/procs.h | 2 ++ 1 file changed, 2 insertions(+) (limited to 'libguile/procs.h') diff --git a/libguile/procs.h b/libguile/procs.h index 122187cb9..c2fc7589a 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -47,6 +47,8 @@ typedef struct #define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x)) #define SCM_SUBR_PROPS(x) (SCM_SUBR_ENTRY (x).properties) #define SCM_SUBR_GENERIC(x) (SCM_SUBR_ENTRY (x).generic) +#define SCM_SET_SUBR_GENERIC(x, g) (*SCM_SUBR_ENTRY (x).generic = (g)) +#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SUBR_ENTRY (x).generic = (g)) #define SCM_CCLO_LENGTH(x) (SCM_CELL_WORD_0 (x) >> 8) #define SCM_MAKE_CCLO_TAG(v) (((v) << 8) + scm_tc7_cclo) -- cgit v1.2.3 From 2ee5aa25dbd679b175707762f5961585027e1397 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 21 Jan 2009 00:24:44 +0100 Subject: Use double-cells to store subrs. * libguile/procs.c (scm_subr_table, scm_subr_table_size, scm_subr_table_room, subr_table_gc_hint, scm_init_subr_table): Remove. (scm_c_make_subr): Simply return a double-cell, with the procedure name and properties stored in a two-element array. * libguile/init.c (scm_i_init_guile): Remove call to `scm_init_subr_table ()'. * libguile/procs.h (SCM_SUBR_META_INFO): New macro. (SCM_SNAME, SCM_SUBR_PROPS): Use it. (SCM_SUBR_GENERIC, SCM_SET_SUBR_GENERIC, SCM_SET_SUBR_GENERIC_LOC): Update. (scm_t_subr_entry, SCM_SUBR_ENTRY, SCM_SUBRNUM, scm_subr_table, scm_init_subr_table): Remove. --- libguile/init.c | 3 +-- libguile/procs.c | 48 ++++++++++-------------------------------------- libguile/procs.h | 25 ++++++------------------- 3 files changed, 17 insertions(+), 59 deletions(-) (limited to 'libguile/procs.h') diff --git a/libguile/init.c b/libguile/init.c index 2d5c94340..56c34c8bc 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -446,7 +446,6 @@ scm_i_init_guile (SCM_STACKITEM *base) scm_struct_prehistory (); /* requires storage */ scm_symbols_prehistory (); /* requires storage */ - scm_init_subr_table (); #if 0 scm_environments_prehistory (); /* requires storage */ #endif diff --git a/libguile/procs.c b/libguile/procs.c index fa32277fe..307be4380 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -37,45 +37,26 @@ /* {Procedures} */ -scm_t_subr_entry *scm_subr_table; /* libguile contained approx. 700 primitive procedures on 24 Aug 1999. */ /* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on startup, 786 with guile-readline. 'martin */ -static unsigned long scm_subr_table_size = 0; -static unsigned long scm_subr_table_room = 800; - -/* Hint for `scm_gc_malloc ()' and friends. */ -static const char subr_table_gc_hint[] = "subr table"; - -SCM +SCM scm_c_make_subr (const char *name, long type, SCM (*fcn) ()) { register SCM z; - unsigned long entry; + SCM *meta_info; - if (scm_subr_table_size == scm_subr_table_room) - { - long new_size = scm_subr_table_room * 3 / 2; - void *new_table - = scm_gc_realloc (scm_subr_table, - sizeof (* scm_subr_table) * scm_subr_table_room, - sizeof (* scm_subr_table) * new_size, - subr_table_gc_hint); - scm_subr_table = new_table; - scm_subr_table_room = new_size; - } + meta_info = scm_gc_malloc (2 * sizeof (* meta_info), + "subr meta-info"); + meta_info[0] = scm_from_locale_symbol (name); + meta_info[1] = SCM_EOL; /* properties */ + + z = scm_double_cell ((scm_t_bits) type, (scm_t_bits) fcn, + 0 /* generic */, (scm_t_bits) meta_info); - entry = scm_subr_table_size; - z = scm_cell ((entry << 8) + type, (scm_t_bits) fcn); - scm_subr_table[entry].handle = z; - scm_subr_table[entry].name = scm_from_locale_symbol (name); - scm_subr_table[entry].generic = 0; - scm_subr_table[entry].properties = SCM_EOL; - scm_subr_table_size++; - return z; } @@ -327,16 +308,7 @@ scm_setter (SCM proc) return SCM_BOOL_F; /* not reached */ } - -void -scm_init_subr_table () -{ - scm_subr_table - = ((scm_t_subr_entry *) - scm_gc_malloc (sizeof (* scm_subr_table) * scm_subr_table_room, - subr_table_gc_hint)); -} - + void scm_init_procs () { diff --git a/libguile/procs.h b/libguile/procs.h index c2fc7589a..bdace4a9f 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -30,25 +30,14 @@ /* Subrs */ -typedef struct -{ - SCM handle; /* link back to procedure object */ - SCM name; - SCM *generic; /* 0 if no generic support - * *generic == 0 until first method - */ - SCM properties; /* procedure properties */ -} scm_t_subr_entry; - -#define SCM_SUBRNUM(subr) (SCM_CELL_WORD_0 (subr) >> 8) -#define SCM_SUBR_ENTRY(x) (scm_subr_table[SCM_SUBRNUM (x)]) -#define SCM_SNAME(x) (SCM_SUBR_ENTRY (x).name) +#define SCM_SUBR_META_INFO(x) ((SCM *) SCM_CELL_WORD_3 (x)) +#define SCM_SNAME(x) (SCM_SUBR_META_INFO (x) [0]) #define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x)) #define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x)) -#define SCM_SUBR_PROPS(x) (SCM_SUBR_ENTRY (x).properties) -#define SCM_SUBR_GENERIC(x) (SCM_SUBR_ENTRY (x).generic) -#define SCM_SET_SUBR_GENERIC(x, g) (*SCM_SUBR_ENTRY (x).generic = (g)) -#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SUBR_ENTRY (x).generic = (g)) +#define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1]) +#define SCM_SUBR_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x)) +#define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g)) +#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) g)) #define SCM_CCLO_LENGTH(x) (SCM_CELL_WORD_0 (x) >> 8) #define SCM_MAKE_CCLO_TAG(v) (((v) << 8) + scm_tc7_cclo) @@ -126,7 +115,6 @@ typedef struct #define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj) #define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj) -SCM_API scm_t_subr_entry *scm_subr_table; @@ -146,7 +134,6 @@ SCM_API SCM scm_procedure_with_setter_p (SCM obj); SCM_API SCM scm_make_procedure_with_setter (SCM procedure, SCM setter); SCM_API SCM scm_procedure (SCM proc); SCM_API SCM scm_setter (SCM proc); -SCM_INTERNAL void scm_init_subr_table (void); SCM_INTERNAL void scm_init_procs (void); #ifdef GUILE_DEBUG -- cgit v1.2.3 From 46f9baf49a8ea4461e8494c75a88b87d0f5c5195 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 31 Jan 2009 21:52:30 +0100 Subject: 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 | 1 + libguile/Makefile.am | 24 ++++++++++++++---- libguile/procs.h | 34 +++++++++++++++++++++++++ libguile/snarf.h | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 124 insertions(+), 6 deletions(-) (limited to 'libguile/procs.h') 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 */ -- cgit v1.2.3 From f0eb5ae6c173aed35965b0561897fda1d8ff0db1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 16 Mar 2009 19:13:41 +0100 Subject: Allow the static allocation of all types of subrs. This is a follow-up to 46f9baf49a8ea4461e8494c75a88b87d0f5c5195 ("Allow the static initialization of subrs.") and e20d7001c3f7150400169fecb0bf0eefdf122fe2 ("Remove "compiled closures" ("cclos") in favor of a simpler mechanism."). * libguile/procs.h (SCM_SUBR_ARITY_TO_TYPE): Return the appropriate type for gsubrs instead of returning -1. * libguile/Makefile.am (snarf-gsubr.h): Remove target. (BUILT_SOURCES, nodist_modinclude_HEADERS, MOSTLYCLEANFILES): Remove `snarf-gsubr.h'. * libguile/snarf.h (SCM_DEFINE)[SCM_SUPPORT_STATIC_ALLOCATION]: Don't include "libguile/snarf-gsubr.h". (SCM_DEFINE_SUBR_reqX_optY_rstZ): Remove. --- .gitignore | 1 - libguile/Makefile.am | 24 ++++--------------- libguile/procs.h | 68 ++++++++++++++++++++++++++++------------------------ libguile/snarf.h | 32 ++----------------------- 4 files changed, 43 insertions(+), 82 deletions(-) (limited to 'libguile/procs.h') diff --git a/.gitignore b/.gitignore index 43545aedb..7644deacd 100644 --- a/.gitignore +++ b/.gitignore @@ -74,5 +74,4 @@ libguile/stack-limit-calibration.scm cscope.out cscope.files *.log -/libguile/snarf-gsubr.h INSTALL diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 885de72c4..9b05f01be 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -77,21 +77,6 @@ scmconfig.h: ${top_builddir}/config.h gen-scmconfig$(EXEEXT) rm -f scmconfig.h mv scmconfig.h.tmp scmconfig.h -# Generate aliases for `SCM_DEFINE_GSUBR'. Since there's a lot of -# them, it's an efficient compression method. -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. @@ -181,8 +166,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 snarf-gsubr.h \ +BUILT_SOURCES = cpp_err_symbols.c cpp_sig_symbols.c libpath.h \ + version.h scmconfig.h \ $(DOT_X_FILES) $(EXTRA_DOT_X_FILES) EXTRA_libguile_la_SOURCES = _scm.h \ @@ -239,7 +224,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 snarf-gsubr.h +nodist_modinclude_HEADERS = version.h scmconfig.h bin_SCRIPTS = guile-snarf @@ -424,8 +409,7 @@ 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 snarf-gsubr.h snarf-gsubr.h.tmp \ - stack-limit-calibration.scm + scmconfig.h scmconfig.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 e2dec99d0..18857c62e 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -39,37 +39,43 @@ #define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g)) #define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) g)) -/* 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)) +/* Return the most suitable subr type for a subr with REQ required arguments, + OPT optional arguments, and REST (0 or 1) arguments. 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 \ + : scm_tc7_gsubr \ + | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))))) \ + : ((opt) == 1 \ + ? ((req) == 0 \ + ? scm_tc7_subr_1o \ + : ((req) == 1 \ + ? scm_tc7_subr_2o \ + : scm_tc7_gsubr | \ + (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))) \ + : scm_tc7_gsubr | \ + (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))) \ + : ((rest) == 1 \ + ? ((opt) == 0 \ + ? ((req) == 0 \ + ? scm_tc7_lsubr \ + : ((req) == 2 \ + ? scm_tc7_lsubr_2 \ + : scm_tc7_gsubr \ + | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))) \ + : scm_tc7_gsubr \ + | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U)) \ + : scm_tc7_gsubr \ + | (SCM_GSUBR_MAKTYPE (req, opt, rest) << 8U))) diff --git a/libguile/snarf.h b/libguile/snarf.h index 451323c1b..c3113e1a7 100644 --- a/libguile/snarf.h +++ b/libguile/snarf.h @@ -97,8 +97,8 @@ 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) \ +/* Static subr allocation. */ +#define SCM_DEFINE(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; \ @@ -116,34 +116,6 @@ SCM_SNARF_INIT( \ ) \ 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. */ -- cgit v1.2.3