Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/generic/tclLink.c @ 63

Last change on this file since 63 was 25, checked in by landauf, 17 years ago

added tcl to libs
File size: 18.9 KB
Line 
1/*
2 * tclLink.c --
3 *
4 *      This file implements linked variables (a C variable that is tied to a
5 *      Tcl variable). The idea of linked variables was first suggested by
6 *      Andreas Stolcke and this implementation is based heavily on a
7 *      prototype implementation provided by him.
8 *
9 * Copyright (c) 1993 The Regents of the University of California.
10 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
11 *
12 * See the file "license.terms" for information on usage and redistribution of
13 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
14 *
15 * RCS: @(#) $Id: tclLink.c,v 1.24 2007/12/13 15:23:18 dgp Exp $
16 */
17
18#include "tclInt.h"
19
20/*
21 * For each linked variable there is a data structure of the following type,
22 * which describes the link and is the clientData for the trace set on the Tcl
23 * variable.
24 */
25
26typedef struct Link {
27    Tcl_Interp *interp;         /* Interpreter containing Tcl variable. */
28    Tcl_Obj *varName;           /* Name of variable (must be global). This is
29                                 * needed during trace callbacks, since the
30                                 * actual variable may be aliased at that time
31                                 * via upvar. */
32    char *addr;                 /* Location of C variable. */
33    int type;                   /* Type of link (TCL_LINK_INT, etc.). */
34    union {
35        char c;
36        unsigned char uc;
37        int i;
38        unsigned int ui;
39        short s;
40        unsigned short us;
41        long l;
42        unsigned long ul;
43        Tcl_WideInt w;
44        Tcl_WideUInt uw;
45        float f;
46        double d;
47    } lastValue;                /* Last known value of C variable; used to
48                                 * avoid string conversions. */
49    int flags;                  /* Miscellaneous one-bit values; see below for
50                                 * definitions. */
51} Link;
52
53/*
54 * Definitions for flag bits:
55 * LINK_READ_ONLY -             1 means errors should be generated if Tcl
56 *                              script attempts to write variable.
57 * LINK_BEING_UPDATED -         1 means that a call to Tcl_UpdateLinkedVar is
58 *                              in progress for this variable, so trace
59 *                              callbacks on the variable should be ignored.
60 */
61
62#define LINK_READ_ONLY          1
63#define LINK_BEING_UPDATED      2
64
65/*
66 * Forward references to functions defined later in this file:
67 */
68
69static char *           LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
70                            CONST char *name1, CONST char *name2, int flags);
71static Tcl_Obj *        ObjValue(Link *linkPtr);
72
73/*
74 * Convenience macro for accessing the value of the C variable pointed to by a
75 * link. Note that this macro produces something that may be regarded as an
76 * lvalue or rvalue; it may be assigned to as well as read. Also note that
77 * this macro assumes the name of the variable being accessed (linkPtr); this
78 * is not strictly a good thing, but it keeps the code much shorter and
79 * cleaner.
80 */
81
82#define LinkedVar(type) (*(type *) linkPtr->addr)
83
84/*
85 *----------------------------------------------------------------------
86 *
87 * Tcl_LinkVar --
88 *
89 *      Link a C variable to a Tcl variable so that changes to either one
90 *      causes the other to change.
91 *
92 * Results:
93 *      The return value is TCL_OK if everything went well or TCL_ERROR if an
94 *      error occurred (the interp's result is also set after errors).
95 *
96 * Side effects:
97 *      The value at *addr is linked to the Tcl variable "varName", using
98 *      "type" to convert between string values for Tcl and binary values for
99 *      *addr.
100 *
101 *----------------------------------------------------------------------
102 */
103
104int
105Tcl_LinkVar(
106    Tcl_Interp *interp,         /* Interpreter in which varName exists. */
107    CONST char *varName,        /* Name of a global variable in interp. */
108    char *addr,                 /* Address of a C variable to be linked to
109                                 * varName. */
110    int type)                   /* Type of C variable: TCL_LINK_INT, etc. Also
111                                 * may have TCL_LINK_READ_ONLY OR'ed in. */
112{
113    Tcl_Obj *objPtr;
114    Link *linkPtr;
115    int code;
116
117    linkPtr = (Link *) ckalloc(sizeof(Link));
118    linkPtr->interp = interp;
119    linkPtr->varName = Tcl_NewStringObj(varName, -1);
120    Tcl_IncrRefCount(linkPtr->varName);
121    linkPtr->addr = addr;
122    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
123    if (type & TCL_LINK_READ_ONLY) {
124        linkPtr->flags = LINK_READ_ONLY;
125    } else {
126        linkPtr->flags = 0;
127    }
128    objPtr = ObjValue(linkPtr);
129    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
130            TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
131        Tcl_DecrRefCount(linkPtr->varName);
132        ckfree((char *) linkPtr);
133        return TCL_ERROR;
134    }
135    code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
136            |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
137            (ClientData) linkPtr);
138    if (code != TCL_OK) {
139        Tcl_DecrRefCount(linkPtr->varName);
140        ckfree((char *) linkPtr);
141    }
142    return code;
143}
144
145/*
146 *----------------------------------------------------------------------
147 *
148 * Tcl_UnlinkVar --
149 *
150 *      Destroy the link between a Tcl variable and a C variable.
151 *
152 * Results:
153 *      None.
154 *
155 * Side effects:
156 *      If "varName" was previously linked to a C variable, the link is broken
157 *      to make the variable independent. If there was no previous link for
158 *      "varName" then nothing happens.
159 *
160 *----------------------------------------------------------------------
161 */
162
163void
164Tcl_UnlinkVar(
165    Tcl_Interp *interp,         /* Interpreter containing variable to unlink */
166    CONST char *varName)        /* Global variable in interp to unlink. */
167{
168    Link *linkPtr;
169
170    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
171            LinkTraceProc, (ClientData) NULL);
172    if (linkPtr == NULL) {
173        return;
174    }
175    Tcl_UntraceVar(interp, varName,
176            TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
177            LinkTraceProc, (ClientData) linkPtr);
178    Tcl_DecrRefCount(linkPtr->varName);
179    ckfree((char *) linkPtr);
180}
181
182/*
183 *----------------------------------------------------------------------
184 *
185 * Tcl_UpdateLinkedVar --
186 *
187 *      This function is invoked after a linked variable has been changed by C
188 *      code. It updates the Tcl variable so that traces on the variable will
189 *      trigger.
190 *
191 * Results:
192 *      None.
193 *
194 * Side effects:
195 *      The Tcl variable "varName" is updated from its C value, causing traces
196 *      on the variable to trigger.
197 *
198 *----------------------------------------------------------------------
199 */
200
201void
202Tcl_UpdateLinkedVar(
203    Tcl_Interp *interp,         /* Interpreter containing variable. */
204    CONST char *varName)        /* Name of global variable that is linked. */
205{
206    Link *linkPtr;
207    int savedFlag;
208
209    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
210            LinkTraceProc, (ClientData) NULL);
211    if (linkPtr == NULL) {
212        return;
213    }
214    savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
215    linkPtr->flags |= LINK_BEING_UPDATED;
216    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
217            TCL_GLOBAL_ONLY);
218    /*
219     * Callback may have unlinked the variable. [Bug 1740631]
220     */
221    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
222            LinkTraceProc, (ClientData) NULL);
223    if (linkPtr != NULL) {
224        linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
225    }
226}
227
228/*
229 *----------------------------------------------------------------------
230 *
231 * LinkTraceProc --
232 *
233 *      This function is invoked when a linked Tcl variable is read, written,
234 *      or unset from Tcl. It's responsible for keeping the C variable in sync
235 *      with the Tcl variable.
236 *
237 * Results:
238 *      If all goes well, NULL is returned; otherwise an error message is
239 *      returned.
240 *
241 * Side effects:
242 *      The C variable may be updated to make it consistent with the Tcl
243 *      variable, or the Tcl variable may be overwritten to reject a
244 *      modification.
245 *
246 *----------------------------------------------------------------------
247 */
248
249static char *
250LinkTraceProc(
251    ClientData clientData,      /* Contains information about the link. */
252    Tcl_Interp *interp,         /* Interpreter containing Tcl variable. */
253    CONST char *name1,          /* First part of variable name. */
254    CONST char *name2,          /* Second part of variable name. */
255    int flags)                  /* Miscellaneous additional information. */
256{
257    Link *linkPtr = (Link *) clientData;
258    int changed, valueLength;
259    CONST char *value;
260    char **pp;
261    Tcl_Obj *valueObj;
262    int valueInt;
263    Tcl_WideInt valueWide;
264    double valueDouble;
265
266    /*
267     * If the variable is being unset, then just re-create it (with a trace)
268     * unless the whole interpreter is going away.
269     */
270
271    if (flags & TCL_TRACE_UNSETS) {
272        if (Tcl_InterpDeleted(interp)) {
273            Tcl_DecrRefCount(linkPtr->varName);
274            ckfree((char *) linkPtr);
275        } else if (flags & TCL_TRACE_DESTROYED) {
276            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
277                    TCL_GLOBAL_ONLY);
278            Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
279                    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
280                    |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
281        }
282        return NULL;
283    }
284
285    /*
286     * If we were invoked because of a call to Tcl_UpdateLinkedVar, then don't
287     * do anything at all. In particular, we don't want to get upset that the
288     * variable is being modified, even if it is supposed to be read-only.
289     */
290
291    if (linkPtr->flags & LINK_BEING_UPDATED) {
292        return NULL;
293    }
294
295    /*
296     * For read accesses, update the Tcl variable if the C variable has
297     * changed since the last time we updated the Tcl variable.
298     */
299
300    if (flags & TCL_TRACE_READS) {
301        switch (linkPtr->type) {
302        case TCL_LINK_INT:
303        case TCL_LINK_BOOLEAN:
304            changed = (LinkedVar(int) != linkPtr->lastValue.i);
305            break;
306        case TCL_LINK_DOUBLE:
307            changed = (LinkedVar(double) != linkPtr->lastValue.d);
308            break;
309        case TCL_LINK_WIDE_INT:
310            changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
311            break;
312        case TCL_LINK_WIDE_UINT:
313            changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
314            break;
315        case TCL_LINK_CHAR:
316            changed = (LinkedVar(char) != linkPtr->lastValue.c);
317            break;
318        case TCL_LINK_UCHAR:
319            changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
320            break;
321        case TCL_LINK_SHORT:
322            changed = (LinkedVar(short) != linkPtr->lastValue.s);
323            break;
324        case TCL_LINK_USHORT:
325            changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
326            break;
327        case TCL_LINK_UINT:
328            changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
329            break;
330        case TCL_LINK_LONG:
331            changed = (LinkedVar(long) != linkPtr->lastValue.l);
332            break;
333        case TCL_LINK_ULONG:
334            changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
335            break;
336        case TCL_LINK_FLOAT:
337            changed = (LinkedVar(float) != linkPtr->lastValue.f);
338            break;
339        case TCL_LINK_STRING:
340            changed = 1;
341            break;
342        default:
343            return "internal error: bad linked variable type";
344        }
345        if (changed) {
346            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
347                    TCL_GLOBAL_ONLY);
348        }
349        return NULL;
350    }
351
352    /*
353     * For writes, first make sure that the variable is writable. Then convert
354     * the Tcl value to C if possible. If the variable isn't writable or can't
355     * be converted, then restore the varaible's old value and return an
356     * error. Another tricky thing: we have to save and restore the interp's
357     * result, since the variable access could occur when the result has been
358     * partially set.
359     */
360
361    if (linkPtr->flags & LINK_READ_ONLY) {
362        Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
363                TCL_GLOBAL_ONLY);
364        return "linked variable is read-only";
365    }
366    valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
367    if (valueObj == NULL) {
368        /*
369         * This shouldn't ever happen.
370         */
371
372        return "internal error: linked variable couldn't be read";
373    }
374
375    switch (linkPtr->type) {
376    case TCL_LINK_INT:
377        if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
378                != TCL_OK) {
379            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
380                    TCL_GLOBAL_ONLY);
381            return "variable must have integer value";
382        }
383        LinkedVar(int) = linkPtr->lastValue.i;
384        break;
385
386    case TCL_LINK_WIDE_INT:
387        if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
388                != TCL_OK) {
389            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
390                    TCL_GLOBAL_ONLY);
391            return "variable must have integer value";
392        }
393        LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
394        break;
395
396    case TCL_LINK_DOUBLE:
397        if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
398                != TCL_OK) {
399#ifdef ACCEPT_NAN
400            if (valueObj->typePtr != &tclDoubleType) {
401#endif
402                Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
403                        ObjValue(linkPtr), TCL_GLOBAL_ONLY);
404                return "variable must have real value";
405#ifdef ACCEPT_NAN
406            }
407            linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
408#endif
409        }
410        LinkedVar(double) = linkPtr->lastValue.d;
411        break;
412
413    case TCL_LINK_BOOLEAN:
414        if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
415                != TCL_OK) {
416            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
417                    TCL_GLOBAL_ONLY);
418            return "variable must have boolean value";
419        }
420        LinkedVar(int) = linkPtr->lastValue.i;
421        break;
422
423    case TCL_LINK_CHAR:
424        if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
425                || valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
426            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
427                    TCL_GLOBAL_ONLY);
428            return "variable must have char value";
429        }
430        linkPtr->lastValue.c = (char)valueInt;
431        LinkedVar(char) = linkPtr->lastValue.c;
432        break;
433
434    case TCL_LINK_UCHAR:
435        if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
436                || valueInt < 0 || valueInt > UCHAR_MAX) {
437            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
438                    TCL_GLOBAL_ONLY);
439            return "variable must have unsigned char value";
440        }
441        linkPtr->lastValue.uc = (unsigned char) valueInt;
442        LinkedVar(unsigned char) = linkPtr->lastValue.uc;
443        break;
444
445    case TCL_LINK_SHORT:
446        if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
447                || valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
448            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
449                    TCL_GLOBAL_ONLY);
450            return "variable must have short value";
451        }
452        linkPtr->lastValue.s = (short)valueInt;
453        LinkedVar(short) = linkPtr->lastValue.s;
454        break;
455
456    case TCL_LINK_USHORT:
457        if (Tcl_GetIntFromObj(interp, valueObj, &valueInt) != TCL_OK
458                || valueInt < 0 || valueInt > USHRT_MAX) {
459            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
460                    TCL_GLOBAL_ONLY);
461            return "variable must have unsigned short value";
462        }
463        linkPtr->lastValue.us = (unsigned short)valueInt;
464        LinkedVar(unsigned short) = linkPtr->lastValue.us;
465        break;
466
467    case TCL_LINK_UINT:
468        if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
469                || valueWide < 0 || valueWide > UINT_MAX) {
470            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
471                    TCL_GLOBAL_ONLY);
472            return "variable must have unsigned int value";
473        }
474        linkPtr->lastValue.ui = (unsigned int)valueWide;
475        LinkedVar(unsigned int) = linkPtr->lastValue.ui;
476        break;
477
478    case TCL_LINK_LONG:
479        if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
480                || valueWide < LONG_MIN || valueWide > LONG_MAX) {
481            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
482                    TCL_GLOBAL_ONLY);
483            return "variable must have long value";
484        }
485        linkPtr->lastValue.l = (long)valueWide;
486        LinkedVar(long) = linkPtr->lastValue.l;
487        break;
488
489    case TCL_LINK_ULONG:
490        if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK
491                || valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
492            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
493                    TCL_GLOBAL_ONLY);
494            return "variable must have unsigned long value";
495        }
496        linkPtr->lastValue.ul = (unsigned long)valueWide;
497        LinkedVar(unsigned long) = linkPtr->lastValue.ul;
498        break;
499
500    case TCL_LINK_WIDE_UINT:
501        /*
502         * FIXME: represent as a bignum.
503         */
504        if (Tcl_GetWideIntFromObj(interp, valueObj, &valueWide) != TCL_OK) {
505            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
506                    TCL_GLOBAL_ONLY);
507            return "variable must have unsigned wide int value";
508        }
509        linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
510        LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
511        break;
512
513    case TCL_LINK_FLOAT:
514        if (Tcl_GetDoubleFromObj(interp, valueObj, &valueDouble) != TCL_OK
515                || valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
516            Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
517                    TCL_GLOBAL_ONLY);
518            return "variable must have float value";
519        }
520        linkPtr->lastValue.f = (float)valueDouble;
521        LinkedVar(float) = linkPtr->lastValue.f;
522        break;
523
524    case TCL_LINK_STRING:
525        value = Tcl_GetStringFromObj(valueObj, &valueLength);
526        valueLength++;
527        pp = (char **) linkPtr->addr;
528
529        *pp = ckrealloc(*pp, valueLength);
530        memcpy(*pp, value, (unsigned) valueLength);
531        break;
532
533    default:
534        return "internal error: bad linked variable type";
535    }
536    return NULL;
537}
538
539/*
540 *----------------------------------------------------------------------
541 *
542 * ObjValue --
543 *
544 *      Converts the value of a C variable to a Tcl_Obj* for use in a Tcl
545 *      variable to which it is linked.
546 *
547 * Results:
548 *      The return value is a pointer to a Tcl_Obj that represents the value
549 *      of the C variable given by linkPtr.
550 *
551 * Side effects:
552 *      None.
553 *
554 *----------------------------------------------------------------------
555 */
556
557static Tcl_Obj *
558ObjValue(
559    Link *linkPtr)              /* Structure describing linked variable. */
560{
561    char *p;
562    Tcl_Obj *resultObj;
563
564    switch (linkPtr->type) {
565    case TCL_LINK_INT:
566        linkPtr->lastValue.i = LinkedVar(int);
567        return Tcl_NewIntObj(linkPtr->lastValue.i);
568    case TCL_LINK_WIDE_INT:
569        linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
570        return Tcl_NewWideIntObj(linkPtr->lastValue.w);
571    case TCL_LINK_DOUBLE:
572        linkPtr->lastValue.d = LinkedVar(double);
573        return Tcl_NewDoubleObj(linkPtr->lastValue.d);
574    case TCL_LINK_BOOLEAN:
575        linkPtr->lastValue.i = LinkedVar(int);
576        return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
577    case TCL_LINK_CHAR:
578        linkPtr->lastValue.c = LinkedVar(char);
579        return Tcl_NewIntObj(linkPtr->lastValue.c);
580    case TCL_LINK_UCHAR:
581        linkPtr->lastValue.uc = LinkedVar(unsigned char);
582        return Tcl_NewIntObj(linkPtr->lastValue.uc);
583    case TCL_LINK_SHORT:
584        linkPtr->lastValue.s = LinkedVar(short);
585        return Tcl_NewIntObj(linkPtr->lastValue.s);
586    case TCL_LINK_USHORT:
587        linkPtr->lastValue.us = LinkedVar(unsigned short);
588        return Tcl_NewIntObj(linkPtr->lastValue.us);
589    case TCL_LINK_UINT:
590        linkPtr->lastValue.ui = LinkedVar(unsigned int);
591        return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
592    case TCL_LINK_LONG:
593        linkPtr->lastValue.l = LinkedVar(long);
594        return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
595    case TCL_LINK_ULONG:
596        linkPtr->lastValue.ul = LinkedVar(unsigned long);
597        return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
598    case TCL_LINK_FLOAT:
599        linkPtr->lastValue.f = LinkedVar(float);
600        return Tcl_NewDoubleObj(linkPtr->lastValue.f);
601    case TCL_LINK_WIDE_UINT:
602        linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
603        /*
604         * FIXME: represent as a bignum.
605         */
606        return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);
607    case TCL_LINK_STRING:
608        p = LinkedVar(char *);
609        if (p == NULL) {
610            TclNewLiteralStringObj(resultObj, "NULL");
611            return resultObj;
612        }
613        return Tcl_NewStringObj(p, -1);
614
615    /*
616     * This code only gets executed if the link type is unknown (shouldn't
617     * ever happen).
618     */
619
620    default:
621        TclNewLiteralStringObj(resultObj, "??");
622        return resultObj;
623    }
624}
625
626/*
627 * Local Variables:
628 * mode: c
629 * c-basic-offset: 4
630 * fill-column: 78
631 * End:
632 */
Note: See TracBrowser for help on using the repository browser.