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 * guile_scm_run.swg 6 * ----------------------------------------------------------------------------- */ 7 8#include <libguile.h> 9#include <stdio.h> 10#include <string.h> 11#include <stdlib.h> 12#include <assert.h> 13 14#ifdef __cplusplus 15extern "C" { 16#endif 17 18typedef SCM (*swig_guile_proc)(); 19typedef SCM (*guile_destructor)(SCM); 20 21typedef struct swig_guile_clientdata { 22 guile_destructor destroy; 23 SCM goops_class; 24} swig_guile_clientdata; 25 26#define SWIG_scm2str(s) \ 27 SWIG_Guile_scm2newstr(s, NULL) 28#define SWIG_malloc(size) \ 29 SCM_MUST_MALLOC(size) 30#define SWIG_free(mem) \ 31 scm_must_free(mem) 32#define SWIG_ConvertPtr(s, result, type, flags) \ 33 SWIG_Guile_ConvertPtr(s, result, type, flags) 34#define SWIG_MustGetPtr(s, type, argnum, flags) \ 35 SWIG_Guile_MustGetPtr(s, type, argnum, flags, FUNC_NAME) 36#define SWIG_NewPointerObj(ptr, type, owner) \ 37 SWIG_Guile_NewPointerObj((void*)ptr, type, owner) 38#define SWIG_PointerAddress(object) \ 39 SWIG_Guile_PointerAddress(object) 40#define SWIG_PointerType(object) \ 41 SWIG_Guile_PointerType(object) 42#define SWIG_IsPointerOfType(object, type) \ 43 SWIG_Guile_IsPointerOfType(object, type) 44#define SWIG_IsPointer(object) \ 45 SWIG_Guile_IsPointer(object) 46#define SWIG_contract_assert(expr, msg) \ 47 if (!(expr)) \ 48 scm_error(scm_str2symbol("swig-contract-assertion-failed"), \ 49 (char *) FUNC_NAME, (char *) msg, \ 50 SCM_EOL, SCM_BOOL_F); else 51 52/* for C++ member pointers, ie, member methods */ 53#define SWIG_ConvertMember(obj, ptr, sz, ty) \ 54 SWIG_Guile_ConvertMember(obj, ptr, sz, ty, FUNC_NAME) 55#define SWIG_NewMemberObj(ptr, sz, type) \ 56 SWIG_Guile_NewMemberObj(ptr, sz, type, FUNC_NAME) 57 58/* Runtime API */ 59static swig_module_info *SWIG_Guile_GetModule(void); 60#define SWIG_GetModule(clientdata) SWIG_Guile_GetModule() 61#define SWIG_SetModule(clientdata, pointer) SWIG_Guile_SetModule(pointer) 62 63SWIGINTERN char * 64SWIG_Guile_scm2newstr(SCM str, size_t *len) { 65#define FUNC_NAME "SWIG_Guile_scm2newstr" 66 char *ret; 67 size_t l; 68 69 SCM_ASSERT (SCM_STRINGP(str), str, 1, FUNC_NAME); 70 71 l = SCM_STRING_LENGTH(str); 72 ret = (char *) SWIG_malloc( (l + 1) * sizeof(char)); 73 if (!ret) return NULL; 74 75 memcpy(ret, SCM_STRING_CHARS(str), l); 76 ret[l] = '\0'; 77 if (len) *len = l; 78 return ret; 79#undef FUNC_NAME 80} 81 82static int swig_initialized = 0; 83static scm_t_bits swig_tag = 0; 84static scm_t_bits swig_collectable_tag = 0; 85static scm_t_bits swig_destroyed_tag = 0; 86static scm_t_bits swig_member_function_tag = 0; 87static SCM swig_make_func = SCM_EOL; 88static SCM swig_keyword = SCM_EOL; 89static SCM swig_symbol = SCM_EOL; 90 91#define SWIG_Guile_GetSmob(x) \ 92 ( SCM_NNULLP(x) && SCM_INSTANCEP(x) && SCM_NFALSEP(scm_slot_exists_p(x, swig_symbol)) \ 93 ? scm_slot_ref(x, swig_symbol) : (x) ) 94 95SWIGINTERN SCM 96SWIG_Guile_NewPointerObj(void *ptr, swig_type_info *type, int owner) 97{ 98 if (ptr == NULL) 99 return SCM_EOL; 100 else { 101 SCM smob; 102 swig_guile_clientdata *cdata = (swig_guile_clientdata *) type->clientdata; 103 if (owner) 104 SCM_NEWSMOB2(smob, swig_collectable_tag, ptr, (void *) type); 105 else 106 SCM_NEWSMOB2(smob, swig_tag, ptr, (void *) type); 107 108 if (!cdata || SCM_NULLP(cdata->goops_class) || swig_make_func == SCM_EOL ) { 109 return smob; 110 } else { 111 /* the scm_make() C function only handles the creation of gf, 112 methods and classes (no instances) the (make ...) function is 113 later redefined in goops.scm. So we need to call that 114 Scheme function. */ 115 return scm_apply(swig_make_func, 116 scm_list_3(cdata->goops_class, 117 swig_keyword, 118 smob), 119 SCM_EOL); 120 } 121 } 122} 123 124SWIGINTERN unsigned long 125SWIG_Guile_PointerAddress(SCM object) 126{ 127 SCM smob = SWIG_Guile_GetSmob(object); 128 if (SCM_NULLP(smob)) return 0; 129 else if (SCM_SMOB_PREDICATE(swig_tag, smob) 130 || SCM_SMOB_PREDICATE(swig_collectable_tag, smob) 131 || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) { 132 return (unsigned long) (void *) SCM_CELL_WORD_1(smob); 133 } 134 else scm_wrong_type_arg("SWIG-Guile-PointerAddress", 1, object); 135} 136 137SWIGINTERN swig_type_info * 138SWIG_Guile_PointerType(SCM object) 139{ 140 SCM smob = SWIG_Guile_GetSmob(object); 141 if (SCM_NULLP(smob)) return NULL; 142 else if (SCM_SMOB_PREDICATE(swig_tag, smob) 143 || SCM_SMOB_PREDICATE(swig_collectable_tag, smob) 144 || SCM_SMOB_PREDICATE(swig_destroyed_tag, smob)) { 145 return (swig_type_info *) SCM_CELL_WORD_2(smob); 146 } 147 else scm_wrong_type_arg("SWIG-Guile-PointerType", 1, object); 148} 149 150SWIGINTERN int 151SWIG_Guile_ConvertPtr(SCM s, void **result, swig_type_info *type, int flags) 152{ 153 swig_cast_info *cast; 154 swig_type_info *from; 155 SCM smob = SWIG_Guile_GetSmob(s); 156 157 if (SCM_NULLP(smob)) { 158 *result = NULL; 159 return SWIG_OK; 160 } else if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) { 161 /* we do not accept smobs representing destroyed pointers */ 162 from = (swig_type_info *) SCM_CELL_WORD_2(smob); 163 if (!from) return SWIG_ERROR; 164 if (type) { 165 cast = SWIG_TypeCheckStruct(from, type); 166 if (cast) { 167 int newmemory = 0; 168 *result = SWIG_TypeCast(cast, (void *) SCM_CELL_WORD_1(smob), &newmemory); 169 assert(!newmemory); /* newmemory handling not yet implemented */ 170 return SWIG_OK; 171 } else { 172 return SWIG_ERROR; 173 } 174 } else { 175 *result = (void *) SCM_CELL_WORD_1(smob); 176 return SWIG_OK; 177 } 178 } 179 return SWIG_ERROR; 180} 181 182SWIGINTERNINLINE void * 183SWIG_Guile_MustGetPtr (SCM s, swig_type_info *type, 184 int argnum, int flags, const char *func_name) 185{ 186 void *result; 187 int res = SWIG_Guile_ConvertPtr(s, &result, type, flags); 188 if (!SWIG_IsOK(res)) { 189 /* type mismatch */ 190 scm_wrong_type_arg((char *) func_name, argnum, s); 191 } 192 return result; 193} 194 195SWIGINTERNINLINE int 196SWIG_Guile_IsPointerOfType (SCM s, swig_type_info *type) 197{ 198 void *result; 199 if (SWIG_Guile_ConvertPtr(s, &result, type, 0)) { 200 /* type mismatch */ 201 return 0; 202 } 203 else return 1; 204} 205 206SWIGINTERNINLINE int 207SWIG_Guile_IsPointer (SCM s) 208{ 209 /* module might not be initialized yet, so initialize it */ 210 SWIG_Guile_GetModule(); 211 return SWIG_Guile_IsPointerOfType (s, NULL); 212} 213 214/* Mark a pointer object non-collectable */ 215SWIGINTERN void 216SWIG_Guile_MarkPointerNoncollectable(SCM s) 217{ 218 SCM smob = SWIG_Guile_GetSmob(s); 219 if (!SCM_NULLP(smob)) { 220 if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) { 221 SCM_SET_CELL_TYPE(smob, swig_tag); 222 } 223 else scm_wrong_type_arg(NULL, 0, s); 224 } 225} 226 227/* Mark a pointer object destroyed */ 228SWIGINTERN void 229SWIG_Guile_MarkPointerDestroyed(SCM s) 230{ 231 SCM smob = SWIG_Guile_GetSmob(s); 232 if (!SCM_NULLP(smob)) { 233 if (SCM_SMOB_PREDICATE(swig_tag, smob) || SCM_SMOB_PREDICATE(swig_collectable_tag, smob)) { 234 SCM_SET_CELL_TYPE(smob, swig_destroyed_tag); 235 } 236 else scm_wrong_type_arg(NULL, 0, s); 237 } 238} 239 240/* Member functions */ 241 242SWIGINTERN SCM 243SWIG_Guile_NewMemberObj(void *ptr, size_t sz, swig_type_info *type, 244 const char *func_name) 245{ 246 SCM smob; 247 void *copy = malloc(sz); 248 memcpy(copy, ptr, sz); 249 SCM_NEWSMOB2(smob, swig_member_function_tag, copy, (void *) type); 250 return smob; 251} 252 253SWIGINTERN int 254SWIG_Guile_ConvertMember(SCM smob, void *ptr, size_t sz, swig_type_info *type, 255 const char *func_name) 256{ 257 swig_cast_info *cast; 258 swig_type_info *from; 259 260 if (SCM_SMOB_PREDICATE(swig_member_function_tag, smob)) { 261 from = (swig_type_info *) SCM_CELL_WORD_2(smob); 262 if (!from) return SWIG_ERROR; 263 if (type) { 264 cast = SWIG_TypeCheckStruct(from, type); 265 if (!cast) return SWIG_ERROR; 266 } 267 memcpy(ptr, (void *) SCM_CELL_WORD_1(smob), sz); 268 return SWIG_OK; 269 } 270 return SWIG_ERROR; 271} 272 273 274/* Init */ 275 276SWIGINTERN int 277print_swig_aux (SCM swig_smob, SCM port, scm_print_state *pstate, 278 const char *attribute) 279{ 280 swig_type_info *type; 281 282 type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob); 283 if (type) { 284 scm_puts((char *) "#<", port); 285 scm_puts((char *) attribute, port); 286 scm_puts((char *) "swig-pointer ", port); 287 scm_puts((char *) SWIG_TypePrettyName(type), port); 288 scm_puts((char *) " ", port); 289 scm_intprint((long) SCM_CELL_WORD_1(swig_smob), 16, port); 290 scm_puts((char *) ">", port); 291 /* non-zero means success */ 292 return 1; 293 } else { 294 return 0; 295 } 296} 297 298 299SWIGINTERN int 300print_swig (SCM swig_smob, SCM port, scm_print_state *pstate) 301{ 302 return print_swig_aux(swig_smob, port, pstate, ""); 303} 304 305SWIGINTERN int 306print_collectable_swig (SCM swig_smob, SCM port, scm_print_state *pstate) 307{ 308 return print_swig_aux(swig_smob, port, pstate, "collectable-"); 309} 310 311SWIGINTERN int 312print_destroyed_swig (SCM swig_smob, SCM port, scm_print_state *pstate) 313{ 314 return print_swig_aux(swig_smob, port, pstate, "destroyed-"); 315} 316 317SWIGINTERN int 318print_member_function_swig (SCM swig_smob, SCM port, scm_print_state *pstate) 319{ 320 swig_type_info *type; 321 type = (swig_type_info *) SCM_CELL_WORD_2(swig_smob); 322 if (type) { 323 scm_puts((char *) "#<", port); 324 scm_puts((char *) "swig-member-function-pointer ", port); 325 scm_puts((char *) SWIG_TypePrettyName(type), port); 326 scm_puts((char *) " >", port); 327 /* non-zero means success */ 328 return 1; 329 } else { 330 return 0; 331 } 332} 333 334SWIGINTERN SCM 335equalp_swig (SCM A, SCM B) 336{ 337 if (SCM_CELL_WORD_0(A) == SCM_CELL_WORD_0(B) && SCM_CELL_WORD_1(A) == SCM_CELL_WORD_1(B) 338 && SCM_CELL_WORD_2(A) == SCM_CELL_WORD_2(B)) 339 return SCM_BOOL_T; 340 else return SCM_BOOL_F; 341} 342 343SWIGINTERN size_t 344free_swig(SCM A) 345{ 346 swig_type_info *type = (swig_type_info *) SCM_CELL_WORD_2(A); 347 if (type) { 348 if (type->clientdata && ((swig_guile_clientdata *)type->clientdata)->destroy) 349 ((swig_guile_clientdata *)type->clientdata)->destroy(A); 350 } 351 return 0; 352} 353 354SWIGINTERN size_t 355free_swig_member_function(SCM A) 356{ 357 free((swig_type_info *) SCM_CELL_WORD_1(A)); 358 return 0; 359} 360 361SWIGINTERN int 362ensure_smob_tag(SCM swig_module, 363 scm_t_bits *tag_variable, 364 const char *smob_name, 365 const char *scheme_variable_name) 366{ 367 SCM variable = scm_sym2var(scm_str2symbol(scheme_variable_name), 368 scm_module_lookup_closure(swig_module), 369 SCM_BOOL_T); 370 if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) { 371 *tag_variable = scm_make_smob_type((char*)scheme_variable_name, 0); 372 SCM_VARIABLE_SET(variable, 373 scm_ulong2num(*tag_variable)); 374 return 1; 375 } 376 else { 377 *tag_variable = scm_num2ulong(SCM_VARIABLE_REF(variable), 0, 378 "SWIG_Guile_Init"); 379 return 0; 380 } 381} 382 383SWIGINTERN SCM 384SWIG_Guile_Init () 385{ 386 static SCM swig_module; 387 388 if (swig_initialized) return swig_module; 389 swig_initialized = 1; 390 391 swig_module = scm_c_resolve_module("Swig swigrun"); 392 if (ensure_smob_tag(swig_module, &swig_tag, 393 "swig-pointer", "swig-pointer-tag")) { 394 scm_set_smob_print(swig_tag, print_swig); 395 scm_set_smob_equalp(swig_tag, equalp_swig); 396 } 397 if (ensure_smob_tag(swig_module, &swig_collectable_tag, 398 "collectable-swig-pointer", "collectable-swig-pointer-tag")) { 399 scm_set_smob_print(swig_collectable_tag, print_collectable_swig); 400 scm_set_smob_equalp(swig_collectable_tag, equalp_swig); 401 scm_set_smob_free(swig_collectable_tag, free_swig); 402 } 403 if (ensure_smob_tag(swig_module, &swig_destroyed_tag, 404 "destroyed-swig-pointer", "destroyed-swig-pointer-tag")) { 405 scm_set_smob_print(swig_destroyed_tag, print_destroyed_swig); 406 scm_set_smob_equalp(swig_destroyed_tag, equalp_swig); 407 } 408 if (ensure_smob_tag(swig_module, &swig_member_function_tag, 409 "swig-member-function-pointer", "swig-member-function-pointer-tag")) { 410 scm_set_smob_print(swig_member_function_tag, print_member_function_swig); 411 scm_set_smob_free(swig_member_function_tag, free_swig_member_function); 412 } 413 swig_make_func = scm_permanent_object( 414 scm_variable_ref(scm_c_module_lookup(scm_c_resolve_module("oop goops"), "make"))); 415 swig_keyword = scm_permanent_object(scm_c_make_keyword((char*) "init-smob")); 416 swig_symbol = scm_permanent_object(scm_str2symbol("swig-smob")); 417#ifdef SWIG_INIT_RUNTIME_MODULE 418 SWIG_INIT_RUNTIME_MODULE 419#endif 420 421 return swig_module; 422} 423 424SWIGINTERN swig_module_info * 425SWIG_Guile_GetModule(void) 426{ 427 SCM module; 428 SCM variable; 429 430 module = SWIG_Guile_Init(); 431 432 variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME), 433 scm_module_lookup_closure(module), 434 SCM_BOOL_T); 435 if (SCM_UNBNDP(SCM_VARIABLE_REF(variable))) { 436 return NULL; 437 } else { 438 return (swig_module_info *) scm_num2ulong(SCM_VARIABLE_REF(variable), 0, "SWIG_Guile_Init"); 439 } 440} 441 442SWIGINTERN void 443SWIG_Guile_SetModule(swig_module_info *swig_module) 444{ 445 SCM module; 446 SCM variable; 447 448 module = SWIG_Guile_Init(); 449 450 variable = scm_sym2var(scm_str2symbol("swig-type-list-address" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME), 451 scm_module_lookup_closure(module), 452 SCM_BOOL_T); 453 454 SCM_VARIABLE_SET(variable, scm_ulong2num((unsigned long) swig_module)); 455} 456 457SWIGINTERN int 458SWIG_Guile_GetArgs (SCM *dest, SCM rest, 459 int reqargs, int optargs, 460 const char *procname) 461{ 462 int i; 463 int num_args_passed = 0; 464 for (i = 0; i<reqargs; i++) { 465 if (!SCM_CONSP(rest)) 466 scm_wrong_num_args(scm_makfrom0str((char *) procname)); 467 *dest++ = SCM_CAR(rest); 468 rest = SCM_CDR(rest); 469 num_args_passed++; 470 } 471 for (i = 0; i<optargs && SCM_CONSP(rest); i++) { 472 *dest++ = SCM_CAR(rest); 473 rest = SCM_CDR(rest); 474 num_args_passed++; 475 } 476 for (; i<optargs; i++) 477 *dest++ = SCM_UNDEFINED; 478 if (!SCM_NULLP(rest)) 479 scm_wrong_num_args(scm_makfrom0str((char *) procname)); 480 return num_args_passed; 481} 482 483#ifdef __cplusplus 484} 485#endif 486