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