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