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