Commit | Line | Data |
---|---|---|
5b4215a8 JB |
1 | /* classes: h_files */ |
2 | ||
b29058ff DH |
3 | #ifndef SCM_SNARF_H |
4 | #define SCM_SNARF_H | |
5b4215a8 | 5 | |
bab98046 | 6 | /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009, 2010 Free Software Foundation, Inc. |
b29058ff | 7 | * |
73be1d9e | 8 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
9 | * modify it under the terms of the GNU Lesser General Public License |
10 | * as published by the Free Software Foundation; either version 3 of | |
11 | * the License, or (at your option) any later version. | |
b29058ff | 12 | * |
53befeb7 NJ |
13 | * This library is distributed in the hope that it will be useful, but |
14 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
16 | * Lesser General Public License for more details. | |
b29058ff | 17 | * |
73be1d9e MV |
18 | * You should have received a copy of the GNU Lesser General Public |
19 | * License along with this library; if not, write to the Free Software | |
53befeb7 NJ |
20 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
21 | * 02110-1301 USA | |
73be1d9e | 22 | */ |
1bbd0b84 | 23 | |
5b4215a8 JB |
24 | \f |
25 | ||
b29058ff DH |
26 | /* Macros for snarfing initialization actions from C source. */ |
27 | ||
4b4d0898 | 28 | #if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF) |
e1fbffa9 MV |
29 | |
30 | /* This used to be "SCM (*)(...)" but GCC on RedHat 7.1 doesn't seem | |
31 | to like it. | |
32 | */ | |
33 | #define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)() | |
34 | ||
bfe19b46 | 35 | #else |
4b4d0898 | 36 | #define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)() |
bfe19b46 MD |
37 | #endif |
38 | ||
c6054fea LC |
39 | #if (defined SCM_ALIGNED) && (SCM_DEBUG_TYPING_STRICTNESS <= 1) |
40 | /* We support static allocation of some `SCM' objects. */ | |
41 | # define SCM_SUPPORT_STATIC_ALLOCATION | |
42 | #endif | |
43 | ||
b68095f0 LC |
44 | /* C preprocessor token concatenation. */ |
45 | #define scm_i_paste(x, y) x ## y | |
46 | #define scm_i_paste3(a, b, c) a ## b ## c | |
47 | ||
c6054fea LC |
48 | |
49 | \f | |
73d8385e MD |
50 | /* Generic macros to be used in user macro definitions. |
51 | * | |
52 | * For example, in order to define a macro which creates ints and | |
53 | * initializes them to the result of foo (), do: | |
54 | * | |
55 | * #define SCM_FOO(NAME) \ | |
94a70859 MD |
56 | * SCM_SNARF_HERE (int NAME) \ |
57 | * SCM_SNARF_INIT (NAME = foo ()) | |
1e76143f | 58 | * |
94a70859 | 59 | * The SCM_SNARF_INIT text goes into the corresponding .x file |
3c6d9d71 DH |
60 | * up through the first occurrence of SCM_SNARF_DOC_START on that |
61 | * line, if any. | |
73d8385e MD |
62 | */ |
63 | ||
c99f9605 ML |
64 | #ifdef SCM_MAGIC_SNARF_INITS |
65 | # define SCM_SNARF_HERE(X) | |
09e804ff | 66 | # define SCM_SNARF_INIT(X) ^^ 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 | #ifdef SCM_SUPPORT_STATIC_ALLOCATION |
100 | ||
f0eb5ae6 | 101 | /* Static subr allocation. */ |
fd12a19a | 102 | /* FIXME: how to verify that req + opt + rest < 11, all are positive, etc? */ |
f0eb5ae6 | 103 | #define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ |
46f9baf4 | 104 | SCM_SYMBOL (scm_i_paste (FNAME, __name), PRIMNAME); \ |
fd12a19a | 105 | SCM_SNARF_HERE( \ |
46f9baf4 | 106 | static const char scm_i_paste (s_, FNAME) [] = PRIMNAME; \ |
f4767979 | 107 | SCM_API SCM FNAME ARGLIST; \ |
fd12a19a AW |
108 | static const scm_t_bits scm_i_paste (FNAME, __subr_ptr) = \ |
109 | (scm_t_bits) &FNAME; /* the subr */ \ | |
110 | SCM_IMMUTABLE_FOREIGN (scm_i_paste (FNAME, __subr_foreign), \ | |
111 | scm_i_paste (FNAME, __subr_ptr)); \ | |
112 | SCM_STATIC_SUBR_OBJVECT (scm_i_paste (FNAME, __raw_objtable), \ | |
113 | /* FIXME: directly be the foreign */ \ | |
114 | SCM_BOOL_F); \ | |
115 | /* FIXME: be immutable. grr */ \ | |
116 | SCM_STATIC_PROGRAM (scm_i_paste (FNAME, __subr), \ | |
117 | SCM_BOOL_F, \ | |
118 | SCM_PACK (&scm_i_paste (FNAME, __raw_objtable)), \ | |
119 | SCM_BOOL_F); \ | |
46f9baf4 LC |
120 | SCM FNAME ARGLIST \ |
121 | ) \ | |
f4767979 | 122 | SCM_SNARF_INIT( \ |
fd12a19a AW |
123 | /* Initialize the foreign. */ \ |
124 | scm_i_paste (FNAME, __raw_objtable)[2] = scm_i_paste (FNAME, __subr_foreign); \ | |
46f9baf4 | 125 | /* Initialize the procedure name (an interned symbol). */ \ |
fd12a19a AW |
126 | scm_i_paste (FNAME, __raw_objtable)[3] = scm_i_paste (FNAME, __name); \ |
127 | /* Initialize the objcode trampoline. */ \ | |
128 | SCM_SET_CELL_OBJECT (scm_i_paste (FNAME, __subr), 1, \ | |
129 | scm_subr_objcode_trampoline (REQ, OPT, VAR)); \ | |
46f9baf4 LC |
130 | \ |
131 | /* Define the subr. */ \ | |
fd12a19a | 132 | scm_define (scm_i_paste (FNAME, __name), scm_i_paste (FNAME, __subr)); \ |
46f9baf4 LC |
133 | ) \ |
134 | SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) | |
135 | ||
46f9baf4 LC |
136 | #else /* !SCM_SUPPORT_STATIC_ALLOCATION */ |
137 | ||
138 | /* Always use the generic subr case. */ | |
139 | #define SCM_DEFINE SCM_DEFINE_GSUBR | |
140 | ||
141 | #endif /* !SCM_SUPPORT_STATIC_ALLOCATION */ | |
142 | ||
143 | ||
a48d60b1 MD |
144 | #define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ |
145 | SCM_SNARF_HERE(\ | |
146 | static const char s_ ## FNAME [] = PRIMNAME; \ | |
147 | static SCM g_ ## FNAME; \ | |
148 | SCM FNAME ARGLIST\ | |
149 | )\ | |
150 | SCM_SNARF_INIT(\ | |
151 | g_ ## FNAME = SCM_PACK (0); \ | |
152 | scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \ | |
153 | (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME, \ | |
154 | &g_ ## FNAME); \ | |
155 | )\ | |
156 | SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) | |
157 | ||
5527702a MV |
158 | #define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \ |
159 | SCM_SNARF_HERE(\ | |
160 | static const char s_ ## FNAME [] = PRIMNAME; \ | |
161 | SCM FNAME ARGLIST\ | |
162 | )\ | |
163 | SCM_SNARF_INIT(\ | |
164 | scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \ | |
165 | (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \ | |
166 | scm_c_export (s_ ## FNAME, NULL); \ | |
167 | )\ | |
168 | SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) | |
169 | ||
9b1594fd | 170 | #define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ |
94a70859 | 171 | SCM_SNARF_HERE(static const char RANAME[]=STR) \ |
9a441ddb MV |
172 | SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \ |
173 | (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN)) | |
9b1594fd | 174 | |
1bbd0b84 | 175 | #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \ |
94a70859 | 176 | SCM_SNARF_HERE(static const char RANAME[]=STR) \ |
9a441ddb MV |
177 | SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \ |
178 | (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \ | |
cecb4a5e | 179 | SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \ |
c99f9605 | 180 | "implemented by the C function \"" #CFN "\"") |
3dc81fba | 181 | |
9de33deb | 182 | #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \ |
94a70859 | 183 | SCM_SNARF_HERE(\ |
4b4d0898 | 184 | static const char RANAME[]=STR;\ |
54778cd3 | 185 | static SCM GF \ |
94a70859 | 186 | )SCM_SNARF_INIT(\ |
54778cd3 | 187 | GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \ |
9a441ddb MV |
188 | scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \ |
189 | (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \ | |
4b4d0898 | 190 | ) |
3dc81fba | 191 | |
c6054fea LC |
192 | #ifdef SCM_SUPPORT_STATIC_ALLOCATION |
193 | ||
194 | # define SCM_SYMBOL(c_name, scheme_name) \ | |
195 | SCM_SNARF_HERE( \ | |
b68095f0 | 196 | SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \ |
c6054fea | 197 | static SCM c_name) \ |
b68095f0 LC |
198 | SCM_SNARF_INIT( \ |
199 | c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \ | |
200 | ) | |
c6054fea LC |
201 | |
202 | # define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \ | |
203 | SCM_SNARF_HERE( \ | |
b68095f0 | 204 | SCM_IMMUTABLE_STRING (scm_i_paste (c_name, _string), scheme_name); \ |
c6054fea | 205 | SCM c_name) \ |
b68095f0 LC |
206 | SCM_SNARF_INIT( \ |
207 | c_name = scm_string_to_symbol (scm_i_paste (c_name, _string)) \ | |
208 | ) | |
c6054fea LC |
209 | |
210 | #else /* !SCM_SUPPORT_STATIC_ALLOCATION */ | |
211 | ||
212 | # define SCM_SYMBOL(c_name, scheme_name) \ | |
213 | SCM_SNARF_HERE(static SCM c_name) \ | |
e7efe8e7 | 214 | SCM_SNARF_INIT(c_name = scm_from_locale_symbol (scheme_name)) |
5b4215a8 | 215 | |
c6054fea LC |
216 | # define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \ |
217 | SCM_SNARF_HERE(SCM c_name) \ | |
e7efe8e7 | 218 | SCM_SNARF_INIT(c_name = scm_from_locale_symbol (scheme_name)) |
78f9f47b | 219 | |
c6054fea LC |
220 | #endif /* !SCM_SUPPORT_STATIC_ALLOCATION */ |
221 | ||
37b83f68 | 222 | #define SCM_KEYWORD(c_name, scheme_name) \ |
94a70859 | 223 | SCM_SNARF_HERE(static SCM c_name) \ |
e7efe8e7 | 224 | SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name)) |
37b83f68 | 225 | |
37b83f68 | 226 | #define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \ |
94a70859 | 227 | SCM_SNARF_HERE(SCM c_name) \ |
e7efe8e7 | 228 | SCM_SNARF_INIT(c_name = scm_from_locale_keyword (scheme_name)) |
5b4215a8 | 229 | |
86d31dfe MV |
230 | #define SCM_VARIABLE(c_name, scheme_name) \ |
231 | SCM_SNARF_HERE(static SCM c_name) \ | |
e7efe8e7 | 232 | SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);) |
86d31dfe MV |
233 | |
234 | #define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \ | |
235 | SCM_SNARF_HERE(SCM c_name) \ | |
e7efe8e7 | 236 | SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, SCM_BOOL_F);) |
86d31dfe MV |
237 | |
238 | #define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \ | |
239 | SCM_SNARF_HERE(static SCM c_name) \ | |
e7efe8e7 | 240 | SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);) |
86d31dfe MV |
241 | |
242 | #define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \ | |
243 | SCM_SNARF_HERE(SCM c_name) \ | |
e7efe8e7 | 244 | SCM_SNARF_INIT(c_name = scm_c_define (scheme_name, init_val);) |
86d31dfe | 245 | |
28d52ebb MD |
246 | #define SCM_MUTEX(c_name) \ |
247 | SCM_SNARF_HERE(static scm_t_mutex c_name) \ | |
248 | SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex)) | |
9bc4701c | 249 | |
28d52ebb MD |
250 | #define SCM_GLOBAL_MUTEX(c_name) \ |
251 | SCM_SNARF_HERE(scm_t_mutex c_name) \ | |
252 | SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex)) | |
9bc4701c | 253 | |
28d52ebb MD |
254 | #define SCM_REC_MUTEX(c_name) \ |
255 | SCM_SNARF_HERE(static scm_t_rec_mutex c_name) \ | |
256 | SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex)) | |
9bc4701c | 257 | |
28d52ebb MD |
258 | #define SCM_GLOBAL_REC_MUTEX(c_name) \ |
259 | SCM_SNARF_HERE(scm_t_rec_mutex c_name) \ | |
0b6843b1 | 260 | SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex)) |
9bc4701c | 261 | |
94e38a65 MV |
262 | #define SCM_SMOB(tag, scheme_name, size) \ |
263 | SCM_SNARF_HERE(static scm_t_bits tag) \ | |
264 | SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));) | |
265 | ||
266 | #define SCM_GLOBAL_SMOB(tag, scheme_name, size) \ | |
267 | SCM_SNARF_HERE(scm_t_bits tag) \ | |
268 | SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));) | |
269 | ||
270 | #define SCM_SMOB_MARK(tag, c_name, arg) \ | |
271 | SCM_SNARF_HERE(static SCM c_name(SCM arg)) \ | |
272 | SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));) | |
273 | ||
274 | #define SCM_GLOBAL_SMOB_MARK(tag, c_name, arg) \ | |
275 | SCM_SNARF_HERE(SCM c_name(SCM arg)) \ | |
276 | SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));) | |
277 | ||
278 | #define SCM_SMOB_FREE(tag, c_name, arg) \ | |
279 | SCM_SNARF_HERE(static size_t c_name(SCM arg)) \ | |
280 | SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));) | |
281 | ||
282 | #define SCM_GLOBAL_SMOB_FREE(tag, c_name, arg) \ | |
283 | SCM_SNARF_HERE(size_t c_name(SCM arg)) \ | |
284 | SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));) | |
285 | ||
286 | #define SCM_SMOB_PRINT(tag, c_name, obj, port, pstate) \ | |
287 | SCM_SNARF_HERE(static int c_name(SCM obj, SCM port, scm_print_state* pstate)) \ | |
288 | SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));) | |
289 | ||
290 | #define SCM_GLOBAL_SMOB_PRINT(tag, c_name, obj, port, pstate) \ | |
291 | SCM_SNARF_HERE(int c_name(SCM obj, SCM port, scm_print_state* pstate)) \ | |
292 | SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));) | |
293 | ||
294 | #define SCM_SMOB_EQUALP(tag, c_name, obj1, obj2) \ | |
295 | SCM_SNARF_HERE(static SCM c_name(SCM obj1, SCM obj2)) \ | |
296 | SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));) | |
297 | ||
298 | #define SCM_GLOBAL_SMOB_EQUALP(tag, c_name, obj1, obj2) \ | |
299 | SCM_SNARF_HERE(SCM c_name(SCM obj1, SCM obj2)) \ | |
300 | SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));) | |
301 | ||
302 | #define SCM_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \ | |
303 | SCM_SNARF_HERE(static SCM c_name arglist) \ | |
304 | SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));) | |
305 | ||
306 | #define SCM_GLOBAL_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \ | |
307 | SCM_SNARF_HERE(SCM c_name arglist) \ | |
308 | SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));) | |
309 | ||
c6054fea LC |
310 | \f |
311 | /* Low-level snarfing for static memory allocation. */ | |
312 | ||
313 | #ifdef SCM_SUPPORT_STATIC_ALLOCATION | |
314 | ||
fd12a19a AW |
315 | #define SCM_IMMUTABLE_CELL(c_name, car, cdr) \ |
316 | static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell \ | |
317 | c_name ## _raw_scell = \ | |
318 | { \ | |
319 | SCM_PACK (car), \ | |
320 | SCM_PACK (cdr) \ | |
321 | }; \ | |
322 | static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_scell) | |
323 | ||
c6054fea LC |
324 | #define SCM_IMMUTABLE_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \ |
325 | static SCM_ALIGNED (8) SCM_UNUSED const scm_t_cell \ | |
326 | c_name ## _raw_cell [2] = \ | |
327 | { \ | |
328 | { SCM_PACK (car), SCM_PACK (cbr) }, \ | |
329 | { SCM_PACK (ccr), SCM_PACK (cdr) } \ | |
330 | }; \ | |
331 | static SCM_UNUSED const SCM c_name = SCM_PACK (& c_name ## _raw_cell) | |
332 | ||
fd12a19a AW |
333 | #define SCM_STATIC_DOUBLE_CELL(c_name, car, cbr, ccr, cdr) \ |
334 | static SCM_ALIGNED (8) SCM_UNUSED scm_t_cell \ | |
335 | c_name ## _raw_cell [2] = \ | |
336 | { \ | |
337 | { SCM_PACK (car), SCM_PACK (cbr) }, \ | |
338 | { SCM_PACK (ccr), SCM_PACK (cdr) } \ | |
339 | }; \ | |
340 | static SCM_UNUSED SCM c_name = SCM_PACK (& c_name ## _raw_cell) | |
341 | ||
5f236208 LC |
342 | #define SCM_IMMUTABLE_STRINGBUF(c_name, contents) \ |
343 | static SCM_UNUSED const \ | |
344 | struct \ | |
345 | { \ | |
346 | scm_t_bits word_0; \ | |
347 | scm_t_bits word_1; \ | |
348 | const char buffer[sizeof (contents)]; \ | |
349 | } \ | |
350 | c_name = \ | |
351 | { \ | |
352 | scm_tc7_stringbuf | SCM_I_STRINGBUF_F_SHARED, \ | |
353 | sizeof (contents) - 1, \ | |
354 | contents \ | |
355 | } | |
c6054fea LC |
356 | |
357 | #define SCM_IMMUTABLE_STRING(c_name, contents) \ | |
b68095f0 | 358 | SCM_IMMUTABLE_STRINGBUF (scm_i_paste (c_name, _stringbuf), contents); \ |
c6054fea LC |
359 | SCM_IMMUTABLE_DOUBLE_CELL (c_name, \ |
360 | scm_tc7_ro_string, \ | |
b68095f0 | 361 | (scm_t_bits) &scm_i_paste (c_name, \ |
5f236208 | 362 | _stringbuf), \ |
c6054fea LC |
363 | (scm_t_bits) 0, \ |
364 | (scm_t_bits) sizeof (contents) - 1) | |
365 | ||
fd12a19a AW |
366 | #define SCM_IMMUTABLE_FOREIGN(c_name, loc) \ |
367 | SCM_IMMUTABLE_CELL (c_name, \ | |
368 | scm_tc7_foreign | (SCM_FOREIGN_TYPE_POINTER << 8), \ | |
369 | &loc) | |
370 | ||
371 | /* for primitive-generics, add a foreign to the end */ | |
372 | #define SCM_STATIC_SUBR_OBJVECT(c_name, foreign) \ | |
373 | static SCM_ALIGNED (8) SCM c_name[4] = \ | |
374 | { \ | |
375 | SCM_PACK (scm_tc7_vector | (2 << 8)), \ | |
376 | SCM_PACK (0), \ | |
377 | foreign, \ | |
378 | SCM_BOOL_F, /* the name */ \ | |
379 | }; \ | |
380 | ||
381 | #define SCM_STATIC_PROGRAM(c_name, objcode, objtable, freevars) \ | |
382 | SCM_STATIC_DOUBLE_CELL (c_name, \ | |
cc7005bc | 383 | scm_tc7_program | (SCM_F_PROGRAM_IS_PRIMITIVE<<8), \ |
fd12a19a AW |
384 | (scm_t_bits) objcode, \ |
385 | (scm_t_bits) objtable, \ | |
386 | (scm_t_bits) freevars) | |
46f9baf4 | 387 | |
c6054fea LC |
388 | #endif /* SCM_SUPPORT_STATIC_ALLOCATION */ |
389 | ||
390 | \f | |
391 | /* Documentation. */ | |
94e38a65 | 392 | |
c99f9605 | 393 | #ifdef SCM_MAGIC_SNARF_DOCS |
4b4d0898 | 394 | #undef SCM_ASSERT |
ac13d9d2 | 395 | #define SCM_ASSERT(_cond, _arg, _pos, _subr) ^^ argpos _arg _pos __LINE__ ^^ |
c99f9605 | 396 | #endif /* SCM_MAGIC_SNARF_DOCS */ |
2e07d033 | 397 | |
b29058ff | 398 | #endif /* SCM_SNARF_H */ |
89e00824 ML |
399 | |
400 | /* | |
401 | Local Variables: | |
402 | c-file-style: "gnu" | |
403 | End: | |
404 | */ |