mirror of
https://github.com/nillerusr/source-engine.git
synced 2026-09-01 23:19:18 +00:00
1
This commit is contained in:
@@ -0,0 +1,467 @@
|
||||
/* -----------------------------------------------------------------------------
|
||||
* 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 *SWIGUNUSEDPARM(pPerl),
|
||||
#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) sv_setpvf(GvSV(PL_errgv),"%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
|
||||
* ----------------------------------------------------------------------------- */
|
||||
|
||||
/* For backward compatibility only */
|
||||
#define SWIG_POINTER_EXCEPTION 0
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
#define SWIG_OWNER SWIG_POINTER_OWN
|
||||
#define SWIG_SHADOW SWIG_OWNER << 1
|
||||
|
||||
#define SWIG_MAYBE_PERL_OBJECT SWIG_PERL_OBJECT_DECL
|
||||
|
||||
/* SWIG Perl macros */
|
||||
|
||||
/* Macro to declare an XS function */
|
||||
#ifndef XSPROTO
|
||||
# define XSPROTO(name) void name(pTHX_ CV* cv)
|
||||
#endif
|
||||
|
||||
/* Macro to call an XS function */
|
||||
#ifdef PERL_OBJECT
|
||||
# define SWIG_CALLXS(_name) _name(cv,pPerl)
|
||||
#else
|
||||
# ifndef MULTIPLICITY
|
||||
# define SWIG_CALLXS(_name) _name(cv)
|
||||
# else
|
||||
# define SWIG_CALLXS(_name) _name(PERL_GET_THX, cv)
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifdef PERL_OBJECT
|
||||
#define MAGIC_PPERL CPerlObj *pPerl = (CPerlObj *) this;
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
typedef int (CPerlObj::*SwigMagicFunc)(SV *, MAGIC *);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
|
||||
#define SWIGCLASS_STATIC
|
||||
|
||||
#else /* PERL_OBJECT */
|
||||
|
||||
#define MAGIC_PPERL
|
||||
#define SWIGCLASS_STATIC static SWIGUNUSED
|
||||
|
||||
#ifndef MULTIPLICITY
|
||||
#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
typedef int (*SwigMagicFunc)(SV *, MAGIC *);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#else /* MULTIPLICITY */
|
||||
|
||||
#define SWIG_MAGIC(a,b) (struct interpreter *interp, SV *a, MAGIC *b)
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif /* MULTIPLICITY */
|
||||
#endif /* PERL_OBJECT */
|
||||
|
||||
/* Workaround for bug in perl 5.6.x croak and earlier */
|
||||
#if (PERL_VERSION < 8)
|
||||
# ifdef PERL_OBJECT
|
||||
# define SWIG_croak_null() SWIG_Perl_croak_null(pPerl)
|
||||
static void SWIG_Perl_croak_null(CPerlObj *pPerl)
|
||||
# else
|
||||
static void SWIG_croak_null()
|
||||
# endif
|
||||
{
|
||||
SV *err=ERRSV;
|
||||
# if (PERL_VERSION < 6)
|
||||
croak("%_", err);
|
||||
# else
|
||||
if (SvOK(err) && !SvROK(err)) croak("%_", err);
|
||||
croak(Nullch);
|
||||
# endif
|
||||
}
|
||||
#else
|
||||
# define SWIG_croak_null() croak(Nullch)
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
Define how strict is the cast between strings and integers/doubles
|
||||
when overloading between these types occurs.
|
||||
|
||||
The default is making it as strict as possible by using SWIG_AddCast
|
||||
when needed.
|
||||
|
||||
You can use -DSWIG_PERL_NO_STRICT_STR2NUM at compilation time to
|
||||
disable the SWIG_AddCast, making the casting between string and
|
||||
numbers less strict.
|
||||
|
||||
In the end, we try to solve the overloading between strings and
|
||||
numerical types in the more natural way, but if you can avoid it,
|
||||
well, avoid it using %rename, for example.
|
||||
*/
|
||||
#ifndef SWIG_PERL_NO_STRICT_STR2NUM
|
||||
# ifndef SWIG_PERL_STRICT_STR2NUM
|
||||
# define SWIG_PERL_STRICT_STR2NUM
|
||||
# endif
|
||||
#endif
|
||||
#ifdef SWIG_PERL_STRICT_STR2NUM
|
||||
/* string takes precedence */
|
||||
#define SWIG_Str2NumCast(x) SWIG_AddCast(x)
|
||||
#else
|
||||
/* number takes precedence */
|
||||
#define SWIG_Str2NumCast(x) x
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
#include <stdlib.h>
|
||||
|
||||
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)) {
|
||||
IV tmp = 0;
|
||||
tsv = (SV*) SvRV(sv);
|
||||
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 = INT2PTR(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;
|
||||
}
|
||||
{
|
||||
int newmemory = 0;
|
||||
*ptr = SWIG_TypeCast(tc,voidptr,&newmemory);
|
||||
assert(!newmemory); /* newmemory handling not yet implemented */
|
||||
}
|
||||
} 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 below 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 below), a 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_nolen(obj);
|
||||
/* 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 XSPROTO(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 = (SwigMagicFunc) get;
|
||||
mg->mg_virtual->svt_set = (SwigMagicFunc) 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(void) {
|
||||
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
|
||||
}
|
||||
#endif
|
||||
Reference in New Issue
Block a user