2 // SWIG pointer conversion and utility library
7 // Tcl specific implementation. This file is included
8 // by the file ../pointer.i
13 // -----------------------------------------------------------------
14 // Define a hack for GetPtr on Tcl 8
16 // -----------------------------------------------------------------
20 static char *_SWIG_GetPtr(Tcl_Interp *interp, char *s, void **ptr, char *type) {
23 obj = Tcl_NewStringObj(s, strlen(s));
24 c = SWIG_GetPointerObj(interp, obj, ptr, type);
28 Tcl_DecrRefCount(obj);
32 #define SWIG_GetPtr(a,b,c) _SWIG_GetPtr(interp, a,b,c)
41 /*------------------------------------------------------------------
44 Constructs a new pointer value. Value may either be a string
45 or an integer. Type is a string corresponding to either the
46 C datatype or mangled datatype.
51 ------------------------------------------------------------------ */
53 static int ptrcast(Tcl_Interp *interp, char *_ptrvalue, char *type) {
61 /* Produce a "mangled" version of the type string. */
63 typestr = (char *) malloc(strlen(type)+2);
65 /* Go through and munge the typestring */
72 if ((*c == '*') || (*c == '&')) {
83 /* Check to see what kind of object _PTRVALUE is */
84 if (Tcl_GetInt(interp,_ptrvalue,&pv) == TCL_OK) {
86 /* Received a numerical value. Make a pointer out of it */
87 r = (char *) malloc(strlen(typestr)+22);
89 SWIG_MakePtr(r, ptr, typestr);
91 sprintf(r,"_0%s",typestr);
93 Tcl_SetResult(interp,r,TCL_VOLATILE);
96 /* Have a string. Try to get the real pointer value */
98 r = (char *) malloc(strlen(type)+22);
100 /* Now extract the pointer value */
101 if (!SWIG_GetPtr(s,&ptr,0)) {
103 SWIG_MakePtr(r,ptr,typestr);
105 sprintf(r,"_0%s",typestr);
107 Tcl_SetResult(interp,r,TCL_VOLATILE);
115 Tcl_SetResult(interp,"Type error in ptrcast. Argument is not a valid pointer value.",TCL_VOLATILE);
121 /*------------------------------------------------------------------
122 ptrvalue(ptr,type = 0)
124 Attempts to dereference a pointer value. If type is given, it
125 will try to use that type. Otherwise, this function will attempt
126 to "guess" the proper datatype by checking against all of the
128 ------------------------------------------------------------------ */
130 static int ptrvalue(Tcl_Interp *interp, char *_ptrvalue, int index, char *type) {
136 if (strlen(type) == 0) type = 0;
139 if (SWIG_GetPtr(s,&ptr,0)) {
140 Tcl_SetResult(interp,"Type error in ptrvalue. Argument is not a valid pointer value.",
145 /* If no datatype was passed, try a few common datatypes first */
149 /* No datatype was passed. Type to figure out if it's a common one */
151 if (!SWIG_GetPtr(s,&ptr,"_int_p")) {
153 } else if (!SWIG_GetPtr(s,&ptr,"_double_p")) {
155 } else if (!SWIG_GetPtr(s,&ptr,"_short_p")) {
157 } else if (!SWIG_GetPtr(s,&ptr,"_long_p")) {
159 } else if (!SWIG_GetPtr(s,&ptr,"_float_p")) {
161 } else if (!SWIG_GetPtr(s,&ptr,"_char_p")) {
163 } else if (!SWIG_GetPtr(s,&ptr,"_char_pp")) {
171 Tcl_SetResult(interp,"Unable to dereference NULL pointer.",TCL_STATIC);
175 /* Now we have a datatype. Try to figure out what to do about it */
176 if (strcmp(type,"int") == 0) {
177 sprintf(interp->result,"%ld",(long) *(((int *) ptr) + index));
178 } else if (strcmp(type,"double") == 0) {
179 Tcl_PrintDouble(interp,(double) *(((double *) ptr)+index), interp->result);
180 } else if (strcmp(type,"short") == 0) {
181 sprintf(interp->result,"%ld",(long) *(((short *) ptr) + index));
182 } else if (strcmp(type,"long") == 0) {
183 sprintf(interp->result,"%ld",(long) *(((long *) ptr) + index));
184 } else if (strcmp(type,"float") == 0) {
185 Tcl_PrintDouble(interp,(double) *(((float *) ptr)+index), interp->result);
186 } else if (strcmp(type,"char") == 0) {
187 Tcl_SetResult(interp,((char *) ptr) + index, TCL_VOLATILE);
188 } else if (strcmp(type,"char *") == 0) {
189 char *c = *(((char **) ptr)+index);
190 if (c) Tcl_SetResult(interp,(char *) c, TCL_VOLATILE);
191 else Tcl_SetResult(interp,"NULL", TCL_VOLATILE);
193 Tcl_SetResult(interp,"Unable to dereference unsupported datatype.",TCL_STATIC);
199 /*------------------------------------------------------------------
200 ptrcreate(type,value = 0,numelements = 1)
202 Attempts to create a new object of given type. Type must be
203 a basic C datatype. Will not create complex objects.
204 ------------------------------------------------------------------ */
206 static int ptrcreate(Tcl_Interp *interp, char *type, char *_ptrvalue, int numelements) {
212 /* Check the type string against a variety of possibilities */
214 if (strcmp(type,"int") == 0) {
215 sz = sizeof(int)*numelements;
217 } else if (strcmp(type,"short") == 0) {
218 sz = sizeof(short)*numelements;
220 } else if (strcmp(type,"long") == 0) {
221 sz = sizeof(long)*numelements;
223 } else if (strcmp(type,"double") == 0) {
224 sz = sizeof(double)*numelements;
226 } else if (strcmp(type,"float") == 0) {
227 sz = sizeof(float)*numelements;
229 } else if (strcmp(type,"char") == 0) {
230 sz = sizeof(char)*numelements;
232 } else if (strcmp(type,"char *") == 0) {
233 sz = sizeof(char *)*(numelements+1);
235 } else if (strcmp(type,"void") == 0) {
238 Tcl_SetResult(interp,"Unable to create unknown datatype.",TCL_STATIC);
242 /* Create the new object */
244 ptr = (void *) malloc(sz);
246 Tcl_SetResult(interp,"Out of memory in ptrcreate.",TCL_STATIC);
250 /* Now try to set its default value */
253 if (strcmp(type,"int") == 0) {
255 Tcl_GetInt(interp,_ptrvalue,&ivalue);
257 for (i = 0; i < numelements; i++)
259 } else if (strcmp(type,"short") == 0) {
262 Tcl_GetInt(interp,_ptrvalue,&ivalue);
264 for (i = 0; i < numelements; i++)
265 ip[i] = (short) ivalue;
266 } else if (strcmp(type,"long") == 0) {
269 Tcl_GetInt(interp,_ptrvalue,&ivalue);
271 for (i = 0; i < numelements; i++)
272 ip[i] = (long) ivalue;
273 } else if (strcmp(type,"double") == 0) {
276 Tcl_GetDouble(interp,_ptrvalue,&ivalue);
278 for (i = 0; i < numelements; i++)
280 } else if (strcmp(type,"float") == 0) {
284 Tcl_GetDouble(interp,_ptrvalue,&ivalue);
286 for (i = 0; i < numelements; i++)
287 ip[i] = (double) ivalue;
288 } else if (strcmp(type,"char") == 0) {
290 ivalue = (char *) _ptrvalue;
292 strncpy(ip,ivalue,numelements-1);
293 } else if (strcmp(type,"char *") == 0) {
296 ivalue = (char *) _ptrvalue;
298 for (i = 0; i < numelements; i++) {
300 ip[i] = (char *) malloc(strlen(ivalue)+1);
301 strcpy(ip[i],ivalue);
309 /* Create the pointer value */
311 SWIG_MakePtr(temp,ptr,cast);
312 Tcl_SetResult(interp,temp,TCL_VOLATILE);
316 /*------------------------------------------------------------------
317 ptrset(ptr,value,index = 0,type = 0)
319 Attempts to set the value of a pointer variable. If type is
320 given, we will use that type. Otherwise, we'll guess the datatype.
321 ------------------------------------------------------------------ */
323 static int ptrset(Tcl_Interp *interp, char *_PTRVALUE, char *_VALUE, int index, char *type) {
328 if (SWIG_GetPtr(s,&ptr,0)) {
329 Tcl_SetResult(interp,"Type error in ptrset. Argument is not a valid pointer value.",
334 /* If no datatype was passed, try a few common datatypes first */
338 /* No datatype was passed. Type to figure out if it's a common one */
340 if (!SWIG_GetPtr(s,&ptr,"_int_p")) {
342 } else if (!SWIG_GetPtr(s,&ptr,"_double_p")) {
344 } else if (!SWIG_GetPtr(s,&ptr,"_short_p")) {
346 } else if (!SWIG_GetPtr(s,&ptr,"_long_p")) {
348 } else if (!SWIG_GetPtr(s,&ptr,"_float_p")) {
350 } else if (!SWIG_GetPtr(s,&ptr,"_char_p")) {
352 } else if (!SWIG_GetPtr(s,&ptr,"_char_pp")) {
360 Tcl_SetResult(interp,"Unable to set NULL pointer.",TCL_STATIC);
364 /* Now we have a datatype. Try to figure out what to do about it */
365 if (strcmp(type,"int") == 0) {
367 Tcl_GetInt(interp,_VALUE, &ivalue);
368 *(((int *) ptr)+index) = ivalue;
369 } else if (strcmp(type,"double") == 0) {
371 Tcl_GetDouble(interp,_VALUE, &ivalue);
372 *(((double *) ptr)+index) = (double) ivalue;
373 } else if (strcmp(type,"short") == 0) {
375 Tcl_GetInt(interp,_VALUE, &ivalue);
376 *(((short *) ptr)+index) = (short) ivalue;
377 } else if (strcmp(type,"long") == 0) {
379 Tcl_GetInt(interp,_VALUE, &ivalue);
380 *(((long *) ptr)+index) = (long) ivalue;
381 } else if (strcmp(type,"float") == 0) {
383 Tcl_GetDouble(interp,_VALUE, &ivalue);
384 *(((float *) ptr)+index) = (float) ivalue;
385 } else if (strcmp(type,"char") == 0) {
387 strcpy(((char *) ptr)+index, c);
388 } else if (strcmp(type,"char *") == 0) {
390 char **ca = (char **) ptr;
391 if (ca[index]) free(ca[index]);
392 if (strcmp(c,"NULL") == 0) {
395 ca[index] = (char *) malloc(strlen(c)+1);
399 Tcl_SetResult(interp,"Unable to set unsupported datatype.",TCL_STATIC);
405 /*------------------------------------------------------------------
408 Adds a value to an existing pointer value. Will do a type-dependent
409 add for basic datatypes. For other datatypes, will do a byte-add.
410 ------------------------------------------------------------------ */
412 static int ptradd(Tcl_Interp *interp, char *_PTRVALUE, int offset) {
418 /* Check to see what kind of object _PTRVALUE is */
422 /* Try to handle a few common datatypes first */
424 if (!SWIG_GetPtr(s,&ptr,"_int_p")) {
425 ptr = (void *) (((int *) ptr) + offset);
426 } else if (!SWIG_GetPtr(s,&ptr,"_double_p")) {
427 ptr = (void *) (((double *) ptr) + offset);
428 } else if (!SWIG_GetPtr(s,&ptr,"_short_p")) {
429 ptr = (void *) (((short *) ptr) + offset);
430 } else if (!SWIG_GetPtr(s,&ptr,"_long_p")) {
431 ptr = (void *) (((long *) ptr) + offset);
432 } else if (!SWIG_GetPtr(s,&ptr,"_float_p")) {
433 ptr = (void *) (((float *) ptr) + offset);
434 } else if (!SWIG_GetPtr(s,&ptr,"_char_p")) {
435 ptr = (void *) (((char *) ptr) + offset);
436 } else if (!SWIG_GetPtr(s,&ptr,0)) {
437 ptr = (void *) (((char *) ptr) + offset);
439 Tcl_SetResult(interp,"Type error in ptradd. Argument is not a valid pointer value.",TCL_STATIC);
442 type = SWIG_GetPtr(s,&junk,"INVALID POINTER");
443 r = (char *) malloc(strlen(type)+20);
445 SWIG_MakePtr(r,ptr,type);
447 sprintf(r,"_0%s",type);
449 Tcl_SetResult(interp,r,TCL_VOLATILE);
455 /*------------------------------------------------------------------
458 Allows a mapping between type1 and type2. (Like a typedef)
459 ------------------------------------------------------------------ */
461 static void ptrmap(char *type1, char *type2) {
463 char *typestr1,*typestr2,*c,*r;
465 /* Produce a "mangled" version of the type string. */
467 typestr1 = (char *) malloc(strlen(type1)+2);
469 /* Go through and munge the typestring */
476 if ((*c == '*') || (*c == '&')) {
487 typestr2 = (char *) malloc(strlen(type2)+2);
489 /* Go through and munge the typestring */
496 if ((*c == '*') || (*c == '&')) {
506 SWIG_RegisterMapping(typestr1,typestr2,0);
507 SWIG_RegisterMapping(typestr2,typestr1,0);
510 /*------------------------------------------------------------------
513 Destroys a pointer value
514 ------------------------------------------------------------------ */
516 int ptrfree(Tcl_Interp *interp, char *_PTRVALUE) {
521 if (SWIG_GetPtr(s,&ptr,0)) {
522 Tcl_SetResult(interp,"Type error in ptrfree. Argument is not a valid pointer value.",TCL_STATIC);
526 /* Check to see if this pointer is a char ** */
527 if (!SWIG_GetPtr(s,&junk,"_char_pp")) {
528 char **c = (char **) ptr;
544 %typemap(tcl,out) int ptrcast,
553 %typemap(tcl8,out) int ptrcast,
563 // Ignore the Tcl_Interp * value, but set it to a value
565 %typemap(tcl,ignore) Tcl_Interp * {
568 %typemap(tcl8,ignore) Tcl_Interp * {
572 int ptrcast(Tcl_Interp *interp, char *ptr, char *type);
573 // Casts a pointer ptr to a new datatype given by the string type.
574 // type may be either the SWIG generated representation of a datatype
575 // or the C representation. For example :
577 // ptrcast $ptr double_p # Tcl representation
578 // ptrcast $ptr "double *" # C representation
580 // A new pointer value is returned. ptr may also be an integer
581 // value in which case the value will be used to set the pointer
582 // value. For example :
584 // set a [ptrcast 0 Vector_p]
586 // Will create a NULL pointer of type "Vector_p"
588 // The casting operation is sensitive to formatting. As a result,
589 // "double *" is different than "double*". As a result of thumb,
590 // there should always be exactly one space between the C datatype
591 // and any pointer specifiers (*).
594 int ptrvalue(Tcl_Interp *interp, char *ptr, int index = 0, char *type = 0);
595 // Returns the value that a pointer is pointing to (ie. dereferencing).
596 // The type is automatically inferred by the pointer type--thus, an
597 // integer pointer will return an integer, a double will return a double,
598 // and so on. The index and type fields are optional parameters. When
599 // an index is specified, this function returns the value of ptr[index].
600 // This allows array access. When a type is specified, it overrides
601 // the given pointer type. Examples :
603 // ptrvalue $a # Returns the value *a
604 // ptrvalue $a 10 # Returns the value a[10]
605 // ptrvalue $a 10 double # Returns a[10] assuming a is a double *
607 int ptrset(Tcl_Interp *interp, char *ptr, char *value, int index = 0, char *type = 0);
608 // Sets the value pointed to by a pointer. The type is automatically
609 // inferred from the pointer type so this function will work for
610 // integers, floats, doubles, etc... The index and type fields are
611 // optional. When an index is given, it provides array access. When
612 // type is specified, it overrides the given pointer type. Examples :
614 // ptrset $a 3 # Sets the value *a = 3
615 // ptrset $a 3 10 # Sets a[10] = 3
616 // ptrset $a 3 10 int # Sets a[10] = 3 assuming a is a int *
618 int ptrcreate(Tcl_Interp *interp, char *type, char *value = 0, int nitems = 1);
619 // Creates a new object and returns a pointer to it. This function
620 // can be used to create various kinds of objects for use in C functions.
621 // type specifies the basic C datatype to create and value is an
622 // optional parameter that can be used to set the initial value of the
623 // object. nitems is an optional parameter that can be used to create
624 // an array. This function results in a memory allocation using
625 // malloc(). Examples :
627 // set a [ptrcreate "double"] # Create a new double, return pointer
628 // set a [ptrcreate int 7] # Create an integer, set value to 7
629 // set a [ptrcreate int 0 1000] # Create an integer array with initial
630 // # values all set to zero
632 // This function only recognizes a few common C datatypes as listed below :
634 // int, short, long, float, double, char, char *, void
636 // All other datatypes will result in an error. However, other
637 // datatypes can be created by using the ptrcast function. For
640 // set a [ptrcast [ptrcreate int 0 100],"unsigned int *"]
642 int ptrfree(Tcl_Interp *interp, char *ptr);
643 // Destroys the memory pointed to by ptr. This function calls free()
644 // and should only be used with objects created by ptrcreate(). Since
645 // this function calls free, it may work with other objects, but this
646 // is generally discouraged unless you absolutely know what you're
649 int ptradd(Tcl_Interp *interp, char *ptr, int offset);
650 // Adds a value to the current pointer value. For the C datatypes of
651 // int, short, long, float, double, and char, the offset value is the
652 // number of objects and works in exactly the same manner as in C. For
653 // example, the following code steps through the elements of an array
655 // set a [ptrcreate double 0 100] # Create an array double a[100]
657 // for {set i 0} {$i < 100} {incr i 1} {
658 // ptrset $b [expr{0.0025*$i}] # set *b = 0.0025*i
659 // set b [ptradd $b 1] # b++ (go to next double)
662 // In this case, adding one to b goes to the next double.
664 // For all other datatypes (including all complex datatypes), the
665 // offset corresponds to bytes. This function does not perform any
666 // bounds checking and negative offsets are perfectly legal.
668 void ptrmap(char *type1, char *type2);
669 // This is a rarely used function that performs essentially the same
670 // operation as a C typedef. To manage datatypes at run-time, SWIG
671 // modules manage an internal symbol table of type mappings. This
672 // table keeps track of which types are equivalent to each other. The
673 // ptrmap() function provides a mechanism for scripts to add symbols
674 // to this table. For example :
676 // ptrmap double_p Real_p
678 // would make the types "double_p" and "Real_p" equivalent to each
679 // other. Pointers of either type could now be used interchangably.
681 // Normally this function is not needed, but it can be used to
682 // circumvent SWIG's normal type-checking behavior or to work around
683 // weird type-handling bugs.
685 // Clear the ignore typemap
687 %typemap(tcl,ignore) Tcl_Interp *;
688 %typemap(tcl8,ignore) Tcl_Interp *;