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 *;