Return to tclvar.c CVS log

Up to [Micropolis - Activity] / micropolis / src / tcl

Annotation of micropolis/src/tcl/tclvar.c, revision 1.1

1.1     ! root        1: /* 
        !             2:  * tclVar.c --
        !             3:  *
        !             4:  *     This file contains routines that implement Tcl variables
        !             5:  *     (both scalars and arrays).
        !             6:  *
        !             7:  *     The implementation of arrays is modelled after an initial
        !             8:  *     implementation by Karl Lehenbauer, Mark Diekhans and
        !             9:  *     Peter da Silva.
        !            10:  *
        !            11:  * Copyright 1987-1991 Regents of the University of California
        !            12:  * Permission to use, copy, modify, and distribute this
        !            13:  * software and its documentation for any purpose and without
        !            14:  * fee is hereby granted, provided that the above copyright
        !            15:  * notice appear in all copies.  The University of California
        !            16:  * makes no representations about the suitability of this
        !            17:  * software for any purpose.  It is provided "as is" without
        !            18:  * express or implied warranty.
        !            19:  */
        !            20: 
        !            21: #ifndef lint
        !            22: static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclVar.c,v 1.27 92/05/07 09:24:59 ouster Exp $ SPRITE (Berkeley)";
        !            23: #endif
        !            24: 
        !            25: #include "tclint.h"
        !            26: 
        !            27: /*
        !            28:  * The strings below are used to indicate what went wrong when a
        !            29:  * variable access is denied.
        !            30:  */
        !            31: 
        !            32: static char *noSuchVar =       "no such variable";
        !            33: static char *isArray =         "variable is array";
        !            34: static char *needArray =       "variable isn't array";
        !            35: static char *noSuchElement =   "no such element in array";
        !            36: static char *traceActive =     "trace is active on variable";
        !            37: 
        !            38: /*
        !            39:  * Forward references to procedures defined later in this file:
        !            40:  */
        !            41: 
        !            42: static  char *         CallTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
        !            43:                            Tcl_HashEntry *hPtr, char *name1, char *name2,
        !            44:                            int flags));
        !            45: static void            DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
        !            46: static void            DeleteArray _ANSI_ARGS_((Interp *iPtr, char *arrayName,
        !            47:                            Var *varPtr, int flags));
        !            48: static Var *           NewVar _ANSI_ARGS_((int space));
        !            49: static ArraySearch *   ParseSearchId _ANSI_ARGS_((Tcl_Interp *interp,
        !            50:                            Var *varPtr, char *varName, char *string));
        !            51: static void            VarErrMsg _ANSI_ARGS_((Tcl_Interp *interp,
        !            52:                            char *name1, char *name2, char *operation,
        !            53:                            char *reason));
        !            54: 
        !            55: /*
        !            56:  *----------------------------------------------------------------------
        !            57:  *
        !            58:  * Tcl_GetVar --
        !            59:  *
        !            60:  *     Return the value of a Tcl variable.
        !            61:  *
        !            62:  * Results:
        !            63:  *     The return value points to the current value of varName.  If
        !            64:  *     the variable is not defined or can't be read because of a clash
        !            65:  *     in array usage then a NULL pointer is returned and an error
        !            66:  *     message is left in interp->result if the TCL_LEAVE_ERR_MSG
        !            67:  *     flag is set.  Note:  the return value is only valid up until
        !            68:  *     the next call to Tcl_SetVar or Tcl_SetVar2;  if you depend on
        !            69:  *     the value lasting longer than that, then make yourself a private
        !            70:  *     copy.
        !            71:  *
        !            72:  * Side effects:
        !            73:  *     None.
        !            74:  *
        !            75:  *----------------------------------------------------------------------
        !            76:  */
        !            77: 
        !            78: char *
        !            79: Tcl_GetVar(interp, varName, flags)
        !            80:     Tcl_Interp *interp;                /* Command interpreter in which varName is
        !            81:                                 * to be looked up. */
        !            82:     char *varName;             /* Name of a variable in interp. */
        !            83:     int flags;                 /* OR-ed combination of TCL_GLOBAL_ONLY
        !            84:                                 * or TCL_LEAVE_ERR_MSG bits. */
        !            85: {
        !            86:     register char *p;
        !            87: 
        !            88:     /*
        !            89:      * If varName refers to an array (it ends with a parenthesized
        !            90:      * element name), then handle it specially.
        !            91:      */
        !            92: 
        !            93:     for (p = varName; *p != '\0'; p++) {
        !            94:        if (*p == '(') {
        !            95:            char *result;
        !            96:            char *open = p;
        !            97: 
        !            98:            do {
        !            99:                p++;
        !           100:            } while (*p != '\0');
        !           101:            p--;
        !           102:            if (*p != ')') {
        !           103:                goto scalar;
        !           104:            }
        !           105:            *open = '\0';
        !           106:            *p = '\0';
        !           107:            result = Tcl_GetVar2(interp, varName, open + 1, flags);
        !           108:            *open = '(';
        !           109:            *p = ')';
        !           110: #ifdef sgi
        !           111:            strcmp("a", "b"); /* XXX SGI compiler optimizer bug */
        !           112: #endif
        !           113:            return result;
        !           114:        }
        !           115:     }
        !           116: 
        !           117:     scalar:
        !           118:     return Tcl_GetVar2(interp, varName, (char *) NULL, flags);
        !           119: }
        !           120: 
        !           121: /*
        !           122:  *----------------------------------------------------------------------
        !           123:  *
        !           124:  * Tcl_GetVar2 --
        !           125:  *
        !           126:  *     Return the value of a Tcl variable, given a two-part name
        !           127:  *     consisting of array name and element within array.
        !           128:  *
        !           129:  * Results:
        !           130:  *     The return value points to the current value of the variable
        !           131:  *     given by name1 and name2.  If the specified variable doesn't
        !           132:  *     exist, or if there is a clash in array usage, then NULL is
        !           133:  *     returned and a message will be left in interp->result if the
        !           134:  *     TCL_LEAVE_ERR_MSG flag is set.  Note:  the return value is
        !           135:  *     only valid up until the next call to Tcl_SetVar or Tcl_SetVar2;
        !           136:  *     if you depend on the value lasting longer than that, then make
        !           137:  *     yourself a private copy.
        !           138:  *
        !           139:  * Side effects:
        !           140:  *     None.
        !           141:  *
        !           142:  *----------------------------------------------------------------------
        !           143:  */
        !           144: 
        !           145: char *
        !           146: Tcl_GetVar2(interp, name1, name2, flags)
        !           147:     Tcl_Interp *interp;                /* Command interpreter in which variable is
        !           148:                                 * to be looked up. */
        !           149:     char *name1;               /* Name of array (if name2 is NULL) or
        !           150:                                 * name of variable. */
        !           151:     char *name2;               /* If non-null, gives name of element in
        !           152:                                 * array. */
        !           153:     int flags;                 /* OR-ed combination of TCL_GLOBAL_ONLY
        !           154:                                 * or TCL_LEAVE_ERR_MSG bits. */
        !           155: {
        !           156:     Tcl_HashEntry *hPtr;
        !           157:     Var *varPtr;
        !           158:     Interp *iPtr = (Interp *) interp;
        !           159:     Var *arrayPtr = NULL;
        !           160: 
        !           161:     /*
        !           162:      * Lookup the first name.
        !           163:      */
        !           164: 
        !           165:     if ((flags & TCL_GLOBAL_ONLY) || (iPtr->varFramePtr == NULL)) {
        !           166:        hPtr = Tcl_FindHashEntry(&iPtr->globalTable, name1);
        !           167:     } else {
        !           168:        hPtr = Tcl_FindHashEntry(&iPtr->varFramePtr->varTable, name1);
        !           169:     }
        !           170:     if (hPtr == NULL) {
        !           171:        if (flags & TCL_LEAVE_ERR_MSG) {
        !           172:            VarErrMsg(interp, name1, name2, "read", noSuchVar);
        !           173:        }
        !           174:        return NULL;
        !           175:     }
        !           176:     varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           177:     if (varPtr->flags & VAR_UPVAR) {
        !           178:        hPtr = varPtr->value.upvarPtr;
        !           179:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           180:     }
        !           181: 
        !           182:     /*
        !           183:      * If this is an array reference, then remember the traces on the array
        !           184:      * and lookup the element within the array.
        !           185:      */
        !           186: 
        !           187:     if (name2 != NULL) {
        !           188:        if (varPtr->flags & VAR_UNDEFINED) {
        !           189:            if (flags & TCL_LEAVE_ERR_MSG) {
        !           190:                VarErrMsg(interp, name1, name2, "read", noSuchVar);
        !           191:            }
        !           192:            return NULL;
        !           193:        } else if (!(varPtr->flags & VAR_ARRAY)) {
        !           194:            if (flags & TCL_LEAVE_ERR_MSG) {
        !           195:                VarErrMsg(interp, name1, name2, "read", needArray);
        !           196:            }
        !           197:            return NULL;
        !           198:        }
        !           199:        arrayPtr = varPtr;
        !           200:        hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, name2);
        !           201:        if (hPtr == NULL) {
        !           202:            if (flags & TCL_LEAVE_ERR_MSG) {
        !           203:                VarErrMsg(interp, name1, name2, "read", noSuchElement);
        !           204:            }
        !           205:            return NULL;
        !           206:        }
        !           207:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           208:     }
        !           209: 
        !           210:     /*
        !           211:      * Invoke any traces that have been set for the variable.
        !           212:      */
        !           213: 
        !           214:     if ((varPtr->tracePtr != NULL)
        !           215:            || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
        !           216:        char *msg;
        !           217: 
        !           218:        msg = CallTraces(iPtr, arrayPtr, hPtr, name1, name2,
        !           219:                (flags & TCL_GLOBAL_ONLY) | TCL_TRACE_READS);
        !           220:        if (msg != NULL) {
        !           221:            VarErrMsg(interp, name1, name2, "read", msg);
        !           222:            return NULL;
        !           223:        }
        !           224: 
        !           225:        /*
        !           226:         * Watch out!  The variable could have gotten re-allocated to
        !           227:         * a larger size.  Fortunately the hash table entry will still
        !           228:         * be around.
        !           229:         */
        !           230: 
        !           231:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           232:     }
        !           233:     if (varPtr->flags & (VAR_UNDEFINED|VAR_UPVAR|VAR_ARRAY)) {
        !           234:        if (flags & TCL_LEAVE_ERR_MSG) {
        !           235:            VarErrMsg(interp, name1, name2, "read", noSuchVar);
        !           236:        }
        !           237:        return NULL;
        !           238:     }
        !           239:     return varPtr->value.string;
        !           240: }
        !           241: 
        !           242: /*
        !           243:  *----------------------------------------------------------------------
        !           244:  *
        !           245:  * Tcl_SetVar --
        !           246:  *
        !           247:  *     Change the value of a variable.
        !           248:  *
        !           249:  * Results:
        !           250:  *     Returns a pointer to the malloc'ed string holding the new
        !           251:  *     value of the variable.  The caller should not modify this
        !           252:  *     string.  If the write operation was disallowed then NULL
        !           253:  *     is returned;  if the TCL_LEAVE_ERR_MSG flag is set, then
        !           254:  *     an explanatory message will be left in interp->result.
        !           255:  *
        !           256:  * Side effects:
        !           257:  *     If varName is defined as a local or global variable in interp,
        !           258:  *     its value is changed to newValue.  If varName isn't currently
        !           259:  *     defined, then a new global variable by that name is created.
        !           260:  *
        !           261:  *----------------------------------------------------------------------
        !           262:  */
        !           263: 
        !           264: char *
        !           265: Tcl_SetVar(interp, varName, newValue, flags)
        !           266:     Tcl_Interp *interp;                /* Command interpreter in which varName is
        !           267:                                 * to be looked up. */
        !           268:     char *varName;             /* Name of a variable in interp. */
        !           269:     char *newValue;            /* New value for varName. */
        !           270:     int flags;                 /* Various flags that tell how to set value:
        !           271:                                 * any of TCL_GLOBAL_ONLY, TCL_APPEND_VALUE,
        !           272:                                 * TCL_LIST_ELEMENT, TCL_NO_SPACE, or
        !           273:                                 * TCL_LEAVE_ERR_MSG. */
        !           274: {
        !           275:     register char *p;
        !           276: 
        !           277:     /*
        !           278:      * If varName refers to an array (it ends with a parenthesized
        !           279:      * element name), then handle it specially.
        !           280:      */
        !           281: 
        !           282:     for (p = varName; *p != '\0'; p++) {
        !           283:        if (*p == '(') {
        !           284:            char *result;
        !           285:            char *open = p;
        !           286: 
        !           287:            do {
        !           288:                p++;
        !           289:            } while (*p != '\0');
        !           290:            p--;
        !           291:            if (*p != ')') {
        !           292:                goto scalar;
        !           293:            }
        !           294:            *open = '\0';
        !           295:            *p = '\0';
        !           296:            result = Tcl_SetVar2(interp, varName, open+1, newValue, flags);
        !           297:            *open = '(';
        !           298:            *p = ')';
        !           299:            return result;
        !           300:        }
        !           301:     }
        !           302: 
        !           303:     scalar:
        !           304:     return Tcl_SetVar2(interp, varName, (char *) NULL, newValue, flags);
        !           305: }
        !           306: 
        !           307: /*
        !           308:  *----------------------------------------------------------------------
        !           309:  *
        !           310:  * Tcl_SetVar2 --
        !           311:  *
        !           312:  *     Given a two-part variable name, which may refer either to a
        !           313:  *     scalar variable or an element of an array, change the value
        !           314:  *     of the variable.  If the named scalar or array or element
        !           315:  *     doesn't exist then create one.
        !           316:  *
        !           317:  * Results:
        !           318:  *     Returns a pointer to the malloc'ed string holding the new
        !           319:  *     value of the variable.  The caller should not modify this
        !           320:  *     string.  If the write operation was disallowed because an
        !           321:  *     array was expected but not found (or vice versa), then NULL
        !           322:  *     is returned;  if the TCL_LEAVE_ERR_MSG flag is set, then
        !           323:  *     an explanatory message will be left in interp->result.
        !           324:  *
        !           325:  * Side effects:
        !           326:  *     The value of the given variable is set.  If either the array
        !           327:  *     or the entry didn't exist then a new one is created.
        !           328:  *
        !           329:  *----------------------------------------------------------------------
        !           330:  */
        !           331: 
        !           332: char *
        !           333: Tcl_SetVar2(interp, name1, name2, newValue, flags)
        !           334:     Tcl_Interp *interp;                /* Command interpreter in which variable is
        !           335:                                 * to be looked up. */
        !           336:     char *name1;               /* If name2 is NULL, this is name of scalar
        !           337:                                 * variable.  Otherwise it is name of array. */
        !           338:     char *name2;               /* Name of an element within array, or NULL. */
        !           339:     char *newValue;            /* New value for variable. */
        !           340:     int flags;                 /* Various flags that tell how to set value:
        !           341:                                 * any of TCL_GLOBAL_ONLY, TCL_APPEND_VALUE,
        !           342:                                 * TCL_LIST_ELEMENT, and TCL_NO_SPACE, or
        !           343:                                 * TCL_LEAVE_ERR_MSG . */
        !           344: {
        !           345:     Tcl_HashEntry *hPtr;
        !           346:     register Var *varPtr = NULL;
        !           347:                                /* Initial value only used to stop compiler
        !           348:                                 * from complaining; not really needed. */
        !           349:     register Interp *iPtr = (Interp *) interp;
        !           350:     int length, new, listFlags;
        !           351:     Var *arrayPtr = NULL;
        !           352: 
        !           353:     /*
        !           354:      * Lookup the first name.
        !           355:      */
        !           356: 
        !           357:     if ((flags & TCL_GLOBAL_ONLY) || (iPtr->varFramePtr == NULL)) {
        !           358:        hPtr = Tcl_CreateHashEntry(&iPtr->globalTable, name1, &new);
        !           359:     } else {
        !           360:        hPtr = Tcl_CreateHashEntry(&iPtr->varFramePtr->varTable,
        !           361:                name1, &new);
        !           362:     }
        !           363:     if (!new) {
        !           364:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           365:        if (varPtr->flags & VAR_UPVAR) {
        !           366:            hPtr = varPtr->value.upvarPtr;
        !           367:            varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           368:        }
        !           369:     }
        !           370: 
        !           371:     /*
        !           372:      * If this is an array reference, then create a new array (if
        !           373:      * needed), remember any traces on the array, and lookup the
        !           374:      * element within the array.
        !           375:      */
        !           376: 
        !           377:     if (name2 != NULL) {
        !           378:        if (new) {
        !           379:            varPtr = NewVar(0);
        !           380:            Tcl_SetHashValue(hPtr, varPtr);
        !           381:            varPtr->flags = VAR_ARRAY;
        !           382:            varPtr->value.tablePtr = (Tcl_HashTable *)
        !           383:                    ckalloc(sizeof(Tcl_HashTable));
        !           384:            Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
        !           385:        } else {
        !           386:            if (varPtr->flags & VAR_UNDEFINED) {
        !           387:                varPtr->flags = VAR_ARRAY;
        !           388:                varPtr->value.tablePtr = (Tcl_HashTable *)
        !           389:                        ckalloc(sizeof(Tcl_HashTable));
        !           390:                Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
        !           391:            } else if (!(varPtr->flags & VAR_ARRAY)) {
        !           392:                if (flags & TCL_LEAVE_ERR_MSG) {
        !           393:                    VarErrMsg(interp, name1, name2, "set", needArray);
        !           394:                }
        !           395:                return NULL;
        !           396:            }
        !           397:            arrayPtr = varPtr;
        !           398:        }
        !           399:        hPtr = Tcl_CreateHashEntry(varPtr->value.tablePtr, name2, &new);
        !           400:     }
        !           401: 
        !           402:     /*
        !           403:      * Compute how many bytes will be needed for newValue (leave space
        !           404:      * for a separating space between list elements).
        !           405:      */
        !           406: 
        !           407:     if (flags & TCL_LIST_ELEMENT) {
        !           408:        length = Tcl_ScanElement(newValue, &listFlags) + 1;
        !           409:     } else {
        !           410:        length = strlen(newValue);
        !           411:     }
        !           412: 
        !           413:     /*
        !           414:      * If the variable doesn't exist then create a new one.  If it
        !           415:      * does exist then clear its current value unless this is an
        !           416:      * append operation.
        !           417:      */
        !           418: 
        !           419:     if (new) {
        !           420:        varPtr = NewVar(length);
        !           421:        Tcl_SetHashValue(hPtr, varPtr);
        !           422:        if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
        !           423:            DeleteSearches(arrayPtr);
        !           424:        }
        !           425:     } else {
        !           426:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           427:        if (varPtr->flags & VAR_ARRAY) {
        !           428:            if (flags & TCL_LEAVE_ERR_MSG) {
        !           429:                VarErrMsg(interp, name1, name2, "set", isArray);
        !           430:            }
        !           431:            return NULL;
        !           432:        }
        !           433:        if (!(flags & TCL_APPEND_VALUE) || (varPtr->flags & VAR_UNDEFINED)) {
        !           434:            varPtr->valueLength = 0;
        !           435:        }
        !           436:     }
        !           437: 
        !           438:     /*
        !           439:      * Make sure there's enough space to hold the variable's
        !           440:      * new value.  If not, enlarge the variable's space.
        !           441:      */
        !           442: 
        !           443:     if ((length + varPtr->valueLength) >= varPtr->valueSpace) {
        !           444:        Var *newVarPtr;
        !           445:        int newSize;
        !           446: 
        !           447:        newSize = 2*varPtr->valueSpace;
        !           448:        if (newSize <= (length + varPtr->valueLength)) {
        !           449:            newSize += length;
        !           450:        }
        !           451:        newVarPtr = NewVar(newSize);
        !           452:        newVarPtr->valueLength = varPtr->valueLength;
        !           453:        newVarPtr->upvarUses = varPtr->upvarUses;
        !           454:        newVarPtr->tracePtr = varPtr->tracePtr;
        !           455:        strcpy(newVarPtr->value.string, varPtr->value.string);
        !           456:        Tcl_SetHashValue(hPtr, newVarPtr);
        !           457:        ckfree((char *) varPtr);
        !           458:        varPtr = newVarPtr;
        !           459:     }
        !           460: 
        !           461:     /*
        !           462:      * Append the new value to the variable, either as a list
        !           463:      * element or as a string.
        !           464:      */
        !           465: 
        !           466:     if (flags & TCL_LIST_ELEMENT) {
        !           467:        if ((varPtr->valueLength > 0) && !(flags & TCL_NO_SPACE)) {
        !           468:            varPtr->value.string[varPtr->valueLength] = ' ';
        !           469:            varPtr->valueLength++;
        !           470:        }
        !           471:        varPtr->valueLength += Tcl_ConvertElement(newValue,
        !           472:                varPtr->value.string + varPtr->valueLength, listFlags);
        !           473:        varPtr->value.string[varPtr->valueLength] = 0;
        !           474:     } else {
        !           475:        strcpy(varPtr->value.string + varPtr->valueLength, newValue);
        !           476:        varPtr->valueLength += length;
        !           477:     }
        !           478:     varPtr->flags &= ~VAR_UNDEFINED;
        !           479: 
        !           480:     /*
        !           481:      * Invoke any write traces for the variable.
        !           482:      */
        !           483: 
        !           484:     if ((varPtr->tracePtr != NULL)
        !           485:            || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
        !           486:        char *msg;
        !           487: 
        !           488:        msg = CallTraces(iPtr, arrayPtr, hPtr, name1, name2,
        !           489:                (flags & TCL_GLOBAL_ONLY) | TCL_TRACE_WRITES);
        !           490:        if (msg != NULL) {
        !           491:            VarErrMsg(interp, name1, name2, "set", msg);
        !           492:            return NULL;
        !           493:        }
        !           494: 
        !           495:        /*
        !           496:         * Watch out!  The variable could have gotten re-allocated to
        !           497:         * a larger size.  Fortunately the hash table entry will still
        !           498:         * be around.
        !           499:         */
        !           500: 
        !           501:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           502:     }
        !           503:     return varPtr->value.string;
        !           504: }
        !           505: 
        !           506: /*
        !           507:  *----------------------------------------------------------------------
        !           508:  *
        !           509:  * Tcl_UnsetVar --
        !           510:  *
        !           511:  *     Delete a variable, so that it may not be accessed anymore.
        !           512:  *
        !           513:  * Results:
        !           514:  *     Returns 0 if the variable was successfully deleted, -1
        !           515:  *     if the variable can't be unset.  In the event of an error,
        !           516:  *     if the TCL_LEAVE_ERR_MSG flag is set then an error message
        !           517:  *     is left in interp->result.
        !           518:  *
        !           519:  * Side effects:
        !           520:  *     If varName is defined as a local or global variable in interp,
        !           521:  *     it is deleted.
        !           522:  *
        !           523:  *----------------------------------------------------------------------
        !           524:  */
        !           525: 
        !           526: int
        !           527: Tcl_UnsetVar(interp, varName, flags)
        !           528:     Tcl_Interp *interp;                /* Command interpreter in which varName is
        !           529:                                 * to be looked up. */
        !           530:     char *varName;             /* Name of a variable in interp.  May be
        !           531:                                 * either a scalar name or an array name
        !           532:                                 * or an element in an array. */
        !           533:     int flags;                 /* OR-ed combination of any of
        !           534:                                 * TCL_GLOBAL_ONLY or TCL_LEAVE_ERR_MSG. */
        !           535: {
        !           536:     register char *p;
        !           537:     int result;
        !           538: 
        !           539:     /*
        !           540:      * Figure out whether this is an array reference, then call
        !           541:      * Tcl_UnsetVar2 to do all the real work.
        !           542:      */
        !           543: 
        !           544:     for (p = varName; *p != '\0'; p++) {
        !           545:        if (*p == '(') {
        !           546:            char *open = p;
        !           547: 
        !           548:            do {
        !           549:                p++;
        !           550:            } while (*p != '\0');
        !           551:            p--;
        !           552:            if (*p != ')') {
        !           553:                goto scalar;
        !           554:            }
        !           555:            *open = '\0';
        !           556:            *p = '\0';
        !           557:            result = Tcl_UnsetVar2(interp, varName, open+1, flags);
        !           558:            *open = '(';
        !           559:            *p = ')';
        !           560:            return result;
        !           561:        }
        !           562:     }
        !           563: 
        !           564:     scalar:
        !           565:     return Tcl_UnsetVar2(interp, varName, (char *) NULL, flags);
        !           566: }
        !           567: 
        !           568: /*
        !           569:  *----------------------------------------------------------------------
        !           570:  *
        !           571:  * Tcl_UnsetVar2 --
        !           572:  *
        !           573:  *     Delete a variable, given a 2-part name.
        !           574:  *
        !           575:  * Results:
        !           576:  *     Returns 0 if the variable was successfully deleted, -1
        !           577:  *     if the variable can't be unset.  In the event of an error,
        !           578:  *     if the TCL_LEAVE_ERR_MSG flag is set then an error message
        !           579:  *     is left in interp->result.
        !           580:  *
        !           581:  * Side effects:
        !           582:  *     If name1 and name2 indicate a local or global variable in interp,
        !           583:  *     it is deleted.  If name1 is an array name and name2 is NULL, then
        !           584:  *     the whole array is deleted.
        !           585:  *
        !           586:  *----------------------------------------------------------------------
        !           587:  */
        !           588: 
        !           589: int
        !           590: Tcl_UnsetVar2(interp, name1, name2, flags)
        !           591:     Tcl_Interp *interp;                /* Command interpreter in which varName is
        !           592:                                 * to be looked up. */
        !           593:     char *name1;               /* Name of variable or array. */
        !           594:     char *name2;               /* Name of element within array or NULL. */
        !           595:     int flags;                 /* OR-ed combination of any of
        !           596:                                 * TCL_GLOBAL_ONLY or TCL_LEAVE_ERR_MSG. */
        !           597: {
        !           598:     Tcl_HashEntry *hPtr, dummyEntry;
        !           599:     Var *varPtr, dummyVar;
        !           600:     Interp *iPtr = (Interp *) interp;
        !           601:     Var *arrayPtr = NULL;
        !           602: 
        !           603:     if ((flags & TCL_GLOBAL_ONLY) || (iPtr->varFramePtr == NULL)) {
        !           604:        hPtr = Tcl_FindHashEntry(&iPtr->globalTable, name1);
        !           605:     } else {
        !           606:        hPtr = Tcl_FindHashEntry(&iPtr->varFramePtr->varTable, name1);
        !           607:     }
        !           608:     if (hPtr == NULL) {
        !           609:        if (flags & TCL_LEAVE_ERR_MSG) {
        !           610:            VarErrMsg(interp, name1, name2, "unset", noSuchVar);
        !           611:        }
        !           612:        return -1;
        !           613:     }
        !           614:     varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           615: 
        !           616:     /*
        !           617:      * For global variables referenced in procedures, leave the procedure's
        !           618:      * reference variable in place, but unset the global variable.  Can't
        !           619:      * decrement the actual variable's use count, since we didn't delete
        !           620:      * the reference variable.
        !           621:      */
        !           622: 
        !           623:     if (varPtr->flags & VAR_UPVAR) {
        !           624:        hPtr = varPtr->value.upvarPtr;
        !           625:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           626:     }
        !           627: 
        !           628:     /*
        !           629:      * If the variable being deleted is an element of an array, then
        !           630:      * remember trace procedures on the overall array and find the
        !           631:      * element to delete.
        !           632:      */
        !           633: 
        !           634:     if (name2 != NULL) {
        !           635:        if (!(varPtr->flags & VAR_ARRAY)) {
        !           636:            if (flags & TCL_LEAVE_ERR_MSG) {
        !           637:                VarErrMsg(interp, name1, name2, "unset", needArray);
        !           638:            }
        !           639:            return -1;
        !           640:        }
        !           641:        if (varPtr->searchPtr != NULL) {
        !           642:            DeleteSearches(varPtr);
        !           643:        }
        !           644:        arrayPtr = varPtr;
        !           645:        hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, name2);
        !           646:        if (hPtr == NULL) {
        !           647:            if (flags & TCL_LEAVE_ERR_MSG) {
        !           648:                VarErrMsg(interp, name1, name2, "unset", noSuchElement);
        !           649:            }
        !           650:            return -1;
        !           651:        }
        !           652:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           653:     }
        !           654: 
        !           655:     /*
        !           656:      * If there is a trace active on this variable or if the variable
        !           657:      * is already being deleted then don't delete the variable:  it
        !           658:      * isn't safe, since there are procedures higher up on the stack
        !           659:      * that will use pointers to the variable.  Also don't delete an
        !           660:      * array if there are traces active on any of its elements.
        !           661:      */
        !           662: 
        !           663:     if (varPtr->flags &
        !           664:            (VAR_TRACE_ACTIVE|VAR_ELEMENT_ACTIVE)) {
        !           665:        if (flags & TCL_LEAVE_ERR_MSG) {
        !           666:            VarErrMsg(interp, name1, name2, "unset", traceActive);
        !           667:        }
        !           668:        return -1;
        !           669:     }
        !           670: 
        !           671:     /*
        !           672:      * The code below is tricky, because of the possibility that
        !           673:      * a trace procedure might try to access a variable being
        !           674:      * deleted.  To handle this situation gracefully, copy the
        !           675:      * contents of the variable and its hash table entry to
        !           676:      * dummy variables, then clean up the actual variable so that
        !           677:      * it's been completely deleted before the traces are called.
        !           678:      * Then call the traces, and finally clean up the variable's
        !           679:      * storage using the dummy copies.
        !           680:      */
        !           681: 
        !           682:     dummyVar = *varPtr;
        !           683:     Tcl_SetHashValue(&dummyEntry, &dummyVar);
        !           684:     if (varPtr->upvarUses == 0) {
        !           685:        Tcl_DeleteHashEntry(hPtr);
        !           686:        ckfree((char *) varPtr);
        !           687:     } else {
        !           688:        varPtr->flags = VAR_UNDEFINED;
        !           689:        varPtr->tracePtr = NULL;
        !           690:     }
        !           691: 
        !           692:     /*
        !           693:      * Call trace procedures for the variable being deleted and delete
        !           694:      * its traces.
        !           695:      */
        !           696: 
        !           697:     if ((dummyVar.tracePtr != NULL)
        !           698:            || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
        !           699:        (void) CallTraces(iPtr, arrayPtr, &dummyEntry, name1, name2,
        !           700:                (flags & TCL_GLOBAL_ONLY) | TCL_TRACE_UNSETS);
        !           701:        while (dummyVar.tracePtr != NULL) {
        !           702:            VarTrace *tracePtr = dummyVar.tracePtr;
        !           703:            dummyVar.tracePtr = tracePtr->nextPtr;
        !           704:            ckfree((char *) tracePtr);
        !           705:        }
        !           706:     }
        !           707: 
        !           708:     /*
        !           709:      * If the variable is an array, delete all of its elements.  This
        !           710:      * must be done after calling the traces on the array, above (that's
        !           711:      * the way traces are defined).
        !           712:      */
        !           713: 
        !           714:     if (dummyVar.flags & VAR_ARRAY) {
        !           715:        DeleteArray(iPtr, name1, &dummyVar,
        !           716:            (flags & TCL_GLOBAL_ONLY) | TCL_TRACE_UNSETS);
        !           717:     }
        !           718:     if (dummyVar.flags & VAR_UNDEFINED) {
        !           719:        if (flags & TCL_LEAVE_ERR_MSG) {
        !           720:            VarErrMsg(interp, name1, name2, "unset", 
        !           721:                    (name2 == NULL) ? noSuchVar : noSuchElement);
        !           722:        }
        !           723:        return -1;
        !           724:     }
        !           725:     return 0;
        !           726: }
        !           727: 
        !           728: /*
        !           729:  *----------------------------------------------------------------------
        !           730:  *
        !           731:  * Tcl_TraceVar --
        !           732:  *
        !           733:  *     Arrange for reads and/or writes to a variable to cause a
        !           734:  *     procedure to be invoked, which can monitor the operations
        !           735:  *     and/or change their actions.
        !           736:  *
        !           737:  * Results:
        !           738:  *     A standard Tcl return value.
        !           739:  *
        !           740:  * Side effects:
        !           741:  *     A trace is set up on the variable given by varName, such that
        !           742:  *     future references to the variable will be intermediated by
        !           743:  *     proc.  See the manual entry for complete details on the calling
        !           744:  *     sequence for proc.
        !           745:  *
        !           746:  *----------------------------------------------------------------------
        !           747:  */
        !           748: 
        !           749: int
        !           750: Tcl_TraceVar(interp, varName, flags, proc, clientData)
        !           751:     Tcl_Interp *interp;                /* Interpreter in which variable is
        !           752:                                 * to be traced. */
        !           753:     char *varName;             /* Name of variable;  may end with "(index)"
        !           754:                                 * to signify an array reference. */
        !           755:     int flags;                 /* OR-ed collection of bits, including any
        !           756:                                 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
        !           757:                                 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
        !           758:     Tcl_VarTraceProc *proc;    /* Procedure to call when specified ops are
        !           759:                                 * invoked upon varName. */
        !           760:     ClientData clientData;     /* Arbitrary argument to pass to proc. */
        !           761: {
        !           762:     register char *p;
        !           763: 
        !           764:     /*
        !           765:      * If varName refers to an array (it ends with a parenthesized
        !           766:      * element name), then handle it specially.
        !           767:      */
        !           768: 
        !           769:     for (p = varName; *p != '\0'; p++) {
        !           770:        if (*p == '(') {
        !           771:            int result;
        !           772:            char *open = p;
        !           773: 
        !           774:            do {
        !           775:                p++;
        !           776:            } while (*p != '\0');
        !           777:            p--;
        !           778:            if (*p != ')') {
        !           779:                goto scalar;
        !           780:            }
        !           781:            *open = '\0';
        !           782:            *p = '\0';
        !           783:            result = Tcl_TraceVar2(interp, varName, open+1, flags,
        !           784:                    proc, clientData);
        !           785:            *open = '(';
        !           786:            *p = ')';
        !           787:            return result;
        !           788:        }
        !           789:     }
        !           790: 
        !           791:     scalar:
        !           792:     return Tcl_TraceVar2(interp, varName, (char *) NULL, flags,
        !           793:            proc, clientData);
        !           794: }
        !           795: 
        !           796: /*
        !           797:  *----------------------------------------------------------------------
        !           798:  *
        !           799:  * Tcl_TraceVar2 --
        !           800:  *
        !           801:  *     Arrange for reads and/or writes to a variable to cause a
        !           802:  *     procedure to be invoked, which can monitor the operations
        !           803:  *     and/or change their actions.
        !           804:  *
        !           805:  * Results:
        !           806:  *     A standard Tcl return value.
        !           807:  *
        !           808:  * Side effects:
        !           809:  *     A trace is set up on the variable given by name1 and name2, such
        !           810:  *     that future references to the variable will be intermediated by
        !           811:  *     proc.  See the manual entry for complete details on the calling
        !           812:  *     sequence for proc.
        !           813:  *
        !           814:  *----------------------------------------------------------------------
        !           815:  */
        !           816: 
        !           817: int
        !           818: Tcl_TraceVar2(interp, name1, name2, flags, proc, clientData)
        !           819:     Tcl_Interp *interp;                /* Interpreter in which variable is
        !           820:                                 * to be traced. */
        !           821:     char *name1;               /* Name of scalar variable or array. */
        !           822:     char *name2;               /* Name of element within array;  NULL means
        !           823:                                 * trace applies to scalar variable or array
        !           824:                                 * as-a-whole. */
        !           825:     int flags;                 /* OR-ed collection of bits, including any
        !           826:                                 * of TCL_TRACE_READS, TCL_TRACE_WRITES,
        !           827:                                 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
        !           828:     Tcl_VarTraceProc *proc;    /* Procedure to call when specified ops are
        !           829:                                 * invoked upon varName. */
        !           830:     ClientData clientData;     /* Arbitrary argument to pass to proc. */
        !           831: {
        !           832:     Tcl_HashEntry *hPtr;
        !           833:     Var *varPtr = NULL;                /* Initial value only used to stop compiler
        !           834:                                 * from complaining; not really needed. */
        !           835:     Interp *iPtr = (Interp *) interp;
        !           836:     register VarTrace *tracePtr;
        !           837:     int new;
        !           838: 
        !           839:     /*
        !           840:      * Locate the variable, making a new (undefined) one if necessary.
        !           841:      */
        !           842: 
        !           843:     if ((flags & TCL_GLOBAL_ONLY) || (iPtr->varFramePtr == NULL)) {
        !           844:        hPtr = Tcl_CreateHashEntry(&iPtr->globalTable, name1, &new);
        !           845:     } else {
        !           846:        hPtr = Tcl_CreateHashEntry(&iPtr->varFramePtr->varTable, name1, &new);
        !           847:     }
        !           848:     if (!new) {
        !           849:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           850:        if (varPtr->flags & VAR_UPVAR) {
        !           851:            hPtr = varPtr->value.upvarPtr;
        !           852:            varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           853:        }
        !           854:     }
        !           855: 
        !           856:     /*
        !           857:      * If the trace is to be on an array element, make sure that the
        !           858:      * variable is an array variable.  If the variable doesn't exist
        !           859:      * then define it as an empty array.  Then find the specific
        !           860:      * array element.
        !           861:      */
        !           862: 
        !           863:     if (name2 != NULL) {
        !           864:        if (new) {
        !           865:            varPtr = NewVar(0);
        !           866:            Tcl_SetHashValue(hPtr, varPtr);
        !           867:            varPtr->flags = VAR_ARRAY;
        !           868:            varPtr->value.tablePtr = (Tcl_HashTable *)
        !           869:                    ckalloc(sizeof(Tcl_HashTable));
        !           870:            Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
        !           871:        } else {
        !           872:            if (varPtr->flags & VAR_UNDEFINED) {
        !           873:                varPtr->flags = VAR_ARRAY;
        !           874:                varPtr->value.tablePtr = (Tcl_HashTable *)
        !           875:                        ckalloc(sizeof(Tcl_HashTable));
        !           876:                Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
        !           877:            } else if (!(varPtr->flags & VAR_ARRAY)) {
        !           878:                iPtr->result = needArray;
        !           879:                return TCL_ERROR;
        !           880:            }
        !           881:        }
        !           882:        hPtr = Tcl_CreateHashEntry(varPtr->value.tablePtr, name2, &new);
        !           883:     }
        !           884: 
        !           885:     if (new) {
        !           886:        if ((name2 != NULL) && (varPtr->searchPtr != NULL)) {
        !           887:            DeleteSearches(varPtr);
        !           888:        }
        !           889:        varPtr = NewVar(0);
        !           890:        varPtr->flags = VAR_UNDEFINED;
        !           891:        Tcl_SetHashValue(hPtr, varPtr);
        !           892:     } else {
        !           893:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !           894:     }
        !           895: 
        !           896:     /*
        !           897:      * Set up trace information.
        !           898:      */
        !           899: 
        !           900:     tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
        !           901:     tracePtr->traceProc = proc;
        !           902:     tracePtr->clientData = clientData;
        !           903:     tracePtr->flags = flags &
        !           904:            (TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS);
        !           905:     tracePtr->nextPtr = varPtr->tracePtr;
        !           906:     varPtr->tracePtr = tracePtr;
        !           907:     return TCL_OK;
        !           908: }
        !           909: 
        !           910: /*
        !           911:  *----------------------------------------------------------------------
        !           912:  *
        !           913:  * Tcl_UntraceVar --
        !           914:  *
        !           915:  *     Remove a previously-created trace for a variable.
        !           916:  *
        !           917:  * Results:
        !           918:  *     None.
        !           919:  *
        !           920:  * Side effects:
        !           921:  *     If there exists a trace for the variable given by varName
        !           922:  *     with the given flags, proc, and clientData, then that trace
        !           923:  *     is removed.
        !           924:  *
        !           925:  *----------------------------------------------------------------------
        !           926:  */
        !           927: 
        !           928: void
        !           929: Tcl_UntraceVar(interp, varName, flags, proc, clientData)
        !           930:     Tcl_Interp *interp;                /* Interpreter containing traced variable. */
        !           931:     char *varName;             /* Name of variable;  may end with "(index)"
        !           932:                                 * to signify an array reference. */
        !           933:     int flags;                 /* OR-ed collection of bits describing
        !           934:                                 * current trace, including any of
        !           935:                                 * TCL_TRACE_READS, TCL_TRACE_WRITES,
        !           936:                                 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
        !           937:     Tcl_VarTraceProc *proc;    /* Procedure assocated with trace. */
        !           938:     ClientData clientData;     /* Arbitrary argument to pass to proc. */
        !           939: {
        !           940:     register char *p;
        !           941: 
        !           942:     /*
        !           943:      * If varName refers to an array (it ends with a parenthesized
        !           944:      * element name), then handle it specially.
        !           945:      */
        !           946: 
        !           947:     for (p = varName; *p != '\0'; p++) {
        !           948:        if (*p == '(') {
        !           949:            char *open = p;
        !           950: 
        !           951:            do {
        !           952:                p++;
        !           953:            } while (*p != '\0');
        !           954:            p--;
        !           955:            if (*p != ')') {
        !           956:                goto scalar;
        !           957:            }
        !           958:            *open = '\0';
        !           959:            *p = '\0';
        !           960:            Tcl_UntraceVar2(interp, varName, open+1, flags, proc, clientData);
        !           961:            *open = '(';
        !           962:            *p = ')';
        !           963:            return;
        !           964:        }
        !           965:     }
        !           966: 
        !           967:     scalar:
        !           968:     Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData);
        !           969: }
        !           970: 
        !           971: /*
        !           972:  *----------------------------------------------------------------------
        !           973:  *
        !           974:  * Tcl_UntraceVar2 --
        !           975:  *
        !           976:  *     Remove a previously-created trace for a variable.
        !           977:  *
        !           978:  * Results:
        !           979:  *     None.
        !           980:  *
        !           981:  * Side effects:
        !           982:  *     If there exists a trace for the variable given by name1
        !           983:  *     and name2 with the given flags, proc, and clientData, then
        !           984:  *     that trace is removed.
        !           985:  *
        !           986:  *----------------------------------------------------------------------
        !           987:  */
        !           988: 
        !           989: void
        !           990: Tcl_UntraceVar2(interp, name1, name2, flags, proc, clientData)
        !           991:     Tcl_Interp *interp;                /* Interpreter containing traced variable. */
        !           992:     char *name1;               /* Name of variable or array. */
        !           993:     char *name2;               /* Name of element within array;  NULL means
        !           994:                                 * trace applies to scalar variable or array
        !           995:                                 * as-a-whole. */
        !           996:     int flags;                 /* OR-ed collection of bits describing
        !           997:                                 * current trace, including any of
        !           998:                                 * TCL_TRACE_READS, TCL_TRACE_WRITES,
        !           999:                                 * TCL_TRACE_UNSETS, and TCL_GLOBAL_ONLY. */
        !          1000:     Tcl_VarTraceProc *proc;    /* Procedure assocated with trace. */
        !          1001:     ClientData clientData;     /* Arbitrary argument to pass to proc. */
        !          1002: {
        !          1003:     register VarTrace *tracePtr;
        !          1004:     VarTrace *prevPtr;
        !          1005:     Var *varPtr;
        !          1006:     Interp *iPtr = (Interp *) interp;
        !          1007:     Tcl_HashEntry *hPtr;
        !          1008:     ActiveVarTrace *activePtr;
        !          1009: 
        !          1010:     /*
        !          1011:      * First, lookup the variable.
        !          1012:      */
        !          1013: 
        !          1014:     if ((flags & TCL_GLOBAL_ONLY) || (iPtr->varFramePtr == NULL)) {
        !          1015:        hPtr = Tcl_FindHashEntry(&iPtr->globalTable, name1);
        !          1016:     } else {
        !          1017:        hPtr = Tcl_FindHashEntry(&iPtr->varFramePtr->varTable, name1);
        !          1018:     }
        !          1019:     if (hPtr == NULL) {
        !          1020:        return;
        !          1021:     }
        !          1022:     varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1023:     if (varPtr->flags & VAR_UPVAR) {
        !          1024:        hPtr = varPtr->value.upvarPtr;
        !          1025:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1026:     }
        !          1027:     if (name2 != NULL) {
        !          1028:        if (!(varPtr->flags & VAR_ARRAY)) {
        !          1029:            return;
        !          1030:        }
        !          1031:        hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, name2);
        !          1032:        if (hPtr == NULL) {
        !          1033:            return;
        !          1034:        }
        !          1035:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1036:     }
        !          1037: 
        !          1038:     flags &= (TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS);
        !          1039:     for (tracePtr = varPtr->tracePtr, prevPtr = NULL; ;
        !          1040:            prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
        !          1041:        if (tracePtr == NULL) {
        !          1042:            return;
        !          1043:        }
        !          1044:        if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
        !          1045:                && (tracePtr->clientData == clientData)) {
        !          1046:            break;
        !          1047:        }
        !          1048:     }
        !          1049: 
        !          1050:     /*
        !          1051:      * The code below makes it possible to delete traces while traces
        !          1052:      * are active:  it makes sure that the deleted trace won't be
        !          1053:      * processed by CallTraces.
        !          1054:      */
        !          1055: 
        !          1056:     for (activePtr = iPtr->activeTracePtr; activePtr != NULL;
        !          1057:            activePtr = activePtr->nextPtr) {
        !          1058:        if (activePtr->nextTracePtr == tracePtr) {
        !          1059:            activePtr->nextTracePtr = tracePtr->nextPtr;
        !          1060:        }
        !          1061:     }
        !          1062:     if (prevPtr == NULL) {
        !          1063:        varPtr->tracePtr = tracePtr->nextPtr;
        !          1064:     } else {
        !          1065:        prevPtr->nextPtr = tracePtr->nextPtr;
        !          1066:     }
        !          1067:     ckfree((char *) tracePtr);
        !          1068: }
        !          1069: 
        !          1070: /*
        !          1071:  *----------------------------------------------------------------------
        !          1072:  *
        !          1073:  * Tcl_VarTraceInfo --
        !          1074:  *
        !          1075:  *     Return the clientData value associated with a trace on a
        !          1076:  *     variable.  This procedure can also be used to step through
        !          1077:  *     all of the traces on a particular variable that have the
        !          1078:  *     same trace procedure.
        !          1079:  *
        !          1080:  * Results:
        !          1081:  *     The return value is the clientData value associated with
        !          1082:  *     a trace on the given variable.  Information will only be
        !          1083:  *     returned for a trace with proc as trace procedure.  If
        !          1084:  *     the clientData argument is NULL then the first such trace is
        !          1085:  *     returned;  otherwise, the next relevant one after the one
        !          1086:  *     given by clientData will be returned.  If the variable
        !          1087:  *     doesn't exist, or if there are no (more) traces for it,
        !          1088:  *     then NULL is returned.
        !          1089:  *
        !          1090:  * Side effects:
        !          1091:  *     None.
        !          1092:  *
        !          1093:  *----------------------------------------------------------------------
        !          1094:  */
        !          1095: 
        !          1096: ClientData
        !          1097: Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
        !          1098:     Tcl_Interp *interp;                /* Interpreter containing variable. */
        !          1099:     char *varName;             /* Name of variable;  may end with "(index)"
        !          1100:                                 * to signify an array reference. */
        !          1101:     int flags;                 /* 0 or TCL_GLOBAL_ONLY. */
        !          1102:     Tcl_VarTraceProc *proc;    /* Procedure assocated with trace. */
        !          1103:     ClientData prevClientData; /* If non-NULL, gives last value returned
        !          1104:                                 * by this procedure, so this call will
        !          1105:                                 * return the next trace after that one.
        !          1106:                                 * If NULL, this call will return the
        !          1107:                                 * first trace. */
        !          1108: {
        !          1109:     register char *p;
        !          1110: 
        !          1111:     /*
        !          1112:      * If varName refers to an array (it ends with a parenthesized
        !          1113:      * element name), then handle it specially.
        !          1114:      */
        !          1115: 
        !          1116:     for (p = varName; *p != '\0'; p++) {
        !          1117:        if (*p == '(') {
        !          1118:            ClientData result;
        !          1119:            char *open = p;
        !          1120: 
        !          1121:            do {
        !          1122:                p++;
        !          1123:            } while (*p != '\0');
        !          1124:            p--;
        !          1125:            if (*p != ')') {
        !          1126:                goto scalar;
        !          1127:            }
        !          1128:            *open = '\0';
        !          1129:            *p = '\0';
        !          1130:            result = Tcl_VarTraceInfo2(interp, varName, open+1, flags, proc,
        !          1131:                prevClientData);
        !          1132:            *open = '(';
        !          1133:            *p = ')';
        !          1134:            return result;
        !          1135:        }
        !          1136:     }
        !          1137: 
        !          1138:     scalar:
        !          1139:     return Tcl_VarTraceInfo2(interp, varName, (char *) NULL, flags, proc,
        !          1140:            prevClientData);
        !          1141: }
        !          1142: 
        !          1143: /*
        !          1144:  *----------------------------------------------------------------------
        !          1145:  *
        !          1146:  * Tcl_VarTraceInfo2 --
        !          1147:  *
        !          1148:  *     Same as Tcl_VarTraceInfo, except takes name in two pieces
        !          1149:  *     instead of one.
        !          1150:  *
        !          1151:  * Results:
        !          1152:  *     Same as Tcl_VarTraceInfo.
        !          1153:  *
        !          1154:  * Side effects:
        !          1155:  *     None.
        !          1156:  *
        !          1157:  *----------------------------------------------------------------------
        !          1158:  */
        !          1159: 
        !          1160: ClientData
        !          1161: Tcl_VarTraceInfo2(interp, name1, name2, flags, proc, prevClientData)
        !          1162:     Tcl_Interp *interp;                /* Interpreter containing variable. */
        !          1163:     char *name1;               /* Name of variable or array. */
        !          1164:     char *name2;               /* Name of element within array;  NULL means
        !          1165:                                 * trace applies to scalar variable or array
        !          1166:                                 * as-a-whole. */
        !          1167:     int flags;                 /* 0 or TCL_GLOBAL_ONLY. */
        !          1168:     Tcl_VarTraceProc *proc;    /* Procedure assocated with trace. */
        !          1169:     ClientData prevClientData; /* If non-NULL, gives last value returned
        !          1170:                                 * by this procedure, so this call will
        !          1171:                                 * return the next trace after that one.
        !          1172:                                 * If NULL, this call will return the
        !          1173:                                 * first trace. */
        !          1174: {
        !          1175:     register VarTrace *tracePtr;
        !          1176:     Var *varPtr;
        !          1177:     Interp *iPtr = (Interp *) interp;
        !          1178:     Tcl_HashEntry *hPtr;
        !          1179: 
        !          1180:     /*
        !          1181:      * First, lookup the variable.
        !          1182:      */
        !          1183: 
        !          1184:     if ((flags & TCL_GLOBAL_ONLY) || (iPtr->varFramePtr == NULL)) {
        !          1185:        hPtr = Tcl_FindHashEntry(&iPtr->globalTable, name1);
        !          1186:     } else {
        !          1187:        hPtr = Tcl_FindHashEntry(&iPtr->varFramePtr->varTable, name1);
        !          1188:     }
        !          1189:     if (hPtr == NULL) {
        !          1190:        return NULL;
        !          1191:     }
        !          1192:     varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1193:     if (varPtr->flags & VAR_UPVAR) {
        !          1194:        hPtr = varPtr->value.upvarPtr;
        !          1195:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1196:     }
        !          1197:     if (name2 != NULL) {
        !          1198:        if (!(varPtr->flags & VAR_ARRAY)) {
        !          1199:            return NULL;
        !          1200:        }
        !          1201:        hPtr = Tcl_FindHashEntry(varPtr->value.tablePtr, name2);
        !          1202:        if (hPtr == NULL) {
        !          1203:            return NULL;
        !          1204:        }
        !          1205:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1206:     }
        !          1207: 
        !          1208:     /*
        !          1209:      * Find the relevant trace, if any, and return its clientData.
        !          1210:      */
        !          1211: 
        !          1212:     tracePtr = varPtr->tracePtr;
        !          1213:     if (prevClientData != NULL) {
        !          1214:        for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
        !          1215:            if ((tracePtr->clientData == prevClientData)
        !          1216:                    && (tracePtr->traceProc == proc)) {
        !          1217:                tracePtr = tracePtr->nextPtr;
        !          1218:                break;
        !          1219:            }
        !          1220:        }
        !          1221:     }
        !          1222:     for ( ; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
        !          1223:        if (tracePtr->traceProc == proc) {
        !          1224:            return tracePtr->clientData;
        !          1225:        }
        !          1226:     }
        !          1227:     return NULL;
        !          1228: }
        !          1229: 
        !          1230: /*
        !          1231:  *----------------------------------------------------------------------
        !          1232:  *
        !          1233:  * Tcl_SetCmd --
        !          1234:  *
        !          1235:  *     This procedure is invoked to process the "set" Tcl command.
        !          1236:  *     See the user documentation for details on what it does.
        !          1237:  *
        !          1238:  * Results:
        !          1239:  *     A standard Tcl result value.
        !          1240:  *
        !          1241:  * Side effects:
        !          1242:  *     A variable's value may be changed.
        !          1243:  *
        !          1244:  *----------------------------------------------------------------------
        !          1245:  */
        !          1246: 
        !          1247:        /* ARGSUSED */
        !          1248: int
        !          1249: Tcl_SetCmd(dummy, interp, argc, argv)
        !          1250:     ClientData dummy;                  /* Not used. */
        !          1251:     register Tcl_Interp *interp;       /* Current interpreter. */
        !          1252:     int argc;                          /* Number of arguments. */
        !          1253:     char **argv;                       /* Argument strings. */
        !          1254: {
        !          1255:     if (argc == 2) {
        !          1256:        char *value;
        !          1257: 
        !          1258:        value = Tcl_GetVar(interp, argv[1], TCL_LEAVE_ERR_MSG);
        !          1259:        if (value == NULL) {
        !          1260:            return TCL_ERROR;
        !          1261:        }
        !          1262:        interp->result = value;
        !          1263:        return TCL_OK;
        !          1264:     } else if (argc == 3) {
        !          1265:        char *result;
        !          1266: 
        !          1267:        result = Tcl_SetVar(interp, argv[1], argv[2], TCL_LEAVE_ERR_MSG);
        !          1268:        if (result == NULL) {
        !          1269:            return TCL_ERROR;
        !          1270:        }
        !          1271:        interp->result = result;
        !          1272:        return TCL_OK;
        !          1273:     } else {
        !          1274:        Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1275:                argv[0], " varName ?newValue?\"", (char *) NULL);
        !          1276:        return TCL_ERROR;
        !          1277:     }
        !          1278: }
        !          1279: 
        !          1280: /*
        !          1281:  *----------------------------------------------------------------------
        !          1282:  *
        !          1283:  * Tcl_UnsetCmd --
        !          1284:  *
        !          1285:  *     This procedure is invoked to process the "unset" Tcl command.
        !          1286:  *     See the user documentation for details on what it does.
        !          1287:  *
        !          1288:  * Results:
        !          1289:  *     A standard Tcl result value.
        !          1290:  *
        !          1291:  * Side effects:
        !          1292:  *     See the user documentation.
        !          1293:  *
        !          1294:  *----------------------------------------------------------------------
        !          1295:  */
        !          1296: 
        !          1297:        /* ARGSUSED */
        !          1298: int
        !          1299: Tcl_UnsetCmd(dummy, interp, argc, argv)
        !          1300:     ClientData dummy;                  /* Not used. */
        !          1301:     register Tcl_Interp *interp;       /* Current interpreter. */
        !          1302:     int argc;                          /* Number of arguments. */
        !          1303:     char **argv;                       /* Argument strings. */
        !          1304: {
        !          1305:     int i;
        !          1306: 
        !          1307:     if (argc < 2) {
        !          1308:        Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1309:                argv[0], " varName ?varName ...?\"", (char *) NULL);
        !          1310:        return TCL_ERROR;
        !          1311:     }
        !          1312:     for (i = 1; i < argc; i++) {
        !          1313:        if (Tcl_UnsetVar(interp, argv[i], TCL_LEAVE_ERR_MSG) != 0) {
        !          1314:            return TCL_ERROR;
        !          1315:        }
        !          1316:     }
        !          1317:     return TCL_OK;
        !          1318: }
        !          1319: 
        !          1320: /*
        !          1321:  *----------------------------------------------------------------------
        !          1322:  *
        !          1323:  * Tcl_AppendCmd --
        !          1324:  *
        !          1325:  *     This procedure is invoked to process the "append" Tcl command.
        !          1326:  *     See the user documentation for details on what it does.
        !          1327:  *
        !          1328:  * Results:
        !          1329:  *     A standard Tcl result value.
        !          1330:  *
        !          1331:  * Side effects:
        !          1332:  *     A variable's value may be changed.
        !          1333:  *
        !          1334:  *----------------------------------------------------------------------
        !          1335:  */
        !          1336: 
        !          1337:        /* ARGSUSED */
        !          1338: int
        !          1339: Tcl_AppendCmd(dummy, interp, argc, argv)
        !          1340:     ClientData dummy;                  /* Not used. */
        !          1341:     register Tcl_Interp *interp;       /* Current interpreter. */
        !          1342:     int argc;                          /* Number of arguments. */
        !          1343:     char **argv;                       /* Argument strings. */
        !          1344: {
        !          1345:     int i;
        !          1346:     char *result = NULL;               /* (Initialization only needed to keep
        !          1347:                                         * the compiler from complaining) */
        !          1348: 
        !          1349:     if (argc < 3) {
        !          1350:        Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1351:                argv[0], " varName value ?value ...?\"", (char *) NULL);
        !          1352:        return TCL_ERROR;
        !          1353:     }
        !          1354: 
        !          1355:     for (i = 2; i < argc; i++) {
        !          1356:        result = Tcl_SetVar(interp, argv[1], argv[i],
        !          1357:                TCL_APPEND_VALUE|TCL_LEAVE_ERR_MSG);
        !          1358:        if (result == NULL) {
        !          1359:            return TCL_ERROR;
        !          1360:        }
        !          1361:     }
        !          1362:     interp->result = result;
        !          1363:     return TCL_OK;
        !          1364: }
        !          1365: 
        !          1366: /*
        !          1367:  *----------------------------------------------------------------------
        !          1368:  *
        !          1369:  * Tcl_LappendCmd --
        !          1370:  *
        !          1371:  *     This procedure is invoked to process the "lappend" Tcl command.
        !          1372:  *     See the user documentation for details on what it does.
        !          1373:  *
        !          1374:  * Results:
        !          1375:  *     A standard Tcl result value.
        !          1376:  *
        !          1377:  * Side effects:
        !          1378:  *     A variable's value may be changed.
        !          1379:  *
        !          1380:  *----------------------------------------------------------------------
        !          1381:  */
        !          1382: 
        !          1383:        /* ARGSUSED */
        !          1384: int
        !          1385: Tcl_LappendCmd(dummy, interp, argc, argv)
        !          1386:     ClientData dummy;                  /* Not used. */
        !          1387:     register Tcl_Interp *interp;       /* Current interpreter. */
        !          1388:     int argc;                          /* Number of arguments. */
        !          1389:     char **argv;                       /* Argument strings. */
        !          1390: {
        !          1391:     int i;
        !          1392:     char *result = NULL;               /* (Initialization only needed to keep
        !          1393:                                         * the compiler from complaining) */
        !          1394: 
        !          1395:     if (argc < 3) {
        !          1396:        Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1397:                argv[0], " varName value ?value ...?\"", (char *) NULL);
        !          1398:        return TCL_ERROR;
        !          1399:     }
        !          1400: 
        !          1401:     for (i = 2; i < argc; i++) {
        !          1402:        result = Tcl_SetVar(interp, argv[1], argv[i],
        !          1403:                TCL_APPEND_VALUE|TCL_LIST_ELEMENT|TCL_LEAVE_ERR_MSG);
        !          1404:        if (result == NULL) {
        !          1405:            return TCL_ERROR;
        !          1406:        }
        !          1407:     }
        !          1408:     interp->result = result;
        !          1409:     return TCL_OK;
        !          1410: }
        !          1411: 
        !          1412: /*
        !          1413:  *----------------------------------------------------------------------
        !          1414:  *
        !          1415:  * Tcl_ArrayCmd --
        !          1416:  *
        !          1417:  *     This procedure is invoked to process the "array" Tcl command.
        !          1418:  *     See the user documentation for details on what it does.
        !          1419:  *
        !          1420:  * Results:
        !          1421:  *     A standard Tcl result value.
        !          1422:  *
        !          1423:  * Side effects:
        !          1424:  *     See the user documentation.
        !          1425:  *
        !          1426:  *----------------------------------------------------------------------
        !          1427:  */
        !          1428: 
        !          1429:        /* ARGSUSED */
        !          1430: int
        !          1431: Tcl_ArrayCmd(dummy, interp, argc, argv)
        !          1432:     ClientData dummy;                  /* Not used. */
        !          1433:     register Tcl_Interp *interp;       /* Current interpreter. */
        !          1434:     int argc;                          /* Number of arguments. */
        !          1435:     char **argv;                       /* Argument strings. */
        !          1436: {
        !          1437:     int length;
        !          1438:     char c;
        !          1439:     Var *varPtr;
        !          1440:     Tcl_HashEntry *hPtr;
        !          1441:     Interp *iPtr = (Interp *) interp;
        !          1442: 
        !          1443:     if (argc < 3) {
        !          1444:        Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1445:                argv[0], " option arrayName ?arg ...?\"", (char *) NULL);
        !          1446:        return TCL_ERROR;
        !          1447:     }
        !          1448: 
        !          1449:     /*
        !          1450:      * Locate the array variable (and it better be an array).
        !          1451:      */
        !          1452: 
        !          1453:     if (iPtr->varFramePtr == NULL) {
        !          1454:        hPtr = Tcl_FindHashEntry(&iPtr->globalTable, argv[2]);
        !          1455:     } else {
        !          1456:        hPtr = Tcl_FindHashEntry(&iPtr->varFramePtr->varTable, argv[2]);
        !          1457:     }
        !          1458:     if (hPtr == NULL) {
        !          1459:        notArray:
        !          1460:        Tcl_AppendResult(interp, "\"", argv[2], "\" isn't an array",
        !          1461:                (char *) NULL);
        !          1462:        return TCL_ERROR;
        !          1463:     }
        !          1464:     varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1465:     if (varPtr->flags & VAR_UPVAR) {
        !          1466:        varPtr = (Var *) Tcl_GetHashValue(varPtr->value.upvarPtr);
        !          1467:     }
        !          1468:     if (!(varPtr->flags & VAR_ARRAY)) {
        !          1469:        goto notArray;
        !          1470:     }
        !          1471: 
        !          1472:     /*
        !          1473:      * Dispatch based on the option.
        !          1474:      */
        !          1475: 
        !          1476:     c = argv[1][0];
        !          1477:     length = strlen(argv[1]);
        !          1478:     if ((c == 'a') && (strncmp(argv[1], "anymore", length) == 0)) {
        !          1479:        ArraySearch *searchPtr;
        !          1480: 
        !          1481:        if (argc != 4) {
        !          1482:            Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1483:                    argv[0], " anymore arrayName searchId\"", (char *) NULL);
        !          1484:            return TCL_ERROR;
        !          1485:        }
        !          1486:        searchPtr = ParseSearchId(interp, varPtr, argv[2], argv[3]);
        !          1487:        if (searchPtr == NULL) {
        !          1488:            return TCL_ERROR;
        !          1489:        }
        !          1490:        while (1) {
        !          1491:            Var *varPtr2;
        !          1492: 
        !          1493:            if (searchPtr->nextEntry != NULL) {
        !          1494:                varPtr2 = (Var *) Tcl_GetHashValue(searchPtr->nextEntry);
        !          1495:                if (!(varPtr2->flags & VAR_UNDEFINED)) {
        !          1496:                    break;
        !          1497:                }
        !          1498:            }
        !          1499:            searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
        !          1500:            if (searchPtr->nextEntry == NULL) {
        !          1501:                interp->result = "0";
        !          1502:                return TCL_OK;
        !          1503:            }
        !          1504:        }
        !          1505:        interp->result = "1";
        !          1506:        return TCL_OK;
        !          1507:     } else if ((c == 'd') && (strncmp(argv[1], "donesearch", length) == 0)) {
        !          1508:        ArraySearch *searchPtr, *prevPtr;
        !          1509: 
        !          1510:        if (argc != 4) {
        !          1511:            Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1512:                    argv[0], " donesearch arrayName searchId\"", (char *) NULL);
        !          1513:            return TCL_ERROR;
        !          1514:        }
        !          1515:        searchPtr = ParseSearchId(interp, varPtr, argv[2], argv[3]);
        !          1516:        if (searchPtr == NULL) {
        !          1517:            return TCL_ERROR;
        !          1518:        }
        !          1519:        if (varPtr->searchPtr == searchPtr) {
        !          1520:            varPtr->searchPtr = searchPtr->nextPtr;
        !          1521:        } else {
        !          1522:            for (prevPtr = varPtr->searchPtr; ; prevPtr = prevPtr->nextPtr) {
        !          1523:                if (prevPtr->nextPtr == searchPtr) {
        !          1524:                    prevPtr->nextPtr = searchPtr->nextPtr;
        !          1525:                    break;
        !          1526:                }
        !          1527:            }
        !          1528:        }
        !          1529:        ckfree((char *) searchPtr);
        !          1530:     } else if ((c == 'n') && (strncmp(argv[1], "names", length) == 0)
        !          1531:            && (length >= 2)) {
        !          1532:        Tcl_HashSearch search;
        !          1533:        Var *varPtr2;
        !          1534: 
        !          1535:        if (argc != 3) {
        !          1536:            Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1537:                    argv[0], " names arrayName\"", (char *) NULL);
        !          1538:            return TCL_ERROR;
        !          1539:        }
        !          1540:        for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
        !          1541:                hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
        !          1542:            varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
        !          1543:            if (varPtr2->flags & VAR_UNDEFINED) {
        !          1544:                continue;
        !          1545:            }
        !          1546:            Tcl_AppendElement(interp,
        !          1547:                    Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), 0);
        !          1548:        }
        !          1549:     } else if ((c == 'n') && (strncmp(argv[1], "nextelement", length) == 0)
        !          1550:            && (length >= 2)) {
        !          1551:        ArraySearch *searchPtr;
        !          1552:        Tcl_HashEntry *hPtr;
        !          1553: 
        !          1554:        if (argc != 4) {
        !          1555:            Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1556:                    argv[0], " nextelement arrayName searchId\"",
        !          1557:                    (char *) NULL);
        !          1558:            return TCL_ERROR;
        !          1559:        }
        !          1560:        searchPtr = ParseSearchId(interp, varPtr, argv[2], argv[3]);
        !          1561:        if (searchPtr == NULL) {
        !          1562:            return TCL_ERROR;
        !          1563:        }
        !          1564:        while (1) {
        !          1565:            Var *varPtr2;
        !          1566: 
        !          1567:            hPtr = searchPtr->nextEntry;
        !          1568:            if (hPtr == NULL) {
        !          1569:                hPtr = Tcl_NextHashEntry(&searchPtr->search);
        !          1570:                if (hPtr == NULL) {
        !          1571:                    return TCL_OK;
        !          1572:                }
        !          1573:            } else {
        !          1574:                searchPtr->nextEntry = NULL;
        !          1575:            }
        !          1576:            varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
        !          1577:            if (!(varPtr2->flags & VAR_UNDEFINED)) {
        !          1578:                break;
        !          1579:            }
        !          1580:        }
        !          1581:        interp->result = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
        !          1582:     } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)
        !          1583:            && (length >= 2)) {
        !          1584:        Tcl_HashSearch search;
        !          1585:        Var *varPtr2;
        !          1586:        int size;
        !          1587: 
        !          1588:        if (argc != 3) {
        !          1589:            Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1590:                    argv[0], " size arrayName\"", (char *) NULL);
        !          1591:            return TCL_ERROR;
        !          1592:        }
        !          1593:        size = 0;
        !          1594:        for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
        !          1595:                hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
        !          1596:            varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
        !          1597:            if (varPtr2->flags & VAR_UNDEFINED) {
        !          1598:                continue;
        !          1599:            }
        !          1600:            size++;
        !          1601:        }
        !          1602:        sprintf(interp->result, "%d", size);
        !          1603:     } else if ((c == 's') && (strncmp(argv[1], "startsearch", length) == 0)
        !          1604:            && (length >= 2)) {
        !          1605:        ArraySearch *searchPtr;
        !          1606: 
        !          1607:        if (argc != 3) {
        !          1608:            Tcl_AppendResult(interp, "wrong # args: should be \"",
        !          1609:                    argv[0], " startsearch arrayName\"", (char *) NULL);
        !          1610:            return TCL_ERROR;
        !          1611:        }
        !          1612:        searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
        !          1613:        if (varPtr->searchPtr == NULL) {
        !          1614:            searchPtr->id = 1;
        !          1615:            Tcl_AppendResult(interp, "s-1-", argv[2], (char *) NULL);
        !          1616:        } else {
        !          1617:            char string[20];
        !          1618: 
        !          1619:            searchPtr->id = varPtr->searchPtr->id + 1;
        !          1620:            sprintf(string, "%d", searchPtr->id);
        !          1621:            Tcl_AppendResult(interp, "s-", string, "-", argv[2],
        !          1622:                    (char *) NULL);
        !          1623:        }
        !          1624:        searchPtr->varPtr = varPtr;
        !          1625:        searchPtr->nextEntry = Tcl_FirstHashEntry(varPtr->value.tablePtr,
        !          1626:                &searchPtr->search);
        !          1627:        searchPtr->nextPtr = varPtr->searchPtr;
        !          1628:        varPtr->searchPtr = searchPtr;
        !          1629:     } else {
        !          1630:        Tcl_AppendResult(interp, "bad option \"", argv[1],
        !          1631:                "\": should be anymore, donesearch, names, nextelement, ",
        !          1632:                "size, or startsearch", (char *) NULL);
        !          1633:        return TCL_ERROR;
        !          1634:     }
        !          1635:     return TCL_OK;
        !          1636: }
        !          1637: 
        !          1638: /*
        !          1639:  *----------------------------------------------------------------------
        !          1640:  *
        !          1641:  * Tcl_GlobalCmd --
        !          1642:  *
        !          1643:  *     This procedure is invoked to process the "global" Tcl command.
        !          1644:  *     See the user documentation for details on what it does.
        !          1645:  *
        !          1646:  * Results:
        !          1647:  *     A standard Tcl result value.
        !          1648:  *
        !          1649:  * Side effects:
        !          1650:  *     See the user documentation.
        !          1651:  *
        !          1652:  *----------------------------------------------------------------------
        !          1653:  */
        !          1654: 
        !          1655:        /* ARGSUSED */
        !          1656: int
        !          1657: Tcl_GlobalCmd(dummy, interp, argc, argv)
        !          1658:     ClientData dummy;                  /* Not used. */
        !          1659:     Tcl_Interp *interp;                        /* Current interpreter. */
        !          1660:     int argc;                          /* Number of arguments. */
        !          1661:     char **argv;                       /* Argument strings. */
        !          1662: {
        !          1663:     Var *varPtr, *gVarPtr;
        !          1664:     register Interp *iPtr = (Interp *) interp;
        !          1665:     Tcl_HashEntry *hPtr, *hPtr2;
        !          1666:     int new;
        !          1667: 
        !          1668:     if (argc < 2) {
        !          1669:        Tcl_AppendResult((Tcl_Interp *) iPtr, "wrong # args: should be \"",
        !          1670:                argv[0], " varName ?varName ...?\"", (char *) NULL);
        !          1671:        return TCL_ERROR;
        !          1672:     }
        !          1673:     if (iPtr->varFramePtr == NULL) {
        !          1674:        return TCL_OK;
        !          1675:     }
        !          1676: 
        !          1677:     for (argc--, argv++; argc > 0; argc--, argv++) {
        !          1678:        hPtr = Tcl_CreateHashEntry(&iPtr->globalTable, *argv, &new);
        !          1679:        if (new) {
        !          1680:            gVarPtr = NewVar(0);
        !          1681:            gVarPtr->flags |= VAR_UNDEFINED;
        !          1682:            Tcl_SetHashValue(hPtr, gVarPtr);
        !          1683:        } else {
        !          1684:            gVarPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1685:        }
        !          1686:        hPtr2 = Tcl_CreateHashEntry(&iPtr->varFramePtr->varTable, *argv, &new);
        !          1687:        if (!new) {
        !          1688:            Var *varPtr;
        !          1689:            varPtr = (Var *) Tcl_GetHashValue(hPtr2);
        !          1690:            if (varPtr->flags & VAR_UPVAR) {
        !          1691:                continue;
        !          1692:            } else {
        !          1693:                Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", *argv,
        !          1694:                    "\" already exists", (char *) NULL);
        !          1695:                return TCL_ERROR;
        !          1696:            }
        !          1697:        }
        !          1698:        varPtr = NewVar(0);
        !          1699:        varPtr->flags |= VAR_UPVAR;
        !          1700:        varPtr->value.upvarPtr = hPtr;
        !          1701:        gVarPtr->upvarUses++;
        !          1702:        Tcl_SetHashValue(hPtr2, varPtr);
        !          1703:     }
        !          1704:     return TCL_OK;
        !          1705: }
        !          1706: 
        !          1707: /*
        !          1708:  *----------------------------------------------------------------------
        !          1709:  *
        !          1710:  * Tcl_UpvarCmd --
        !          1711:  *
        !          1712:  *     This procedure is invoked to process the "upvar" Tcl command.
        !          1713:  *     See the user documentation for details on what it does.
        !          1714:  *
        !          1715:  * Results:
        !          1716:  *     A standard Tcl result value.
        !          1717:  *
        !          1718:  * Side effects:
        !          1719:  *     See the user documentation.
        !          1720:  *
        !          1721:  *----------------------------------------------------------------------
        !          1722:  */
        !          1723: 
        !          1724:        /* ARGSUSED */
        !          1725: int
        !          1726: Tcl_UpvarCmd(dummy, interp, argc, argv)
        !          1727:     ClientData dummy;                  /* Not used. */
        !          1728:     Tcl_Interp *interp;                        /* Current interpreter. */
        !          1729:     int argc;                          /* Number of arguments. */
        !          1730:     char **argv;                       /* Argument strings. */
        !          1731: {
        !          1732:     register Interp *iPtr = (Interp *) interp;
        !          1733:     int result;
        !          1734:     CallFrame *framePtr;
        !          1735:     Var *varPtr = NULL;
        !          1736:     Tcl_HashTable *upVarTablePtr;
        !          1737:     Tcl_HashEntry *hPtr, *hPtr2;
        !          1738:     int new;
        !          1739:     Var *upVarPtr;
        !          1740: 
        !          1741:     if (argc < 3) {
        !          1742:        upvarSyntax:
        !          1743:        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
        !          1744:                " ?level? otherVar localVar ?otherVar localVar ...?\"",
        !          1745:                (char *) NULL);
        !          1746:        return TCL_ERROR;
        !          1747:     }
        !          1748: 
        !          1749:     /*
        !          1750:      * Find the hash table containing the variable being referenced.
        !          1751:      */
        !          1752: 
        !          1753:     result = TclGetFrame(interp, argv[1], &framePtr);
        !          1754:     if (result == -1) {
        !          1755:        return TCL_ERROR;
        !          1756:     }
        !          1757:     argc -= result+1;
        !          1758:     argv += result+1;
        !          1759:     if (framePtr == NULL) {
        !          1760:        upVarTablePtr = &iPtr->globalTable;
        !          1761:     } else {
        !          1762:        upVarTablePtr = &framePtr->varTable;
        !          1763:     }
        !          1764: 
        !          1765:     if ((argc & 1) != 0) {
        !          1766:        goto upvarSyntax;
        !          1767:     }
        !          1768: 
        !          1769:     /*
        !          1770:      * Iterate over all the pairs of (local variable, other variable)
        !          1771:      * names.  For each pair, create a hash table entry in the upper
        !          1772:      * context (if the name wasn't there already), then associate it
        !          1773:      * with a new local variable.
        !          1774:      */
        !          1775: 
        !          1776:     while (argc > 0) {
        !          1777:         hPtr = Tcl_CreateHashEntry(upVarTablePtr, argv[0], &new);
        !          1778:         if (new) {
        !          1779:             upVarPtr = NewVar(0);
        !          1780:             upVarPtr->flags |= VAR_UNDEFINED;
        !          1781:             Tcl_SetHashValue(hPtr, upVarPtr);
        !          1782:         } else {
        !          1783:             upVarPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1784:            if (upVarPtr->flags & VAR_UPVAR) {
        !          1785:                hPtr = upVarPtr->value.upvarPtr;
        !          1786:                upVarPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1787:            }
        !          1788:         }
        !          1789: 
        !          1790:         hPtr2 = Tcl_CreateHashEntry(&iPtr->varFramePtr->varTable,
        !          1791:                     argv[1], &new);
        !          1792:         if (!new) {
        !          1793:             Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", argv[1],
        !          1794:                 "\" already exists", (char *) NULL);
        !          1795:             return TCL_ERROR;
        !          1796:         }
        !          1797:         varPtr = NewVar(0);
        !          1798:         varPtr->flags |= VAR_UPVAR;
        !          1799:         varPtr->value.upvarPtr = hPtr;
        !          1800:         upVarPtr->upvarUses++;
        !          1801:         Tcl_SetHashValue(hPtr2, varPtr);
        !          1802: 
        !          1803:         argc -= 2;
        !          1804:         argv += 2;
        !          1805:     }
        !          1806:     return TCL_OK;
        !          1807: }
        !          1808: 
        !          1809: /*
        !          1810:  *----------------------------------------------------------------------
        !          1811:  *
        !          1812:  * TclDeleteVars --
        !          1813:  *
        !          1814:  *     This procedure is called to recycle all the storage space
        !          1815:  *     associated with a table of variables.  For this procedure
        !          1816:  *     to work correctly, it must not be possible for any of the
        !          1817:  *     variable in the table to be accessed from Tcl commands
        !          1818:  *     (e.g. from trace procedures).
        !          1819:  *
        !          1820:  * Results:
        !          1821:  *     None.
        !          1822:  *
        !          1823:  * Side effects:
        !          1824:  *     Variables are deleted and trace procedures are invoked, if
        !          1825:  *     any are declared.
        !          1826:  *
        !          1827:  *----------------------------------------------------------------------
        !          1828:  */
        !          1829: 
        !          1830: void
        !          1831: TclDeleteVars(iPtr, tablePtr)
        !          1832:     Interp *iPtr;              /* Interpreter to which variables belong. */
        !          1833:     Tcl_HashTable *tablePtr;   /* Hash table containing variables to
        !          1834:                                 * delete. */
        !          1835: {
        !          1836:     Tcl_HashSearch search;
        !          1837:     Tcl_HashEntry *hPtr;
        !          1838:     register Var *varPtr;
        !          1839:     int flags, globalFlag;
        !          1840: 
        !          1841:     flags = TCL_TRACE_UNSETS;
        !          1842:     if (tablePtr == &iPtr->globalTable) {
        !          1843:        flags |= TCL_INTERP_DESTROYED | TCL_GLOBAL_ONLY;
        !          1844:     }
        !          1845:     for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
        !          1846:            hPtr = Tcl_NextHashEntry(&search)) {
        !          1847:        varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1848: 
        !          1849:        /*
        !          1850:         * For global/upvar variables referenced in procedures, free up the
        !          1851:         * local space and then decrement the reference count on the
        !          1852:         * variable referred to.  If there are no more references to the
        !          1853:         * global/upvar and it is undefined and has no traces set, then
        !          1854:         * follow on and delete the referenced variable too.
        !          1855:         */
        !          1856: 
        !          1857:        globalFlag = 0;
        !          1858:        if (varPtr->flags & VAR_UPVAR) {
        !          1859:            hPtr = varPtr->value.upvarPtr;
        !          1860:            ckfree((char *) varPtr);
        !          1861:            varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1862:            varPtr->upvarUses--;
        !          1863:            if ((varPtr->upvarUses != 0) || !(varPtr->flags & VAR_UNDEFINED)
        !          1864:                    || (varPtr->tracePtr != NULL)) {
        !          1865:                continue;
        !          1866:            }
        !          1867:            globalFlag = TCL_GLOBAL_ONLY;
        !          1868:        }
        !          1869: 
        !          1870:        /*
        !          1871:         * Invoke traces on the variable that is being deleted, then
        !          1872:         * free up the variable's space (no need to free the hash entry
        !          1873:         * here, unless we're dealing with a global variable:  the
        !          1874:         * hash entries will be deleted automatically when the whole
        !          1875:         * table is deleted).
        !          1876:         */
        !          1877: 
        !          1878:        if (varPtr->tracePtr != NULL) {
        !          1879:            (void) CallTraces(iPtr, (Var *) NULL, hPtr,
        !          1880:                    Tcl_GetHashKey(tablePtr, hPtr), (char *) NULL,
        !          1881:                    flags | globalFlag);
        !          1882:            while (varPtr->tracePtr != NULL) {
        !          1883:                VarTrace *tracePtr = varPtr->tracePtr;
        !          1884:                varPtr->tracePtr = tracePtr->nextPtr;
        !          1885:                ckfree((char *) tracePtr);
        !          1886:            }
        !          1887:        }
        !          1888:        if (varPtr->flags & VAR_ARRAY) {
        !          1889:            DeleteArray(iPtr, Tcl_GetHashKey(tablePtr, hPtr), varPtr,
        !          1890:                    flags | globalFlag);
        !          1891:        }
        !          1892:        if (globalFlag) {
        !          1893:            Tcl_DeleteHashEntry(hPtr);
        !          1894:        }
        !          1895:        ckfree((char *) varPtr);
        !          1896:     }
        !          1897:     Tcl_DeleteHashTable(tablePtr);
        !          1898: }
        !          1899: 
        !          1900: /*
        !          1901:  *----------------------------------------------------------------------
        !          1902:  *
        !          1903:  * CallTraces --
        !          1904:  *
        !          1905:  *     This procedure is invoked to find and invoke relevant
        !          1906:  *     trace procedures associated with a particular operation on
        !          1907:  *     a variable.  This procedure invokes traces both on the
        !          1908:  *     variable and on its containing array (where relevant).
        !          1909:  *
        !          1910:  * Results:
        !          1911:  *     The return value is NULL if no trace procedures were invoked, or
        !          1912:  *     if all the invoked trace procedures returned successfully.
        !          1913:  *     The return value is non-zero if a trace procedure returned an
        !          1914:  *     error (in this case no more trace procedures were invoked after
        !          1915:  *     the error was returned).  In this case the return value is a
        !          1916:  *     pointer to a static string describing the error.
        !          1917:  *
        !          1918:  * Side effects:
        !          1919:  *     Almost anything can happen, depending on trace;  this procedure
        !          1920:  *     itself doesn't have any side effects.
        !          1921:  *
        !          1922:  *----------------------------------------------------------------------
        !          1923:  */
        !          1924: 
        !          1925: static char *
        !          1926: CallTraces(iPtr, arrayPtr, hPtr, name1, name2, flags)
        !          1927:     Interp *iPtr;                      /* Interpreter containing variable. */
        !          1928:     register Var *arrayPtr;            /* Pointer to array variable that
        !          1929:                                         * contains the variable, or NULL if
        !          1930:                                         * the variable isn't an element of an
        !          1931:                                         * array. */
        !          1932:     Tcl_HashEntry *hPtr;               /* Hash table entry corresponding to
        !          1933:                                         * variable whose traces are to be
        !          1934:                                         * invoked. */
        !          1935:     char *name1, *name2;               /* Variable's two-part name. */
        !          1936:     int flags;                         /* Flags to pass to trace procedures:
        !          1937:                                         * indicates what's happening to
        !          1938:                                         * variable, plus other stuff like
        !          1939:                                         * TCL_GLOBAL_ONLY and
        !          1940:                                         * TCL_INTERP_DESTROYED. */
        !          1941: {
        !          1942:     Var *varPtr;
        !          1943:     register VarTrace *tracePtr;
        !          1944:     ActiveVarTrace active;
        !          1945:     char *result;
        !          1946:     int savedArrayFlags = 0;           /* (Initialization not needed except
        !          1947:                                         * to prevent compiler warning) */
        !          1948: 
        !          1949:     /*
        !          1950:      * If there are already similar trace procedures active for the
        !          1951:      * variable, don't call them again.
        !          1952:      */
        !          1953: 
        !          1954:     varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          1955:     if (varPtr->flags & VAR_TRACE_ACTIVE) {
        !          1956:        return NULL;
        !          1957:     }
        !          1958:     varPtr->flags |= VAR_TRACE_ACTIVE;
        !          1959: 
        !          1960:     /*
        !          1961:      * Invoke traces on the array containing the variable, if relevant.
        !          1962:      */
        !          1963: 
        !          1964:     result = NULL;
        !          1965:     active.nextPtr = iPtr->activeTracePtr;
        !          1966:     iPtr->activeTracePtr = &active;
        !          1967:     if (arrayPtr != NULL) {
        !          1968:        savedArrayFlags = arrayPtr->flags;
        !          1969:        arrayPtr->flags |= VAR_ELEMENT_ACTIVE;
        !          1970:        for (tracePtr = arrayPtr->tracePtr;  tracePtr != NULL;
        !          1971:                tracePtr = active.nextTracePtr) {
        !          1972:            active.nextTracePtr = tracePtr->nextPtr;
        !          1973:            if (!(tracePtr->flags & flags)) {
        !          1974:                continue;
        !          1975:            }
        !          1976:            result = (*tracePtr->traceProc)(tracePtr->clientData,
        !          1977:                    (Tcl_Interp *) iPtr, name1, name2, flags);
        !          1978:            if (result != NULL) {
        !          1979:                if (flags & TCL_TRACE_UNSETS) {
        !          1980:                    result = NULL;
        !          1981:                } else {
        !          1982:                    goto done;
        !          1983:                }
        !          1984:            }
        !          1985:        }
        !          1986:     }
        !          1987: 
        !          1988:     /*
        !          1989:      * Invoke traces on the variable itself.
        !          1990:      */
        !          1991: 
        !          1992:     if (flags & TCL_TRACE_UNSETS) {
        !          1993:        flags |= TCL_TRACE_DESTROYED;
        !          1994:     }
        !          1995:     for (tracePtr = varPtr->tracePtr; tracePtr != NULL;
        !          1996:            tracePtr = active.nextTracePtr) {
        !          1997:        active.nextTracePtr = tracePtr->nextPtr;
        !          1998:        if (!(tracePtr->flags & flags)) {
        !          1999:            continue;
        !          2000:        }
        !          2001:        result = (*tracePtr->traceProc)(tracePtr->clientData,
        !          2002:                (Tcl_Interp *) iPtr, name1, name2, flags);
        !          2003:        if (result != NULL) {
        !          2004:            if (flags & TCL_TRACE_UNSETS) {
        !          2005:                result = NULL;
        !          2006:            } else {
        !          2007:                goto done;
        !          2008:            }
        !          2009:        }
        !          2010:     }
        !          2011: 
        !          2012:     /*
        !          2013:      * Restore the variable's flags, remove the record of our active
        !          2014:      * traces, and then return.  Remember that the variable could have
        !          2015:      * been re-allocated during the traces, but its hash entry won't
        !          2016:      * change.
        !          2017:      */
        !          2018: 
        !          2019:     done:
        !          2020:     if (arrayPtr != NULL) {
        !          2021:        arrayPtr->flags = savedArrayFlags;
        !          2022:     }
        !          2023:     varPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          2024:     varPtr->flags &= ~VAR_TRACE_ACTIVE;
        !          2025:     iPtr->activeTracePtr = active.nextPtr;
        !          2026:     return result;
        !          2027: }
        !          2028: 
        !          2029: /*
        !          2030:  *----------------------------------------------------------------------
        !          2031:  *
        !          2032:  * NewVar --
        !          2033:  *
        !          2034:  *     Create a new variable with a given initial value.
        !          2035:  *
        !          2036:  * Results:
        !          2037:  *     The return value is a pointer to the new variable structure.
        !          2038:  *     The variable will not be part of any hash table yet, and its
        !          2039:  *     upvarUses count is initialized to 0.  Its initial value will
        !          2040:  *     be empty, but "space" bytes will be available in the value
        !          2041:  *     area.
        !          2042:  *
        !          2043:  * Side effects:
        !          2044:  *     Storage gets allocated.
        !          2045:  *
        !          2046:  *----------------------------------------------------------------------
        !          2047:  */
        !          2048: 
        !          2049: static Var *
        !          2050: NewVar(space)
        !          2051:     int space;         /* Minimum amount of space to allocate
        !          2052:                         * for variable's value. */
        !          2053: {
        !          2054:     int extra;
        !          2055:     register Var *varPtr;
        !          2056: 
        !          2057:     extra = space - sizeof(varPtr->value);
        !          2058:     if (extra < 0) {
        !          2059:        extra = 0;
        !          2060:        space = sizeof(varPtr->value);
        !          2061:     }
        !          2062:     varPtr = (Var *) ckalloc((unsigned) (sizeof(Var) + extra));
        !          2063:     varPtr->valueLength = 0;
        !          2064:     varPtr->valueSpace = space;
        !          2065:     varPtr->upvarUses = 0;
        !          2066:     varPtr->tracePtr = NULL;
        !          2067:     varPtr->searchPtr = NULL;
        !          2068:     varPtr->flags = 0;
        !          2069:     varPtr->value.string[0] = 0;
        !          2070:     return varPtr;
        !          2071: }
        !          2072: 
        !          2073: /*
        !          2074:  *----------------------------------------------------------------------
        !          2075:  *
        !          2076:  * ParseSearchId --
        !          2077:  *
        !          2078:  *     This procedure translates from a string to a pointer to an
        !          2079:  *     active array search (if there is one that matches the string).
        !          2080:  *
        !          2081:  * Results:
        !          2082:  *     The return value is a pointer to the array search indicated
        !          2083:  *     by string, or NULL if there isn't one.  If NULL is returned,
        !          2084:  *     interp->result contains an error message.
        !          2085:  *
        !          2086:  * Side effects:
        !          2087:  *     None.
        !          2088:  *
        !          2089:  *----------------------------------------------------------------------
        !          2090:  */
        !          2091: 
        !          2092: static ArraySearch *
        !          2093: ParseSearchId(interp, varPtr, varName, string)
        !          2094:     Tcl_Interp *interp;                /* Interpreter containing variable. */
        !          2095:     Var *varPtr;               /* Array variable search is for. */
        !          2096:     char *varName;             /* Name of array variable that search is
        !          2097:                                 * supposed to be for. */
        !          2098:     char *string;              /* String containing id of search.  Must have
        !          2099:                                 * form "search-num-var" where "num" is a
        !          2100:                                 * decimal number and "var" is a variable
        !          2101:                                 * name. */
        !          2102: {
        !          2103:     char *end;
        !          2104:     int id;
        !          2105:     ArraySearch *searchPtr;
        !          2106: 
        !          2107:     /*
        !          2108:      * Parse the id into the three parts separated by dashes.
        !          2109:      */
        !          2110: 
        !          2111:     if ((string[0] != 's') || (string[1] != '-')) {
        !          2112:        syntax:
        !          2113:        Tcl_AppendResult(interp, "illegal search identifier \"", string,
        !          2114:                "\"", (char *) NULL);
        !          2115:        return NULL;
        !          2116:     }
        !          2117:     id = strtoul(string+2, &end, 10);
        !          2118:     if ((end == (string+2)) || (*end != '-')) {
        !          2119:        goto syntax;
        !          2120:     }
        !          2121:     if (strcmp(end+1, varName) != 0) {
        !          2122:        Tcl_AppendResult(interp, "search identifier \"", string,
        !          2123:                "\" isn't for variable \"", varName, "\"", (char *) NULL);
        !          2124:        return NULL;
        !          2125:     }
        !          2126: 
        !          2127:     /*
        !          2128:      * Search through the list of active searches on the interpreter
        !          2129:      * to see if the desired one exists.
        !          2130:      */
        !          2131: 
        !          2132:     for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
        !          2133:            searchPtr = searchPtr->nextPtr) {
        !          2134:        if (searchPtr->id == id) {
        !          2135:            return searchPtr;
        !          2136:        }
        !          2137:     }
        !          2138:     Tcl_AppendResult(interp, "couldn't find search \"", string, "\"",
        !          2139:            (char *) NULL);
        !          2140:     return NULL;
        !          2141: }
        !          2142: 
        !          2143: /*
        !          2144:  *----------------------------------------------------------------------
        !          2145:  *
        !          2146:  * DeleteSearches --
        !          2147:  *
        !          2148:  *     This procedure is called to free up all of the searches
        !          2149:  *     associated with an array variable.
        !          2150:  *
        !          2151:  * Results:
        !          2152:  *     None.
        !          2153:  *
        !          2154:  * Side effects:
        !          2155:  *     Memory is released to the storage allocator.
        !          2156:  *
        !          2157:  *----------------------------------------------------------------------
        !          2158:  */
        !          2159: 
        !          2160: static void
        !          2161: DeleteSearches(arrayVarPtr)
        !          2162:     register Var *arrayVarPtr;         /* Variable whose searches are
        !          2163:                                         * to be deleted. */
        !          2164: {
        !          2165:     ArraySearch *searchPtr;
        !          2166: 
        !          2167:     while (arrayVarPtr->searchPtr != NULL) {
        !          2168:        searchPtr = arrayVarPtr->searchPtr;
        !          2169:        arrayVarPtr->searchPtr = searchPtr->nextPtr;
        !          2170:        ckfree((char *) searchPtr);
        !          2171:     }
        !          2172: }
        !          2173: 
        !          2174: /*
        !          2175:  *----------------------------------------------------------------------
        !          2176:  *
        !          2177:  * DeleteArray --
        !          2178:  *
        !          2179:  *     This procedure is called to free up everything in an array
        !          2180:  *     variable.  It's the caller's responsibility to make sure
        !          2181:  *     that the array is no longer accessible before this procedure
        !          2182:  *     is called.
        !          2183:  *
        !          2184:  * Results:
        !          2185:  *     None.
        !          2186:  *
        !          2187:  * Side effects:
        !          2188:  *     All storage associated with varPtr's array elements is deleted
        !          2189:  *     (including the hash table).  Any delete trace procedures for
        !          2190:  *     array elements are invoked.
        !          2191:  *
        !          2192:  *----------------------------------------------------------------------
        !          2193:  */
        !          2194: 
        !          2195: static void
        !          2196: DeleteArray(iPtr, arrayName, varPtr, flags)
        !          2197:     Interp *iPtr;                      /* Interpreter containing array. */
        !          2198:     char *arrayName;                   /* Name of array (used for trace
        !          2199:                                         * callbacks). */
        !          2200:     Var *varPtr;                       /* Pointer to variable structure. */
        !          2201:     int flags;                         /* Flags to pass to CallTraces:
        !          2202:                                         * TCL_TRACE_UNSETS and sometimes
        !          2203:                                         * TCL_INTERP_DESTROYED and/or
        !          2204:                                         * TCL_GLOBAL_ONLY. */
        !          2205: {
        !          2206:     Tcl_HashSearch search;
        !          2207:     register Tcl_HashEntry *hPtr;
        !          2208:     register Var *elPtr;
        !          2209: 
        !          2210:     DeleteSearches(varPtr);
        !          2211:     for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
        !          2212:            hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
        !          2213:        elPtr = (Var *) Tcl_GetHashValue(hPtr);
        !          2214:        if (elPtr->tracePtr != NULL) {
        !          2215:            (void) CallTraces(iPtr, (Var *) NULL, hPtr, arrayName,
        !          2216:                    Tcl_GetHashKey(varPtr->value.tablePtr, hPtr), flags);
        !          2217:            while (elPtr->tracePtr != NULL) {
        !          2218:                VarTrace *tracePtr = elPtr->tracePtr;
        !          2219:                elPtr->tracePtr = tracePtr->nextPtr;
        !          2220:                ckfree((char *) tracePtr);
        !          2221:            }
        !          2222:        }
        !          2223:        if (elPtr->flags & VAR_SEARCHES_POSSIBLE) {
        !          2224:            panic("DeleteArray found searches on array alement!");
        !          2225:        }
        !          2226:        ckfree((char *) elPtr);
        !          2227:     }
        !          2228:     Tcl_DeleteHashTable(varPtr->value.tablePtr);
        !          2229:     ckfree((char *) varPtr->value.tablePtr);
        !          2230: }
        !          2231: 
        !          2232: /*
        !          2233:  *----------------------------------------------------------------------
        !          2234:  *
        !          2235:  * VarErrMsg --
        !          2236:  *
        !          2237:  *     Generate a reasonable error message describing why a variable
        !          2238:  *     operation failed.
        !          2239:  *
        !          2240:  * Results:
        !          2241:  *     None.
        !          2242:  *
        !          2243:  * Side effects:
        !          2244:  *     Interp->result is reset to hold a message identifying the
        !          2245:  *     variable given by name1 and name2 and describing why the
        !          2246:  *     variable operation failed.
        !          2247:  *
        !          2248:  *----------------------------------------------------------------------
        !          2249:  */
        !          2250: 
        !          2251: static void
        !          2252: VarErrMsg(interp, name1, name2, operation, reason)
        !          2253:     Tcl_Interp *interp;                /* Interpreter in which to record message. */
        !          2254:     char *name1, *name2;       /* Variable's two-part name. */
        !          2255:     char *operation;           /* String describing operation that failed,
        !          2256:                                 * e.g. "read", "set", or "unset". */
        !          2257:     char *reason;              /* String describing why operation failed. */
        !          2258: {
        !          2259:     Tcl_ResetResult(interp);
        !          2260:     Tcl_AppendResult(interp, "can't ", operation, " \"", name1, (char *) NULL);
        !          2261:     if (name2 != NULL) {
        !          2262:        Tcl_AppendResult(interp, "(", name2, ")", (char *) NULL);
        !          2263:     }
        !          2264:     Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
        !          2265: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.