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() 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(GvSV(PL_errgv),"%s %s\n", 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 73extern "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 103extern "C" { 104#endif 105typedef 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 122extern "C" { 123#endif 124typedef 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 134extern "C" { 135#endif 136typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *); 137#ifdef __cplusplus 138} 139#endif 140 141#endif /* MULTIPLICITY */ 142#endif /* PERL_OBJECT */ 143 144/* Workaround for bug in perl 5.6.x croak and earlier */ 145#if (PERL_VERSION < 8) 146# ifdef PERL_OBJECT 147# define SWIG_croak_null() SWIG_Perl_croak_null(pPerl) 148static void SWIG_Perl_croak_null(CPerlObj *pPerl) 149# else 150static void SWIG_croak_null() 151# endif 152{ 153 SV *err=ERRSV; 154# if (PERL_VERSION < 6) 155 croak("%_", err); 156# else 157 if (SvOK(err) && !SvROK(err)) croak("%_", err); 158 croak(Nullch); 159# endif 160} 161#else 162# define SWIG_croak_null() croak(Nullch) 163#endif 164 165 166/* 167 Define how strict is the cast between strings and integers/doubles 168 when overloading between these types occurs. 169 170 The default is making it as strict as possible by using SWIG_AddCast 171 when needed. 172 173 You can use -DSWIG_PERL_NO_STRICT_STR2NUM at compilation time to 174 disable the SWIG_AddCast, making the casting between string and 175 numbers less strict. 176 177 In the end, we try to solve the overloading between strings and 178 numerical types in the more natural way, but if you can avoid it, 179 well, avoid it using %rename, for example. 180*/ 181#ifndef SWIG_PERL_NO_STRICT_STR2NUM 182# ifndef SWIG_PERL_STRICT_STR2NUM 183# define SWIG_PERL_STRICT_STR2NUM 184# endif 185#endif 186#ifdef SWIG_PERL_STRICT_STR2NUM 187/* string takes precedence */ 188#define SWIG_Str2NumCast(x) SWIG_AddCast(x) 189#else 190/* number takes precedence */ 191#define SWIG_Str2NumCast(x) x 192#endif 193 194 195 196#include <stdlib.h> 197 198SWIGRUNTIME const char * 199SWIG_Perl_TypeProxyName(const swig_type_info *type) { 200 if (!type) return NULL; 201 if (type->clientdata != NULL) { 202 return (const char*) type->clientdata; 203 } 204 else { 205 return type->name; 206 } 207} 208 209/* Identical to SWIG_TypeCheck, except for strcmp comparison */ 210SWIGRUNTIME swig_cast_info * 211SWIG_TypeProxyCheck(const char *c, swig_type_info *ty) { 212 if (ty) { 213 swig_cast_info *iter = ty->cast; 214 while (iter) { 215 if ( (!iter->type->clientdata && (strcmp(iter->type->name, c) == 0)) || 216 (iter->type->clientdata && (strcmp((char*)iter->type->clientdata, c) == 0)) ) { 217 if (iter == ty->cast) 218 return iter; 219 /* Move iter to the top of the linked list */ 220 iter->prev->next = iter->next; 221 if (iter->next) 222 iter->next->prev = iter->prev; 223 iter->next = ty->cast; 224 iter->prev = 0; 225 if (ty->cast) ty->cast->prev = iter; 226 ty->cast = iter; 227 return iter; 228 } 229 iter = iter->next; 230 } 231 } 232 return 0; 233} 234 235/* Function for getting a pointer value */ 236 237SWIGRUNTIME int 238SWIG_Perl_ConvertPtrAndOwn(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags, int *own) { 239 swig_cast_info *tc; 240 void *voidptr = (void *)0; 241 SV *tsv = 0; 242 243 if (own) 244 *own = 0; 245 246 /* If magical, apply more magic */ 247 if (SvGMAGICAL(sv)) 248 mg_get(sv); 249 250 /* Check to see if this is an object */ 251 if (sv_isobject(sv)) { 252 IV tmp = 0; 253 tsv = (SV*) SvRV(sv); 254 if ((SvTYPE(tsv) == SVt_PVHV)) { 255 MAGIC *mg; 256 if (SvMAGICAL(tsv)) { 257 mg = mg_find(tsv,'P'); 258 if (mg) { 259 sv = mg->mg_obj; 260 if (sv_isobject(sv)) { 261 tsv = (SV*)SvRV(sv); 262 tmp = SvIV(tsv); 263 } 264 } 265 } else { 266 return SWIG_ERROR; 267 } 268 } else { 269 tmp = SvIV(tsv); 270 } 271 voidptr = INT2PTR(void *,tmp); 272 } else if (! SvOK(sv)) { /* Check for undef */ 273 *(ptr) = (void *) 0; 274 return SWIG_OK; 275 } else if (SvTYPE(sv) == SVt_RV) { /* Check for NULL pointer */ 276 if (!SvROK(sv)) { 277 *(ptr) = (void *) 0; 278 return SWIG_OK; 279 } else { 280 return SWIG_ERROR; 281 } 282 } else { /* Don't know what it is */ 283 return SWIG_ERROR; 284 } 285 if (_t) { 286 /* Now see if the types match */ 287 char *_c = HvNAME(SvSTASH(SvRV(sv))); 288 tc = SWIG_TypeProxyCheck(_c,_t); 289 if (!tc) { 290 return SWIG_ERROR; 291 } 292 { 293 int newmemory = 0; 294 *ptr = SWIG_TypeCast(tc,voidptr,&newmemory); 295 if (newmemory == SWIG_CAST_NEW_MEMORY) { 296 assert(own); 297 if (own) 298 *own = *own | SWIG_CAST_NEW_MEMORY; 299 } 300 } 301 } else { 302 *ptr = voidptr; 303 } 304 305 /* 306 * DISOWN implementation: we need a perl guru to check this one. 307 */ 308 if (tsv && (flags & SWIG_POINTER_DISOWN)) { 309 /* 310 * almost copy paste code from below SWIG_POINTER_OWN setting 311 */ 312 SV *obj = sv; 313 HV *stash = SvSTASH(SvRV(obj)); 314 GV *gv = *(GV**) hv_fetch(stash, "OWNER", 5, TRUE); 315 if (isGV(gv)) { 316 HV *hv = GvHVn(gv); 317 /* 318 * To set ownership (see below), a newSViv(1) entry is added. 319 * Hence, to remove ownership, we delete the entry. 320 */ 321 if (hv_exists_ent(hv, obj, 0)) { 322 hv_delete_ent(hv, obj, 0, 0); 323 } 324 } 325 } 326 return SWIG_OK; 327} 328 329SWIGRUNTIME int 330SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags) { 331 return SWIG_Perl_ConvertPtrAndOwn(sv, ptr, _t, flags, 0); 332} 333 334SWIGRUNTIME void 335SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, swig_type_info *t, int flags) { 336 if (ptr && (flags & (SWIG_SHADOW | SWIG_POINTER_OWN))) { 337 SV *self; 338 SV *obj=newSV(0); 339 HV *hash=newHV(); 340 HV *stash; 341 sv_setref_pv(obj, (char *) SWIG_Perl_TypeProxyName(t), ptr); 342 stash=SvSTASH(SvRV(obj)); 343 if (flags & SWIG_POINTER_OWN) { 344 HV *hv; 345 GV *gv=*(GV**)hv_fetch(stash, "OWNER", 5, TRUE); 346 if (!isGV(gv)) 347 gv_init(gv, stash, "OWNER", 5, FALSE); 348 hv=GvHVn(gv); 349 hv_store_ent(hv, obj, newSViv(1), 0); 350 } 351 sv_magic((SV *)hash, (SV *)obj, 'P', Nullch, 0); 352 SvREFCNT_dec(obj); 353 self=newRV_noinc((SV *)hash); 354 sv_setsv(sv, self); 355 SvREFCNT_dec((SV *)self); 356 sv_bless(sv, stash); 357 } 358 else { 359 sv_setref_pv(sv, (char *) SWIG_Perl_TypeProxyName(t), ptr); 360 } 361} 362 363SWIGRUNTIMEINLINE SV * 364SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *ptr, swig_type_info *t, int flags) { 365 SV *result = sv_newmortal(); 366 SWIG_MakePtr(result, ptr, t, flags); 367 return result; 368} 369 370SWIGRUNTIME void 371SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, int sz, swig_type_info *type) { 372 char result[1024]; 373 char *r = result; 374 if ((2*sz + 1 + strlen(SWIG_Perl_TypeProxyName(type))) > 1000) return; 375 *(r++) = '_'; 376 r = SWIG_PackData(r,ptr,sz); 377 strcpy(r,SWIG_Perl_TypeProxyName(type)); 378 sv_setpv(sv, result); 379} 380 381SWIGRUNTIME SV * 382SWIG_Perl_NewPackedObj(SWIG_MAYBE_PERL_OBJECT void *ptr, int sz, swig_type_info *type) { 383 SV *result = sv_newmortal(); 384 SWIG_Perl_MakePackedObj(result, ptr, sz, type); 385 return result; 386} 387 388/* Convert a packed value value */ 389SWIGRUNTIME int 390SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *obj, void *ptr, int sz, swig_type_info *ty) { 391 swig_cast_info *tc; 392 const char *c = 0; 393 394 if ((!obj) || (!SvOK(obj))) return SWIG_ERROR; 395 c = SvPV_nolen(obj); 396 /* Pointer values must start with leading underscore */ 397 if (*c != '_') return SWIG_ERROR; 398 c++; 399 c = SWIG_UnpackData(c,ptr,sz); 400 if (ty) { 401 tc = SWIG_TypeCheck(c,ty); 402 if (!tc) return SWIG_ERROR; 403 } 404 return SWIG_OK; 405} 406 407 408/* Macros for low-level exception handling */ 409#define SWIG_croak(x) { SWIG_Error(SWIG_RuntimeError, x); SWIG_fail; } 410 411 412typedef XSPROTO(SwigPerlWrapper); 413typedef SwigPerlWrapper *SwigPerlWrapperPtr; 414 415/* Structure for command table */ 416typedef struct { 417 const char *name; 418 SwigPerlWrapperPtr wrapper; 419} swig_command_info; 420 421/* Information for constant table */ 422 423#define SWIG_INT 1 424#define SWIG_FLOAT 2 425#define SWIG_STRING 3 426#define SWIG_POINTER 4 427#define SWIG_BINARY 5 428 429/* Constant information structure */ 430typedef struct swig_constant_info { 431 int type; 432 const char *name; 433 long lvalue; 434 double dvalue; 435 void *pvalue; 436 swig_type_info **ptype; 437} swig_constant_info; 438 439 440/* Structure for variable table */ 441typedef struct { 442 const char *name; 443 SwigMagicFunc set; 444 SwigMagicFunc get; 445 swig_type_info **type; 446} swig_variable_info; 447 448/* Magic variable code */ 449#ifndef PERL_OBJECT 450#define swig_create_magic(s,a,b,c) _swig_create_magic(s,a,b,c) 451 #ifndef MULTIPLICITY 452 SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int (*get)(SV *,MAGIC *)) 453 #else 454 SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(struct interpreter*, SV *, MAGIC *), int (*get)(struct interpreter*, SV *,MAGIC *)) 455 #endif 456#else 457# define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c) 458SWIGRUNTIME void _swig_create_magic(CPerlObj *pPerl, SV *sv, const char *name, int (CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *)) 459#endif 460{ 461 MAGIC *mg; 462 sv_magic(sv,sv,'U',(char *) name,strlen(name)); 463 mg = mg_find(sv,'U'); 464 mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL)); 465 mg->mg_virtual->svt_get = (SwigMagicFunc) get; 466 mg->mg_virtual->svt_set = (SwigMagicFunc) set; 467 mg->mg_virtual->svt_len = 0; 468 mg->mg_virtual->svt_clear = 0; 469 mg->mg_virtual->svt_free = 0; 470} 471 472 473SWIGRUNTIME swig_module_info * 474SWIG_Perl_GetModule(void) { 475 static void *type_pointer = (void *)0; 476 SV *pointer; 477 478 /* first check if pointer already created */ 479 if (!type_pointer) { 480 pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, FALSE | GV_ADDMULTI); 481 if (pointer && SvOK(pointer)) { 482 type_pointer = INT2PTR(swig_type_info **, SvIV(pointer)); 483 } 484 } 485 486 return (swig_module_info *) type_pointer; 487} 488 489SWIGRUNTIME void 490SWIG_Perl_SetModule(swig_module_info *module) { 491 SV *pointer; 492 493 /* create a new pointer */ 494 pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, TRUE | GV_ADDMULTI); 495 sv_setiv(pointer, PTR2IV(module)); 496} 497 498#ifdef __cplusplus 499} 500#endif 501