2 // SWIG pointer conversion and utility library
7 // Perl5 specific implementation. This file is included
8 // by the file ../pointer.i
14 #define isspace(c) (c == ' ')
17 /*------------------------------------------------------------------
20 Constructs a new pointer value. Value may either be a string
21 or an integer. Type is a string corresponding to either the
22 C datatype or mangled datatype.
27 ------------------------------------------------------------------ */
29 static SV *_ptrcast(CPerlObj *pPerl, SV *_PTRVALUE, char *type) {
30 #define ptrcast(a,b) _ptrcast(pPerl,a,b)
32 static SV *_ptrcast(SV *_PTRVALUE, char *type) {
33 #define ptrcast(a,b) _ptrcast(a,b)
40 /* Produce a "mangled" version of the type string. */
42 typestr = (char *) malloc(strlen(type)+20);
44 /* Go through and munge the typestring */
50 if ((*c == '*') || (*c == '&')) {
59 /* Check to see if the input value is an integer */
60 if (SvIOK(_PTRVALUE)) {
61 ptr = (void *) SvIV(_PTRVALUE);
62 /* Received a numerical value. Make a pointer out of it */
64 sv_setref_pv(obj,typestr,ptr);
65 } else if (sv_isobject(_PTRVALUE)) {
66 /* Have a real pointer value now. Try to strip out the pointer value */
67 /* Now extract the pointer value */
68 if (!SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
70 sv_setref_pv(obj,typestr,ptr);
73 croak("ptrcast(). Not a reference.");
81 /*------------------------------------------------------------------
82 ptrvalue(ptr,type = 0)
84 Attempts to dereference a pointer value. If type is given, it
85 will try to use that type. Otherwise, this function will attempt
86 to "guess" the proper datatype by checking against all of the
88 ------------------------------------------------------------------ */
91 static SV *_ptrvalue(CPerlObj *pPerl,SV *_PTRVALUE, int index, char *type) {
92 #define ptrvalue(a,b,c) _ptrvalue(pPerl,a,b,c)
94 static SV *_ptrvalue(SV *_PTRVALUE, int index, char *type) {
95 #define ptrvalue(a,b,c) _ptrvalue(a,b,c)
102 if (SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
103 croak("Type error it ptrvalue. Argument is not a valid pointer value.");
105 /* If no datatype was passed, try a few common datatypes first */
108 /* No datatype was passed. Type to figure out if it's a common one */
110 if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) {
112 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) {
114 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) {
116 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) {
118 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) {
120 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) {
122 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtrPtr")) {
130 croak("Unable to dereference NULL pointer.");
134 /* Now we have a datatype. Try to figure out what to do about it */
135 if (strcmp(type,"int") == 0) {
136 obj = sv_newmortal();
137 sv_setiv(obj,(IV) *(((int *) ptr) + index));
138 } else if (strcmp(type,"double") == 0) {
139 obj = sv_newmortal();
140 sv_setnv(obj,(double) *(((double *) ptr)+index));
141 } else if (strcmp(type,"short") == 0) {
142 obj = sv_newmortal();
143 sv_setiv(obj,(IV) *(((short *) ptr) + index));
144 } else if (strcmp(type,"long") == 0) {
145 obj = sv_newmortal();
146 sv_setiv(obj,(IV) *(((long *) ptr) + index));
147 } else if (strcmp(type,"float") == 0) {
148 obj = sv_newmortal();
149 sv_setnv(obj,(double) *(((float *) ptr)+index));
150 } else if (strcmp(type,"char") == 0) {
151 obj = sv_newmortal();
152 sv_setpv(obj,((char *) ptr)+index);
153 } else if (strcmp(type,"char *") == 0) {
154 char *c = *(((char **) ptr)+index);
155 obj = sv_newmortal();
159 sv_setpv(obj,"NULL");
161 croak("Unable to dereference unsupported datatype.");
168 /*------------------------------------------------------------------
169 ptrcreate(type,value = 0,numelements = 1)
171 Attempts to create a new object of given type. Type must be
172 a basic C datatype. Will not create complex objects.
173 ------------------------------------------------------------------ */
175 static SV *_ptrcreate(CPerlObj *pPerl, char *type, SV *value, int numelements) {
176 #define ptrcreate(a,b,c) _ptrcreate(pPerl,a,b,c)
178 static SV *_ptrcreate(char *type, SV *value, int numelements) {
179 #define ptrcreate(a,b,c) _ptrcreate(a,b,c)
188 /* Check the type string against a variety of possibilities */
190 if (strcmp(type,"int") == 0) {
191 sz = sizeof(int)*numelements;
193 } else if (strcmp(type,"short") == 0) {
194 sz = sizeof(short)*numelements;
196 } else if (strcmp(type,"long") == 0) {
197 sz = sizeof(long)*numelements;
199 } else if (strcmp(type,"double") == 0) {
200 sz = sizeof(double)*numelements;
202 } else if (strcmp(type,"float") == 0) {
203 sz = sizeof(float)*numelements;
205 } else if (strcmp(type,"char") == 0) {
206 sz = sizeof(char)*numelements;
208 } else if (strcmp(type,"char *") == 0) {
209 sz = sizeof(char *)*(numelements+1);
211 } else if (strcmp(type,"void") == 0) {
215 croak("Unable to create unknown datatype.");
219 /* Create the new object */
221 ptr = (void *) malloc(sz);
223 croak("Out of memory in ptrcreate.");
227 /* Now try to set its default value */
230 if (strcmp(type,"int") == 0) {
232 ivalue = (int) SvIV(value);
234 for (i = 0; i < numelements; i++)
236 } else if (strcmp(type,"short") == 0) {
239 ivalue = (short) SvIV(value);
241 for (i = 0; i < numelements; i++)
243 } else if (strcmp(type,"long") == 0) {
246 ivalue = (long) SvIV(value);
248 for (i = 0; i < numelements; i++)
250 } else if (strcmp(type,"double") == 0) {
253 ivalue = (double) SvNV(value);
255 for (i = 0; i < numelements; i++)
257 } else if (strcmp(type,"float") == 0) {
260 ivalue = (float) SvNV(value);
262 for (i = 0; i < numelements; i++)
264 } else if (strcmp(type,"char") == 0) {
266 ivalue = (char *) SvPV(value,PL_na);
268 strncpy(ip,ivalue,numelements-1);
269 } else if (strcmp(type,"char *") == 0) {
272 ivalue = (char *) SvPV(value,PL_na);
274 for (i = 0; i < numelements; i++) {
276 ip[i] = (char *) malloc(strlen(ivalue)+1);
277 strcpy(ip[i],ivalue);
285 /* Create the pointer value */
287 SWIG_MakePtr(temp,ptr,cast);
288 obj = sv_newmortal();
289 sv_setref_pv(obj,cast,ptr);
293 /*------------------------------------------------------------------
294 ptrset(ptr,value,index = 0,type = 0)
296 Attempts to set the value of a pointer variable. If type is
297 given, we will use that type. Otherwise, we'll guess the datatype.
298 ------------------------------------------------------------------ */
301 static void _ptrset(CPerlObj *pPerl,SV *_PTRVALUE, SV *value, int index, char *type) {
302 #define ptrset(a,b,c,d) _ptrset(pPerl,a,b,c,d)
304 static void _ptrset(SV *_PTRVALUE, SV *value, int index, char *type) {
305 #define ptrset(a,b,c,d) _ptrset(a,b,c,d)
310 if (SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
311 croak("Type error in ptrset. Argument is not a valid pointer value.");
315 /* If no datatype was passed, try a few common datatypes first */
319 /* No datatype was passed. Type to figure out if it's a common one */
321 if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) {
323 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) {
325 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) {
327 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) {
329 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) {
331 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) {
333 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtrPtr")) {
341 croak("Unable to set NULL pointer.");
345 /* Now we have a datatype. Try to figure out what to do about it */
346 if (strcmp(type,"int") == 0) {
347 *(((int *) ptr)+index) = (int) SvIV(value);
348 } else if (strcmp(type,"double") == 0) {
349 *(((double *) ptr)+index) = (double) SvNV(value);
350 } else if (strcmp(type,"short") == 0) {
351 *(((short *) ptr)+index) = (short) SvIV(value);
352 } else if (strcmp(type,"long") == 0) {
353 *(((long *) ptr)+index) = (long) SvIV(value);
354 } else if (strcmp(type,"float") == 0) {
355 *(((float *) ptr)+index) = (float) SvNV(value);
356 } else if (strcmp(type,"char") == 0) {
357 char *c = SvPV(value,PL_na);
358 strcpy(((char *) ptr)+index, c);
359 } else if (strcmp(type,"char *") == 0) {
360 char *c = SvPV(value,PL_na);
361 char **ca = (char **) ptr;
362 if (ca[index]) free(ca[index]);
363 if (strcmp(c,"NULL") == 0) {
366 ca[index] = (char *) malloc(strlen(c)+1);
370 croak("Unable to set unsupported datatype.");
375 /*------------------------------------------------------------------
378 Adds a value to an existing pointer value. Will do a type-dependent
379 add for basic datatypes. For other datatypes, will do a byte-add.
380 ------------------------------------------------------------------ */
383 static SV *_ptradd(CPerlObj *pPerl, SV *_PTRVALUE, int offset) {
384 #define ptradd(a,b) _ptradd(pPerl,a,b)
386 static SV *_ptradd(SV *_PTRVALUE, int offset) {
387 #define ptradd(a,b) _ptradd(a,b)
394 /* Try to handle a few common datatypes first */
396 if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) {
397 ptr = (void *) (((int *) ptr) + offset);
398 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) {
399 ptr = (void *) (((double *) ptr) + offset);
400 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) {
401 ptr = (void *) (((short *) ptr) + offset);
402 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) {
403 ptr = (void *) (((long *) ptr) + offset);
404 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) {
405 ptr = (void *) (((float *) ptr) + offset);
406 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) {
407 ptr = (void *) (((char *) ptr) + offset);
408 } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
409 ptr = (void *) (((char *) ptr) + offset);
411 croak("Type error in ptradd. Argument is not a valid pointer value.");
414 type = SWIG_GetPtr(_PTRVALUE,&junk,"INVALID POINTER");
415 obj = sv_newmortal();
416 sv_setref_pv(obj,type,ptr);
420 /*------------------------------------------------------------------
423 Allows a mapping between type1 and type2. (Like a typedef)
424 ------------------------------------------------------------------ */
427 static void _ptrmap(CPerlObj *pPerl,char *type1, char *type2) {
428 #define ptrmap(a,b) _ptrmap(pPerl,a,b)
430 static void _ptrmap(char *type1, char *type2) {
431 #define ptrmap(a,b) _ptrmap(a,b)
433 char *typestr1,*typestr2,*c,*r;
434 /* Produce a "mangled" version of the type string. */
436 typestr1 = (char *) malloc(strlen(type1)+20);
439 /* Go through and munge the typestring */
447 if ((*c == '*') || (*c == '&')) {
457 typestr2 = (char *) malloc(strlen(type2)+20);
459 /* Go through and munge the typestring */
466 if ((*c == '*') || (*c == '&')) {
475 SWIG_RegisterMapping(typestr1,typestr2,0);
476 SWIG_RegisterMapping(typestr2,typestr1,0);
479 /*------------------------------------------------------------------
482 Destroys a pointer value
483 ------------------------------------------------------------------ */
485 void _ptrfree(CPerlObj *pPerl, SV *_PTRVALUE) {
486 #define ptrfree(a) _ptrfree(pPerl, a)
488 void _ptrfree(SV *_PTRVALUE) {
489 #define ptrfree(a) _ptrfree(a)
494 if (SWIG_GetPtr(_PTRVALUE,&ptr,0)) {
495 croak("Type error in ptrfree. Argument is not a valid pointer value.");
499 /* Check to see if this pointer is a char ** */
500 if (!SWIG_GetPtr(_PTRVALUE,&junk,"charPtrPtr")) {
501 char **c = (char **) ptr;
516 %typemap(perl5,in) SV *ptr, SV *value {
521 %typemap(perl5,out) SV *ptrcast,
530 %typemap(perl5,ret) int ptrset {
531 if ($source == -1) return NULL;
534 SV *ptrcast(SV *ptr, char *type);
535 // Casts a pointer ptr to a new datatype given by the string type.
536 // type may be either the SWIG generated representation of a datatype
537 // or the C representation. For example :
539 // ptrcast($ptr,"doublePtr"); # Perl5 representation
540 // ptrcast($ptr,"double *"); # C representation
542 // A new pointer value is returned. ptr may also be an integer
543 // value in which case the value will be used to set the pointer
544 // value. For example :
546 // $a = ptrcast(0,"VectorPtr");
548 // Will create a NULL pointer of type "VectorPtr"
550 // The casting operation is sensitive to formatting. As a result,
551 // "double *" is different than "double*". As a result of thumb,
552 // there should always be exactly one space between the C datatype
553 // and any pointer specifiers (*).
555 SV *ptrvalue(SV *ptr, int index = 0, char *type = 0);
556 // Returns the value that a pointer is pointing to (ie. dereferencing).
557 // The type is automatically inferred by the pointer type--thus, an
558 // integer pointer will return an integer, a double will return a double,
559 // and so on. The index and type fields are optional parameters. When
560 // an index is specified, this function returns the value of ptr[index].
561 // This allows array access. When a type is specified, it overrides
562 // the given pointer type. Examples :
564 // ptrvalue($a) # Returns the value *a
565 // ptrvalue($a,10) # Returns the value a[10]
566 // ptrvalue($a,10,"double") # Returns a[10] assuming a is a double *
569 void ptrset(SV *ptr, SV *value, int index = 0, char *type = 0);
570 // Sets the value pointed to by a pointer. The type is automatically
571 // inferred from the pointer type so this function will work for
572 // integers, floats, doubles, etc... The index and type fields are
573 // optional. When an index is given, it provides array access. When
574 // type is specified, it overrides the given pointer type. Examples :
576 // ptrset($a,3) # Sets the value *a = 3
577 // ptrset($a,3,10) # Sets a[10] = 3
578 // ptrset($a,3,10,"int") # Sets a[10] = 3 assuming a is a int *
581 SV *ptrcreate(char *type, SV *value = 0, int nitems = 1);
582 // Creates a new object and returns a pointer to it. This function
583 // can be used to create various kinds of objects for use in C functions.
584 // type specifies the basic C datatype to create and value is an
585 // optional parameter that can be used to set the initial value of the
586 // object. nitems is an optional parameter that can be used to create
587 // an array. This function results in a memory allocation using
588 // malloc(). Examples :
590 // $a = ptrcreate("double") # Create a new double, return pointer
591 // $a = ptrcreate("int",7) # Create an integer, set value to 7
592 // $a = ptrcreate("int",0,1000) # Create an integer array with initial
593 // # values all set to zero
595 // This function only recognizes a few common C datatypes as listed below :
597 // int, short, long, float, double, char, char *, void
599 // All other datatypes will result in an error. However, other
600 // datatypes can be created by using the ptrcast function. For
603 // $a = ptrcast(ptrcreate("int",0,100),"unsigned int *")
606 void ptrfree(SV *ptr);
607 // Destroys the memory pointed to by ptr. This function calls free()
608 // and should only be used with objects created by ptrcreate(). Since
609 // this function calls free, it may work with other objects, but this
610 // is generally discouraged unless you absolutely know what you're
613 SV *ptradd(SV *ptr, int offset);
614 // Adds a value to the current pointer value. For the C datatypes of
615 // int, short, long, float, double, and char, the offset value is the
616 // number of objects and works in exactly the same manner as in C. For
617 // example, the following code steps through the elements of an array
619 // $a = ptrcreate("double",0,100); # Create an array double a[100]
621 // for ($i = 0; $i < 100; $i++) {
622 // ptrset($b,0.0025*$i); # set *b = 0.0025*i
623 // $b = ptradd($b,1); # b++ (go to next double)
626 // In this case, adding one to b goes to the next double.
628 // For all other datatypes (including all complex datatypes), the
629 // offset corresponds to bytes. This function does not perform any
630 // bounds checking and negative offsets are perfectly legal.
632 void ptrmap(char *type1, char *type2);
633 // This is a rarely used function that performs essentially the same
634 // operation as a C typedef. To manage datatypes at run-time, SWIG
635 // modules manage an internal symbol table of type mappings. This
636 // table keeps track of which types are equivalent to each other. The
637 // ptrmap() function provides a mechanism for scripts to add symbols
638 // to this table. For example :
640 // ptrmap("doublePtr","RealPtr");
642 // would make the types "doublePtr" and "RealPtr" equivalent to each
643 // other. Pointers of either type could now be used interchangably.
645 // Normally this function is not needed, but it can be used to
646 // circumvent SWIG's normal type-checking behavior or to work around
647 // weird type-handling problems.