1/* -----------------------------------------------------------------------------
2 * See the LICENSE file for information on copyright, usage and redistribution
3 * of SWIG, and the README file for authors - http://www.swig.org/release.html.
4 *
5 * guile_scm_run.swg
6 * ----------------------------------------------------------------------------- */
7
8#include <libguile.h>
9#include <stdio.h>
10#include <string.h>
11#include <stdlib.h>
12#include <assert.h>
13
14#ifdef __cplusplus
15extern "C" {
16#endif
17
18typedef SCM (*swig_guile_proc)();
19typedef SCM (*guile_destructor)(SCM);
20
21typedef struct swig_guile_clientdata {
22  guile_destructor destroy;
23  SCM goops_class;
24} swig_guile_clientdata;
25
26#define SWIG_scm2str(s) \
27  SWIG_Guile_scm2newstr(s, NULL)
28#define SWIG_malloc(size) \
29  SCM_MUST_MALLOC(size)
30#define SWIG_free(mem) \
31  scm_must_free(mem)
32#define SWIG_ConvertPtr(s, result, type, flags) \
33  SWIG_Guile_ConvertPtr(s, result, type, flags)
34#define SWIG_MustGetPtr(s, type, argnum, flags) \
35  SWIG_Guile_MustGetPtr(s, type, argnum, flags, FUNC_NAME)
36#define SWIG_NewPointerObj(ptr, type, owner) \
37  SWIG_Guile_NewPointerObj((void*)ptr, type, owner)
38#define SWIG_PointerAddress(object) \
39  SWIG_Guile_PointerAddress(object)
40#define SWIG_PointerType(object) \
41  SWIG_Guile_PointerType(object)
42#define SWIG_IsPointerOfType(object, type) \
43  SWIG_Guile_IsPointerOfType(object, type)
44#define SWIG_IsPointer(object) \
45  SWIG_Guile_IsPointer(object)
46#define SWIG_contract_assert(expr, msg)				\
47  if (!(expr))							\
48    scm_error(scm_str2symbol("swig-contract-assertion-failed"),	\
49	      (char *) FUNC_NAME, (char *) msg,			\
50	      SCM_EOL, SCM_BOOL_F); else
51
52/* for C++ member pointers, ie, member methods */
53#define SWIG_ConvertMember(obj, ptr, sz, ty) \
54  SWIG_Guile_ConvertMember(obj, ptr, sz, ty, FUNC_NAME)
55#define SWIG_NewMemberObj(ptr, sz, type) \
56  SWIG_Guile_NewMemberObj(ptr, sz, type, FUNC_NAME)
57
58/* Runtime API */
59static swig_module_info *SWIG_Guile_GetModule(void);
60#define SWIG_GetModule(clientdata) SWIG_Guile_GetModule()
61#define SWIG_SetModule(clientdata, pointer) SWIG_Guile_SetModule(pointer)
62
63SWIGINTERN char *
64SWIG_Guile_scm2newstr(SCM str, size_t *len) {
65#define FUNC_NAME "SWIG_Guile_scm2newstr"
66  char *ret;
67  size_t l;
68
69  SCM_ASSERT (SCM_STRINGP(str), str, 1, FUNC_NAME);
70
71  l = SCM_STRING_LENGTH(str);
72  ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
73  if (!ret) return NULL;
74
75  memcpy(ret, SCM_STRING_CHARS(str), l);
76  ret[l] = '\0';
77  if (len) *len = l;
78  return ret;
79#undef FUNC_NAME
80}
81
82static int swig_initialized = 0;
83static scm_t_bits swig_tag = 0;
84static scm_t_bits swig_collectable_tag = 0;
85static scm_t_bits swig_destroyed_tag = 0;
86static scm_t_bits swig_member_function_tag = 0;
87static SCM swig_make_func = SCM_EOL;
88static SCM swig_keyword = SCM_EOL;
89static SCM swig_symbol = SCM_EOL;
90
91#define SWIG_Guile_GetSmob(x) \
92  ( SCM_NNULLP(x) && SCM_INSTANCEP(x) && SCM_NFALSEP(scm_slot_exists_p(x, swig_symbol)) \
93      ? scm_slot_ref(x, swig_symbol) : (x) )
94
95SWIGINTERN SCM
96SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner)
97{
98  if (ptr == NULL)
99    return SCM_EOL;
100  else {
101    SCM smob;
102    swig_guile_clientdata *cdata = (swig_guile_clientdata *) type->clientdata;
103    if (owner)
104      SCM_NEWSMOB2(smob, swig_collectable_tag, ptr, (void *) type);
105    else
106      SCM_NEWSMOB2(smob, swig_tag, ptr, (void *) type);
107
108    if (!cdata || SCM_NULLP(cdata->goops_class) || swig_make_func == SCM_EOL ) {
109      return smob;
110    } else {
111      /* the scm_make() C function only handles the creation of gf,
112	 methods and classes (no instances) the (make ...) function is
113	 later redefined in goops.scm.  So we need to call that
114	 Scheme function. */
115      return scm_apply(swig_make_func,
116		       scm_list_3(cdata->goops_class,
117				  swig_keyword,
118				  smob),
119		       SCM_EOL);
120    }
121  }
122}
123
124SWIGINTERN unsigned long
125SWIG_Guile_PointerAddress(SCM object)
126{
127  SCM smob = SWIG_Guile_GetSmob(object);
128  if (SCM_NULLP(smob)) return 0;
129  else if (SCM_SMOB_PREDICATE(swig_tag, smob)
130	   || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)
131	   || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) {
132    return (unsigned long) (void *) SCM_CELL_WORD_1(smob);
133  }
134  else scm_wrong_type_arg("SWIG-Guile-PointerAddress", 1, object);
135}
136
137SWIGINTERN swig_type_info *
138SWIG_Guile_PointerType(SCM object)
139{
140  SCM smob = SWIG_Guile_GetSmob(object);
141  if (SCM_NULLP(smob)) return NULL;
142  else if (SCM_SMOB_PREDICATE(swig_tag, smob)
143	   || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)
144	   || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) {
145    return (swig_type_info *) SCM_CELL_WORD_2(smob);
146  }
147  else scm_wrong_type_arg("SWIG-Guile-PointerType", 1, object);
148}
149
150SWIGINTERN int
151SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags)
152{
153  swig_cast_info *cast;
154  swig_type_info *from;
155  SCM smob = SWIG_Guile_GetSmob(s);
156
157  if (SCM_NULLP(smob)) {
158    *result = NULL;
159    return SWIG_OK;
160  } else if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) {
161    /* we do not accept smobs representing destroyed pointers */
162    from = (swig_type_info *) SCM_CELL_WORD_2(smob);
163    if (!from) return SWIG_ERROR;
164    if (type) {
165      cast = SWIG_TypeCheckStruct(from, type);
166      if (cast) {
167        int newmemory = 0;
168        *result = SWIG_TypeCast(cast, (void *) SCM_CELL_WORD_1(smob), &newmemory);
169        assert(!newmemory); /* newmemory handling not yet implemented */
170        return SWIG_OK;
171      } else {
172        return SWIG_ERROR;
173      }
174    } else {
175      *result = (void *) SCM_CELL_WORD_1(smob);
176      return SWIG_OK;
177    }
178  }
179  return SWIG_ERROR;
180}
181
182SWIGINTERNINLINE void *
183SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
184		       int argnum, int flags, const char *func_name)
185{
186  void *result;
187  int res = SWIG_Guile_ConvertPtr(s, &result, type, flags);
188  if (!SWIG_IsOK(res)) {
189    /* type mismatch */
190    scm_wrong_type_arg((char *) func_name, argnum, s);
191  }
192  return result;
193}
194
195SWIGINTERNINLINE int
196SWIG_Guile_IsPointerOfType (SCM s, swig_type_info *type)
197{
198  void *result;
199  if (SWIG_Guile_ConvertPtr(s, &result, type, 0)) {
200    /* type mismatch */
201    return 0;
202  }
203  else return 1;
204}
205
206SWIGINTERNINLINE int
207SWIG_Guile_IsPointer (SCM s)
208{
209  /* module might not be initialized yet, so initialize it */
210  SWIG_Guile_GetModule();
211  return SWIG_Guile_IsPointerOfType (s, NULL);
212}
213
214/* Mark a pointer object non-collectable */
215SWIGINTERN void
216SWIG_Guile_MarkPointerNoncollectable(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_tag);
222    }
223    else scm_wrong_type_arg(NULL, 0, s);
224  }
225}
226
227/* Mark a pointer object destroyed */
228SWIGINTERN void
229SWIG_Guile_MarkPointerDestroyed(SCM s)
230{
231  SCM smob = SWIG_Guile_GetSmob(s);
232  if (!SCM_NULLP(smob)) {
233    if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) {
234      SCM_SET_CELL_TYPE(smob, swig_destroyed_tag);
235    }
236    else scm_wrong_type_arg(NULL, 0, s);
237  }
238}
239
240/* Member functions */
241
242SWIGINTERN SCM
243SWIG_Guile_NewMemberObj(void *ptr, size_t sz, swig_type_info *type,
244			const char *func_name)
245{
246  SCM smob;
247  void *copy = malloc(sz);
248  memcpy(copy, ptr, sz);
249  SCM_NEWSMOB2(smob, swig_member_function_tag, copy, (void *) type);
250  return smob;
251}
252
253SWIGINTERN int
254SWIG_Guile_ConvertMember(SCM smob, void *ptr, size_t sz, swig_type_info *type,
255			 const char *func_name)
256{
257  swig_cast_info *cast;
258  swig_type_info *from;
259
260  if (SCM_SMOB_PREDICATE(swig_member_function_tag, smob)) {
261    from = (swig_type_info *) SCM_CELL_WORD_2(smob);
262    if (!from) return SWIG_ERROR;
263    if (type) {
264      cast = SWIG_TypeCheckStruct(from, type);
265      if (!cast) return SWIG_ERROR;
266    }
267    memcpy(ptr, (void *) SCM_CELL_WORD_1(smob), sz);
268    return SWIG_OK;
269  }
270  return SWIG_ERROR;
271}
272
273
274/* Init */
275
276SWIGINTERN int
277print_swig_aux (SCM swig_smob, SCM port, scm_print_state *pstate,
278                const char *attribute)
279{
280  swig_type_info *type;
281
282  type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
283  if (type) {
284    scm_puts((char *) "#<", port);
285    scm_puts((char *) attribute, port);
286    scm_puts((char *) "swig-pointer ", port);
287    scm_puts((char *) SWIG_TypePrettyName(type), port);
288    scm_puts((char *) " ", port);
289    scm_intprint((long) SCM_CELL_WORD_1(swig_smob), 16, port);
290    scm_puts((char *) ">", port);
291    /* non-zero means success */
292    return 1;
293  } else {
294    return 0;
295  }
296}
297
298
299SWIGINTERN int
300print_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
301{
302  return print_swig_aux(swig_smob, port, pstate, "");
303}
304
305SWIGINTERN int
306print_collectable_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
307{
308  return print_swig_aux(swig_smob, port, pstate, "collectable-");
309}
310
311SWIGINTERN int
312print_destroyed_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
313{
314  return print_swig_aux(swig_smob, port, pstate, "destroyed-");
315}
316
317SWIGINTERN int
318print_member_function_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
319{
320  swig_type_info *type;
321  type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
322  if (type) {
323    scm_puts((char *) "#<", port);
324    scm_puts((char *) "swig-member-function-pointer ", port);
325    scm_puts((char *) SWIG_TypePrettyName(type), port);
326    scm_puts((char *) " >", port);
327    /* non-zero means success */
328    return 1;
329  } else {
330    return 0;
331  }
332}
333
334SWIGINTERN SCM
335equalp_swig (SCM A, SCM B)
336{
337  if (SCM_CELL_WORD_0(A) == SCM_CELL_WORD_0(B) && SCM_CELL_WORD_1(A) == SCM_CELL_WORD_1(B)
338      && SCM_CELL_WORD_2(A) == SCM_CELL_WORD_2(B))
339    return SCM_BOOL_T;
340  else return SCM_BOOL_F;
341}
342
343SWIGINTERN size_t
344free_swig(SCM A)
345{
346  swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(A);
347  if (type) {
348    if (type->clientdata && ((swig_guile_clientdata *)type->clientdata)->destroy)
349      ((swig_guile_clientdata *)type->clientdata)->destroy(A);
350  }
351  return 0;
352}
353
354SWIGINTERN size_t
355free_swig_member_function(SCM A)
356{
357  free((swig_type_info *) SCM_CELL_WORD_1(A));
358  return 0;
359}
360
361SWIGINTERN int
362ensure_smob_tag(SCM swig_module,
363		scm_t_bits *tag_variable,
364		const char *smob_name,
365		const char *scheme_variable_name)
366{
367  SCM variable = scm_sym2var(scm_str2symbol(scheme_variable_name),
368			     scm_module_lookup_closure(swig_module),
369			     SCM_BOOL_T);
370  if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) {
371    *tag_variable = scm_make_smob_type((char*)scheme_variable_name, 0);
372    SCM_VARIABLE_SET(variable,
373		     scm_ulong2num(*tag_variable));
374    return 1;
375  }
376  else {
377    *tag_variable = scm_num2ulong(SCM_VARIABLE_REF(variable), 0,
378				  "SWIG_Guile_Init");
379    return 0;
380  }
381}
382
383SWIGINTERN SCM
384SWIG_Guile_Init ()
385{
386  static SCM swig_module;
387
388  if (swig_initialized) return swig_module;
389  swig_initialized = 1;
390
391  swig_module = scm_c_resolve_module("Swig swigrun");
392  if (ensure_smob_tag(swig_module, &swig_tag,
393		      "swig-pointer", "swig-pointer-tag")) {
394    scm_set_smob_print(swig_tag, print_swig);
395    scm_set_smob_equalp(swig_tag, equalp_swig);
396  }
397  if (ensure_smob_tag(swig_module, &swig_collectable_tag,
398		      "collectable-swig-pointer", "collectable-swig-pointer-tag")) {
399    scm_set_smob_print(swig_collectable_tag, print_collectable_swig);
400    scm_set_smob_equalp(swig_collectable_tag, equalp_swig);
401    scm_set_smob_free(swig_collectable_tag, free_swig);
402  }
403  if (ensure_smob_tag(swig_module, &swig_destroyed_tag,
404		      "destroyed-swig-pointer", "destroyed-swig-pointer-tag")) {
405    scm_set_smob_print(swig_destroyed_tag, print_destroyed_swig);
406    scm_set_smob_equalp(swig_destroyed_tag, equalp_swig);
407  }
408  if (ensure_smob_tag(swig_module, &swig_member_function_tag,
409		      "swig-member-function-pointer", "swig-member-function-pointer-tag")) {
410    scm_set_smob_print(swig_member_function_tag, print_member_function_swig);
411    scm_set_smob_free(swig_member_function_tag, free_swig_member_function);
412  }
413  swig_make_func = scm_permanent_object(
414  scm_variable_ref(scm_c_module_lookup(scm_c_resolve_module("oop goops"), "make")));
415  swig_keyword = scm_permanent_object(scm_c_make_keyword((char*) "init-smob"));
416  swig_symbol = scm_permanent_object(scm_str2symbol("swig-smob"));
417#ifdef SWIG_INIT_RUNTIME_MODULE
418  SWIG_INIT_RUNTIME_MODULE
419#endif
420
421  return swig_module;
422}
423
424SWIGINTERN swig_module_info *
425SWIG_Guile_GetModule(void)
426{
427  SCM module;
428  SCM variable;
429
430  module = SWIG_Guile_Init();
431
432  variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
433			       scm_module_lookup_closure(module),
434			       SCM_BOOL_T);
435  if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) {
436    return NULL;
437  } else {
438    return (swig_module_info *) scm_num2ulong(SCM_VARIABLE_REF(variable), 0, "SWIG_Guile_Init");
439  }
440}
441
442SWIGINTERN void
443SWIG_Guile_SetModule(swig_module_info *swig_module)
444{
445  SCM module;
446  SCM variable;
447
448  module = SWIG_Guile_Init();
449
450  variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
451			       scm_module_lookup_closure(module),
452			       SCM_BOOL_T);
453
454  SCM_VARIABLE_SET(variable, scm_ulong2num((unsigned long) swig_module));
455}
456
457SWIGINTERN int
458SWIG_Guile_GetArgs (SCM *dest, SCM rest,
459		    int reqargs, int optargs,
460		    const char *procname)
461{
462  int i;
463  int num_args_passed = 0;
464  for (i = 0; i<reqargs; i++) {
465    if (!SCM_CONSP(rest))
466      scm_wrong_num_args(scm_makfrom0str((char *) procname));
467    *dest++ = SCM_CAR(rest);
468    rest = SCM_CDR(rest);
469    num_args_passed++;
470  }
471  for (i = 0; i<optargs && SCM_CONSP(rest); i++) {
472    *dest++ = SCM_CAR(rest);
473    rest = SCM_CDR(rest);
474    num_args_passed++;
475  }
476  for (; i<optargs; i++)
477    *dest++ = SCM_UNDEFINED;
478  if (!SCM_NULLP(rest))
479    scm_wrong_num_args(scm_makfrom0str((char *) procname));
480  return num_args_passed;
481}
482
483#ifdef __cplusplus
484}
485#endif
486