%include pointer.i The pointer.i library provides run-time support for managing and manipulating a variety of C/C++ pointer values. In particular, you can create various kinds of objects and dereference common pointer types. This is done through a common set of functions: ptrvalue - Dereferences a pointer ptrset - Set the value of an object referenced by a pointer. ptrcreate - Create a new object and return a pointer. ptrfree - Free the memory allocated by ptrcreate. ptradd - Increment/decrement a pointer value. When creating, dereferencing, or setting the value of pointer variable, only the common C datatypes of int, short, long, float, double, char, and char * are currently supported. Other datatypes may generate an error. One of the more interesting aspects of this library is that it operates with a wide range of datatypes. For example, the "ptrvalue" function can dereference "double *", "int *", "long *", "char *", and other datatypes. Since SWIG encodes pointers with type information, this can be done transparently and in most cases, you can dereference a pointer without ever knowing what type it actually is. This library is primarily designed for utility, not high performance (the dynamic determination of pointer types takes more work than most normal wrapper functions). As a result, you may achieve better performance by writing customized "helper" functions if you're making lots of calls to these functions in inner loops or other intensive operations. #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; 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); } { $target = $source; } { $target = $source; } { $target = $source; argvi++; } { $target = $source; argvi++; } { $target = $source; argvi++; } { $target = $source; argvi++; } { if ($source == -1) return NULL; } { temp = (double) SvNV($source); $target = &temp; } { temp = (float) SvNV($source); $target = &temp; } { temp = (int) SvIV($source); $target = &temp; } { temp = (short) SvIV($source); $target = &temp; } { temp = (long) SvIV($source); $target = &temp; } { temp = (unsigned int) SvIV($source); $target = &temp; } { temp = (unsigned short) SvIV($source); $target = &temp; } { temp = (unsigned long) SvIV($source); $target = &temp; } { temp = (unsigned char) SvIV($source); $target = &temp; } { $target = &temp; } { $target = &temp; } { $target = &temp; } { $target = &temp; } { $target = &temp; } { $target = &temp; } { $target = &temp; } { $target = &temp; } { $target = &temp; } { if (argvi >= items) { EXTEND(sp,1); } $target = sv_newmortal(); sv_setiv($target,(IV) *($source)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } $target = sv_newmortal(); sv_setiv($target,(IV) *($source)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } $target = sv_newmortal(); sv_setiv($target,(IV) *($source)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } $target = sv_newmortal(); sv_setiv($target,(IV) *($source)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } $target = sv_newmortal(); sv_setiv($target,(IV) *($source)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } $target = sv_newmortal(); sv_setiv($target,(IV) *($source)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } $target = sv_newmortal(); sv_setiv($target,(IV) *($source)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } $target = sv_newmortal(); sv_setnv($target,(double) *($source)); argvi++; } { if (argvi >= items) { EXTEND(sp,1); } $target = sv_newmortal(); sv_setnv($target,(double) *($source)); argvi++; } { 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; } { 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; } { 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; } { 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; } { 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; } { 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; } { 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; } { 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; } { SV *tempsv; tempsv = SvRV($arg); sv_setnv(tempsv, (double) *$source); } { SV *tempsv; tempsv = SvRV($arg); sv_setnv(tempsv, (double) *$source); } { SV *tempsv; tempsv = SvRV($arg); sv_setiv(tempsv, (int) *$source); } { SV *tempsv; tempsv = SvRV($arg); sv_setiv(tempsv, (int) *$source); } { SV *tempsv; tempsv = SvRV($arg); sv_setiv(tempsv, (int) *$source); } { SV *tempsv; tempsv = SvRV($arg); sv_setiv(tempsv, (int) *$source); } { SV *tempsv; tempsv = SvRV($arg); sv_setiv(tempsv, (int) *$source); } { SV *tempsv; tempsv = SvRV($arg); sv_setiv(tempsv, (int) *$source); }