Home | History | Annotate | Download | only in chicken
      1 /* -----------------------------------------------------------------------------
      2  * chickenrun.swg
      3  * ----------------------------------------------------------------------------- */
      4 
      5 #include <chicken.h>
      6 #include <assert.h>
      7 #include <stdio.h>
      8 #include <string.h>
      9 #include <stdlib.h>
     10 #if defined(_MSC_VER) || defined(__BORLANDC__) || defined(_WATCOM)
     11 # ifndef snprintf
     12 #  define snprintf _snprintf
     13 # endif
     14 #endif
     15 
     16 #ifdef __cplusplus
     17 extern "C" {
     18 #endif
     19 
     20 #define SWIG_malloc(size) \
     21   malloc(size)
     22 #define SWIG_free(mem) \
     23   free(mem)
     24 #define SWIG_MakeString(c) \
     25   SWIG_Chicken_MakeString(c)
     26 #define SWIG_ConvertPtr(s, result, type, flags) \
     27   SWIG_Chicken_ConvertPtr(s, result, type, flags)
     28 #define SWIG_MustGetPtr(s, type, argnum, flags) \
     29   SWIG_Chicken_MustGetPtr(s, type, argnum, flags)
     30 #define SWIG_NewPointerObj(ptr, type, owner) \
     31   SWIG_Chicken_NewPointerObj((void*)ptr, type, owner, &known_space)
     32 #define swig_barf SWIG_Chicken_Barf
     33 #define SWIG_ThrowException(val) SWIG_Chicken_ThrowException(val)
     34 
     35 #define SWIG_contract_assert(expr, message) if (!(expr)) { \
     36                                               SWIG_Chicken_Barf(SWIG_BARF1_CONTRACT_ASSERT, C_text(message)); } else
     37 
     38 /* Runtime API */
     39 #define SWIG_GetModule(clientdata) SWIG_Chicken_GetModule(clientdata)
     40 #define SWIG_SetModule(clientdata, pointer) SWIG_Chicken_SetModule(pointer)
     41 
     42 #define C_swig_is_bool(x) C_truep (C_booleanp (x))
     43 #define C_swig_is_char(x) C_truep (C_charp (x))
     44 #define C_swig_is_fixnum(x) C_truep (C_fixnump (x))
     45 #define C_swig_is_flonum(x) (C_truep (C_blockp (x)) && C_truep (C_flonump (x)))
     46 #define C_swig_is_string(x) (C_truep (C_blockp (x)) && C_truep (C_stringp (x)))
     47 #define C_swig_is_vector(x) (C_truep (C_blockp (x)) && C_truep (C_vectorp (x)))
     48 #define C_swig_is_list(x) (C_truep (C_i_listp (x)))
     49 #define C_swig_is_pair(x) (C_truep (C_blockp(x)) && C_truep (C_pairp(x)))
     50 #define C_swig_is_ptr(x) (C_truep (C_blockp (x)) && C_truep (C_pointerp (x)))
     51 #define C_swig_is_swigpointer(x) (C_truep (C_blockp(x)) && C_truep (C_swigpointerp(x)))
     52 #define C_swig_is_closurep(x) (C_truep (C_blockp(x)) && C_truep(C_closurep(x)))
     53 #define C_swig_is_number(x) (C_swig_is_fixnum(x) || C_swig_is_flonum(x))
     54 #define C_swig_is_long(x) C_swig_is_number(x)
     55 
     56 #define C_swig_sizeof_closure(num) (num+1)
     57 
     58 #define SWIG_Chicken_SetupArgout { \
     59   C_word *a = C_alloc(C_swig_sizeof_closure(2)); \
     60   C_word *closure = a; \
     61   *(a++)=C_CLOSURE_TYPE|2; \
     62   *(a++)=(C_word)SWIG_Chicken_ApplyResults; \
     63   *(a++)=continuation; \
     64   continuation=(C_word)closure; \
     65 }
     66 
     67 #define SWIG_APPEND_VALUE(obj) { \
     68   C_word val = (C_word)(obj); \
     69   if (val != C_SCHEME_UNDEFINED) { \
     70     C_word *a = C_alloc(C_swig_sizeof_closure(3)); \
     71     C_word *closure = a; \
     72     *(a++)=C_CLOSURE_TYPE|3; \
     73     *(a++)=(C_word)SWIG_Chicken_MultiResultBuild; \
     74     *(a++)=(C_word)continuation; \
     75     *(a++)=val; \
     76     continuation=(C_word)closure; \
     77   } }
     78 
     79 #define SWIG_Chicken_FindCreateProxy(func,obj) \
     80   if (C_swig_is_swigpointer(obj)) { \
     81     swig_type_info *t = (swig_type_info *) C_block_item(obj, 1); \
     82     if (t && t->clientdata &&    ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create) { \
     83       func = CHICKEN_gc_root_ref( ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create); \
     84     } else { \
     85       func = C_SCHEME_FALSE; \
     86     } \
     87   } else { \
     88     func = C_SCHEME_FALSE; \
     89   }
     90 
     91 
     92 enum {
     93   SWIG_BARF1_BAD_ARGUMENT_TYPE /* 1 arg */,
     94   SWIG_BARF1_ARGUMENT_NULL /* 1 arg */,
     95   SWIG_BARF1_CONTRACT_ASSERT /* 1 arg */,
     96 };
     97 
     98 typedef C_word (*swig_chicken_destructor)(C_word,C_word,C_word,C_word);
     99 typedef struct swig_chicken_clientdata {
    100   void *gc_proxy_create;
    101   swig_chicken_destructor destroy;
    102 } swig_chicken_clientdata;
    103 
    104 static char *
    105 SWIG_Chicken_MakeString(C_word str) {
    106   char *ret;
    107   size_t l;
    108 
    109   l = C_header_size(str);
    110   ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
    111   if (!ret) return NULL;
    112 
    113   memcpy(ret, C_c_string(str), l);
    114   ret[l] = '\0';
    115   return ret;
    116 }
    117 
    118 static C_word SWIG_Chicken_LookupSymbol(char *name, C_SYMBOL_TABLE *stable) {
    119   C_word *a = C_alloc(C_SIZEOF_STRING (strlen (name)));
    120   C_word n = C_string2(&a, name);
    121   C_word sym = C_find_symbol(n, stable);
    122   if (C_truep(sym)) {
    123     return C_symbol_value(sym);
    124   } else {
    125     return C_SCHEME_FALSE;
    126   }
    127 }
    128 
    129 /* Just a helper function.  Do not export it */
    130 static void SWIG_Chicken_Panic (C_char *) C_noret;
    131 static void SWIG_Chicken_Panic (C_char *msg)
    132 {
    133   C_word *a = C_alloc (C_SIZEOF_STRING (strlen (msg)));
    134   C_word scmmsg = C_string2 (&a, msg);
    135   C_halt (scmmsg);
    136   exit (5); /* should never get here */
    137 }
    138 
    139 static void
    140 SWIG_Chicken_Barf(int code, C_char *msg, ...) C_noret;
    141 static void
    142 SWIG_Chicken_Barf(int code, C_char *msg, ...)
    143 {
    144   char *errorhook = C_text("\003syserror-hook");
    145   C_word *a = C_alloc (C_SIZEOF_STRING (strlen (errorhook)));
    146   C_word err = C_intern2 (&a, errorhook);
    147   int c = -1;
    148   int i, barfval;
    149   va_list v;
    150 
    151 
    152   C_temporary_stack = C_temporary_stack_bottom;
    153   err = C_block_item(err, 0);
    154 
    155   if(C_immediatep (err))
    156     SWIG_Chicken_Panic (C_text ("`##sys#error-hook' is not defined"));
    157 
    158   switch (code) {
    159   case SWIG_BARF1_BAD_ARGUMENT_TYPE:
    160     barfval = C_BAD_ARGUMENT_TYPE_ERROR;
    161     c = 1;
    162     break;
    163   case SWIG_BARF1_ARGUMENT_NULL:
    164     barfval = C_BAD_ARGUMENT_TYPE_ERROR;
    165     c = 1;
    166     break;
    167   case SWIG_BARF1_CONTRACT_ASSERT:
    168     barfval = C_BAD_ARGUMENT_TYPE_ERROR;
    169     c = 1;
    170     break;
    171   default:
    172     SWIG_Chicken_Panic (C_text (msg));
    173   };
    174 
    175   if(c > 0 && !C_immediatep (err)) {
    176     C_save (C_fix (barfval));
    177 
    178     i = c;
    179     if (i) {
    180       C_word *b = C_alloc (C_SIZEOF_STRING (strlen (msg)));
    181       C_word scmmsg = C_string2 (&b, msg);
    182       C_save (scmmsg);
    183       i--;
    184     }
    185 
    186     va_start (v, msg);
    187 
    188     while(i--)
    189       C_save (va_arg (v, C_word));
    190 
    191     va_end (v);
    192     C_do_apply (c + 1, err,
    193 		C_SCHEME_UNDEFINED);  /* <- no continuation is passed:
    194 					 '##sys#error-hook' may not
    195 					 return! */
    196   }
    197   else if (msg) {
    198     SWIG_Chicken_Panic (msg);
    199   }
    200   else {
    201     SWIG_Chicken_Panic (C_text ("unspecified panic"));
    202   }
    203 }
    204 
    205 static void SWIG_Chicken_ThrowException(C_word value) C_noret;
    206 static void SWIG_Chicken_ThrowException(C_word value)
    207 {
    208   char *aborthook = C_text("\003sysabort");
    209   C_word *a = C_alloc(C_SIZEOF_STRING(strlen(aborthook)));
    210   C_word abort = C_intern2(&a, aborthook);
    211 
    212   abort = C_block_item(abort, 0);
    213   if (C_immediatep(abort))
    214     SWIG_Chicken_Panic(C_text("`##sys#abort' is not defined"));
    215 
    216   C_save(value);
    217   C_do_apply(1, abort, C_SCHEME_UNDEFINED);
    218 }
    219 
    220 static void
    221 SWIG_Chicken_Finalizer(C_word argc, C_word closure, C_word continuation, C_word s)
    222 {
    223   swig_type_info *type;
    224   swig_chicken_clientdata *cdata;
    225 
    226   if (argc == 3 && s != C_SCHEME_FALSE && C_swig_is_swigpointer(s)) {
    227     type = (swig_type_info *) C_block_item(s, 1);
    228     if (type) {
    229       cdata = (swig_chicken_clientdata *) type->clientdata;
    230       if (cdata && cdata->destroy) {
    231 	/* this will not return, but will continue correctly */
    232         cdata->destroy(3,closure,continuation,s);
    233       }
    234     }
    235   }
    236   C_kontinue(continuation, C_SCHEME_UNDEFINED);
    237 }
    238 static C_word finalizer_obj[2] = {(C_word) (C_CLOSURE_TYPE|1), (C_word) SWIG_Chicken_Finalizer};
    239 
    240 static C_word
    241 SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word **data)
    242 {
    243   swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) type->clientdata;
    244 
    245   if (ptr == NULL)
    246     return C_SCHEME_FALSE;
    247   else {
    248     C_word cptr = C_swigmpointer(data, ptr, type);
    249     /* add finalizer to object */
    250     #ifndef SWIG_CHICKEN_NO_COLLECTION
    251     if (owner)
    252       C_do_register_finalizer(cptr, (C_word) finalizer_obj);
    253     #endif
    254 
    255     return cptr;
    256   }
    257 }
    258 
    259 /* Return 0 if successful. */
    260 static int
    261 SWIG_Chicken_ConvertPtr(C_word s, void **result, swig_type_info *type, int flags)
    262 {
    263   swig_cast_info *cast;
    264   swig_type_info *from;
    265 
    266   if (s == C_SCHEME_FALSE) {
    267     *result = NULL;
    268   } else if (C_swig_is_swigpointer(s)) {
    269     /* try and convert type */
    270     from = (swig_type_info *) C_block_item(s, 1);
    271     if (!from) return 1;
    272     if (type) {
    273       cast = SWIG_TypeCheckStruct(from, type);
    274       if (cast) {
    275         int newmemory = 0;
    276         *result = SWIG_TypeCast(cast, (void *) C_block_item(s, 0), &newmemory);
    277         assert(!newmemory); /* newmemory handling not yet implemented */
    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 
    296 static SWIGINLINE void *
    297 SWIG_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 
    309 static char *chicken_runtimevar_name = "type_pointer" SWIG_TYPE_TABLE_NAME;
    310 
    311 static swig_module_info *
    312 SWIG_Chicken_GetModule(void *SWIGUNUSEDPARM(clientdata)) {
    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 
    328 static void
    329 SWIG_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 static C_word SWIG_Chicken_MultiResultBuild(C_word num, C_word closure, C_word lst) {
    352   C_word cont = C_block_item(closure,1);
    353   C_word obj = C_block_item(closure,2);
    354   C_word func;
    355 
    356   SWIG_Chicken_FindCreateProxy(func,obj);
    357 
    358   if (C_swig_is_closurep(func)) {
    359     ((C_proc4)(void *)C_block_item(func, 0))(4,func,cont,obj,lst);
    360   } else {
    361     C_word *a = C_alloc(C_SIZEOF_PAIR);
    362     C_kontinue(cont,C_pair(&a,obj,lst));
    363   }
    364   return C_SCHEME_UNDEFINED; /* never reached */
    365 }
    366 
    367 static C_word SWIG_Chicken_ApplyResults(C_word num, C_word closure, C_word result) {
    368   C_apply_values(3,C_SCHEME_UNDEFINED,C_block_item(closure,1),result);
    369   return C_SCHEME_UNDEFINED; /* never reached */
    370 }
    371 
    372 #ifdef __cplusplus
    373 }
    374 #endif
    375