mzrun.swg 14 KB

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