1 /* ----------------------------------------------------------------------------- 2 * perlrun.swg 3 * 4 * This file contains the runtime support for Perl modules 5 * and includes code for managing global variables and pointer 6 * type checking. 7 * ----------------------------------------------------------------------------- */ 8 9 #ifdef PERL_OBJECT 10 #define SWIG_PERL_OBJECT_DECL CPerlObj *SWIGUNUSEDPARM(pPerl), 11 #define SWIG_PERL_OBJECT_CALL pPerl, 12 #else 13 #define SWIG_PERL_OBJECT_DECL 14 #define SWIG_PERL_OBJECT_CALL 15 #endif 16 17 /* Common SWIG API */ 18 19 /* for raw pointers */ 20 #define SWIG_ConvertPtr(obj, pp, type, flags) SWIG_Perl_ConvertPtr(SWIG_PERL_OBJECT_CALL obj, pp, type, flags) 21 #define SWIG_ConvertPtrAndOwn(obj, pp, type, flags,own) SWIG_Perl_ConvertPtrAndOwn(SWIG_PERL_OBJECT_CALL obj, pp, type, flags, own) 22 #define SWIG_NewPointerObj(p, type, flags) SWIG_Perl_NewPointerObj(SWIG_PERL_OBJECT_CALL p, type, flags) 23 24 /* for raw packed data */ 25 #define SWIG_ConvertPacked(obj, p, s, type) SWIG_Perl_ConvertPacked(SWIG_PERL_OBJECT_CALL obj, p, s, type) 26 #define SWIG_NewPackedObj(p, s, type) SWIG_Perl_NewPackedObj(SWIG_PERL_OBJECT_CALL p, s, type) 27 28 /* for class or struct pointers */ 29 #define SWIG_ConvertInstance(obj, pptr, type, flags) SWIG_ConvertPtr(obj, pptr, type, flags) 30 #define SWIG_NewInstanceObj(ptr, type, flags) SWIG_NewPointerObj(ptr, type, flags) 31 32 /* for C or C++ function pointers */ 33 #define SWIG_ConvertFunctionPtr(obj, pptr, type) SWIG_ConvertPtr(obj, pptr, type, 0) 34 #define SWIG_NewFunctionPtrObj(ptr, type) SWIG_NewPointerObj(ptr, type, 0) 35 36 /* for C++ member pointers, ie, member methods */ 37 #define SWIG_ConvertMember(obj, ptr, sz, ty) SWIG_ConvertPacked(obj, ptr, sz, ty) 38 #define SWIG_NewMemberObj(ptr, sz, type) SWIG_NewPackedObj(ptr, sz, type) 39 40 41 /* Runtime API */ 42 43 #define SWIG_GetModule(clientdata) SWIG_Perl_GetModule(clientdata) 44 #define SWIG_SetModule(clientdata, pointer) SWIG_Perl_SetModule(pointer) 45 46 47 /* Error manipulation */ 48 49 #define SWIG_ErrorType(code) SWIG_Perl_ErrorType(code) 50 #define SWIG_Error(code, msg) sv_setpvf(get_sv("@", GV_ADD), "%s %s", SWIG_ErrorType(code), msg) 51 #define SWIG_fail goto fail 52 53 /* Perl-specific SWIG API */ 54 55 #define SWIG_MakePtr(sv, ptr, type, flags) SWIG_Perl_MakePtr(SWIG_PERL_OBJECT_CALL sv, ptr, type, flags) 56 #define SWIG_MakePackedObj(sv, p, s, type) SWIG_Perl_MakePackedObj(SWIG_PERL_OBJECT_CALL sv, p, s, type) 57 #define SWIG_SetError(str) SWIG_Error(SWIG_RuntimeError, str) 58 59 60 #define SWIG_PERL_DECL_ARGS_1(arg1) (SWIG_PERL_OBJECT_DECL arg1) 61 #define SWIG_PERL_CALL_ARGS_1(arg1) (SWIG_PERL_OBJECT_CALL arg1) 62 #define SWIG_PERL_DECL_ARGS_2(arg1, arg2) (SWIG_PERL_OBJECT_DECL arg1, arg2) 63 #define SWIG_PERL_CALL_ARGS_2(arg1, arg2) (SWIG_PERL_OBJECT_CALL arg1, arg2) 64 65 /* ----------------------------------------------------------------------------- 66 * pointers/data manipulation 67 * ----------------------------------------------------------------------------- */ 68 69 /* For backward compatibility only */ 70 #define SWIG_POINTER_EXCEPTION 0 71 72 #ifdef __cplusplus 73 extern "C" { 74 #endif 75 76 #define SWIG_OWNER SWIG_POINTER_OWN 77 #define SWIG_SHADOW SWIG_OWNER << 1 78 79 #define SWIG_MAYBE_PERL_OBJECT SWIG_PERL_OBJECT_DECL 80 81 /* SWIG Perl macros */ 82 83 /* Macro to declare an XS function */ 84 #ifndef XSPROTO 85 # define XSPROTO(name) void name(pTHX_ CV* cv) 86 #endif 87 88 /* Macro to call an XS function */ 89 #ifdef PERL_OBJECT 90 # define SWIG_CALLXS(_name) _name(cv,pPerl) 91 #else 92 # ifndef MULTIPLICITY 93 # define SWIG_CALLXS(_name) _name(cv) 94 # else 95 # define SWIG_CALLXS(_name) _name(PERL_GET_THX, cv) 96 # endif 97 #endif 98 99 #ifdef PERL_OBJECT 100 #define MAGIC_PPERL CPerlObj *pPerl = (CPerlObj *) this; 101 102 #ifdef __cplusplus 103 extern "C" { 104 #endif 105 typedef int (CPerlObj::*SwigMagicFunc)(SV *, MAGIC *); 106 #ifdef __cplusplus 107 } 108 #endif 109 110 #define SWIG_MAGIC(a,b) (SV *a, MAGIC *b) 111 #define SWIGCLASS_STATIC 112 113 #else /* PERL_OBJECT */ 114 115 #define MAGIC_PPERL 116 #define SWIGCLASS_STATIC static SWIGUNUSED 117 118 #ifndef MULTIPLICITY 119 #define SWIG_MAGIC(a,b) (SV *a, MAGIC *b) 120 121 #ifdef __cplusplus 122 extern "C" { 123 #endif 124 typedef int (*SwigMagicFunc)(SV *, MAGIC *); 125 #ifdef __cplusplus 126 } 127 #endif 128 129 #else /* MULTIPLICITY */ 130 131 #define SWIG_MAGIC(a,b) (struct interpreter *interp, SV *a, MAGIC *b) 132 133 #ifdef __cplusplus 134 extern "C" { 135 #endif 136 typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *); 137 #ifdef __cplusplus 138 } 139 #endif 140 141 #endif /* MULTIPLICITY */ 142 #endif /* PERL_OBJECT */ 143 144 # ifdef PERL_OBJECT 145 # define SWIG_croak_null() SWIG_Perl_croak_null(pPerl) 146 static void SWIG_Perl_croak_null(CPerlObj *pPerl) 147 # else 148 static void SWIG_croak_null() 149 # endif 150 { 151 SV *err = get_sv("@", GV_ADD); 152 # if (PERL_VERSION < 6) 153 croak("%_", err); 154 # else 155 if (sv_isobject(err)) 156 croak(0); 157 else 158 croak("%s", SvPV_nolen(err)); 159 # endif 160 } 161 162 163 /* 164 Define how strict is the cast between strings and integers/doubles 165 when overloading between these types occurs. 166 167 The default is making it as strict as possible by using SWIG_AddCast 168 when needed. 169 170 You can use -DSWIG_PERL_NO_STRICT_STR2NUM at compilation time to 171 disable the SWIG_AddCast, making the casting between string and 172 numbers less strict. 173 174 In the end, we try to solve the overloading between strings and 175 numerical types in the more natural way, but if you can avoid it, 176 well, avoid it using %rename, for example. 177 */ 178 #ifndef SWIG_PERL_NO_STRICT_STR2NUM 179 # ifndef SWIG_PERL_STRICT_STR2NUM 180 # define SWIG_PERL_STRICT_STR2NUM 181 # endif 182 #endif 183 #ifdef SWIG_PERL_STRICT_STR2NUM 184 /* string takes precedence */ 185 #define SWIG_Str2NumCast(x) SWIG_AddCast(x) 186 #else 187 /* number takes precedence */ 188 #define SWIG_Str2NumCast(x) x 189 #endif 190 191 192 193 #include <stdlib.h> 194 195 SWIGRUNTIME const char * 196 SWIG_Perl_TypeProxyName(const swig_type_info *type) { 197 if (!type) return NULL; 198 if (type->clientdata != NULL) { 199 return (const char*) type->clientdata; 200 } 201 else { 202 return type->name; 203 } 204 } 205 206 /* Identical to SWIG_TypeCheck, except for strcmp comparison */ 207 SWIGRUNTIME swig_cast_info * 208 SWIG_TypeProxyCheck(const char *c, swig_type_info *ty) { 209 if (ty) { 210 swig_cast_info *iter = ty->cast; 211 while (iter) { 212 if (strcmp(SWIG_Perl_TypeProxyName(iter->type), c) == 0) { 213 if (iter == ty->cast) 214 return iter; 215 /* Move iter to the top of the linked list */ 216 iter->prev->next = iter->next; 217 if (iter->next) 218 iter->next->prev = iter->prev; 219 iter->next = ty->cast; 220 iter->prev = 0; 221 if (ty->cast) ty->cast->prev = iter; 222 ty->cast = iter; 223 return iter; 224 } 225 iter = iter->next; 226 } 227 } 228 return 0; 229 } 230 231 /* Function for getting a pointer value */ 232 233 SWIGRUNTIME int 234 SWIG_Perl_ConvertPtrAndOwn(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags, int *own) { 235 swig_cast_info *tc; 236 void *voidptr = (void *)0; 237 SV *tsv = 0; 238 239 if (own) 240 *own = 0; 241 242 /* If magical, apply more magic */ 243 if (SvGMAGICAL(sv)) 244 mg_get(sv); 245 246 /* Check to see if this is an object */ 247 if (sv_isobject(sv)) { 248 IV tmp = 0; 249 tsv = (SV*) SvRV(sv); 250 if ((SvTYPE(tsv) == SVt_PVHV)) { 251 MAGIC *mg; 252 if (SvMAGICAL(tsv)) { 253 mg = mg_find(tsv,'P'); 254 if (mg) { 255 sv = mg->mg_obj; 256 if (sv_isobject(sv)) { 257 tsv = (SV*)SvRV(sv); 258 tmp = SvIV(tsv); 259 } 260 } 261 } else { 262 return SWIG_ERROR; 263 } 264 } else { 265 tmp = SvIV(tsv); 266 } 267 voidptr = INT2PTR(void *,tmp); 268 } else if (! SvOK(sv)) { /* Check for undef */ 269 *(ptr) = (void *) 0; 270 return SWIG_OK; 271 } else if (SvTYPE(sv) == SVt_RV) { /* Check for NULL pointer */ 272 if (!SvROK(sv)) { 273 /* In Perl 5.12 and later, SVt_RV == SVt_IV, so sv could be a valid integer value. */ 274 if (SvIOK(sv)) { 275 return SWIG_ERROR; 276 } else { 277 /* NULL pointer (reference to undef). */ 278 *(ptr) = (void *) 0; 279 return SWIG_OK; 280 } 281 } else { 282 return SWIG_ERROR; 283 } 284 } else { /* Don't know what it is */ 285 return SWIG_ERROR; 286 } 287 if (_t) { 288 /* Now see if the types match */ 289 char *_c = HvNAME(SvSTASH(SvRV(sv))); 290 tc = SWIG_TypeProxyCheck(_c,_t); 291 if (!tc) { 292 return SWIG_ERROR; 293 } 294 { 295 int newmemory = 0; 296 *ptr = SWIG_TypeCast(tc,voidptr,&newmemory); 297 if (newmemory == SWIG_CAST_NEW_MEMORY) { 298 assert(own); /* badly formed typemap which will lead to a memory leak - it must set and use own to delete *ptr */ 299 if (own) 300 *own = *own | SWIG_CAST_NEW_MEMORY; 301 } 302 } 303 } else { 304 *ptr = voidptr; 305 } 306 307 /* 308 * DISOWN implementation: we need a perl guru to check this one. 309 */ 310 if (tsv && (flags & SWIG_POINTER_DISOWN)) { 311 /* 312 * almost copy paste code from below SWIG_POINTER_OWN setting 313 */ 314 SV *obj = sv; 315 HV *stash = SvSTASH(SvRV(obj)); 316 GV *gv = *(GV**)hv_fetch(stash, "OWNER", 5, TRUE); 317 if (isGV(gv)) { 318 HV *hv = GvHVn(gv); 319 /* 320 * To set ownership (see below), a newSViv(1) entry is added. 321 * Hence, to remove ownership, we delete the entry. 322 */ 323 if (hv_exists_ent(hv, obj, 0)) { 324 hv_delete_ent(hv, obj, 0, 0); 325 } 326 } 327 } 328 return SWIG_OK; 329 } 330 331 SWIGRUNTIME int 332 SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags) { 333 return SWIG_Perl_ConvertPtrAndOwn(sv, ptr, _t, flags, 0); 334 } 335 336 SWIGRUNTIME void 337 SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, swig_type_info *t, int flags) { 338 if (ptr && (flags & (SWIG_SHADOW | SWIG_POINTER_OWN))) { 339 SV *self; 340 SV *obj=newSV(0); 341 HV *hash=newHV(); 342 HV *stash; 343 sv_setref_pv(obj, SWIG_Perl_TypeProxyName(t), ptr); 344 stash=SvSTASH(SvRV(obj)); 345 if (flags & SWIG_POINTER_OWN) { 346 HV *hv; 347 GV *gv = *(GV**)hv_fetch(stash, "OWNER", 5, TRUE); 348 if (!isGV(gv)) 349 gv_init(gv, stash, "OWNER", 5, FALSE); 350 hv=GvHVn(gv); 351 hv_store_ent(hv, obj, newSViv(1), 0); 352 } 353 sv_magic((SV *)hash, (SV *)obj, 'P', Nullch, 0); 354 SvREFCNT_dec(obj); 355 self=newRV_noinc((SV *)hash); 356 sv_setsv(sv, self); 357 SvREFCNT_dec((SV *)self); 358 sv_bless(sv, stash); 359 } 360 else { 361 sv_setref_pv(sv, SWIG_Perl_TypeProxyName(t), ptr); 362 } 363 } 364 365 SWIGRUNTIMEINLINE SV * 366 SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *ptr, swig_type_info *t, int flags) { 367 SV *result = sv_newmortal(); 368 SWIG_MakePtr(result, ptr, t, flags); 369 return result; 370 } 371 372 SWIGRUNTIME void 373 SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, int sz, swig_type_info *type) { 374 char result[1024]; 375 char *r = result; 376 if ((2*sz + 1 + strlen(SWIG_Perl_TypeProxyName(type))) > 1000) return; 377 *(r++) = '_'; 378 r = SWIG_PackData(r,ptr,sz); 379 strcpy(r,SWIG_Perl_TypeProxyName(type)); 380 sv_setpv(sv, result); 381 } 382 383 SWIGRUNTIME SV * 384 SWIG_Perl_NewPackedObj(SWIG_MAYBE_PERL_OBJECT void *ptr, int sz, swig_type_info *type) { 385 SV *result = sv_newmortal(); 386 SWIG_Perl_MakePackedObj(result, ptr, sz, type); 387 return result; 388 } 389 390 /* Convert a packed value value */ 391 SWIGRUNTIME int 392 SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *obj, void *ptr, int sz, swig_type_info *ty) { 393 swig_cast_info *tc; 394 const char *c = 0; 395 396 if ((!obj) || (!SvOK(obj))) return SWIG_ERROR; 397 c = SvPV_nolen(obj); 398 /* Pointer values must start with leading underscore */ 399 if (*c != '_') return SWIG_ERROR; 400 c++; 401 c = SWIG_UnpackData(c,ptr,sz); 402 if (ty) { 403 tc = SWIG_TypeCheck(c,ty); 404 if (!tc) return SWIG_ERROR; 405 } 406 return SWIG_OK; 407 } 408 409 410 /* Macros for low-level exception handling */ 411 #define SWIG_croak(x) { SWIG_Error(SWIG_RuntimeError, x); SWIG_fail; } 412 413 414 typedef XSPROTO(SwigPerlWrapper); 415 typedef SwigPerlWrapper *SwigPerlWrapperPtr; 416 417 /* Structure for command table */ 418 typedef struct { 419 const char *name; 420 SwigPerlWrapperPtr wrapper; 421 } swig_command_info; 422 423 /* Information for constant table */ 424 425 #define SWIG_INT 1 426 #define SWIG_FLOAT 2 427 #define SWIG_STRING 3 428 #define SWIG_POINTER 4 429 #define SWIG_BINARY 5 430 431 /* Constant information structure */ 432 typedef struct swig_constant_info { 433 int type; 434 const char *name; 435 long lvalue; 436 double dvalue; 437 void *pvalue; 438 swig_type_info **ptype; 439 } swig_constant_info; 440 441 442 /* Structure for variable table */ 443 typedef struct { 444 const char *name; 445 SwigMagicFunc set; 446 SwigMagicFunc get; 447 swig_type_info **type; 448 } swig_variable_info; 449 450 /* Magic variable code */ 451 #ifndef PERL_OBJECT 452 # ifdef __cplusplus 453 # define swig_create_magic(s,a,b,c) _swig_create_magic(s,const_cast<char*>(a),b,c) 454 # else 455 # define swig_create_magic(s,a,b,c) _swig_create_magic(s,(char*)(a),b,c) 456 # endif 457 # ifndef MULTIPLICITY 458 SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int (*get)(SV *,MAGIC *)) 459 # else 460 SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(struct interpreter*, SV *, MAGIC *), int (*get)(struct interpreter*, SV *,MAGIC *)) 461 # endif 462 #else 463 # define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c) 464 SWIGRUNTIME void _swig_create_magic(CPerlObj *pPerl, SV *sv, const char *name, int (CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *)) 465 #endif 466 { 467 MAGIC *mg; 468 sv_magic(sv,sv,'U',name,strlen(name)); 469 mg = mg_find(sv,'U'); 470 mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL)); 471 mg->mg_virtual->svt_get = (SwigMagicFunc) get; 472 mg->mg_virtual->svt_set = (SwigMagicFunc) set; 473 mg->mg_virtual->svt_len = 0; 474 mg->mg_virtual->svt_clear = 0; 475 mg->mg_virtual->svt_free = 0; 476 } 477 478 479 SWIGRUNTIME swig_module_info * 480 SWIG_Perl_GetModule(void *SWIGUNUSEDPARM(clientdata)) { 481 static void *type_pointer = (void *)0; 482 SV *pointer; 483 484 /* first check if pointer already created */ 485 if (!type_pointer) { 486 pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, FALSE | GV_ADDMULTI); 487 if (pointer && SvOK(pointer)) { 488 type_pointer = INT2PTR(swig_type_info **, SvIV(pointer)); 489 } 490 } 491 492 return (swig_module_info *) type_pointer; 493 } 494 495 SWIGRUNTIME void 496 SWIG_Perl_SetModule(swig_module_info *module) { 497 SV *pointer; 498 499 /* create a new pointer */ 500 pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, TRUE | GV_ADDMULTI); 501 sv_setiv(pointer, PTR2IV(module)); 502 } 503 504 #ifdef __cplusplus 505 } 506 #endif 507
