Commit | Line | Data |
---|---|---|
5b4215a8 JB |
1 | /* classes: h_files */ |
2 | ||
b29058ff DH |
3 | #ifndef SCM_SNARF_H |
4 | #define SCM_SNARF_H | |
5b4215a8 | 5 | |
be90d0b6 | 6 | /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, |
27337b63 | 7 | * 2004, 2006, 2009, 2010, 2011, 2013 Free Software Foundation, Inc. |
b29058ff | 8 | * |
73be1d9e | 9 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
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. | |
b29058ff | 13 | * |
53befeb7 NJ |
14 | * This library is distributed in the hope that it will be useful, but |
15 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
16 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | * Lesser General Public License for more details. | |
b29058ff | 18 | * |
73be1d9e MV |
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 | |
53befeb7 NJ |
21 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | * 02110-1301 USA | |
73be1d9e | 23 | */ |
1bbd0b84 | 24 | |
5b4215a8 JB |
25 | \f |
26 | ||
b29058ff DH |
27 | /* Macros for snarfing initialization actions from C source. */ |
28 | ||
be90d0b6 LC |
29 | /* Casting to a function that can take any number of arguments. */ |
30 | #define SCM_FUNC_CAST_ARBITRARY_ARGS scm_t_subr | |
e1fbffa9 | 31 | |
bfe19b46 | 32 | |
544a29de | 33 | #ifdef SCM_ALIGNED |
c6054fea LC |
34 | /* We support static allocation of some `SCM' objects. */ |
35 | # define SCM_SUPPORT_STATIC_ALLOCATION | |
36 | #endif | |
37 | ||
b68095f0 LC |
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 | |
41 | ||
c6054fea LC |
42 | |
43 | \f | |
73d8385e MD |
44 | /* Generic macros to be used in user macro definitions. |
45 | * | |
46 | * For example, in order to define a macro which creates ints and | |
47 | * initializes them to the result of foo (), do: | |
48 | * | |
49 | * #define SCM_FOO(NAME) \ | |
94a70859 MD |
50 | * SCM_SNARF_HERE (int NAME) \ |
51 | * SCM_SNARF_INIT (NAME = foo ()) | |
1e76143f | 52 | * |
94a70859 | 53 | * The SCM_SNARF_INIT text goes into the corresponding .x file |
3c6d9d71 DH |
54 | * up through the first occurrence of SCM_SNARF_DOC_START on that |
55 | * line, if any. | |
95c1cfb5 BT |
56 | * |
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. | |
73d8385e MD |
61 | */ |
62 | ||
c99f9605 ML |
63 | #ifdef SCM_MAGIC_SNARF_INITS |
64 | # define SCM_SNARF_HERE(X) | |
95c1cfb5 BT |
65 | # define SCM_SNARF_INIT_PREFIX ^^ |
66 | # define SCM_SNARF_INIT(X) SCM_SNARF_INIT_PREFIX X ^:^ | |
cecb4a5e | 67 | # define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) |
1e76143f | 68 | #else |
c99f9605 | 69 | # ifdef SCM_MAGIC_SNARF_DOCS |
94a70859 | 70 | # define SCM_SNARF_HERE(X) |
c99f9605 | 71 | # define SCM_SNARF_INIT(X) |
cecb4a5e | 72 | # define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) \ |
ac13d9d2 | 73 | ^^ { \ |
cecb4a5e | 74 | cname CNAME ^^ \ |
ac13d9d2 ML |
75 | fname FNAME ^^ \ |
76 | type TYPE ^^ \ | |
77 | location __FILE__ __LINE__ ^^ \ | |
78 | arglist ARGLIST ^^ \ | |
79 | argsig REQ OPT VAR ^^ \ | |
80 | DOCSTRING ^^ } | |
c99f9605 ML |
81 | # else |
82 | # define SCM_SNARF_HERE(X) X | |
83 | # define SCM_SNARF_INIT(X) | |
cecb4a5e | 84 | # define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) |
c99f9605 | 85 | # endif |
1e76143f | 86 | #endif |
73d8385e | 87 | |
46f9baf4 | 88 | #define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ |
94a70859 | 89 | SCM_SNARF_HERE(\ |
4b4d0898 GB |
90 | static const char s_ ## FNAME [] = PRIMNAME; \ |
91 | SCM FNAME ARGLIST\ | |
92 | )\ | |
94a70859 | 93 | SCM_SNARF_INIT(\ |
9a441ddb MV |
94 | scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \ |
95 | (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \ | |
2fdcf8bd | 96 | )\ |
cecb4a5e | 97 | SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) |
1bbd0b84 | 98 | |
46f9baf4 LC |
99 | /* Always use the generic subr case. */ |
100 | #define SCM_DEFINE SCM_DEFINE_GSUBR | |
101 | ||
46f9baf4 | 102 | |
a48d60b1 MD |
103 | #define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ |
104 | SCM_SNARF_HERE(\ | |
105 | static const char s_ ## FNAME [] = PRIMNAME; \ | |
106 | static SCM g_ ## FNAME; \ | |
107 | SCM FNAME ARGLIST\ | |
108 | )\ | |
109 | SCM_SNARF_INIT(\ | |
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, \ | |
113 | &g_ ## FNAME); \ | |
114 | )\ | |
115 | SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) | |
116 | ||
5527702a MV |
117 | #define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ |
118 | SCM_SNARF_HERE(\ | |
119 | static const char s_ ## FNAME [] = PRIMNAME; \ | |
120 | SCM FNAME ARGLIST\ | |
121 | )\ | |
122 | SCM_SNARF_INIT(\ | |
123 | scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \ | |
124 | (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \ | |
125 | scm_c_export (s_ ## FNAME, NULL); \ | |
126 | )\ | |
127 | SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) | |
128 | ||
9b1594fd | 129 | #define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ |
94a70859 | 130 | SCM_SNARF_HERE(static const char RANAME[]=STR) \ |
9a441ddb MV |
131 | SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \ |
132 | (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN)) | |
9b1594fd | 133 | |
1bbd0b84 | 134 | #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ |
94a70859 | 135 | SCM_SNARF_HERE(static const char RANAME[]=STR) \ |
9a441ddb MV |
136 | SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \ |
137 | (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \ | |
cecb4a5e | 138 | SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \ |
c99f9605 | 139 | "implemented by the C function \"" #CFN "\"") |
3dc81fba | 140 | |
9de33deb | 141 | #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \ |
94a70859 | 142 | SCM_SNARF_HERE(\ |
4b4d0898 | 143 | static const char RANAME[]=STR;\ |
54778cd3 | 144 | static SCM GF \ |
94a70859 | 145 | )SCM_SNARF_INIT(\ |
54778cd3 | 146 | GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \ |
9a441ddb MV |
147 | scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \ |
148 | (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \ | |
4b4d0898 | 149 | ) |
3dc81fba | 150 | |
c6054fea LC |
151 | #ifdef SCM_SUPPORT_STATIC_ALLOCATION |
152 | ||
153 | # define SCM_SYMBOL(c_name, scheme_name) \ | |
154 | SCM_SNARF_HERE( \ | |
b68095f0 | 155 | SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \ |
c6054fea | 156 | static SCM c_name) \ |
b68095f0 LC |
157 | SCM_SNARF_INIT( \ |
158 | c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \ | |
159 | ) | |
c6054fea LC |
160 | |
161 | # define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \ | |
162 | SCM_SNARF_HERE( \ | |
b68095f0 | 163 | SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \ |
c6054fea | 164 | SCM c_name) \ |
b68095f0 LC |
165 | SCM_SNARF_INIT( \ |
166 | c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \ | |
167 | ) | |
c6054fea LC |
168 | |
169 | #else /* !SCM_SUPPORT_STATIC_ALLOCATION */ | |
170 | ||
171 | # define SCM_SYMBOL(c_name, scheme_name) \ | |
172 | SCM_SNARF_HERE(static SCM c_name) \ | |
25d50a05 | 173 | SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name)) |
5b4215a8 | 174 | |
c6054fea LC |
175 | # define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \ |
176 | SCM_SNARF_HERE(SCM c_name) \ | |
25d50a05 | 177 | SCM_SNARF_INIT(c_name = scm_from_utf8_symbol (scheme_name)) |
78f9f47b | 178 | |
c6054fea LC |
179 | #endif /* !SCM_SUPPORT_STATIC_ALLOCATION */ |
180 | ||
37b83f68 | 181 | #define SCM_KEYWORD(c_name, scheme_name) \ |
94a70859 | 182 | SCM_SNARF_HERE(static SCM c_name) \ |
e7efe8e7 | 183 | SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name)) |
37b83f68 | 184 | |
37b83f68 | 185 | #define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \ |
94a70859 | 186 | SCM_SNARF_HERE(SCM c_name) \ |
e7efe8e7 | 187 | SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name)) |
5b4215a8 | 188 | |
86d31dfe MV |
189 | #define SCM_VARIABLE(c_name, scheme_name) \ |
190 | SCM_SNARF_HERE(static SCM c_name) \ | |
e7efe8e7 | 191 | SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);) |
86d31dfe MV |
192 | |
193 | #define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \ | |
194 | SCM_SNARF_HERE(SCM c_name) \ | |
e7efe8e7 | 195 | SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);) |
86d31dfe MV |
196 | |
197 | #define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \ | |
198 | SCM_SNARF_HERE(static SCM c_name) \ | |
e7efe8e7 | 199 | SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);) |
86d31dfe MV |
200 | |
201 | #define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \ | |
202 | SCM_SNARF_HERE(SCM c_name) \ | |
e7efe8e7 | 203 | SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);) |
86d31dfe | 204 | |
28d52ebb MD |
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)) | |
9bc4701c | 208 | |
28d52ebb MD |
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)) | |
9bc4701c | 212 | |
28d52ebb MD |
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)) | |
9bc4701c | 216 | |
28d52ebb MD |
217 | #define SCM_GLOBAL_REC_MUTEX(c_name) \ |
218 | SCM_SNARF_HERE(scm_t_rec_mutex c_name) \ | |
0b6843b1 | 219 | SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex)) |
9bc4701c | 220 | |
94e38a65 MV |
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));) | |
224 | ||
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));) | |
228 | ||
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));) | |
232 | ||
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));) | |
236 | ||
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));) | |
240 | ||
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));) | |
244 | ||
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));) | |
248 | ||
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));) | |
252 | ||
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));) | |
256 | ||
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));) | |
260 | ||
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));) | |
264 | ||
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));) | |
268 | ||
c6054fea LC |
269 | \f |
270 | /* Low-level snarfing for static memory allocation. */ | |
271 | ||
272 | #ifdef SCM_SUPPORT_STATIC_ALLOCATION | |
273 | ||
fd12a19a AW |
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 = \ | |
277 | { \ | |
278 | SCM_PACK (car), \ | |
279 | SCM_PACK (cdr) \ | |
280 | }; \ | |
281 | static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_scell) | |
282 | ||
c6054fea LC |
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] = \ | |
286 | { \ | |
287 | { SCM_PACK (car), SCM_PACK (cbr) }, \ | |
288 | { SCM_PACK (ccr), SCM_PACK (cdr) } \ | |
289 | }; \ | |
290 | static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_cell) | |
291 | ||
fd12a19a AW |
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] = \ | |
295 | { \ | |
296 | { SCM_PACK (car), SCM_PACK (cbr) }, \ | |
297 | { SCM_PACK (ccr), SCM_PACK (cdr) } \ | |
298 | }; \ | |
299 | static SCM_UNUSED SCM c_name = SCM_PACK (& c_name ## _raw_cell) | |
300 | ||
5f236208 LC |
301 | #define SCM_IMMUTABLE_STRINGBUF(c_name, contents) \ |
302 | static SCM_UNUSED const \ | |
303 | struct \ | |
304 | { \ | |
305 | scm_t_bits word_0; \ | |
306 | scm_t_bits word_1; \ | |
307 | const char buffer[sizeof (contents)]; \ | |
308 | } \ | |
309 | c_name = \ | |
310 | { \ | |
311 | scm_tc7_stringbuf | SCM_I_STRINGBUF_F_SHARED, \ | |
312 | sizeof (contents) - 1, \ | |
313 | contents \ | |
314 | } | |
c6054fea LC |
315 | |
316 | #define SCM_IMMUTABLE_STRING(c_name, contents) \ | |
b68095f0 | 317 | SCM_IMMUTABLE_STRINGBUF (scm_i_paste (c_name, _stringbuf), contents); \ |
c6054fea LC |
318 | SCM_IMMUTABLE_DOUBLE_CELL (c_name, \ |
319 | scm_tc7_ro_string, \ | |
b68095f0 | 320 | (scm_t_bits) &scm_i_paste (c_name, \ |
5f236208 | 321 | _stringbuf), \ |
c6054fea | 322 | (scm_t_bits) 0, \ |
544a29de | 323 | (scm_t_bits) (sizeof (contents) - 1)) |
c6054fea | 324 | |
5b46a8c2 LC |
325 | #define SCM_IMMUTABLE_POINTER(c_name, ptr) \ |
326 | SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr) | |
fd12a19a | 327 | |
c6054fea LC |
328 | #endif /* SCM_SUPPORT_STATIC_ALLOCATION */ |
329 | ||
330 | \f | |
331 | /* Documentation. */ | |
94e38a65 | 332 | |
c99f9605 | 333 | #ifdef SCM_MAGIC_SNARF_DOCS |
4b4d0898 | 334 | #undef SCM_ASSERT |
ac13d9d2 | 335 | #define SCM_ASSERT(_cond, _arg, _pos, _subr) ^^ argpos _arg _pos __LINE__ ^^ |
c99f9605 | 336 | #endif /* SCM_MAGIC_SNARF_DOCS */ |
2e07d033 | 337 | |
b29058ff | 338 | #endif /* SCM_SNARF_H */ |
89e00824 ML |
339 | |
340 | /* | |
341 | Local Variables: | |
342 | c-file-style: "gnu" | |
343 | End: | |
344 | */ |