tclLink.c

Go to the documentation of this file.
00001 /*
00002  * tclLink.c --
00003  *
00004  *      This file implements linked variables (a C variable that is tied to a
00005  *      Tcl variable). The idea of linked variables was first suggested by
00006  *      Andreas Stolcke and this implementation is based heavily on a
00007  *      prototype implementation provided by him.
00008  *
00009  * Copyright (c) 1993 The Regents of the University of California.
00010  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
00011  *
00012  * See the file "license.terms" for information on usage and redistribution of
00013  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
00014  *
00015  * RCS: @(#) $Id: tclLink.c,v 1.24 2007/12/13 15:23:18 dgp Exp $
00016  */
00017 
00018 #include "tclInt.h"
00019 
00020 /*
00021  * For each linked variable there is a data structure of the following type,
00022  * which describes the link and is the clientData for the trace set on the Tcl
00023  * variable.
00024  */
00025 
00026 typedef struct Link {
00027     Tcl_Interp *interp;         /* Interpreter containing Tcl variable. */
00028     Tcl_Obj *varName;           /* Name of variable (must be global). This is
00029                                  * needed during trace callbacks, since the
00030                                  * actual variable may be aliased at that time
00031                                  * via upvar. */
00032     char *addr;                 /* Location of C variable. */
00033     int type;                   /* Type of link (TCL_LINK_INT, etc.). */
00034     union {
00035         char c;
00036         unsigned char uc;
00037         int i;
00038         unsigned int ui;
00039         short s;
00040         unsigned short us;
00041         long l;
00042         unsigned long ul;
00043         Tcl_WideInt w;
00044         Tcl_WideUInt uw;
00045         float f;
00046         double d;
00047     } lastValue;                /* Last known value of C variable; used to
00048                                  * avoid string conversions. */
00049     int flags;                  /* Miscellaneous one-bit values; see below for
00050                                  * definitions. */
00051 } Link;
00052 
00053 /*
00054  * Definitions for flag bits:
00055  * LINK_READ_ONLY -             1 means errors should be generated if Tcl
00056  *                              script attempts to write variable.
00057  * LINK_BEING_UPDATED -         1 means that a call to Tcl_UpdateLinkedVar is
00058  *                              in progress for this variable, so trace
00059  *                              callbacks on the variable should be ignored.
00060  */
00061 
00062 #define LINK_READ_ONLY          1
00063 #define LINK_BEING_UPDATED      2
00064 
00065 /*
00066  * Forward references to functions defined later in this file:
00067  */
00068 
00069 static char *           LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
00070                             CONST char *name1, CONST char *name2, int flags);
00071 static Tcl_Obj *        ObjValue(Link *linkPtr);
00072 
00073 /*
00074  * Convenience macro for accessing the value of the C variable pointed to by a
00075  * link. Note that this macro produces something that may be regarded as an
00076  * lvalue or rvalue; it may be assigned to as well as read. Also note that
00077  * this macro assumes the name of the variable being accessed (linkPtr); this
00078  * is not strictly a good thing, but it keeps the code much shorter and
00079  * cleaner.
00080  */
00081 
00082 #define LinkedVar(type) (*(type *) linkPtr->addr)
00083 
00084 /*
00085  *----------------------------------------------------------------------
00086  *
00087  * Tcl_LinkVar --
00088  *
00089  *      Link a C variable to a Tcl variable so that changes to either one
00090  *      causes the other to change.
00091  *
00092  * Results:
00093  *      The return value is TCL_OK if everything went well or TCL_ERROR if an
00094  *      error occurred (the interp's result is also set after errors).
00095  *
00096  * Side effects:
00097  *      The value at *addr is linked to the Tcl variable "varName", using
00098  *      "type" to convert between string values for Tcl and binary values for
00099  *      *addr.
00100  *
00101  *----------------------------------------------------------------------
00102  */
00103 
00104 int
00105 Tcl_LinkVar(
00106     Tcl_Interp *interp,         /* Interpreter in which varName exists. */
00107     CONST char *varName,        /* Name of a global variable in interp. */
00108     char *addr,                 /* Address of a C variable to be linked to
00109                                  * varName. */
00110     int type)                   /* Type of C variable: TCL_LINK_INT, etc. Also
00111                                  * may have TCL_LINK_READ_ONLY OR'ed in. */
00112 {
00113     Tcl_Obj *objPtr;
00114     Link *linkPtr;
00115     int code;
00116 
00117     linkPtr = (Link *) ckalloc(sizeof(Link));
00118     linkPtr->interp = interp;
00119     linkPtr->varName = Tcl_NewStringObj(varName, -1);
00120     Tcl_IncrRefCount(linkPtr->varName);
00121     linkPtr->addr = addr;
00122     linkPtr->type = type & ~TCL_LINK_READ_ONLY;
00123     if (type & TCL_LINK_READ_ONLY) {
00124         linkPtr->flags = LINK_READ_ONLY;
00125     } else {
00126         linkPtr->flags = 0;
00127     }
00128     objPtr = ObjValue(linkPtr);
00129     if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
00130             TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
00131         Tcl_DecrRefCount(linkPtr->varName);
00132         ckfree((char *) linkPtr);
00133         return TCL_ERROR;
00134     }
00135     code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
00136             |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
00137             (ClientData) linkPtr);
00138     if (code != TCL_OK) {
00139         Tcl_DecrRefCount(linkPtr->varName);
00140         ckfree((char *) linkPtr);
00141     }
00142     return code;
00143 }
00144 
00145 /*
00146  *----------------------------------------------------------------------
00147  *
00148  * Tcl_UnlinkVar --
00149  *
00150  *      Destroy the link between a Tcl variable and a C variable.
00151  *
00152  * Results:
00153  *      None.
00154  *
00155  * Side effects:
00156  *      If "varName" was previously linked to a C variable, the link is broken
00157  *      to make the variable independent. If there was no previous link for
00158  *      "varName" then nothing happens.
00159  *
00160  *----------------------------------------------------------------------
00161  */
00162 
00163 void
00164 Tcl_UnlinkVar(
00165     Tcl_Interp *interp,         /* Interpreter containing variable to unlink */
00166     CONST char *varName)        /* Global variable in interp to unlink. */
00167 {
00168     Link *linkPtr;
00169 
00170     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
00171             LinkTraceProc, (ClientData) NULL);
00172     if (linkPtr == NULL) {
00173         return;
00174     }
00175     Tcl_UntraceVar(interp, varName,
00176             TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
00177             LinkTraceProc, (ClientData) linkPtr);
00178     Tcl_DecrRefCount(linkPtr->varName);
00179     ckfree((char *) linkPtr);
00180 }
00181 
00182 /*
00183  *----------------------------------------------------------------------
00184  *
00185  * Tcl_UpdateLinkedVar --
00186  *
00187  *      This function is invoked after a linked variable has been changed by C
00188  *      code. It updates the Tcl variable so that traces on the variable will
00189  *      trigger.
00190  *
00191  * Results:
00192  *      None.
00193  *
00194  * Side effects:
00195  *      The Tcl variable "varName" is updated from its C value, causing traces
00196  *      on the variable to trigger.
00197  *
00198  *----------------------------------------------------------------------
00199  */
00200 
00201 void
00202 Tcl_UpdateLinkedVar(
00203     Tcl_Interp *interp,         /* Interpreter containing variable. */
00204     CONST char *varName)        /* Name of global variable that is linked. */
00205 {
00206     Link *linkPtr;
00207     int savedFlag;
00208 
00209     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
00210             LinkTraceProc, (ClientData) NULL);
00211     if (linkPtr == NULL) {
00212         return;
00213     }
00214     savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
00215     linkPtr->flags |= LINK_BEING_UPDATED;
00216     Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00217             TCL_GLOBAL_ONLY);
00218     /*
00219      * Callback may have unlinked the variable. [Bug 1740631]
00220      */
00221     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
00222             LinkTraceProc, (ClientData) NULL);
00223     if (linkPtr != NULL) {
00224         linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
00225     }
00226 }
00227 
00228 /*
00229  *----------------------------------------------------------------------
00230  *
00231  * LinkTraceProc --
00232  *
00233  *      This function is invoked when a linked Tcl variable is read, written,
00234  *      or unset from Tcl. It's responsible for keeping the C variable in sync
00235  *      with the Tcl variable.
00236  *
00237  * Results:
00238  *      If all goes well, NULL is returned; otherwise an error message is
00239  *      returned.
00240  *
00241  * Side effects:
00242  *      The C variable may be updated to make it consistent with the Tcl
00243  *      variable, or the Tcl variable may be overwritten to reject a
00244  *      modification.
00245  *
00246  *----------------------------------------------------------------------
00247  */
00248 
00249 static char *
00250 LinkTraceProc(
00251     ClientData clientData,      /* Contains information about the link. */
00252     Tcl_Interp *interp,         /* Interpreter containing Tcl variable. */
00253     CONST char *name1,          /* First part of variable name. */
00254     CONST char *name2,          /* Second part of variable name. */
00255     int flags)                  /* Miscellaneous additional information. */
00256 {
00257     Link *linkPtr = (Link *) clientData;
00258     int changed, valueLength;
00259     CONST char *value;
00260     char **pp;
00261     Tcl_Obj *valueObj;
00262     int valueInt;
00263     Tcl_WideInt valueWide;
00264     double valueDouble;
00265 
00266     /*
00267      * If the variable is being unset, then just re-create it (with a trace)
00268      * unless the whole interpreter is going away.
00269      */
00270 
00271     if (flags & TCL_TRACE_UNSETS) {
00272         if (Tcl_InterpDeleted(interp)) {
00273             Tcl_DecrRefCount(linkPtr->varName);
00274             ckfree((char *) linkPtr);
00275         } else if (flags & TCL_TRACE_DESTROYED) {
00276             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00277                     TCL_GLOBAL_ONLY);
00278             Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
00279                     TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
00280                     |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
00281         }
00282         return NULL;
00283     }
00284 
00285     /*
00286      * If we were invoked because of a call to Tcl_UpdateLinkedVar, then don't
00287      * do anything at all. In particular, we don't want to get upset that the
00288      * variable is being modified, even if it is supposed to be read-only.
00289      */
00290 
00291     if (linkPtr->flags & LINK_BEING_UPDATED) {
00292         return NULL;
00293     }
00294 
00295     /*
00296      * For read accesses, update the Tcl variable if the C variable has
00297      * changed since the last time we updated the Tcl variable.
00298      */
00299 
00300     if (flags & TCL_TRACE_READS) {
00301         switch (linkPtr->type) {
00302         case TCL_LINK_INT:
00303         case TCL_LINK_BOOLEAN:
00304             changed = (LinkedVar(int) != linkPtr->lastValue.i);
00305             break;
00306         case TCL_LINK_DOUBLE:
00307             changed = (LinkedVar(double) != linkPtr->lastValue.d);
00308             break;
00309         case TCL_LINK_WIDE_INT:
00310             changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
00311             break;
00312         case TCL_LINK_WIDE_UINT:
00313             changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
00314             break;
00315         case TCL_LINK_CHAR:
00316             changed = (LinkedVar(char) != linkPtr->lastValue.c);
00317             break;
00318         case TCL_LINK_UCHAR:
00319             changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
00320             break;
00321         case TCL_LINK_SHORT:
00322             changed = (LinkedVar(short) != linkPtr->lastValue.s);
00323             break;
00324         case TCL_LINK_USHORT:
00325             changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
00326             break;
00327         case TCL_LINK_UINT:
00328             changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
00329             break;
00330         case TCL_LINK_LONG:
00331             changed = (LinkedVar(long) != linkPtr->lastValue.l);
00332             break;
00333         case TCL_LINK_ULONG:
00334             changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
00335             break;
00336         case TCL_LINK_FLOAT:
00337             changed = (LinkedVar(float) != linkPtr->lastValue.f);
00338             break;
00339         case TCL_LINK_STRING:
00340             changed = 1;
00341             break;
00342         default:
00343             return "internal error: bad linked variable type";
00344         }
00345         if (changed) {
00346             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00347                     TCL_GLOBAL_ONLY);
00348         }
00349         return NULL;
00350     }
00351 
00352     /*
00353      * For writes, first make sure that the variable is writable. Then convert
00354      * the Tcl value to C if possible. If the variable isn't writable or can't
00355      * be converted, then restore the varaible's old value and return an
00356      * error. Another tricky thing: we have to save and restore the interp's
00357      * result, since the variable access could occur when the result has been
00358      * partially set.
00359      */
00360 
00361     if (linkPtr->flags & LINK_READ_ONLY) {
00362         Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00363                 TCL_GLOBAL_ONLY);
00364         return "linked variable is read-only";
00365     }
00366     valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
00367     if (valueObj == NULL) {
00368         /*
00369          * This shouldn't ever happen.
00370          */
00371 
00372         return "internal error: linked variable couldn't be read";
00373     }
00374 
00375     switch (linkPtr->type) {
00376     case TCL_LINK_INT:
00377         if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
00378                 != TCL_OK) {
00379             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00380                     TCL_GLOBAL_ONLY);
00381             return "variable must have integer value";
00382         }
00383         LinkedVar(int) = linkPtr->lastValue.i;
00384         break;
00385 
00386     case TCL_LINK_WIDE_INT:
00387         if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
00388                 != TCL_OK) {
00389             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00390                     TCL_GLOBAL_ONLY);
00391             return "variable must have integer value";
00392         }
00393         LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
00394         break;
00395 
00396     case TCL_LINK_DOUBLE:
00397         if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
00398                 != TCL_OK) {
00399 #ifdef ACCEPT_NAN
00400             if (valueObj->typePtr != &tclDoubleType) {
00401 #endif
00402                 Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
00403                         ObjValue(linkPtr), TCL_GLOBAL_ONLY);
00404                 return "variable must have real value";
00405 #ifdef ACCEPT_NAN
00406             }
00407             linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
00408 #endif
00409         }
00410         LinkedVar(double) = linkPtr->lastValue.d;
00411         break;
00412 
00413     case TCL_LINK_BOOLEAN:
00414         if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
00415                 != TCL_OK) {
00416             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00417                     TCL_GLOBAL_ONLY);
00418             return "variable must have boolean value";
00419         }
00420         LinkedVar(int) = linkPtr->lastValue.i;
00421         break;
00422 
00423     case TCL_LINK_CHAR:
00424         if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
00425                 || valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
00426             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00427                     TCL_GLOBAL_ONLY);
00428             return "variable must have char value";
00429         }
00430         linkPtr->lastValue.c = (char)valueInt;
00431         LinkedVar(char) = linkPtr->lastValue.c;
00432         break;
00433 
00434     case TCL_LINK_UCHAR:
00435         if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
00436                 || valueInt < 0 || valueInt > UCHAR_MAX) {
00437             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00438                     TCL_GLOBAL_ONLY);
00439             return "variable must have unsigned char value";
00440         }
00441         linkPtr->lastValue.uc = (unsigned char) valueInt;
00442         LinkedVar(unsigned char) = linkPtr->lastValue.uc;
00443         break;
00444 
00445     case TCL_LINK_SHORT:
00446         if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
00447                 || valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
00448             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00449                     TCL_GLOBAL_ONLY);
00450             return "variable must have short value";
00451         }
00452         linkPtr->lastValue.s = (short)valueInt;
00453         LinkedVar(short) = linkPtr->lastValue.s;
00454         break;
00455 
00456     case TCL_LINK_USHORT:
00457         if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
00458                 || valueInt < 0 || valueInt > USHRT_MAX) {
00459             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00460                     TCL_GLOBAL_ONLY);
00461             return "variable must have unsigned short value";
00462         }
00463         linkPtr->lastValue.us = (unsigned short)valueInt;
00464         LinkedVar(unsigned short) = linkPtr->lastValue.us;
00465         break;
00466 
00467     case TCL_LINK_UINT:
00468         if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
00469                 || valueWide < 0 || valueWide > UINT_MAX) {
00470             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00471                     TCL_GLOBAL_ONLY);
00472             return "variable must have unsigned int value";
00473         }
00474         linkPtr->lastValue.ui = (unsigned int)valueWide;
00475         LinkedVar(unsigned int) = linkPtr->lastValue.ui;
00476         break;
00477 
00478     case TCL_LINK_LONG:
00479         if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
00480                 || valueWide < LONG_MIN || valueWide > LONG_MAX) {
00481             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00482                     TCL_GLOBAL_ONLY);
00483             return "variable must have long value";
00484         }
00485         linkPtr->lastValue.l = (long)valueWide;
00486         LinkedVar(long) = linkPtr->lastValue.l;
00487         break;
00488 
00489     case TCL_LINK_ULONG:
00490         if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
00491                 || valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
00492             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00493                     TCL_GLOBAL_ONLY);
00494             return "variable must have unsigned long value";
00495         }
00496         linkPtr->lastValue.ul = (unsigned long)valueWide;
00497         LinkedVar(unsigned long) = linkPtr->lastValue.ul;
00498         break;
00499 
00500     case TCL_LINK_WIDE_UINT:
00501         /*
00502          * FIXME: represent as a bignum.
00503          */
00504         if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
00505             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00506                     TCL_GLOBAL_ONLY);
00507             return "variable must have unsigned wide int value";
00508         }
00509         linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
00510         LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
00511         break;
00512 
00513     case TCL_LINK_FLOAT:
00514         if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK
00515                 || valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
00516             Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
00517                     TCL_GLOBAL_ONLY);
00518             return "variable must have float value";
00519         }
00520         linkPtr->lastValue.f = (float)valueDouble;
00521         LinkedVar(float) = linkPtr->lastValue.f;
00522         break;
00523 
00524     case TCL_LINK_STRING:
00525         value = Tcl_GetStringFromObj(valueObj, &valueLength);
00526         valueLength++;
00527         pp = (char **) linkPtr->addr;
00528 
00529         *pp = ckrealloc(*pp, valueLength);
00530         memcpy(*pp, value, (unsigned) valueLength);
00531         break;
00532 
00533     default:
00534         return "internal error: bad linked variable type";
00535     }
00536     return NULL;
00537 }
00538 
00539 /*
00540  *----------------------------------------------------------------------
00541  *
00542  * ObjValue --
00543  *
00544  *      Converts the value of a C variable to a Tcl_Obj* for use in a Tcl
00545  *      variable to which it is linked.
00546  *
00547  * Results:
00548  *      The return value is a pointer to a Tcl_Obj that represents the value
00549  *      of the C variable given by linkPtr.
00550  *
00551  * Side effects:
00552  *      None.
00553  *
00554  *----------------------------------------------------------------------
00555  */
00556 
00557 static Tcl_Obj *
00558 ObjValue(
00559     Link *linkPtr)              /* Structure describing linked variable. */
00560 {
00561     char *p;
00562     Tcl_Obj *resultObj;
00563 
00564     switch (linkPtr->type) {
00565     case TCL_LINK_INT:
00566         linkPtr->lastValue.i = LinkedVar(int);
00567         return Tcl_NewIntObj(linkPtr->lastValue.i);
00568     case TCL_LINK_WIDE_INT:
00569         linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
00570         return Tcl_NewWideIntObj(linkPtr->lastValue.w);
00571     case TCL_LINK_DOUBLE:
00572         linkPtr->lastValue.d = LinkedVar(double);
00573         return Tcl_NewDoubleObj(linkPtr->lastValue.d);
00574     case TCL_LINK_BOOLEAN:
00575         linkPtr->lastValue.i = LinkedVar(int);
00576         return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
00577     case TCL_LINK_CHAR:
00578         linkPtr->lastValue.c = LinkedVar(char);
00579         return Tcl_NewIntObj(linkPtr->lastValue.c);
00580     case TCL_LINK_UCHAR:
00581         linkPtr->lastValue.uc = LinkedVar(unsigned char);
00582         return Tcl_NewIntObj(linkPtr->lastValue.uc);
00583     case TCL_LINK_SHORT:
00584         linkPtr->lastValue.s = LinkedVar(short);
00585         return Tcl_NewIntObj(linkPtr->lastValue.s);
00586     case TCL_LINK_USHORT:
00587         linkPtr->lastValue.us = LinkedVar(unsigned short);
00588         return Tcl_NewIntObj(linkPtr->lastValue.us);
00589     case TCL_LINK_UINT:
00590         linkPtr->lastValue.ui = LinkedVar(unsigned int);
00591         return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
00592     case TCL_LINK_LONG:
00593         linkPtr->lastValue.l = LinkedVar(long);
00594         return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
00595     case TCL_LINK_ULONG:
00596         linkPtr->lastValue.ul = LinkedVar(unsigned long);
00597         return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
00598     case TCL_LINK_FLOAT:
00599         linkPtr->lastValue.f = LinkedVar(float);
00600         return Tcl_NewDoubleObj(linkPtr->lastValue.f);
00601     case TCL_LINK_WIDE_UINT:
00602         linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
00603         /*
00604          * FIXME: represent as a bignum.
00605          */
00606         return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
00607     case TCL_LINK_STRING:
00608         p = LinkedVar(char *);
00609         if (p == NULL) {
00610             TclNewLiteralStringObj(resultObj, "NULL");
00611             return resultObj;
00612         }
00613         return Tcl_NewStringObj(p, -1);
00614 
00615     /*
00616      * This code only gets executed if the link type is unknown (shouldn't
00617      * ever happen).
00618      */
00619 
00620     default:
00621         TclNewLiteralStringObj(resultObj, "??");
00622         return resultObj;
00623     }
00624 }
00625 
00626 /*
00627  * Local Variables:
00628  * mode: c
00629  * c-basic-offset: 4
00630  * fill-column: 78
00631  * End:
00632  */



Generated on Wed Mar 12 12:18:18 2008 by  doxygen 1.5.1