/tags/rel-1-3-26/SWIG/Lib/chicken/chickenrun.swg

  1/* -*- c -*-
  2 * -----------------------------------------------------------------------
  3 * swig_lib/chicken/chickenrun.swg
  4 *
  5 * Author: John Lenz <jelenz@wisc.edu>
  6 * ----------------------------------------------------------------------- */
  7
  8#include <chicken.h>
  9#include <stdio.h>
 10#include <string.h>
 11#include <stdlib.h>
 12
 13#ifdef __cplusplus
 14extern "C" {
 15#endif
 16
 17#define SWIG_malloc(size) \
 18  malloc(size)
 19#define SWIG_free(mem) \
 20  free(mem)
 21#define SWIG_MakeString(c) \
 22  SWIG_Chicken_MakeString(c)
 23#define SWIG_ConvertPtr(s, result, type, flags) \
 24  SWIG_Chicken_ConvertPtr(s, result, type, flags)
 25#define SWIG_MustGetPtr(s, type, argnum, flags) \
 26  SWIG_Chicken_MustGetPtr(s, type, argnum, flags)
 27#define SWIG_NewPointerObj(ptr, type, owner) \
 28  SWIG_Chicken_NewPointerObj((void*)ptr, type, owner, 1, &known_space)
 29#define SWIG_NewPointerObjProxy(ptr, type, owner, proxy) \
 30  SWIG_Chicken_NewPointerObj((void*)ptr, type, owner, proxy, &known_space)
 31#define swig_barf SWIG_Chicken_Barf
 32#define SWIG_ThrowException(val) SWIG_Chicken_ThrowException(val)
 33
 34#define SWIG_contract_assert(expr, message) if (!(expr)) { \
 35                                              SWIG_Chicken_Barf(SWIG_BARF1_CONTRACT_ASSERT, C_text(message)); } else
 36
 37/* Runtime API */
 38#define SWIG_GetModule(clientdata) SWIG_Chicken_GetModule()
 39#define SWIG_SetModule(clientdata, pointer) SWIG_Chicken_SetModule(pointer)
 40
 41#define C_swig_is_bool(x) C_truep (C_booleanp (x))
 42#define C_swig_is_char(x) C_truep (C_charp (x))
 43#define C_swig_is_fixnum(x) C_truep (C_fixnump (x))
 44#define C_swig_is_flonum(x) (C_truep (C_blockp (x)) && C_truep (C_flonump (x)))
 45#define C_swig_is_string(x) (C_truep (C_blockp (x)) && C_truep (C_stringp (x)))
 46#define C_swig_is_vector(x) (C_truep (C_blockp (x)) && C_truep (C_vectorp (x)))
 47#define C_swig_is_list(x) (C_truep (C_i_listp (x)))
 48#define C_swig_is_pair(x) (C_truep (C_blockp(x)) && C_truep (C_pairp(x)))
 49#define C_swig_is_ptr(x) (C_truep (C_blockp (x)) && C_truep (C_pointerp (x)))
 50#define C_swig_is_swigpointer(x) (C_truep (C_blockp(x)) && C_truep (C_swigpointerp(x)))
 51#define C_swig_is_closurep(x) (C_truep (C_blockp(x)) && C_truep(C_closurep(x)))
 52#define C_swig_is_number(x) (C_swig_is_fixnum(x) || C_swig_is_flonum(x))
 53#define C_swig_is_long(x) C_swig_is_number(x)
 54
 55#define SWIG_APPEND_VALUE(object) \
 56  if (resultobj == C_SCHEME_UNDEFINED) \
 57    resultobj = object; \
 58  else { \
 59    C_word *pair_space = C_alloc(C_SIZEOF_PAIR); \
 60    if (!gswig_list_p) { \
 61      gswig_list_p = 1; \
 62      C_word *pair_space2 = C_alloc(C_SIZEOF_PAIR); \
 63      resultobj = C_pair(&pair_space2, resultobj, C_SCHEME_END_OF_LIST); \
 64      resultobjlast = resultobj; \
 65    } \
 66    C_word tmp = C_pair(&pair_space, object, C_SCHEME_END_OF_LIST); \
 67    C_set_block_item(resultobjlast, 1, tmp); \
 68    resultobjlast = tmp; \
 69  }
 70
 71/* given a SWIG pointer wrapped in a C_word, return the proxy create function, if any */
 72#define SWIG_Chicken_FindCreateProxy(val, x) \
 73  if (C_swig_is_swigpointer(x)) { \
 74    swig_type_info *t = (swig_type_info *) C_block_item(x, 1); \
 75    if (t && t->clientdata &&    ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create) { \
 76      val = CHICKEN_gc_root_ref( ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create); \
 77    } else { \
 78      val = C_SCHEME_FALSE; \
 79    } \
 80  } else { \
 81    val = C_SCHEME_FALSE; \
 82  }
 83
 84#define SWIG_POINTER_DISOWN 1
 85
 86enum {
 87  SWIG_BARF1_BAD_ARGUMENT_TYPE /* 1 arg */,
 88  SWIG_BARF1_ARGUMENT_NULL /* 1 arg */,
 89  SWIG_BARF1_CONTRACT_ASSERT /* 1 arg */,
 90};
 91
 92typedef C_word (*swig_chicken_destructor)(C_word,C_word,C_word,C_word);
 93typedef struct swig_chicken_clientdata {
 94  void *gc_proxy_create;
 95  swig_chicken_destructor destroy;
 96} swig_chicken_clientdata;
 97  
 98static char *
 99SWIG_Chicken_MakeString(C_word str) {
100  char *ret;
101  size_t l;
102
103  l = C_header_size(str);
104  ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
105  if (!ret) return NULL;
106
107  memcpy(ret, C_c_string(str), l);
108  ret[l] = '\0';
109  return ret;
110}
111
112static C_word SWIG_Chicken_LookupSymbol(char *name, C_SYMBOL_TABLE *stable) {
113  C_word *a = C_alloc(C_SIZEOF_STRING (strlen (name)));
114  C_word n = C_string2(&a, name);
115  C_word sym = C_find_symbol(n, stable);
116  if (C_truep(sym)) {
117    return C_symbol_value(sym);
118  } else {
119    return C_SCHEME_FALSE;
120  }
121}
122
123/* Just a helper function.  Do not export it */
124static void SWIG_Chicken_Panic (C_char *) C_noret;
125static void SWIG_Chicken_Panic (C_char *msg)
126{
127  C_word *a = C_alloc (C_SIZEOF_STRING (strlen (msg)));
128  C_word scmmsg = C_string2 (&a, msg);
129  C_halt (scmmsg);
130  exit (5); /* should never get here */
131}
132
133static void
134SWIG_Chicken_Barf(int code, C_char *msg, ...) C_noret;
135static void
136SWIG_Chicken_Barf(int code, C_char *msg, ...)
137{
138  char *errorhook = C_text("\003syserror-hook");
139  C_word *a = C_alloc (C_SIZEOF_STRING (strlen (errorhook)));
140  C_word err = C_intern2 (&a, errorhook);
141  int c = -1;
142  int i, barfval;
143  va_list v;
144
145  
146  C_temporary_stack = C_temporary_stack_bottom;
147  err = C_block_item(err, 0);
148
149  if(C_immediatep (err))
150    SWIG_Chicken_Panic (C_text ("`##sys#error-hook' is not defined"));
151
152  switch (code) {
153  case SWIG_BARF1_BAD_ARGUMENT_TYPE:
154    barfval = C_BAD_ARGUMENT_TYPE_ERROR;
155    c = 1;
156    break;
157  case SWIG_BARF1_ARGUMENT_NULL:
158    barfval = C_BAD_ARGUMENT_TYPE_ERROR;
159    c = 1;
160    break;
161  case SWIG_BARF1_CONTRACT_ASSERT:
162    barfval = C_BAD_ARGUMENT_TYPE_ERROR;
163    c = 1;
164    break;
165  default:
166    SWIG_Chicken_Panic (C_text (msg));
167  };
168
169  if(c > 0 && !C_immediatep (err)) {
170    C_save (C_fix (barfval));
171
172    i = c;
173    if (i) {
174      C_word *b = C_alloc (C_SIZEOF_STRING (strlen (msg)));
175      C_word scmmsg = C_string2 (&b, msg);
176      C_save (scmmsg);
177      i--;
178    }
179
180    va_start (v, msg);
181
182    while(i--)
183      C_save (va_arg (v, C_word));
184
185    va_end (v);
186    C_do_apply (c + 1, err, 
187		C_SCHEME_UNDEFINED);  /* <- no continuation is passed:
188					 '##sys#error-hook' may not
189					 return! */
190  }
191  else if (msg) {
192    SWIG_Chicken_Panic (msg);
193  }
194  else {
195    SWIG_Chicken_Panic (C_text ("unspecified panic"));
196  }
197}
198
199static void SWIG_Chicken_ThrowException(C_word value) C_noret;
200static void SWIG_Chicken_ThrowException(C_word value)
201{
202  char *aborthook = C_text("\003sysabort");
203  C_word *a = C_alloc(C_SIZEOF_STRING(strlen(aborthook)));
204  C_word abort = C_intern2(&a, aborthook);
205
206  abort = C_block_item(abort, 0);
207  if (C_immediatep(abort))
208    SWIG_Chicken_Panic(C_text("`##sys#abort' is not defined"));
209
210  C_save(value);
211  C_do_apply(1, abort, C_SCHEME_UNDEFINED);
212}
213
214static void
215SWIG_Chicken_Finalizer(C_word argc, C_word closure, C_word continuation, C_word s)
216{
217  swig_type_info *type;
218  swig_chicken_clientdata *cdata;
219
220  if (argc == 3 && s != C_SCHEME_FALSE && C_swig_is_swigpointer(s)) {
221    type = (swig_type_info *) C_block_item(s, 1);
222    if (type) {
223      cdata = (swig_chicken_clientdata *) type->clientdata;
224      if (cdata && cdata->destroy) {
225	/* this will not return, but will continue correctly */
226        cdata->destroy(3,closure,continuation,s);
227      }
228    }
229  }
230  C_kontinue(continuation, C_SCHEME_UNDEFINED);
231}
232static C_word finalizer_obj[2] = {(C_word) (C_CLOSURE_TYPE|1), (C_word) SWIG_Chicken_Finalizer};
233
234static C_word
235SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, int create_proxy, C_word **data)
236{
237  swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) type->clientdata;
238
239  if (ptr == NULL)
240    return C_SCHEME_FALSE;
241  else {
242    C_word cptr = C_swigmpointer(data, ptr, type);
243    /* add finalizer to object */
244    #ifndef SWIG_CHICKEN_NO_COLLECTION
245    if (owner)
246      C_do_register_finalizer(cptr, (C_word) finalizer_obj);
247    #endif
248
249    /* wrap the result inside a proxy class if one is available */
250    if (create_proxy && cdata && cdata->gc_proxy_create) {
251      C_word closure = CHICKEN_gc_root_ref(cdata->gc_proxy_create);
252      if (C_swig_is_closurep(closure)) {
253        C_save(cptr);
254        return C_callback(closure, 1);
255      }
256    }
257    return cptr;
258  }
259}
260
261/* Return 0 if successful. */
262static int
263SWIG_Chicken_ConvertPtr(C_word s, void **result, swig_type_info *type, int flags)
264{
265  swig_cast_info *cast;
266  swig_type_info *from;
267
268  if (s == C_SCHEME_FALSE) {
269    *result = NULL;
270  } else if (C_swig_is_swigpointer(s)) {
271    /* try and convert type */
272    from = (swig_type_info *) C_block_item(s, 1);
273    if (!from) return 1;
274    if (type) {
275      cast = SWIG_TypeCheckStruct(from, type);
276      if (cast) {
277        *result = SWIG_TypeCast(cast, (void *) C_block_item(s, 0));
278      } else {
279        return 1;
280      }
281    } else {
282      *result = (void *) C_block_item(s, 0);
283    }
284
285    /* check if we are disowning this object */
286    if (flags & SWIG_POINTER_DISOWN) {
287      C_do_unregister_finalizer(s);
288    }
289  } else {
290    return 1;
291  }
292
293  return 0;
294}
295
296static SWIGINLINE void *
297SWIG_Chicken_MustGetPtr (C_word s, swig_type_info *type, int argnum, int flags)
298{
299  void *result;
300  char err_msg[256];
301  if (SWIG_Chicken_ConvertPtr(s, &result, type, flags)) {
302    /* type mismatch */
303    snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", argnum, (type->str ? type->str : type->name));
304    SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
305  }
306  return result;
307}
308
309static char *chicken_runtimevar_name = "type_pointer" SWIG_TYPE_TABLE_NAME;
310
311static swig_module_info *
312SWIG_Chicken_GetModule() {
313    swig_module_info *ret = 0;
314    C_word sym;
315
316    /* lookup the type pointer... it is stored in it's own symbol table */
317    C_SYMBOL_TABLE *stable = C_find_symbol_table("swig_runtime_data" SWIG_RUNTIME_VERSION);
318    if (stable != NULL) {
319      sym = SWIG_Chicken_LookupSymbol(chicken_runtimevar_name, stable);
320      if (C_truep(sym) && C_swig_is_ptr(sym)) {
321        ret = (swig_module_info *) C_block_item(sym, 0);
322      }
323    }
324
325    return ret;
326}
327
328static void
329SWIG_Chicken_SetModule(swig_module_info *module) {
330    C_word *a;
331    C_SYMBOL_TABLE *stable;
332    C_word sym;
333    C_word pointer;
334    static C_word *space = 0;
335    
336    /* type pointer is stored in it's own symbol table */
337    stable = C_find_symbol_table("swig_runtime_data" SWIG_RUNTIME_VERSION);
338    if (stable == NULL) {
339      stable = C_new_symbol_table("swig_runtime_data" SWIG_RUNTIME_VERSION, 16);
340    }
341
342    if (!space) {
343      space = (C_word *) C_malloc((C_SIZEOF_POINTER + C_SIZEOF_INTERNED_SYMBOL(C_strlen(chicken_runtimevar_name))) * sizeof(C_word));
344    }
345    a = space;
346    pointer = C_mpointer(&a, (void *) module);
347    sym = C_intern_in(&a, C_strlen(chicken_runtimevar_name), chicken_runtimevar_name, stable);
348    C_set_block_item(sym, 0, pointer);
349}
350
351#ifdef __cplusplus
352}
353#endif