Lib/mzscheme/mzrun.swg

   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  * mzrun.swg
   6  * ----------------------------------------------------------------------------- */
   7
   8 #include <stdio.h>
   9 #include <string.h>
  10 #include <stdlib.h>
  11 #include <limits.h>
  12 #include <escheme.h>
  13 #include <assert.h>
  14
  15 #ifdef __cplusplus
  16 extern "C" {
  17 #endif
  18
  19 /* Common SWIG API */
  20
  21 #define SWIG_ConvertPtr(s, result, type, flags) \
  22   SWIG_MzScheme_ConvertPtr(s, result, type, flags)
  23 #define SWIG_NewPointerObj(ptr, type, owner) \
  24   SWIG_MzScheme_NewPointerObj((void *)ptr, type, owner)
  25 #define SWIG_MustGetPtr(s, type, argnum, flags) \
  26   SWIG_MzScheme_MustGetPtr(s, type, argnum, flags, FUNC_NAME, argc, argv)
  27
  28 #define SWIG_contract_assert(expr,msg) \
  29  if (!(expr)) { \
  30     char *m=(char *) scheme_malloc(strlen(msg)+1000); \
  31     sprintf(m,"SWIG contract, assertion failed: function=%s, message=%s", \
  32             (char *) FUNC_NAME,(char *) msg); \
  33     scheme_signal_error(m); \
  34  }
  35
  36 /* Runtime API */
  37 #define SWIG_GetModule(clientdata) SWIG_MzScheme_GetModule((Scheme_Env *)(clientdata))
  38 #define SWIG_SetModule(clientdata, pointer) SWIG_MzScheme_SetModule((Scheme_Env *) (clientdata), pointer)
  39 #define SWIG_MODULE_CLIENTDATA_TYPE Scheme_Env *
  40
  41 /* MzScheme-specific SWIG API */
  42
  43 #define SWIG_malloc(size) SWIG_MzScheme_Malloc(size, FUNC_NAME)
  44 #define SWIG_free(mem) free(mem)
  45 #define SWIG_NewStructFromPtr(ptr,type) \
  46         _swig_convert_struct_##type##(ptr)
  47
  48 #define MAXVALUES 6
  49 #define swig_make_boolean(b) (b ? scheme_true : scheme_false)
  50
  51 static long
  52 SWIG_convert_integer(Scheme_Object *o,
  53                      long lower_bound, long upper_bound,
  54                      const char *func_name, int argnum, int argc,
  55                      Scheme_Object **argv)
  56 {
  57   long value;
  58   int status = scheme_get_int_val(o, &value);
  59   if (!status)
  60     scheme_wrong_type(func_name, "integer", argnum, argc, argv);
  61   if (value < lower_bound || value > upper_bound)
  62     scheme_wrong_type(func_name, "integer", argnum, argc, argv);
  63   return value;
  64 }
  65
  66 static int
  67 SWIG_is_integer(Scheme_Object *o)
  68 {
  69   long value;
  70   return scheme_get_int_val(o, &value);
  71 }
  72
  73 static unsigned long
  74 SWIG_convert_unsigned_integer(Scheme_Object *o,
  75                               unsigned long lower_bound, unsigned long upper_bound,
  76                               const char *func_name, int argnum, int argc,
  77                               Scheme_Object **argv)
  78 {
  79   unsigned long value;
  80   int status = scheme_get_unsigned_int_val(o, &value);
  81   if (!status)
  82     scheme_wrong_type(func_name, "integer", argnum, argc, argv);
  83   if (value < lower_bound || value > upper_bound)
  84     scheme_wrong_type(func_name, "integer", argnum, argc, argv);
  85   return value;
  86 }
  87
  88 static int
  89 SWIG_is_unsigned_integer(Scheme_Object *o)
  90 {
  91   unsigned long value;
  92   return scheme_get_unsigned_int_val(o, &value);
  93 }
  94
  95 /* -----------------------------------------------------------------------
  96  * mzscheme 30X support code
  97  * Contributed by Hans Oesterholt
  98  * ----------------------------------------------------------------------- */
  99
 100 #ifndef SCHEME_STR_VAL
 101 #define MZSCHEME30X 1
 102 #endif
 103
 104 #ifdef MZSCHEME30X
 105 /*
 106  * This is MZSCHEME 299.100 or higher (30x).  From version 299.100 of
 107  * mzscheme upwards, strings are in unicode. These functions convert
 108  * to and from utf8 encodings of these strings.  NB! strlen(s) will be
 109  * the size in bytes of the string, not the actual length.
 110  */
 111 #define SCHEME_STR_VAL(obj)            SCHEME_BYTE_STR_VAL(scheme_char_string_to_byte_string(obj))
 112 #define SCHEME_STRLEN_VAL(obj)         SCHEME_BYTE_STRLEN_VAL(scheme_char_string_to_byte_string(obj))
 113 #define SCHEME_STRINGP(obj)            SCHEME_CHAR_STRINGP(obj)
 114 #define scheme_make_string(s)          scheme_make_utf8_string(s)
 115 #define scheme_make_sized_string(s,l)  scheme_make_sized_utf8_string(s,l)
 116 #define scheme_make_sized_offset_string(s,d,l) \
 117                    scheme_make_sized_offset_utf8_string(s,d,l)
 118 #define SCHEME_MAKE_STRING(s) scheme_make_utf8_string(s)
 119 #else
 120 #define SCHEME_MAKE_STRING(s) scheme_make_string_without_copying(s)
 121 #endif
 122 /* -----------------------------------------------------------------------
 123  * End of mzscheme 30X support code
 124  * ----------------------------------------------------------------------- */
 125
 126 struct swig_mz_proxy {
 127   Scheme_Type mztype;
 128   swig_type_info *type;
 129   void *object;
 130 };
 131
 132 static Scheme_Type swig_type;
 133
 134 static void
 135 mz_free_swig(void *p, void *data) {
 136   struct swig_mz_proxy *proxy = (struct swig_mz_proxy *) p;
 137   if (SCHEME_NULLP((Scheme_Object*)p) || SCHEME_TYPE((Scheme_Object*)p) != swig_type)
 138     return;
 139   if (proxy->type) {
 140     if (proxy->type->clientdata) {
 141       ((Scheme_Prim *)proxy->type->clientdata)(1, (Scheme_Object **)&proxy);
 142     }
 143   }
 144 }
 145
 146 static Scheme_Object *
 147 SWIG_MzScheme_NewPointerObj(void *ptr, swig_type_info *type, int owner) {
 148   struct swig_mz_proxy *new_proxy;
 149   new_proxy = (struct swig_mz_proxy *) scheme_malloc(sizeof(struct swig_mz_proxy));
 150   new_proxy->mztype = swig_type;
 151   new_proxy->type = type;
 152   new_proxy->object = ptr;
 153   if (owner) {
 154     scheme_add_finalizer(new_proxy, mz_free_swig, NULL);
 155   }
 156   return (Scheme_Object *) new_proxy;
 157 }
 158
 159 static int
 160 SWIG_MzScheme_ConvertPtr(Scheme_Object *s, void **result, swig_type_info *type, int flags) {
 161   swig_cast_info *cast;
 162
 163   if (SCHEME_NULLP(s)) {
 164     *result = NULL;
 165     return 0;
 166   } else if (SCHEME_TYPE(s) == swig_type) {
 167     struct swig_mz_proxy *proxy = (struct swig_mz_proxy *) s;
 168     if (type) {
 169       cast = SWIG_TypeCheckStruct(proxy->type, type);
 170       if (cast) {
 171         int newmemory = 0;
 172         *result = SWIG_TypeCast(cast, proxy->object, &newmemory);
 173         assert(!newmemory); /* newmemory handling not yet implemented */
 174         return 0;
 175       } else {
 176         return 1;
 177       }
 178     } else {
 179       *result = proxy->object;
 180       return 0;
 181     }
 182   }
 183   return 1;
 184 }
 185
 186 static SWIGINLINE void *
 187 SWIG_MzScheme_MustGetPtr(Scheme_Object *s, swig_type_info *type,
 188                          int argnum, int flags, const char *func_name,
 189                          int argc, Scheme_Object **argv) {
 190   void *result;
 191   if (SWIG_MzScheme_ConvertPtr(s, &result, type, flags)) {
 192     scheme_wrong_type(func_name, type->str ? type->str : "void *", argnum - 1, argc, argv);
 193   }
 194   return result;
 195 }
 196
 197 static SWIGINLINE void *
 198 SWIG_MzScheme_Malloc(size_t size, const char *func_name) {
 199   void *p = malloc(size);
 200   if (p == NULL) {
 201     scheme_signal_error("swig-memory-error");
 202   } else return p;
 203 }
 204
 205 static Scheme_Object *
 206 SWIG_MzScheme_PackageValues(int num, Scheme_Object **values) {
 207     /* ignore first value if void */
 208     if (num > 0 && SCHEME_VOIDP(values[0]))
 209         num--, values++;
 210     if (num == 0) return scheme_void;
 211     else if (num == 1) return values[0];
 212     else return scheme_values(num, values);
 213 }
 214
 215 #ifndef scheme_make_inspector
 216 #define scheme_make_inspector(x,y) \
 217         _scheme_apply(scheme_builtin_value("make-inspector"), x, y)
 218 #endif
 219
 220 /* Function to create a new struct. */
 221 static Scheme_Object *
 222 SWIG_MzScheme_new_scheme_struct (Scheme_Env* env, const char* basename,
 223                                  int num_fields, char** field_names)
 224 {
 225     Scheme_Object *new_type;
 226     int count_out, i;
 227     Scheme_Object **struct_names;
 228     Scheme_Object **vals;
 229     Scheme_Object **a = (Scheme_Object**) \
 230         scheme_malloc(num_fields*sizeof(Scheme_Object*));
 231
 232     for (i=0; i<num_fields; ++i) {
 233         a[i] = (Scheme_Object*) scheme_intern_symbol(field_names[i]);
 234     }
 235
 236     new_type = scheme_make_struct_type(scheme_intern_symbol(basename),
 237                                        NULL /*super_type*/,
 238                                        scheme_make_inspector(0, NULL),
 239                                        num_fields,
 240                                        0 /* auto_fields */,
 241                                        NULL /* auto_val */,
 242                                        NULL /* properties */
 243 #ifdef MZSCHEME30X
 244                                        ,NULL /* Guard */
 245 #endif
 246                                        );
 247     struct_names = scheme_make_struct_names(scheme_intern_symbol(basename),
 248                                             scheme_build_list(num_fields,a),
 249                                             0 /*flags*/, &count_out);
 250     vals = scheme_make_struct_values(new_type, struct_names, count_out, 0);
 251
 252     for (i = 0; i < count_out; i++)
 253         scheme_add_global_symbol(struct_names[i], vals[i],env);
 254
 255     return new_type;
 256 }
 257
 258 /*** DLOPEN PATCH ******************************************************
 259  * Contributed by Hans Oesterholt-Dijkema (jan. 2006)
 260  ***********************************************************************/
 261
 262 #if defined(_WIN32) || defined(__WIN32__)
 263 #define __OS_WIN32
 264 #endif
 265
 266 #ifdef __OS_WIN32
 267 #include <windows.h>
 268 #else
 269 #include <dlfcn.h>
 270 #endif
 271
 272   static char **mz_dlopen_libraries=NULL;
 273   static void **mz_libraries=NULL;
 274   static char **mz_dynload_libpaths=NULL;
 275
 276   static void mz_set_dlopen_libraries(const char *_libs)
 277   {
 278     int   i,k,n;
 279     int   mz_dynload_debug=(1==0);
 280     char *extra_paths[1000];
 281     char *EP;
 282
 283     {
 284       char *dbg=getenv("MZ_DYNLOAD_DEBUG");
 285       if (dbg!=NULL) {
 286         mz_dynload_debug=atoi(dbg);
 287       }
 288     }
 289
 290     {
 291       char *ep=getenv("MZ_DYNLOAD_LIBPATH");
 292       int   i,k,j;
 293       k=0;
 294       if (ep!=NULL) {
 295         EP=strdup(ep);
 296         for(i=0,j=0;EP[i]!='\0';i++) {
 297           if (EP[i]==':') {
 298             EP[i]='\0';
 299             extra_paths[k++]=&EP[j];
 300             j=i+1;
 301           }
 302         }
 303         if (j!=i) {
 304           extra_paths[k++]=&EP[j];
 305         }
 306       }
 307       else {
 308         EP=strdup("");
 309       }
 310       extra_paths[k]=NULL;
 311       k+=1;
 312
 313       if (mz_dynload_debug) {
 314         fprintf(stderr,"SWIG:mzscheme:MZ_DYNLOAD_LIBPATH=%s\n",(ep==NULL) ? "(null)" : ep);
 315         fprintf(stderr,"SWIG:mzscheme:extra_paths[%d]\n",k-1);
 316         for(i=0;i<k-1;i++) {
 317           fprintf(stderr,"SWIG:mzscheme:extra_paths[%d]=%s\n",i,extra_paths[i]);
 318         }
 319       }
 320
 321       mz_dynload_libpaths=(char **) malloc(sizeof(char *)*k);
 322       for(i=0;i<k;i++) {
 323         if (extra_paths[i]!=NULL) {
 324           mz_dynload_libpaths[i]=strdup(extra_paths[i]);
 325         }
 326         else {
 327           mz_dynload_libpaths[i]=NULL;
 328         }
 329       }
 330
 331       if (mz_dynload_debug) {
 332         int i;
 333         for(i=0;extra_paths[i]!=NULL;i++) {
 334           fprintf(stderr,"SWIG:mzscheme:%s\n",extra_paths[i]);
 335         }
 336       }
 337     }
 338
 339     {
 340 #ifdef MZ_DYNLOAD_LIBS
 341       char *libs=(char *) malloc((strlen(MZ_DYNLOAD_LIBS)+1)*sizeof(char));
 342       strcpy(libs,MZ_DYNLOAD_LIBS);
 343 #else
 344       char *libs=(char *) malloc((strlen(_libs)+1)*sizeof(char));
 345       strcpy(libs,_libs);
 346 #endif
 347
 348       for(i=0,n=strlen(libs),k=0;i<n;i++) {
 349         if (libs[i]==',') { k+=1; }
 350       }
 351       k+=1;
 352       mz_dlopen_libraries=(char **) malloc(sizeof(char *)*(k+1));
 353       mz_dlopen_libraries[0]=libs;
 354       for(i=0,k=1,n=strlen(libs);i<n;i++) {
 355         if (libs[i]==',') {
 356           libs[i]='\0';
 357           mz_dlopen_libraries[k++]=&libs[i+1];
 358           i+=1;
 359         }
 360       }
 361
 362       if (mz_dynload_debug) {
 363         fprintf(stderr,"k=%d\n",k);
 364       }
 365       mz_dlopen_libraries[k]=NULL;
 366
 367       free(EP);
 368     }
 369   }
 370
 371   static void *mz_load_function(char *function)
 372   {
 373     int mz_dynload_debug=(1==0);
 374
 375     {
 376       char *dbg=getenv("MZ_DYNLOAD_DEBUG");
 377       if (dbg!=NULL) {
 378         mz_dynload_debug=atoi(dbg);
 379       }
 380     }
 381
 382     if (mz_dlopen_libraries==NULL) {
 383       return NULL;
 384     }
 385     else {
 386       if (mz_libraries==NULL) {
 387         int i,n;
 388         for(n=0;mz_dlopen_libraries[n]!=NULL;n++);
 389         if (mz_dynload_debug) {
 390           fprintf(stderr,"SWIG:mzscheme:n=%d\n",n);
 391         }
 392         mz_libraries=(void **) malloc(sizeof(void*)*n);
 393         for(i=0;i<n;i++) {
 394           if (mz_dynload_debug) {
 395            fprintf(stderr,"SWIG:mzscheme:loading %s\n",mz_dlopen_libraries[i]);
 396           }
 397 #ifdef __OS_WIN32
 398           mz_libraries[i]=(void *) LoadLibrary(mz_dlopen_libraries[i]);
 399 #else
 400           mz_libraries[i]=(void *) dlopen(mz_dlopen_libraries[i],RTLD_LAZY);
 401 #endif
 402           if (mz_libraries[i]==NULL) {
 403             int k;
 404             char *libp;
 405             for(k=0;mz_dynload_libpaths[k]!=NULL && mz_libraries[i]==NULL;k++) {
 406               int L=strlen(mz_dynload_libpaths[k])+strlen("\\")+strlen(mz_dlopen_libraries[i])+1;
 407               libp=(char *) malloc(L*sizeof(char));
 408 #ifdef __OS_WIN32
 409               sprintf(libp,"%s\\%s",mz_dynload_libpaths[k],mz_dlopen_libraries[i]);
 410               mz_libraries[i]=(void *) LoadLibrary(libp);
 411 #else
 412               sprintf(libp,"%s/%s",mz_dynload_libpaths[k],mz_dlopen_libraries[i]);
 413               mz_libraries[i]=(void *) dlopen(libp,RTLD_LAZY);
 414 #endif
 415               if (mz_dynload_debug) {
 416                 fprintf(stderr,"SWIG:mzscheme:trying %s --> %p\n",libp,mz_libraries[i]);
 417               }
 418               free(libp);
 419             }
 420           }
 421         }
 422       }
 423       {
 424         int i;
 425         void *func=NULL;
 426
 427         for(i=0;mz_dlopen_libraries[i]!=NULL && func==NULL;i++) {
 428           if (mz_libraries[i]!=NULL) {
 429 #ifdef __OS_WIN32
 430             func=GetProcAddress(mz_libraries[i],function);
 431 #else
 432             func=dlsym(mz_libraries[i],function);
 433 #endif
 434           }
 435           if (mz_dynload_debug) {
 436             fprintf(stderr,
 437                     "SWIG:mzscheme:library:%s;dlopen=%p,function=%s,func=%p\n",
 438                     mz_dlopen_libraries[i],mz_libraries[i],function,func
 439                     );
 440           }
 441         }
 442
 443         return func;
 444       }
 445     }
 446   }
 447
 448 /*** DLOPEN PATCH ******************************************************
 449  * Contributed by Hans Oesterholt-Dijkema (jan. 2006)
 450  ***********************************************************************/
 451
 452 /* The interpreter will store a pointer to this structure in a global
 453    variable called swig-runtime-data-type-pointer.  The instance of this
 454    struct is only used if no other module has yet been loaded */
 455 struct swig_mzscheme_runtime_data {
 456   swig_module_info *module_head;
 457   Scheme_Type type;
 458 };
 459 static struct swig_mzscheme_runtime_data swig_mzscheme_runtime_data;
 460
 461
 462 static swig_module_info *
 463 SWIG_MzScheme_GetModule(Scheme_Env *env) {
 464   Scheme_Object *pointer, *symbol;
 465   struct swig_mzscheme_runtime_data *data;
 466
 467   /* first check if pointer already created */
 468   symbol = scheme_intern_symbol("swig-runtime-data-type-pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME);
 469   pointer = scheme_lookup_global(symbol, env);
 470   if (pointer && SCHEME_CPTRP(pointer)) {
 471       data = (struct swig_mzscheme_runtime_data *) SCHEME_CPTR_VAL(pointer);
 472       swig_type = data->type;
 473       return data->module_head;
 474   } else {
 475       return NULL;
 476   }
 477 }
 478
 479 static void
 480 SWIG_MzScheme_SetModule(Scheme_Env *env, swig_module_info *module) {
 481   Scheme_Object *pointer, *symbol;
 482   struct swig_mzscheme_runtime_data *data;
 483
 484   /* first check if pointer already created */
 485   symbol = scheme_intern_symbol("swig-runtime-data-type-pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME);
 486   pointer = scheme_lookup_global(symbol, env);
 487   if (pointer && SCHEME_CPTRP(pointer)) {
 488     data = (struct swig_mzscheme_runtime_data *) SCHEME_CPTR_VAL(pointer);
 489     swig_type = data->type;
 490     data->module_head = module;
 491   } else {
 492     /* create a new type for wrapped pointer values */
 493     swig_type = scheme_make_type((char *)"swig");
 494     swig_mzscheme_runtime_data.module_head = module;
 495     swig_mzscheme_runtime_data.type = swig_type;
 496
 497     /* create a new pointer */
 498 #ifndef MZSCHEME30X
 499     pointer = scheme_make_cptr((void *) &swig_mzscheme_runtime_data, "swig_mzscheme_runtime_data");
 500 #else
 501     pointer = scheme_make_cptr((void *) &swig_mzscheme_runtime_data,
 502                                scheme_make_byte_string("swig_mzscheme_runtime_data"));
 503 #endif
 504     scheme_add_global_symbol(symbol, pointer, env);
 505   }
 506 }
 507
 508 #ifdef __cplusplus
 509 }
 510 #endif
 511