jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

The great merge

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@4141 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Dave Beazley 2002-11-30 22:01:28 +00:00
commit 516036631c
1508 changed files with 125983 additions and 44037 deletions
Download patch file Download diff file Expand all files Collapse all files

10
SWIG/Lib/perl5/Makefile.in
View file

@ -35,7 +35,7 @@ CC = @CC@
CXX = @CXX@
OBJC = @CC@ -Wno-import # -Wno-import needed for gcc
CFLAGS =
INCLUDE =
INCLUDES =
LIBS =
# SWIG Options
@ -103,13 +103,13 @@ BUILD_LIBS = $(LIBS) # Dynamic loading
.SUFFIXES: .c .cxx .m
.c.o:
$(CC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
$(CC) $(CCSHARED) $(CFLAGS) $(INCLUDES) -c $<
.cxx.o:
$(CXX) $(CCSHARED) $(CXXFLAGS) $(INCLUDE) -c $<
$(CXX) $(CCSHARED) $(CXXFLAGS) $(INCLUDES) -c $<
.m.o:
$(OBJC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
$(OBJC) $(CCSHARED) $(CFLAGS) $(INCLUDES) -c $<
# ----------------------------------------------------------------------
@ -121,7 +121,7 @@ all: $(TARGET)
# Convert the wrapper file into an object file
$(WRAPOBJ) : $(WRAPFILE)
$(SWIGCC) -c $(CCSHARED) $(CFLAGS) $(INCLUDE) $(PERL_INCLUDE) $(PERL_FLAGS) $(WRAPFILE)
$(SWIGCC) -c $(CCSHARED) $(CFLAGS) $(INCLUDES) $(PERL_INCLUDE) $(PERL_FLAGS) $(WRAPFILE)
$(WRAPFILE) : $(INTERFACE)
$(SWIG) $(SWIGOPT) -o $(WRAPFILE) $(SWIGLIB) $(INTERFACE)

2
SWIG/Lib/perl5/extra-install.list Normal file
View file

@ -0,0 +1,2 @@
# see top-level Makefile.in
Makefile.pl

703
SWIG/Lib/perl5/perl5.swg
View file

@ -1,186 +1,571 @@
/* -----------------------------------------------------------------------------
* perl5.swg
*
* Perl5 runtime library
* $Header$
* Perl 5 configuration file
* ----------------------------------------------------------------------------- */
#define SWIGPERL
#define SWIGPERL5
#ifdef __cplusplus
/* Needed on some windows machines---since MS plays funny
games with the header files under C++ */
#include <math.h>
#include <stdlib.h>
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
%runtime "common.swg" // common type checking code
%runtime "perlrun.swg" // Perl runtime functions
/* Get rid of free and malloc defined by perl */
#undef free
#undef malloc
/* Typemaps for input parameters */
#include <string.h>
%typemap(in) int, short, long, signed char, bool, enum SWIGTYPE
"$1 = ($1_ltype) SvIV($input);";
%typemap(in) unsigned int, unsigned short, unsigned long, unsigned char
"$1 = ($1_ltype) SvUV($input);";
%typemap(in) char
"$1 = ($1_ltype) *SvPV($input,PL_na);";
%typemap(in) float, double
"$1 = ($1_ltype) SvNV($input);\n";
%typemap(in) long long "$1 = (long long) strtoll(SvPV($input, PL_na), 0, 0);";
%typemap(in) unsigned long long "$1 = (unsigned long long) strtoull(SvPV($input, PL_na), 0, 0);";
%typemap(in) char *
"if (!SvOK((SV*) $input)) $1 = 0;
else $1 = ($1_ltype) SvPV($input, PL_na);";
%typemap(in) char [ANY]
"$1 = SvPV($input,PL_na);\n";
%typemap(in) SWIGTYPE *, SWIGTYPE [], SWIGTYPE & {
if (SWIG_ConvertPtr($input, (void **) &$1, $1_descriptor,0) < 0) {
SWIG_croak("Type error in argument $argnum of $symname. Expected $1_mangle");
}
}
%typemap(in) void * {
if (SWIG_ConvertPtr($input, (void **) &$1, 0,0) < 0) {
SWIG_croak("Type error in argument $argnum of $symname. Expected $1_mangle");
}
}
/* Object passed by value. Convert to a pointer */
%typemap(in) SWIGTYPE {
$&1_ltype argp;
if (SWIG_ConvertPtr($input,(void **) &argp, $&1_descriptor,0) < 0) {
SWIG_croak("Type error in argument $argnum of $symname. Expected $&1_mangle");
}
$1 = *argp;
}
/* Const primitive references. Passed by value */
%typemap(in) const int & (int temp),
const short & (short temp),
const long & (long temp),
const signed char & (signed char temp),
const bool & (bool temp)
"temp = ($*1_ltype) SvIV($input);
$1 = &temp;";
%typemap(in) const unsigned int & (unsigned int temp),
const unsigned short & (unsigned short temp),
const unsigned long & (unsigned long temp),
const unsigned char & (unsigned char temp)
"temp = ($*1_ltype) SvUV($input);
$1 = &temp;";
%typemap(in) const float & (float temp),
const double & (double temp)
"temp = ($*1_ltype) SvNV($input);
$1 = &temp;";
%typemap(in) const long long & (long long temp)
"temp = (long long) strtoll(SvPV($input,PL_na),0,0);
$1 = &temp;";
%typemap(in) const unsigned long long & (unsigned long long temp)
"temp = (unsigned long long) strtoull(SvPV($input, PL_na),0,0);
$1 = &temp;";
%typemap(in) const char &(char temp) {
temp = *SvPV($input,PL_na);
$1 = &temp;
}
/* Typemap for output values */
%typemap(out) int, short, long, signed char, bool, enum SWIGTYPE
"ST(argvi) = sv_newmortal();
sv_setiv(ST(argvi++), (IV) $1);";
%typemap(out) unsigned int, unsigned short, unsigned long, unsigned char
"ST(argvi) = sv_newmortal();
sv_setuv(ST(argvi++), (UV) $1);";
%typemap(out) float, double
"ST(argvi) = sv_newmortal();
sv_setnv(ST(argvi++), (double) $1);";
%typemap(out) char
"ST(argvi) = sv_newmortal();
sv_setpvn((SV*)ST(argvi++), &$1, 1);";
%typemap(out) char *
"ST(argvi) = sv_newmortal();
if ($1) {
sv_setpv((SV*)ST(argvi++), (char *) $1);
} else {
sv_setsv((SV*)ST(argvi++), &PL_sv_undef);
}";
%typemap(out) long long {
char temp[256];
sprintf(temp,"%lld", $1);
ST(argvi) = sv_newmortal();
sv_setpv((SV*)ST(argvi++), temp);
}
%typemap(out) unsigned long long {
char temp[256];
sprintf(temp,"%llu", $1);
ST(argvi) = sv_newmortal();
sv_setpv((SV*)ST(argvi++), temp);
}
%typemap(out) SWIGTYPE *, SWIGTYPE [], SWIGTYPE &
"ST(argvi) = sv_newmortal();
SWIG_MakePtr(ST(argvi++), (void *) $1, $1_descriptor,0);";
%typemap(out) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultobj = new $1_ltype(($1_ltype &)$1);
ST(argvi) = sv_newmortal();
SWIG_MakePtr(ST(argvi++), (void *) resultobj, $&1_descriptor,0);
}
#else
{
$&1_ltype resultobj = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultobj, &$1, sizeof($1_type));
ST(argvi) = sv_newmortal();
SWIG_MakePtr(ST(argvi++), (void *) resultobj, $&1_descriptor,0);
}
#endif
#ifdef PERL_OBJECT
#define MAGIC_PPERL CPerlObj *pPerl = (CPerlObj *) this;
#define MAGIC_CAST (int (CPerlObj::*)(SV *, MAGIC *))
#define SWIGCLASS_STATIC
#else
#define MAGIC_PPERL
#define MAGIC_CAST
#define SWIGCLASS_STATIC static
#endif
/* Dynamic casts */
#if defined(WIN32) && defined(PERL_OBJECT) && !defined(PerlIO_exportFILE)
#define PerlIO_exportFILE(fh,fl) (FILE*)(fh)
#endif
%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC {
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor, (void **) &$1);
ST(argvi) = sv_newmortal();
SWIG_MakePtr(ST(argvi++), (void *) $1, ty,0);
}
/* Modifications for newer Perl 5.005 releases */
%typemap(out) void "";
#if !defined(PERL_REVISION) || ((PERL_REVISION >= 5) && ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION < 50))))
#ifndef PL_sv_yes
#define PL_sv_yes sv_yes
#endif
#ifndef PL_sv_undef
#define PL_sv_undef sv_undef
#endif
#ifndef PL_na
#define PL_na na
#endif
#endif
/* Typemap for character array returns */
#include <stdlib.h>
%typemap(out) char [ANY]
"ST(argvi) = sv_newmortal();
sv_setpv((SV*)ST(argvi++),(char *) $1);";
/* References to primitive types. Return by value */
%typemap(out) const int &,
const short &,
const long &,
const signed char &,
const bool &
"ST(argvi) = sv_newmortal();
sv_setiv(ST(argvi++), (IV) *($1));";
%typemap(out) const unsigned int &,
const unsigned short &,
const unsigned long &,
const unsigned char &
"ST(argvi) = sv_newmortal();
sv_setuv(ST(argvi++), (UV) *($1));";
%typemap(out) const float &, const double &
"ST(argvi) = sv_newmortal();
sv_setnv(ST(argvi++), (double) *($1));";
%typemap(out) const long long & {
char temp[256];
sprintf(temp,"%lld", *($1));
ST(argvi) = sv_newmortal();
sv_setpv((SV*)ST(argvi++), temp);
}
%typemap(out) const unsigned long long & {
char temp[256];
sprintf(temp,"%llu", *($1));
ST(argvi) = sv_newmortal();
sv_setpv((SV*)ST(argvi++), temp);
}
%typemap(out) const char &
"ST(argvi) = sv_newmortal();
sv_setpvn((SV*)ST(argvi++), $1, 1);";
/* Variable input */
%typemap(varin) int, short, long, signed char, bool, enum SWIGTYPE
"$1 = ($1_ltype) SvIV($input);";
%typemap(varin) unsigned int, unsigned short, unsigned long, unsigned char
"$1 = ($1_ltype) SvUV($input);";
%typemap(varin) char
"$1 = ($1_ltype) *SvPV($input,PL_na);";
%typemap(varin) float, double
"$1 = ($1_ltype) SvNV($input);\n";
%typemap(varin) long long "$1 = (long long) strtoll(SvPV($input, PL_na), 0, 0);";
%typemap(varin) unsigned long long "$1 = (unsigned long long) strtoull(SvPV($input, PL_na), 0, 0);";
%typemap(varin) SWIGTYPE *, SWIGTYPE [], SWIGTYPE & {
if (SWIG_ConvertPtr($input, (void **) &$1, $1_descriptor,0) < 0) {
croak("Type error in argument $argnum of $symname. Expected $1_mangle");
}
}
%typemap(varin) void * {
if (SWIG_ConvertPtr($input, (void **) &$1, 0,0) < 0) {
croak("Type error in argument $argnum of $symname. Expected $1_mangle");
}
}
/* Object passed by value. Convert to a pointer */
%typemap(varin) SWIGTYPE {
$&1_ltype argp;
if (SWIG_ConvertPtr($input,(void **) &argp, $&1_descriptor,0) < 0) {
croak("Type error in argument $argnum of $symname. Expected $&1_mangle");
}
$1 = *argp;
}
/* Const primitive references. Passed by value */
%typemap(varin) const int & (int temp),
const short & (short temp),
const long & (long temp),
const signed char & (signed char temp),
const bool & (bool temp)
"temp = ($*1_ltype) SvIV($input);
$1 = &temp;";
%typemap(varin) const unsigned int & (unsigned int temp),
const unsigned short & (unsigned short temp),
const unsigned long & (unsigned long temp),
const unsigned char & (unsigned char temp)
"temp = ($*1_ltype) SvUV($input);
$1 = &temp;";
%typemap(varin) const float & (float temp),
const double & (double temp)
"temp = ($*1_ltype) SvNV($input);
$1 = &temp;";
%typemap(varin) const long long & (long long temp)
"temp = (long long) strtoll(SvPV($input,PL_na),0,0);
$1 = &temp;";
%typemap(varin) const unsigned long long & (unsigned long long temp)
"temp = (unsigned long long) strtoull(SvPV($input, PL_na),0,0);
$1 = &temp;";
%typemap(varin) const char &(char temp) {
temp = *SvPV($input,PL_na);
$1 = &temp;
}
%typemap(varin) char *
#ifdef __cplusplus
extern "C" {
#endif
#ifdef SWIG_NOINCLUDE
#ifndef PERL_OBJECT
extern int SWIG_ConvertPtr(SV *, void **, swig_type_info *);
extern void SWIG_MakePtr(SV *, void *, swig_type_info *);
#else
extern int _SWIG_ConvertPtr(CPerlObj *, SV *, void **, swig_type_info *);
extern void _SWIG_MakePtr(CPerlObj *, SV *, void *, swig_type_info *);
#define SWIG_ConvertPtr(a,b,c) _SWIG_ConvertPtr(pPerl,a,b,c)
#define SWIG_MakePtr(a,b,c) _SWIG_MakePtr(pPerl,a,b,c)
#endif
#endif
/* Function for getting a pointer value */
#ifndef PERL_OBJECT
SWIGRUNTIME(int)
SWIG_ConvertPtr(SV *sv, void **ptr, swig_type_info *_t)
#else
#define SWIG_ConvertPtr(a,b,c) _SWIG_ConvertPtr(pPerl,a,b,c)
SWIGRUNTIME(int)
_SWIG_ConvertPtr(CPerlObj *pPerl, SV *sv, void **ptr, swig_type_info *_t)
#endif
{
char *_c;
swig_type_info *tc;
IV tmp;
char *_a = (char *) SvPV(sv,PL_na);
if ($1) delete [] $1;
$1 = new char[strlen(_a)+1];
strcpy((char *)$1,_a);
}
#else
{
char *_a = (char *) SvPV(sv,PL_na);
if ($1) free((char *) $1);
$1 = (char *) malloc(strlen(_a)+1);
strcpy((char *)$1,_a);
}
#endif
/* If magical, apply more magic */
if (SvGMAGICAL(sv))
mg_get(sv);
%typemap(varin,warning="451:Setting const char * variable may leak memory") const char *
#ifdef __cplusplus
{
char *_a = (char *) SvPV(sv,PL_na);
$1 = new char[strlen(_a)+1];
strcpy((char *)$1,_a);
}
#else
{
char *_a = (char *) SvPV(sv,PL_na);
$1 = (char *) malloc(strlen(_a)+1);
strcpy((char *)$1,_a);
}
#endif
/* Check to see if this is an object */
if (sv_isobject(sv)) {
SV *tsv = (SV*) SvRV(sv);
if ((SvTYPE(tsv) == SVt_PVHV)) {
MAGIC *mg;
if (SvMAGICAL(tsv)) {
mg = mg_find(tsv,'P');
if (mg) {
SV *rsv = mg->mg_obj;
if (sv_isobject(rsv)) {
tmp = SvIV((SV*)SvRV(rsv));
}
}
%typemap(varin) char [ANY]
"strncpy($1, (char *) SvPV(sv,PL_na), $1_dim0);";
%typemap(varin) SWIGTYPE [] "croak(\"Value is read-only.\");";
%typemap(varin) enum SWIGTYPE
"$1 = ($1_type) SvIV($input);";
/* --- Typemaps for variable output --- */
%typemap(varout) int, short, long, signed char, bool, enum SWIGTYPE
"sv_setiv($result, (IV) $1);";
%typemap(varout) unsigned int, unsigned short, unsigned long, unsigned char
"sv_setuv($result, (UV) $1);";
%typemap(varout) float, double
"sv_setnv($result, (double) $1);";
%typemap(varout) char
"sv_setpvn((SV *) $result, &$1, 1);";
%typemap(varout) long long {
char temp[256];
sprintf(temp,"%lld",$1);
sv_setpv((SV *) $result, temp);
}
%typemap(varout) unsigned long long {
char temp[256];
sprintf(temp,"%llu",$1);
sv_setpv((SV *) $result, temp);
}
%typemap(varout) char *, char [ANY]
"if ($1) {
sv_setpv((SV*)$result, (char *) $1);
} else {
sv_setsv((SV*)$result, &PL_sv_undef);
}";
//%typemap(varout) SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
// "SWIG_MakePtr($result, (void *) $1, $1_descriptor);";
%typemap(varout,type="$1_descriptor") SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
"sv_setiv(SvRV($result),(IV) $1);";
//%typemap(varout) SWIGTYPE
// "SWIG_MakePtr($result, (void *) &$1, $&1_descriptor);";
%typemap(varout,type="$&1_descriptor") SWIGTYPE
"sv_setiv(SvRV($result), (IV) &$1);";
/* --- Typemaps for constants --- *
/* --- Constants --- */
%typemap(consttab) int, unsigned int, short, unsigned short, long, unsigned long, unsigned char, signed char, bool, enum SWIGTYPE
{ SWIG_INT, (char *) SWIG_prefix "$symname", (long) $value, 0, 0, 0}
%typemap(consttab) float, double
{ SWIG_FLOAT, (char *) SWIG_prefix "$symname", 0, (double) $value, 0, 0}
%typemap(consttab) char, char *
{ SWIG_STRING, (char *) SWIG_prefix "$symname", 0, 0, (void *)"$value", 0}
%typemap(consttab) long long, unsigned long long
{ SWIG_STRING, (char *) SWIG_prefix "$symname", 0, 0, (void *) "$value", 0}
%typemap(consttab) SWIGTYPE *, SWIGTYPE &, SWIGTYPE []
{ SWIG_POINTER, (char *) SWIG_prefix "$symname", 0, 0, (void *)$value, &$1_descriptor}
%typemap(consttab) SWIGTYPE (CLASS::*)
{ SWIG_BINARY, (char *) SWIG_prefix "$symname", sizeof($type), 0, (void *)&$value, &$1_descriptor}
/* ------------------------------------------------------------
* String & length
* ------------------------------------------------------------ */
%typemap(in) (char *STRING, int LENGTH) {
unsigned int temp;
$1 = ($1_ltype) SvPV($input,temp);
$2 = ($2_ltype) temp;
}
/* ------------------------------------------------------------
* ANSI C typemaps
* ------------------------------------------------------------ */
%apply unsigned long { size_t };
/* ------------------------------------------------------------
* Typechecking rules
* ------------------------------------------------------------ */
%typecheck(SWIG_TYPECHECK_INTEGER)
int, short, long,
unsigned int, unsigned short, unsigned long,
signed char, unsigned char,
long long, unsigned long long,
const int &, const short &, const long &,
const unsigned int &, const unsigned short &, const unsigned long &,
const long long &, const unsigned long long &,
enum SWIGTYPE,
bool, const bool &
{
$1 = SvIOK($input) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_DOUBLE)
float, double,
const float &, const double &
{
$1 = SvNOK($input) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_CHAR) char {
$1 = SvPOK($input) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_STRING) char * {
$1 = SvPOK($input) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE [] {
void *tmp;
if (SWIG_ConvertPtr($input, (void **) &tmp, $1_descriptor, 0) == -1) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE {
void *tmp;
if (SWIG_ConvertPtr($input, (void **) &tmp, $&1_descriptor, 0) == -1) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *tmp;
if (SWIG_ConvertPtr($input, (void **) &tmp, 0, 0) == -1) {
$1 = 0;
} else {
$1 = 1;
}
}
/* ------------------------------------------------------------
* Exception handling
* ------------------------------------------------------------ */
%typemap(throws) int,
long,
short,
unsigned int,
unsigned long,
unsigned short {
sprintf(_swigmsg,"%d",$1);
SWIG_croak(_swigmsg);
}
%typemap(throws) SWIGTYPE {
SWIG_croak("$1_type");
}
%typemap(throws) char * {
SWIG_croak($1);
SWIG_fail;
}
/* Export the SWIG initialization function */
%header %{
#ifdef __cplusplus
extern "C"
#endif
#ifndef PERL_OBJECT
#ifndef MULTIPLICITY
SWIGEXPORT(void) SWIG_init (CV* cv);
#else
SWIGEXPORT(void) SWIG_init (pTHXo_ CV* cv);
#endif
#else
SWIGEXPORT(void) SWIG_init (CV *cv, CPerlObj *);
#endif
%}
/* Module initialization function */
%init %{
#ifdef __cplusplus
extern "C"
#endif
XS(SWIG_init) {
dXSARGS;
int i;
static int _init = 0;
if (!_init) {
for (i = 0; swig_types_initial[i]; i++) {
swig_types[i] = SWIG_TypeRegister(swig_types_initial[i]);
}
_init = 1;
}
/* Install commands */
for (i = 0; swig_commands[i].name; i++) {
newXS((char*) swig_commands[i].name,swig_commands[i].wrapper, (char*)__FILE__);
}
/* Install variables */
for (i = 0; swig_variables[i].name; i++) {
SV *sv;
sv = perl_get_sv((char*) swig_variables[i].name, TRUE | 0x2);
if (swig_variables[i].type) {
SWIG_MakePtr(sv,(void *)1, *swig_variables[i].type,0);
} else {
return -1;
sv_setiv(sv,(IV) 0);
}
} else {
tmp = SvIV((SV*)SvRV(sv));
swig_create_magic(sv, (char *) swig_variables[i].name, swig_variables[i].set, swig_variables[i].get);
}
if (!_t) {
*(ptr) = (void *) tmp;
return 0;
/* Install constant */
for (i = 0; swig_constants[i].type; i++) {
SV *sv;
sv = perl_get_sv((char*)swig_constants[i].name, TRUE | 0x2);
switch(swig_constants[i].type) {
case SWIG_INT:
sv_setiv(sv, (IV) swig_constants[i].lvalue);
break;
case SWIG_FLOAT:
sv_setnv(sv, (double) swig_constants[i].dvalue);
break;
case SWIG_STRING:
sv_setpv(sv, (char *) swig_constants[i].pvalue);
break;
case SWIG_POINTER:
SWIG_MakePtr(sv, swig_constants[i].pvalue, *(swig_constants[i].ptype),0);
break;
case SWIG_BINARY:
/* obj = SWIG_NewPackedObj(swig_constants[i].pvalue, swig_constants[i].lvalue, *(swig_constants[i].ptype)); */
break;
default:
break;
}
SvREADONLY_on(sv);
}
} else if (! SvOK(sv)) { /* Check for undef */
*(ptr) = (void *) 0;
return 0;
} else if (SvTYPE(sv) == SVt_RV) { /* Check for NULL pointer */
*(ptr) = (void *) 0;
if (!SvROK(sv))
return 0;
else
return -1;
} else { /* Don't know what it is */
*(ptr) = (void *) 0;
return -1;
}
if (_t) {
/* Now see if the types match */
_c = HvNAME(SvSTASH(SvRV(sv)));
tc = SWIG_TypeCheck(_c,_t);
if (!tc) {
*ptr = (void *) tmp;
return -1;
}
*ptr = SWIG_TypeCast(tc,(void *)tmp);
return 0;
}
*ptr = (void *) tmp;
return 0;
}
#ifndef PERL_OBJECT
SWIGRUNTIME(void)
SWIG_MakePtr(SV *sv, void *ptr, swig_type_info *t)
#else
#define SWIG_MakePtr(a,b,c) _SWIG_MakePtr(pPerl,a,b,c)
SWIGRUNTIME(int *)
_SWIG_MakePtr(CPerlObj *pPerl, SV *sv, void *ptr, swig_type_info *t)
#endif
{
sv_setref_pv(sv, t->name, ptr);
}
/* Magic variable code */
#ifndef PERL_OBJECT
#define swig_create_magic(s,a,b,c) _swig_create_magic(s,a,b,c)
static void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int (*get)(SV *,MAGIC *)) {
#else
#define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c)
static void _swig_create_magic(CPerlObj *pPerl, SV *sv, char *name, int (CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *)) {
#endif
MAGIC *mg;
sv_magic(sv,sv,'U',name,strlen(name));
mg = mg_find(sv,'U');
mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL));
mg->mg_virtual->svt_get = get;
mg->mg_virtual->svt_set = set;
mg->mg_virtual->svt_len = 0;
mg->mg_virtual->svt_clear = 0;
mg->mg_virtual->svt_free = 0;
}
#ifdef __cplusplus
}
#endif
%}

286
SWIG/Lib/perl5/perlrun.swg Normal file
View file

@ -0,0 +1,286 @@
/* -----------------------------------------------------------------------------
* perl5.swg
*
* Perl5 runtime library
* $Header$
* ----------------------------------------------------------------------------- */
#define SWIGPERL
#define SWIGPERL5
#ifdef __cplusplus
/* Needed on some windows machines---since MS plays funny
games with the header files under C++ */
#include <math.h>
#include <stdlib.h>
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
/* Get rid of free and malloc defined by perl */
#undef free
#undef malloc
#ifndef pTHX_
#define pTHX_
#endif
#include <string.h>
#ifdef __cplusplus
}
#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
/* Macros for low-level exception handling */
#define SWIG_fail goto fail
#define SWIG_croak(x) { if ((_swigerr = (const char *) x)) goto fail; }
#define SWIG_MAX_ERRMSG 256
/* Note: SwigMagicFuncHack is a typedef used to get the C++
compiler to just shut up already */
#ifdef PERL_OBJECT
#define MAGIC_PPERL CPerlObj *pPerl = (CPerlObj *) this;
typedef int (CPerlObj::*SwigMagicFunc)(SV *, MAGIC *);
#ifdef __cplusplus
extern "C" {
#endif
typedef int (CPerlObj::*SwigMagicFuncHack)(SV *, MAGIC *);
#ifdef __cplusplus
}
#endif
#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
#define SWIGCLASS_STATIC
#else
#define MAGIC_PPERL
#define SWIGCLASS_STATIC static
#ifndef MULTIPLICITY
#define SWIG_MAGIC(a,b) (SV *a, MAGIC *b)
typedef int (*SwigMagicFunc)(SV *, MAGIC *);
#ifdef __cplusplus
extern "C" {
#endif
typedef int (*SwigMagicFuncHack)(SV *, MAGIC *);
#ifdef __cplusplus
}
#endif
#else
#define SWIG_MAGIC(a,b) (struct interpreter *interp, SV *a, MAGIC *b)
typedef int (*SwigMagicFunc)(struct interpreter *, SV *, MAGIC *);
#ifdef __cplusplus
extern "C" {
#endif
typedef int (*SwigMagicFuncHack)(struct interpreter *, SV *, MAGIC *);
#ifdef __cplusplus
}
#endif
#endif
#endif
#if defined(WIN32) && defined(PERL_OBJECT) && !defined(PerlIO_exportFILE)
#define PerlIO_exportFILE(fh,fl) (FILE*)(fh)
#endif
/* Modifications for newer Perl 5.005 releases */
#if !defined(PERL_REVISION) || ((PERL_REVISION >= 5) && ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION < 50))))
#ifndef PL_sv_yes
#define PL_sv_yes sv_yes
#endif
#ifndef PL_sv_undef
#define PL_sv_undef sv_undef
#endif
#ifndef PL_na
#define PL_na na
#endif
#endif
#include <stdlib.h>
#ifdef __cplusplus
extern "C" {
#endif
#ifdef SWIG_NOINCLUDE
#ifndef PERL_OBJECT
extern int SWIG_ConvertPtr(SV *, void **, swig_type_info *, int flags);
extern void SWIG_MakePtr(SV *, void *, swig_type_info *, int flags);
#else
extern int _SWIG_ConvertPtr(CPerlObj *, SV *, void **, swig_type_info *,int flags);
extern void _SWIG_MakePtr(CPerlObj *, SV *, void *, swig_type_info *, int flags);
#define SWIG_ConvertPtr(a,b,c,d) _SWIG_ConvertPtr(pPerl,a,b,c,d)
#define SWIG_MakePtr(a,b,c,d) _SWIG_MakePtr(pPerl,a,b,c,d)
#endif
#else
/* Function for getting a pointer value */
#ifndef PERL_OBJECT
SWIGRUNTIME(int)
SWIG_ConvertPtr(SV *sv, void **ptr, swig_type_info *_t, int flags)
#else
#define SWIG_ConvertPtr(a,b,c,d) _SWIG_ConvertPtr(pPerl,a,b,c,d)
SWIGRUNTIME(int)
_SWIG_ConvertPtr(CPerlObj *pPerl, SV *sv, void **ptr, swig_type_info *_t, int flags)
#endif
{
char *_c;
swig_type_info *tc;
IV tmp;
/* If magical, apply more magic */
if (SvGMAGICAL(sv))
mg_get(sv);
/* Check to see if this is an object */
if (sv_isobject(sv)) {
SV *tsv = (SV*) SvRV(sv);
if ((SvTYPE(tsv) == SVt_PVHV)) {
MAGIC *mg;
if (SvMAGICAL(tsv)) {
mg = mg_find(tsv,'P');
if (mg) {
SV *rsv = mg->mg_obj;
if (sv_isobject(rsv)) {
tmp = SvIV((SV*)SvRV(rsv));
}
}
} else {
return -1;
}
} else {
tmp = SvIV((SV*)SvRV(sv));
}
if (!_t) {
*(ptr) = (void *) tmp;
return 0;
}
} else if (! SvOK(sv)) { /* Check for undef */
*(ptr) = (void *) 0;
return 0;
} else if (SvTYPE(sv) == SVt_RV) { /* Check for NULL pointer */
*(ptr) = (void *) 0;
if (!SvROK(sv))
return 0;
else
return -1;
} else { /* Don't know what it is */
*(ptr) = (void *) 0;
return -1;
}
if (_t) {
/* Now see if the types match */
_c = HvNAME(SvSTASH(SvRV(sv)));
tc = SWIG_TypeCheck(_c,_t);
if (!tc) {
*ptr = (void *) tmp;
return -1;
}
*ptr = SWIG_TypeCast(tc,(void *)tmp);
return 0;
}
*ptr = (void *) tmp;
return 0;
}
#ifndef PERL_OBJECT
SWIGRUNTIME(void)
SWIG_MakePtr(SV *sv, void *ptr, swig_type_info *t,int flags)
#else
#define SWIG_MakePtr(a,b,c,d) _SWIG_MakePtr(pPerl,a,b,c,d)
SWIGRUNTIME(void)
_SWIG_MakePtr(CPerlObj *pPerl, SV *sv, void *ptr, swig_type_info *t, int flags)
#endif
{
sv_setref_pv(sv, (char *) t->name, ptr);
}
#endif
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;
#ifdef __cplusplus
}
#endif
/* 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
static void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int \
(*get)(SV *,MAGIC *)) {
#else
static 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)
static 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;
}

511
SWIG/Lib/perl5/ptrlang.i
View file

@ -1,511 +0,0 @@
//
// SWIG pointer conversion and utility library
//
// Dave Beazley
// April 19, 1997
//
// Perl5 specific implementation. This file is included
// by the file ../pointer.i
%{
#include <ctype.h>
/* Types used by the library */
static swig_type_info *SWIG_POINTER_int_p = 0;
static swig_type_info *SWIG_POINTER_short_p =0;
static swig_type_info *SWIG_POINTER_long_p = 0;
static swig_type_info *SWIG_POINTER_float_p = 0;
static swig_type_info *SWIG_POINTER_double_p = 0;
static swig_type_info *SWIG_POINTER_char_p = 0;
static swig_type_info *SWIG_POINTER_char_pp = 0;
static swig_type_info *SWIG_POINTER_void_p = 0;
%}
%init %{
SWIG_POINTER_int_p = SWIG_TypeQuery("int *");
SWIG_POINTER_short_p = SWIG_TypeQuery("short *");
SWIG_POINTER_long_p = SWIG_TypeQuery("long *");
SWIG_POINTER_float_p = SWIG_TypeQuery("float *");
SWIG_POINTER_double_p = SWIG_TypeQuery("double *");
SWIG_POINTER_char_p = SWIG_TypeQuery("char *");
SWIG_POINTER_char_pp = SWIG_TypeQuery("char **");
SWIG_POINTER_void_p = SWIG_TypeQuery("void *");
%}
%{
/* #ifdef WIN32
#undef isspace
#define isspace(c) (c == ' ')
#endif
*/
/*------------------------------------------------------------------
ptrvalue(ptr,type = 0)
Attempts to dereference a pointer value. If type is given, it
will try to use that type. Otherwise, this function will attempt
to "guess" the proper datatype by checking against all of the
builtin C datatypes.
------------------------------------------------------------------ */
#ifdef PERL_OBJECT
static SV *_ptrvalue(CPerlObj *pPerl,SV *_PTRVALUE, int index, char *type) {
#define ptrvalue(a,b,c) _ptrvalue(pPerl,a,b,c)
#else
static SV *_ptrvalue(SV *_PTRVALUE, int index, char *type) {
#define ptrvalue(a,b,c) _ptrvalue(a,b,c)
#endif
void *ptr;
SV *obj = 0;
if (SWIG_ConvertPtr(_PTRVALUE, &ptr, 0) < 0) {
croak("Type error it ptrvalue. Argument is not a valid pointer value.");
} else {
/* If no datatype was passed, try a few common datatypes first */
if (!type) {
/* No datatype was passed. Type to figure out if it's a common one */
if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_int_p) >= 0) {
type = "int";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_double_p) >= 0) {
type = "double";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_short_p) >= 0) {
type = "short";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_long_p) >= 0) {
type = "long";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_float_p) >= 0) {
type = "float";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_p) >= 0) {
type = "char";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_pp) >= 0) {
type = "char *";
} else {
type = "unknown";
}
}
if (!ptr) {
croak("Unable to dereference NULL pointer.");
return 0;
}
/* Now we have a datatype. Try to figure out what to do about it */
if (strcmp(type,"int") == 0) {
obj = sv_newmortal();
sv_setiv(obj,(IV) *(((int *) ptr) + index));
} else if (strcmp(type,"double") == 0) {
obj = sv_newmortal();
sv_setnv(obj,(double) *(((double *) ptr)+index));
} else if (strcmp(type,"short") == 0) {
obj = sv_newmortal();
sv_setiv(obj,(IV) *(((short *) ptr) + index));
} else if (strcmp(type,"long") == 0) {
obj = sv_newmortal();
sv_setiv(obj,(IV) *(((long *) ptr) + index));
} else if (strcmp(type,"float") == 0) {
obj = sv_newmortal();
sv_setnv(obj,(double) *(((float *) ptr)+index));
} else if (strcmp(type,"char") == 0) {
obj = sv_newmortal();
sv_setpv(obj,((char *) ptr)+index);
} else if (strcmp(type,"char *") == 0) {
char *c = *(((char **) ptr)+index);
obj = sv_newmortal();
if (c)
sv_setpv(obj,c);
else
sv_setpv(obj,"NULL");
} else {
croak("Unable to dereference unsupported datatype.");
obj = 0;
}
}
return obj;
}
/*------------------------------------------------------------------
ptrcreate(type,value = 0,numelements = 1)
Attempts to create a new object of given type. Type must be
a basic C datatype. Will not create complex objects.
------------------------------------------------------------------ */
#ifdef PERL_OBJECT
static SV *_ptrcreate(CPerlObj *pPerl, char *type, SV *value, int numelements) {
#define ptrcreate(a,b,c) _ptrcreate(pPerl,a,b,c)
#else
static SV *_ptrcreate(char *type, SV *value, int numelements) {
#define ptrcreate(a,b,c) _ptrcreate(a,b,c)
#endif
void *ptr;
SV *obj;
int sz;
swig_type_info *cast = 0;
/* Check the type string against a variety of possibilities */
if (strcmp(type,"int") == 0) {
sz = sizeof(int)*numelements;
cast = SWIG_POINTER_int_p;
} else if (strcmp(type,"short") == 0) {
sz = sizeof(short)*numelements;
cast = SWIG_POINTER_short_p;
} else if (strcmp(type,"long") == 0) {
sz = sizeof(long)*numelements;
cast = SWIG_POINTER_long_p;
} else if (strcmp(type,"double") == 0) {
sz = sizeof(double)*numelements;
cast = SWIG_POINTER_double_p;
} else if (strcmp(type,"float") == 0) {
sz = sizeof(float)*numelements;
cast = SWIG_POINTER_float_p;
} else if (strcmp(type,"char") == 0) {
sz = sizeof(char)*numelements;
cast = SWIG_POINTER_char_p;
} else if (strcmp(type,"char *") == 0) {
sz = sizeof(char *)*(numelements+1);
cast = SWIG_POINTER_char_pp;
} else if (strcmp(type,"void") == 0) {
sz = numelements;
cast = SWIG_POINTER_void_p;
} else {
croak("Unable to create unknown datatype.");
return 0;
}
/* Create the new object */
ptr = (void *) malloc(sz);
if (!ptr) {
croak("Out of memory in ptrcreate.");
return 0;
}
/* Now try to set its default value */
if (value) {
if (strcmp(type,"int") == 0) {
int *ip,i,ivalue;
ivalue = (int) SvIV(value);
ip = (int *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = ivalue;
} else if (strcmp(type,"short") == 0) {
short *ip,ivalue;
int i;
ivalue = (short) SvIV(value);
ip = (short *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = ivalue;
} else if (strcmp(type,"long") == 0) {
long *ip,ivalue;
int i;
ivalue = (long) SvIV(value);
ip = (long *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = ivalue;
} else if (strcmp(type,"double") == 0) {
double *ip,ivalue;
int i;
ivalue = (double) SvNV(value);
ip = (double *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = ivalue;
} else if (strcmp(type,"float") == 0) {
float *ip,ivalue;
int i;
ivalue = (float) SvNV(value);
ip = (float *) ptr;
for (i = 0; i < numelements; i++)
ip[i] = ivalue;
} else if (strcmp(type,"char") == 0) {
char *ip,*ivalue;
ivalue = (char *) SvPV(value,PL_na);
ip = (char *) ptr;
strncpy(ip,ivalue,numelements-1);
} else if (strcmp(type,"char *") == 0) {
char **ip, *ivalue;
int i;
ivalue = (char *) SvPV(value,PL_na);
ip = (char **) ptr;
for (i = 0; i < numelements; i++) {
if (ivalue) {
ip[i] = (char *) malloc(strlen(ivalue)+1);
strcpy(ip[i],ivalue);
} else {
ip[i] = 0;
}
}
ip[numelements] = 0;
}
}
/* Create the pointer value */
obj = sv_newmortal();
SWIG_MakePtr(obj,ptr,cast);
return obj;
}
/*------------------------------------------------------------------
ptrset(ptr,value,index = 0,type = 0)
Attempts to set the value of a pointer variable. If type is
given, we will use that type. Otherwise, we'll guess the datatype.
------------------------------------------------------------------ */
#ifdef PERL_OBJECT
static void _ptrset(CPerlObj *pPerl,SV *_PTRVALUE, SV *value, int index, char *type) {
#define ptrset(a,b,c,d) _ptrset(pPerl,a,b,c,d)
#else
static void _ptrset(SV *_PTRVALUE, SV *value, int index, char *type) {
#define ptrset(a,b,c,d) _ptrset(a,b,c,d)
#endif
void *ptr;
SV *obj;
if (SWIG_ConvertPtr(_PTRVALUE, &ptr, 0) < 0) {
croak("Type error it ptrvalue. Argument is not a valid pointer value.");
} else {
/* If no datatype was passed, try a few common datatypes first */
if (!type) {
/* No datatype was passed. Type to figure out if it's a common one */
if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_int_p) >= 0) {
type = "int";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_double_p) >= 0) {
type = "double";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_short_p) >= 0) {
type = "short";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_long_p) >= 0) {
type = "long";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_float_p) >= 0) {
type = "float";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_p) >= 0) {
type = "char";
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_pp) >= 0) {
type = "char *";
} else {
type = "unknown";
}
}
}
if (!ptr) {
croak("Unable to set NULL pointer.");
return;
}
/* Now we have a datatype. Try to figure out what to do about it */
if (strcmp(type,"int") == 0) {
*(((int *) ptr)+index) = (int) SvIV(value);
} else if (strcmp(type,"double") == 0) {
*(((double *) ptr)+index) = (double) SvNV(value);
} else if (strcmp(type,"short") == 0) {
*(((short *) ptr)+index) = (short) SvIV(value);
} else if (strcmp(type,"long") == 0) {
*(((long *) ptr)+index) = (long) SvIV(value);
} else if (strcmp(type,"float") == 0) {
*(((float *) ptr)+index) = (float) SvNV(value);
} else if (strcmp(type,"char") == 0) {
char *c = SvPV(value,PL_na);
strcpy(((char *) ptr)+index, c);
} else if (strcmp(type,"char *") == 0) {
char *c = SvPV(value,PL_na);
char **ca = (char **) ptr;
if (ca[index]) free(ca[index]);
if (strcmp(c,"NULL") == 0) {
ca[index] = 0;
} else {
ca[index] = (char *) malloc(strlen(c)+1);
strcpy(ca[index],c);
}
} else {
croak("Unable to set unsupported datatype.");
return;
}
}
/*------------------------------------------------------------------
ptradd(ptr,offset)
Adds a value to an existing pointer value. Will do a type-dependent
add for basic datatypes. For other datatypes, will do a byte-add.
------------------------------------------------------------------ */
#ifdef PERL_OBJECT
static SV *_ptradd(CPerlObj *pPerl, SV *_PTRVALUE, int offset) {
#define ptradd(a,b) _ptradd(pPerl,a,b)
#else
static SV *_ptradd(SV *_PTRVALUE, int offset) {
#define ptradd(a,b) _ptradd(a,b)
#endif
void *ptr,*junk;
SV *obj;
swig_type_info *type;
char *tname;
/* Try to handle a few common datatypes first */
if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_int_p) >= 0) {
ptr = (void *) (((int *) ptr) + offset);
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_double_p) >= 0) {
ptr = (void *) (((double *) ptr) + offset);
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_short_p) >= 0) {
ptr = (void *) (((short *) ptr) + offset);
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_long_p) >= 0) {
ptr = (void *) (((long *) ptr) + offset);
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_float_p) >= 0) {
ptr = (void *) (((float *) ptr) + offset);
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_p) >= 0) {
ptr = (void *) (((char *) ptr) + offset);
} else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,0) >= 0) {
ptr = (void *) (((char *) ptr) + offset);
} else {
croak("Type error in ptradd. Argument is not a valid pointer value.");
return 0;
}
printf("ptradd = %x\n", ptr);
tname = HvNAME(SvSTASH(SvRV(_PTRVALUE)));
obj = sv_newmortal();
sv_setref_pv(obj,tname,ptr);
return obj;
}
/*------------------------------------------------------------------
ptrfree(ptr)
Destroys a pointer value
------------------------------------------------------------------ */
#ifdef PERL_OBJECT
void _ptrfree(CPerlObj *pPerl, SV *_PTRVALUE) {
#define ptrfree(a) _ptrfree(pPerl, a)
#else
void _ptrfree(SV *_PTRVALUE) {
#define ptrfree(a) _ptrfree(a)
#endif
void *ptr, *junk;
if (SWIG_ConvertPtr(_PTRVALUE,&ptr,0) < 0) {
croak("Type error in ptrfree. Argument is not a valid pointer value.");
return;
}
/* Check to see if this pointer is a char ** */
if (SWIG_ConvertPtr(_PTRVALUE,&junk,SWIG_POINTER_char_pp) >= 0) {
char **c = (char **) ptr;
if (c) {
int i = 0;
while (c[i]) {
free(c[i]);
i++;
}
}
}
if (ptr)
free((char *) ptr);
}
%}
%typemap(perl5,in) SV *ptr, SV *value {
$target = $source;
}
%typemap(perl5,out) SV *ptrcast,
SV *ptrvalue,
SV *ptrcreate,
SV *ptradd
{
$target = $source;
argvi++;
}
%typemap(perl5,ret) int ptrset {
if ($source == -1) return NULL;
}
SV *ptrvalue(SV *ptr, int index = 0, char *type = 0);
// Returns the value that a pointer is pointing to (ie. dereferencing).
// The type is automatically inferred by the pointer type--thus, an
// integer pointer will return an integer, a double will return a double,
// and so on. The index and type fields are optional parameters. When
// an index is specified, this function returns the value of ptr[index].
// This allows array access. When a type is specified, it overrides
// the given pointer type. Examples :
//
// ptrvalue($a) # Returns the value *a
// ptrvalue($a,10) # Returns the value a[10]
// ptrvalue($a,10,"double") # Returns a[10] assuming a is a double *
void ptrset(SV *ptr, SV *value, int index = 0, char *type = 0);
// Sets the value pointed to by a pointer. The type is automatically
// inferred from the pointer type so this function will work for
// integers, floats, doubles, etc... The index and type fields are
// optional. When an index is given, it provides array access. When
// type is specified, it overrides the given pointer type. Examples :
//
// ptrset($a,3) # Sets the value *a = 3
// ptrset($a,3,10) # Sets a[10] = 3
// ptrset($a,3,10,"int") # Sets a[10] = 3 assuming a is a int *
SV *ptrcreate(char *type, SV *value = 0, int nitems = 1);
// Creates a new object and returns a pointer to it. This function
// can be used to create various kinds of objects for use in C functions.
// type specifies the basic C datatype to create and value is an
// optional parameter that can be used to set the initial value of the
// object. nitems is an optional parameter that can be used to create
// an array. This function results in a memory allocation using
// malloc(). Examples :
//
// $a = ptrcreate("double") # Create a new double, return pointer
// $a = ptrcreate("int",7) # Create an integer, set value to 7
// $a = ptrcreate("int",0,1000) # Create an integer array with initial
// # values all set to zero
//
// This function only recognizes a few common C datatypes as listed below :
//
// int, short, long, float, double, char, char *, void
//
// All other datatypes will result in an error. However, other
// datatypes can be created by using the ptrcast function. For
// example:
//
// $a = ptrcast(ptrcreate("int",0,100),"unsigned int *")
void ptrfree(SV *ptr);
// Destroys the memory pointed to by ptr. This function calls free()
// and should only be used with objects created by ptrcreate(). Since
// this function calls free, it may work with other objects, but this
// is generally discouraged unless you absolutely know what you're
// doing.
SV *ptradd(SV *ptr, int offset);
// Adds a value to the current pointer value. For the C datatypes of
// int, short, long, float, double, and char, the offset value is the
// number of objects and works in exactly the same manner as in C. For
// example, the following code steps through the elements of an array
//
// $a = ptrcreate("double",0,100); # Create an array double a[100]
// $b = $a;
// for ($i = 0; $i < 100; $i++) {
// ptrset($b,0.0025*$i); # set *b = 0.0025*i
// $b = ptradd($b,1); # b++ (go to next double)
// }
//
// In this case, adding one to b goes to the next double.
//
// For all other datatypes (including all complex datatypes), the
// offset corresponds to bytes. This function does not perform any
// bounds checking and negative offsets are perfectly legal.

69
SWIG/Lib/perl5/std_string.i Normal file
View file

@ -0,0 +1,69 @@
//
// SWIG typemaps for std::string
// Roy M. LeCates
// October 23, 2002
//
// Perl implementation
// ------------------------------------------------------------------------
// std::string is typemapped by value
// This can prevent exporting methods which return a string
// in order for the user to modify it.
// However, I think I'll wait until someone asks for it...
// ------------------------------------------------------------------------
%include exception.i
%{
#include <string>
%}
namespace std {
class string;
/* Overloading check */
%typemap(typecheck) string = char *;
%typemap(typecheck) const string & = char *;
%typemap(in) string {
if (!SvPOK((SV*) $input)) {
SWIG_croak("Type error in argument $argnum of $symname. "
"Expected a string");
} else {
STRLEN len;
const char *ptr = SvPV($input, len);
$1.assign(ptr, len);
}
}
%typemap(in) string *INPUT(std::string temp),
const string & (std::string temp) {
if (!SvPOK((SV*) $input)) {
SWIG_croak("Type error in argument $argnum of $symname. "
"Expected a string");
} else {
STRLEN len;
const char *ptr = SvPV($input, len);
temp.assign(ptr, len);
$1 = &temp;
}
}
%typemap(out) string {
if (argvi >= items) EXTEND(sp, 1); // bump stack ptr, if needed
char *data = const_cast<char*>($1.data());
sv_setpvn($result = sv_newmortal(), data, $1.size());
++argvi;
}
%typemap(out) const string & {
if (argvi >= items) EXTEND(sp, 1); // bump stack ptr, if needed
char *data = const_cast<char*>($1->data());
sv_setpvn($result = sv_newmortal(), data, $1->size());
++argvi;
}
}

297
SWIG/Lib/perl5/std_vector.i Normal file
View file

@ -0,0 +1,297 @@
//
// SWIG typemaps for std::vector types
// Luigi Ballabio
// May 7, 2002
// Chris Seatory
// August 5, 2002
//
// Perl implementation
%include exception.i
// containers
// methods which can raise are caused to throw an IndexError
%exception std::vector::get {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::vector::set {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
%exception std::vector::pop {
try {
$action
} catch (std::out_of_range& e) {
SWIG_exception(SWIG_IndexError,const_cast<char*>(e.what()));
}
}
// ------------------------------------------------------------------------
// std::vector
//
// The aim of all that follows would be to integrate std::vector with
// Perl as much as possible, namely, to allow the user to pass and
// be returned Perl lists.
// const declarations are used to guess the intent of the function being
// exported; therefore, the following rationale is applied:
//
// -- f(std::vector<T>), f(const std::vector<T>&), f(const std::vector<T>*):
// the parameter being read-only, either a Perl sequence or a
// previously wrapped std::vector<T> can be passed.
// -- f(std::vector<T>&), f(std::vector<T>*):
// the parameter must be modified; therefore, only a wrapped std::vector
// can be passed.
// -- std::vector<T> f():
// the vector is returned by copy; therefore, a Perl sequence of T:s
// is returned which is most easily used in other Perl functions
// -- std::vector<T>& f(), std::vector<T>* f(), const std::vector<T>& f(),
// const std::vector<T>* f():
// the vector is returned by reference; therefore, a wrapped std::vector
// is returned
// ------------------------------------------------------------------------
%{
#include <vector>
#include <algorithm>
#include <stdexcept>
%}
// exported class
namespace std {
template<class T> class vector {
%typemap(in) vector<T> (std::vector<T>* v) {
if (SvROK($input)) {
AV *av = (AV *)SvRV($input);
if (SvTYPE(av) != SVt_PVAV)
SWIG_croak("Type error in argument $argnum of $symname. "
"Expected an array of " #T);
SV **tv;
I32 len = av_len(av) + 1;
T* obj;
for (int i=0; i<len; i++) {
tv = av_fetch(av, i, 0);
if (SWIG_ConvertPtr(*tv, (void **)&obj,
$descriptor(T *),0) != -1) {
$1.push_back(*obj);
} else {
SWIG_croak("Type error in argument $argnum of "
"$symname. "
"Expected an array of " #T);
}
}
} else if (SWIG_ConvertPtr($input,(void **) &v,
$&1_descriptor,1) != -1){
$1 = *v;
} else {
SWIG_croak("Type error in argument $argnum of $symname. "
"Expected an array of " #T);
}
}
%typemap(in) const vector<T>& (std::vector<T> temp,
std::vector<T>* v),
const vector<T>* (std::vector<T> temp,
std::vector<T>* v) {
if (SvROK($input)) {
AV *av = (AV *)SvRV($input);
if (SvTYPE(av) != SVt_PVAV)
SWIG_croak("Type error in argument $argnum of $symname. "
"Expected an array of " #T);
SV **tv;
I32 len = av_len(av) + 1;
T* obj;
for (int i=0; i<len; i++) {
tv = av_fetch(av, i, 0);
if (SWIG_ConvertPtr(*tv, (void **)&obj,
$descriptor(T *),0) != -1) {
temp.push_back(*obj);
} else {
SWIG_croak("Type error in argument $argnum of "
"$symname. "
"Expected an array of " #T);
}
}
$1 = &temp;
} else if (SWIG_ConvertPtr($input,(void **) &v,
$1_descriptor,1) != -1){
$1 = v;
} else {
SWIG_croak("Type error in argument $argnum of $symname. "
"Expected an array of " #T);
}
}
%typemap(out) vector<T> {
int len = $1.size();
SV **svs = new SV*[len];
for (unsigned int i=0; i<len; i++) {
svs[i] = sv_newmortal();
SWIG_MakePtr(svs[i], (void*)&($1->at(i)),
$descriptor(T *), 0);
}
AV *myav = av_make(len, svs);
delete[] svs;
$result = newRV_noinc((SV*) myav);
sv_2mortal($result);
argvi++;
}
%typecheck(SWIG_TYPECHECK_VECTOR) vector<T> {
/* native sequence? */
if (SvROK($input)) {
AV *av = (AV *)SvRV($input);
if (SvTYPE(av) == SVt_PVAV) {
SV **tv;
I32 len = av_len(av) + 1;
if (len == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
T* obj;
tv = av_fetch(av, 0, 0);
if (SWIG_ConvertPtr(*tv, (void **)&obj,
$descriptor(T *),0) != -1)
$1 = 1;
else
$1 = 0;
}
}
} else {
/* wrapped vector? */
std::vector<T >* v;
if (SWIG_ConvertPtr($input,(void **) &v,
$1_&descriptor,0) != -1)
$1 = 1;
else
$1 = 0;
}
}
%typecheck(SWIG_TYPECHECK_VECTOR) const vector<T>&,
const vector<T>* {
/* native sequence? */
if (SvROK($input)) {
AV *av = (AV *)SvRV($input);
if (SvTYPE(av) == SVt_PVAV) {
SV **tv;
I32 len = av_len(av) + 1;
if (len == 0) {
/* an empty sequence can be of any type */
$1 = 1;
} else {
/* check the first element only */
T* obj;
tv = av_fetch(av, 0, 0);
if (SWIG_ConvertPtr(*tv, (void **)&obj,
$descriptor(T *),0) != -1)
$1 = 1;
else
$1 = 0;
}
}
} else {
/* wrapped vector? */
std::vector<T >* v;
if (SWIG_ConvertPtr($input,(void **) &v,
$1_descriptor,0) != -1)
$1 = 1;
else
$1 = 0;
}
}
public:
vector(unsigned int size = 0);
unsigned int size() const;
bool empty() const;
void clear();
%rename(push) push_back;
void push_back(const T& x);
%extend {
T pop() {
if (self->size() == 0)
throw std::out_of_range("pop from empty vector");
T x = self->back();
self->pop_back();
return x;
}
T& get(int i) {
int size = int(self->size());
if (i>=0 && i<size)
return (*self)[i];
else
throw std::out_of_range("vector index out of range");
}
void set(int i, const T& x) {
int size = int(self->size());
if (i>=0 && i<size)
(*self)[i] = x;
else
throw std::out_of_range("vector index out of range");
}
}
};
// specializations for built-ins
%define specialize_std_vector(T)
template<> class vector<T> {
// add specialized typemaps here
public:
vector();
vector(unsigned int size, const T& value=T());
vector(const vector<T> &);
unsigned int size() const;
bool empty() const;
void clear();
%rename(push) push_back;
void push_back(T x);
%extend {
T pop() {
if (self->size() == 0)
throw std::out_of_range("pop from empty vector");
T x = self->back();
self->pop_back();
return x;
}
T get(int i) {
int size = int(self->size());
if (i>=0 && i<size)
return (*self)[i];
else
throw std::out_of_range("vector index out of range");
}
void set(int i, T x) {
int size = int(self->size());
if (i>=0 && i<size)
(*self)[i] = x;
else
throw std::out_of_range("vector index out of range");
}
}
};
%enddef
specialize_std_vector(bool);
specialize_std_vector(int);
specialize_std_vector(short);
specialize_std_vector(long);
specialize_std_vector(unsigned int);
specialize_std_vector(unsigned short);
specialize_std_vector(unsigned long);
specialize_std_vector(float);
specialize_std_vector(double);
}

9
SWIG/Lib/perl5/stl.i Normal file
View file

@ -0,0 +1,9 @@
//
// SWIG typemaps for STL types
// Luigi Ballabio and Manu ???
// Apr 26, 2002
//
%include std_string.i
%include std_vector.i

465
SWIG/Lib/perl5/typemaps.i
View file

@ -10,36 +10,20 @@
// ever need to write a typemap.
//
#ifdef AUTODOC
%section "Typemap Library (Perl 5)",info,after,pre,nosort,skip=1,chop_left=3,chop_right=0,chop_top=0,chop_bottom=0
%text %{
%include typemaps.i
/*
The SWIG typemap library provides a language independent mechanism for
supporting output arguments, input values, and other C function
calling mechanisms. The primary use of the library is to provide a
better interface to certain C function--especially those involving
pointers.
%}
#endif
// ------------------------------------------------------------------------
// Pointer handling
//
// These mappings provide support for input/output arguments and common
// uses for C/C++ pointers.
// ------------------------------------------------------------------------
*/
// INPUT typemaps.
// These remap a C pointer to be an "INPUT" value which is passed by value
// instead of reference.
#ifdef AUTODOC
%subsection "Input Methods"
%text %{
/*
The following methods can be applied to turn a pointer into a simple
"input" value. That is, instead of passing a pointer to an object,
you would use a real value instead.
@ -71,68 +55,37 @@ or you can use the %apply directive :
%apply double *INPUT { double *a, double *b };
double fadd(double *a, double *b);
%}
#endif
*/
%typemap(perl5,in) double *INPUT(double temp)
{
temp = (double) SvNV($source);
$target = &temp;
%define INPUT_TYPEMAP(type, converter)
%typemap(in) type *INPUT(type temp), type &INPUT(type temp) {
temp = (type) converter($input);
$1 = &temp;
}
%typemap(typecheck) type *INPUT = type;
%typemap(typecheck) type &INPUT = type;
%enddef
%typemap(perl5,in) float *INPUT(float temp)
{
temp = (float) SvNV($source);
$target = &temp;
}
INPUT_TYPEMAP(float, SvNV);
INPUT_TYPEMAP(double, SvNV);
INPUT_TYPEMAP(int, SvIV);
INPUT_TYPEMAP(long, SvIV);
INPUT_TYPEMAP(short, SvIV);
INPUT_TYPEMAP(signed char, SvIV);
INPUT_TYPEMAP(unsigned int, SvUV);
INPUT_TYPEMAP(unsigned long, SvUV);
INPUT_TYPEMAP(unsigned short, SvUV);
INPUT_TYPEMAP(unsigned char, SvUV);
INPUT_TYPEMAP(bool, SvIV);
%typemap(perl5,in) int *INPUT(int temp)
{
temp = (int) SvIV($source);
$target = &temp;
}
%typemap(perl5,in) short *INPUT(short temp)
{
temp = (short) SvIV($source);
$target = &temp;
}
%typemap(perl5,in) long *INPUT(long temp)
{
temp = (long) SvIV($source);
$target = &temp;
}
%typemap(perl5,in) unsigned int *INPUT(unsigned int temp)
{
temp = (unsigned int) SvIV($source);
$target = &temp;
}
%typemap(perl5,in) unsigned short *INPUT(unsigned short temp)
{
temp = (unsigned short) SvIV($source);
$target = &temp;
}
%typemap(perl5,in) unsigned long *INPUT(unsigned long temp)
{
temp = (unsigned long) SvIV($source);
$target = &temp;
}
%typemap(perl5,in) unsigned char *INPUT(unsigned char temp)
{
temp = (unsigned char) SvIV($source);
$target = &temp;
}
#undef INPUT_TYPEMAP
// OUTPUT typemaps. These typemaps are used for parameters that
// are output only. The output value is appended to the result as
// a list element.
#ifdef AUTODOC
%subsection "Output Methods"
%text %{
/*
The following methods can be applied to turn a pointer into an "output"
value. When calling a function, no input value would be given for
a parameter, but an output value would be returned. In the case of
@ -150,7 +103,7 @@ multiple output values, functions will return a Perl array.
For example, suppose you were trying to wrap the modf() function in the
C math library which splits x into integral and fractional parts (and
returns the integer part in one of its parameters).K:
returns the integer part in one of its parameters).:
double modf(double x, double *ip);
@ -168,75 +121,82 @@ or you can use the %apply directive :
The Perl output of the function would be an array containing both
output values.
%}
#endif
*/
// Force the argument to be ignored.
%typemap(perl5,ignore) int *OUTPUT(int temp),
short *OUTPUT(short temp),
long *OUTPUT(long temp),
unsigned int *OUTPUT(unsigned int temp),
unsigned short *OUTPUT(unsigned short temp),
unsigned long *OUTPUT(unsigned long temp),
unsigned char *OUTPUT(unsigned char temp),
float *OUTPUT(float temp),
double *OUTPUT(double temp)
{
$target = &temp;
}
%typemap(in,numinputs=0) int *OUTPUT(int temp), int &OUTPUT(int temp),
short *OUTPUT(short temp), short &OUTPUT(short temp),
long *OUTPUT(long temp), long &OUTPUT(long temp),
unsigned int *OUTPUT(unsigned int temp), unsigned int &OUTPUT(unsigned int temp),
unsigned short *OUTPUT(unsigned short temp), unsigned short &OUTPUT(unsigned short temp),
unsigned long *OUTPUT(unsigned long temp), unsigned long &OUTPUT(unsigned long temp),
unsigned char *OUTPUT(unsigned char temp), unsigned char &OUTPUT(unsigned char temp),
signed char *OUTPUT(signed char temp), signed char &OUTPUT(signed char temp),
bool *OUTPUT(bool temp), bool &OUTPUT(bool temp),
float *OUTPUT(float temp), float &OUTPUT(float temp),
double *OUTPUT(double temp), double &OUTPUT(double temp)
"$1 = &temp;";
%typemap(perl5,argout) int *OUTPUT,
short *OUTPUT,
long *OUTPUT,
unsigned int *OUTPUT,
unsigned short *OUTPUT,
unsigned long *OUTPUT,
unsigned char *OUTPUT
%typemap(argout) int *OUTPUT, int &OUTPUT,
short *OUTPUT, short &OUTPUT,
long *OUTPUT, long &OUTPUT,
signed char *OUTPUT, signed char &OUTPUT,
bool *OUTPUT, bool &OUTPUT
{
if (argvi >= items) {
EXTEND(sp,1);
}
$target = sv_newmortal();
sv_setiv($target,(IV) *($source));
$result = sv_newmortal();
sv_setiv($result,(IV) *($1));
argvi++;
}
%typemap(perl5,argout) float *OUTPUT,
double *OUTPUT
%typemap(argout) unsigned int *OUTPUT, unsigned int &OUTPUT,
unsigned short *OUTPUT, unsigned short &OUTPUT,
unsigned long *OUTPUT, unsigned long &OUTPUT,
unsigned char *OUTPUT, unsigned char &OUTPUT
{
if (argvi >= items) {
EXTEND(sp,1);
}
$target = sv_newmortal();
sv_setnv($target,(double) *($source));
$result = sv_newmortal();
sv_setuv($result,(UV) *($1));
argvi++;
}
// BOTH
%typemap(argout) float *OUTPUT, float &OUTPUT,
double *OUTPUT, double &OUTPUT
{
if (argvi >= items) {
EXTEND(sp,1);
}
$result = sv_newmortal();
sv_setnv($result,(double) *($1));
argvi++;
}
// INOUT
// Mappings for an argument that is both an input and output
// parameter
#ifdef AUTODOC
%subsection "Input/Output Methods"
%text %{
/*
The following methods can be applied to make a function parameter both
an input and output value. This combines the behavior of both the
"INPUT" and "OUTPUT" methods described earlier. Output values are
returned in the form of a Tcl list.
returned in the form of a Perl array.
int *BOTH
short *BOTH
long *BOTH
unsigned int *BOTH
unsigned short *BOTH
unsigned long *BOTH
unsigned char *BOTH
float *BOTH
double *BOTH
int *INOUT
short *INOUT
long *INOUT
unsigned int *INOUT
unsigned short *INOUT
unsigned long *INOUT
unsigned char *INOUT
float *INOUT
double *INOUT
For example, suppose you were trying to wrap the following function :
@ -247,12 +207,12 @@ For example, suppose you were trying to wrap the following function :
You could wrap it with SWIG as follows :
%include typemaps.i
void neg(double *BOTH);
void neg(double *INOUT);
or you can use the %apply directive :
%include typemaps.i
%apply double *BOTH { double *x };
%apply double *INOUT { double *x };
void neg(double *x);
Unlike C, this mapping does not directly modify the input value.
@ -262,38 +222,61 @@ do this :
$x = neg($x);
%}
*/
#endif
%typemap(in) int *INOUT = int *INPUT;
%typemap(in) short *INOUT = short *INPUT;
%typemap(in) long *INOUT = long *INPUT;
%typemap(in) unsigned *INOUT = unsigned *INPUT;
%typemap(in) unsigned short *INOUT = unsigned short *INPUT;
%typemap(in) unsigned long *INOUT = unsigned long *INPUT;
%typemap(in) unsigned char *INOUT = unsigned char *INPUT;
%typemap(in) signed char *INOUT = signed char *INPUT;
%typemap(in) bool *INOUT = bool *INPUT;
%typemap(in) float *INOUT = float *INPUT;
%typemap(in) double *INOUT = double *INPUT;
%typemap(perl5,in) int *BOTH = int *INPUT;
%typemap(perl5,in) short *BOTH = short *INPUT;
%typemap(perl5,in) long *BOTH = long *INPUT;
%typemap(perl5,in) unsigned *BOTH = unsigned *INPUT;
%typemap(perl5,in) unsigned short *BOTH = unsigned short *INPUT;
%typemap(perl5,in) unsigned long *BOTH = unsigned long *INPUT;
%typemap(perl5,in) unsigned char *BOTH = unsigned char *INPUT;
%typemap(perl5,in) float *BOTH = float *INPUT;
%typemap(perl5,in) double *BOTH = double *INPUT;
%typemap(in) int &INOUT = int &INPUT;
%typemap(in) short &INOUT = short &INPUT;
%typemap(in) long &INOUT = long &INPUT;
%typemap(in) unsigned &INOUT = unsigned &INPUT;
%typemap(in) unsigned short &INOUT = unsigned short &INPUT;
%typemap(in) unsigned long &INOUT = unsigned long &INPUT;
%typemap(in) unsigned char &INOUT = unsigned char &INPUT;
%typemap(in) signed char &INOUT = signed char &INPUT;
%typemap(in) bool &INOUT = bool &INPUT;
%typemap(in) float &INOUT = float &INPUT;
%typemap(in) double &INOUT = double &INPUT;
%typemap(perl5,argout) int *BOTH = int *OUTPUT;
%typemap(perl5,argout) short *BOTH = short *OUTPUT;
%typemap(perl5,argout) long *BOTH = long *OUTPUT;
%typemap(perl5,argout) unsigned *BOTH = unsigned *OUTPUT;
%typemap(perl5,argout) unsigned short *BOTH = unsigned short *OUTPUT;
%typemap(perl5,argout) unsigned long *BOTH = unsigned long *OUTPUT;
%typemap(perl5,argout) unsigned char *BOTH = unsigned char *OUTPUT;
%typemap(perl5,argout) float *BOTH = float *OUTPUT;
%typemap(perl5,argout) double *BOTH = double *OUTPUT;
%typemap(argout) int *INOUT = int *OUTPUT;
%typemap(argout) short *INOUT = short *OUTPUT;
%typemap(argout) long *INOUT = long *OUTPUT;
%typemap(argout) unsigned *INOUT = unsigned *OUTPUT;
%typemap(argout) unsigned short *INOUT = unsigned short *OUTPUT;
%typemap(argout) unsigned long *INOUT = unsigned long *OUTPUT;
%typemap(argout) unsigned char *INOUT = unsigned char *OUTPUT;
%typemap(argout) signed char *INOUT = signed char *OUTPUT;
%typemap(argout) bool *INOUT = bool *OUTPUT;
%typemap(argout) float *INOUT = float *OUTPUT;
%typemap(argout) double *INOUT = double *OUTPUT;
%typemap(argout) int &INOUT = int &OUTPUT;
%typemap(argout) short &INOUT = short &OUTPUT;
%typemap(argout) long &INOUT = long &OUTPUT;
%typemap(argout) unsigned &INOUT = unsigned &OUTPUT;
%typemap(argout) unsigned short &INOUT = unsigned short &OUTPUT;
%typemap(argout) unsigned long &INOUT = unsigned long &OUTPUT;
%typemap(argout) unsigned char &INOUT = unsigned char &OUTPUT;
%typemap(argout) signed char &INOUT = signed char &OUTPUT;
%typemap(argout) bool &INOUT = bool &OUTPUT;
%typemap(argout) float &INOUT = float &OUTPUT;
%typemap(argout) double &INOUT = double &OUTPUT;
// REFERENCE
// Accept Perl references as pointers
#ifdef AUTODOC
%subsection "Reference Methods"
%text %{
/*
The following methods make Perl references work like simple C
pointers. References can only be used for simple input/output
values, not C arrays however. It should also be noted that
@ -327,149 +310,207 @@ or you can use the %apply directive :
%apply double *REFERENCE { double *x };
void neg(double *x);
Unlike the BOTH mapping described previous, this approach directly
Unlike the INOUT mapping described previous, this approach directly
modifies the value of a Perl reference. Thus, you could use it
as follows :
$x = 3;
neg(\$x);
print "$x\n"; # Should print out -3.
%}
#endif
*/
%typemap(perl5,in) double *REFERENCE (double dvalue)
%typemap(in) double *REFERENCE (double dvalue), double &REFERENCE(double dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($source);
tempsv = SvRV($input);
if ((!SvNOK(tempsv)) && (!SvIOK(tempsv))) {
printf("Received %d\n", SvTYPE(tempsv));
croak("Expected a double reference.");
SWIG_croak("Expected a double reference.");
}
dvalue = SvNV(tempsv);
$target = &dvalue;
$1 = &dvalue;
}
%typemap(perl5,in) float *REFERENCE (float dvalue)
%typemap(in) float *REFERENCE (float dvalue), float &REFERENCE(float dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($source);
tempsv = SvRV($input);
if ((!SvNOK(tempsv)) && (!SvIOK(tempsv))) {
croak("expected a double reference");
SWIG_croak("expected a double reference");
}
dvalue = (float) SvNV(tempsv);
$target = &dvalue;
$1 = &dvalue;
}
%typemap(perl5,in) int *REFERENCE (int dvalue)
%typemap(in) int *REFERENCE (int dvalue), int &REFERENCE (int dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($source);
tempsv = SvRV($input);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
SWIG_croak("expected a integer reference");
}
dvalue = SvIV(tempsv);
$target = &dvalue;
$1 = &dvalue;
}
%typemap(perl5,in) short *REFERENCE (short dvalue)
%typemap(in) short *REFERENCE (short dvalue), short &REFERENCE(short dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($source);
tempsv = SvRV($input);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
SWIG_croak("expected a integer reference");
}
dvalue = (short) SvIV(tempsv);
$target = &dvalue;
$1 = &dvalue;
}
%typemap(perl5,in) long *REFERENCE (long dvalue)
%typemap(in) long *REFERENCE (long dvalue), long &REFERENCE(long dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($source);
tempsv = SvRV($input);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
SWIG_croak("expected a integer reference");
}
dvalue = (long) SvIV(tempsv);
$target = &dvalue;
$1 = &dvalue;
}
%typemap(perl5,in) unsigned int *REFERENCE (unsigned int dvalue)
%typemap(in) unsigned int *REFERENCE (unsigned int dvalue), unsigned int &REFERENCE(unsigned int dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($source);
tempsv = SvRV($input);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
SWIG_croak("expected a integer reference");
}
dvalue = (unsigned int) SvIV(tempsv);
$target = &dvalue;
dvalue = (unsigned int) SvUV(tempsv);
$1 = &dvalue;
}
%typemap(perl5,in) unsigned short *REFERENCE (unsigned short dvalue)
%typemap(in) unsigned short *REFERENCE (unsigned short dvalue), unsigned short &REFERENCE(unsigned short dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($source);
tempsv = SvRV($input);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
SWIG_croak("expected a integer reference");
}
dvalue = (unsigned short) SvIV(tempsv);
$target = &dvalue;
dvalue = (unsigned short) SvUV(tempsv);
$1 = &dvalue;
}
%typemap(perl5,in) unsigned long *REFERENCE (unsigned long dvalue)
%typemap(in) unsigned long *REFERENCE (unsigned long dvalue), unsigned long &REFERENCE(unsigned long dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($source);
tempsv = SvRV($input);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
SWIG_croak("expected a integer reference");
}
dvalue = (unsigned long) SvIV(tempsv);
$target = &dvalue;
dvalue = (unsigned long) SvUV(tempsv);
$1 = &dvalue;
}
%typemap(perl5,argout) double *REFERENCE,
float *REFERENCE
%typemap(in) unsigned char *REFERENCE (unsigned char dvalue), unsigned char &REFERENCE(unsigned char dvalue)
{
SV *tempsv;
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($input);
if (!SvIOK(tempsv)) {
SWIG_croak("expected a integer reference");
}
dvalue = (unsigned char) SvUV(tempsv);
$1 = &dvalue;
}
%typemap(in) signed char *REFERENCE (signed char dvalue), signed char &REFERENCE(signed char dvalue)
{
SV *tempsv;
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($input);
if (!SvIOK(tempsv)) {
SWIG_croak("expected a integer reference");
}
dvalue = (signed char) SvIV(tempsv);
$1 = &dvalue;
}
%typemap(in) bool *REFERENCE (bool dvalue), bool &REFERENCE(bool dvalue)
{
SV *tempsv;
if (!SvROK($input)) {
SWIG_croak("expected a reference");
}
tempsv = SvRV($input);
if (!SvIOK(tempsv)) {
SWIG_croak("expected a integer reference");
}
dvalue = (bool) SvIV(tempsv);
$1 = &dvalue;
}
%typemap(argout) double *REFERENCE, double &REFERENCE,
float *REFERENCE, float &REFERENCE
{
SV *tempsv;
tempsv = SvRV($arg);
sv_setnv(tempsv, (double) *$source);
sv_setnv(tempsv, (double) *$1);
}
%typemap(perl5,argout) int *REFERENCE,
short *REFERENCE,
long *REFERENCE,
unsigned int *REFERENCE,
unsigned short *REFERENCE,
unsigned long *REFERENCE
%typemap(argout) int *REFERENCE, int &REFERENCE,
short *REFERENCE, short &REFERENCE,
long *REFERENCE, long &REFERENCE,
signed char *REFERENCE, unsigned char &REFERENCE,
bool *REFERENCE, bool &REFERENCE
{
SV *tempsv;
tempsv = SvRV($arg);
sv_setiv(tempsv, (int) *$source);
tempsv = SvRV($input);
sv_setiv(tempsv, (IV) *$1);
}
// --------------------------------------------------------------------
// Special types
//
// --------------------------------------------------------------------
%typemap(argout) unsigned int *REFERENCE, unsigned int &REFERENCE,
unsigned short *REFERENCE, unsigned short &REFERENCE,
unsigned long *REFERENCE, unsigned long &REFERENCE,
unsigned char *REFERENCE, unsigned char &REFERENCE
{
SV *tempsv;
tempsv = SvRV($input);
sv_setuv(tempsv, (UV) *$1);
}
/* Overloading information */
%typemap(typecheck) double *INOUT = double;
%typemap(typecheck) bool *INOUT = bool;
%typemap(typecheck) signed char *INOUT = signed char;
%typemap(typecheck) unsigned char *INOUT = unsigned char;
%typemap(typecheck) unsigned long *INOUT = unsigned long;
%typemap(typecheck) unsigned short *INOUT = unsigned short;
%typemap(typecheck) unsigned int *INOUT = unsigned int;
%typemap(typecheck) long *INOUT = long;
%typemap(typecheck) short *INOUT = short;
%typemap(typecheck) int *INOUT = int;
%typemap(typecheck) float *INOUT = float;