Tcl Source Code

Check-in [9f649172e4]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:merge 8.5
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | rc0 | core-8-5-19-rc
Files: files | file ages | folders
SHA1: 9f649172e4e4b3c2f1b6df55490808905f684add
User & Date: dgp 2016-01-26 16:08:26
Context
2016-01-28
13:42
RefineApproximation() leaked twoMv and twoMd in one of its exits. check-in: 7e0659670d user: dgp tags: core-8-5-19-rc
2016-01-26
16:08
merge 8.5 check-in: 9f649172e4 user: dgp tags: rc0, core-8-5-19-rc
2016-01-22
10:27
Improve code 'quality' by fixing some harmless clang/cppcheck warnings. Thanks to Gustaf Neumann. No... check-in: 01f95b9116 user: jan.nijtmans tags: core-8-5-branch
2016-01-21
14:55
merge 8.5 check-in: 77e71f94b3 user: dgp tags: core-8-5-19-rc
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclIORChan.c.

512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
....
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
....
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
    }

    /*
     * First argument is a list of modes. Allowed entries are "read", "write".
     * Expect at least one list element. Abbreviations are ok.
     */

    modeObj = objv[MODE];
    if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Second argument is command prefix, i.e. list of words, first word is
     * name of handler command, other words are fixed arguments. Run the
................................................................................
	 *
	 * NOTE: The channel may have been removed from the map already via
	 * the per-interp DeleteReflectedChannelMap exit-handler.
	 */

	if (rcPtr->interp) {
	    rcmPtr = GetReflectedChannelMap (rcPtr->interp);
	    hPtr = Tcl_FindHashEntry (&rcmPtr->map, 
				      Tcl_GetChannelName (rcPtr->chan));
	    if (hPtr) {
		Tcl_DeleteHashEntry (hPtr);
	    }
	}
#ifdef TCL_THREADS
        rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry (&rcmPtr->map, 
				  Tcl_GetChannelName (rcPtr->chan));
	if (hPtr) {
	    Tcl_DeleteHashEntry (hPtr);
	}
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
................................................................................
	 *
	 * We remove the channel from both interpreter and thread maps before
	 * releasing the memory, to prevent future accesses (like by
	 * 'postevent') from finding and dereferencing a dangling pointer.
	 */

	rcmPtr = GetReflectedChannelMap (interp);
	hPtr = Tcl_FindHashEntry (&rcmPtr->map, 
				  Tcl_GetChannelName (rcPtr->chan));
	Tcl_DeleteHashEntry (hPtr);

        rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry (&rcmPtr->map, 
				  Tcl_GetChannelName (rcPtr->chan));
	Tcl_DeleteHashEntry (hPtr);

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;






<







 







|







|







 







|




|







512
513
514
515
516
517
518

519
520
521
522
523
524
525
....
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
....
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
    }

    /*
     * First argument is a list of modes. Allowed entries are "read", "write".
     * Expect at least one list element. Abbreviations are ok.
     */


    if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Second argument is command prefix, i.e. list of words, first word is
     * name of handler command, other words are fixed arguments. Run the
................................................................................
	 *
	 * NOTE: The channel may have been removed from the map already via
	 * the per-interp DeleteReflectedChannelMap exit-handler.
	 */

	if (rcPtr->interp) {
	    rcmPtr = GetReflectedChannelMap (rcPtr->interp);
	    hPtr = Tcl_FindHashEntry (&rcmPtr->map,
				      Tcl_GetChannelName (rcPtr->chan));
	    if (hPtr) {
		Tcl_DeleteHashEntry (hPtr);
	    }
	}
#ifdef TCL_THREADS
        rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry (&rcmPtr->map,
				  Tcl_GetChannelName (rcPtr->chan));
	if (hPtr) {
	    Tcl_DeleteHashEntry (hPtr);
	}
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
................................................................................
	 *
	 * We remove the channel from both interpreter and thread maps before
	 * releasing the memory, to prevent future accesses (like by
	 * 'postevent') from finding and dereferencing a dangling pointer.
	 */

	rcmPtr = GetReflectedChannelMap (interp);
	hPtr = Tcl_FindHashEntry (&rcmPtr->map,
				  Tcl_GetChannelName (rcPtr->chan));
	Tcl_DeleteHashEntry (hPtr);

        rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry (&rcmPtr->map,
				  Tcl_GetChannelName (rcPtr->chan));
	Tcl_DeleteHashEntry (hPtr);

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;

Changes to generic/tclInterp.c.

1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = (Tcl_Obj **) TclStackAlloc(interp, cmdc*(int)sizeof(Tcl_Obj*));
    }

    prefv = &aliasPtr->objPtr;
    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));

    Tcl_ResetResult(targetInterp);

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);






<







1744
1745
1746
1747
1748
1749
1750

1751
1752
1753
1754
1755
1756
1757
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = (Tcl_Obj **) TclStackAlloc(interp, cmdc*(int)sizeof(Tcl_Obj*));
    }


    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));

    Tcl_ResetResult(targetInterp);

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);

Changes to generic/tclVar.c.

912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
...
933
934
935
936
937
938
939


940
941
942
943
944
945
946
....
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011


1012
1013
1014
1015
1016
1017
1018
....
1040
1041
1042
1043
1044
1045
1046

1047
1048
1049
1050
1051
1052
1053
....
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152


1153
1154
1155
1156
1157
1158
1159
....
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
....
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
....
2400
2401
2402
2403
2404
2405
2406


2407
2408
2409
2410
2411
2412
2413
....
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599



2600
2601
2602
2603
2604
2605
2606
....
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
....
2673
2674
2675
2676
2677
2678
2679



2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
....
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
....
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
....
3314
3315
3316
3317
3318
3319
3320


3321
3322
3323
3324
3325
3326
3327
....
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
....
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689

3690
3691
3692
3693
3694
3695
3696
....
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901



3902
3903
3904
3905
3906
3907
3908
....
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
....
3964
3965
3966
3967
3968
3969
3970


3971
3972
3973
3974
3975
3976
3977
....
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072


4073
4074
4075
4076
4077
4078
4079
....
4420
4421
4422
4423
4424
4425
4426

4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
....
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924


4925
4926
4927
4928
4929
4930
4931
....
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
....
5065
5066
5067
5068
5069
5070
5071


5072
5073
5074
5075
5076
5077
5078
....
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
....
5220
5221
5222
5223
5224
5225
5226



5227
5228
5229
5230
5231
5232
5233
....
5260
5261
5262
5263
5264
5265
5266

5267
5268
5269

5270
5271
5272
5273
5274
5275
5276
....
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
....
5401
5402
5403
5404
5405
5406
5407



5408
5409
5410
5411
5412
5413
5414
    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
				 * to look up the variable. */
    Tcl_Var var;		/* Used to search for global names. */
    Var *varPtr;		/* Points to the Var structure returned for
				 * the variable. */
    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolverScheme *resPtr;
    int isNew, i, result;
    const char *varName = TclGetString(varNamePtr);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {
................................................................................
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
     * to continue onward, or it may signal an error.
     */

    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
	    && !(flags & AVOID_RESOLVERS)) {


	resPtr = iPtr->resolverPtr;
	if (cxtNsPtr->varResProc) {
	    result = (*cxtNsPtr->varResProc)(interp, varName,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}
................................................................................
	 * otherwise generate our own error!
	 */

	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
		(Tcl_Namespace *) cxtNsPtr,
		(flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
	if (varPtr == NULL) {
	    Tcl_Obj *tailPtr;

	    if (create) {	/* Var wasn't found so create it. */


		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
		if (varNsPtr == NULL) {
		    *errMsgPtr = badNamespace;
		    return NULL;
		} else if (tail == NULL) {
		    *errMsgPtr = missingName;
................................................................................
		*errMsgPtr = noSuchVar;
		return NULL;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localCt = varFramePtr->numCompiledLocals;
	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;


	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
	    register Tcl_Obj *objPtr = *objPtrPtr;

	    if (objPtr) {
		char *localName = TclGetString(objPtr);

................................................................................
				 * return error if it doesn't exist. */
    Var *arrayPtr,		/* Pointer to the array's Var structure. */
    int index)			/* If >=0, the index of the local array. */
{
    int isNew;
    Var *varPtr;
    TclVarHashTable *tablePtr;
    Namespace *nsPtr;

    /*
     * We're dealing with an array element. Make sure the variable is an array
     * and look up the element (create the element if desired).
     */

    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {


	if (!createArray) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			noSuchVar, index);
	    }
	    return NULL;
	}
................................................................................
    }
    if (varValuePtr == NULL) {
	varValuePtr = Tcl_NewIntObj(0);
    }
    if (Tcl_IsShared(varValuePtr)) {
	/* Copy on write */
	varValuePtr = Tcl_DuplicateObj(varValuePtr);
	
	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
		    varValuePtr, flags, index);
	} else {
	    Tcl_DecrRefCount(varValuePtr);
	    return NULL;
	}
................................................................................
     *    will use dummyVar so it won't increment varPtr's refCount itself.
     * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to call
     *    unset traces even if other traces are pending.
     */

    if (traced) {
	VarTrace *tracePtr = NULL;
	Tcl_HashEntry *tPtr = NULL;

	if (TclIsVarTraced(&dummyVar)) {
	    /*
	     * Transfer any existing traces on var, IF there are unset traces.
	     * Otherwise just delete them.
	     */

................................................................................
	    } else {
		tPtr = NULL;
	    }
	}

	if ((dummyVar.flags & VAR_TRACED_UNSET)
		|| (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {


	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
		    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
			    | TCL_TRACE_UNSETS,
		    /* leaveErrMsg */ 0, -1);

	    /*
................................................................................
int
Tcl_AppendObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr, *arrayPtr;
    register Tcl_Obj *varValuePtr = NULL;
				/* Initialized to avoid compiler warning. */
    int i;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
	return TCL_ERROR;
    }

    if (objc == 2) {
	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	if (varValuePtr == NULL) {
	    return TCL_ERROR;
	}
    } else {



	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	    return TCL_ERROR;
	}
	for (i=2 ; i<objc ; i++) {
	    /*
................................................................................
Tcl_LappendObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValuePtr, *newValuePtr;
    int numElems, createdNewObj;
    Var *varPtr, *arrayPtr;
    int result;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
	return TCL_ERROR;
    }
    if (objc == 2) {
................................................................................
	} else {
	    result = TclListObjLength(interp, newValuePtr, &numElems);
	    if (result != TCL_OK) {
		return result;
	    }
	}
    } else {



	/*
	 * We have arguments to append. We used to call Tcl_SetVar2 to append
	 * each argument one at a time to ensure that traces were run for each
	 * append step. We now append the arguments all at once because it's
	 * faster. Note that a read trace and a write trace for the variable
	 * will now each only be called once. Also, if the variable's old
	 * value is unshared we modify it directly, otherwise we create a new
	 * copy to modify: this is "copy on write".
	 */

	createdNewObj = 0;

	/*
	 * Protect the variable pointers around the TclPtrGetVar call
	 * to insure that they remain valid even if the variable was undefined
	 * and unused.
	 */

	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
................................................................................
	    goto error;
	}
	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
	if (searchPtr == NULL) {
	    return TCL_ERROR;
	}
	while (1) {
	    Var *varPtr2;

	    if (searchPtr->nextEntry != NULL) {
		varPtr2 = VarHashGetValue(searchPtr->nextEntry);
		if (!TclIsVarUndefined(varPtr2)) {
		    break;
		}
	    }
	    searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
	    if (searchPtr->nextEntry == NULL) {
		Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[0]);
................................................................................
		}
	    }
	    break;
	}

    case ARRAY_SIZE: {
	Tcl_HashSearch search;
	Var *varPtr2;
	int size;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}
	size = 0;
................................................................................

	/*
	 * Must iterate in order to get chance to check for present but
	 * "undefined" entries.
	 */

	if (!notArray) {


	    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
		    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
		if (TclIsVarUndefined(varPtr2)) {
		    continue;
		}
		size++;
	    }
................................................................................
    if (myNamePtr) {
	Tcl_DecrRefCount(myNamePtr);
    }
    return result;
}

/* Callers must Incr myNamePtr if they plan to Decr it. */
 
int
TclPtrObjMakeUpvar(
    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
				 * error messages, too. */
    Var *otherPtr,		/* Pointer to the variable being linked-to. */
    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
................................................................................
    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
    int index)			/* If the variable to be linked is an indexed
				 * scalar, this is its index. Otherwise, -1 */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    const char *errMsg, *p, *myName;
    Var *varPtr;

    if (index >= 0) {
	if (!HasLocalVars(varFramePtr)) {
	    Tcl_Panic("ObjMakeUpvar called with an index outside from a proc");
	}
	varPtr = (Var *) &(varFramePtr->compiledLocals[index]);
	myNamePtr = localName(iPtr->varFramePtr, index);
	myName = myNamePtr? TclGetString(myNamePtr) : NULL;
    } else {

	/*
	 * Do not permit the new variable to look like an array reference, as
	 * it will not be reachable in that case [Bug 600812, TIP 184]. The
	 * "definition" of what "looks like an array reference" is consistent
	 * (and must remain consistent) with the code in TclObjLookupVar().
	 */

................................................................................
    Tcl_Var variable,		/* Token for the variable returned by a
				 * previous call to Tcl_FindNamespaceVar. */
    Tcl_Obj *objPtr)		/* Points to the object onto which the
				 * variable's full name is appended. */
{
    Interp *iPtr = (Interp *) interp;
    register Var *varPtr = (Var *) variable;
    Tcl_Obj *namePtr;
    Namespace *nsPtr;

    /*
     * Add the full name of the containing namespace (if any), followed by the
     * "::" separator, then the variable name.
     */

    if (varPtr) {
	if (!TclIsVarArrayElement(varPtr)) {



	    nsPtr = TclGetVarNsPtr(varPtr);
	    if (nsPtr) {
		Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
		if (nsPtr != iPtr->globalNsPtr) {
		    Tcl_AppendToObj(objPtr, "::", 2);
		}
	    }
................................................................................
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    register Tcl_Obj *objPtr, *tailPtr;
    char *varName;
    register char *tail;
    int result, i;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
	return TCL_ERROR;
    }

    /*
................................................................................
     */

    if (!HasLocalVars(iPtr->varFramePtr)) {
	return TCL_OK;
    }

    for (i=1 ; i<objc ; i++) {


	/*
	 * Make a local variable linked to its counterpart in the global ::
	 * namespace.
	 */

	objPtr = objv[i];
	varName = TclGetString(objPtr);
................................................................................
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    char *varName, *tail, *cp;
    Var *varPtr, *arrayPtr;
    Tcl_Obj *varValuePtr;
    int i, result;
    Tcl_Obj *varNamePtr, *tailPtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?");
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i+=2) {


	/*
	 * Look up each variable in the current namespace context, creating it
	 * if necessary.
	 */

	varNamePtr = objv[i];
	varName = TclGetString(varNamePtr);
................................................................................

static void
DeleteSearches(
    Interp *iPtr,
    register Var *arrayVarPtr)	/* Variable whose searches are to be
				 * deleted. */
{

    ArraySearch *searchPtr, *nextPtr;
    Tcl_HashEntry *sPtr;

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, (char *) arrayVarPtr);
	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(sPtr);
		searchPtr != NULL; searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    ckfree((char *) searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
................................................................................
DupParsedVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
    register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
    char *elemCopy;
    unsigned int elemLen;

    if (arrayPtr != NULL) {


	Tcl_IncrRefCount(arrayPtr);
	elemLen = strlen(elem);
	elemCopy = ckalloc(elemLen+1);
	memcpy(elemCopy, elem, elemLen);
	*(elemCopy + elemLen) = '\0';
	elem = elemCopy;
    }
................................................................................
{
    Interp *iPtr = (Interp *) interp;
    ResolverScheme *resPtr;
    Namespace *nsPtr[2], *cxtNsPtr;
    const char *simpleName;
    Var *varPtr;
    register int search;
    int result;
    Tcl_Var var;
    Tcl_Obj *simpleNamePtr;
    char *name = TclGetString(namePtr);

    /*
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
................................................................................
	cxtNsPtr = (Namespace *) contextNsPtr;
    } else {
	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }

    if (!(flags & AVOID_RESOLVERS) &&
	    (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {


	resPtr = iPtr->resolverPtr;

	if (cxtNsPtr->varResProc) {
	    result = (*cxtNsPtr->varResProc)(interp, name,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
................................................................................
TclInfoVarsCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    char *varName, *pattern;
    const char *simplePattern;
    Tcl_HashSearch search;
    Var *varPtr;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Obj *simplePatternPtr = NULL, *varNamePtr;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * variables. We only use this effective namespace if there's no active
     * Tcl procedure frame.
................................................................................
	return TCL_OK;
    }

    listPtr = Tcl_NewListObj(0, NULL);

    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
	    || specificNsInPattern) {



	/*
	 * There is no frame pointer, the frame pointer was pushed only to
	 * activate a namespace, or we are in a procedure call frame but a
	 * specific namespace was specified. Create a list containing only the
	 * variables in the effective namespace's variable table.
	 */

................................................................................
		    }
		}
	    }
	} else {
	    /*
	     * Have to scan the tables of variables.
	     */


	    varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
	    while (varPtr) {

		if (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr)) {
		    varNamePtr = VarHashGetKey(varPtr);
		    varName = TclGetString(varNamePtr);
		    if ((simplePattern == NULL)
			    || Tcl_StringMatch(varName, simplePattern)) {
			if (specificNsInPattern) {
................................................................................
int
TclInfoGlobalsCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *varName, *pattern;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Tcl_HashSearch search;
    Var *varPtr;
    Tcl_Obj *listPtr, *varNamePtr, *patternPtr;

    if (objc == 1) {
	pattern = NULL;
    } else if (objc == 2) {
	pattern = TclGetString(objv[1]);

	/*
................................................................................
	    }
	}
	Tcl_DecrRefCount(patternPtr);
    } else {
	for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
		varPtr != NULL;
		varPtr = VarHashNextVar(&search)) {



	    if (TclIsVarUndefined(varPtr)) {
		continue;
	    }
	    varNamePtr = VarHashGetKey(varPtr);
	    varName = TclGetString(varNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, varNamePtr);






|







 







>
>







 







<


>
>







 







>







 







<







>
>







 







|







 







<







 







>
>







 







<


<












>
>
>







 







|
<







 







>
>
>










<
<







 







<
<

|







 







<







 







>
>







 







|







 







|










>







 







<
<








>
>
>







 







|







 







>
>







 







<










>
>







 







>
|
|

<







 







<


>
>







 







<







 







>
>







 







|


<



|







 







>
>
>







 







>



>







 







|



|







 







>
>
>







912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
...
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
....
1004
1005
1006
1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
....
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
....
1142
1143
1144
1145
1146
1147
1148

1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
....
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
....
2379
2380
2381
2382
2383
2384
2385

2386
2387
2388
2389
2390
2391
2392
....
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
....
2583
2584
2585
2586
2587
2588
2589

2590
2591

2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
....
2651
2652
2653
2654
2655
2656
2657
2658

2659
2660
2661
2662
2663
2664
2665
....
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698


2699
2700
2701
2702
2703
2704
2705
....
2873
2874
2875
2876
2877
2878
2879


2880
2881
2882
2883
2884
2885
2886
2887
2888
....
3304
3305
3306
3307
3308
3309
3310

3311
3312
3313
3314
3315
3316
3317
....
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
....
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
....
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
....
3892
3893
3894
3895
3896
3897
3898


3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
....
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
....
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
....
4065
4066
4067
4068
4069
4070
4071

4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
....
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441

4442
4443
4444
4445
4446
4447
4448
....
4926
4927
4928
4929
4930
4931
4932

4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
....
5056
5057
5058
5059
5060
5061
5062

5063
5064
5065
5066
5067
5068
5069
....
5076
5077
5078
5079
5080
5081
5082
5083
5084
5085
5086
5087
5088
5089
5090
5091
....
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179

5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
....
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
....
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
....
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
....
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
				 * to look up the variable. */
    Tcl_Var var;		/* Used to search for global names. */
    Var *varPtr;		/* Points to the Var structure returned for
				 * the variable. */
    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolverScheme *resPtr;
    int isNew;
    const char *varName = TclGetString(varNamePtr);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {
................................................................................
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
     * to continue onward, or it may signal an error.
     */

    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
	    && !(flags & AVOID_RESOLVERS)) {
	int result;

	resPtr = iPtr->resolverPtr;
	if (cxtNsPtr->varResProc) {
	    result = (*cxtNsPtr->varResProc)(interp, varName,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}
................................................................................
	 * otherwise generate our own error!
	 */

	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
		(Tcl_Namespace *) cxtNsPtr,
		(flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
	if (varPtr == NULL) {


	    if (create) {	/* Var wasn't found so create it. */
		Tcl_Obj *tailPtr;

		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
		if (varNsPtr == NULL) {
		    *errMsgPtr = badNamespace;
		    return NULL;
		} else if (tail == NULL) {
		    *errMsgPtr = missingName;
................................................................................
		*errMsgPtr = noSuchVar;
		return NULL;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localCt = varFramePtr->numCompiledLocals;
	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	int i;

	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
	    register Tcl_Obj *objPtr = *objPtrPtr;

	    if (objPtr) {
		char *localName = TclGetString(objPtr);

................................................................................
				 * return error if it doesn't exist. */
    Var *arrayPtr,		/* Pointer to the array's Var structure. */
    int index)			/* If >=0, the index of the local array. */
{
    int isNew;
    Var *varPtr;
    TclVarHashTable *tablePtr;


    /*
     * We're dealing with an array element. Make sure the variable is an array
     * and look up the element (create the element if desired).
     */

    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
	Namespace *nsPtr;

	if (!createArray) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			noSuchVar, index);
	    }
	    return NULL;
	}
................................................................................
    }
    if (varValuePtr == NULL) {
	varValuePtr = Tcl_NewIntObj(0);
    }
    if (Tcl_IsShared(varValuePtr)) {
	/* Copy on write */
	varValuePtr = Tcl_DuplicateObj(varValuePtr);

	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
		    varValuePtr, flags, index);
	} else {
	    Tcl_DecrRefCount(varValuePtr);
	    return NULL;
	}
................................................................................
     *    will use dummyVar so it won't increment varPtr's refCount itself.
     * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to call
     *    unset traces even if other traces are pending.
     */

    if (traced) {
	VarTrace *tracePtr = NULL;


	if (TclIsVarTraced(&dummyVar)) {
	    /*
	     * Transfer any existing traces on var, IF there are unset traces.
	     * Otherwise just delete them.
	     */

................................................................................
	    } else {
		tPtr = NULL;
	    }
	}

	if ((dummyVar.flags & VAR_TRACED_UNSET)
		|| (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {
	    Tcl_HashEntry *tPtr = NULL;

	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
		    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
			    | TCL_TRACE_UNSETS,
		    /* leaveErrMsg */ 0, -1);

	    /*
................................................................................
int
Tcl_AppendObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    register Tcl_Obj *varValuePtr = NULL;
				/* Initialized to avoid compiler warning. */


    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
	return TCL_ERROR;
    }

    if (objc == 2) {
	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	if (varValuePtr == NULL) {
	    return TCL_ERROR;
	}
    } else {
	Var *arrayPtr, *varPtr;
	int i;

	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	    return TCL_ERROR;
	}
	for (i=2 ; i<objc ; i++) {
	    /*
................................................................................
Tcl_LappendObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValuePtr, *newValuePtr;
    int numElems;

    int result;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
	return TCL_ERROR;
    }
    if (objc == 2) {
................................................................................
	} else {
	    result = TclListObjLength(interp, newValuePtr, &numElems);
	    if (result != TCL_OK) {
		return result;
	    }
	}
    } else {
	Var *varPtr, *arrayPtr;
	int createdNewObj = 0;

	/*
	 * We have arguments to append. We used to call Tcl_SetVar2 to append
	 * each argument one at a time to ensure that traces were run for each
	 * append step. We now append the arguments all at once because it's
	 * faster. Note that a read trace and a write trace for the variable
	 * will now each only be called once. Also, if the variable's old
	 * value is unshared we modify it directly, otherwise we create a new
	 * copy to modify: this is "copy on write".
	 */



	/*
	 * Protect the variable pointers around the TclPtrGetVar call
	 * to insure that they remain valid even if the variable was undefined
	 * and unused.
	 */

	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
................................................................................
	    goto error;
	}
	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
	if (searchPtr == NULL) {
	    return TCL_ERROR;
	}
	while (1) {


	    if (searchPtr->nextEntry != NULL) {
		Var *varPtr2 = VarHashGetValue(searchPtr->nextEntry);
		if (!TclIsVarUndefined(varPtr2)) {
		    break;
		}
	    }
	    searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
	    if (searchPtr->nextEntry == NULL) {
		Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[0]);
................................................................................
		}
	    }
	    break;
	}

    case ARRAY_SIZE: {
	Tcl_HashSearch search;

	int size;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}
	size = 0;
................................................................................

	/*
	 * Must iterate in order to get chance to check for present but
	 * "undefined" entries.
	 */

	if (!notArray) {
	    Var *varPtr2;

	    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
		    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
		if (TclIsVarUndefined(varPtr2)) {
		    continue;
		}
		size++;
	    }
................................................................................
    if (myNamePtr) {
	Tcl_DecrRefCount(myNamePtr);
    }
    return result;
}

/* Callers must Incr myNamePtr if they plan to Decr it. */

int
TclPtrObjMakeUpvar(
    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
				 * error messages, too. */
    Var *otherPtr,		/* Pointer to the variable being linked-to. */
    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
................................................................................
    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
    int index)			/* If the variable to be linked is an indexed
				 * scalar, this is its index. Otherwise, -1 */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    const char *errMsg, *myName;
    Var *varPtr;

    if (index >= 0) {
	if (!HasLocalVars(varFramePtr)) {
	    Tcl_Panic("ObjMakeUpvar called with an index outside from a proc");
	}
	varPtr = (Var *) &(varFramePtr->compiledLocals[index]);
	myNamePtr = localName(iPtr->varFramePtr, index);
	myName = myNamePtr? TclGetString(myNamePtr) : NULL;
    } else {
	const char *p;
	/*
	 * Do not permit the new variable to look like an array reference, as
	 * it will not be reachable in that case [Bug 600812, TIP 184]. The
	 * "definition" of what "looks like an array reference" is consistent
	 * (and must remain consistent) with the code in TclObjLookupVar().
	 */

................................................................................
    Tcl_Var variable,		/* Token for the variable returned by a
				 * previous call to Tcl_FindNamespaceVar. */
    Tcl_Obj *objPtr)		/* Points to the object onto which the
				 * variable's full name is appended. */
{
    Interp *iPtr = (Interp *) interp;
    register Var *varPtr = (Var *) variable;



    /*
     * Add the full name of the containing namespace (if any), followed by the
     * "::" separator, then the variable name.
     */

    if (varPtr) {
	if (!TclIsVarArrayElement(varPtr)) {
	    Tcl_Obj *namePtr;
	    Namespace *nsPtr;

	    nsPtr = TclGetVarNsPtr(varPtr);
	    if (nsPtr) {
		Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
		if (nsPtr != iPtr->globalNsPtr) {
		    Tcl_AppendToObj(objPtr, "::", 2);
		}
	    }
................................................................................
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    register Tcl_Obj *objPtr, *tailPtr;
    char *varName;
    register char *tail;
    int i;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
	return TCL_ERROR;
    }

    /*
................................................................................
     */

    if (!HasLocalVars(iPtr->varFramePtr)) {
	return TCL_OK;
    }

    for (i=1 ; i<objc ; i++) {
	int result;

	/*
	 * Make a local variable linked to its counterpart in the global ::
	 * namespace.
	 */

	objPtr = objv[i];
	varName = TclGetString(objPtr);
................................................................................
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    char *varName, *tail, *cp;

    Tcl_Obj *varValuePtr;
    int i, result;
    Tcl_Obj *varNamePtr, *tailPtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?");
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i+=2) {
	Var *varPtr, *arrayPtr;

	/*
	 * Look up each variable in the current namespace context, creating it
	 * if necessary.
	 */

	varNamePtr = objv[i];
	varName = TclGetString(varNamePtr);
................................................................................

static void
DeleteSearches(
    Interp *iPtr,
    register Var *arrayVarPtr)	/* Variable whose searches are to be
				 * deleted. */
{
    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	ArraySearch *searchPtr, *nextPtr;
	Tcl_HashEntry *sPtr;


	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, (char *) arrayVarPtr);
	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(sPtr);
		searchPtr != NULL; searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    ckfree((char *) searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
................................................................................
DupParsedVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
    register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
    char *elemCopy;


    if (arrayPtr != NULL) {
	unsigned int elemLen;

	Tcl_IncrRefCount(arrayPtr);
	elemLen = strlen(elem);
	elemCopy = ckalloc(elemLen+1);
	memcpy(elemCopy, elem, elemLen);
	*(elemCopy + elemLen) = '\0';
	elem = elemCopy;
    }
................................................................................
{
    Interp *iPtr = (Interp *) interp;
    ResolverScheme *resPtr;
    Namespace *nsPtr[2], *cxtNsPtr;
    const char *simpleName;
    Var *varPtr;
    register int search;

    Tcl_Var var;
    Tcl_Obj *simpleNamePtr;
    char *name = TclGetString(namePtr);

    /*
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
................................................................................
	cxtNsPtr = (Namespace *) contextNsPtr;
    } else {
	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }

    if (!(flags & AVOID_RESOLVERS) &&
	    (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
	int result;

	resPtr = iPtr->resolverPtr;

	if (cxtNsPtr->varResProc) {
	    result = (*cxtNsPtr->varResProc)(interp, name,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
................................................................................
TclInfoVarsCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    char *pattern;
    const char *simplePattern;
    Tcl_HashSearch search;

    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Obj *simplePatternPtr = NULL, *varNamePtr;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * variables. We only use this effective namespace if there's no active
     * Tcl procedure frame.
................................................................................
	return TCL_OK;
    }

    listPtr = Tcl_NewListObj(0, NULL);

    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
	    || specificNsInPattern) {
	Var *varPtr;
	Tcl_Obj *elemObjPtr;

	/*
	 * There is no frame pointer, the frame pointer was pushed only to
	 * activate a namespace, or we are in a procedure call frame but a
	 * specific namespace was specified. Create a list containing only the
	 * variables in the effective namespace's variable table.
	 */

................................................................................
		    }
		}
	    }
	} else {
	    /*
	     * Have to scan the tables of variables.
	     */
	    char *varName;

	    varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
	    while (varPtr) {

		if (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr)) {
		    varNamePtr = VarHashGetKey(varPtr);
		    varName = TclGetString(varNamePtr);
		    if ((simplePattern == NULL)
			    || Tcl_StringMatch(varName, simplePattern)) {
			if (specificNsInPattern) {
................................................................................
int
TclInfoGlobalsCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *pattern;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Tcl_HashSearch search;
    Var *varPtr;
    Tcl_Obj *listPtr, *patternPtr;

    if (objc == 1) {
	pattern = NULL;
    } else if (objc == 2) {
	pattern = TclGetString(objv[1]);

	/*
................................................................................
	    }
	}
	Tcl_DecrRefCount(patternPtr);
    } else {
	for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
		varPtr != NULL;
		varPtr = VarHashNextVar(&search)) {
	    char *varName;
	    Tcl_Obj *varNamePtr;

	    if (TclIsVarUndefined(varPtr)) {
		continue;
	    }
	    varNamePtr = VarHashGetKey(varPtr);
	    varName = TclGetString(varNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, varNamePtr);