Check-in [9d4cd6b1aa]
Not logged in

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

Overview
Comment:More internal use of size_t. Eliminate unused "isBin" argument from TclpSysAlloc()
Timelines: family | ancestors | descendants | both | novem
Files: files | file ages | folders
SHA1: 9d4cd6b1aa1648ca997b4fa8fd8aaefac244d76c
User & Date: jan.nijtmans 2016-12-01 11:20:52.183
Context
2016-12-01
11:46
merge trunk check-in: 391ec4f295 user: jan.nijtmans tags: novem
11:20
More internal use of size_t. Eliminate unused "isBin" argument from TclpSysAlloc() check-in: 9d4cd6b1aa user: jan.nijtmans tags: novem
2016-11-30
14:27
Merge trunk check-in: 39918e8e32 user: jan.nijtmans tags: novem
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tcl.h.
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
 * should access any of these fields directly; use the macros defined below.
 */

struct Tcl_HashEntry {
    Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
				 * or NULL for end of chain. */
    Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
    void *hash;			/* Hash value, stored as pointer to ensure
				 * that the offsets of the fields in this
				 * structure are not changed. */
    ClientData clientData;	/* Application stores something here with
				 * Tcl_SetHashValue. */
    union {			/* Key has one of these forms: */
	char *oneWordValue;	/* One-word value for key. */
	Tcl_Obj *objPtr;	/* Tcl_Obj * key value. */
	int words[1];		/* Multiple integer words for key. The actual
				 * size will be as large as necessary for this
				 * table's keys. */







|
<
<
|







956
957
958
959
960
961
962
963


964
965
966
967
968
969
970
971
 * should access any of these fields directly; use the macros defined below.
 */

struct Tcl_HashEntry {
    Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
				 * or NULL for end of chain. */
    Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
    size_t hash;		/* Hash value. */


    void *clientData;		/* Application stores something here with
				 * Tcl_SetHashValue. */
    union {			/* Key has one of these forms: */
	char *oneWordValue;	/* One-word value for key. */
	Tcl_Obj *objPtr;	/* Tcl_Obj * key value. */
	int words[1];		/* Multiple integer words for key. The actual
				 * size will be as large as necessary for this
				 * table's keys. */
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059

1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
struct Tcl_HashTable {
    Tcl_HashEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables (to
				 * avoid mallocs and frees). */
    int numBuckets;		/* Total number of buckets allocated at
				 * **bucketPtr. */
    int numEntries;		/* Total number of entries present in
				 * table. */
    int rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */

    int downShift;		/* Shift count used in hashing function.
				 * Designed to use high-order bits of
				 * randomized keys. */
    int mask;			/* Mask value used in hashing function. */
    int keyType;		/* Type of keys used in this table. It's
				 * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
				 * TCL_ONE_WORD_KEYS, or an integer giving the
				 * number of ints that is the size of the
				 * key. */
    Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const char *key);
    Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const char *key,
	    int *newPtr);
    const Tcl_HashKeyType *typePtr;
				/* Type of the keys used in the
				 * Tcl_HashTable. */
};

/*
 * Structure definition for information used to keep track of searches through
 * hash tables:
 */

typedef struct Tcl_HashSearch {
    Tcl_HashTable *tablePtr;	/* Table being searched. */
    int nextIndex;		/* Index of next bucket to be enumerated after
				 * present one. */
    Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current
				 * bucket. */
} Tcl_HashSearch;

/*
 * Acceptable key types for hash tables:
 *
 * TCL_STRING_KEYS:		The keys are strings, they are copied into the
 *				entry.
 * TCL_ONE_WORD_KEYS:		The keys are pointers, the pointer is stored
 *				in the entry.
 * TCL_CUSTOM_TYPE_KEYS:	The keys are arbitrary types which are copied
 *				into the entry.
 * TCL_CUSTOM_PTR_KEYS:		The keys are pointers to arbitrary types, the
 *				pointer is stored in the entry.
 *
 * While maintaining binary compatability the above have to be distinct values
 * as they are used to differentiate between old versions of the hash table
 * which don't have a typePtr and new ones which do. Once binary compatability
 * is discarded in favour of making more wide spread changes TCL_STRING_KEYS
 * can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the
 * same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is
 * accessed from the entry and not the behaviour.
 */

#define TCL_STRING_KEYS		(0)







|

|

|

>



<




















|

















|

|







1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061

1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
struct Tcl_HashTable {
    Tcl_HashEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables (to
				 * avoid mallocs and frees). */
    size_t numBuckets;		/* Total number of buckets allocated at
				 * **bucketPtr. */
    size_t numEntries;		/* Total number of entries present in
				 * table. */
    size_t rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    size_t mask;		/* Mask value used in hashing function. */
    int downShift;		/* Shift count used in hashing function.
				 * Designed to use high-order bits of
				 * randomized keys. */

    int keyType;		/* Type of keys used in this table. It's
				 * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
				 * TCL_ONE_WORD_KEYS, or an integer giving the
				 * number of ints that is the size of the
				 * key. */
    Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const char *key);
    Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const char *key,
	    int *newPtr);
    const Tcl_HashKeyType *typePtr;
				/* Type of the keys used in the
				 * Tcl_HashTable. */
};

/*
 * Structure definition for information used to keep track of searches through
 * hash tables:
 */

typedef struct Tcl_HashSearch {
    Tcl_HashTable *tablePtr;	/* Table being searched. */
    size_t nextIndex;		/* Index of next bucket to be enumerated after
				 * present one. */
    Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current
				 * bucket. */
} Tcl_HashSearch;

/*
 * Acceptable key types for hash tables:
 *
 * TCL_STRING_KEYS:		The keys are strings, they are copied into the
 *				entry.
 * TCL_ONE_WORD_KEYS:		The keys are pointers, the pointer is stored
 *				in the entry.
 * TCL_CUSTOM_TYPE_KEYS:	The keys are arbitrary types which are copied
 *				into the entry.
 * TCL_CUSTOM_PTR_KEYS:		The keys are pointers to arbitrary types, the
 *				pointer is stored in the entry.
 *
 * While maintaining binary compatibility the above have to be distinct values
 * as they are used to differentiate between old versions of the hash table
 * which don't have a typePtr and new ones which do. Once binary compatibility
 * is discarded in favour of making more wide spread changes TCL_STRING_KEYS
 * can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the
 * same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is
 * accessed from the entry and not the behaviour.
 */

#define TCL_STRING_KEYS		(0)
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358

/*
 *----------------------------------------------------------------------------
 * Macros for clients to use to access fields of hash entries:
 */

#define Tcl_GetHashValue(h) ((h)->clientData)
#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
#define Tcl_GetHashKey(tablePtr, h) \
	((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
		    (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
		   ? (h)->key.oneWordValue \
		   : (h)->key.string))

/*







|







2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356

/*
 *----------------------------------------------------------------------------
 * Macros for clients to use to access fields of hash entries:
 */

#define Tcl_GetHashValue(h) ((h)->clientData)
#define Tcl_SetHashValue(h, value) ((h)->clientData = (void *) (value))
#define Tcl_GetHashKey(tablePtr, h) \
	((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
		    (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
		   ? (h)->key.oneWordValue \
		   : (h)->key.string))

/*
Changes to generic/tclAlloc.c.
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285

    /*
     * First the simple case: we simple allocate big blocks directly.
     */

    if (numBytes >= MAXMALLOC - OVERHEAD) {
	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
	    bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
		    (sizeof(struct block) + OVERHEAD + numBytes), 0);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
	bigBlocks.nextPtr = bigBlockPtr;







|
|







270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285

    /*
     * First the simple case: we simple allocate big blocks directly.
     */

    if (numBytes >= MAXMALLOC - OVERHEAD) {
	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
	    bigBlockPtr = (struct block *) TclpSysAlloc(
		    sizeof(struct block) + OVERHEAD + numBytes);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
	bigBlocks.nextPtr = bigBlockPtr;
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
    size = 1 << (bucket + 3);
    ASSERT(size > 0);

    amount = MAXMALLOC;
    numBlocks = amount / size;
    ASSERT(numBlocks*size == amount);

    blockPtr = (struct block *) TclpSysAlloc((unsigned)
	    (sizeof(struct block) + amount), 1);
    /* no more room! */
    if (blockPtr == NULL) {
	return;
    }
    blockPtr->nextPtr = blockList;
    blockList = blockPtr;








|
|







401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
    size = 1 << (bucket + 3);
    ASSERT(size > 0);

    amount = MAXMALLOC;
    numBlocks = amount / size;
    ASSERT(numBlocks*size == amount);

    blockPtr = (struct block *) TclpSysAlloc(
	    sizeof(struct block) + amount);
    /* no more room! */
    if (blockPtr == NULL) {
	return;
    }
    blockPtr->nextPtr = blockList;
    blockList = blockPtr;

Changes to generic/tclBasic.c.
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
#endif /* TCL_COMPILE_STATS */

    /*
     * Initialize the ensemble error message rewriting support.
     */

    iPtr->ensembleRewrite.sourceObjs = NULL;
    iPtr->ensembleRewrite.numRemovedObjs = 0;
    iPtr->ensembleRewrite.numInsertedObjs = 0;

    /*
     * TIP#143: Initialise the resource limit support.
     */

    TclInitLimitSupport(interp);








|
|







694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
#endif /* TCL_COMPILE_STATS */

    /*
     * Initialize the ensemble error message rewriting support.
     */

    iPtr->ensembleRewrite.sourceObjs = NULL;
    iPtr->ensembleRewrite.numRemovedObjs1 = 0;
    iPtr->ensembleRewrite.numInsertedObjs1 = 0;

    /*
     * TIP#143: Initialise the resource limit support.
     */

    TclInitLimitSupport(interp);

Changes to generic/tclCompile.h.
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
			    size_t length, TCL_HASH_TYPE hash, int *newPtr,
			    Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);







|













|







1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
			    size_t length, size_t hash, int *newPtr,
			    Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, size_t index);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
Changes to generic/tclDictObj.c.
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
{
    Tcl_Obj *objPtr = keyPtr;
    ChainEntry *cPtr;

    cPtr = ckalloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    cPtr->entry.clientData = NULL;
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}

/*
 * Helper functions that disguise most of the details relating to how the







|







231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
{
    Tcl_Obj *objPtr = keyPtr;
    ChainEntry *cPtr;

    cPtr = ckalloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    Tcl_SetHashValue(&cPtr->entry, NULL);
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}

/*
 * Helper functions that disguise most of the details relating to how the
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict = DICT(dictPtr);
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    int i, length, bytesNeeded = 0;
    const char *elem;
    char *dst;

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    int numElems = dict->table.numEntries * 2;

    /* Handle empty list case first, simplifies what follows */
    if (numElems == 0) {
	dictPtr->bytes = tclEmptyStringRep;
	dictPtr->length = 0;
	return;
    }







|








|







488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict = DICT(dictPtr);
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    size_t i, length, bytesNeeded = 0;
    const char *elem;
    char *dst;

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    size_t numElems = dict->table.numEntries * 2;

    /* Handle empty list case first, simplifies what follows */
    if (numElems == 0) {
	dictPtr->bytes = tclEmptyStringRep;
	dictPtr->length = 0;
	return;
    }
523
524
525
526
527
528
529
530

531
532
533
534
535
536
537
538

539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559

560
561
562
563
564
565

566
567
568
569
570
571
572
	/*
	 * Assume that cPtr is never NULL since we know the number of array
	 * elements already.
	 */

	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);

	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);

	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dictPtr->length = bytesNeeded - 1;
    dictPtr->bytes = ckalloc(bytesNeeded);
    dst = dictPtr->bytes;
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);

	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);

	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    dictPtr->bytes[dictPtr->length] = '\0';

    if (flagPtr != localFlags) {
	ckfree(flagPtr);







|
>







|
>

<
<
<
<
<
<













|
>





|
>







523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541






542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
	/*
	 * Assume that cPtr is never NULL since we know the number of array
	 * elements already.
	 */

	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetString(keyPtr);
	length = keyPtr->length;
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetString(valuePtr);
	length = valuePtr->length;
	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);






    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dictPtr->length = bytesNeeded - 1;
    dictPtr->bytes = ckalloc(bytesNeeded);
    dst = dictPtr->bytes;
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetString(keyPtr);
	length = keyPtr->length;
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetString(valuePtr);
	length = valuePtr->length;
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    dictPtr->bytes[dictPtr->length] = '\0';

    if (flagPtr != localFlags) {
	ckfree(flagPtr);
Changes to generic/tclEnsemble.c.
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
    int reparseCount = 0;	/* Number of reparses. */
    Tcl_Obj *errorObj;		/* Used for building error messages. */
    Tcl_Obj *subObj;
    int subIdx;

    /*
     * Must recheck objc, since numParameters might have changed. Cf. test
     * namespace-53.9.
     */

  restartEnsembleParse:
    subIdx = 1 + ensemblePtr->numParameters;
    if (objc < subIdx + 1) {
	/*
	 * We don't have a subcommand argument. Make error message.
	 */

	Tcl_DString buf;	/* Message being built */

	Tcl_DStringInit(&buf);







|








|







1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
    int reparseCount = 0;	/* Number of reparses. */
    Tcl_Obj *errorObj;		/* Used for building error messages. */
    Tcl_Obj *subObj;
    size_t subIdx;

    /*
     * Must recheck objc, since numParameters might have changed. Cf. test
     * namespace-53.9.
     */

  restartEnsembleParse:
    subIdx = 1 + ensemblePtr->numParameters;
    if ((size_t)objc < subIdx + 1) {
	/*
	 * We don't have a subcommand argument. Make error message.
	 */

	Tcl_DString buf;	/* Message being built */

	Tcl_DStringInit(&buf);
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774

1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
	 * matches.
	 */

	const char *subcmdName; /* Name of the subcommand, or unique prefix of
				 * it (will be an error for a non-unique
				 * prefix). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	int stringLength, i;
	int tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetStringFromObj(subObj, &stringLength);

	for (i=0 ; i<tableLength ; i++) {
	    register int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    (unsigned) stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
		    /*
		     * Since there's never the exact-match case to worry about
		     * (hash search filters this), getting here indicates that
		     * our subcommand is an ambiguous prefix of (at least) two







|
|


|
>



|







1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
	 * matches.
	 */

	const char *subcmdName; /* Name of the subcommand, or unique prefix of
				 * it (will be an error for a non-unique
				 * prefix). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	size_t stringLength, i;
	size_t tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetString(subObj);
	stringLength = subObj->length;
	for (i=0 ; i<tableLength ; i++) {
	    register int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
		    /*
		     * Since there's never the exact-match case to worry about
		     * (hash search filters this), getting here indicates that
		     * our subcommand is an ambiguous prefix of (at least) two
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
    } else {
	int i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
	    Tcl_AppendToObj(errorObj, ", ", 2);
	}
	Tcl_AppendPrintfToObj(errorObj, "or %s",
		ensemblePtr->subcommandArrayPtr[i]);







|







1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
    } else {
	size_t i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
	    Tcl_AppendToObj(errorObj, ", ", 2);
	}
	Tcl_AppendPrintfToObj(errorObj, "or %s",
		ensemblePtr->subcommandArrayPtr[i]);
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
 *
 *----------------------------------------------------------------------
 */

int
TclInitRewriteEnsemble(
    Tcl_Interp *interp,
    int numRemoved,
    int numInserted,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;

    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
	iPtr->ensembleRewrite.numInsertedObjs = numInserted;
    } else {
	int numIns = iPtr->ensembleRewrite.numInsertedObjs;

	if (numIns < numRemoved) {
	    iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
	    iPtr->ensembleRewrite.numInsertedObjs = numInserted;
	} else {
	    iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
	}
    }
    return isRootEnsemble;
}

/*
 *----------------------------------------------------------------------







|
|








|
|

|


|
|

|







1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
 *
 *----------------------------------------------------------------------
 */

int
TclInitRewriteEnsemble(
    Tcl_Interp *interp,
    size_t numRemoved,
    size_t numInserted,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;

    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs1 = numRemoved;
	iPtr->ensembleRewrite.numInsertedObjs1 = numInserted;
    } else {
	size_t numIns = iPtr->ensembleRewrite.numInsertedObjs1;

	if (numIns < numRemoved) {
	    iPtr->ensembleRewrite.numRemovedObjs1 += numRemoved - numIns;
	    iPtr->ensembleRewrite.numInsertedObjs1 = numInserted;
	} else {
	    iPtr->ensembleRewrite.numInsertedObjs1 += numInserted - numRemoved;
	}
    }
    return isRootEnsemble;
}

/*
 *----------------------------------------------------------------------
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
    Tcl_Interp *interp,
    int isRootEnsemble)
{
    Interp *iPtr = (Interp *) interp;

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = NULL;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclSpellFix --







|
|







2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
    Tcl_Interp *interp,
    int isRootEnsemble)
{
    Interp *iPtr = (Interp *) interp;

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = NULL;
	iPtr->ensembleRewrite.numRemovedObjs1 = 0;
	iPtr->ensembleRewrite.numInsertedObjs1 = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclSpellFix --
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
}

void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    int objc,
    int badIdx,
    Tcl_Obj *bad,
    Tcl_Obj *fix)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *const *search;
    Tcl_Obj **store;
    int idx;
    int size;

    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }

    /* Compute the valid length of the ensemble root */

    size = iPtr->ensembleRewrite.numRemovedObjs + objc
		- iPtr->ensembleRewrite.numInsertedObjs;

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	/* Awful casting abuse here */
	search = (Tcl_Obj *const *) search[1];
    }

    if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
	/*
	 * Misspelled value was inserted. We cannot directly jump
	 * to the bad value, but have to search.
	 */
	idx = 1;
	while (idx < size) {
	    if (search[idx] == bad) {
		break;
	    }
	    idx++;
	}
	if (idx == size) {
	    return;
	}
    } else {
	/* Jump to the misspelled value. */
	idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx
		- iPtr->ensembleRewrite.numInsertedObjs;

	/* Verify */
	if (search[idx] != bad) {
	    Tcl_Panic("SpellFix: programming error");
	}
    }








|











|
|




|
|







|
















|
|







2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
}

void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    int objc,
    size_t badIdx,
    Tcl_Obj *bad,
    Tcl_Obj *fix)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *const *search;
    Tcl_Obj **store;
    int idx;
    int size;

    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs1 = 0;
	iPtr->ensembleRewrite.numInsertedObjs1 = 0;
    }

    /* Compute the valid length of the ensemble root */

    size = iPtr->ensembleRewrite.numRemovedObjs1 + objc
		- iPtr->ensembleRewrite.numInsertedObjs1;

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	/* Awful casting abuse here */
	search = (Tcl_Obj *const *) search[1];
    }

    if (badIdx < iPtr->ensembleRewrite.numInsertedObjs1) {
	/*
	 * Misspelled value was inserted. We cannot directly jump
	 * to the bad value, but have to search.
	 */
	idx = 1;
	while (idx < size) {
	    if (search[idx] == bad) {
		break;
	    }
	    idx++;
	}
	if (idx == size) {
	    return;
	}
    } else {
	/* Jump to the misspelled value. */
	idx = iPtr->ensembleRewrite.numRemovedObjs1 + badIdx
		- iPtr->ensembleRewrite.numInsertedObjs1;

	/* Verify */
	if (search[idx] != bad) {
	    Tcl_Panic("SpellFix: programming error");
	}
    }

2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
    Tcl_Obj *const *objv,
    int objc,
    int *objcPtr)
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->ensembleRewrite.sourceObjs) {
	*objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
		- iPtr->ensembleRewrite.numInsertedObjs;
	return iPtr->ensembleRewrite.sourceObjs;
    }
    *objcPtr = objc;
    return objv;
}

/*







|
|







2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
    Tcl_Obj *const *objv,
    int objc,
    int *objcPtr)
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->ensembleRewrite.sourceObjs) {
	*objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs1
		- iPtr->ensembleRewrite.numInsertedObjs1;
	return iPtr->ensembleRewrite.sourceObjs;
    }
    *objcPtr = objc;
    return objv;
}

/*
2498
2499
2500
2501
2502
2503
2504

2505
2506
2507
2508
2509
2510
2511
2512
static void
BuildEnsembleConfig(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashSearch search;	/* Used for scanning the set of commands in
				 * the namespace that backs up this
				 * ensemble. */

    int i, j, isNew;
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
    Tcl_HashEntry *hPtr;

    if (hash->numEntries != 0) {
	/*
	 * Remove pre-existing table.
	 */







>
|







2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
static void
BuildEnsembleConfig(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashSearch search;	/* Used for scanning the set of commands in
				 * the namespace that backs up this
				 * ensemble. */
    size_t i, j;
    int isNew;
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
    Tcl_HashEntry *hPtr;

    if (hash->numEntries != 0) {
	/*
	 * Remove pre-existing table.
	 */
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545

    if (ensemblePtr->subcmdList != NULL) {
	Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
	int subcmdc;

	TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
		&subcmdv);
	for (i=0 ; i<subcmdc ; i++) {
	    const char *name = TclGetString(subcmdv[i]);

	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);

	    /*
	     * Skip non-unique cases.
	     */







|







2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547

    if (ensemblePtr->subcmdList != NULL) {
	Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
	int subcmdc;

	TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
		&subcmdv);
	for (i=0 ; (int)i<subcmdc ; i++) {
	    const char *name = TclGetString(subcmdv[i]);

	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);

	    /*
	     * Skip non-unique cases.
	     */
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, (unsigned) hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}

/*
 *----------------------------------------------------------------------
 *







|







2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}

/*
 *----------------------------------------------------------------------
 *
Changes to generic/tclExecute.c.
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

/*
 * Mapping from expression instruction opcodes to strings; used for error
 * messages. Note that these entries must match the order and number of the
 * expression opcodes (e.g., INST_LOR) in tclCompile.h.
 *
 * Does not include the string for INST_EXPON (and beyond), as that is
 * disjoint for backward-compatability reasons.
 */

static const char *const operatorStrings[] = {
    "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
    "+", "-", "*", "/", "%", "+", "-", "~", "!"
};








|







69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

/*
 * Mapping from expression instruction opcodes to strings; used for error
 * messages. Note that these entries must match the order and number of the
 * expression opcodes (e.g., INST_LOR) in tclCompile.h.
 *
 * Does not include the string for INST_EXPON (and beyond), as that is
 * disjoint for backward-compatibility reasons.
 */

static const char *const operatorStrings[] = {
    "||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
    "+", "-", "*", "/", "%", "+", "-", "~", "!"
};

Changes to generic/tclHash.c.
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
    const char *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;
    unsigned int hash;
    int index;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

    if (typePtr->hashKeyProc) {
	hash = typePtr->hashKeyProc(tablePtr, (void *) key);
	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	    index = RANDOM_INDEX(tablePtr, hash);
	} else {
	    index = hash & tablePtr->mask;
	}
    } else {
	hash = PTR2UINT(key);
	index = RANDOM_INDEX(tablePtr, hash);
    }

    /*
     * Search all of the entries in the appropriate bucket.
     */

    if (typePtr->compareKeysProc) {
	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
	    if (hash != PTR2UINT(hPtr->hash)) {
		continue;
	    }
	    if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
    } else {
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
	    if (hash != PTR2UINT(hPtr->hash)) {
		continue;
	    }
	    if (key == hPtr->key.oneWordValue) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;







<
|




















|












|












|







239
240
241
242
243
244
245

246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
    const char *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;

    size_t hash, index;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

    if (typePtr->hashKeyProc) {
	hash = typePtr->hashKeyProc(tablePtr, (void *) key);
	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	    index = RANDOM_INDEX(tablePtr, hash);
	} else {
	    index = hash & tablePtr->mask;
	}
    } else {
	hash = (size_t) key;
	index = RANDOM_INDEX(tablePtr, hash);
    }

    /*
     * Search all of the entries in the appropriate bucket.
     */

    if (typePtr->compareKeysProc) {
	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
	    if (hash != hPtr->hash) {
		continue;
	    }
	    if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
    } else {
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
	    if (hash != hPtr->hash) {
		continue;
	    }
	    if (key == hPtr->key.oneWordValue) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331

    *newPtr = 1;
    if (typePtr->allocEntryProc) {
	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
    } else {
	hPtr = ckalloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	hPtr->clientData = 0;
    }

    hPtr->tablePtr = tablePtr;
    hPtr->hash = UINT2PTR(hash);
    hPtr->nextPtr = tablePtr->buckets[index];
    tablePtr->buckets[index] = hPtr;
    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many more
     * buckets.







|



|







312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330

    *newPtr = 1;
    if (typePtr->allocEntryProc) {
	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
    } else {
	hPtr = ckalloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	Tcl_SetHashValue(hPtr, NULL);
    }

    hPtr->tablePtr = tablePtr;
    hPtr->hash = hash;
    hPtr->nextPtr = tablePtr->buckets[index];
    tablePtr->buckets[index] = hPtr;
    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many more
     * buckets.
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
Tcl_DeleteHashEntry(
    Tcl_HashEntry *entryPtr)
{
    register Tcl_HashEntry *prevPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry **bucketPtr;
    int index;

    tablePtr = entryPtr->tablePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

    if (typePtr->hashKeyProc == NULL
	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
    } else {
	index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
    }

    bucketPtr = &tablePtr->buckets[index];

    if (*bucketPtr == entryPtr) {
	*bucketPtr = entryPtr->nextPtr;
    } else {







|
















|

|







358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
Tcl_DeleteHashEntry(
    Tcl_HashEntry *entryPtr)
{
    register Tcl_HashEntry *prevPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry **bucketPtr;
    size_t index;

    tablePtr = entryPtr->tablePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

    if (typePtr->hashKeyProc == NULL
	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	index = RANDOM_INDEX(tablePtr, entryPtr->hash);
    } else {
	index = entryPtr->hash & tablePtr->mask;
    }

    bucketPtr = &tablePtr->buckets[index];

    if (*bucketPtr == entryPtr) {
	*bucketPtr = entryPtr->nextPtr;
    } else {
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442

void
Tcl_DeleteHashTable(
    register Tcl_HashTable *tablePtr)	/* Table to delete. */
{
    register Tcl_HashEntry *hPtr, *nextPtr;
    const Tcl_HashKeyType *typePtr;
    int i;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {







|







427
428
429
430
431
432
433
434
435
436
437
438
439
440
441

void
Tcl_DeleteHashTable(
    register Tcl_HashTable *tablePtr)	/* Table to delete. */
{
    register Tcl_HashEntry *hPtr, *nextPtr;
    const Tcl_HashKeyType *typePtr;
    size_t i;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
 */

char *
Tcl_HashStats(
    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    int count[NUM_COUNTERS], overflow, i, j;
    double average, tmp;
    register Tcl_HashEntry *hPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage.
     */







|







576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
 */

char *
Tcl_HashStats(
    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    size_t count[NUM_COUNTERS], overflow, i, j;
    double average, tmp;
    register Tcl_HashEntry *hPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage.
     */
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = ckalloc((NUM_COUNTERS * 60) + 300);
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %d\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}

/*
 *----------------------------------------------------------------------







|
|


|
|



|







611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = ckalloc((NUM_COUNTERS * 60) + 300);
    sprintf(result, "%" TCL_LL_MODIFIER "d entries in table, %" TCL_LL_MODIFIER "d buckets\n",
	    (Tcl_WideInt)tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	sprintf(p, "number of buckets with %d entries: %" TCL_LL_MODIFIER "d\n",
		(int)i, (Tcl_WideInt)count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %d\n",
	    NUM_COUNTERS, (int)overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}

/*
 *----------------------------------------------------------------------
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
    }
    hPtr = ckalloc(size);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    hPtr->clientData = 0;

    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *







|







665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
    }
    hPtr = ckalloc(size);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    Tcl_SetHashValue(hPtr, NULL);

    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize);
    memcpy(hPtr->key.string, string, size);
    hPtr->clientData = 0;
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CompareStringKeys --







|







773
774
775
776
777
778
779
780
781
782
783
784
785
786
787

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize);
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CompareStringKeys --
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
 *----------------------------------------------------------------------
 */

static void
RebuildTable(
    register Tcl_HashTable *tablePtr)	/* Table to enlarge. */
{
    int oldSize, count, index;
    Tcl_HashEntry **oldBuckets;
    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;







|







950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
 *----------------------------------------------------------------------
 */

static void
RebuildTable(
    register Tcl_HashTable *tablePtr)	/* Table to enlarge. */
{
    size_t oldSize, count, index;
    Tcl_HashEntry **oldBuckets;
    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    tablePtr->numBuckets *= 4;
    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
    } else {
	tablePtr->buckets =
		ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;







|
|







977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    tablePtr->numBuckets *= 4;
    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc(
		tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    } else {
	tablePtr->buckets =
		ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
     */

    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
	    *oldChainPtr = hPtr->nextPtr;
	    if (typePtr->hashKeyProc == NULL
		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
	    } else {
		index = PTR2UINT(hPtr->hash) & tablePtr->mask;
	    }
	    hPtr->nextPtr = tablePtr->buckets[index];
	    tablePtr->buckets[index] = hPtr;
	}
    }

    /*







|

|







1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
     */

    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
	    *oldChainPtr = hPtr->nextPtr;
	    if (typePtr->hashKeyProc == NULL
		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		index = RANDOM_INDEX(tablePtr, hPtr->hash);
	    } else {
		index = hPtr->hash & tablePtr->mask;
	    }
	    hPtr->nextPtr = tablePtr->buckets[index];
	    tablePtr->buckets[index] = hPtr;
	}
    }

    /*
Changes to generic/tclIndexObj.c.
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
    Tcl_Obj *const objv[],	/* Initial argument objects, which should be
				 * included in the error message. */
    const char *message)	/* Error message to print after the leading
				 * objects in objv. The message may be
				 * NULL. */
{
    Tcl_Obj *objPtr;
    int i, len, elemLen;
    char flags;
    Interp *iPtr = (Interp *) interp;
    const char *elementStr;

    TclNewObj(objPtr);
    if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
	Tcl_AppendToObj(objPtr, " or \"", -1);
    } else {
	Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
    }

    /*
     * Check to see if we are processing an ensemble implementation, and if so
     * rewrite the results in terms of how the ensemble was invoked.
     */

    if (iPtr->ensembleRewrite.sourceObjs != NULL) {
	int toSkip = iPtr->ensembleRewrite.numInsertedObjs;
	int toPrint = iPtr->ensembleRewrite.numRemovedObjs;
	Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;

	/*
	 * Check for spelling fixes, and substitute the fixed values.
	 */

	if (origObjv[0] == NULL) {
	    origObjv = (Tcl_Obj *const *)origObjv[2];
	}

	/*
	 * We only know how to do rewriting if all the replaced objects are
	 * actually arguments (in objv) to this function. Otherwise it just
	 * gets too complicated and we'd be better off just giving a slightly
	 * confusing error message...
	 */

	if (objc < toSkip) {
	    goto addNormalArgumentsToMessage;
	}

	/*
	 * Strip out the actual arguments that the ensemble inserted.
	 */








|



















|
|

















|







808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
    Tcl_Obj *const objv[],	/* Initial argument objects, which should be
				 * included in the error message. */
    const char *message)	/* Error message to print after the leading
				 * objects in objv. The message may be
				 * NULL. */
{
    Tcl_Obj *objPtr;
    size_t i, len, elemLen;
    char flags;
    Interp *iPtr = (Interp *) interp;
    const char *elementStr;

    TclNewObj(objPtr);
    if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
	Tcl_AppendToObj(objPtr, " or \"", -1);
    } else {
	Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
    }

    /*
     * Check to see if we are processing an ensemble implementation, and if so
     * rewrite the results in terms of how the ensemble was invoked.
     */

    if (iPtr->ensembleRewrite.sourceObjs != NULL) {
	size_t toSkip = iPtr->ensembleRewrite.numInsertedObjs1;
	size_t toPrint = iPtr->ensembleRewrite.numRemovedObjs1;
	Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;

	/*
	 * Check for spelling fixes, and substitute the fixed values.
	 */

	if (origObjv[0] == NULL) {
	    origObjv = (Tcl_Obj *const *)origObjv[2];
	}

	/*
	 * We only know how to do rewriting if all the replaced objects are
	 * actually arguments (in objv) to this function. Otherwise it just
	 * gets too complicated and we'd be better off just giving a slightly
	 * confusing error message...
	 */

	if ((size_t)objc < toSkip) {
	    goto addNormalArgumentsToMessage;
	}

	/*
	 * Strip out the actual arguments that the ensemble inserted.
	 */

874
875
876
877
878
879
880
881

882
883
884
885
886
887
888
	    if (origObjv[i]->typePtr == &indexType) {
		register IndexRep *indexRep =
			origObjv[i]->internalRep.twoPtrValue.ptr1;

		elementStr = EXPAND_OF(indexRep);
		elemLen = strlen(elementStr);
	    } else {
		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);

	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp,
			(unsigned)len + 1);







|
>







874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
	    if (origObjv[i]->typePtr == &indexType) {
		register IndexRep *indexRep =
			origObjv[i]->internalRep.twoPtrValue.ptr1;

		elementStr = EXPAND_OF(indexRep);
		elemLen = strlen(elementStr);
	    } else {
		elementStr = TclGetString(origObjv[i]);
		elemLen = origObjv[i]->length;
	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp,
			(unsigned)len + 1);
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931

932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960

    /*
     * Now add the arguments (other than those rewritten) that the caller took
     * from its calling context.
     */

  addNormalArgumentsToMessage:
    for (i = 0; i < objc; i++) {
	/*
	 * If the object is an index type use the index table which allows for
	 * the correct error message even if the subcommand was abbreviated.
	 * Otherwise, just use the string rep.
	 */

	if (objv[i]->typePtr == &indexType) {
	    register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;

	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
	} else {
	    /*
	     * Quote the argument if it contains spaces (Bug 942757).
	     */

	    elementStr = TclGetStringFromObj(objv[i], &elemLen);

	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp,
			(unsigned) len + 1);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
	    }
	}

	/*
	 * Append a space character (" ") if there is more text to follow
	 * (either another element from objv, or the message string).
	 */

	if (i<objc-1 || message!=NULL) {
	    Tcl_AppendStringsToObj(objPtr, " ", NULL);
	}
    }

    /*
     * Add any trailing message bits and set the resulting string as the
     * interpreter result. Caller is responsible for reporting this as an







|















|
>





|















|







909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962

    /*
     * Now add the arguments (other than those rewritten) that the caller took
     * from its calling context.
     */

  addNormalArgumentsToMessage:
    for (i = 0; i < (size_t)objc; i++) {
	/*
	 * If the object is an index type use the index table which allows for
	 * the correct error message even if the subcommand was abbreviated.
	 * Otherwise, just use the string rep.
	 */

	if (objv[i]->typePtr == &indexType) {
	    register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;

	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
	} else {
	    /*
	     * Quote the argument if it contains spaces (Bug 942757).
	     */

	    elementStr = TclGetString(objv[i]);
	    elemLen = objv[i]->length;
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp,
			len + 1);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
	    }
	}

	/*
	 * Append a space character (" ") if there is more text to follow
	 * (either another element from objv, or the message string).
	 */

	if (i<(size_t)(objc-1) || message!=NULL) {
	    Tcl_AppendStringsToObj(objPtr, " ", NULL);
	}
    }

    /*
     * Add any trailing message bits and set the resulting string as the
     * interpreter result. Caller is responsible for reporting this as an
Changes to generic/tclInt.decls.
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
declare 244 {
    Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
}
declare 245 {
    Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
}
declare 246 {
    int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved,
	    int numInserted, Tcl_Obj *const *objv)
}
declare 247 {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,







|
|







996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
declare 244 {
    Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
}
declare 245 {
    Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
}
declare 246 {
    int TclInitRewriteEnsemble(Tcl_Interp *interp, size_t numRemoved,
	    size_t numInserted, Tcl_Obj *const *objv)
}
declare 247 {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
declare 250 {
    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}

# Allow extensions for optimization
declare 251 {
    int TclRegisterLiteral(void *envPtr,
	    const char *bytes, int length, int flags)
}

##############################################################################

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.








|







1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
declare 250 {
    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}

# Allow extensions for optimization
declare 251 {
    int TclRegisterLiteral(void *envPtr,
	    const char *bytes, size_t length, int flags)
}

##############################################################################

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.

Changes to generic/tclInt.h.
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
    char **exportArrayPtr;	/* Points to an array of string patterns
				 * specifying which commands are exported. A
				 * pattern may include "string match" style
				 * wildcard characters to specify multiple
				 * commands; however, no namespace qualifiers
				 * are allowed. NULL if no export patterns are
				 * registered. */
    int numExportPatterns;	/* Number of export patterns currently
				 * registered using "namespace export". */
    int maxExportPatterns;	/* Mumber of export patterns for which space
				 * is currently allocated. */
    size_t cmdRefEpoch;	/* Incremented if a newly added command
				 * shadows a command for which this namespace
				 * has already cached a Command* pointer; this
				 * causes all its cached Command* pointers to
				 * be invalidated. */
    size_t resolverEpoch;	/* Incremented whenever (a) the name
				 * resolution rules change for this namespace
				 * or (b) a newly added command shadows a







|

|

|







278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
    char **exportArrayPtr;	/* Points to an array of string patterns
				 * specifying which commands are exported. A
				 * pattern may include "string match" style
				 * wildcard characters to specify multiple
				 * commands; however, no namespace qualifiers
				 * are allowed. NULL if no export patterns are
				 * registered. */
    size_t numExportPatterns;	/* Number of export patterns currently
				 * registered using "namespace export". */
    size_t maxExportPatterns;	/* Mumber of export patterns for which space
				 * is currently allocated. */
    size_t cmdRefEpoch;		/* Incremented if a newly added command
				 * shadows a command for which this namespace
				 * has already cached a Command* pointer; this
				 * causes all its cached Command* pointers to
				 * be invalidated. */
    size_t resolverEpoch;	/* Incremented whenever (a) the name
				 * resolution rules change for this namespace
				 * or (b) a newly added command shadows a
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
    ClientData clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
    struct CommandTrace *nextPtr;
				/* Next in list of traces associated with a
				 * particular command. */
    int refCount;		/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
} CommandTrace;

/*
 * When a command trace is active (i.e. its associated procedure is executing)







|







528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
    ClientData clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
    struct CommandTrace *nextPtr;
				/* Next in list of traces associated with a
				 * particular command. */
    size_t refCount;		/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
} CommandTrace;

/*
 * When a command trace is active (i.e. its associated procedure is executing)
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
				 * "upvar", this field points to the
				 * referenced variable's Var struct. */
    } value;
} Var;

typedef struct VarInHash {
    Var var;
    int refCount;		/* Counts number of active uses of this
				 * variable: 1 for the entry in the hash
				 * table, 1 for each additional variable whose
				 * linkPtr points here, 1 for each nested
				 * trace active on variable, and 1 if the
				 * variable is a namespace variable. This
				 * record can't be deleted until refCount
				 * becomes 0. */







|







601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
				 * "upvar", this field points to the
				 * referenced variable's Var struct. */
    } value;
} Var;

typedef struct VarInHash {
    Var var;
    size_t refCount;		/* Counts number of active uses of this
				 * variable: 1 for the entry in the hash
				 * table, 1 for each additional variable whose
				 * linkPtr points here, 1 for each nested
				 * trace active on variable, and 1 if the
				 * variable is a namespace variable. This
				 * record can't be deleted until refCount
				 * becomes 0. */
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
 * collection of Tcl commands plus information about arguments and other local
 * variables recognized at compile time.
 */

typedef struct Proc {
    struct Interp *iPtr;	/* Interpreter for which this command is
				 * defined. */
    int refCount;		/* Reference count: 1 if still present in
				 * command table plus 1 for each call to the
				 * procedure that is currently active. This
				 * structure can be freed when refCount
				 * becomes zero. */
    struct Command *cmdPtr;	/* Points to the Command structure for this
				 * procedure. This is used to get the
				 * namespace in which to execute the







|







933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
 * collection of Tcl commands plus information about arguments and other local
 * variables recognized at compile time.
 */

typedef struct Proc {
    struct Interp *iPtr;	/* Interpreter for which this command is
				 * defined. */
    size_t refCount;		/* Reference count: 1 if still present in
				 * command table plus 1 for each call to the
				 * procedure that is currently active. This
				 * structure can be freed when refCount
				 * becomes zero. */
    struct Command *cmdPtr;	/* Points to the Command structure for this
				 * procedure. This is used to get the
				 * namespace in which to execute the
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064

/*
 * Will be grown to contain: pointers to the varnames (allocated at the end),
 * plus the init values for each variable (suitable to be memcopied on init)
 */

typedef struct LocalCache {
    int refCount;
    int numVars;
    Tcl_Obj *varName0;
} LocalCache;

#define localName(framePtr, i) \
    ((&((framePtr)->localCachePtr->varName0))[(i)])








|







1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064

/*
 * Will be grown to contain: pointers to the varnames (allocated at the end),
 * plus the init values for each variable (suitable to be memcopied on init)
 */

typedef struct LocalCache {
    size_t refCount;
    int numVars;
    Tcl_Obj *varName0;
} LocalCache;

#define localName(framePtr, i) \
    ((&((framePtr)->localCachePtr->varName0))[(i)])

1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
				 * TclArgumentBCEnter(). These will be removed
				 * by TclArgumentBCRelease. */
} CmdFrame;

typedef struct CFWord {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int word;			/* Index of the word in the command. */
    int refCount;		/* Number of times the word is on the
				 * stack. */
} CFWord;

typedef struct CFWordBC {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */







|







1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
				 * TclArgumentBCEnter(). These will be removed
				 * by TclArgumentBCRelease. */
} CmdFrame;

typedef struct CFWord {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int word;			/* Index of the word in the command. */
    size_t refCount;		/* Number of times the word is on the
				 * stack. */
} CFWord;

typedef struct CFWordBC {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
typedef struct LiteralTable {
    LiteralEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables to avoid
				 * mallocs and frees. */
    int numBuckets;		/* Total number of buckets allocated at
				 * **buckets. */
    int numEntries;		/* Total number of entries present in
				 * table. */
    int rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    int mask;			/* Mask value used in hashing function. */
} LiteralTable;

/*
 * The following structure defines for each Tcl interpreter various
 * statistics-related information about the bytecode compiler and
 * interpreter's operation in that interpreter.
 */







|

|

|

|







1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
typedef struct LiteralTable {
    LiteralEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables to avoid
				 * mallocs and frees. */
    size_t numBuckets;		/* Total number of buckets allocated at
				 * **buckets. */
    size_t numEntries;		/* Total number of entries present in
				 * table. */
    size_t rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    size_t mask;		/* Mask value used in hashing function. */
} LiteralTable;

/*
 * The following structure defines for each Tcl interpreter various
 * statistics-related information about the bytecode compiler and
 * interpreter's operation in that interpreter.
 */
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976

    struct {
	Tcl_Obj *const *sourceObjs;
				/* What arguments were actually input into the
				 * *root* ensemble command? (Nested ensembles
				 * don't rewrite this.) NULL if we're not
				 * processing an ensemble. */
	int numRemovedObjs;	/* How many arguments have been stripped off
				 * because of ensemble processing. */
	int numInsertedObjs;	/* How many of the current arguments were
				 * inserted by an ensemble. */
    } ensembleRewrite;

    /*
     * TIP #219: Global info for the I/O system.
     */








|

|







1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976

    struct {
	Tcl_Obj *const *sourceObjs;
				/* What arguments were actually input into the
				 * *root* ensemble command? (Nested ensembles
				 * don't rewrite this.) NULL if we're not
				 * processing an ensemble. */
	size_t numRemovedObjs1;	/* How many arguments have been stripped off
				 * because of ensemble processing. */
	size_t numInsertedObjs1;	/* How many of the current arguments were
				 * inserted by an ensemble. */
    } ensembleRewrite;

    /*
     * TIP #219: Global info for the I/O system.
     */

3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
MODULE_SCOPE int	TclStringCatObjv(Tcl_Interp *interp, int inPlace,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Obj **objPtrPtr);
MODULE_SCOPE int	TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack,







|







3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, size_t subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    int numBytes);
MODULE_SCOPE int	TclStringCatObjv(Tcl_Interp *interp, int inPlace,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Obj **objPtrPtr);
MODULE_SCOPE int	TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack,
Changes to generic/tclIntDecls.h.
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
TCLAPI void		TclDbDumpActiveObjects(FILE *outFile);
/* 244 */
TCLAPI Tcl_HashTable *	TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
/* 245 */
TCLAPI Tcl_HashTable *	TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
/* 246 */
TCLAPI int		TclInitRewriteEnsemble(Tcl_Interp *interp,
				int numRemoved, int numInserted,
				Tcl_Obj *const *objv);
/* 247 */
TCLAPI void		TclResetRewriteEnsemble(Tcl_Interp *interp,
				int isRootEnsemble);
/* 248 */
TCLAPI int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
/* 249 */
TCLAPI char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
/* 250 */
TCLAPI void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
				int force);
/* 251 */
TCLAPI int		TclRegisterLiteral(void *envPtr, const char *bytes,
				int length, int flags);

typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
    void (*reserved1)(void);







|
















|







527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
TCLAPI void		TclDbDumpActiveObjects(FILE *outFile);
/* 244 */
TCLAPI Tcl_HashTable *	TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
/* 245 */
TCLAPI Tcl_HashTable *	TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
/* 246 */
TCLAPI int		TclInitRewriteEnsemble(Tcl_Interp *interp,
				size_t numRemoved, size_t numInserted,
				Tcl_Obj *const *objv);
/* 247 */
TCLAPI void		TclResetRewriteEnsemble(Tcl_Interp *interp,
				int isRootEnsemble);
/* 248 */
TCLAPI int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
/* 249 */
TCLAPI char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
/* 250 */
TCLAPI void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
				int force);
/* 251 */
TCLAPI int		TclRegisterLiteral(void *envPtr, const char *bytes,
				size_t length, int flags);

typedef struct TclIntStubs {
    int magic;
    void *hooks;

    void (*reserved0)(void);
    void (*reserved1)(void);
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
    int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
    int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
    int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
    int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif







|




|







796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
    int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
    int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
    int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
    int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, size_t numRemoved, size_t numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif
Changes to generic/tclLiteral.c.
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
/*
 * Function prototypes for static functions in this file:
 */

static int		AddLocalLiteralEntry(CompileEnv *envPtr,
			    Tcl_Obj *objPtr, int localHash);
static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
static unsigned		HashString(const char *string, int length);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
static void		RebuildLiteralTable(LiteralTable *tablePtr);

/*







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
/*
 * Function prototypes for static functions in this file:
 */

static int		AddLocalLiteralEntry(CompileEnv *envPtr,
			    Tcl_Obj *objPtr, int localHash);
static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
static size_t		HashString(const char *string, size_t length);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
static void		RebuildLiteralTable(LiteralTable *tablePtr);

/*
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
TclDeleteLiteralTable(
    Tcl_Interp *interp,		/* Interpreter containing shared literals
				 * referenced by the table to delete. */
    LiteralTable *tablePtr)	/* Points to the literal table to delete. */
{
    LiteralEntry *entryPtr, *nextPtr;
    Tcl_Obj *objPtr;
    int i;

    /*
     * Release remaining literals in the table. Note that releasing a literal
     * might release other literals, modifying the table, so we restart the
     * search from the bucket chain we last found an entry.
     */








|







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
TclDeleteLiteralTable(
    Tcl_Interp *interp,		/* Interpreter containing shared literals
				 * referenced by the table to delete. */
    LiteralTable *tablePtr)	/* Points to the literal table to delete. */
{
    LiteralEntry *entryPtr, *nextPtr;
    Tcl_Obj *objPtr;
    size_t i;

    /*
     * Release remaining literals in the table. Note that releasing a literal
     * might release other literals, modifying the table, so we restart the
     * search from the bucket chain we last found an entry.
     */

170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,	/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    size_t length,			/* Number of bytes in the string. */
    TCL_HASH_TYPE hash,		/* The string's hash. If -1, it will be
				 * computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    TCL_HASH_TYPE globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == (TCL_HASH_TYPE) -1) {
	hash = HashString(bytes, length);
    }
    globalHash = (hash & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if ((globalPtr->nsPtr == nsPtr)







|

|
|








|






|







170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,		/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    size_t length,		/* Number of bytes in the string. */
    size_t hash,		/* The string's hash. If -1, it will be
				 * computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    size_t globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == (size_t) -1) {
	hash = HashString(bytes, length);
    }
    globalHash = (hash & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if ((globalPtr->nsPtr == nsPtr)
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
	RebuildLiteralTable(globalTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyGlobalLiteralTable(iPtr);
    {
	LiteralEntry *entryPtr;
	int found, i;


	found = 0;
	for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	    for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ;
		    entryPtr=entryPtr->nextPtr) {
		if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) {
		    found = 1;
		}
	    }
	}
	if (!found) {
	    Tcl_Panic("%s: literal \"%.*s\" wasn't global",
		    "TclRegisterLiteral", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numLiteralsCreated++;
    iPtr->stats.totalLitStringBytes += (double) (length + 1);







|
>












|







281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
	RebuildLiteralTable(globalTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyGlobalLiteralTable(iPtr);
    {
	LiteralEntry *entryPtr;
	int found;
	size_t i;

	found = 0;
	for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	    for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ;
		    entryPtr=entryPtr->nextPtr) {
		if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) {
		    found = 1;
		}
	    }
	}
	if (!found) {
	    Tcl_Panic("%s: literal \"%.*s\" wasn't global",
		    "TclRegisterLiteral", (length>60? 60 : (int)length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numLiteralsCreated++;
    iPtr->stats.totalLitStringBytes += (double) (length + 1);
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    unsigned int index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= (unsigned int) envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}

/*
 *----------------------------------------------------------------------







|


|







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    size_t index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= (size_t) envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}

/*
 *----------------------------------------------------------------------
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396

397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
int
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    register const char *bytes,	/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    int length,			/* Number of bytes in the string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    unsigned hash;
    int localHash, objIndex, new;

    Namespace *nsPtr;

    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    hash = HashString(bytes, length);

    /*
     * Is the literal already in the CompileEnv's local literal array? If so,
     * just return its index.
     */

    localHash = (hash & localTablePtr->mask);
    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
	    localPtr = localPtr->nextPtr) {
	objPtr = localPtr->objPtr;
	if ((objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		ckfree((char *)bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG







|













<
|
>


|













|







375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
int
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    register const char *bytes,	/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    size_t length,			/* Number of bytes in the string. If -1, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;

    size_t hash, localHash, objIndex;
    int new;
    Namespace *nsPtr;

    if (length == (size_t)-1) {
	length = (bytes ? strlen(bytes) : 0);
    }
    hash = HashString(bytes, length);

    /*
     * Is the literal already in the CompileEnv's local literal array? If so,
     * just return its index.
     */

    localHash = (hash & localTablePtr->mask);
    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
	    localPtr = localPtr->nextPtr) {
	objPtr = localPtr->objPtr;
	if (((size_t)objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		ckfree((char *)bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
	    &globalPtr);
    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);

#ifdef TCL_COMPILE_DEBUG
    if (globalPtr != NULL && globalPtr->refCount < 1) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
		"TclRegisterLiteral", (length>60? 60 : length), bytes,
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}








|







451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
	    &globalPtr);
    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);

#ifdef TCL_COMPILE_DEBUG
    if (globalPtr != NULL && globalPtr->refCount < 1) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes,
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}

488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    register LiteralEntry *entryPtr;
    const char *bytes;
    int length, globalHash;

    bytes = TclGetStringFromObj(objPtr, &length);
    globalHash = (HashString(bytes, length) & globalTablePtr->mask);
    for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
	    entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }
    return NULL;







|

|
|







489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    register LiteralEntry *entryPtr;
    const char *bytes;
    size_t globalHash;

    bytes = TclGetString(objPtr);
    globalHash = (HashString(bytes, objPtr->length) & globalTablePtr->mask);
    for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
	    entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }
    return NULL;
533
534
535
536
537
538
539
540

541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558

559
560
561
562
563
564
565
    register CompileEnv *envPtr,/* Points to CompileEnv whose literal array
				 * contains the entry being hidden. */
    int index)			/* The index of the entry in the literal
				 * array. */
{
    LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    int localHash, length;

    const char *bytes;
    Tcl_Obj *newObjPtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from
     * the local and global literal tables. It still has a slot in the literal
     * array so it can be referred to by byte codes, but it will not be
     * matched by literal searches.
     */

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = TclGetStringFromObj(newObjPtr, &length);

    localHash = (HashString(bytes, length) & localTablePtr->mask);
    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
	if (entryPtr == lPtr) {
	    *nextPtrPtr = lPtr->nextPtr;
	    lPtr->nextPtr = NULL;







|
>

















|
>







534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
    register CompileEnv *envPtr,/* Points to CompileEnv whose literal array
				 * contains the entry being hidden. */
    int index)			/* The index of the entry in the literal
				 * array. */
{
    LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    size_t localHash;
    size_t length;
    const char *bytes;
    Tcl_Obj *newObjPtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from
     * the local and global literal tables. It still has a slot in the literal
     * array so it can be referred to by byte codes, but it will not be
     * matched by literal searches.
     */

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = TclGetString(newObjPtr);
    length = newObjPtr->length;
    localHash = (HashString(bytes, length) & localTablePtr->mask);
    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
	if (entryPtr == lPtr) {
	    *nextPtrPtr = lPtr->nextPtr;
	    lPtr->nextPtr = NULL;
670
671
672
673
674
675
676

677
678
679
680
681
682
683
684
685
686
687
688
689
690

691
692
693
694
695
696
697
698
699
	RebuildLiteralTable(localTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(envPtr);
    {
	char *bytes;

	int length, found, i;

	found = 0;
	for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	    for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
		    localPtr=localPtr->nextPtr) {
		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = TclGetStringFromObj(objPtr, &length);

	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
}








>
|












|
>

|







673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
	RebuildLiteralTable(localTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(envPtr);
    {
	char *bytes;
	int found;
	size_t length, i;

	found = 0;
	for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	    for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
		    localPtr=localPtr->nextPtr) {
		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = TclGetString(objPtr);
	    length = objPtr->length;
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
}

724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
{
    /*
     * The current allocated local literal entries are stored between elements
     * 0 and (envPtr->literalArrayNext - 1) [inclusive].
     */

    LiteralTable *localTablePtr = &envPtr->localLitTable;
    int currElems = envPtr->literalArrayNext;
    size_t currBytes = (currElems * sizeof(LiteralEntry));
    LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
    LiteralEntry *newArrayPtr;
    int i;
    unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX;

    if (currBytes == newSize) {
	Tcl_Panic("max size of Tcl literal array (%d literals) exceeded",
		currElems);
    }

    if (envPtr->mallocedLiteralArray) {
	newArrayPtr = ckrealloc(currArrayPtr, newSize);
    } else {
	/*
	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must







|



|
|


|
|







729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
{
    /*
     * The current allocated local literal entries are stored between elements
     * 0 and (envPtr->literalArrayNext - 1) [inclusive].
     */

    LiteralTable *localTablePtr = &envPtr->localLitTable;
    size_t currElems = envPtr->literalArrayNext;
    size_t currBytes = (currElems * sizeof(LiteralEntry));
    LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
    LiteralEntry *newArrayPtr;
    size_t i;
    size_t newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX;

    if (currBytes == newSize) {
	Tcl_Panic("max size of Tcl literal array (%" TCL_LL_MODIFIER "d literals) exceeded",
		(Tcl_WideInt)currElems);
    }

    if (envPtr->mallocedLiteralArray) {
	newArrayPtr = ckrealloc(currArrayPtr, newSize);
    } else {
	/*
	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819

820
821
822
823
824
825
826
827
				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    register LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    int length, index;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetStringFromObj(objPtr, &length);

    index = (HashString(bytes, length) & globalTablePtr->mask);

    /*
     * Check to see if the object is in the global literal table and remove
     * this reference. The object may not be in the table if it is a hidden
     * local literal.
     */








|






|
>
|







810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    register LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    size_t length, index;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetString(objPtr);
    length = objPtr->length;
    index = HashString(bytes, length) & globalTablePtr->mask;

    /*
     * Check to see if the object is in the global literal table and remove
     * this reference. The object may not be in the table if it is a hidden
     * local literal.
     */

876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static unsigned
HashString(
    register const char *string,	/* String for which to compute hash value. */
    int length)			/* Number of bytes in the string. */
{
    register unsigned int result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:







|


|

|







882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
HashString(
    register const char *string,	/* String for which to compute hash value. */
    size_t length)			/* Number of bytes in the string. */
{
    register size_t result = 0;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    register LiteralEntry **oldChainPtr, **newChainPtr;
    register LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    unsigned int oldSize;
    int count, index, length;

    oldSize = tablePtr->numBuckets;
    oldBuckets = tablePtr->buckets;

    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.







<
|







956
957
958
959
960
961
962

963
964
965
966
967
968
969
970
				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    register LiteralEntry **oldChainPtr, **newChainPtr;
    register LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;

    size_t oldSize, count, index, length;

    oldSize = tablePtr->numBuckets;
    oldBuckets = tablePtr->buckets;

    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
986
987
988
989
990
991
992
993

994
995
996
997
998
999
1000

    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
	for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
	    bytes = TclGetStringFromObj(entryPtr->objPtr, &length);

	    index = (HashString(bytes, length) & tablePtr->mask);

	    *oldChainPtr = entryPtr->nextPtr;
	    bucketPtr = &tablePtr->buckets[index];
	    entryPtr->nextPtr = *bucketPtr;
	    *bucketPtr = entryPtr;
	}







|
>







991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006

    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
	for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
	    bytes = TclGetString(entryPtr->objPtr);
	    length = entryPtr->objPtr->length;
	    index = (HashString(bytes, length) & tablePtr->mask);

	    *oldChainPtr = entryPtr->nextPtr;
	    bucketPtr = &tablePtr->buckets[index];
	    entryPtr->nextPtr = *bucketPtr;
	    *bucketPtr = entryPtr;
	}
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = ckalloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %d\n",







|
|







1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = ckalloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%" TCL_LL_MODIFIER "d entries in table, %" TCL_LL_MODIFIER "d buckets\n",
	    (Tcl_WideInt)tablePtr->numEntries, (Tcl_WideInt)tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %d\n",
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166

1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
TclVerifyLocalLiteralTable(
    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
				 * to be validated. */
{
    register LiteralTable *localTablePtr = &envPtr->localLitTable;
    register LiteralEntry *localPtr;
    char *bytes;
    register int i;
    int length, count;

    count = 0;
    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != -1) {
		bytes = TclGetStringFromObj(localPtr->objPtr, &length);

		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes, localPtr->refCount);
	    }
	    if (localPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyLocalLiteralTable");
	    }
	}
    }







<
|

<





|
>


|







1156
1157
1158
1159
1160
1161
1162

1163
1164

1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
TclVerifyLocalLiteralTable(
    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
				 * to be validated. */
{
    register LiteralTable *localTablePtr = &envPtr->localLitTable;
    register LiteralEntry *localPtr;
    char *bytes;

    size_t i, length, count = 0;


    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != -1) {
		bytes = TclGetString(localPtr->objPtr);
		length = localPtr->objPtr->length;
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : (int) length), bytes, localPtr->refCount);
	    }
	    if (localPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyLocalLiteralTable");
	    }
	}
    }
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217

1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
TclVerifyGlobalLiteralTable(
    Interp *iPtr)		/* Points to interpreter whose global literal
				 * table is to be validated. */
{
    register LiteralTable *globalTablePtr = &iPtr->literalTable;
    register LiteralEntry *globalPtr;
    char *bytes;
    register int i;
    int length, count;

    count = 0;
    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount < 1) {
		bytes = TclGetStringFromObj(globalPtr->objPtr, &length);

		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");
	    }
	}
    }







<
|

<





|
>


|







1206
1207
1208
1209
1210
1211
1212

1213
1214

1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
TclVerifyGlobalLiteralTable(
    Interp *iPtr)		/* Points to interpreter whose global literal
				 * table is to be validated. */
{
    register LiteralTable *globalTablePtr = &iPtr->literalTable;
    register LiteralEntry *globalPtr;
    char *bytes;

    size_t i, length, count = 0;


    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount < 1) {
		bytes = TclGetString(globalPtr->objPtr);
		length = globalPtr->objPtr->length;
		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : (int)length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");
	    }
	}
    }
Changes to generic/tclNamesp.c.
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
     * is "dying" and there are no more active call frames, call
     * Tcl_DeleteNamespace to destroy it.
     */

    nsPtr = framePtr->nsPtr;
    nsPtr->activationCount--;
    if ((nsPtr->flags & NS_DYING)
	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->callerPtr) {
	iPtr->framePtr = framePtr->callerPtr;
	iPtr->varFramePtr = framePtr->callerVarPtr;







|







400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
     * is "dying" and there are no more active call frames, call
     * Tcl_DeleteNamespace to destroy it.
     */

    nsPtr = framePtr->nsPtr;
    nsPtr->activationCount--;
    if ((nsPtr->flags & NS_DYING)
	    && (nsPtr->activationCount == (nsPtr == iPtr->globalNsPtr))) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->callerPtr) {
	iPtr->framePtr = framePtr->callerPtr;
	iPtr->varFramePtr = framePtr->callerVarPtr;
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
     * namespace's commands and variables are deleted but the structure isn't
     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
     * namespace resolution code to recognize that the namespace is "deleted".
     * The structure's storage is freed by FreeNsNameInternalRep when its
     * refCount reaches 0.
     */

    if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);







|







993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
     * namespace's commands and variables are deleted but the structure isn't
     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
     * namespace resolution code to recognize that the namespace is "deleted".
     * The structure's storage is freed by FreeNsNameInternalRep when its
     * refCount reaches 0.
     */

    if (nsPtr->activationCount  > (nsPtr == globalNsPtr)) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
TclTeardownNamespace(
    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    int i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table. Because of traces (and the desire to avoid the quadratic
     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	int length = nsPtr->cmdTable.numEntries;
	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {







|




















|







1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
TclTeardownNamespace(
    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    size_t i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table. Because of traces (and the desire to avoid the quadratic
     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	size_t length = nsPtr->cmdTable.numEntries;
	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
     * namespaces.
     *
     * Important: leave the hash table itself still live.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    while (nsPtr->childTable.numEntries > 0) {
	int length = nsPtr->childTable.numEntries;
	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Namespace *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {







|







1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
     * namespaces.
     *
     * Important: leave the hash table itself still live.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    while (nsPtr->childTable.numEntries > 0) {
	size_t length = nsPtr->childTable.numEntries;
	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Namespace *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
				 * list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    const char *simplePattern;
    char *patternCpy;
    int neededElems, len, i;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) currNsPtr;







|







1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
				 * list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    const char *simplePattern;
    char *patternCpy;
    size_t neededElems, len, i;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) currNsPtr;
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497
1498
1499
1500
1501
1502
    Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
				 * pattern list is appended onto objPtr. NULL
				 * for the current namespace. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * export pattern list is appended. */
{
    Namespace *nsPtr;

    int i, result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);







>
|







1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
    Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
				 * pattern list is appended onto objPtr. NULL
				 * for the current namespace. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * export pattern list is appended. */
{
    Namespace *nsPtr;
    size_t i;
    int result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    int i = 0, exported = 0;
    Tcl_HashEntry *found;

    /*
     * The command cmdName in the source namespace matches the pattern. Check
     * whether it was exported. If it wasn't, we ignore it.
     */








|







1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    size_t i = 0, exported = 0;
    Tcl_HashEntry *found;

    /*
     * The command cmdName in the source namespace matches the pattern. Check
     * whether it was exported. If it wasn't, we ignore it.
     */

Changes to generic/tclOO.h.
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
				 * data, or NULL if the type-specific data can
				 * be copied directly. */
} Tcl_MethodType;

/*
 * The correct value for the version field of the Tcl_MethodType structure.
 * This allows new versions of the structure to be introduced without breaking
 * binary compatability.
 */

#define TCL_OO_METHOD_VERSION_CURRENT 1

/*
 * The type of some object (or class) metadata. This describes how to delete
 * the metadata (when the object or class is deleted) and how to create a







|







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
				 * data, or NULL if the type-specific data can
				 * be copied directly. */
} Tcl_MethodType;

/*
 * The correct value for the version field of the Tcl_MethodType structure.
 * This allows new versions of the structure to be introduced without breaking
 * binary compatibility.
 */

#define TCL_OO_METHOD_VERSION_CURRENT 1

/*
 * The type of some object (or class) metadata. This describes how to delete
 * the metadata (when the object or class is deleted) and how to create a
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
				 * type-specific data can be copied
				 * directly. */
} Tcl_ObjectMetadataType;

/*
 * The correct value for the version field of the Tcl_ObjectMetadataType
 * structure. This allows new versions of the structure to be introduced
 * without breaking binary compatability.
 */

#define TCL_OO_METADATA_VERSION_CURRENT 1

/*
 * Include all the public API, generated from tclOO.decls.
 */







|







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
				 * type-specific data can be copied
				 * directly. */
} Tcl_ObjectMetadataType;

/*
 * The correct value for the version field of the Tcl_ObjectMetadataType
 * structure. This allows new versions of the structure to be introduced
 * without breaking binary compatibility.
 */

#define TCL_OO_METADATA_VERSION_CURRENT 1

/*
 * Include all the public API, generated from tclOO.decls.
 */
Changes to generic/tclObj.c.
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = keyPtr;
    Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));

    hPtr->key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    hPtr->clientData = NULL;

    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *







|







3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = keyPtr;
    Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));

    hPtr->key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    Tcl_SetHashValue(hPtr, NULL);

    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
Changes to generic/tclProc.c.
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {
	if (TclIsVarTemporary(localPtr)) {
	    *namePtr = NULL;
	} else {
	    *namePtr = TclCreateLiteral(iPtr, localPtr->name,
		    localPtr->nameLength, /* hash */ (unsigned int) -1,
		    &new, /* nsPtr */ NULL, 0, NULL);
	    Tcl_IncrRefCount(*namePtr);
	}

	if (i < numArgs) {
	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
	    varPtr->value.objPtr = localPtr->defValuePtr;







|







1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {
	if (TclIsVarTemporary(localPtr)) {
	    *namePtr = NULL;
	} else {
	    *namePtr = TclCreateLiteral(iPtr, localPtr->name,
		    localPtr->nameLength, /* hash */ -1,
		    &new, /* nsPtr */ NULL, 0, NULL);
	    Tcl_IncrRefCount(*namePtr);
	}

	if (i < numArgs) {
	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
	    varPtr->value.objPtr = localPtr->defValuePtr;
Changes to generic/tclStringObj.c.
2704
2705
2706
2707
2708
2709
2710


2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
	} else {
	    TclInvalidateStringRep(objPtr);
	    objResultPtr = objPtr;
	}

        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {


		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %lu bytes",
			STRING_SIZE(count*length)));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);







>
>

|
|







2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
	} else {
	    TclInvalidateStringRep(objPtr);
	    objResultPtr = objPtr;
	}

        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		char buf[TCL_INTEGER_SPACE];
		sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideInt)STRING_SIZE(count*length));
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %s bytes",
			buf));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return TCL_ERROR;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
2927
2928
2929
2930
2931
2932
2933


2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948


2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {


		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %lu bytes",
			STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
	    }
	    dst = Tcl_GetUnicode(objResultPtr) + start;
	} else {
	    Tcl_UniChar ch = 0;

	    /* Ugly interface! No scheme to init array size. */
	    objResultPtr = Tcl_NewUnicodeObj(&ch, 0);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {


		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %lu bytes",
			STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {







>
>

|
|












>
>

|
|







2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    Tcl_GetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    char buf[TCL_INTEGER_SPACE];
		    sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideInt)STRING_SIZE(length));
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %s bytes",
			buf));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
	    }
	    dst = Tcl_GetUnicode(objResultPtr) + start;
	} else {
	    Tcl_UniChar ch = 0;

	    /* Ugly interface! No scheme to init array size. */
	    objResultPtr = Tcl_NewUnicodeObj(&ch, 0);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    char buf[TCL_INTEGER_SPACE];
		    sprintf(buf, "%" TCL_LL_MODIFIER "u", (Tcl_WideInt)STRING_SIZE(length));
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %s bytes",
			buf));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return TCL_ERROR;
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
Changes to generic/tclTest.c.
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    if (hash.numEntries != limit) {
	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
	Tcl_DeleteHashTable(&hash);
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));







|







6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    if (hash.numEntries != (size_t)limit) {
	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
	Tcl_DeleteHashTable(&hash);
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
Changes to generic/tclThreadAlloc.c.
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

    /*
     * Get this thread's cache, allocating if necessary.
     */

    cachePtr = TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = TclpSysAlloc(sizeof(Cache), 0);
	if (cachePtr == NULL) {
	    Tcl_Panic("alloc: could not allocate new cache");
	}
        memset(cachePtr, 0, sizeof(Cache));
	Tcl_MutexLock(listLockPtr);
	cachePtr->nextPtr = firstCachePtr;
	firstCachePtr = cachePtr;







|







216
217
218
219
220
221
222
223
224
225
226
227
228
229
230

    /*
     * Get this thread's cache, allocating if necessary.
     */

    cachePtr = TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = TclpSysAlloc(sizeof(Cache));
	if (cachePtr == NULL) {
	    Tcl_Panic("alloc: could not allocate new cache");
	}
        memset(cachePtr, 0, sizeof(Cache));
	Tcl_MutexLock(listLockPtr);
	cachePtr->nextPtr = firstCachePtr;
	firstCachePtr = cachePtr;
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
    blockPtr = NULL;
    size = reqSize + sizeof(Block);
#if RCHECK
    size++;
#endif
    if (size > MAXALLOC) {
	bucket = NBUCKETS;
	blockPtr = TclpSysAlloc(size, 0);
	if (blockPtr != NULL) {
	    cachePtr->totalAssigned += reqSize;
	}
    } else {
	bucket = 0;
	while (bucketInfo[bucket].blockSize < size) {
	    bucket++;







|







342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
    blockPtr = NULL;
    size = reqSize + sizeof(Block);
#if RCHECK
    size++;
#endif
    if (size > MAXALLOC) {
	bucket = NBUCKETS;
	blockPtr = TclpSysAlloc(size);
	if (blockPtr != NULL) {
	    cachePtr->totalAssigned += reqSize;
	}
    } else {
	bucket = 0;
	while (bucketInfo[bucket].blockSize < size) {
	    bucket++;
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
	    MoveObjs(sharedPtr, cachePtr, numMove);
	}
	Tcl_MutexUnlock(objLockPtr);
	if (cachePtr->numObjects == 0) {
	    Tcl_Obj *newObjsPtr;

	    cachePtr->numObjects = numMove = NOBJALLOC;
	    newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
	    if (newObjsPtr == NULL) {
		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
	    }
	    cachePtr->lastPtr = newObjsPtr + numMove - 1;
	    objPtr = cachePtr->firstObjPtr;	/* NULL */
	    while (--numMove >= 0) {
		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;







|







568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
	    MoveObjs(sharedPtr, cachePtr, numMove);
	}
	Tcl_MutexUnlock(objLockPtr);
	if (cachePtr->numObjects == 0) {
	    Tcl_Obj *newObjsPtr;

	    cachePtr->numObjects = numMove = NOBJALLOC;
	    newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove);
	    if (newObjsPtr == NULL) {
		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
	    }
	    cachePtr->lastPtr = newObjsPtr + numMove - 1;
	    objPtr = cachePtr->firstObjPtr;	/* NULL */
	    while (--numMove >= 0) {
		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051

	/*
	 * Otherwise, allocate a big new block directly.
	 */

	if (blockPtr == NULL) {
	    size = MAXALLOC;
	    blockPtr = TclpSysAlloc(size, 0);
	    if (blockPtr == NULL) {
		return 0;
	    }
	}

	/*
	 * Split the larger block into smaller blocks for this bucket.







|







1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051

	/*
	 * Otherwise, allocate a big new block directly.
	 */

	if (blockPtr == NULL) {
	    size = MAXALLOC;
	    blockPtr = TclpSysAlloc(size);
	    if (blockPtr == NULL) {
		return 0;
	    }
	}

	/*
	 * Split the larger block into smaller blocks for this bucket.
Changes to generic/tclThreadStorage.c.
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

static TSDTable *
TSDTableCreate(void)
{
    TSDTable *tsdTablePtr;
    sig_atomic_t i;

    tsdTablePtr = TclpSysAlloc(sizeof(TSDTable), 0);
    if (tsdTablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    tsdTablePtr->allocated = 8;
    tsdTablePtr->tablePtr =
	    TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0);
    if (tsdTablePtr->tablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    for (i = 0; i < tsdTablePtr->allocated; ++i) {
	tsdTablePtr->tablePtr[i] = NULL;
    }







|






|







81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

static TSDTable *
TSDTableCreate(void)
{
    TSDTable *tsdTablePtr;
    sig_atomic_t i;

    tsdTablePtr = TclpSysAlloc(sizeof(TSDTable));
    if (tsdTablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    tsdTablePtr->allocated = 8;
    tsdTablePtr->tablePtr =
	    TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated);
    if (tsdTablePtr->tablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    for (i = 0; i < tsdTablePtr->allocated; ++i) {
	tsdTablePtr->tablePtr[i] = NULL;
    }
Changes to generic/tclVar.c.
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else {
	/*
	 * Not a dictionary, so assume (and convert to, for backward-
	 * -compatability reasons) a list.
	 */

	int elemLen;
	Tcl_Obj **elemPtrs, *copyListObj;

	result = TclListObjGetElements(interp, arrayElemObj,
		&elemLen, &elemPtrs);







|







2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else {
	/*
	 * Not a dictionary, so assume (and convert to, for backward-
	 * -compatibility reasons) a list.
	 */

	int elemLen;
	Tcl_Obj **elemPtrs, *copyListObj;

	result = TclListObjGetElements(interp, arrayElemObj,
		&elemLen, &elemPtrs);
Changes to unix/tclUnixPort.h.
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684

/*
 *---------------------------------------------------------------------------
 * The following defines wrap the system memory allocation routines.
 *---------------------------------------------------------------------------
 */

#define TclpSysAlloc(size, isBin)	malloc((size_t)(size))
#define TclpSysFree(ptr)		free((char *)(ptr))
#define TclpSysRealloc(ptr, size)	realloc((char *)(ptr), (size_t)(size))

/*
 *---------------------------------------------------------------------------
 * The following macros and declaration wrap the C runtime library functions.
 *---------------------------------------------------------------------------
 */








|

|







668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684

/*
 *---------------------------------------------------------------------------
 * The following defines wrap the system memory allocation routines.
 *---------------------------------------------------------------------------
 */

#define TclpSysAlloc(size)		malloc(size)
#define TclpSysFree(ptr)		free((char *)(ptr))
#define TclpSysRealloc(ptr, size)	realloc(ptr, size)

/*
 *---------------------------------------------------------------------------
 * The following macros and declaration wrap the C runtime library functions.
 *---------------------------------------------------------------------------
 */

Changes to unix/tclUnixThrd.c.
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
#endif /* USE_THREAD_ALLOC */

void *
TclpThreadCreateKey(void)
{
    pthread_key_t *ptkeyPtr;

    ptkeyPtr = TclpSysAlloc(sizeof *ptkeyPtr, 0);
    if (NULL == ptkeyPtr) {
	Tcl_Panic("unable to allocate thread key!");
    }

    if (pthread_key_create(ptkeyPtr, NULL)) {
	Tcl_Panic("unable to create pthread key!");
    }







|







704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
#endif /* USE_THREAD_ALLOC */

void *
TclpThreadCreateKey(void)
{
    pthread_key_t *ptkeyPtr;

    ptkeyPtr = TclpSysAlloc(sizeof *ptkeyPtr);
    if (NULL == ptkeyPtr) {
	Tcl_Panic("unable to allocate thread key!");
    }

    if (pthread_key_create(ptkeyPtr, NULL)) {
	Tcl_Panic("unable to create pthread key!");
    }
Changes to win/tclWinPort.h.
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
#endif

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */

#define TclpSysAlloc(size, isBin)	((void*)HeapAlloc(GetProcessHeap(), \
					    (DWORD)0, (DWORD)size))
#define TclpSysFree(ptr)		(HeapFree(GetProcessHeap(), \
					    (DWORD)0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
					    (DWORD)0, (LPVOID)ptr, (DWORD)size))

/* This type is not defined in the Windows headers */







|







529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
#endif

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */

#define TclpSysAlloc(size)		((void*)HeapAlloc(GetProcessHeap(), \
					    (DWORD)0, (DWORD)size))
#define TclpSysFree(ptr)		(HeapFree(GetProcessHeap(), \
					    (DWORD)0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
					    (DWORD)0, (LPVOID)ptr, (DWORD)size))

/* This type is not defined in the Windows headers */
Changes to win/tclWinThrd.c.
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047


void *
TclpThreadCreateKey(void)
{
    DWORD *key;

    key = TclpSysAlloc(sizeof *key, 0);
    if (key == NULL) {
	Tcl_Panic("unable to allocate thread key!");
    }

    *key = TlsAlloc();

    if (*key == TLS_OUT_OF_INDEXES) {







|







1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047


void *
TclpThreadCreateKey(void)
{
    DWORD *key;

    key = TclpSysAlloc(sizeof *key);
    if (key == NULL) {
	Tcl_Panic("unable to allocate thread key!");
    }

    *key = TlsAlloc();

    if (*key == TLS_OUT_OF_INDEXES) {