/tags/rel-1-3-27/SWIG/Lib/guile/guile_scm_run.swg
Unknown | 408 lines | 362 code | 46 blank | 0 comment | 0 complexity | 79deb76e344447586a023ea607d0ee8c MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
1/* -*- c -*-
2 * -----------------------------------------------------------------------
3 * swig_lib/guile/guile_scm_run.swg
4 *
5 * Author: John Lenz <jelenz@wisc.edu>
6 * ----------------------------------------------------------------------- */
7
8#include <libguile.h>
9#include <stdio.h>
10#include <string.h>
11#include <stdlib.h>
12
13#ifdef __cplusplus
14extern "C" {
15#endif
16
17typedef SCM (*swig_guile_proc)();
18typedef SCM (*guile_destructor)(SCM);
19
20typedef struct swig_guile_clientdata {
21 guile_destructor destroy;
22 SCM goops_class;
23} swig_guile_clientdata;
24
25#define SWIG_scm2str(s) \
26 SWIG_Guile_scm2newstr(s, NULL)
27#define SWIG_malloc(size) \
28 SCM_MUST_MALLOC(size)
29#define SWIG_free(mem) \
30 scm_must_free(mem)
31#define SWIG_ConvertPtr(s, result, type, flags) \
32 SWIG_Guile_ConvertPtr(s, result, type, flags)
33#define SWIG_MustGetPtr(s, type, argnum, flags) \
34 SWIG_Guile_MustGetPtr(s, type, argnum, flags, FUNC_NAME)
35#define SWIG_NewPointerObj(ptr, type, owner) \
36 SWIG_Guile_NewPointerObj((void*)ptr, type, owner)
37#define SWIG_PointerAddress(object) \
38 SWIG_Guile_PointerAddress(object)
39#define SWIG_PointerType(object) \
40 SWIG_Guile_PointerType(object)
41#define SWIG_IsPointerOfType(object, type) \
42 SWIG_Guile_IsPointerOfType(object, type)
43#define SWIG_IsPointer(object) \
44 SWIG_Guile_IsPointer(object)
45#define SWIG_contract_assert(expr, msg) \
46 if (!(expr)) \
47 scm_error(scm_str2symbol("swig-contract-assertion-failed"), \
48 (char *) FUNC_NAME, (char *) msg, \
49 SCM_EOL, SCM_BOOL_F); else
50
51/* Runtime API */
52#define SWIG_GetModule(clientdata) SWIG_Guile_GetModule()
53#define SWIG_SetModule(clientdata, pointer) SWIG_Guile_SetModule(pointer)
54
55static char *
56SWIG_Guile_scm2newstr(SCM str, size_t *len) {
57#define FUNC_NAME "SWIG_Guile_scm2newstr"
58 char *ret;
59 size_t l;
60
61 SCM_ASSERT (SCM_STRINGP(str), str, 1, FUNC_NAME);
62
63 l = SCM_STRING_LENGTH(str);
64 ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
65 if (!ret) return NULL;
66
67 memcpy(ret, SCM_STRING_CHARS(str), l);
68 ret[l] = '\0';
69 if (len) *len = l;
70 return ret;
71#undef FUNC_NAME
72}
73
74static int swig_initialized = 0;
75static scm_t_bits swig_tag = 0;
76static scm_t_bits swig_collectable_tag = 0;
77static scm_t_bits swig_destroyed_tag = 0;
78static SCM swig_make_func = SCM_EOL;
79static SCM swig_keyword = SCM_EOL;
80static SCM swig_symbol = SCM_EOL;
81
82#define SWIG_Guile_GetSmob(x) \
83 ( SCM_NNULLP(x) && SCM_INSTANCEP(x) && SCM_NFALSEP(scm_slot_exists_p(x, swig_symbol)) \
84 ? scm_slot_ref(x, swig_symbol) : (x) )
85
86static SCM
87SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner)
88{
89 if (ptr == NULL)
90 return SCM_EOL;
91 else {
92 SCM smob;
93 swig_guile_clientdata *cdata = (swig_guile_clientdata *) type->clientdata;
94 if (owner)
95 SCM_NEWSMOB2(smob, swig_collectable_tag, ptr, (void *) type);
96 else
97 SCM_NEWSMOB2(smob, swig_tag, ptr, (void *) type);
98
99 if (!cdata || SCM_NULLP(cdata->goops_class) || swig_make_func == SCM_EOL ) {
100 return smob;
101 } else {
102 /* the scm_make() C function only handles the creation of gf,
103 methods and classes (no instances) the (make ...) function is
104 later redefined in goops.scm. So we need to call that
105 Scheme function. */
106 return scm_apply(swig_make_func,
107 scm_list_3(cdata->goops_class,
108 swig_keyword,
109 smob),
110 SCM_EOL);
111 }
112 }
113}
114
115static unsigned long
116SWIG_Guile_PointerAddress(SCM object)
117{
118 SCM smob = SWIG_Guile_GetSmob(object);
119 if (SCM_NULLP(smob)) return 0;
120 else if (SCM_SMOB_PREDICATE(swig_tag, smob)
121 || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)
122 || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) {
123 return (unsigned long) (void *) SCM_CELL_WORD_1(smob);
124 }
125 else scm_wrong_type_arg("SWIG-Guile-PointerAddress", 1, object);
126}
127
128static swig_type_info *
129SWIG_Guile_PointerType(SCM object)
130{
131 SCM smob = SWIG_Guile_GetSmob(object);
132 if (SCM_NULLP(smob)) return NULL;
133 else if (SCM_SMOB_PREDICATE(swig_tag, smob)
134 || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)
135 || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) {
136 return (swig_type_info *) SCM_CELL_WORD_2(smob);
137 }
138 else scm_wrong_type_arg("SWIG-Guile-PointerType", 1, object);
139}
140
141/* Return 0 if successful. */
142static int
143SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags)
144{
145 swig_cast_info *cast;
146 swig_type_info *from;
147 SCM smob = SWIG_Guile_GetSmob(s);
148
149 if (SCM_NULLP(smob)) {
150 *result = NULL;
151 return 0;
152 } else if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) {
153 /* we do not accept smobs representing destroyed pointers */
154 from = (swig_type_info *) SCM_CELL_WORD_2(smob);
155 if (!from) return 1;
156 if (type) {
157 cast = SWIG_TypeCheckStruct(from, type);
158 if (cast) {
159 *result = SWIG_TypeCast(cast, (void *) SCM_CELL_WORD_1(smob));
160 return 0;
161 } else {
162 return 1;
163 }
164 } else {
165 *result = (void *) SCM_CELL_WORD_1(smob);
166 return 0;
167 }
168 }
169 return 1;
170}
171
172static SWIGINLINE void *
173SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
174 int argnum, int flags, const char *func_name)
175{
176 void *result;
177 if (SWIG_Guile_ConvertPtr(s, &result, type, flags)) {
178 /* type mismatch */
179 scm_wrong_type_arg((char *) func_name, argnum, s);
180 }
181 return result;
182}
183
184static SWIGINLINE int
185SWIG_Guile_IsPointerOfType (SCM s, swig_type_info *type)
186{
187 void *result;
188 if (SWIG_Guile_ConvertPtr(s, &result, type, 0)) {
189 /* type mismatch */
190 return 0;
191 }
192 else return 1;
193}
194
195static SWIGINLINE int
196SWIG_Guile_IsPointer (SCM s)
197{
198 return SWIG_Guile_IsPointerOfType (s, NULL);
199}
200
201/* Mark a pointer object non-collectable */
202static void
203SWIG_Guile_MarkPointerNoncollectable(SCM s)
204{
205 SCM smob = SWIG_Guile_GetSmob(s);
206 if (!SCM_NULLP(smob)) {
207 if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) {
208 SCM_SET_CELL_TYPE(smob, swig_tag);
209 }
210 else scm_wrong_type_arg(NULL, 0, s);
211 }
212}
213
214/* Mark a pointer object destroyed */
215static void
216SWIG_Guile_MarkPointerDestroyed(SCM s)
217{
218 SCM smob = SWIG_Guile_GetSmob(s);
219 if (!SCM_NULLP(smob)) {
220 if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) {
221 SCM_SET_CELL_TYPE(smob, swig_destroyed_tag);
222 }
223 else scm_wrong_type_arg(NULL, 0, s);
224 }
225}
226
227/* Init */
228
229static int
230print_swig_aux (SCM swig_smob, SCM port, scm_print_state *pstate, const char *attribute)
231{
232 swig_type_info *type;
233
234 type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
235 if (type) {
236 scm_puts((char *) "#<", port);
237 scm_puts((char *) attribute, port);
238 scm_puts((char *) "swig-pointer ", port);
239 scm_puts((char *) SWIG_TypePrettyName(type), port);
240 scm_puts((char *) " ", port);
241 scm_intprint((long) SCM_CELL_WORD_1(swig_smob), 16, port);
242 scm_puts((char *) ">", port);
243 /* non-zero means success */
244 return 1;
245 } else {
246 return 0;
247 }
248}
249
250
251static int
252print_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
253{
254 return print_swig_aux(swig_smob, port, pstate, "");
255}
256
257static int
258print_collectable_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
259{
260 return print_swig_aux(swig_smob, port, pstate, "collectable-");
261}
262
263static int
264print_destroyed_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
265{
266 return print_swig_aux(swig_smob, port, pstate, "destroyed-");
267}
268
269static SCM
270equalp_swig (SCM A, SCM B)
271{
272 if (SCM_CELL_WORD_0(A) == SCM_CELL_WORD_0(B) && SCM_CELL_WORD_1(A) == SCM_CELL_WORD_1(B)
273 && SCM_CELL_WORD_2(A) == SCM_CELL_WORD_2(B))
274 return SCM_BOOL_T;
275 else return SCM_BOOL_F;
276}
277
278static size_t
279free_swig(SCM A)
280{
281 swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(A);
282 if (type) {
283 if (type->clientdata && ((swig_guile_clientdata *)type->clientdata)->destroy)
284 ((swig_guile_clientdata *)type->clientdata)->destroy(A);
285 }
286 return 0;
287}
288
289static int
290ensure_smob_tag(SCM swig_module,
291 scm_t_bits *tag_variable,
292 const char *smob_name,
293 const char *scheme_variable_name)
294{
295 SCM variable = scm_sym2var(scm_str2symbol(scheme_variable_name),
296 scm_module_lookup_closure(swig_module),
297 SCM_BOOL_T);
298 if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) {
299 *tag_variable = scm_make_smob_type((char*)scheme_variable_name, 0);
300 SCM_VARIABLE_SET(variable,
301 scm_ulong2num(*tag_variable));
302 return 1;
303 }
304 else {
305 *tag_variable = scm_num2ulong(SCM_VARIABLE_REF(variable), 0,
306 "SWIG_Guile_Init");
307 return 0;
308 }
309}
310
311static SCM
312SWIG_Guile_Init ()
313{
314 static SCM swig_module;
315
316 if (swig_initialized) return swig_module;
317 swig_initialized = 1;
318
319 swig_module = scm_c_resolve_module("Swig swigrun");
320 if (ensure_smob_tag(swig_module, &swig_tag,
321 "swig-pointer", "swig-pointer-tag")) {
322 scm_set_smob_print(swig_tag, print_swig);
323 scm_set_smob_equalp(swig_tag, equalp_swig);
324 }
325 if (ensure_smob_tag(swig_module, &swig_collectable_tag,
326 "collectable-swig-pointer", "collectable-swig-pointer-tag")) {
327 scm_set_smob_print(swig_collectable_tag, print_collectable_swig);
328 scm_set_smob_equalp(swig_collectable_tag, equalp_swig);
329 scm_set_smob_free(swig_collectable_tag, free_swig);
330 }
331 if (ensure_smob_tag(swig_module, &swig_destroyed_tag,
332 "destroyed-swig-pointer", "destroyed-swig-pointer-tag")) {
333 scm_set_smob_print(swig_destroyed_tag, print_destroyed_swig);
334 scm_set_smob_equalp(swig_destroyed_tag, equalp_swig);
335 }
336 swig_make_func = scm_permanent_object(
337 scm_variable_ref(scm_c_module_lookup(scm_c_resolve_module("oop goops"), "make")));
338 swig_keyword = scm_permanent_object(scm_c_make_keyword((char*) "init-smob"));
339 swig_symbol = scm_permanent_object(scm_str2symbol("swig-smob"));
340#ifdef SWIG_INIT_RUNTIME_MODULE
341 SWIG_INIT_RUNTIME_MODULE
342#endif
343
344 return swig_module;
345}
346
347static swig_module_info *
348SWIG_Guile_GetModule()
349{
350 SCM module;
351 SCM variable;
352
353 module = SWIG_Guile_Init();
354
355 variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
356 scm_module_lookup_closure(module),
357 SCM_BOOL_T);
358 if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) {
359 return NULL;
360 } else {
361 return (swig_module_info *) scm_num2ulong(SCM_VARIABLE_REF(variable), 0, "SWIG_Guile_Init");
362 }
363}
364
365static void
366SWIG_Guile_SetModule(swig_module_info *swig_module)
367{
368 SCM module;
369 SCM variable;
370
371 module = SWIG_Guile_Init();
372
373 variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
374 scm_module_lookup_closure(module),
375 SCM_BOOL_T);
376
377 SCM_VARIABLE_SET(variable, scm_ulong2num((unsigned long) swig_module));
378}
379
380static int
381SWIG_Guile_GetArgs (SCM *dest, SCM rest,
382 int reqargs, int optargs,
383 const char *procname)
384{
385 int i;
386 int num_args_passed = 0;
387 for (i = 0; i<reqargs; i++) {
388 if (!SCM_CONSP(rest))
389 scm_wrong_num_args(scm_makfrom0str((char *) procname));
390 *dest++ = SCM_CAR(rest);
391 rest = SCM_CDR(rest);
392 num_args_passed++;
393 }
394 for (i = 0; i<optargs && SCM_CONSP(rest); i++) {
395 *dest++ = SCM_CAR(rest);
396 rest = SCM_CDR(rest);
397 num_args_passed++;
398 }
399 for (; i<optargs; i++)
400 *dest++ = SCM_UNDEFINED;
401 if (!SCM_NULLP(rest))
402 scm_wrong_num_args(scm_makfrom0str((char *) procname));
403 return num_args_passed;
404}
405
406#ifdef __cplusplus
407}
408#endif