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: |
9d4cd6b1aa1648ca997b4fa8fd8aaefa |
| 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
Changes to generic/tcl.h.
| ︙ | ︙ | |||
956 957 958 959 960 961 962 |
* 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. */
| | < < | | 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 |
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). */
| | | | > < | | | | 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 | /* *---------------------------------------------------------------------------- * Macros for clients to use to access fields of hash entries: */ #define Tcl_GetHashValue(h) ((h)->clientData) | | | 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 |
/*
* First the simple case: we simple allocate big blocks directly.
*/
if (numBytes >= MAXMALLOC - OVERHEAD) {
if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
| | | | 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 |
size = 1 << (bucket + 3);
ASSERT(size > 0);
amount = MAXMALLOC;
numBlocks = amount / size;
ASSERT(numBlocks*size == amount);
| | | | 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 |
#endif /* TCL_COMPILE_STATS */
/*
* Initialize the ensemble error message rewriting support.
*/
iPtr->ensembleRewrite.sourceObjs = NULL;
| | | | 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 | 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, | | | | 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 |
{
Tcl_Obj *objPtr = keyPtr;
ChainEntry *cPtr;
cPtr = ckalloc(sizeof(ChainEntry));
cPtr->entry.key.objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
| | | 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 |
Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
Dict *dict = DICT(dictPtr);
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
| | | | 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 | /* * 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); | | > | > < < < < < < | > | > | 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 |
* 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;
| | | | 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 | * 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. */ | | | | > | | 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 |
}
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 {
| | | 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 |
*
*----------------------------------------------------------------------
*/
int
TclInitRewriteEnsemble(
Tcl_Interp *interp,
| | | | | | | | | | 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 |
Tcl_Interp *interp,
int isRootEnsemble)
{
Interp *iPtr = (Interp *) interp;
if (isRootEnsemble) {
iPtr->ensembleRewrite.sourceObjs = NULL;
| | | | 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 |
}
void
TclSpellFix(
Tcl_Interp *interp,
Tcl_Obj *const *objv,
int objc,
| | | | | | | | | | 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 |
Tcl_Obj *const *objv,
int objc,
int *objcPtr)
{
Interp *iPtr = (Interp *) interp;
if (iPtr->ensembleRewrite.sourceObjs) {
| | | | 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 |
static void
BuildEnsembleConfig(
EnsembleConfig *ensemblePtr)
{
Tcl_HashSearch search; /* Used for scanning the set of commands in
* the namespace that backs up this
* ensemble. */
| > | | 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 |
if (ensemblePtr->subcmdList != NULL) {
Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
int subcmdc;
TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
&subcmdv);
| | | 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 |
if (hPtr == NULL) {
break;
}
ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
hPtr = Tcl_NextHashEntry(&search);
}
if (hash->numEntries > 1) {
| | | 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 | /* * 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 | | | 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 |
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;
| < | | | | | 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 |
*newPtr = 1;
if (typePtr->allocEntryProc) {
hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
} else {
hPtr = ckalloc(sizeof(Tcl_HashEntry));
hPtr->key.oneWordValue = (char *) key;
| | | | 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 |
Tcl_DeleteHashEntry(
Tcl_HashEntry *entryPtr)
{
register Tcl_HashEntry *prevPtr;
const Tcl_HashKeyType *typePtr;
Tcl_HashTable *tablePtr;
Tcl_HashEntry **bucketPtr;
| | | | | 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 |
void
Tcl_DeleteHashTable(
register Tcl_HashTable *tablePtr) /* Table to delete. */
{
register Tcl_HashEntry *hPtr, *nextPtr;
const Tcl_HashKeyType *typePtr;
| | | 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 |
*/
char *
Tcl_HashStats(
Tcl_HashTable *tablePtr) /* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
| | | 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 |
}
/*
* Print out the histogram and a few other pieces of information.
*/
result = ckalloc((NUM_COUNTERS * 60) + 300);
| | | | | | | 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 |
}
hPtr = ckalloc(size);
for (iPtr1 = array, iPtr2 = hPtr->key.words;
count > 0; count--, iPtr1++, iPtr2++) {
*iPtr2 = *iPtr1;
}
| | | 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 |
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);
| | | 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 |
*----------------------------------------------------------------------
*/
static void
RebuildTable(
register Tcl_HashTable *tablePtr) /* Table to enlarge. */
{
| | | 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 |
/*
* 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) {
| | | | 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 |
*/
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) {
| | | | 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 |
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;
| | | | | | 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 |
if (origObjv[i]->typePtr == &indexType) {
register IndexRep *indexRep =
origObjv[i]->internalRep.twoPtrValue.ptr1;
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
} else {
| | > | 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 |
/*
* Now add the arguments (other than those rewritten) that the caller took
* from its calling context.
*/
addNormalArgumentsToMessage:
| | | > | | | 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 |
declare 244 {
Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
}
declare 245 {
Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
}
declare 246 {
| | | | 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 |
declare 250 {
void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}
# Allow extensions for optimization
declare 251 {
int TclRegisterLiteral(void *envPtr,
| | | 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 |
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. */
| | | | | 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 |
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. */
| | | 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 |
* "upvar", this field points to the
* referenced variable's Var struct. */
} value;
} Var;
typedef struct VarInHash {
Var var;
| | | 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 |
* 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. */
| | | 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 |
/*
* 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 {
| | | 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 |
* 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. */
| | | 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 |
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. */
| | | | | | 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 |
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. */
| | | | 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 | 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, | | | 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 | 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, | | | | 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 |
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 */
| | | | 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 | /* * Function prototypes for static functions in this file: */ static int AddLocalLiteralEntry(CompileEnv *envPtr, Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); | | | 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 |
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;
| | | 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 |
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclCreateLiteral(
Interp *iPtr,
| | | | | | | 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 |
RebuildLiteralTable(globalTablePtr);
}
#ifdef TCL_COMPILE_DEBUG
TclVerifyGlobalLiteralTable(iPtr);
{
LiteralEntry *entryPtr;
| | > | | 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 |
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclFetchLiteral(
CompileEnv *envPtr, /* Points to the CompileEnv from which to
* fetch the registered literal value. */
| | | | 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 |
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. */
| | < | > | | | 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 |
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",
| | | 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 |
* that was previously created by a call to
* TclRegisterLiteral. */
{
Interp *iPtr = (Interp *) interp;
LiteralTable *globalTablePtr = &iPtr->literalTable;
register LiteralEntry *entryPtr;
const char *bytes;
| | | | | 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 |
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;
| | > | > | 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 |
RebuildLiteralTable(localTablePtr);
}
#ifdef TCL_COMPILE_DEBUG
TclVerifyLocalLiteralTable(envPtr);
{
char *bytes;
| > | | > | | 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 |
{
/*
* The current allocated local literal entries are stored between elements
* 0 and (envPtr->literalArrayNext - 1) [inclusive].
*/
LiteralTable *localTablePtr = &envPtr->localLitTable;
| | | | | | | 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 |
* previously created by a call to
* TclRegisterLiteral. */
{
Interp *iPtr = (Interp *) interp;
LiteralTable *globalTablePtr;
register LiteralEntry *entryPtr, *prevPtr;
const char *bytes;
| | | > | | 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 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | | 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 |
/* Local or global table to enlarge. */
{
LiteralEntry **oldBuckets;
register LiteralEntry **oldChainPtr, **newChainPtr;
register LiteralEntry *entryPtr;
LiteralEntry **bucketPtr;
const char *bytes;
| < | | 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 |
/*
* 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) {
| | > | 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 |
}
/*
* Print out the histogram and a few other pieces of information.
*/
result = ckalloc(NUM_COUNTERS*60 + 300);
| | | | 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 |
TclVerifyLocalLiteralTable(
CompileEnv *envPtr) /* Points to CompileEnv whose literal table is
* to be validated. */
{
register LiteralTable *localTablePtr = &envPtr->localLitTable;
register LiteralEntry *localPtr;
char *bytes;
| < | < | > | | 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 |
TclVerifyGlobalLiteralTable(
Interp *iPtr) /* Points to interpreter whose global literal
* table is to be validated. */
{
register LiteralTable *globalTablePtr = &iPtr->literalTable;
register LiteralEntry *globalPtr;
char *bytes;
| < | < | > | | 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 |
* 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)
| | | 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 |
* 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.
*/
| | | 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 |
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;
| | | | 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 |
* namespaces.
*
* Important: leave the hash table itself still live.
*/
#ifndef BREAK_NAMESPACE_COMPAT
while (nsPtr->childTable.numEntries > 0) {
| | | 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 |
* list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
Namespace *nsPtr, *exportNsPtr, *dummyPtr;
Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
const char *simplePattern;
char *patternCpy;
| | | 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 |
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;
| > | | 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 |
Namespace *nsPtr,
Tcl_HashEntry *hPtr,
const char *cmdName,
const char *pattern,
Namespace *importNsPtr,
int allowOverwrite)
{
| | | 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 | * 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 | | | 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 | * 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 | | | 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 |
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);
| | | 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 |
varPtr = (Var *) (namePtr + localCt);
localPtr = procPtr->firstLocalPtr;
while (localPtr) {
if (TclIsVarTemporary(localPtr)) {
*namePtr = NULL;
} else {
*namePtr = TclCreateLiteral(iPtr, localPtr->name,
| | | 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 |
} else {
TclInvalidateStringRep(objPtr);
objResultPtr = objPtr;
}
if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
| > > | | | 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 |
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(
| > > | | > > | | | 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 |
Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
Tcl_DeleteHashTable(&hash);
return TCL_ERROR;
}
Tcl_SetHashValue(hPtr, INT2PTR(i+42));
}
| | | 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 |
/*
* Get this thread's cache, allocating if necessary.
*/
cachePtr = TclpGetAllocCache();
if (cachePtr == NULL) {
| | | 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 |
blockPtr = NULL;
size = reqSize + sizeof(Block);
#if RCHECK
size++;
#endif
if (size > MAXALLOC) {
bucket = NBUCKETS;
| | | 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 |
MoveObjs(sharedPtr, cachePtr, numMove);
}
Tcl_MutexUnlock(objLockPtr);
if (cachePtr->numObjects == 0) {
Tcl_Obj *newObjsPtr;
cachePtr->numObjects = numMove = NOBJALLOC;
| | | 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 |
/*
* Otherwise, allocate a big new block directly.
*/
if (blockPtr == NULL) {
size = MAXALLOC;
| | | 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 |
static TSDTable *
TSDTableCreate(void)
{
TSDTable *tsdTablePtr;
sig_atomic_t i;
| | | | 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 |
return TCL_ERROR;
}
}
return TCL_OK;
} else {
/*
* Not a dictionary, so assume (and convert to, for backward-
| | | 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 | /* *--------------------------------------------------------------------------- * The following defines wrap the system memory allocation routines. *--------------------------------------------------------------------------- */ | | | | 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 |
#endif /* USE_THREAD_ALLOC */
void *
TclpThreadCreateKey(void)
{
pthread_key_t *ptkeyPtr;
| | | 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 | #endif /* * The following defines wrap the system memory allocation routines for * use by tclAlloc.c. */ | | | 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 |
void *
TclpThreadCreateKey(void)
{
DWORD *key;
| | | 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) {
|
| ︙ | ︙ |