PageRenderTime 40ms CodeModel.GetById 35ms app.highlight 2ms RepoModel.GetById 1ms app.codeStats 0ms

/trunk/Lib/guile/guile_scm_run.swg

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