jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
swig/SWIG/Lib/perl5/perlrun.swg
Marcelo Matus 4267a26ecd fix for perl + multiple modules 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@7863 626c5289-ae23-0410-ae9c-e8d60b6d4f22
2005-11-24 00:54:10 +00:00

348 lines
10 KiB
Text
Raw Blame History

/***********************************************************************
* perlrun.swg
*
* This file contains the runtime support for Perl modules
* and includes code for managing global variables and pointer
* type checking.
*
************************************************************************/
#ifdef PERL_OBJECT
#define SWIG_PERL_OBJECT_DECL CPerlObj *pPerl SWIGUNUSED,
#define SWIG_PERL_OBJECT_CALL pPerl,
#else
#define SWIG_PERL_OBJECT_DECL
#define SWIG_PERL_OBJECT_CALL
#endif
/* Common SWIG API */
/* for raw pointers */
#define SWIG_ConvertPtr(obj, pp, type, flags) SWIG_Perl_ConvertPtr(SWIG_PERL_OBJECT_CALL obj, pp, type, flags)
#define SWIG_NewPointerObj(p, type, flags) SWIG_Perl_NewPointerObj(SWIG_PERL_OBJECT_CALL p, type, flags)
/* for raw packed data */
#define SWIG_ConvertPacked(obj, p, s, type) SWIG_Perl_ConvertPacked(SWIG_PERL_OBJECT_CALL obj, p, s, type)
#define SWIG_NewPackedObj(p, s, type) SWIG_Perl_NewPackedObj(SWIG_PERL_OBJECT_CALL p, s, type)
/* for class or struct pointers */
#define SWIG_ConvertInstance(obj, pptr, type, flags) SWIG_ConvertPtr(obj, pptr, type, flags)
#define SWIG_NewInstanceObj(ptr, type, flags) SWIG_NewPointerObj(ptr, type, flags)
/* for C or C++ function pointers */
#define SWIG_ConvertFunctionPtr(obj, pptr, type) SWIG_ConvertPtr(obj, pptr, type, 0)
#define SWIG_NewFunctionPtrObj(ptr, type) SWIG_NewPointerObj(ptr, type, 0)
/* for C++ member pointers, ie, member methods */
#define SWIG_ConvertMember(obj, ptr, sz, ty) SWIG_ConvertPacked(obj, ptr, sz, ty)
#define SWIG_NewMemberObj(ptr, sz, type) SWIG_NewPackedObj(ptr, sz, type)
/* Runtime API */
#define SWIG_GetModule(clientdata) SWIG_Perl_GetModule()
#define SWIG_SetModule(clientdata, pointer) SWIG_Perl_SetModule(pointer)
/* Error manipulation */
#define SWIG_ErrorType(code) SWIG_Perl_ErrorType(code)
#define SWIG_Error(code, msg) warn("%s %s\n", SWIG_ErrorType(code), msg)
#define SWIG_fail goto fail
/* Perl-specific SWIG API */
#define SWIG_MakePtr(sv, ptr, type, flags) SWIG_Perl_MakePtr(SWIG_PERL_OBJECT_CALL sv, ptr, type, flags)
#define SWIG_MakePackedObj(sv, p, s, type) SWIG_Perl_MakePackedObj(SWIG_PERL_OBJECT_CALL sv, p, s, type)
#define SWIG_SetError(str) SWIG_Error(SWIG_RuntimeError, str)
#define SWIG_PERL_DECL_ARGS_1(arg1) (SWIG_PERL_OBJECT_DECL arg1)
#define SWIG_PERL_CALL_ARGS_1(arg1) (SWIG_PERL_OBJECT_CALL arg1)
#define SWIG_PERL_DECL_ARGS_2(arg1, arg2) (SWIG_PERL_OBJECT_DECL arg1, arg2)
#define SWIG_PERL_CALL_ARGS_2(arg1, arg2) (SWIG_PERL_OBJECT_CALL arg1, arg2)
/* -----------------------------------------------------------------------------
* pointers/data manipulation
* ----------------------------------------------------------------------------- */
#ifdef __cplusplus
extern "C" {
#if 0
} /* cc-mode */
#endif
#endif
#define SWIG_OWNER SWIG_POINTER_OWN
#define SWIG_SHADOW SWIG_OWNER << 1
#define SWIG_MAYBE_PERL_OBJECT SWIG_PERL_OBJECT_DECL
SWIGRUNTIME const char *
SWIG_Perl_TypeProxyName(const swig_type_info *type) {
if (!type) return NULL;
if (type->clientdata != NULL) {
return (const char*) type->clientdata;
}
else {
return type->name;
}
}
SWIGRUNTIME swig_cast_info *
SWIG_TypeProxyCheck(const char *c, swig_type_info *ty) {
SWIG_TypeCheck_Template(( (!iter->type->clientdata && (strcmp((char*)iter->type->name, c) == 0))
|| (iter->type->clientdata && (strcmp((char*)iter->type->clientdata, c) == 0))), ty);
}
/* Function for getting a pointer value */
SWIGRUNTIME int
SWIG_Perl_ConvertPtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void **ptr, swig_type_info *_t, int flags) {
swig_cast_info *tc;
void *voidptr = (void *)0;
SV *tsv = 0;
/* If magical, apply more magic */
if (SvGMAGICAL(sv))
mg_get(sv);
/* Check to see if this is an object */
if (sv_isobject(sv)) {
tsv = (SV*) SvRV(sv);
IV tmp = 0;
if ((SvTYPE(tsv) == SVt_PVHV)) {
MAGIC *mg;
if (SvMAGICAL(tsv)) {
mg = mg_find(tsv,'P');
if (mg) {
sv = mg->mg_obj;
if (sv_isobject(sv)) {
tsv = (SV*)SvRV(sv);
tmp = SvIV(tsv);
}
}
} else {
return SWIG_ERROR;
}
} else {
tmp = SvIV(tsv);
}
voidptr = (void *)tmp;
} else if (! SvOK(sv)) { /* Check for undef */
*(ptr) = (void *) 0;
return SWIG_OK;
} else if (SvTYPE(sv) == SVt_RV) { /* Check for NULL pointer */
if (!SvROK(sv)) {
*(ptr) = (void *) 0;
return SWIG_OK;
} else {
return SWIG_ERROR;
}
} else { /* Don't know what it is */
return SWIG_ERROR;
}
if (_t) {
/* Now see if the types match */
char *_c = HvNAME(SvSTASH(SvRV(sv)));
tc = SWIG_TypeProxyCheck(_c,_t);
if (!tc) {
return SWIG_ERROR;
}
*ptr = SWIG_TypeCast(tc,voidptr);
} else {
*ptr = voidptr;
}
/*
DISOWN implementation: we need a perl guru to check this one.
*/
if (tsv && (flags & SWIG_POINTER_DISOWN)) {
/*
almost copy paste code from bellow SWIG_POINTER_OWN setting
*/
SV *obj = sv;
HV *stash = SvSTASH(SvRV(obj));
GV *gv = *(GV**) hv_fetch(stash, "OWNER", 5, TRUE);
if (isGV(gv)) {
HV *hv = GvHVn(gv);
/*
To set ownership (see bellow), an newSViv(1) entry is added.
Hence, to remove ownership, we delete the entry.
*/
if (hv_exists_ent(hv, obj, 0)) {
hv_delete_ent(hv, obj, 0, 0);
}
}
}
return SWIG_OK;
}
SWIGRUNTIME void
SWIG_Perl_MakePtr(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, swig_type_info *t, int flags) {
if (ptr && (flags & SWIG_SHADOW)) {
SV *self;
SV *obj=newSV(0);
HV *hash=newHV();
HV *stash;
sv_setref_pv(obj, (char *) SWIG_Perl_TypeProxyName(t), ptr);
stash=SvSTASH(SvRV(obj));
if (flags & SWIG_POINTER_OWN) {
HV *hv;
GV *gv=*(GV**)hv_fetch(stash, "OWNER", 5, TRUE);
if (!isGV(gv))
gv_init(gv, stash, "OWNER", 5, FALSE);
hv=GvHVn(gv);
hv_store_ent(hv, obj, newSViv(1), 0);
}
sv_magic((SV *)hash, (SV *)obj, 'P', Nullch, 0);
SvREFCNT_dec(obj);
self=newRV_noinc((SV *)hash);
sv_setsv(sv, self);
SvREFCNT_dec((SV *)self);
sv_bless(sv, stash);
}
else {
sv_setref_pv(sv, (char *) SWIG_Perl_TypeProxyName(t), ptr);
}
}
SWIGRUNTIMEINLINE SV *
SWIG_Perl_NewPointerObj(SWIG_MAYBE_PERL_OBJECT void *ptr, swig_type_info *t, int flags) {
SV *result = sv_newmortal();
SWIG_MakePtr(result, ptr, t, flags);
return result;
}
SWIGRUNTIME void
SWIG_Perl_MakePackedObj(SWIG_MAYBE_PERL_OBJECT SV *sv, void *ptr, int sz, swig_type_info *type) {
char result[1024];
char *r = result;
if ((2*sz + 1 + strlen(SWIG_Perl_TypeProxyName(type))) > 1000) return;
*(r++) = '_';
r = SWIG_PackData(r,ptr,sz);
strcpy(r,SWIG_Perl_TypeProxyName(type));
sv_setpv(sv, result);
}
SWIGRUNTIME SV *
SWIG_Perl_NewPackedObj(SWIG_MAYBE_PERL_OBJECT void *ptr, int sz, swig_type_info *type) {
SV *result = sv_newmortal();
SWIG_Perl_MakePackedObj(result, ptr, sz, type);
return result;
}
/* Convert a packed value value */
SWIGRUNTIME int
SWIG_Perl_ConvertPacked(SWIG_MAYBE_PERL_OBJECT SV *obj, void *ptr, int sz, swig_type_info *ty) {
swig_cast_info *tc;
const char *c = 0;
if ((!obj) || (!SvOK(obj))) return SWIG_ERROR;
c = SvPV(obj, PL_na);
/* Pointer values must start with leading underscore */
if (*c != '_') return SWIG_ERROR;
c++;
c = SWIG_UnpackData(c,ptr,sz);
if (ty) {
tc = SWIG_TypeCheck(c,ty);
if (!tc) return SWIG_ERROR;
}
return SWIG_OK;
}
/* Macros for low-level exception handling */
#define SWIG_croak(x) { SWIG_Error(SWIG_RuntimeError, x); SWIG_fail; }
typedef XS(SwigPerlWrapper);
typedef SwigPerlWrapper *SwigPerlWrapperPtr;
/* Structure for command table */
typedef struct {
const char *name;
SwigPerlWrapperPtr wrapper;
} swig_command_info;
/* Information for constant table */
#define SWIG_INT 1
#define SWIG_FLOAT 2
#define SWIG_STRING 3
#define SWIG_POINTER 4
#define SWIG_BINARY 5
/* Constant information structure */
typedef struct swig_constant_info {
int type;
const char *name;
long lvalue;
double dvalue;
void *pvalue;
swig_type_info **ptype;
} swig_constant_info;
/* Structure for variable table */
typedef struct {
const char *name;
SwigMagicFunc set;
SwigMagicFunc get;
swig_type_info **type;
} swig_variable_info;
/* Magic variable code */
#ifndef PERL_OBJECT
#define swig_create_magic(s,a,b,c) _swig_create_magic(s,a,b,c)
#ifndef MULTIPLICITY
SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int (*get)(SV *,MAGIC *))
#else
SWIGRUNTIME void _swig_create_magic(SV *sv, char *name, int (*set)(struct interpreter*, SV *, MAGIC *), int (*get)(struct interpreter*, SV *,MAGIC *))
#endif
#else
# define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c)
SWIGRUNTIME void _swig_create_magic(CPerlObj *pPerl, SV *sv, const char *name, int (CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *))
#endif
{
MAGIC *mg;
sv_magic(sv,sv,'U',(char *) name,strlen(name));
mg = mg_find(sv,'U');
mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
mg->mg_virtual->svt_get = (SwigMagicFuncHack) get;
mg->mg_virtual->svt_set = (SwigMagicFuncHack) set;
mg->mg_virtual->svt_len = 0;
mg->mg_virtual->svt_clear = 0;
mg->mg_virtual->svt_free = 0;
}
SWIGRUNTIME swig_module_info *
SWIG_Perl_GetModule() {
static void *type_pointer = (void *)0;
SV *pointer;
/* first check if pointer already created */
if (!type_pointer) {
pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, FALSE);
if (pointer && SvOK(pointer)) {
type_pointer = INT2PTR(swig_type_info **, SvIV(pointer));
}
}
return (swig_module_info *) type_pointer;
}
SWIGRUNTIME void
SWIG_Perl_SetModule(swig_module_info *module) {
SV *pointer;
/* create a new pointer */
pointer = get_sv("swig_runtime_data::type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, TRUE);
sv_setiv(pointer, PTR2IV(module));
}
#ifdef __cplusplus
#if 0
{ /* cc-mode */
#endif
}
#endif
Reference in a new issue View git blame Copy permalink