Tcl Source Code

Check-in [2869529c82]
Login

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

Overview
Comment:Merge to feature branch
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dkf-notifier-poll
Files: files | file ages | folders
SHA1: 2869529c828e2edd91ec51e41ce86174ad7a4df7
User & Date: dkf 2011-03-28 09:32:17
Context
2011-03-31
10:05
Merge to feature branch check-in: ca02b70013 user: dkf tags: dkf-notifier-poll
2011-03-28
09:32
Merge to feature branch check-in: 2869529c82 user: dkf tags: dkf-notifier-poll
2011-03-27
22:43
* generic/tclBasic.c (TclNREvalObjEx): fix performance issue, notably apparent in tclbench's 'LIST l... check-in: 98907640f3 user: mig tags: trunk
2011-03-26
07:24
Merge to feature branch check-in: 2c89760d75 user: dkf tags: dkf-notifier-poll
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.



















1
2
3
4
5
6
7


















2011-03-24  Don Porter  <[email protected]>

	* generic/tcl.h (ckfree,etc.): Restored C++ usability to the memory
	allocation and free macros.

2011-03-24  Donal K. Fellows  <[email protected]>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
2011-03-27  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNREvalObjEx): fix performance issue,
	notably apparent in tclbench's "LIST lset foreach". Many thanks to
	twylite for patiently researching the issue and explaining it to
	me: a missing Tcl_ResetObjResult that causes unwanted sharing of
	the current result Tcl_Obj. 

2011-03-26  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (Tcl_Export, Tcl_Import, DoImport): More
	generation of errorCode information.

	* generic/tclCompExpr.c, generic/tclCompile.c, generic/tclExecute.c:
	* generic/tclListObj.c, generic/tclNamesp.c, generic/tclObj.c:
	* generic/tclStringObj.c, generic/tclUtil.c: Reduce the number of
	casts used to manage Tcl_Obj internal representations.

2011-03-24  Don Porter  <[email protected]>

	* generic/tcl.h (ckfree,etc.): Restored C++ usability to the memory
	allocation and free macros.

2011-03-24  Donal K. Fellows  <[email protected]>

Changes to generic/tcl.h.

795
796
797
798
799
800
801
802

803



804
805
806
807
808
809
810
811
812
813
	double doubleValue;	/*   - a double-precision floating value. */
	void *otherValuePtr;	/*   - another, type-specific value. */
	Tcl_WideInt wideValue;	/*   - a long long value. */
	struct {		/*   - internal rep as two pointers. */
	    void *ptr1;
	    void *ptr2;
	} twoPtrValue;
	struct {		/*   - internal rep as a wide int, tightly

				 *     packed fields. */



	    void *ptr;		/* Pointer to digits. */
	    unsigned long value;/* Alloc, used, and signum packed into a
				 * single word. */
	} ptrAndLongRep;
    } internalRep;
} Tcl_Obj;

/*
 * Macros to increment and decrement a Tcl_Obj's reference count, and to test
 * whether an object is shared (i.e. has reference count > 1). Note: clients







|
>
|
>
>
>
|
|
<







795
796
797
798
799
800
801
802
803
804
805
806
807
808
809

810
811
812
813
814
815
816
	double doubleValue;	/*   - a double-precision floating value. */
	void *otherValuePtr;	/*   - another, type-specific value. */
	Tcl_WideInt wideValue;	/*   - a long long value. */
	struct {		/*   - internal rep as two pointers. */
	    void *ptr1;
	    void *ptr2;
	} twoPtrValue;
	struct {		/*   - internal rep as a pointer and a long,
				 *     the main use of which is a bignum's
				 *     tightly packed fields, where the alloc,
				 *     used and signum flags are packed into a
				 *     single word with everything else hung
				 *     off the pointer. */
	    void *ptr;
	    unsigned long value;

	} ptrAndLongRep;
    } internalRep;
} Tcl_Obj;

/*
 * Macros to increment and decrement a Tcl_Obj's reference count, and to test
 * whether an object is shared (i.e. has reference count > 1). Note: clients

Changes to generic/tclBasic.c.

6014
6015
6016
6017
6018
6019
6020



6021
6022
6023
6024
6025
6026
6027

	int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
	ByteCode *codePtr;
	CallFrame *savedVarFramePtr = NULL;	/* Saves old copy of
						 * iPtr->varFramePtr in case
						 * TCL_EVAL_GLOBAL was set. */




	if (flags & TCL_EVAL_GLOBAL) {
	    savedVarFramePtr = iPtr->varFramePtr;
	    iPtr->varFramePtr = iPtr->rootFramePtr;
	}
	Tcl_IncrRefCount(objPtr);
	codePtr = TclCompileObj(interp, objPtr, invoker, word);








>
>
>







6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030

	int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
	ByteCode *codePtr;
	CallFrame *savedVarFramePtr = NULL;	/* Saves old copy of
						 * iPtr->varFramePtr in case
						 * TCL_EVAL_GLOBAL was set. */

        if (TclInterpReady(interp) != TCL_OK) {
            return TCL_ERROR;
        }
	if (flags & TCL_EVAL_GLOBAL) {
	    savedVarFramePtr = iPtr->varFramePtr;
	    iPtr->varFramePtr = iPtr->rootFramePtr;
	}
	Tcl_IncrRefCount(objPtr);
	codePtr = TclCompileObj(interp, objPtr, invoker, word);

Changes to generic/tclCompExpr.c.

2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
    CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
	    0 /* optimize */);
    TclEmitOpcode(INST_DONE, envPtr);
    Tcl_IncrRefCount(byteCodeObj);
    TclInitByteCodeObj(byteCodeObj, envPtr);
    TclFreeCompileEnv(envPtr);
    TclStackFree(interp, envPtr);
    byteCodePtr = (ByteCode *) byteCodeObj->internalRep.otherValuePtr;
    TclNRExecuteByteCode(interp, byteCodePtr);
    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
    Tcl_DecrRefCount(byteCodeObj);
    return code;
}

/*







|







2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
    CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
	    0 /* optimize */);
    TclEmitOpcode(INST_DONE, envPtr);
    Tcl_IncrRefCount(byteCodeObj);
    TclInitByteCodeObj(byteCodeObj, envPtr);
    TclFreeCompileEnv(envPtr);
    TclStackFree(interp, envPtr);
    byteCodePtr = byteCodeObj->internalRep.otherValuePtr;
    TclNRExecuteByteCode(interp, byteCodePtr);
    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
    Tcl_DecrRefCount(byteCodeObj);
    return code;
}

/*

Changes to generic/tclCompile.c.

997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
{
    Interp *iPtr = (Interp *) interp;
    ByteCode *codePtr = NULL;

    if (objPtr->typePtr == &substCodeType) {
	Namespace *nsPtr = iPtr->varFramePtr->nsPtr;

	codePtr = (ByteCode *) objPtr->internalRep.ptrAndLongRep.ptr;
	if ((unsigned long)flags != objPtr->internalRep.ptrAndLongRep.value
		|| ((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
		|| (codePtr->localCachePtr !=
		iPtr->varFramePtr->localCachePtr)) {







|







997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
{
    Interp *iPtr = (Interp *) interp;
    ByteCode *codePtr = NULL;

    if (objPtr->typePtr == &substCodeType) {
	Namespace *nsPtr = iPtr->varFramePtr->nsPtr;

	codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
	if ((unsigned long)flags != objPtr->internalRep.ptrAndLongRep.value
		|| ((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
		|| (codePtr->localCachePtr !=
		iPtr->varFramePtr->localCachePtr)) {

Changes to generic/tclExecute.c.

185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
#define TEBC_YIELD()					\
    esPtr->tosPtr = tosPtr;				\
    TD->pc = pc;					\
    TD->cleanup = cleanup;				\
    TclNRAddCallback(interp, TEBCresume, TD,	\
	    INT2PTR(1), NULL, NULL)
    
#define TEBC_DATA_DIG()				\
    pc = TD->pc;				\
    cleanup = TD->cleanup;			\
    tosPtr = esPtr->tosPtr
    

#define PUSH_TAUX_OBJ(objPtr) \
    do {							\
	objPtr->internalRep.twoPtrValue.ptr2 = auxObjList;	\
	auxObjList = objPtr;					\
    } while (0)

#define POP_TAUX_OBJ() \
    do {								\
	tmpPtr = auxObjList;						\
	auxObjList = (Tcl_Obj *) tmpPtr->internalRep.twoPtrValue.ptr2;	\
	Tcl_DecrRefCount(tmpPtr);					\
    } while (0)

/*
 * These variable-access macros have to coincide with those in tclVar.c
 */

#define VarHashGetValue(hPtr) \







|







|




|
|
|
|







185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
#define TEBC_YIELD()					\
    esPtr->tosPtr = tosPtr;				\
    TD->pc = pc;					\
    TD->cleanup = cleanup;				\
    TclNRAddCallback(interp, TEBCresume, TD,	\
	    INT2PTR(1), NULL, NULL)
    
#define TEBC_DATA_DIG() \
    pc = TD->pc;				\
    cleanup = TD->cleanup;			\
    tosPtr = esPtr->tosPtr
    

#define PUSH_TAUX_OBJ(objPtr) \
    do {							\
	objPtr->internalRep.ptrAndLongRep.ptr = auxObjList;	\
	auxObjList = objPtr;					\
    } while (0)

#define POP_TAUX_OBJ() \
    do {							\
	tmpPtr = auxObjList;					\
	auxObjList = tmpPtr->internalRep.ptrAndLongRep.ptr;	\
	Tcl_DecrRefCount(tmpPtr);				\
    } while (0)

/*
 * These variable-access macros have to coincide with those in tclVar.c
 */

#define VarHashGetValue(hPtr) \
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
    /*
     * Get the expression ByteCode from the object. If it exists, make sure it
     * is valid in the current context.
     */
    if (objPtr->typePtr == &exprCodeType) {
	Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;

	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != namespacePtr)
		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
	    FreeExprCodeInternalRep(objPtr);
	}







|







1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
    /*
     * Get the expression ByteCode from the object. If it exists, make sure it
     * is valid in the current context.
     */
    if (objPtr->typePtr == &exprCodeType) {
	Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;

	codePtr = objPtr->internalRep.otherValuePtr;
	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != namespacePtr)
		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
	    FreeExprCodeInternalRep(objPtr);
	}
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
	 * aux data items is given to the ByteCode object.
	 */

	TclEmitOpcode(INST_DONE, &compEnv);
	TclInitByteCodeObj(objPtr, &compEnv);
	objPtr->typePtr = &exprCodeType;
	TclFreeCompileEnv(&compEnv);
	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
	if (iPtr->varFramePtr->localCachePtr) {
	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	    codePtr->localCachePtr->refCount++;
	}
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile == 2) {
	    TclPrintByteCodeObj(interp, objPtr);







|







1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
	 * aux data items is given to the ByteCode object.
	 */

	TclEmitOpcode(INST_DONE, &compEnv);
	TclInitByteCodeObj(objPtr, &compEnv);
	objPtr->typePtr = &exprCodeType;
	TclFreeCompileEnv(&compEnv);
	codePtr = objPtr->internalRep.otherValuePtr;
	if (iPtr->varFramePtr->localCachePtr) {
	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	    codePtr->localCachePtr->refCount++;
	}
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile == 2) {
	    TclPrintByteCodeObj(interp, objPtr);
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
 *----------------------------------------------------------------------
 */

static void
FreeExprCodeInternalRep(
    Tcl_Obj *objPtr)
{
    ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;

    objPtr->typePtr = NULL;
    objPtr->internalRep.otherValuePtr = NULL;
    codePtr->refCount--;
    if (codePtr->refCount <= 0) {
	TclCleanupByteCode(codePtr);
    }







|







1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
 *----------------------------------------------------------------------
 */

static void
FreeExprCodeInternalRep(
    Tcl_Obj *objPtr)
{
    ByteCode *codePtr = objPtr->internalRep.otherValuePtr;

    objPtr->typePtr = NULL;
    objPtr->internalRep.otherValuePtr = NULL;
    codePtr->refCount--;
    if (codePtr->refCount <= 0) {
	TclCleanupByteCode(codePtr);
    }
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
	 * originating procPtr is the same as the current context procPtr
	 * (assuming one exists at all - none for global level). This code is
	 * #def'ed out because [info body] was changed to never return a
	 * bytecode type object, which should obviate us from the extra checks
	 * here.
	 */

	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != namespacePtr)
		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
	    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
		if ((Interp *) *codePtr->interpHandle != iPtr) {
		    Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");







|







1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
	 * originating procPtr is the same as the current context procPtr
	 * (assuming one exists at all - none for global level). This code is
	 * #def'ed out because [info body] was changed to never return a
	 * bytecode type object, which should obviate us from the extra checks
	 * here.
	 */

	codePtr = objPtr->internalRep.otherValuePtr;
	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != namespacePtr)
		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
	    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
		if ((Interp *) *codePtr->interpHandle != iPtr) {
		    Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696

1697
1698
1699





1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
	 * (3) Alternative 2: Do not fully recompile, adjust just the location
	 *     information.
	 */

	{
	    Tcl_HashEntry *hePtr =
		    Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	    if (hePtr) {
		ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);

		int redo = 0;

		if (invoker) {





		    CmdFrame *ctxPtr = TclStackAlloc(interp,sizeof(CmdFrame));
		    *ctxPtr = *invoker;

		    if (invoker->type == TCL_LOCATION_BC) {
			/*
			 * Note: Type BC => ctx.data.eval.path    is not used.
			 *		    ctx.data.tebc.codePtr used instead
			 */

			TclGetSrcInfoForPc(ctxPtr);
			if (ctxPtr->type == TCL_LOCATION_SOURCE) {
			    /*
			     * The reference made by 'TclGetSrcInfoForPc' is
			     * dead.
			     */

			    Tcl_DecrRefCount(ctxPtr->data.eval.path);
			    ctxPtr->data.eval.path = NULL;
			}
		    }

		    if (word < ctxPtr->nline) {
			/*
			 * Note: We do not care if the line[word] is -1. This
			 * is a difference and requires a recompile (location
			 * changed from absolute to relative, literal is used
			 * fixed and through variable)
			 *
			 * Example:
			 * test info-32.0 using literal of info-24.8
			 *     (dict with ... vs           set body ...).
			 */

			redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
				    && (eclPtr->start != ctxPtr->line[word]))
				|| ((eclPtr->type == TCL_LOCATION_BC)
				    && (ctxPtr->type == TCL_LOCATION_SOURCE));
		    }

		    TclStackFree(interp, ctxPtr);
		}

		if (redo) {
		    goto recompileObj;
		}
	    }
	}

	/*
	 * Increment the code's ref count while it is being executed. If
	 * afterwards no references to it remain, free the code.
	 */

    runCompiledObj:
	return codePtr;
    }

  recompileObj:
    iPtr->errorLine = 1;

    /*
     * TIP #280. Remember the invoker for a moment in the interpreter







<
<
|
>
|

|
>
>
>
>
>
|
|

|
|
|
|
|

|
|
|
|
<
|

|
|
|
|

|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|

|
<
<
|
|
|
|
<
<
<
<
<
<
<
<
<







1687
1688
1689
1690
1691
1692
1693


1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716

1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742


1743
1744
1745
1746









1747
1748
1749
1750
1751
1752
1753
	 * (3) Alternative 2: Do not fully recompile, adjust just the location
	 *     information.
	 */

	{
	    Tcl_HashEntry *hePtr =
		    Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);


	    ExtCmdLoc *eclPtr;
	    CmdFrame *ctxPtr;
	    int redo;

	    if (!hePtr || !invoker) {
		return codePtr;
	    }

	    eclPtr = Tcl_GetHashValue(hePtr);
	    redo = 0;
	    ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
	    *ctxPtr = *invoker;

	    if (invoker->type == TCL_LOCATION_BC) {
		/*
		 * Note: Type BC => ctx.data.eval.path    is not used.
		 *		    ctx.data.tebc.codePtr used instead
		 */

		TclGetSrcInfoForPc(ctxPtr);
		if (ctxPtr->type == TCL_LOCATION_SOURCE) {
		    /*
		     * The reference made by 'TclGetSrcInfoForPc' is dead.

		     */

		    Tcl_DecrRefCount(ctxPtr->data.eval.path);
		    ctxPtr->data.eval.path = NULL;
		}
	    }

	    if (word < ctxPtr->nline) {
		/*
		 * Note: We do not care if the line[word] is -1. This is a
		 * difference and requires a recompile (location changed from
		 * absolute to relative, literal is used fixed and through
		 * variable)
		 *
		 * Example:
		 * test info-32.0 using literal of info-24.8
		 *     (dict with ... vs           set body ...).
		 */

		redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
			    && (eclPtr->start != ctxPtr->line[word]))
			|| ((eclPtr->type == TCL_LOCATION_BC)
			    && (ctxPtr->type == TCL_LOCATION_SOURCE));
	    }

	    TclStackFree(interp, ctxPtr);


	    if (!redo) {
		return codePtr;
	    }
	}









    }

  recompileObj:
    iPtr->errorLine = 1;

    /*
     * TIP #280. Remember the invoker for a moment in the interpreter
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
    tclByteCodeType.setFromAnyProc(interp, objPtr);
    iPtr->invokeCmdFramePtr = NULL;
    codePtr = objPtr->internalRep.otherValuePtr;
    if (iPtr->varFramePtr->localCachePtr) {
	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	codePtr->localCachePtr->refCount++;
    }
    goto runCompiledObj;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrObj --
 *







|







1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
    tclByteCodeType.setFromAnyProc(interp, objPtr);
    iPtr->invokeCmdFramePtr = NULL;
    codePtr = objPtr->internalRep.otherValuePtr;
    if (iPtr->varFramePtr->localCachePtr) {
	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	codePtr->localCachePtr->refCount++;
    }
    return codePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIncrObj --
 *
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
	if (result == TCL_OK) {
#ifndef TCL_COMPILE_DEBUG
	    if (*pc == INST_POP) {
		NEXT_INST_V(1, cleanup, 0);
	    }
#endif
	    /*
	     * Push the call's object result and continue execution with
	     * the next instruction.
	     */
	    
	    TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
			    objc, cmdNameBuf), Tcl_GetObjResult(interp));
	    
	    objResultPtr = Tcl_GetObjResult(interp);
	    
	    /*
	     * Reset the interp's result to avoid possible duplications of
	     * large objects [Bug 781585]. We do not call Tcl_ResetResult
	     * to avoid any side effects caused by the resetting of
	     * errorInfo and errorCode [Bug 804681], which are not needed
	     * here. We chose instead to manipulate the interp's object
	     * result directly. 
	     *
	     * Note that the result object is now in objResultPtr, it
	     * keeps the refCount it had in its role of
	     * iPtr->objResultPtr. 
	     */
	    
	    TclNewObj(objPtr);
	    Tcl_IncrRefCount(objPtr);
	    iPtr->objResultPtr = objPtr;
	    NEXT_INST_V(0, cleanup, -1);		
	}







|
|









|
|
|
|
<

|
|
<







2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130

2131
2132
2133

2134
2135
2136
2137
2138
2139
2140
	if (result == TCL_OK) {
#ifndef TCL_COMPILE_DEBUG
	    if (*pc == INST_POP) {
		NEXT_INST_V(1, cleanup, 0);
	    }
#endif
	    /*
	     * Push the call's object result and continue execution with the
	     * next instruction.
	     */
	    
	    TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
			    objc, cmdNameBuf), Tcl_GetObjResult(interp));
	    
	    objResultPtr = Tcl_GetObjResult(interp);
	    
	    /*
	     * Reset the interp's result to avoid possible duplications of
	     * large objects [Bug 781585]. We do not call Tcl_ResetResult to
	     * avoid any side effects caused by the resetting of errorInfo and
	     * errorCode [Bug 804681], which are not needed here. We chose
	     * instead to manipulate the interp's object result directly.

	     *
	     * Note that the result object is now in objResultPtr, it keeps
	     * the refCount it had in its role of iPtr->objResultPtr.

	     */
	    
	    TclNewObj(objPtr);
	    Tcl_IncrRefCount(objPtr);
	    iPtr->objResultPtr = objPtr;
	    NEXT_INST_V(0, cleanup, -1);		
	}
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) CURR_DEPTH;
	PUSH_TAUX_OBJ(objPtr);
	NEXT_INST_F(1, 0, 0);

    case INST_EXPAND_STKTOP: {
	int i;
	ptrdiff_t moved;








|







2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
	 * we do not define a special tclObjType for it. It is not dangerous
	 * as the obj is never passed anywhere, so that all manipulations are
	 * performed here and in INST_INVOKE_EXPANDED (in case of an expansion
	 * error, also in INST_EXPAND_STKTOP).
	 */

	TclNewObj(objPtr);
	objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
	PUSH_TAUX_OBJ(objPtr);
	NEXT_INST_F(1, 0, 0);

    case INST_EXPAND_STKTOP: {
	int i;
	ptrdiff_t moved;

2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
	cleanup = 1;
	pc += 1;
	TEBC_YIELD();
	return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0);

    case INST_INVOKE_EXPANDED:
	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH
		- (ptrdiff_t) auxObjList->internalRep.twoPtrValue.ptr1;
	POP_TAUX_OBJ();
	if (objc) {
	    pcAdjustment = 1;
	    goto doInvocation;
	}

	/*







|
<







2713
2714
2715
2716
2717
2718
2719
2720

2721
2722
2723
2724
2725
2726
2727
	cleanup = 1;
	pc += 1;
	TEBC_YIELD();
	return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0);

    case INST_INVOKE_EXPANDED:
	CLANG_ASSERT(auxObjList);
	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;

	POP_TAUX_OBJ();
	if (objc) {
	    pcAdjustment = 1;
	    goto doInvocation;
	}

	/*
4411
4412
4413
4414
4415
4416
4417

4418
4419
4420
4421
4422
4423
4424
	    match = 0;
	} else {
	    /*
	     * We only need to check (in)equality when we have equal length
	     * strings.  We can use memcmp in all (n)eq cases because we
	     * don't need to worry about lexical LE/BE variance.
	     */

	    typedef int (*memCmpFn_t)(const void*, const void*, size_t);
	    memCmpFn_t memCmpFn;
	    int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
		    || (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));

	    if (TclIsPureByteArray(valuePtr)
		    && TclIsPureByteArray(value2Ptr)) {







>







4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
	    match = 0;
	} else {
	    /*
	     * We only need to check (in)equality when we have equal length
	     * strings.  We can use memcmp in all (n)eq cases because we
	     * don't need to worry about lexical LE/BE variance.
	     */

	    typedef int (*memCmpFn_t)(const void*, const void*, size_t);
	    memCmpFn_t memCmpFn;
	    int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
		    || (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));

	    if (TclIsPureByteArray(valuePtr)
		    && TclIsPureByteArray(value2Ptr)) {
6255
6256
6257
6258
6259
6260
6261
6262

6263
6264
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
	    goto abnormalReturn;
	}
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    const unsigned char *pcBeg;

	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
	    DECACHE_STACK_INFO();
	    TclLogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0, pcBeg, tosPtr);

	    CACHE_STACK_INFO();
	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.
	 */

	while (auxObjList) {
	    if ((catchTop != initCatchTop) && (*catchTop >
		    (ptrdiff_t) auxObjList->internalRep.twoPtrValue.ptr1)) {
		break;
	    }
	    POP_TAUX_OBJ();
	}

	/*
	 * We must not catch if the script in progress has been canceled with







|
>










|
|







6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
6265
6266
6267
6268
6269
6270
6271
6272
	    goto abnormalReturn;
	}
	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	    const unsigned char *pcBeg;

	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
	    DECACHE_STACK_INFO();
	    TclLogCommandInfo(interp, codePtr->source, bytes,
		    bytes ? length : 0, pcBeg, tosPtr);
	    CACHE_STACK_INFO();
	}
	iPtr->flags &= ~ERR_ALREADY_LOGGED;

	/*
	 * Clear all expansions that may have started after the last
	 * INST_BEGIN_CATCH.
	 */

	while (auxObjList) {
	    if ((catchTop != initCatchTop) &&
		    (*catchTop>auxObjList->internalRep.ptrAndLongRep.value)) {
		break;
	    }
	    POP_TAUX_OBJ();
	}

	/*
	 * We must not catch if the script in progress has been canceled with

Changes to generic/tclListObj.c.

177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    }

    /*
     * Now create the object.
     */

    Tcl_InvalidateStringRep(listPtr);
    listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
    listPtr->typePtr = &tclListType;
    listRepPtr->refCount++;

    return listPtr;
}
#endif /* if TCL_MEM_DEBUG */







|







177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    }

    /*
     * Now create the object.
     */

    Tcl_InvalidateStringRep(listPtr);
    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
    listPtr->typePtr = &tclListType;
    listRepPtr->refCount++;

    return listPtr;
}
#endif /* if TCL_MEM_DEBUG */
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
    }

    /*
     * Now create the object.
     */

    Tcl_InvalidateStringRep(listPtr);
    listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
    listPtr->typePtr = &tclListType;
    listRepPtr->refCount++;

    return listPtr;
}








|







249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
    }

    /*
     * Now create the object.
     */

    Tcl_InvalidateStringRep(listPtr);
    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
    listPtr->internalRep.twoPtrValue.ptr2 = NULL;
    listPtr->typePtr = &tclListType;
    listRepPtr->refCount++;

    return listPtr;
}

325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
     */

    if (objc > 0) {
	listRepPtr = NewListIntRep(objc, objv);
	if (!listRepPtr) {
	    Tcl_Panic("Cannot allocate enough memory for Tcl_SetListObj");
	}
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	objPtr->typePtr = &tclListType;
	listRepPtr->refCount++;
    } else {
	objPtr->bytes = tclEmptyStringRep;
	objPtr->length = 0;
    }







|







325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
     */

    if (objc > 0) {
	listRepPtr = NewListIntRep(objc, objv);
	if (!listRepPtr) {
	    Tcl_Panic("Cannot allocate enough memory for Tcl_SetListObj");
	}
	objPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	objPtr->typePtr = &tclListType;
	listRepPtr->refCount++;
    } else {
	objPtr->bytes = tclEmptyStringRep;
	objPtr->length = 0;
    }
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
	}

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }
    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    *objcPtr = listRepPtr->elemCount;
    *objvPtr = &listRepPtr->elements;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|







442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
	}

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }
    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    *objcPtr = listRepPtr->elemCount;
    *objvPtr = &listRepPtr->elements;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    numElems = listRepPtr->elemCount;
    numRequired = numElems + 1 ;

    /*
     * If there is no room in the current array of element pointers, allocate
     * a new, larger array and copy the pointers to it. If the List struct is
     * shared, allocate a new one.







|







560
561
562
563
564
565
566
567
568
569
570
571
572
573
574

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    numElems = listRepPtr->elemCount;
    numRequired = numElems + 1 ;

    /*
     * If there is no room in the current array of element pointers, allocate
     * a new, larger array and copy the pointers to it. If the List struct is
     * shared, allocate a new one.
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    if ((index < 0) || (index >= listRepPtr->elemCount)) {
	*objPtrPtr = NULL;
    } else {
	*objPtrPtr = (&listRepPtr->elements)[index];
    }

    return TCL_OK;







|







670
671
672
673
674
675
676
677
678
679
680
681
682
683
684

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    if ((index < 0) || (index >= listRepPtr->elemCount)) {
	*objPtrPtr = NULL;
    } else {
	*objPtrPtr = (&listRepPtr->elements)[index];
    }

    return TCL_OK;
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    *intPtr = listRepPtr->elemCount;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|







725
726
727
728
729
730
731
732
733
734
735
736
737
738
739

	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    *intPtr = listRepPtr->elemCount;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
     * Note that when count == 0 and objc == 0, this routine is logically a
     * no-op, removing and adding no elements to the list. However, by flowing
     * through this routine anyway, we get the important side effect that the
     * resulting listPtr is a list in canoncial form. This is important.
     * Resist any temptation to optimize this case.
     */

    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    elemPtrs = &listRepPtr->elements;
    numElems = listRepPtr->elemCount;

    if (first < 0) {
	first = 0;
    }
    if (first >= numElems) {







|







812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
     * Note that when count == 0 and objc == 0, this routine is logically a
     * no-op, removing and adding no elements to the list. However, by flowing
     * through this routine anyway, we get the important side effect that the
     * resulting listPtr is a list in canoncial form. This is important.
     * Resist any temptation to optimize this case.
     */

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    elemPtrs = &listRepPtr->elements;
    numElems = listRepPtr->elemCount;

    if (first < 0) {
	first = 0;
    }
    if (first >= numElems) {
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
	}

	listRepPtr = NewListIntRep(newMax, NULL);
	if (!listRepPtr) {
	    Tcl_Panic("Not enough memory to allocate list");
	}

	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
	listRepPtr->refCount++;

	elemPtrs = &listRepPtr->elements;

	if (isShared) {
	    /*
	     * The old struct will remain in place; need new refCounts for the







|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
	}

	listRepPtr = NewListIntRep(newMax, NULL);
	if (!listRepPtr) {
	    Tcl_Panic("Not enough memory to allocate list");
	}

	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
	listRepPtr->refCount++;

	elemPtrs = &listRepPtr->elements;

	if (isShared) {
	    /*
	     * The old struct will remain in place; need new refCounts for the
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
 *
 * TclLsetFlat --
 *
 *	Core engine of the 'lset' command.
 *
 * Results:
 *	Returns the new value of the list variable, or NULL if an error
 *	occurred. The returned object includes one reference count for
 *	the pointer returned.
 *
 * Side effects:
 *	On entry, the reference count of the variable value does not reflect
 *	any references held on the stack. The first action of this function is
 *	to determine whether the object is shared, and to duplicate it if it
 *	is. The reference count of the duplicate is incremented. At this
 *	point, the reference count will be 1 for either case, so that the







|
|







1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
 *
 * TclLsetFlat --
 *
 *	Core engine of the 'lset' command.
 *
 * Results:
 *	Returns the new value of the list variable, or NULL if an error
 *	occurred. The returned object includes one reference count for the
 *	pointer returned.
 *
 * Side effects:
 *	On entry, the reference count of the variable value does not reflect
 *	any references held on the stack. The first action of this function is
 *	to determine whether the object is shared, and to duplicate it if it
 *	is. The reference count of the duplicate is incremented. At this
 *	point, the reference count will be 1 for either case, so that the
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
				/* Index args. */
    Tcl_Obj *valuePtr)		/* Value arg to 'lset'. */
{
    int index, result, len;
    Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;

    /*
     * If there are no indices, simply return the new value.
     * (Without indices, [lset] is a synonym for [set].
     */

    if (indexCount == 0) {
	Tcl_IncrRefCount(valuePtr);
	return valuePtr;
    }

    /*
     * If the list is shared, make a copy we can modify (copy-on-write).
     * We use Tcl_DuplicateObj() instead of TclListObjCopy() for a few
     * reasons: 1) we have not yet confirmed listPtr is actually a list;
     * 2) We make a verbatim copy of any existing string rep, and when
     * we combine that with the delayed invalidation of string reps of
     * modified Tcl_Obj's implemented below, the outcome is that any
     * error condition that causes this routine to return NULL, will
     * leave the string rep of listPtr and all elements to be unchanged.
     */

    subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValuePtr = subListPtr;
    chainPtr = NULL;

    /*
     * Loop through all the index arguments, and for each one dive
     * into the appropriate sublist.
     */

    do {
	int elemCount;
	Tcl_Obj *parentList, **elemPtrs;

	/* Check for the possible error conditions... */







|
|








|
|
|
|
|
|
|
|













|
|







1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
				/* Index args. */
    Tcl_Obj *valuePtr)		/* Value arg to 'lset'. */
{
    int index, result, len;
    Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;

    /*
     * If there are no indices, simply return the new value.  (Without
     * indices, [lset] is a synonym for [set].
     */

    if (indexCount == 0) {
	Tcl_IncrRefCount(valuePtr);
	return valuePtr;
    }

    /*
     * If the list is shared, make a copy we can modify (copy-on-write).  We
     * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:
     * 1) we have not yet confirmed listPtr is actually a list; 2) We make a
     * verbatim copy of any existing string rep, and when we combine that with
     * the delayed invalidation of string reps of modified Tcl_Obj's
     * implemented below, the outcome is that any error condition that causes
     * this routine to return NULL, will leave the string rep of listPtr and
     * all elements to be unchanged.
     */

    subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValuePtr = subListPtr;
    chainPtr = NULL;

    /*
     * Loop through all the index arguments, and for each one dive into the
     * appropriate sublist.
     */

    do {
	int elemCount;
	Tcl_Obj *parentList, **elemPtrs;

	/* Check for the possible error conditions... */
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421

1422


1423
1424
1425
1426
1427
1428
1429
1430
1431

1432
1433
1434
1435
1436
1437

1438


1439
1440
1441
1442
1443
1444
1445
	    /* ...the index points outside the sublist. */
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("list index out of range", -1));
	    break;
	}

	/*
	 * No error conditions.  As long as we're not yet on the last
	 * index, determine the next sublist for the next pass through
	 * the loop, and take steps to make sure it is an unshared copy,
	 * as we intend to modify it.
	 */

	result = TCL_OK;
	if (--indexCount) {
	    parentList = subListPtr;
	    if (index == elemCount) {
		subListPtr = Tcl_NewObj();
	    } else {
		subListPtr = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
	    }

	    /*
	     * Replace the original elemPtr[index] in parentList with a copy
	     * we know to be unshared.  This call will also deal with the
	     * situation where parentList shares its intrep with other
	     * Tcl_Obj's.  Dealing with the shared intrep case can cause
	     * subListPtr to become shared again, so detect that case and
	     * make and store another copy.
	     */

	    if (index == elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }

	    /*
	     * The TclListObjSetElement() calls do not spoil the string
	     * rep of parentList, and that's fine for now, since all we've
	     * done so far is replace a list element with an unshared copy.
	     * The list value remains the same, so the string rep. is still
	     * valid, and unchanged, which is good because if this whole
	     * routine returns NULL, we'd like to leave no change to the
	     * value of the lset variable.  Later on, when we set valuePtr
	     * in its proper place, then all containing lists will have
	     * their values changed, and will need their string reps spoiled.
	     * We maintain a list of all those Tcl_Obj's (via a little intrep
	     * surgery) so we can spoil them at that time.
	     */

	    parentList->internalRep.twoPtrValue.ptr2 = (void *) chainPtr;
	    chainPtr = parentList;
	}
    } while (indexCount > 0);

    /*
     * Either we've detected and error condition, and exited the loop
     * with result == TCL_ERROR, or we've successfully reached the last
     * index, and we're ready to store valuePtr.  In either case, we
     * need to clean up our string spoiling list of Tcl_Obj's.
     */

    while (chainPtr) {
	Tcl_Obj *objPtr = chainPtr;

	if (result == TCL_OK) {

	    /*
	     * We're going to store valuePtr, so spoil string reps
	     * of all containing lists.
	     */

	    Tcl_InvalidateStringRep(objPtr);
	}


	/* Clear away our intrep surgery mess */


	chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    }

    if (result != TCL_OK) {
	/*
	 * Error return; message is already in interp. Clean up
	 * any excess memory.
	 */

	if (retValuePtr != listPtr) {
	    Tcl_DecrRefCount(retValuePtr);
	}
	return NULL;
    }


    /* Store valuePtr in proper sublist and return */


    Tcl_ListObjLength(NULL, subListPtr, &len);
    if (index == len) {
	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
    } else {
	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
    }
    Tcl_InvalidateStringRep(subListPtr);







|
|
|
|



















|
|













|
|
|
|
|
|
|
|
|
|
|


|





|
|
|
|






<

|
|





>
|
>
>
|





|
|

>






>
|
>
>







1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412

1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
	    /* ...the index points outside the sublist. */
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("list index out of range", -1));
	    break;
	}

	/*
	 * No error conditions.  As long as we're not yet on the last index,
	 * determine the next sublist for the next pass through the loop, and
	 * take steps to make sure it is an unshared copy, as we intend to
	 * modify it.
	 */

	result = TCL_OK;
	if (--indexCount) {
	    parentList = subListPtr;
	    if (index == elemCount) {
		subListPtr = Tcl_NewObj();
	    } else {
		subListPtr = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
	    }

	    /*
	     * Replace the original elemPtr[index] in parentList with a copy
	     * we know to be unshared.  This call will also deal with the
	     * situation where parentList shares its intrep with other
	     * Tcl_Obj's.  Dealing with the shared intrep case can cause
	     * subListPtr to become shared again, so detect that case and make
	     * and store another copy.
	     */

	    if (index == elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }

	    /*
	     * The TclListObjSetElement() calls do not spoil the string rep of
	     * parentList, and that's fine for now, since all we've done so
	     * far is replace a list element with an unshared copy.  The list
	     * value remains the same, so the string rep. is still valid, and
	     * unchanged, which is good because if this whole routine returns
	     * NULL, we'd like to leave no change to the value of the lset
	     * variable.  Later on, when we set valuePtr in its proper place,
	     * then all containing lists will have their values changed, and
	     * will need their string reps spoiled.  We maintain a list of all
	     * those Tcl_Obj's (via a little intrep surgery) so we can spoil
	     * them at that time.
	     */

	    parentList->internalRep.twoPtrValue.ptr2 = chainPtr;
	    chainPtr = parentList;
	}
    } while (indexCount > 0);

    /*
     * Either we've detected and error condition, and exited the loop with
     * result == TCL_ERROR, or we've successfully reached the last index, and
     * we're ready to store valuePtr.  In either case, we need to clean up our
     * string spoiling list of Tcl_Obj's.
     */

    while (chainPtr) {
	Tcl_Obj *objPtr = chainPtr;

	if (result == TCL_OK) {

	    /*
	     * We're going to store valuePtr, so spoil string reps of all
	     * containing lists.
	     */

	    Tcl_InvalidateStringRep(objPtr);
	}

	/*
	 * Clear away our intrep surgery mess.
	 */

	chainPtr = objPtr->internalRep.twoPtrValue.ptr2;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    }

    if (result != TCL_OK) {
	/*
	 * Error return; message is already in interp. Clean up any excess
	 * memory.
	 */

	if (retValuePtr != listPtr) {
	    Tcl_DecrRefCount(retValuePtr);
	}
	return NULL;
    }

    /*
     * Store valuePtr in proper sublist and return.
     */

    Tcl_ListObjLength(NULL, subListPtr, &len);
    if (index == len) {
	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
    } else {
	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
    }
    Tcl_InvalidateStringRep(subListPtr);
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    elemCount = listRepPtr->elemCount;
    elemPtrs = &listRepPtr->elements;

    /*
     * Ensure that the index is in bounds.
     */








|







1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    elemCount = listRepPtr->elemCount;
    elemPtrs = &listRepPtr->elements;

    /*
     * Ensure that the index is in bounds.
     */

1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
	elemPtrs = &listRepPtr->elements;
	for (i=0; i < elemCount; i++) {
	    elemPtrs[i] = oldElemPtrs[i];
	    Tcl_IncrRefCount(elemPtrs[i]);
	}
	listRepPtr->refCount++;
	listRepPtr->elemCount = elemCount;
	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
	oldListRepPtr->refCount--;
    }

    /*
     * Add a reference to the new list element.
     */








|







1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
	elemPtrs = &listRepPtr->elements;
	for (i=0; i < elemCount; i++) {
	    elemPtrs[i] = oldElemPtrs[i];
	    Tcl_IncrRefCount(elemPtrs[i]);
	}
	listRepPtr->refCount++;
	listRepPtr->elemCount = elemCount;
	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
	oldListRepPtr->refCount--;
    }

    /*
     * Add a reference to the new list element.
     */

1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
 *----------------------------------------------------------------------
 */

static void
FreeListInternalRep(
    Tcl_Obj *listPtr)		/* List object with internal rep to free. */
{
    register List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    register Tcl_Obj **elemPtrs = &listRepPtr->elements;
    register Tcl_Obj *objPtr;
    int numElems = listRepPtr->elemCount;
    int i;

    if (--listRepPtr->refCount <= 0) {
	for (i = 0;  i < numElems;  i++) {







|







1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
 *----------------------------------------------------------------------
 */

static void
FreeListInternalRep(
    Tcl_Obj *listPtr)		/* List object with internal rep to free. */
{
    register List *listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    register Tcl_Obj **elemPtrs = &listRepPtr->elements;
    register Tcl_Obj *objPtr;
    int numElems = listRepPtr->elemCount;
    int i;

    if (--listRepPtr->refCount <= 0) {
	for (i = 0;  i < numElems;  i++) {
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
 */

static void
DupListInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    List *listRepPtr = (List *) srcPtr->internalRep.twoPtrValue.ptr1;

    listRepPtr->refCount++;
    copyPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = &tclListType;
}

/*
 *----------------------------------------------------------------------
 *







|


|







1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
 */

static void
DupListInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    List *listRepPtr = srcPtr->internalRep.twoPtrValue.ptr1;

    listRepPtr->refCount++;
    copyPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    copyPtr->typePtr = &tclListType;
}

/*
 *----------------------------------------------------------------------
 *
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871

static void
UpdateStringOfList(
    Tcl_Obj *listPtr)		/* List object with string rep to update. */
{
#   define LOCAL_SIZE 20
    int localFlags[LOCAL_SIZE], *flagPtr;
    List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
    int numElems = listRepPtr->elemCount;
    register int i;
    const char *elem;
    char *dst;
    int length;
    Tcl_Obj **elemPtrs;








|







1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877

static void
UpdateStringOfList(
    Tcl_Obj *listPtr)		/* List object with string rep to update. */
{
#   define LOCAL_SIZE 20
    int localFlags[LOCAL_SIZE], *flagPtr;
    List *listRepPtr = listPtr->internalRep.twoPtrValue.ptr1;
    int numElems = listRepPtr->elemCount;
    register int i;
    const char *elem;
    char *dst;
    int length;
    Tcl_Obj **elemPtrs;

Changes to generic/tclNamesp.c.

907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
     *
     * NOTE: we could avoid traversing the ns's command list by keeping a
     * separate list of coros.
     */

    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    entryPtr != NULL;) {
	cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
	if (cmdPtr->nreProc == NRInterpCoroutine) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmdPtr);
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	} else {
	    entryPtr = Tcl_NextHashEntry(&search);
	}







|







907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
     *
     * NOTE: we could avoid traversing the ns's command list by keeping a
     * separate list of coros.
     */

    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    entryPtr != NULL;) {
	cmdPtr = Tcl_GetHashValue(entryPtr);
	if (cmdPtr->nreProc == NRInterpCoroutine) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmdPtr);
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	} else {
	    entryPtr = Tcl_NextHashEntry(&search);
	}
1331
1332
1333
1334
1335
1336
1337

1338
1339
1340
1341
1342
1343
1344
    TclGetNamespaceForQualName(interp, pattern, nsPtr,
	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
	    &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
	Tcl_AppendResult(interp, "invalid export pattern \"", pattern,
		"\": pattern can't specify a namespace", NULL);

	return TCL_ERROR;
    }

    /*
     * Make sure that we don't already have the pattern in the array
     */








>







1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
    TclGetNamespaceForQualName(interp, pattern, nsPtr,
	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
	    &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
	Tcl_AppendResult(interp, "invalid export pattern \"", pattern,
		"\": pattern can't specify a namespace", NULL);
        Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL);
	return TCL_ERROR;
    }

    /*
     * Make sure that we don't already have the pattern in the array
     */

1535
1536
1537
1538
1539
1540
1541

1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558

1559
1560
1561
1562

1563
1564
1565
1566
1567
1568
1569
    /*
     * From the pattern, find the namespace from which we are importing and
     * get the simple pattern (no namespace qualifiers or ::'s) at the end.
     */

    if (strlen(pattern) == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));

	return TCL_ERROR;
    }
    TclGetNamespaceForQualName(interp, pattern, nsPtr,
	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
	    &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if (importNsPtr == NULL) {
	Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
		pattern, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
	return TCL_ERROR;
    }
    if (importNsPtr == nsPtr) {
	if (pattern == simplePattern) {
	    Tcl_AppendResult(interp,
		    "no namespace specified in import pattern \"", pattern,
		    "\"", NULL);

	} else {
	    Tcl_AppendResult(interp, "import pattern \"", pattern,
		    "\" tries to import from namespace \"",
		    importNsPtr->name, "\" into itself", NULL);

	}
	return TCL_ERROR;
    }

    /*
     * Scan through the command table in the source namespace and look for
     * exported commands that match the string pattern. Create an "imported







>

















>




>







1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
    /*
     * From the pattern, find the namespace from which we are importing and
     * get the simple pattern (no namespace qualifiers or ::'s) at the end.
     */

    if (strlen(pattern) == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));
        Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL);
	return TCL_ERROR;
    }
    TclGetNamespaceForQualName(interp, pattern, nsPtr,
	    /*flags*/ (TCL_LEAVE_ERR_MSG | TCL_NAMESPACE_ONLY),
	    &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if (importNsPtr == NULL) {
	Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
		pattern, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
	return TCL_ERROR;
    }
    if (importNsPtr == nsPtr) {
	if (pattern == simplePattern) {
	    Tcl_AppendResult(interp,
		    "no namespace specified in import pattern \"", pattern,
		    "\"", NULL);
            Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", NULL);
	} else {
	    Tcl_AppendResult(interp, "import pattern \"", pattern,
		    "\" tries to import from namespace \"",
		    importNsPtr->name, "\" into itself", NULL);
            Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Scan through the command table in the source namespace and look for
     * exported commands that match the string pattern. Create an "imported
1677
1678
1679
1680
1681
1682
1683

1684
1685
1686
1687
1688
1689
1690
		dataPtr = linkCmd->objClientData;
		linkCmd = dataPtr->realCmdPtr;
		if (overwrite == linkCmd) {
		    Tcl_AppendResult(interp, "import pattern \"", pattern,
			    "\" would create a loop containing command \"",
			    Tcl_DStringValue(&ds), "\"", NULL);
		    Tcl_DStringFree(&ds);

		    return TCL_ERROR;
		}
	    }
	}

	dataPtr = ckalloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),







>







1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
		dataPtr = linkCmd->objClientData;
		linkCmd = dataPtr->realCmdPtr;
		if (overwrite == linkCmd) {
		    Tcl_AppendResult(interp, "import pattern \"", pattern,
			    "\" would create a loop containing command \"",
			    Tcl_DStringValue(&ds), "\"", NULL);
		    Tcl_DStringFree(&ds);
                    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
		    return TCL_ERROR;
		}
	    }
	}

	dataPtr = ckalloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
1716
1717
1718
1719
1720
1721
1722

1723
1724
1725
1726
1727
1728
1729
		 */

		return TCL_OK;
	    }
	}
	Tcl_AppendResult(interp, "can't import command \"", cmdName,
		"\": already exists", NULL);

	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







>







1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
		 */

		return TCL_OK;
	    }
	}
	Tcl_AppendResult(interp, "can't import command \"", cmdName,
		"\": already exists", NULL);
        Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819

    if (objPtr->typePtr == &nsNameType) {
	/*
	 * Check that the ResolvedNsName is still valid; avoid letting the ref
	 * cross interps.
	 */

	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
	nsPtr = resNamePtr->nsPtr;
	refNsPtr = resNamePtr->refNsPtr;
	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
		(!refNsPtr || ((interp == refNsPtr->interp) &&
		 (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))) {
	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
	    return TCL_OK;
	}
    }
    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*







|




|





|







2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825

    if (objPtr->typePtr == &nsNameType) {
	/*
	 * Check that the ResolvedNsName is still valid; avoid letting the ref
	 * cross interps.
	 */

	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
	nsPtr = resNamePtr->nsPtr;
	refNsPtr = resNamePtr->refNsPtr;
	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
		(!refNsPtr || ((interp == refNsPtr->interp) &&
		(refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))){
	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
	    return TCL_OK;
	}
    }
    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*

Changes to generic/tclObj.c.

4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
     * Free the old internalRep before setting the new one. Do this after
     * getting the string rep to allow the conversion code (in particular,
     * Tcl_GetStringFromObj) to use that old internalRep.
     */

    if (cmdPtr) {
	cmdPtr->refCount++;
	resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
	if ((objPtr->typePtr == &tclCmdNameType)
		&& resPtr && (resPtr->refCount == 1)) {
	    /*
	     * Reuse the old ResolvedCmdName struct instead of freeing it
	     */

	    Command *oldCmdPtr = resPtr->cmdPtr;







|







4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
     * Free the old internalRep before setting the new one. Do this after
     * getting the string rep to allow the conversion code (in particular,
     * Tcl_GetStringFromObj) to use that old internalRep.
     */

    if (cmdPtr) {
	cmdPtr->refCount++;
	resPtr = objPtr->internalRep.otherValuePtr;
	if ((objPtr->typePtr == &tclCmdNameType)
		&& resPtr && (resPtr->refCount == 1)) {
	    /*
	     * Reuse the old ResolvedCmdName struct instead of freeing it
	     */

	    Command *oldCmdPtr = resPtr->cmdPtr;

Changes to generic/tclStringObj.c.

130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
    if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
	Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		STRING_MAXCHARS); \
    }
#define stringAlloc(numChars) \
	(String *) ckalloc((unsigned) STRING_SIZE(numChars) )
#define stringRealloc(ptr, numChars) \
	(String *) ckrealloc((char *) ptr, (unsigned) STRING_SIZE(numChars) )
#define stringAttemptRealloc(ptr, numChars) \
	(String *) attemptckrealloc((char *) ptr, \
		(unsigned) STRING_SIZE(numChars) )
#define GET_STRING(objPtr) \
	((String *) (objPtr)->internalRep.otherValuePtr)
#define SET_STRING(objPtr, stringPtr) \
	((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))

/*
 * TCL STRING GROWTH ALGORITHM







|

|
<







130
131
132
133
134
135
136
137
138
139

140
141
142
143
144
145
146
    if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
	Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		STRING_MAXCHARS); \
    }
#define stringAlloc(numChars) \
	(String *) ckalloc((unsigned) STRING_SIZE(numChars) )
#define stringRealloc(ptr, numChars) \
    (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
#define stringAttemptRealloc(ptr, numChars) \
    (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )

#define GET_STRING(objPtr) \
	((String *) (objPtr)->internalRep.otherValuePtr)
#define SET_STRING(objPtr, stringPtr) \
	((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))

/*
 * TCL STRING GROWTH ALGORITHM

Changes to generic/tclTestObj.c.

519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
	 */

	if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
	    return TCL_ERROR;
	}

	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
	indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
	indexRep->index = index2;
	result = Tcl_GetIndexFromObj(NULL, objv[1],
		tablePtr, "token", 0, &index);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
	}
	return result;







|







519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
	 */

	if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
	    return TCL_ERROR;
	}

	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
	indexRep = objv[1]->internalRep.otherValuePtr;
	indexRep->index = index2;
	result = Tcl_GetIndexFromObj(NULL, objv[1],
		tablePtr, "token", 0, &index);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
	}
	return result;
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
     * that its address is different for each index object. If we accidently
     * allocate a table at the same address as that cached in the index
     * object, clear out the object's cached state.
     */

    if (objv[3]->typePtr != NULL
	    && !strcmp("index", objv[3]->typePtr->name)) {
	indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
	if (indexRep->tablePtr == (void *) argv) {
	    objv[3]->typePtr->freeIntRepProc(objv[3]);
	    objv[3]->typePtr = NULL;
	}
    }

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],







|







556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
     * that its address is different for each index object. If we accidently
     * allocate a table at the same address as that cached in the index
     * object, clear out the object's cached state.
     */

    if (objv[3]->typePtr != NULL
	    && !strcmp("index", objv[3]->typePtr->name)) {
	indexRep = objv[3]->internalRep.otherValuePtr;
	if (indexRep->tablePtr == (void *) argv) {
	    objv[3]->typePtr->freeIntRepProc(objv[3]);
	    objv[3]->typePtr = NULL;
	}
    }

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
	case 5:				/* length2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));
		strPtr = (TestString *)
		    (varPtr[varIndex])->internalRep.otherValuePtr;
		length = (int) strPtr->allocated;
	    } else {
		length = -1;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 6:				/* set */







<
|







1196
1197
1198
1199
1200
1201
1202

1203
1204
1205
1206
1207
1208
1209
1210
	case 5:				/* length2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));

		strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
		length = (int) strPtr->allocated;
	    } else {
		length = -1;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 6:				/* set */
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
	case 9:				/* maxchars */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));
		strPtr = (TestString *)
		    (varPtr[varIndex])->internalRep.otherValuePtr;
		length = strPtr->maxChars;
	    } else {
		length = -1;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 10:			/* getunicode */







<
|







1250
1251
1252
1253
1254
1255
1256

1257
1258
1259
1260
1261
1262
1263
1264
	case 9:				/* maxchars */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));

		strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
		length = strPtr->maxChars;
	    } else {
		length = -1;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 10:			/* getunicode */

Changes to generic/tclUtil.c.

1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
	    TclGetString(objPtr);
	    if (objPtr->length) {
		break;
	    } else {
		continue;
	    }
	}
	listRepPtr = (List *) objPtr->internalRep.twoPtrValue.ptr1;
	if (objPtr->bytes != NULL && !listRepPtr->canonicalFlag) {
	    break;
	}
    }
    if (i == objc) {
	Tcl_Obj **listv;
	int listc;







|







1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
	    TclGetString(objPtr);
	    if (objPtr->length) {
		break;
	    } else {
		continue;
	    }
	}
	listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
	if (objPtr->bytes != NULL && !listRepPtr->canonicalFlag) {
	    break;
	}
    }
    if (i == objc) {
	Tcl_Obj **listv;
	int listc;