You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
511 lines
15 KiB
511 lines
15 KiB
/* ----------------------------------------------------------------------------- |
|
* See the LICENSE file for information on copyright, usage and redistribution |
|
* of SWIG, and the README file for authors - http://www.swig.org/release.html. |
|
* |
|
* mzrun.swg |
|
* ----------------------------------------------------------------------------- */ |
|
|
|
#include <stdio.h> |
|
#include <string.h> |
|
#include <stdlib.h> |
|
#include <limits.h> |
|
#include <escheme.h> |
|
#include <assert.h> |
|
|
|
#ifdef __cplusplus |
|
extern "C" { |
|
#endif |
|
|
|
/* Common SWIG API */ |
|
|
|
#define SWIG_ConvertPtr(s, result, type, flags) \ |
|
SWIG_MzScheme_ConvertPtr(s, result, type, flags) |
|
#define SWIG_NewPointerObj(ptr, type, owner) \ |
|
SWIG_MzScheme_NewPointerObj((void *)ptr, type, owner) |
|
#define SWIG_MustGetPtr(s, type, argnum, flags) \ |
|
SWIG_MzScheme_MustGetPtr(s, type, argnum, flags, FUNC_NAME, argc, argv) |
|
|
|
#define SWIG_contract_assert(expr,msg) \ |
|
if (!(expr)) { \ |
|
char *m=(char *) scheme_malloc(strlen(msg)+1000); \ |
|
sprintf(m,"SWIG contract, assertion failed: function=%s, message=%s", \ |
|
(char *) FUNC_NAME,(char *) msg); \ |
|
scheme_signal_error(m); \ |
|
} |
|
|
|
/* Runtime API */ |
|
#define SWIG_GetModule(clientdata) SWIG_MzScheme_GetModule((Scheme_Env *)(clientdata)) |
|
#define SWIG_SetModule(clientdata, pointer) SWIG_MzScheme_SetModule((Scheme_Env *) (clientdata), pointer) |
|
#define SWIG_MODULE_CLIENTDATA_TYPE Scheme_Env * |
|
|
|
/* MzScheme-specific SWIG API */ |
|
|
|
#define SWIG_malloc(size) SWIG_MzScheme_Malloc(size, FUNC_NAME) |
|
#define SWIG_free(mem) free(mem) |
|
#define SWIG_NewStructFromPtr(ptr,type) \ |
|
_swig_convert_struct_##type##(ptr) |
|
|
|
#define MAXVALUES 6 |
|
#define swig_make_boolean(b) (b ? scheme_true : scheme_false) |
|
|
|
static long |
|
SWIG_convert_integer(Scheme_Object *o, |
|
long lower_bound, long upper_bound, |
|
const char *func_name, int argnum, int argc, |
|
Scheme_Object **argv) |
|
{ |
|
long value; |
|
int status = scheme_get_int_val(o, &value); |
|
if (!status) |
|
scheme_wrong_type(func_name, "integer", argnum, argc, argv); |
|
if (value < lower_bound || value > upper_bound) |
|
scheme_wrong_type(func_name, "integer", argnum, argc, argv); |
|
return value; |
|
} |
|
|
|
static int |
|
SWIG_is_integer(Scheme_Object *o) |
|
{ |
|
long value; |
|
return scheme_get_int_val(o, &value); |
|
} |
|
|
|
static unsigned long |
|
SWIG_convert_unsigned_integer(Scheme_Object *o, |
|
unsigned long lower_bound, unsigned long upper_bound, |
|
const char *func_name, int argnum, int argc, |
|
Scheme_Object **argv) |
|
{ |
|
unsigned long value; |
|
int status = scheme_get_unsigned_int_val(o, &value); |
|
if (!status) |
|
scheme_wrong_type(func_name, "integer", argnum, argc, argv); |
|
if (value < lower_bound || value > upper_bound) |
|
scheme_wrong_type(func_name, "integer", argnum, argc, argv); |
|
return value; |
|
} |
|
|
|
static int |
|
SWIG_is_unsigned_integer(Scheme_Object *o) |
|
{ |
|
unsigned long value; |
|
return scheme_get_unsigned_int_val(o, &value); |
|
} |
|
|
|
/* ----------------------------------------------------------------------- |
|
* mzscheme 30X support code |
|
* Contributed by Hans Oesterholt |
|
* ----------------------------------------------------------------------- */ |
|
|
|
#ifndef SCHEME_STR_VAL |
|
#define MZSCHEME30X 1 |
|
#endif |
|
|
|
#ifdef MZSCHEME30X |
|
/* |
|
* This is MZSCHEME 299.100 or higher (30x). From version 299.100 of |
|
* mzscheme upwards, strings are in unicode. These functions convert |
|
* to and from utf8 encodings of these strings. NB! strlen(s) will be |
|
* the size in bytes of the string, not the actual length. |
|
*/ |
|
#define SCHEME_STR_VAL(obj) SCHEME_BYTE_STR_VAL(scheme_char_string_to_byte_string(obj)) |
|
#define SCHEME_STRLEN_VAL(obj) SCHEME_BYTE_STRLEN_VAL(scheme_char_string_to_byte_string(obj)) |
|
#define SCHEME_STRINGP(obj) SCHEME_CHAR_STRINGP(obj) |
|
#define scheme_make_string(s) scheme_make_utf8_string(s) |
|
#define scheme_make_sized_string(s,l) scheme_make_sized_utf8_string(s,l) |
|
#define scheme_make_sized_offset_string(s,d,l) \ |
|
scheme_make_sized_offset_utf8_string(s,d,l) |
|
#define SCHEME_MAKE_STRING(s) scheme_make_utf8_string(s) |
|
#else |
|
#define SCHEME_MAKE_STRING(s) scheme_make_string_without_copying(s) |
|
#endif |
|
/* ----------------------------------------------------------------------- |
|
* End of mzscheme 30X support code |
|
* ----------------------------------------------------------------------- */ |
|
|
|
struct swig_mz_proxy { |
|
Scheme_Type mztype; |
|
swig_type_info *type; |
|
void *object; |
|
}; |
|
|
|
static Scheme_Type swig_type; |
|
|
|
static void |
|
mz_free_swig(void *p, void *data) { |
|
struct swig_mz_proxy *proxy = (struct swig_mz_proxy *) p; |
|
if (SCHEME_NULLP((Scheme_Object*)p) || SCHEME_TYPE((Scheme_Object*)p) != swig_type) |
|
return; |
|
if (proxy->type) { |
|
if (proxy->type->clientdata) { |
|
((Scheme_Prim *)proxy->type->clientdata)(1, (Scheme_Object **)&proxy); |
|
} |
|
} |
|
} |
|
|
|
static Scheme_Object * |
|
SWIG_MzScheme_NewPointerObj(void *ptr, swig_type_info *type, int owner) { |
|
struct swig_mz_proxy *new_proxy; |
|
new_proxy = (struct swig_mz_proxy *) scheme_malloc(sizeof(struct swig_mz_proxy)); |
|
new_proxy->mztype = swig_type; |
|
new_proxy->type = type; |
|
new_proxy->object = ptr; |
|
if (owner) { |
|
scheme_add_finalizer(new_proxy, mz_free_swig, NULL); |
|
} |
|
return (Scheme_Object *) new_proxy; |
|
} |
|
|
|
static int |
|
SWIG_MzScheme_ConvertPtr(Scheme_Object *s, void **result, swig_type_info *type, int flags) { |
|
swig_cast_info *cast; |
|
|
|
if (SCHEME_NULLP(s)) { |
|
*result = NULL; |
|
return 0; |
|
} else if (SCHEME_TYPE(s) == swig_type) { |
|
struct swig_mz_proxy *proxy = (struct swig_mz_proxy *) s; |
|
if (type) { |
|
cast = SWIG_TypeCheckStruct(proxy->type, type); |
|
if (cast) { |
|
int newmemory = 0; |
|
*result = SWIG_TypeCast(cast, proxy->object, &newmemory); |
|
assert(!newmemory); /* newmemory handling not yet implemented */ |
|
return 0; |
|
} else { |
|
return 1; |
|
} |
|
} else { |
|
*result = proxy->object; |
|
return 0; |
|
} |
|
} |
|
return 1; |
|
} |
|
|
|
static SWIGINLINE void * |
|
SWIG_MzScheme_MustGetPtr(Scheme_Object *s, swig_type_info *type, |
|
int argnum, int flags, const char *func_name, |
|
int argc, Scheme_Object **argv) { |
|
void *result; |
|
if (SWIG_MzScheme_ConvertPtr(s, &result, type, flags)) { |
|
scheme_wrong_type(func_name, type->str ? type->str : "void *", argnum - 1, argc, argv); |
|
} |
|
return result; |
|
} |
|
|
|
static SWIGINLINE void * |
|
SWIG_MzScheme_Malloc(size_t size, const char *func_name) { |
|
void *p = malloc(size); |
|
if (p == NULL) { |
|
scheme_signal_error("swig-memory-error"); |
|
} else return p; |
|
} |
|
|
|
static Scheme_Object * |
|
SWIG_MzScheme_PackageValues(int num, Scheme_Object **values) { |
|
/* ignore first value if void */ |
|
if (num > 0 && SCHEME_VOIDP(values[0])) |
|
num--, values++; |
|
if (num == 0) return scheme_void; |
|
else if (num == 1) return values[0]; |
|
else return scheme_values(num, values); |
|
} |
|
|
|
#ifndef scheme_make_inspector |
|
#define scheme_make_inspector(x,y) \ |
|
_scheme_apply(scheme_builtin_value("make-inspector"), x, y) |
|
#endif |
|
|
|
/* Function to create a new struct. */ |
|
static Scheme_Object * |
|
SWIG_MzScheme_new_scheme_struct (Scheme_Env* env, const char* basename, |
|
int num_fields, char** field_names) |
|
{ |
|
Scheme_Object *new_type; |
|
int count_out, i; |
|
Scheme_Object **struct_names; |
|
Scheme_Object **vals; |
|
Scheme_Object **a = (Scheme_Object**) \ |
|
scheme_malloc(num_fields*sizeof(Scheme_Object*)); |
|
|
|
for (i=0; i<num_fields; ++i) { |
|
a[i] = (Scheme_Object*) scheme_intern_symbol(field_names[i]); |
|
} |
|
|
|
new_type = scheme_make_struct_type(scheme_intern_symbol(basename), |
|
NULL /*super_type*/, |
|
scheme_make_inspector(0, NULL), |
|
num_fields, |
|
0 /* auto_fields */, |
|
NULL /* auto_val */, |
|
NULL /* properties */ |
|
#ifdef MZSCHEME30X |
|
,NULL /* Guard */ |
|
#endif |
|
); |
|
struct_names = scheme_make_struct_names(scheme_intern_symbol(basename), |
|
scheme_build_list(num_fields,a), |
|
0 /*flags*/, &count_out); |
|
vals = scheme_make_struct_values(new_type, struct_names, count_out, 0); |
|
|
|
for (i = 0; i < count_out; i++) |
|
scheme_add_global_symbol(struct_names[i], vals[i],env); |
|
|
|
return new_type; |
|
} |
|
|
|
/*** DLOPEN PATCH ****************************************************** |
|
* Contributed by Hans Oesterholt-Dijkema (jan. 2006) |
|
***********************************************************************/ |
|
|
|
#if defined(_WIN32) || defined(__WIN32__) |
|
#define __OS_WIN32 |
|
#endif |
|
|
|
#ifdef __OS_WIN32 |
|
#include <windows.h> |
|
#else |
|
#include <dlfcn.h> |
|
#endif |
|
|
|
static char **mz_dlopen_libraries=NULL; |
|
static void **mz_libraries=NULL; |
|
static char **mz_dynload_libpaths=NULL; |
|
|
|
static void mz_set_dlopen_libraries(const char *_libs) |
|
{ |
|
int i,k,n; |
|
int mz_dynload_debug=(1==0); |
|
char *extra_paths[1000]; |
|
char *EP; |
|
|
|
{ |
|
char *dbg=getenv("MZ_DYNLOAD_DEBUG"); |
|
if (dbg!=NULL) { |
|
mz_dynload_debug=atoi(dbg); |
|
} |
|
} |
|
|
|
{ |
|
char *ep=getenv("MZ_DYNLOAD_LIBPATH"); |
|
int i,k,j; |
|
k=0; |
|
if (ep!=NULL) { |
|
EP=strdup(ep); |
|
for(i=0,j=0;EP[i]!='\0';i++) { |
|
if (EP[i]==':') { |
|
EP[i]='\0'; |
|
extra_paths[k++]=&EP[j]; |
|
j=i+1; |
|
} |
|
} |
|
if (j!=i) { |
|
extra_paths[k++]=&EP[j]; |
|
} |
|
} |
|
else { |
|
EP=strdup(""); |
|
} |
|
extra_paths[k]=NULL; |
|
k+=1; |
|
|
|
if (mz_dynload_debug) { |
|
fprintf(stderr,"SWIG:mzscheme:MZ_DYNLOAD_LIBPATH=%s\n",(ep==NULL) ? "(null)" : ep); |
|
fprintf(stderr,"SWIG:mzscheme:extra_paths[%d]\n",k-1); |
|
for(i=0;i<k-1;i++) { |
|
fprintf(stderr,"SWIG:mzscheme:extra_paths[%d]=%s\n",i,extra_paths[i]); |
|
} |
|
} |
|
|
|
mz_dynload_libpaths=(char **) malloc(sizeof(char *)*k); |
|
for(i=0;i<k;i++) { |
|
if (extra_paths[i]!=NULL) { |
|
mz_dynload_libpaths[i]=strdup(extra_paths[i]); |
|
} |
|
else { |
|
mz_dynload_libpaths[i]=NULL; |
|
} |
|
} |
|
|
|
if (mz_dynload_debug) { |
|
int i; |
|
for(i=0;extra_paths[i]!=NULL;i++) { |
|
fprintf(stderr,"SWIG:mzscheme:%s\n",extra_paths[i]); |
|
} |
|
} |
|
} |
|
|
|
{ |
|
#ifdef MZ_DYNLOAD_LIBS |
|
char *libs=(char *) malloc((strlen(MZ_DYNLOAD_LIBS)+1)*sizeof(char)); |
|
strcpy(libs,MZ_DYNLOAD_LIBS); |
|
#else |
|
char *libs=(char *) malloc((strlen(_libs)+1)*sizeof(char)); |
|
strcpy(libs,_libs); |
|
#endif |
|
|
|
for(i=0,n=strlen(libs),k=0;i<n;i++) { |
|
if (libs[i]==',') { k+=1; } |
|
} |
|
k+=1; |
|
mz_dlopen_libraries=(char **) malloc(sizeof(char *)*(k+1)); |
|
mz_dlopen_libraries[0]=libs; |
|
for(i=0,k=1,n=strlen(libs);i<n;i++) { |
|
if (libs[i]==',') { |
|
libs[i]='\0'; |
|
mz_dlopen_libraries[k++]=&libs[i+1]; |
|
i+=1; |
|
} |
|
} |
|
|
|
if (mz_dynload_debug) { |
|
fprintf(stderr,"k=%d\n",k); |
|
} |
|
mz_dlopen_libraries[k]=NULL; |
|
|
|
free(EP); |
|
} |
|
} |
|
|
|
static void *mz_load_function(char *function) |
|
{ |
|
int mz_dynload_debug=(1==0); |
|
|
|
{ |
|
char *dbg=getenv("MZ_DYNLOAD_DEBUG"); |
|
if (dbg!=NULL) { |
|
mz_dynload_debug=atoi(dbg); |
|
} |
|
} |
|
|
|
if (mz_dlopen_libraries==NULL) { |
|
return NULL; |
|
} |
|
else { |
|
if (mz_libraries==NULL) { |
|
int i,n; |
|
for(n=0;mz_dlopen_libraries[n]!=NULL;n++); |
|
if (mz_dynload_debug) { |
|
fprintf(stderr,"SWIG:mzscheme:n=%d\n",n); |
|
} |
|
mz_libraries=(void **) malloc(sizeof(void*)*n); |
|
for(i=0;i<n;i++) { |
|
if (mz_dynload_debug) { |
|
fprintf(stderr,"SWIG:mzscheme:loading %s\n",mz_dlopen_libraries[i]); |
|
} |
|
#ifdef __OS_WIN32 |
|
mz_libraries[i]=(void *) LoadLibrary(mz_dlopen_libraries[i]); |
|
#else |
|
mz_libraries[i]=(void *) dlopen(mz_dlopen_libraries[i],RTLD_LAZY); |
|
#endif |
|
if (mz_libraries[i]==NULL) { |
|
int k; |
|
char *libp; |
|
for(k=0;mz_dynload_libpaths[k]!=NULL && mz_libraries[i]==NULL;k++) { |
|
int L=strlen(mz_dynload_libpaths[k])+strlen("\\")+strlen(mz_dlopen_libraries[i])+1; |
|
libp=(char *) malloc(L*sizeof(char)); |
|
#ifdef __OS_WIN32 |
|
sprintf(libp,"%s\\%s",mz_dynload_libpaths[k],mz_dlopen_libraries[i]); |
|
mz_libraries[i]=(void *) LoadLibrary(libp); |
|
#else |
|
sprintf(libp,"%s/%s",mz_dynload_libpaths[k],mz_dlopen_libraries[i]); |
|
mz_libraries[i]=(void *) dlopen(libp,RTLD_LAZY); |
|
#endif |
|
if (mz_dynload_debug) { |
|
fprintf(stderr,"SWIG:mzscheme:trying %s --> %p\n",libp,mz_libraries[i]); |
|
} |
|
free(libp); |
|
} |
|
} |
|
} |
|
} |
|
{ |
|
int i; |
|
void *func=NULL; |
|
|
|
for(i=0;mz_dlopen_libraries[i]!=NULL && func==NULL;i++) { |
|
if (mz_libraries[i]!=NULL) { |
|
#ifdef __OS_WIN32 |
|
func=GetProcAddress(mz_libraries[i],function); |
|
#else |
|
func=dlsym(mz_libraries[i],function); |
|
#endif |
|
} |
|
if (mz_dynload_debug) { |
|
fprintf(stderr, |
|
"SWIG:mzscheme:library:%s;dlopen=%p,function=%s,func=%p\n", |
|
mz_dlopen_libraries[i],mz_libraries[i],function,func |
|
); |
|
} |
|
} |
|
|
|
return func; |
|
} |
|
} |
|
} |
|
|
|
/*** DLOPEN PATCH ****************************************************** |
|
* Contributed by Hans Oesterholt-Dijkema (jan. 2006) |
|
***********************************************************************/ |
|
|
|
/* The interpreter will store a pointer to this structure in a global |
|
variable called swig-runtime-data-type-pointer. The instance of this |
|
struct is only used if no other module has yet been loaded */ |
|
struct swig_mzscheme_runtime_data { |
|
swig_module_info *module_head; |
|
Scheme_Type type; |
|
}; |
|
static struct swig_mzscheme_runtime_data swig_mzscheme_runtime_data; |
|
|
|
|
|
static swig_module_info * |
|
SWIG_MzScheme_GetModule(Scheme_Env *env) { |
|
Scheme_Object *pointer, *symbol; |
|
struct swig_mzscheme_runtime_data *data; |
|
|
|
/* first check if pointer already created */ |
|
symbol = scheme_intern_symbol("swig-runtime-data-type-pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME); |
|
pointer = scheme_lookup_global(symbol, env); |
|
if (pointer && SCHEME_CPTRP(pointer)) { |
|
data = (struct swig_mzscheme_runtime_data *) SCHEME_CPTR_VAL(pointer); |
|
swig_type = data->type; |
|
return data->module_head; |
|
} else { |
|
return NULL; |
|
} |
|
} |
|
|
|
static void |
|
SWIG_MzScheme_SetModule(Scheme_Env *env, swig_module_info *module) { |
|
Scheme_Object *pointer, *symbol; |
|
struct swig_mzscheme_runtime_data *data; |
|
|
|
/* first check if pointer already created */ |
|
symbol = scheme_intern_symbol("swig-runtime-data-type-pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME); |
|
pointer = scheme_lookup_global(symbol, env); |
|
if (pointer && SCHEME_CPTRP(pointer)) { |
|
data = (struct swig_mzscheme_runtime_data *) SCHEME_CPTR_VAL(pointer); |
|
swig_type = data->type; |
|
data->module_head = module; |
|
} else { |
|
/* create a new type for wrapped pointer values */ |
|
swig_type = scheme_make_type((char *)"swig"); |
|
swig_mzscheme_runtime_data.module_head = module; |
|
swig_mzscheme_runtime_data.type = swig_type; |
|
|
|
/* create a new pointer */ |
|
#ifndef MZSCHEME30X |
|
pointer = scheme_make_cptr((void *) &swig_mzscheme_runtime_data, "swig_mzscheme_runtime_data"); |
|
#else |
|
pointer = scheme_make_cptr((void *) &swig_mzscheme_runtime_data, |
|
scheme_make_byte_string("swig_mzscheme_runtime_data")); |
|
#endif |
|
scheme_add_global_symbol(symbol, pointer, env); |
|
} |
|
} |
|
|
|
#ifdef __cplusplus |
|
} |
|
#endif |
|
|
|
|