#ifndef SCM_SNARF_H
#define SCM_SNARF_H
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+ * 2004, 2006, 2009, 2010, 2011, 2014 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 License
/* Macros for snarfing initialization actions from C source. */
-#if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF)
+/* Casting to a function that can take any number of arguments. */
+#define SCM_FUNC_CAST_ARBITRARY_ARGS scm_t_subr
-/* This used to be "SCM (*)(...)" but GCC on RedHat 7.1 doesn't seem
- to like it.
- */
-#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
-
-#else
-#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
-#endif
-#if (defined SCM_ALIGNED) && (SCM_DEBUG_TYPING_STRICTNESS <= 1)
+#ifdef SCM_ALIGNED
/* We support static allocation of some `SCM' objects. */
# define SCM_SUPPORT_STATIC_ALLOCATION
#endif
* The SCM_SNARF_INIT text goes into the corresponding .x file
* up through the first occurrence of SCM_SNARF_DOC_START on that
* line, if any.
+ *
+ * Some debugging options can cause the preprocessor to echo #define
+ * directives to its output. Keeping the snarfing markers on separate
+ * lines prevents guile-snarf from inadvertently snarfing the definition
+ * of SCM_SNARF_INIT if those options are in effect.
*/
#ifdef SCM_MAGIC_SNARF_INITS
# define SCM_SNARF_HERE(X)
-# define SCM_SNARF_INIT(X) ^^ X ^:^
+# define SCM_SNARF_INIT_PREFIX ^^
+# define SCM_SNARF_INIT(X) SCM_SNARF_INIT_PREFIX X ^:^
# define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
#else
# ifdef SCM_MAGIC_SNARF_DOCS
#define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
+SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
SCM FNAME ARGLIST\
)\
SCM_SNARF_INIT(\
#ifdef SCM_SUPPORT_STATIC_ALLOCATION
/* Static subr allocation. */
+/* FIXME: how to verify that req + opt + rest < 11, all are positive, etc? */
#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; \
- SCM_IMMUTABLE_SUBR (scm_i_paste (FNAME, __subr), \
- scm_i_paste (FNAME, __name), \
- REQ, OPT, VAR, &FNAME); \
+SCM_SNARF_HERE( \
+ SCM_UNUSED static const char scm_i_paste (s_, FNAME) [] = PRIMNAME; \
+ SCM_API SCM FNAME ARGLIST; \
+ SCM_IMMUTABLE_POINTER (scm_i_paste (FNAME, __subr_foreign), \
+ (scm_t_bits) &FNAME); /* the subr */ \
+ SCM_STATIC_SUBR_OBJVECT (scm_i_paste (FNAME, __raw_objtable), \
+ /* FIXME: directly be the foreign */ \
+ SCM_BOOL_F); \
+ /* FIXME: be immutable. grr */ \
+ SCM_STATIC_PROGRAM (scm_i_paste (FNAME, __subr), \
+ SCM_BOOL_F, \
+ SCM_PACK (&scm_i_paste (FNAME, __raw_objtable)), \
+ SCM_BOOL_F); \
SCM FNAME ARGLIST \
) \
-SCM_SNARF_INIT( \
+SCM_SNARF_INIT( \
+ /* Initialize the foreign. */ \
+ scm_i_paste (FNAME, __raw_objtable)[2] = scm_i_paste (FNAME, __subr_foreign); \
/* Initialize the procedure name (an interned symbol). */ \
- scm_i_paste (FNAME, __subr_meta_info)[0] = scm_i_paste (FNAME, __name); \
+ scm_i_paste (FNAME, __raw_objtable)[3] = scm_i_paste (FNAME, __name); \
+ /* Initialize the objcode trampoline. */ \
+ SCM_SET_CELL_OBJECT (scm_i_paste (FNAME, __subr), 1, \
+ scm_subr_objcode_trampoline (REQ, OPT, VAR)); \
\
/* Define the subr. */ \
- scm_c_define (scm_i_paste (s_, FNAME), scm_i_paste (FNAME, __subr)); \
+ scm_define (scm_i_paste (FNAME, __name), scm_i_paste (FNAME, __subr)); \
) \
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
#define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
+SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
static SCM g_ ## FNAME; \
SCM FNAME ARGLIST\
)\
#define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
+SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
SCM FNAME ARGLIST\
)\
SCM_SNARF_INIT(\
)\
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
-#define SCM_DEFINE1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
-SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
-SCM FNAME ARGLIST\
-)\
-SCM_SNARF_INIT(scm_c_define_subr (s_ ## FNAME, TYPE, FNAME); ) \
-SCM_SNARF_DOCS(1, FNAME, PRIMNAME, ARGLIST, 2, 0, 0, DOCSTRING)
-
-#define SCM_PRIMITIVE_GENERIC_1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
-SCM_SNARF_HERE(\
-static const char s_ ## FNAME [] = PRIMNAME; \
-static SCM g_ ## FNAME; \
-SCM FNAME ARGLIST\
-)\
-SCM_SNARF_INIT(\
-g_ ## FNAME = SCM_PACK (0); \
-scm_c_define_subr_with_generic (s_ ## FNAME, TYPE, FNAME, &g_ ## FNAME); \
-)\
-SCM_SNARF_DOCS(1, FNAME, PRIMNAME, ARGLIST, 2, 0, 0, DOCSTRING)
-
#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
-SCM_SNARF_HERE(static const char RANAME[]=STR) \
+SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
-SCM_SNARF_HERE(static const char RANAME[]=STR) \
+SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
SCM_SNARF_HERE(\
-static const char RANAME[]=STR;\
+SCM_UNUSED static const char RANAME[]=STR;\
static SCM GF \
)SCM_SNARF_INIT(\
GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
(SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
)
-#define SCM_PROC1(RANAME, STR, TYPE, CFN) \
-SCM_SNARF_HERE(static const char RANAME[]=STR) \
-SCM_SNARF_INIT(\
-scm_c_define_subr (RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN) \
-)
-
-
-#define SCM_GPROC1(RANAME, STR, TYPE, CFN, GF) \
-SCM_SNARF_HERE(\
-static const char RANAME[]=STR; \
-static SCM GF \
-)SCM_SNARF_INIT(\
-GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
-scm_c_define_subr_with_generic (RANAME, TYPE, \
- (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
-)
-
-#define SCM_SYNTAX(RANAME, STR, TYPE, CFN) \
-SCM_SNARF_HERE(static const char RANAME[]=STR)\
-SCM_SNARF_INIT(scm_make_synt (RANAME, TYPE, CFN))
-
#ifdef SCM_SUPPORT_STATIC_ALLOCATION
# define SCM_SYMBOL(c_name, scheme_name) \
# define SCM_SYMBOL(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name)))
+SCM_SNARF_INIT(c_name = scm_from_locale_symbol (scheme_name))
# define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
SCM_SNARF_HERE(SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name)))
+SCM_SNARF_INIT(c_name = scm_from_locale_symbol (scheme_name))
#endif /* !SCM_SUPPORT_STATIC_ALLOCATION */
#define SCM_KEYWORD(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_keyword (scheme_name)))
+SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name))
#define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
SCM_SNARF_HERE(SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_keyword (scheme_name)))
+SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name))
#define SCM_VARIABLE(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, SCM_BOOL_F));)
+SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
#define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \
SCM_SNARF_HERE(SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, SCM_BOOL_F));)
+SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
#define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \
SCM_SNARF_HERE(static SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, init_val));)
+SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
#define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \
SCM_SNARF_HERE(SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, init_val));)
+SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
#define SCM_MUTEX(c_name) \
SCM_SNARF_HERE(static scm_t_mutex c_name) \
#ifdef SCM_SUPPORT_STATIC_ALLOCATION
+#define SCM_IMMUTABLE_CELL(c_name, car, cdr) \
+ static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell \
+ c_name ## _raw_scell = \
+ { \
+ SCM_PACK (car), \
+ SCM_PACK (cdr) \
+ }; \
+ static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_scell)
+
#define SCM_IMMUTABLE_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \
static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell \
c_name ## _raw_cell [2] = \
}; \
static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_cell)
+#define SCM_STATIC_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \
+ static SCM_ALIGNED (8) SCM_UNUSED scm_t_cell \
+ c_name ## _raw_cell [2] = \
+ { \
+ { SCM_PACK (car), SCM_PACK (cbr) }, \
+ { SCM_PACK (ccr), SCM_PACK (cdr) } \
+ }; \
+ static SCM_UNUSED SCM c_name = SCM_PACK (& c_name ## _raw_cell)
+
#define SCM_IMMUTABLE_STRINGBUF(c_name, contents) \
static SCM_UNUSED const \
struct \
(scm_t_bits) &scm_i_paste (c_name, \
_stringbuf), \
(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));
+ (scm_t_bits) (sizeof (contents) - 1))
+
+#define SCM_IMMUTABLE_POINTER(c_name, ptr) \
+ SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr)
+
+/* for primitive-generics, add a foreign to the end */
+#define SCM_STATIC_SUBR_OBJVECT(c_name, foreign) \
+ static SCM_ALIGNED (8) SCM c_name[4] = \
+ { \
+ SCM_PACK (scm_tc7_vector | (2 << 8)), \
+ SCM_PACK (0), \
+ foreign, \
+ SCM_BOOL_F, /* the name */ \
+ }
+
+#define SCM_STATIC_PROGRAM(c_name, objcode, objtable, freevars) \
+ static SCM_ALIGNED (8) SCM_UNUSED SCM \
+ scm_i_paste (c_name, _raw_cell)[] = \
+ { \
+ SCM_PACK (scm_tc7_program | SCM_F_PROGRAM_IS_PRIMITIVE), \
+ objcode, \
+ objtable, \
+ freevars \
+ }; \
+ static SCM_UNUSED const SCM c_name = \
+ SCM_PACK (& scm_i_paste (c_name, _raw_cell))
#endif /* SCM_SUPPORT_STATIC_ALLOCATION */
HCoop / bpt / guile.git / blobdiff