PageRenderTime 48ms CodeModel.GetById 14ms RepoModel.GetById 0ms app.codeStats 0ms

/tags/rel-1-3-27/SWIG/Lib/guile/guile_scm_run.swg

#
Unknown | 408 lines | 362 code | 46 blank | 0 comment | 0 complexity | 79deb76e344447586a023ea607d0ee8c MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
  1. /* -*- c -*-
  2. * -----------------------------------------------------------------------
  3. * swig_lib/guile/guile_scm_run.swg
  4. *
  5. * Author: John Lenz <jelenz@wisc.edu>
  6. * ----------------------------------------------------------------------- */
  7. #include <libguile.h>
  8. #include <stdio.h>
  9. #include <string.h>
  10. #include <stdlib.h>
  11. #ifdef __cplusplus
  12. extern "C" {
  13. #endif
  14. typedef SCM (*swig_guile_proc)();
  15. typedef SCM (*guile_destructor)(SCM);
  16. typedef struct swig_guile_clientdata {
  17. guile_destructor destroy;
  18. SCM goops_class;
  19. } swig_guile_clientdata;
  20. #define SWIG_scm2str(s) \
  21. SWIG_Guile_scm2newstr(s, NULL)
  22. #define SWIG_malloc(size) \
  23. SCM_MUST_MALLOC(size)
  24. #define SWIG_free(mem) \
  25. scm_must_free(mem)
  26. #define SWIG_ConvertPtr(s, result, type, flags) \
  27. SWIG_Guile_ConvertPtr(s, result, type, flags)
  28. #define SWIG_MustGetPtr(s, type, argnum, flags) \
  29. SWIG_Guile_MustGetPtr(s, type, argnum, flags, FUNC_NAME)
  30. #define SWIG_NewPointerObj(ptr, type, owner) \
  31. SWIG_Guile_NewPointerObj((void*)ptr, type, owner)
  32. #define SWIG_PointerAddress(object) \
  33. SWIG_Guile_PointerAddress(object)
  34. #define SWIG_PointerType(object) \
  35. SWIG_Guile_PointerType(object)
  36. #define SWIG_IsPointerOfType(object, type) \
  37. SWIG_Guile_IsPointerOfType(object, type)
  38. #define SWIG_IsPointer(object) \
  39. SWIG_Guile_IsPointer(object)
  40. #define SWIG_contract_assert(expr, msg) \
  41. if (!(expr)) \
  42. scm_error(scm_str2symbol("swig-contract-assertion-failed"), \
  43. (char *) FUNC_NAME, (char *) msg, \
  44. SCM_EOL, SCM_BOOL_F); else
  45. /* Runtime API */
  46. #define SWIG_GetModule(clientdata) SWIG_Guile_GetModule()
  47. #define SWIG_SetModule(clientdata, pointer) SWIG_Guile_SetModule(pointer)
  48. static char *
  49. SWIG_Guile_scm2newstr(SCM str, size_t *len) {
  50. #define FUNC_NAME "SWIG_Guile_scm2newstr"
  51. char *ret;
  52. size_t l;
  53. SCM_ASSERT (SCM_STRINGP(str), str, 1, FUNC_NAME);
  54. l = SCM_STRING_LENGTH(str);
  55. ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
  56. if (!ret) return NULL;
  57. memcpy(ret, SCM_STRING_CHARS(str), l);
  58. ret[l] = '\0';
  59. if (len) *len = l;
  60. return ret;
  61. #undef FUNC_NAME
  62. }
  63. static int swig_initialized = 0;
  64. static scm_t_bits swig_tag = 0;
  65. static scm_t_bits swig_collectable_tag = 0;
  66. static scm_t_bits swig_destroyed_tag = 0;
  67. static SCM swig_make_func = SCM_EOL;
  68. static SCM swig_keyword = SCM_EOL;
  69. static SCM swig_symbol = SCM_EOL;
  70. #define SWIG_Guile_GetSmob(x) \
  71. ( SCM_NNULLP(x) && SCM_INSTANCEP(x) && SCM_NFALSEP(scm_slot_exists_p(x, swig_symbol)) \
  72. ? scm_slot_ref(x, swig_symbol) : (x) )
  73. static SCM
  74. SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner)
  75. {
  76. if (ptr == NULL)
  77. return SCM_EOL;
  78. else {
  79. SCM smob;
  80. swig_guile_clientdata *cdata = (swig_guile_clientdata *) type->clientdata;
  81. if (owner)
  82. SCM_NEWSMOB2(smob, swig_collectable_tag, ptr, (void *) type);
  83. else
  84. SCM_NEWSMOB2(smob, swig_tag, ptr, (void *) type);
  85. if (!cdata || SCM_NULLP(cdata->goops_class) || swig_make_func == SCM_EOL ) {
  86. return smob;
  87. } else {
  88. /* the scm_make() C function only handles the creation of gf,
  89. methods and classes (no instances) the (make ...) function is
  90. later redefined in goops.scm. So we need to call that
  91. Scheme function. */
  92. return scm_apply(swig_make_func,
  93. scm_list_3(cdata->goops_class,
  94. swig_keyword,
  95. smob),
  96. SCM_EOL);
  97. }
  98. }
  99. }
  100. static unsigned long
  101. SWIG_Guile_PointerAddress(SCM object)
  102. {
  103. SCM smob = SWIG_Guile_GetSmob(object);
  104. if (SCM_NULLP(smob)) return 0;
  105. else if (SCM_SMOB_PREDICATE(swig_tag, smob)
  106. || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)
  107. || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) {
  108. return (unsigned long) (void *) SCM_CELL_WORD_1(smob);
  109. }
  110. else scm_wrong_type_arg("SWIG-Guile-PointerAddress", 1, object);
  111. }
  112. static swig_type_info *
  113. SWIG_Guile_PointerType(SCM object)
  114. {
  115. SCM smob = SWIG_Guile_GetSmob(object);
  116. if (SCM_NULLP(smob)) return NULL;
  117. else if (SCM_SMOB_PREDICATE(swig_tag, smob)
  118. || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)
  119. || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) {
  120. return (swig_type_info *) SCM_CELL_WORD_2(smob);
  121. }
  122. else scm_wrong_type_arg("SWIG-Guile-PointerType", 1, object);
  123. }
  124. /* Return 0 if successful. */
  125. static int
  126. SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags)
  127. {
  128. swig_cast_info *cast;
  129. swig_type_info *from;
  130. SCM smob = SWIG_Guile_GetSmob(s);
  131. if (SCM_NULLP(smob)) {
  132. *result = NULL;
  133. return 0;
  134. } else if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) {
  135. /* we do not accept smobs representing destroyed pointers */
  136. from = (swig_type_info *) SCM_CELL_WORD_2(smob);
  137. if (!from) return 1;
  138. if (type) {
  139. cast = SWIG_TypeCheckStruct(from, type);
  140. if (cast) {
  141. *result = SWIG_TypeCast(cast, (void *) SCM_CELL_WORD_1(smob));
  142. return 0;
  143. } else {
  144. return 1;
  145. }
  146. } else {
  147. *result = (void *) SCM_CELL_WORD_1(smob);
  148. return 0;
  149. }
  150. }
  151. return 1;
  152. }
  153. static SWIGINLINE void *
  154. SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type,
  155. int argnum, int flags, const char *func_name)
  156. {
  157. void *result;
  158. if (SWIG_Guile_ConvertPtr(s, &result, type, flags)) {
  159. /* type mismatch */
  160. scm_wrong_type_arg((char *) func_name, argnum, s);
  161. }
  162. return result;
  163. }
  164. static SWIGINLINE int
  165. SWIG_Guile_IsPointerOfType (SCM s, swig_type_info *type)
  166. {
  167. void *result;
  168. if (SWIG_Guile_ConvertPtr(s, &result, type, 0)) {
  169. /* type mismatch */
  170. return 0;
  171. }
  172. else return 1;
  173. }
  174. static SWIGINLINE int
  175. SWIG_Guile_IsPointer (SCM s)
  176. {
  177. return SWIG_Guile_IsPointerOfType (s, NULL);
  178. }
  179. /* Mark a pointer object non-collectable */
  180. static void
  181. SWIG_Guile_MarkPointerNoncollectable(SCM s)
  182. {
  183. SCM smob = SWIG_Guile_GetSmob(s);
  184. if (!SCM_NULLP(smob)) {
  185. if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) {
  186. SCM_SET_CELL_TYPE(smob, swig_tag);
  187. }
  188. else scm_wrong_type_arg(NULL, 0, s);
  189. }
  190. }
  191. /* Mark a pointer object destroyed */
  192. static void
  193. SWIG_Guile_MarkPointerDestroyed(SCM s)
  194. {
  195. SCM smob = SWIG_Guile_GetSmob(s);
  196. if (!SCM_NULLP(smob)) {
  197. if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) {
  198. SCM_SET_CELL_TYPE(smob, swig_destroyed_tag);
  199. }
  200. else scm_wrong_type_arg(NULL, 0, s);
  201. }
  202. }
  203. /* Init */
  204. static int
  205. print_swig_aux (SCM swig_smob, SCM port, scm_print_state *pstate, const char *attribute)
  206. {
  207. swig_type_info *type;
  208. type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob);
  209. if (type) {
  210. scm_puts((char *) "#<", port);
  211. scm_puts((char *) attribute, port);
  212. scm_puts((char *) "swig-pointer ", port);
  213. scm_puts((char *) SWIG_TypePrettyName(type), port);
  214. scm_puts((char *) " ", port);
  215. scm_intprint((long) SCM_CELL_WORD_1(swig_smob), 16, port);
  216. scm_puts((char *) ">", port);
  217. /* non-zero means success */
  218. return 1;
  219. } else {
  220. return 0;
  221. }
  222. }
  223. static int
  224. print_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
  225. {
  226. return print_swig_aux(swig_smob, port, pstate, "");
  227. }
  228. static int
  229. print_collectable_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
  230. {
  231. return print_swig_aux(swig_smob, port, pstate, "collectable-");
  232. }
  233. static int
  234. print_destroyed_swig (SCM swig_smob, SCM port, scm_print_state *pstate)
  235. {
  236. return print_swig_aux(swig_smob, port, pstate, "destroyed-");
  237. }
  238. static SCM
  239. equalp_swig (SCM A, SCM B)
  240. {
  241. if (SCM_CELL_WORD_0(A) == SCM_CELL_WORD_0(B) && SCM_CELL_WORD_1(A) == SCM_CELL_WORD_1(B)
  242. && SCM_CELL_WORD_2(A) == SCM_CELL_WORD_2(B))
  243. return SCM_BOOL_T;
  244. else return SCM_BOOL_F;
  245. }
  246. static size_t
  247. free_swig(SCM A)
  248. {
  249. swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(A);
  250. if (type) {
  251. if (type->clientdata && ((swig_guile_clientdata *)type->clientdata)->destroy)
  252. ((swig_guile_clientdata *)type->clientdata)->destroy(A);
  253. }
  254. return 0;
  255. }
  256. static int
  257. ensure_smob_tag(SCM swig_module,
  258. scm_t_bits *tag_variable,
  259. const char *smob_name,
  260. const char *scheme_variable_name)
  261. {
  262. SCM variable = scm_sym2var(scm_str2symbol(scheme_variable_name),
  263. scm_module_lookup_closure(swig_module),
  264. SCM_BOOL_T);
  265. if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) {
  266. *tag_variable = scm_make_smob_type((char*)scheme_variable_name, 0);
  267. SCM_VARIABLE_SET(variable,
  268. scm_ulong2num(*tag_variable));
  269. return 1;
  270. }
  271. else {
  272. *tag_variable = scm_num2ulong(SCM_VARIABLE_REF(variable), 0,
  273. "SWIG_Guile_Init");
  274. return 0;
  275. }
  276. }
  277. static SCM
  278. SWIG_Guile_Init ()
  279. {
  280. static SCM swig_module;
  281. if (swig_initialized) return swig_module;
  282. swig_initialized = 1;
  283. swig_module = scm_c_resolve_module("Swig swigrun");
  284. if (ensure_smob_tag(swig_module, &swig_tag,
  285. "swig-pointer", "swig-pointer-tag")) {
  286. scm_set_smob_print(swig_tag, print_swig);
  287. scm_set_smob_equalp(swig_tag, equalp_swig);
  288. }
  289. if (ensure_smob_tag(swig_module, &swig_collectable_tag,
  290. "collectable-swig-pointer", "collectable-swig-pointer-tag")) {
  291. scm_set_smob_print(swig_collectable_tag, print_collectable_swig);
  292. scm_set_smob_equalp(swig_collectable_tag, equalp_swig);
  293. scm_set_smob_free(swig_collectable_tag, free_swig);
  294. }
  295. if (ensure_smob_tag(swig_module, &swig_destroyed_tag,
  296. "destroyed-swig-pointer", "destroyed-swig-pointer-tag")) {
  297. scm_set_smob_print(swig_destroyed_tag, print_destroyed_swig);
  298. scm_set_smob_equalp(swig_destroyed_tag, equalp_swig);
  299. }
  300. swig_make_func = scm_permanent_object(
  301. scm_variable_ref(scm_c_module_lookup(scm_c_resolve_module("oop goops"), "make")));
  302. swig_keyword = scm_permanent_object(scm_c_make_keyword((char*) "init-smob"));
  303. swig_symbol = scm_permanent_object(scm_str2symbol("swig-smob"));
  304. #ifdef SWIG_INIT_RUNTIME_MODULE
  305. SWIG_INIT_RUNTIME_MODULE
  306. #endif
  307. return swig_module;
  308. }
  309. static swig_module_info *
  310. SWIG_Guile_GetModule()
  311. {
  312. SCM module;
  313. SCM variable;
  314. module = SWIG_Guile_Init();
  315. variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
  316. scm_module_lookup_closure(module),
  317. SCM_BOOL_T);
  318. if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) {
  319. return NULL;
  320. } else {
  321. return (swig_module_info *) scm_num2ulong(SCM_VARIABLE_REF(variable), 0, "SWIG_Guile_Init");
  322. }
  323. }
  324. static void
  325. SWIG_Guile_SetModule(swig_module_info *swig_module)
  326. {
  327. SCM module;
  328. SCM variable;
  329. module = SWIG_Guile_Init();
  330. variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME),
  331. scm_module_lookup_closure(module),
  332. SCM_BOOL_T);
  333. SCM_VARIABLE_SET(variable, scm_ulong2num((unsigned long) swig_module));
  334. }
  335. static int
  336. SWIG_Guile_GetArgs (SCM *dest, SCM rest,
  337. int reqargs, int optargs,
  338. const char *procname)
  339. {
  340. int i;
  341. int num_args_passed = 0;
  342. for (i = 0; i<reqargs; i++) {
  343. if (!SCM_CONSP(rest))
  344. scm_wrong_num_args(scm_makfrom0str((char *) procname));
  345. *dest++ = SCM_CAR(rest);
  346. rest = SCM_CDR(rest);
  347. num_args_passed++;
  348. }
  349. for (i = 0; i<optargs && SCM_CONSP(rest); i++) {
  350. *dest++ = SCM_CAR(rest);
  351. rest = SCM_CDR(rest);
  352. num_args_passed++;
  353. }
  354. for (; i<optargs; i++)
  355. *dest++ = SCM_UNDEFINED;
  356. if (!SCM_NULLP(rest))
  357. scm_wrong_num_args(scm_makfrom0str((char *) procname));
  358. return num_args_passed;
  359. }
  360. #ifdef __cplusplus
  361. }
  362. #endif