Amebis/wxWidgets
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Since I have made several changes to SWIG over the years to accomodate

Browse Source 
special cases and other things in wxPython, and since I plan on making
several more, I've decided to put the SWIG sources in wxPython's CVS
instead of relying on maintaining patches.  This effectivly becomes a
fork of an obsolete version of SWIG, :-( but since SWIG 1.3 still
doesn't have some things I rely on in 1.1, not to mention that my
custom patches would all have to be redone, I felt that this is the
easier road to take.


git-svn-id: https://svn.wxwidgets.org/svn/wx/wxWidgets/trunk@15307 c3d73ce0-8a6f-49c7-b76d-6d57e0e08775
This commit is contained in:
Robin Dunn
2002-04-29 19:56:57 +00:00
parent 3bd1e03385
commit c90f71dd8c
135 changed files with 51307 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

140
wxPython/wxSWIG/swig_lib/perl5/Makefile Normal file
View File

@@ -0,0 +1,140 @@
# Generated automatically from Makefile.in by configure.
# ---------------------------------------------------------------
# $Header$
# SWIG Perl5 Makefile
#
# This file can be used to build various Perl5 extensions with SWIG.
# By default this file is set up for dynamic loading, but it can
# be easily customized for static extensions by modifying various
# portions of the file.
#
# SRCS = C source files
# CXXSRCS = C++ source files
# OBJCSRCS = Objective-C source files
# OBJS = Additional .o files (compiled previously)
# INTERFACE = SWIG interface file
# TARGET = Name of target module or executable
#
# Many portions of this file were created by the SWIG configure
# script and should already reflect your machine.
#----------------------------------------------------------------
SRCS =
CXXSRCS =
OBJCSRCS =
OBJS =
INTERFACE =
WRAPFILE = $(INTERFACE:.i=_wrap.c)
WRAPOBJ = $(INTERFACE:.i=_wrap.o)
TARGET = module.so # Use this kind of target for dynamic loading
#TARGET = myperl # Use this target for static linking
prefix = /usr/local
exec_prefix = ${prefix}
CC = cc
CXX = CC
OBJC = cc -Wno-import # -Wno-import needed for gcc
CFLAGS =
INCLUDE =
LIBS =
# SWIG Options
# SWIG = location of the SWIG executable
# SWIGOPT = SWIG compiler options
# SWIGCC = Compiler used to compile the wrapper file
SWIG = $(exec_prefix)/bin/swig
SWIGOPT = -perl5
SWIGCC = $(CC)
# SWIG Library files. Uncomment this to staticly rebuild Perl
#SWIGLIB = -static -lperlmain.i
# Rules for creating .o files from source.
COBJS = $(SRCS:.c=.o)
CXXOBJS = $(CXXSRCS:.cxx=.o)
OBJCOBJS = $(OBJCSRCS:.m=.o)
ALLOBJS = $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(OBJS)
# Command that will be used to build the final extension.
BUILD = $(SWIGCC)
# Uncomment the following if you are using dynamic loading
CCSHARED =
BUILD = ld -G
# Uncomment the following if you are using dynamic loading with C++ and
# need to provide additional link libraries (this is not always required).
#DLL_LIBS = -L/usr/local/lib/gcc-lib/sparc-sun-solaris2.5.1/2.7.2 \
-L/usr/local/lib -lg++ -lstdc++ -lgcc
# X11 installation (possibly needed if using Perl-Tk)
XLIB = -L/usr/openwin/lib -lX11
XINCLUDE = -I/usr/openwin/include
# Perl installation
PERL_INCLUDE = -I/usr/local/lib/perl5/5.00503/sun4-solaris/CORE
PERL_LIB = -L/usr/local/lib/perl5/5.00503/sun4-solaris/CORE -lperl
PERL_FLAGS = -Dbool=char -Dexplicit=
# Tcl installation. If using Tk you might need this
TCL_INCLUDE = -I/usr/local/include
TCL_LIB = -L/usr/local/lib
# Build libraries (needed for static builds)
LIBM = -lm
LIBC =
SYSLIBS = $(LIBM) $(LIBC) -lsocket -lnsl -ldl
# Build options (uncomment only one these)
#TK_LIB = $(TCL_LIB) -ltcl -ltk $(XLIB)
BUILD_LIBS = $(LIBS) # Dynamic loading
#BUILD_LIBS = $(PERL_LIB) $(TK_LIB) $(LIBS) $(SYSLIBS) # Static linking
# Compilation rules for non-SWIG components
.SUFFIXES: .c .cxx .m
.c.o:
$(CC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
.cxx.o:
$(CXX) $(CCSHARED) $(CXXFLAGS) $(INCLUDE) -c $<
.m.o:
$(OBJC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
# ----------------------------------------------------------------------
# Rules for building the extension
# ----------------------------------------------------------------------
all: $(TARGET)
# Convert the wrapper file into an object file
$(WRAPOBJ) : $(WRAPFILE)
$(SWIGCC) -c $(CCSHARED) $(CFLAGS) $(INCLUDE) $(PERL_INCLUDE) $(PERL_FLAGS) $(WRAPFILE)
$(WRAPFILE) : $(INTERFACE)
$(SWIG) $(SWIGOPT) -o $(WRAPFILE) $(SWIGLIB) $(INTERFACE)
$(TARGET): $(WRAPOBJ) $(ALLOBJS)
$(BUILD) $(WRAPOBJ) $(ALLOBJS) $(BUILD_LIBS) -o $(TARGET)
clean:
rm -f $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(WRAPOBJ) $(WRAPFILE) $(TARGET)

139
wxPython/wxSWIG/swig_lib/perl5/Makefile.in Normal file
View File

@@ -0,0 +1,139 @@
# ---------------------------------------------------------------
# $Header$
# SWIG Perl5 Makefile
#
# This file can be used to build various Perl5 extensions with SWIG.
# By default this file is set up for dynamic loading, but it can
# be easily customized for static extensions by modifying various
# portions of the file.
#
# SRCS = C source files
# CXXSRCS = C++ source files
# OBJCSRCS = Objective-C source files
# OBJS = Additional .o files (compiled previously)
# INTERFACE = SWIG interface file
# TARGET = Name of target module or executable
#
# Many portions of this file were created by the SWIG configure
# script and should already reflect your machine.
#----------------------------------------------------------------
SRCS =
CXXSRCS =
OBJCSRCS =
OBJS =
INTERFACE =
WRAPFILE = $(INTERFACE:.i=_wrap.c)
WRAPOBJ = $(INTERFACE:.i=_wrap.o)
TARGET = module@SO@ # Use this kind of target for dynamic loading
#TARGET = myperl # Use this target for static linking
prefix = @prefix@
exec_prefix = @exec_prefix@
CC = @CC@
CXX = @CXX@
OBJC = @CC@ -Wno-import # -Wno-import needed for gcc
CFLAGS =
INCLUDE =
LIBS =
# SWIG Options
# SWIG = location of the SWIG executable
# SWIGOPT = SWIG compiler options
# SWIGCC = Compiler used to compile the wrapper file
SWIG = $(exec_prefix)/bin/swig
SWIGOPT = -perl5
SWIGCC = $(CC)
# SWIG Library files. Uncomment this to staticly rebuild Perl
#SWIGLIB = -static -lperlmain.i
# Rules for creating .o files from source.
COBJS = $(SRCS:.c=.o)
CXXOBJS = $(CXXSRCS:.cxx=.o)
OBJCOBJS = $(OBJCSRCS:.m=.o)
ALLOBJS = $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(OBJS)
# Command that will be used to build the final extension.
BUILD = $(SWIGCC)
# Uncomment the following if you are using dynamic loading
CCSHARED = @CCSHARED@
BUILD = @LDSHARED@
# Uncomment the following if you are using dynamic loading with C++ and
# need to provide additional link libraries (this is not always required).
#DLL_LIBS = -L/usr/local/lib/gcc-lib/sparc-sun-solaris2.5.1/2.7.2 \
-L/usr/local/lib -lg++ -lstdc++ -lgcc
# X11 installation (possibly needed if using Perl-Tk)
XLIB = @XLIBSW@
XINCLUDE = @XINCLUDES@
# Perl installation
PERL_INCLUDE = -I@PERL5EXT@
PERL_LIB = -L@PERL5EXT@ -lperl
PERL_FLAGS = -Dbool=char -Dexplicit=
# Tcl installation. If using Tk you might need this
TCL_INCLUDE = @TCLINCLUDE@
TCL_LIB = @TCLLIB@
# Build libraries (needed for static builds)
LIBM = @LIBM@
LIBC = @LIBC@
SYSLIBS = $(LIBM) $(LIBC) @LIBS@
# Build options (uncomment only one these)
#TK_LIB = $(TCL_LIB) -ltcl -ltk $(XLIB)
BUILD_LIBS = $(LIBS) # Dynamic loading
#BUILD_LIBS = $(PERL_LIB) $(TK_LIB) $(LIBS) $(SYSLIBS) # Static linking
# Compilation rules for non-SWIG components
.SUFFIXES: .c .cxx .m
.c.o:
$(CC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
.cxx.o:
$(CXX) $(CCSHARED) $(CXXFLAGS) $(INCLUDE) -c $<
.m.o:
$(OBJC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $<
# ----------------------------------------------------------------------
# Rules for building the extension
# ----------------------------------------------------------------------
all: $(TARGET)
# Convert the wrapper file into an object file
$(WRAPOBJ) : $(WRAPFILE)
$(SWIGCC) -c $(CCSHARED) $(CFLAGS) $(INCLUDE) $(PERL_INCLUDE) $(PERL_FLAGS) $(WRAPFILE)
$(WRAPFILE) : $(INTERFACE)
$(SWIG) $(SWIGOPT) -o $(WRAPFILE) $(SWIGLIB) $(INTERFACE)
$(TARGET): $(WRAPOBJ) $(ALLOBJS)
$(BUILD) $(WRAPOBJ) $(ALLOBJS) $(BUILD_LIBS) -o $(TARGET)
clean:
rm -f $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(WRAPOBJ) $(WRAPFILE) $(TARGET)

21
wxPython/wxSWIG/swig_lib/perl5/Makefile.pl Normal file
View File

@@ -0,0 +1,21 @@
# File : Makefile.pl
# MakeMaker file for a SWIG module. Use this file if you are
# producing a module for general use or distribution.
#
# 1. Modify the file as appropriate. Replace $module with the
# real name of your module and wrapper file.
# 2. Run perl as 'perl Makefile.pl'
# 3. Type 'make' to build your module
# 4. Type 'make install' to install your module.
#
# See "Programming Perl", 2nd. Ed, for more gory details than
# you ever wanted to know.
use ExtUtils::MakeMaker;
WriteMakefile(
'NAME' => '$module', # Name of your module
'LIBS' => [''], # Custom libraries (if any)
'OBJECT' => '$module_wrap.o' # Object files
);

24
wxPython/wxSWIG/swig_lib/perl5/headers.swg Normal file
View File

@@ -0,0 +1,24 @@
/* $Header$ */
/* Implementation : PERL 5 */
#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
#include <string.h>
#ifdef __cplusplus
}
#endif

361
wxPython/wxSWIG/swig_lib/perl5/perl5.swg Normal file
View File

@@ -0,0 +1,361 @@
/* Definitions for compiling Perl extensions on a variety of machines */
#if defined(WIN32) || defined(_WIN32) || defined(__WIN32__)
# if defined(_MSC_VER)
# define SWIGEXPORT(a) __declspec(dllexport) a
# else
# if defined(__BORLANDC__)
# define SWIGEXPORT(a) a _export
# else
# define SWIGEXPORT(a) a
# endif
# endif
#else
# define SWIGEXPORT(a) a
#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
#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
/******************************************************************************
* Pointer type-checking code
*****************************************************************************/
#include <stdlib.h>
#ifdef __cplusplus
extern "C" {
#endif
#ifdef SWIG_NOINCLUDE
extern void SWIG_MakePtr(char *, void *, char *);
#ifndef PERL_OBJECT
extern void SWIG_RegisterMapping(char *, char *, void *(*)(void *));
#else
#define SWIG_RegisterMapping(a,b,c) _SWIG_RegisterMapping(pPerl,a,b,c);
extern void _SWIG_RegisterMapping(CPerlObj *,char *, char *, void *(*)(void *),int);
#endif
#ifndef PERL_OBJECT
extern char *SWIG_GetPtr(SV *, void **, char *);
#else
extern char *_SWIG_GetPtr(CPerlObj *, SV *, void **, char *);
#define SWIG_GetPtr(a,b,c) _SWIG_GetPtr(pPerl,a,b,c)
#endif
#else
#ifdef SWIG_GLOBAL
#define SWIGSTATICRUNTIME(a) SWIGEXPORT(a)
#else
#define SWIGSTATICRUNTIME(a) static a
#endif
/* These are internal variables. Should be static */
typedef struct SwigPtrType {
char *name;
int len;
void *(*cast)(void *);
struct SwigPtrType *next;
} SwigPtrType;
/* Pointer cache structure */
typedef struct {
int stat; /* Status (valid) bit */
SwigPtrType *tp; /* Pointer to type structure */
char name[256]; /* Given datatype name */
char mapped[256]; /* Equivalent name */
} SwigCacheType;
static int SwigPtrMax = 64; /* Max entries that can be currently held */
static int SwigPtrN = 0; /* Current number of entries */
static int SwigPtrSort = 0; /* Status flag indicating sort */
static SwigPtrType *SwigPtrTable = 0; /* Table containing pointer equivalences */
static int SwigStart[256]; /* Table containing starting positions */
/* Cached values */
#define SWIG_CACHESIZE 8
#define SWIG_CACHEMASK 0x7
static SwigCacheType SwigCache[SWIG_CACHESIZE];
static int SwigCacheIndex = 0;
static int SwigLastCache = 0;
/* Sort comparison function */
static int swigsort(const void *data1, const void *data2) {
SwigPtrType *d1 = (SwigPtrType *) data1;
SwigPtrType *d2 = (SwigPtrType *) data2;
return strcmp(d1->name,d2->name);
}
/* Binary Search function */
static int swigcmp(const void *key, const void *data) {
char *k = (char *) key;
SwigPtrType *d = (SwigPtrType *) data;
return strncmp(k,d->name,d->len);
}
/* Register a new datatype with the type-checker */
#ifndef PERL_OBJECT
SWIGSTATICRUNTIME(void)
SWIG_RegisterMapping(char *origtype, char *newtype, void *(*cast)(void *)) {
#else
#define SWIG_RegisterMapping(a,b,c) _SWIG_RegisterMapping(pPerl, a,b,c)
SWIGSTATICRUNTIME(void)
_SWIG_RegisterMapping(CPerlObj *pPerl, char *origtype, char *newtype, void *(*cast)(void *)) {
#endif
int i;
SwigPtrType *t = 0, *t1;
if (!SwigPtrTable) {
SwigPtrTable = (SwigPtrType *) malloc(SwigPtrMax*sizeof(SwigPtrType));
SwigPtrN = 0;
}
if (SwigPtrN >= SwigPtrMax) {
SwigPtrMax = 2*SwigPtrMax;
SwigPtrTable = (SwigPtrType *) realloc(SwigPtrTable,SwigPtrMax*sizeof(SwigPtrType));
}
for (i = 0; i < SwigPtrN; i++)
if (strcmp(SwigPtrTable[i].name,origtype) == 0) {
t = &SwigPtrTable[i];
break;
}
if (!t) {
t = &SwigPtrTable[SwigPtrN];
t->name = origtype;
t->len = strlen(t->name);
t->cast = 0;
t->next = 0;
SwigPtrN++;
}
while (t->next) {
if (strcmp(t->name,newtype) == 0) {
if (cast) t->cast = cast;
return;
}
t = t->next;
}
t1 = (SwigPtrType *) malloc(sizeof(SwigPtrType));
t1->name = newtype;
t1->len = strlen(t1->name);
t1->cast = cast;
t1->next = 0;
t->next = t1;
SwigPtrSort = 0;
}
/* Make a pointer value string */
SWIGSTATICRUNTIME(void)
SWIG_MakePtr(char *_c, const void *_ptr, char *type) {
static char _hex[16] =
{'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
'a', 'b', 'c', 'd', 'e', 'f'};
unsigned long _p, _s;
char _result[20], *_r; /* Note : a 64-bit hex number = 16 digits */
_r = _result;
_p = (unsigned long) _ptr;
if (_p > 0) {
while (_p > 0) {
_s = _p & 0xf;
*(_r++) = _hex[_s];
_p = _p >> 4;
}
*_r = '_';
while (_r >= _result)
*(_c++) = *(_r--);
} else {
strcpy (_c, "NULL");
}
if (_ptr)
strcpy (_c, type);
}
/* Function for getting a pointer value */
#ifndef PERL_OBJECT
SWIGSTATICRUNTIME(char *)
SWIG_GetPtr(SV *sv, void **ptr, char *_t)
#else
#define SWIG_GetPtr(a,b,c) _SWIG_GetPtr(pPerl,a,b,c)
SWIGSTATICRUNTIME(char *)
_SWIG_GetPtr(CPerlObj *pPerl, SV *sv, void **ptr, char *_t)
#endif
{
char temp_type[256];
char *name,*_c;
int len,i,start,end;
IV tmp;
SwigPtrType *sp,*tp;
SwigCacheType *cache;
/* 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 "Not a valid pointer value";
}
} else {
tmp = SvIV((SV*)SvRV(sv));
}
if (!_t) {
*(ptr) = (void *) tmp;
return (char *) 0;
}
} else if (! SvOK(sv)) { /* Check for undef */
*(ptr) = (void *) 0;
return (char *) 0;
} else if (SvTYPE(sv) == SVt_RV) { /* Check for NULL pointer */
*(ptr) = (void *) 0;
if (!SvROK(sv))
return (char *) 0;
else
return "Not a valid pointer value";
} else { /* Don't know what it is */
*(ptr) = (void *) 0;
return "Not a valid pointer value";
}
if (_t) {
/* Now see if the types match */
if (!sv_isa(sv,_t)) {
_c = HvNAME(SvSTASH(SvRV(sv)));
if (!SwigPtrSort) {
qsort((void *) SwigPtrTable, SwigPtrN, sizeof(SwigPtrType), swigsort);
for (i = 0; i < 256; i++) {
SwigStart[i] = SwigPtrN;
}
for (i = SwigPtrN-1; i >= 0; i--) {
SwigStart[SwigPtrTable[i].name[0]] = i;
}
for (i = 255; i >= 1; i--) {
if (SwigStart[i-1] > SwigStart[i])
SwigStart[i-1] = SwigStart[i];
}
SwigPtrSort = 1;
for (i = 0; i < SWIG_CACHESIZE; i++)
SwigCache[i].stat = 0;
}
/* First check cache for matches. Uses last cache value as starting point */
cache = &SwigCache[SwigLastCache];
for (i = 0; i < SWIG_CACHESIZE; i++) {
if (cache->stat) {
if (strcmp(_t,cache->name) == 0) {
if (strcmp(_c,cache->mapped) == 0) {
cache->stat++;
*ptr = (void *) tmp;
if (cache->tp->cast) *ptr = (*(cache->tp->cast))(*ptr);
return (char *) 0;
}
}
}
SwigLastCache = (SwigLastCache+1) & SWIG_CACHEMASK;
if (!SwigLastCache) cache = SwigCache;
else cache++;
}
start = SwigStart[_t[0]];
end = SwigStart[_t[0]+1];
sp = &SwigPtrTable[start];
while (start < end) {
if (swigcmp(_t,sp) == 0) break;
sp++;
start++;
}
if (start > end) sp = 0;
while (start <= end) {
if (swigcmp(_t,sp) == 0) {
name = sp->name;
len = sp->len;
tp = sp->next;
while(tp) {
if (tp->len >= 255) {
return _c;
}
strcpy(temp_type,tp->name);
strncat(temp_type,_t+len,255-tp->len);
if (sv_isa(sv,temp_type)) {
/* Get pointer value */
*ptr = (void *) tmp;
if (tp->cast) *ptr = (*(tp->cast))(*ptr);
strcpy(SwigCache[SwigCacheIndex].mapped,_c);
strcpy(SwigCache[SwigCacheIndex].name,_t);
SwigCache[SwigCacheIndex].stat = 1;
SwigCache[SwigCacheIndex].tp = tp;
SwigCacheIndex = SwigCacheIndex & SWIG_CACHEMASK;
return (char *) 0;
}
tp = tp->next;
}
}
sp++;
start++;
}
/* Didn't find any sort of match for this data.
Get the pointer value and return the received type */
*ptr = (void *) tmp;
return _c;
} else {
/* Found a match on the first try. Return pointer value */
*ptr = (void *) tmp;
return (char *) 0;
}
}
*ptr = (void *) tmp;
return (char *) 0;
}
#endif
#ifdef __cplusplus
}
#endif

19
wxPython/wxSWIG/swig_lib/perl5/perl5mg.swg Normal file
View File

@@ -0,0 +1,19 @@
/* 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;
}

80
wxPython/wxSWIG/swig_lib/perl5/perlmain.i Normal file
View File

@@ -0,0 +1,80 @@
// $Header$
// Code to statically rebuild perl5.
//
#ifdef AUTODOC
%subsection "perlmain.i"
%text %{
This module provides support for building a new version of the
Perl executable. This will be necessary on systems that do
not support shared libraries and may be necessary with C++
extensions.
This module may only build a stripped down version of the
Perl executable. Thus, it may be necessary (or desirable)
to hand-edit this file for your particular application. To
do this, simply copy this file from swig_lib/perl5/perlmain.i
to your working directory and make the appropriate modifications.
This library file works with Perl 5.003. It may work with earlier
versions, but it hasn't been tested. As far as I know, this
library is C++ safe.
%}
#endif
%{
static void xs_init _((void));
static PerlInterpreter *my_perl;
int perl_eval(char *string) {
char *argv[2];
argv[0] = string;
argv[1] = (char *) 0;
return perl_call_argv("eval",0,argv);
}
int
main(int argc, char **argv, char **env)
{
int exitstatus;
my_perl = perl_alloc();
if (!my_perl)
exit(1);
perl_construct( my_perl );
exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL );
if (exitstatus)
exit( exitstatus );
/* Initialize all of the module variables */
exitstatus = perl_run( my_perl );
perl_destruct( my_perl );
perl_free( my_perl );
exit( exitstatus );
}
/* Register any extra external extensions */
/* Do not delete this line--writemain depends on it */
/* EXTERN_C void boot_DynaLoader _((CV* cv)); */
static void
xs_init()
{
/* dXSUB_SYS; */
char *file = __FILE__;
{
/* newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); */
newXS(SWIG_name, SWIG_init, file);
#ifdef SWIGMODINIT
SWIGMODINIT
#endif
}
}
%}

650
wxPython/wxSWIG/swig_lib/perl5/ptrlang.i Normal file
View File

@@ -0,0 +1,650 @@
//
// SWIG pointer conversion and utility library
//
// Dave Beazley
// April 19, 1997
//
// Perl5 specific implementation. This file is included
// by the file ../pointer.i
%{
#ifdef WIN32
#undef isspace
#define isspace(c) (c == ' ')
#endif
/*------------------------------------------------------------------
ptrcast(value,type)
Constructs a new pointer value. Value may either be a string
or an integer. Type is a string corresponding to either the
C datatype or mangled datatype.
ptrcast(0,"Vector *")
or
ptrcast(0,"Vector_p")
------------------------------------------------------------------ */
#ifdef PERL_OBJECT
static SV *_ptrcast(CPerlObj *pPerl, SV *_PTRVALUE, char *type) {
#define ptrcast(a,b) _ptrcast(pPerl,a,b)
#else
static SV *_ptrcast(SV *_PTRVALUE, char *type) {
#define ptrcast(a,b) _ptrcast(a,b)
#endif
char *r,*s;
void *ptr;
SV *obj;
char *typestr,*c;
/* Produce a "mangled" version of the type string. */
typestr = (char *) malloc(strlen(type)+20);
/* Go through and munge the typestring */
r = typestr;
c = type;
while (*c) {
if (!isspace(*c)) {
if ((*c == '*') || (*c == '&')) {
strcpy(r,"Ptr");
r+=3;
} else *(r++) = *c;
}
c++;
}
*(r++) = 0;
/* Check to see if the input value is an integer */
if (SvIOK(_PTRVALUE)) {
ptr = (void *) SvIV(_PTRVALUE);
/* Received a numerical value. Make a pointer out of it */
obj = sv_newmortal();
sv_setref_pv(obj,typestr,ptr);
} else if (sv_isobject(_PTRVALUE)) {
/* Have a real pointer value now. Try to strip out the pointer value */
/* Now extract the pointer value */
if (!SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
obj = sv_newmortal();
sv_setref_pv(obj,typestr,ptr);
}
} else {
croak("ptrcast(). Not a reference.");
}
free(typestr);
return obj;
}
/*------------------------------------------------------------------
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_GetPtr(_PTRVALUE,&ptr,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_GetPtr(_PTRVALUE,&ptr,"intPtr")) {
type = "int";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) {
type = "double";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) {
type = "short";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) {
type = "long";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) {
type = "float";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) {
type = "char";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtrPtr")) {
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;
char *cast;
char temp[40];
/* Check the type string against a variety of possibilities */
if (strcmp(type,"int") == 0) {
sz = sizeof(int)*numelements;
cast = "intPtr";
} else if (strcmp(type,"short") == 0) {
sz = sizeof(short)*numelements;
cast = "shortPtr";
} else if (strcmp(type,"long") == 0) {
sz = sizeof(long)*numelements;
cast = "longPtr";
} else if (strcmp(type,"double") == 0) {
sz = sizeof(double)*numelements;
cast = "doublePtr";
} else if (strcmp(type,"float") == 0) {
sz = sizeof(float)*numelements;
cast = "floatPtr";
} else if (strcmp(type,"char") == 0) {
sz = sizeof(char)*numelements;
cast = "charPtr";
} else if (strcmp(type,"char *") == 0) {
sz = sizeof(char *)*(numelements+1);
cast = "charPtrPtr";
} else if (strcmp(type,"void") == 0) {
sz = numelements;
cast = "voidPtr";
} 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 */
SWIG_MakePtr(temp,ptr,cast);
obj = sv_newmortal();
sv_setref_pv(obj,cast,ptr);
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_GetPtr(_PTRVALUE,&ptr,0)) {
croak("Type error in ptrset. Argument is not a valid pointer value.");
return;
}
/* 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_GetPtr(_PTRVALUE,&ptr,"intPtr")) {
type = "int";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) {
type = "double";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) {
type = "short";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) {
type = "long";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) {
type = "float";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) {
type = "char";
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtrPtr")) {
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;
char *type;
/* Try to handle a few common datatypes first */
if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) {
ptr = (void *) (((int *) ptr) + offset);
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) {
ptr = (void *) (((double *) ptr) + offset);
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) {
ptr = (void *) (((short *) ptr) + offset);
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) {
ptr = (void *) (((long *) ptr) + offset);
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) {
ptr = (void *) (((float *) ptr) + offset);
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) {
ptr = (void *) (((char *) ptr) + offset);
} else if (!SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
ptr = (void *) (((char *) ptr) + offset);
} else {
croak("Type error in ptradd. Argument is not a valid pointer value.");
return 0;
}
type = SWIG_GetPtr(_PTRVALUE,&junk,"INVALID POINTER");
obj = sv_newmortal();
sv_setref_pv(obj,type,ptr);
return obj;
}
/*------------------------------------------------------------------
ptrmap(type1,type2)
Allows a mapping between type1 and type2. (Like a typedef)
------------------------------------------------------------------ */
#ifdef PERL_OBJECT
static void _ptrmap(CPerlObj *pPerl,char *type1, char *type2) {
#define ptrmap(a,b) _ptrmap(pPerl,a,b)
#else
static void _ptrmap(char *type1, char *type2) {
#define ptrmap(a,b) _ptrmap(a,b)
#endif
char *typestr1,*typestr2,*c,*r;
/* Produce a "mangled" version of the type string. */
typestr1 = (char *) malloc(strlen(type1)+20);
/* Go through and munge the typestring */
r = typestr1;
*(r++) = '_';
c = type1;
while (*c) {
if (!isspace(*c)) {
if ((*c == '*') || (*c == '&')) {
strcpy(r,"Ptr");
r+=3;
}
else *(r++) = *c;
}
c++;
}
*(r++) = 0;
typestr2 = (char *) malloc(strlen(type2)+20);
/* Go through and munge the typestring */
r = typestr2;
*(r++) = '_';
c = type2;
while (*c) {
if (!isspace(*c)) {
if ((*c == '*') || (*c == '&')) {
strcpy(r,"Ptr");
r+=3;
}
else *(r++) = *c;
}
c++;
}
*(r++) = 0;
SWIG_RegisterMapping(typestr1,typestr2,0);
SWIG_RegisterMapping(typestr2,typestr1,0);
}
/*------------------------------------------------------------------
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_GetPtr(_PTRVALUE,&ptr,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_GetPtr(_PTRVALUE,&junk,"charPtrPtr")) {
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 *ptrcast(SV *ptr, char *type);
// Casts a pointer ptr to a new datatype given by the string type.
// type may be either the SWIG generated representation of a datatype
// or the C representation. For example :
//
// ptrcast($ptr,"doublePtr"); # Perl5 representation
// ptrcast($ptr,"double *"); # C representation
//
// A new pointer value is returned. ptr may also be an integer
// value in which case the value will be used to set the pointer
// value. For example :
//
// $a = ptrcast(0,"VectorPtr");
//
// Will create a NULL pointer of type "VectorPtr"
//
// The casting operation is sensitive to formatting. As a result,
// "double *" is different than "double*". As a result of thumb,
// there should always be exactly one space between the C datatype
// and any pointer specifiers (*).
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.
void ptrmap(char *type1, char *type2);
// This is a rarely used function that performs essentially the same
// operation as a C typedef. To manage datatypes at run-time, SWIG
// modules manage an internal symbol table of type mappings. This
// table keeps track of which types are equivalent to each other. The
// ptrmap() function provides a mechanism for scripts to add symbols
// to this table. For example :
//
// ptrmap("doublePtr","RealPtr");
//
// would make the types "doublePtr" and "RealPtr" equivalent to each
// other. Pointers of either type could now be used interchangably.
//
// Normally this function is not needed, but it can be used to
// circumvent SWIG's normal type-checking behavior or to work around
// weird type-handling problems.

475
wxPython/wxSWIG/swig_lib/perl5/typemaps.i Normal file
View File

@@ -0,0 +1,475 @@
//
// SWIG Typemap library
// Dave Beazley
// May 5, 1997
//
// Perl5 implementation
//
// This library provides standard typemaps for modifying SWIG's behavior.
// With enough entries in this file, I hope that very few people actually
// 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.
int *INPUT
short *INPUT
long *INPUT
unsigned int *INPUT
unsigned short *INPUT
unsigned long *INPUT
unsigned char *INPUT
float *INPUT
double *INPUT
To use these, suppose you had a C function like this :
double fadd(double *a, double *b) {
return *a+*b;
}
You could wrap it with SWIG as follows :
%include typemaps.i
double fadd(double *INPUT, double *INPUT);
or you can use the %apply directive :
%include typemaps.i
%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;
}
%typemap(perl5,in) float *INPUT(float temp)
{
temp = (float) SvNV($source);
$target = &temp;
}
%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;
}
// 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
multiple output values, functions will return a Perl array.
int *OUTPUT
short *OUTPUT
long *OUTPUT
unsigned int *OUTPUT
unsigned short *OUTPUT
unsigned long *OUTPUT
unsigned char *OUTPUT
float *OUTPUT
double *OUTPUT
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:
double modf(double x, double *ip);
You could wrap it with SWIG as follows :
%include typemaps.i
double modf(double x, double *OUTPUT);
or you can use the %apply directive :
%include typemaps.i
%apply double *OUTPUT { double *ip };
double modf(double x, double *ip);
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(perl5,argout) int *OUTPUT,
short *OUTPUT,
long *OUTPUT,
unsigned int *OUTPUT,
unsigned short *OUTPUT,
unsigned long *OUTPUT,
unsigned char *OUTPUT
{
if (argvi >= items) {
EXTEND(sp,1);
}
$target = sv_newmortal();
sv_setiv($target,(IV) *($source));
argvi++;
}
%typemap(perl5,argout) float *OUTPUT,
double *OUTPUT
{
if (argvi >= items) {
EXTEND(sp,1);
}
$target = sv_newmortal();
sv_setnv($target,(double) *($source));
argvi++;
}
// BOTH
// 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.
int *BOTH
short *BOTH
long *BOTH
unsigned int *BOTH
unsigned short *BOTH
unsigned long *BOTH
unsigned char *BOTH
float *BOTH
double *BOTH
For example, suppose you were trying to wrap the following function :
void neg(double *x) {
*x = -(*x);
}
You could wrap it with SWIG as follows :
%include typemaps.i
void neg(double *BOTH);
or you can use the %apply directive :
%include typemaps.i
%apply double *BOTH { double *x };
void neg(double *x);
Unlike C, this mapping does not directly modify the input value.
Rather, the modified input value shows up as the return value of the
function. Thus, to apply this function to a Perl variable you might
do this :
$x = neg($x);
%}
#endif
%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(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;
// 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
REFERENCES are specific to Perl and not supported in other
scripting languages at this time.
int *REFERENCE
short *REFERENCE
long *REFERENCE
unsigned int *REFERENCE
unsigned short *REFERENCE
unsigned long *REFERENCE
unsigned char *REFERENCE
float *REFERENCE
double *REFERENCE
For example, suppose you were trying to wrap the following function :
void neg(double *x) {
*x = -(*x);
}
You could wrap it with SWIG as follows :
%include typemaps.i
void neg(double *REFERENCE);
or you can use the %apply directive :
%include typemaps.i
%apply double *REFERENCE { double *x };
void neg(double *x);
Unlike the BOTH 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)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
}
tempsv = SvRV($source);
if ((!SvNOK(tempsv)) && (!SvIOK(tempsv))) {
printf("Received %d\n", SvTYPE(tempsv));
croak("Expected a double reference.");
}
dvalue = SvNV(tempsv);
$target = &dvalue;
}
%typemap(perl5,in) float *REFERENCE (float dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
}
tempsv = SvRV($source);
if ((!SvNOK(tempsv)) && (!SvIOK(tempsv))) {
croak("expected a double reference");
}
dvalue = (float) SvNV(tempsv);
$target = &dvalue;
}
%typemap(perl5,in) int *REFERENCE (int dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
}
tempsv = SvRV($source);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
}
dvalue = SvIV(tempsv);
$target = &dvalue;
}
%typemap(perl5,in) short *REFERENCE (short dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
}
tempsv = SvRV($source);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
}
dvalue = (short) SvIV(tempsv);
$target = &dvalue;
}
%typemap(perl5,in) long *REFERENCE (long dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
}
tempsv = SvRV($source);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
}
dvalue = (long) SvIV(tempsv);
$target = &dvalue;
}
%typemap(perl5,in) unsigned int *REFERENCE (unsigned int dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
}
tempsv = SvRV($source);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
}
dvalue = (unsigned int) SvIV(tempsv);
$target = &dvalue;
}
%typemap(perl5,in) unsigned short *REFERENCE (unsigned short dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
}
tempsv = SvRV($source);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
}
dvalue = (unsigned short) SvIV(tempsv);
$target = &dvalue;
}
%typemap(perl5,in) unsigned long *REFERENCE (unsigned long dvalue)
{
SV *tempsv;
if (!SvROK($source)) {
croak("expected a reference");
}
tempsv = SvRV($source);
if (!SvIOK(tempsv)) {
croak("expected a integer reference");
}
dvalue = (unsigned long) SvIV(tempsv);
$target = &dvalue;
}
%typemap(perl5,argout) double *REFERENCE,
float *REFERENCE
{
SV *tempsv;
tempsv = SvRV($arg);
sv_setnv(tempsv, (double) *$source);
}
%typemap(perl5,argout) int *REFERENCE,
short *REFERENCE,
long *REFERENCE,
unsigned int *REFERENCE,
unsigned short *REFERENCE,
unsigned long *REFERENCE
{
SV *tempsv;
tempsv = SvRV($arg);
sv_setiv(tempsv, (int) *$source);
}
// --------------------------------------------------------------------
// Special types
//
// --------------------------------------------------------------------