Initial revision
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@996 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
parent
b8384c52ac
commit
87842339f6
3 changed files with 982 additions and 0 deletions
508
Lib/xml/ptrlang.i
Normal file
508
Lib/xml/ptrlang.i
Normal file
|
|
@ -0,0 +1,508 @@
|
|||
//
|
||||
// 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.
|
||||
473
Lib/xml/typemaps.i
Normal file
473
Lib/xml/typemaps.i
Normal file
|
|
@ -0,0 +1,473 @@
|
|||
//
|
||||
// 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
|
||||
//
|
||||
// --------------------------------------------------------------------
|
||||
1
Lib/xml/xml.swg
Normal file
1
Lib/xml/xml.swg
Normal file
|
|
@ -0,0 +1 @@
|
|||
/* nothing special */
|
||||
Loading…
Add table
Add a link
Reference in a new issue