6 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
7 * 2004, 2006, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
9 * This library is free software; you can redistribute it and/or
10 * modify it under the terms of the GNU Lesser General Public License
11 * as published by the Free Software Foundation; either version 3 of
12 * the License, or (at your option) any later version.
14 * This library is distributed in the hope that it will be useful, but
15 * WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 * Lesser General Public License for more details.
19 * You should have received a copy of the GNU Lesser General Public
20 * License along with this library; if not, write to the Free Software
21 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27 /* Macros for snarfing initialization actions from C source. */
29 /* Casting to a function that can take any number of arguments. */
30 #define SCM_FUNC_CAST_ARBITRARY_ARGS scm_t_subr
34 /* We support static allocation of some `SCM' objects. */
35 # define SCM_SUPPORT_STATIC_ALLOCATION
38 /* C preprocessor token concatenation. */
39 #define scm_i_paste(x, y) x ## y
40 #define scm_i_paste3(a, b, c) a ## b ## c
44 /* Generic macros to be used in user macro definitions.
46 * For example, in order to define a macro which creates ints and
47 * initializes them to the result of foo (), do:
49 * #define SCM_FOO(NAME) \
50 * SCM_SNARF_HERE (int NAME) \
51 * SCM_SNARF_INIT (NAME = foo ())
53 * The SCM_SNARF_INIT text goes into the corresponding .x file
54 * up through the first occurrence of SCM_SNARF_DOC_START on that
57 * Some debugging options can cause the preprocessor to echo #define
58 * directives to its output. Keeping the snarfing markers on separate
59 * lines prevents guile-snarf from inadvertently snarfing the definition
60 * of SCM_SNARF_INIT if those options are in effect.
63 #ifdef SCM_MAGIC_SNARF_INITS
64 # define SCM_SNARF_HERE(X)
65 # define SCM_SNARF_INIT_PREFIX ^^
66 # define SCM_SNARF_INIT(X) SCM_SNARF_INIT_PREFIX X ^:^
67 # define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
69 # ifdef SCM_MAGIC_SNARF_DOCS
70 # define SCM_SNARF_HERE(X)
71 # define SCM_SNARF_INIT(X)
72 # define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) \
77 location __FILE__ __LINE__ ^^ \
79 argsig REQ OPT VAR ^^ \
82 # define SCM_SNARF_HERE(X) X
83 # define SCM_SNARF_INIT(X)
84 # define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
88 #define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
90 static const char s_ ## FNAME [] = PRIMNAME; \
94 scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
95 (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
97 SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
99 /* Always use the generic subr case. */
100 #define SCM_DEFINE SCM_DEFINE_GSUBR
103 #define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
105 static const char s_ ## FNAME [] = PRIMNAME; \
106 static SCM g_ ## FNAME; \
110 g_ ## FNAME = SCM_PACK (0); \
111 scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \
112 (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME, \
115 SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
117 #define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
119 static const char s_ ## FNAME [] = PRIMNAME; \
123 scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
124 (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
125 scm_c_export (s_ ## FNAME, NULL); \
127 SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
129 #define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
130 SCM_SNARF_HERE(static const char RANAME[]=STR) \
131 SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
132 (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
134 #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
135 SCM_SNARF_HERE(static const char RANAME[]=STR) \
136 SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
137 (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
138 SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
139 "implemented by the C function \"" #CFN "\"")
141 #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
143 static const char RANAME[]=STR;\
146 GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
147 scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \
148 (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
151 #ifdef SCM_SUPPORT_STATIC_ALLOCATION
153 # define SCM_SYMBOL(c_name, scheme_name) \
155 SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \
158 c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \
161 # define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
163 SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \
166 c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \
169 #else /* !SCM_SUPPORT_STATIC_ALLOCATION */
171 # define SCM_SYMBOL(c_name, scheme_name) \
172 SCM_SNARF_HERE(static SCM c_name) \
173 SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name))
175 # define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
176 SCM_SNARF_HERE(SCM c_name) \
177 SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name))
179 #endif /* !SCM_SUPPORT_STATIC_ALLOCATION */
181 #define SCM_KEYWORD(c_name, scheme_name) \
182 SCM_SNARF_HERE(static SCM c_name) \
183 SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name))
185 #define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
186 SCM_SNARF_HERE(SCM c_name) \
187 SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name))
189 #define SCM_VARIABLE(c_name, scheme_name) \
190 SCM_SNARF_HERE(static SCM c_name) \
191 SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
193 #define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \
194 SCM_SNARF_HERE(SCM c_name) \
195 SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);)
197 #define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \
198 SCM_SNARF_HERE(static SCM c_name) \
199 SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
201 #define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \
202 SCM_SNARF_HERE(SCM c_name) \
203 SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);)
205 #define SCM_MUTEX(c_name) \
206 SCM_SNARF_HERE(static scm_t_mutex c_name) \
207 SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))
209 #define SCM_GLOBAL_MUTEX(c_name) \
210 SCM_SNARF_HERE(scm_t_mutex c_name) \
211 SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))
213 #define SCM_REC_MUTEX(c_name) \
214 SCM_SNARF_HERE(static scm_t_rec_mutex c_name) \
215 SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
217 #define SCM_GLOBAL_REC_MUTEX(c_name) \
218 SCM_SNARF_HERE(scm_t_rec_mutex c_name) \
219 SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
221 #define SCM_SMOB(tag, scheme_name, size) \
222 SCM_SNARF_HERE(static scm_t_bits tag) \
223 SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
225 #define SCM_GLOBAL_SMOB(tag, scheme_name, size) \
226 SCM_SNARF_HERE(scm_t_bits tag) \
227 SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
229 #define SCM_SMOB_MARK(tag, c_name, arg) \
230 SCM_SNARF_HERE(static SCM c_name(SCM arg)) \
231 SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
233 #define SCM_GLOBAL_SMOB_MARK(tag, c_name, arg) \
234 SCM_SNARF_HERE(SCM c_name(SCM arg)) \
235 SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
237 #define SCM_SMOB_FREE(tag, c_name, arg) \
238 SCM_SNARF_HERE(static size_t c_name(SCM arg)) \
239 SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
241 #define SCM_GLOBAL_SMOB_FREE(tag, c_name, arg) \
242 SCM_SNARF_HERE(size_t c_name(SCM arg)) \
243 SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
245 #define SCM_SMOB_PRINT(tag, c_name, obj, port, pstate) \
246 SCM_SNARF_HERE(static int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
247 SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
249 #define SCM_GLOBAL_SMOB_PRINT(tag, c_name, obj, port, pstate) \
250 SCM_SNARF_HERE(int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
251 SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
253 #define SCM_SMOB_EQUALP(tag, c_name, obj1, obj2) \
254 SCM_SNARF_HERE(static SCM c_name(SCM obj1, SCM obj2)) \
255 SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
257 #define SCM_GLOBAL_SMOB_EQUALP(tag, c_name, obj1, obj2) \
258 SCM_SNARF_HERE(SCM c_name(SCM obj1, SCM obj2)) \
259 SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
261 #define SCM_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
262 SCM_SNARF_HERE(static SCM c_name arglist) \
263 SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
265 #define SCM_GLOBAL_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
266 SCM_SNARF_HERE(SCM c_name arglist) \
267 SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
270 /* Low-level snarfing for static memory allocation. */
272 #ifdef SCM_SUPPORT_STATIC_ALLOCATION
274 #define SCM_IMMUTABLE_CELL(c_name, car, cdr) \
275 static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell \
276 c_name ## _raw_scell = \
281 static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_scell)
283 #define SCM_IMMUTABLE_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \
284 static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell \
285 c_name ## _raw_cell [2] = \
287 { SCM_PACK (car), SCM_PACK (cbr) }, \
288 { SCM_PACK (ccr), SCM_PACK (cdr) } \
290 static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_cell)
292 #define SCM_STATIC_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \
293 static SCM_ALIGNED (8) SCM_UNUSED scm_t_cell \
294 c_name ## _raw_cell [2] = \
296 { SCM_PACK (car), SCM_PACK (cbr) }, \
297 { SCM_PACK (ccr), SCM_PACK (cdr) } \
299 static SCM_UNUSED SCM c_name = SCM_PACK (& c_name ## _raw_cell)
301 #define SCM_IMMUTABLE_STRINGBUF(c_name, contents) \
302 static SCM_UNUSED const \
307 const char buffer[sizeof (contents)]; \
311 scm_tc7_stringbuf | SCM_I_STRINGBUF_F_SHARED, \
312 sizeof (contents) - 1, \
316 #define SCM_IMMUTABLE_STRING(c_name, contents) \
317 SCM_IMMUTABLE_STRINGBUF (scm_i_paste (c_name, _stringbuf), contents); \
318 SCM_IMMUTABLE_DOUBLE_CELL (c_name, \
320 (scm_t_bits) &scm_i_paste (c_name, \
323 (scm_t_bits) (sizeof (contents) - 1))
325 #define SCM_IMMUTABLE_POINTER(c_name, ptr) \
326 SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr)
328 #endif /* SCM_SUPPORT_STATIC_ALLOCATION */
333 #ifdef SCM_MAGIC_SNARF_DOCS
335 #define SCM_ASSERT(_cond, _arg, _pos, _subr) ^^ argpos _arg _pos __LINE__ ^^
336 #endif /* SCM_MAGIC_SNARF_DOCS */
338 #endif /* SCM_SNARF_H */