Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Comment: | merge novem |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | dgp-refactor |
Files: | files | file ages | folders |
SHA1: |
da8349c19aaa88c78ad5759f1afbbfe1 |
User & Date: | dgp 2016-12-02 19:34:47 |
2016-12-06
| ||
12:46 | merge novem check-in: 5101240106 user: dgp tags: dgp-refactor | |
2016-12-02
| ||
19:34 | merge novem check-in: da8349c19a user: dgp tags: dgp-refactor | |
19:02 | merge trunk check-in: 237dd7902f user: dgp tags: novem | |
2016-11-29
| ||
13:50 | merge novem check-in: 3cbb30adcd user: dgp tags: dgp-refactor | |
Changes to ChangeLog.2000.
︙ | ︙ | |||
410 411 412 413 414 415 416 | * generic/tcl.decls: * generic/tclIO.c: updated Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to the new stacked channel implementation. Their stub slots were also moved to give preference to the new 8.3.2 stub functions. This will cause an | | | 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 | * generic/tcl.decls: * generic/tclIO.c: updated Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, and Tcl_ClearChannelHandlers to conform to the new stacked channel implementation. Their stub slots were also moved to give preference to the new 8.3.2 stub functions. This will cause an incompatibility with 8.4a1 only. (StopCopy): fixed a bug introduced by a partial fix in 8.3.2 that didn't set nonBlocking correctly when resetting the flags for the write side. [Bug: 6261] * doc/ChnlStack.3: * doc/CrtChannel.3: * generic/tcl.decls: |
︙ | ︙ |
Changes to ChangeLog.2002.
︙ | ︙ | |||
843 844 845 846 847 848 849 | TCL_MEM_DEBUG is used. [Bug 583445] * win/tclWinConsole.c (ConsoleCloseProc): only wait on writable pipe if there was something to write. This may prevent infinite wait on exit. * tests/exec.test: marked exec-18.1 unixOnly until the Windows | | | 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 | TCL_MEM_DEBUG is used. [Bug 583445] * win/tclWinConsole.c (ConsoleCloseProc): only wait on writable pipe if there was something to write. This may prevent infinite wait on exit. * tests/exec.test: marked exec-18.1 unixOnly until the Windows incompatibility (in the test, not the core) can be resolved. * tests/http.test (http-3.11): added close $fp that was causing an error on Windows because the file was not closed before deleting. * unix/tclUnixInit.c (Tcl_MacOSXGetLibraryPath): made this static function only appear when HAVE_CFBUNDLE is defined. |
︙ | ︙ | |||
3638 3639 3640 3641 3642 3643 3644 | [regsub] returns the modified string. * doc/regsub.n: Updated docs. * tests/regexp.test: Updated and added tests. * compat/strtoll.c (strtoll): * compat/strtoull.c (strtoull): * unix/tclUnixPort.h: | | | 3638 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 | [regsub] returns the modified string. * doc/regsub.n: Updated docs. * tests/regexp.test: Updated and added tests. * compat/strtoll.c (strtoll): * compat/strtoull.c (strtoull): * unix/tclUnixPort.h: * win/tclWinPort.h: Const-ing 64-bit compatibility declarations. Note that the return pointer is non-const because it is entirely legal for the functions to be called from somewhere that owns the string being passed. Fixes problem reported by Larry Virden. 2002-02-21 David Gravereaux <[email protected]> * win/mkd.bat (removed): |
︙ | ︙ | |||
3775 3776 3777 3778 3779 3780 3781 | +----------------------+ | TIP #72 IMPLEMENTED. | +----------------------+ There are a lot of changes from this TIP, so please see http://purl.org/tcl/tip/72.html for discussion of | | | 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 | +----------------------+ | TIP #72 IMPLEMENTED. | +----------------------+ There are a lot of changes from this TIP, so please see http://purl.org/tcl/tip/72.html for discussion of backward-compatibility issues, but the main ones modifications are in: * generic/tcl.h: New types. * generic/tcl.decls: New public functions. * generic/tclExecute.c: 64-bit aware bytecode engine. * generic/tclBinary.c: 64-bit handling in [binary] command. * generic/tclScan.c: 64-bit handling in [scan] command. * generic/tclCmdAH.c: 64-bit handling in [file] and [format] |
︙ | ︙ |
Changes to ChangeLog.2003.
︙ | ︙ | |||
943 944 945 946 947 948 949 | function in multiple interfaces simultaneously. * generic/tcl.decls: Duplicated some namespace declarations from tclInt.decls here, as mandated by TIP #139. This is OK since the declarations match and will end up using the declarations in the public code from now on because of #include ordering. Keeping the old declarations in tclInt.decls; there's no need to gratuitously break | | | 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 | function in multiple interfaces simultaneously. * generic/tcl.decls: Duplicated some namespace declarations from tclInt.decls here, as mandated by TIP #139. This is OK since the declarations match and will end up using the declarations in the public code from now on because of #include ordering. Keeping the old declarations in tclInt.decls; there's no need to gratuitously break compatibility for those extensions which are already clients of the namespace code. 2003-08-23 Zoran Vasiljevic <[email protected]> * generic/tclIOUtil.c: merged fixes for thread-unsafe handling of filesystem records [Bug 753315]. This also fixed the [Bug 788780] * generic/tclPathObj.c: merged fixes for thread-unsafe handling of |
︙ | ︙ | |||
1274 1275 1276 1277 1278 1279 1280 | * generic/tclCmdMZ.c (Tcl_StringObjCmd): Made [string map] accept dictionaries for maps. This is much trickier than it looks, since map entry ordering is significant. [Bug 759936] * generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array get] and [array set] work with dictionaries, producing them and consuming | | | 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 | * generic/tclCmdMZ.c (Tcl_StringObjCmd): Made [string map] accept dictionaries for maps. This is much trickier than it looks, since map entry ordering is significant. [Bug 759936] * generic/tclVar.c (Tcl_ArrayObjCmd, TclArraySet): Made [array get] and [array set] work with dictionaries, producing them and consuming them. Note that for compatibility reasons, you will never get a dict from feeding a string literal to [array set] since that alters the trace behaviour of "multi-key" sets. [Bug 759935] 2003-06-23 Vince Darley <[email protected]> * generic/tclTrace.c: fix to Window debug build compilation error. |
︙ | ︙ |
Changes to ChangeLog.2004.
︙ | ︙ | |||
1352 1353 1354 1355 1356 1357 1358 | code splitting [Bug 925620] removing the need for several #ifdef's, and tests and fix for an unreported Windows glob problem ('glob -dir C: -tails *'). 2004-10-07 Donal K. Fellows <[email protected]> * *.3: Convert CONST to const and VOID to void so we document how | | | 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 | code splitting [Bug 925620] removing the need for several #ifdef's, and tests and fix for an unreported Windows glob problem ('glob -dir C: -tails *'). 2004-10-07 Donal K. Fellows <[email protected]> * *.3: Convert CONST to const and VOID to void so we document how people should actually use the Tcl API and not the compatibility hacks that it has to have. * doc/man.macros, *.3: Update .AS macro so it can know how wide to make the third column of the argument list. Update documentation for C API (only users) to take advantage of this. * doc/FileSystem.3: Formatting fixes for greater documentation |
︙ | ︙ |
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.
︙ | ︙ | |||
2964 2965 2966 2967 2968 2969 2970 | Tcl_Command cmd) /* Token for command to delete. */ { Interp *iPtr = (Interp *) interp; Command *cmdPtr = (Command *) cmd; ImportRef *refPtr, *nextRefPtr; Tcl_Command importCmd; | < < < < < < < | 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 | Tcl_Command cmd) /* Token for command to delete. */ { Interp *iPtr = (Interp *) interp; Command *cmdPtr = (Command *) cmd; ImportRef *refPtr, *nextRefPtr; Tcl_Command importCmd; /* * The code here is tricky. We can't delete the hash table entry before * invoking the deletion callback because there are cases where the * deletion callback needs to invoke the command (e.g. object systems such * as OTcl). However, this means that the callback could try to delete or * rename the command. The deleted flag allows us to detect these cases * and skip nested deletes. |
︙ | ︙ | |||
2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 | * three times, everything goes up in smoke. [Bug 1220058] */ if (cmdPtr->hPtr != NULL) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; } return 0; } /* * We must delete this command, even though both traces and delete procs * may try to avoid this (renaming the command etc). Also traces and * delete procs may try to delete the command themsevles. This flag | > > > > > > > > | 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 | * three times, everything goes up in smoke. [Bug 1220058] */ if (cmdPtr->hPtr != NULL) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; } /* * Bump the command epoch counter. This will invalidate all cached * references that point to this command. */ cmdPtr->cmdEpoch++; return 0; } /* * We must delete this command, even though both traces and delete procs * may try to avoid this (renaming the command etc). Also traces and * delete procs may try to delete the command themsevles. This flag |
︙ | ︙ | |||
3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 | * cmdPtr->hptr, and make sure that no-one else has already deleted the * hash entry. */ if (cmdPtr->hPtr != NULL) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; } /* * A number of tests for particular kinds of commands are done by checking * whether the objProc field holds a known value. Set the field to NULL so * that such tests won't have false positives when applied to deleted * commands. | > > > > > > > | 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 | * cmdPtr->hptr, and make sure that no-one else has already deleted the * hash entry. */ if (cmdPtr->hPtr != NULL) { Tcl_DeleteHashEntry(cmdPtr->hPtr); cmdPtr->hPtr = NULL; /* * Bump the command epoch counter. This will invalidate all cached * references that point to this command. */ cmdPtr->cmdEpoch++; } /* * A number of tests for particular kinds of commands are done by checking * whether the objProc field holds a known value. Set the field to NULL so * that such tests won't have false positives when applied to deleted * commands. |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
151 152 153 154 155 156 157 | { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { NULL, NULL, NULL, NULL, NULL, 0 } }; /* | | > > | > > > > > | > > > | < < < < > | | | > > > > > > > > > > > > > > > > > > > > > > > > > | < | > | > > > > > > > | > > > > > > > | | | > > > > > > > | > > > | > > > > > > > > > > > > > > > > > | | 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 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 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 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 | { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, { NULL, NULL, NULL, NULL, NULL, 0 } }; /* * The following object types represent an array of bytes. The intent is * to allow arbitrary binary data to pass through Tcl as a Tcl value * without loss or damage. Such values are useful for things like * encoded strings or Tk images to name just two. * * It's strange to have two Tcl_ObjTypes in place for this task when * one would do, so a bit of detail and history how we got to this point * and where we might go from here. * * A bytearray is an ordered sequence of bytes. Each byte is an integer * value in the range [0-255]. To be a Tcl value type, we need a way to * encode each value in the value set as a Tcl string. The simplest * encoding is to represent each byte value as the same codepoint value. * A bytearray of N bytes is encoded into a Tcl string of N characters * where the codepoint of each character is the value of corresponding byte. * This approach creates a one-to-one map between all bytearray values * and a subset of Tcl string values. * * When converting a Tcl string value to the bytearray internal rep, the * question arises what to do with strings outside that subset? That is, * those Tcl strings containing at least one codepoint greater than 255? * The obviously correct answer is to raise an error! That string value * does not represent any valid bytearray value. Full Stop. The * setFromAnyProc signature has a completion code return value for just * this reason, to reject invalid inputs. * * Unfortunately this was not the path taken by the authors of the * original tclByteArrayType. They chose to accept all Tcl string values * as acceptable string encodings of the bytearray values that result * from masking away the high bits of any codepoint value at all. This * meant that every bytearray value had multiple accepted string * representations. * * The implications of this choice are truly ugly. When a Tcl value has * a string representation, we are required to accept that as the true * value. Bytearray values that possess a string representation cannot * be processed as bytearrays because we cannot know which true value * that bytearray represents. The consequence is that we drag around * an internal rep that we cannot make any use of. This painful price * is extracted at any point after a string rep happens to be generated * for the value. This happens even when the troublesome codepoints * outside the byte range never show up. This happens rather routinely * in normal Tcl operations unless we burden the script writer with the * cognitive burden of avoiding it. The price is also paid by callers * of the C interface. The routine * * unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr) * * has a guarantee to always return a non-NULL value, but that value * points to a byte sequence that cannot be used by the caller to * process the Tcl value absent some sideband testing that objPtr * is "pure". Tcl offers no public interface to perform this test, * so callers either break encapsulation or are unavoidably buggy. Tcl * has defined a public interface that cannot be used correctly. The * Tcl source code itself suffers the same problem, and has been buggy, * but progressively less so as more and more portions of the code have * been retrofitted with the required "purity testing". The set of values * able to pass the purity test can be increased via the introduction of * a "canonical" flag marker, but the only way the broken interface itself * can be discarded is to start over and define the Tcl_ObjType properly. * Bytearrays should simply be usable as bytearrays without a kabuki * dance of testing. * * The Tcl_ObjType "properByteArrayType" is (nearly) a correct * implementation of bytearrays. Any Tcl value with the type * properByteArrayType can have its bytearray value fetched and * used with confidence that acting on that value is equivalent to * acting on the true Tcl string value. This still implies a side * testing burden -- past mistakes will not let us avoid that * immediately, but it is at least a conventional test of type, and * can be implemented entirely by examining the objPtr fields, with * no need to query the intrep, as a canonical flag would require. * * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can * be revised to admit the possibility of returning NULL when the true * value is not a valid bytearray, we need a mechanism to retain * compatibility with the deployed callers of the broken interface. * That's what the retained "tclByteArrayType" provides. In those * unusual circumstances where we convert an invalid bytearray value * to a bytearray type, it is to this legacy type. Essentially any * time this legacy type gets used, it's a signal of a bug being ignored. * A TIP should be drafted to remove this connection to the broken past * so that Tcl 9 will no longer have any trace of it. Prescribing a * migration path will be the key element of that work. The internal * changes now in place are the limit of what can be done short of * interface repair. They provide a great expansion of the histories * over which bytearray values can be useful in the meanwhile. */ static const Tcl_ObjType properByteArrayType = { "bytearray", FreeByteArrayInternalRep, DupByteArrayInternalRep, UpdateStringOfByteArray, NULL }; const Tcl_ObjType tclByteArrayType = { "bytearray", FreeByteArrayInternalRep, DupByteArrayInternalRep, NULL, SetByteArrayFromAny }; /* * The following structure is the internal rep for a ByteArray object. Keeps * track of how much memory has been used and how much has been allocated for * the byte array to enable growing and shrinking of the ByteArray object with |
︙ | ︙ | |||
207 208 209 210 211 212 213 214 215 216 217 218 219 220 | #define BYTEARRAY_SIZE(len) \ ((unsigned) (TclOffset(ByteArray, bytes) + (len))) #define GET_BYTEARRAY(objPtr) \ ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_BYTEARRAY(objPtr, baPtr) \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr) /* *---------------------------------------------------------------------- * * Tcl_NewByteArrayObj -- * * This procedure is creates a new ByteArray object and initializes it | > > > > > > | 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 | #define BYTEARRAY_SIZE(len) \ ((unsigned) (TclOffset(ByteArray, bytes) + (len))) #define GET_BYTEARRAY(objPtr) \ ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_BYTEARRAY(objPtr, baPtr) \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr) int TclIsPureByteArray( Tcl_Obj * objPtr) { return (objPtr->typePtr == &properByteArrayType); } /* *---------------------------------------------------------------------- * * Tcl_NewByteArrayObj -- * * This procedure is creates a new ByteArray object and initializes it |
︙ | ︙ | |||
337 338 339 340 341 342 343 | byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); byteArrayPtr->used = length; byteArrayPtr->allocated = length; if ((bytes != NULL) && (length > 0)) { memcpy(byteArrayPtr->bytes, bytes, (size_t) length); } | | | 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 | byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); byteArrayPtr->used = length; byteArrayPtr->allocated = length; if ((bytes != NULL) && (length > 0)) { memcpy(byteArrayPtr->bytes, bytes, (size_t) length); } objPtr->typePtr = &properByteArrayType; SET_BYTEARRAY(objPtr, byteArrayPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetByteArrayFromObj -- |
︙ | ︙ | |||
367 368 369 370 371 372 373 | Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; | > | | 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 | Tcl_GetByteArrayFromObj( Tcl_Obj *objPtr, /* The ByteArray object. */ int *lengthPtr) /* If non-NULL, filled with length of the * array of bytes in the ByteArray object. */ { ByteArray *baPtr; if ((objPtr->typePtr != &properByteArrayType) && (objPtr->typePtr != &tclByteArrayType)) { SetByteArrayFromAny(NULL, objPtr); } baPtr = GET_BYTEARRAY(objPtr); if (lengthPtr != NULL) { *lengthPtr = baPtr->used; } |
︙ | ︙ | |||
410 411 412 413 414 415 416 | int length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } | > | | 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 | int length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } if ((objPtr->typePtr != &properByteArrayType) && (objPtr->typePtr != &tclByteArrayType)) { SetByteArrayFromAny(NULL, objPtr); } byteArrayPtr = GET_BYTEARRAY(objPtr); if (length > byteArrayPtr->allocated) { byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length)); byteArrayPtr->allocated = length; |
︙ | ︙ | |||
446 447 448 449 450 451 452 | */ static int SetByteArrayFromAny( Tcl_Interp *interp, /* Not used. */ Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */ { | | > > > | > > > | | | | | > | | | | | | | < | 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 | */ static int SetByteArrayFromAny( Tcl_Interp *interp, /* Not used. */ Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */ { int length, improper = 0; const char *src, *srcEnd; unsigned char *dst; ByteArray *byteArrayPtr; Tcl_UniChar ch; if (objPtr->typePtr == &properByteArrayType) { return TCL_OK; } if (objPtr->typePtr == &tclByteArrayType) { return TCL_OK; } src = TclGetStringFromObj(objPtr, &length); srcEnd = src + length; byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); for (dst = byteArrayPtr->bytes; src < srcEnd; ) { src += Tcl_UtfToUniChar(src, &ch); improper = improper || (ch > 255); *dst++ = UCHAR(ch); } byteArrayPtr->used = dst - byteArrayPtr->bytes; byteArrayPtr->allocated = length; TclFreeIntRep(objPtr); objPtr->typePtr = improper ? &tclByteArrayType : &properByteArrayType; SET_BYTEARRAY(objPtr, byteArrayPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * FreeByteArrayInternalRep -- |
︙ | ︙ | |||
531 532 533 534 535 536 537 | copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length); SET_BYTEARRAY(copyPtr, copyArrayPtr); | | | 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 | copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length); SET_BYTEARRAY(copyPtr, copyArrayPtr); copyPtr->typePtr = srcPtr->typePtr; } /* *---------------------------------------------------------------------- * * UpdateStringOfByteArray -- * |
︙ | ︙ | |||
638 639 640 641 642 643 644 | Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } if (len == 0) { /* Append zero bytes is a no-op. */ return; } | > | | 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 | Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } if (len == 0) { /* Append zero bytes is a no-op. */ return; } if ((objPtr->typePtr != &properByteArrayType) && (objPtr->typePtr != &tclByteArrayType)) { SetByteArrayFromAny(NULL, objPtr); } byteArrayPtr = GET_BYTEARRAY(objPtr); if (len > INT_MAX - byteArrayPtr->used) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
2114 2115 2116 2117 2118 2119 2120 | static int StringReptCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | < < | | < < < < < < < < < < < < < < < < < < < < < < | < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 | static int StringReptCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int count; Tcl_Obj *resultPtr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string count"); return TCL_ERROR; } if (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) { return TCL_ERROR; } /* * Check for cases that allow us to skip copying stuff. */ if (count == 1) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } else if (count < 1) { return TCL_OK; } if (TCL_OK != TclStringRepeat(interp, objv[1], count, &resultPtr)) { return TCL_ERROR; } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * StringRplcCmd -- |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
1066 1067 1068 1069 1070 1071 1072 | 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 int TclNRExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); MODULE_SCOPE ClientData TclFetchAuxData(CompileEnv *envPtr, int index); | | | 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 | 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 int TclNRExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); MODULE_SCOPE ClientData TclFetchAuxData(CompileEnv *envPtr, int index); 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 ByteCode * TclInitByteCode(CompileEnv *envPtr); |
︙ | ︙ |
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/tclDisassemble.c.
︙ | ︙ | |||
250 251 252 253 254 255 256 | ByteCode *codePtr = BYTECODE(objPtr); unsigned char *codeStart, *codeLimit, *pc; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_Obj *bufferObj, *fileObj; | | > | > | < | | < | 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 | ByteCode *codePtr = BYTECODE(objPtr); unsigned char *codeStart, *codeLimit, *pc; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_Obj *bufferObj, *fileObj; char ptrBuf1[20], ptrBuf2[20]; TclNewObj(bufferObj); if (codePtr->refCount <= 0) { return bufferObj; /* Already freed. */ } codeStart = codePtr->codeStart; codeLimit = codeStart + codePtr->numCodeBytes; numCmds = codePtr->numCommands; /* * Print header lines describing the ByteCode. */ sprintf(ptrBuf1, "%p", codePtr); sprintf(ptrBuf2, "%p", iPtr); Tcl_AppendPrintfToObj(bufferObj, "ByteCode 0x%s, refCt %" TCL_LL_MODIFIER "u, epoch %" TCL_LL_MODIFIER "u, interp 0x%s (epoch %" TCL_LL_MODIFIER "u)\n", ptrBuf1, (Tcl_WideUInt)codePtr->refCount, (Tcl_WideUInt)codePtr->compileEpoch, ptrBuf2, (Tcl_WideUInt)iPtr->compileEpoch); Tcl_AppendToObj(bufferObj, " Source ", -1); PrintSourceToObj(bufferObj, codePtr->source, TclMin(codePtr->numSrcBytes, 55)); GetLocationInformation(interp, codePtr->procPtr, &fileObj, &line); if (line > -1 && fileObj != NULL) { Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d", Tcl_GetString(fileObj), line); |
︙ | ︙ | |||
312 313 314 315 316 317 318 | * procedure's name since ByteCode's can be shared among procedures. */ if (codePtr->procPtr != NULL) { Proc *procPtr = codePtr->procPtr; int numCompiledLocals = procPtr->numCompiledLocals; | | | | | 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 | * procedure's name since ByteCode's can be shared among procedures. */ if (codePtr->procPtr != NULL) { Proc *procPtr = codePtr->procPtr; int numCompiledLocals = procPtr->numCompiledLocals; sprintf(ptrBuf1, "%p", procPtr); Tcl_AppendPrintfToObj(bufferObj, " Proc 0x%s, refCt %" TCL_LL_MODIFIER "d, args %d, compiled locals %d\n", ptrBuf1, (Tcl_WideUInt)procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { CompiledLocal *localPtr = procPtr->firstLocalPtr; for (i = 0; i < numCompiledLocals; i++) { Tcl_AppendPrintfToObj(bufferObj, " slot %d%s%s%s%s%s%s", i, |
︙ | ︙ |
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 | * *---------------------------------------------------------------------- */ 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.numRemovedObjs = numRemoved; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { size_t numIns = iPtr->ensembleRewrite.numInsertedObjs; if (numIns < numRemoved) { iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved; } |
︙ | ︙ | |||
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 | } 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; |
︙ | ︙ | |||
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. */ |
︙ | ︙ | |||
2650 2651 2652 2653 2654 2655 2656 | if (hPtr == NULL) { break; } ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr); hPtr = Tcl_NextHashEntry(&search); } if (hash->numEntries > 1) { | | | 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 | 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.numInsertedObjs; size_t 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 ((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.
︙ | ︙ | |||
284 285 286 287 288 289 290 | TclVarHashTable varTable; /* Contains all the (global) variables * currently in this namespace. Indexed by * strings; values have type (Var *). */ Tcl_Obj *exportPatternList; /* Set of "string match" style patterns that * specify which commands are exported. * No namespace qualifiers are allowed. */ | | | 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 | TclVarHashTable varTable; /* Contains all the (global) variables * currently in this namespace. Indexed by * strings; values have type (Var *). */ Tcl_Obj *exportPatternList; /* Set of "string match" style patterns that * specify which commands are exported. * No namespace qualifiers are allowed. */ 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 |
︙ | ︙ | |||
530 531 532 533 534 535 536 | 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. */ | | | 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 | 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) |
︙ | ︙ | |||
603 604 605 606 607 608 609 | * "upvar", this field points to the * referenced variable's Var struct. */ } value; } Var; typedef struct VarInHash { Var var; | | | 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 | * "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. */ |
︙ | ︙ | |||
935 936 937 938 939 940 941 | * 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. */ | | | 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 | * 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 |
︙ | ︙ | |||
1052 1053 1054 1055 1056 1057 1058 | /* * 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 { | | | 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 | /* * 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)]) |
︙ | ︙ | |||
1214 1215 1216 1217 1218 1219 1220 | * 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. */ | | | 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 | * 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[.] */ |
︙ | ︙ | |||
1495 1496 1497 1498 1499 1500 1501 | 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. */ | | | | | | 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 | 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. */ |
︙ | ︙ | |||
1962 1963 1964 1965 1966 1967 1968 | 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. */ | | | | 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 | 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 numRemovedObjs; /* How many arguments have been stripped off * because of ensemble processing. */ size_t numInsertedObjs; /* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; /* * TIP #219: Global info for the I/O system. */ |
︙ | ︙ | |||
3171 3172 3173 3174 3175 3176 3177 | 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, | | > > | 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 | 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, int start); MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, int last); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, Tcl_Obj *patternObj, int flags); MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr); MODULE_SCOPE int TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, int count, Tcl_Obj **objPtrPtr); MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes, int numBytes, int flags, int line, struct CompileEnv *envPtr); MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, int numOpts, Tcl_Obj *const opts[], int *flagPtr); MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, int numBytes, int flags, Tcl_Parse *parsePtr); |
︙ | ︙ | |||
4468 4469 4470 4471 4472 4473 4474 | * but we don't do that at the moment since this is purely about efficiency. * The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ | | < | 4470 4471 4472 4473 4474 4475 4476 4477 4478 4479 4480 4481 4482 4483 4484 | * but we don't do that at the moment since this is purely about efficiency. * The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); *---------------------------------------------------------------- */ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); /* *---------------------------------------------------------------- * Macro used by the Tcl core to compare Unicode strings. On big-endian * systems we can use the more efficient memcmp, but this would not be * lexically correct on little-endian systems. The ANSI C "prototype" for * this macro is: |
︙ | ︙ |
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.
︙ | ︙ | |||
28 29 30 31 32 33 34 | * Function prototypes for static functions in this file: */ static Tcl_Obj * CreateLiteral(Interp *iPtr, const char *bytes, int length, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); static void ExpandLocalLiteralArray(CompileEnv *envPtr); | | | 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | * Function prototypes for static functions in this file: */ static Tcl_Obj * CreateLiteral(Interp *iPtr, const char *bytes, int length, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); 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); /* |
︙ | ︙ | |||
101 102 103 104 105 106 107 | 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; | | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | 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 204 205 | * *---------------------------------------------------------------------- */ Tcl_Obj * TclCreateLiteral( Interp *iPtr, const char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ int length) /* Number of bytes in the string. */ { int new; return CreateLiteral(iPtr, bytes, length, &new, NULL, 0, NULL); } static Tcl_Obj * CreateLiteral( Interp *iPtr, const char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ int length, /* Number of bytes in the string. */ 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 (length < 0) { |
︙ | ︙ | |||
298 299 300 301 302 303 304 | RebuildLiteralTable(globalTablePtr); } #ifdef TCL_COMPILE_DEBUG TclVerifyGlobalLiteralTable(iPtr); { LiteralEntry *entryPtr; | | > | | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 | 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); |
︙ | ︙ | |||
348 349 350 351 352 353 354 | *---------------------------------------------------------------------- */ Tcl_Obj * TclFetchLiteral( CompileEnv *envPtr, /* Points to the CompileEnv from which to * fetch the registered literal value. */ | | | | 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 | *---------------------------------------------------------------------- */ 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]; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
391 392 393 394 395 396 397 | 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. */ | | | 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 | 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. */ |
︙ | ︙ | |||
469 470 471 472 473 474 475 | * that was previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr = &iPtr->literalTable; register LiteralEntry *entryPtr; const char *bytes; | | | | | 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 | * 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; |
︙ | ︙ | |||
609 610 611 612 613 614 615 | * must be enlarged. */ { /* * The current allocated local literal entries are stored between elements * 0 and (envPtr->literalArrayNext - 1) [inclusive]. */ | | | | | | 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 | * must be enlarged. */ { /* * The current allocated local literal entries are stored between elements * 0 and (envPtr->literalArrayNext - 1) [inclusive]. */ size_t currElems = envPtr->literalArrayNext; size_t currBytes = (currElems * sizeof(Tcl_Obj *)); Tcl_Obj **currArrayPtr = envPtr->literalArrayPtr; Tcl_Obj **newArrayPtr; 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 |
︙ | ︙ | |||
670 671 672 673 674 675 676 | * previously created by a call to * TclRegisterLiteral. */ { Interp *iPtr = (Interp *) interp; LiteralTable *globalTablePtr; register LiteralEntry *entryPtr, *prevPtr; const char *bytes; | | | > | | 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 | * 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. */ |
︙ | ︙ | |||
741 742 743 744 745 746 747 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | | 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 | * * 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: |
︙ | ︙ | |||
815 816 817 818 819 820 821 | /* Local or global table to enlarge. */ { LiteralEntry **oldBuckets; register LiteralEntry **oldChainPtr, **newChainPtr; register LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; | < | | 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 | /* 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. |
︙ | ︙ | |||
851 852 853 854 855 856 857 | /* * 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) { | | > | 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 | /* * 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; } |
︙ | ︙ | |||
969 970 971 972 973 974 975 | } /* * Print out the histogram and a few other pieces of information. */ result = ckalloc(NUM_COUNTERS*60 + 300); | | | | 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 | } /* * 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", |
︙ | ︙ | |||
1046 1047 1048 1049 1050 1051 1052 | TclVerifyGlobalLiteralTable( Interp *iPtr) /* Points to interpreter whose global literal * table is to be validated. */ { register LiteralTable *globalTablePtr = &iPtr->literalTable; register LiteralEntry *globalPtr; char *bytes; | < | < | > | | 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 | 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; |
︙ | ︙ | |||
991 992 993 994 995 996 997 | * 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. */ | | | 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 | * 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); |
︙ | ︙ | |||
1093 1094 1095 1096 1097 1098 1099 | 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; | | | | 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 1121 1122 1123 1124 1125 1126 1127 1128 | 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)) { |
︙ | ︙ | |||
1186 1187 1188 1189 1190 1191 1192 | * namespaces. * * Important: leave the hash table itself still live. */ #ifndef BREAK_NAMESPACE_COMPAT while (nsPtr->childTable.numEntries > 0) { | | | 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 | * 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)) { |
︙ | ︙ | |||
1727 1728 1729 1730 1731 1732 1733 | Namespace *nsPtr, Tcl_HashEntry *hPtr, const char *cmdName, const char *pattern, Namespace *importNsPtr, int allowOverwrite) { | | > | 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 | Namespace *nsPtr, Tcl_HashEntry *hPtr, const char *cmdName, const char *pattern, Namespace *importNsPtr, int allowOverwrite) { int objc; size_t exported = 0; Tcl_Obj **objv; 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/tclStringObj.c.
︙ | ︙ | |||
2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 | Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( (long) va_arg(argList, int))); break; case 1: Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( va_arg(argList, long))); break; } break; case 'e': case 'E': case 'f': case 'g': case 'G': | > > > > | 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 | Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( (long) va_arg(argList, int))); break; case 1: Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj( va_arg(argList, long))); break; case 2: Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj( va_arg(argList, Tcl_WideInt))); break; } break; case 'e': case 'E': case 'f': case 'g': case 'G': |
︙ | ︙ | |||
2497 2498 2499 2500 2501 2502 2503 | p = end; break; } case '.': gotPrecision = 1; p++; break; | | | | 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 | p = end; break; } case '.': gotPrecision = 1; p++; break; /* TODO: support for bignum arguments */ case 'l': ++size; p++; break; case 'h': size = -1; default: p++; } |
︙ | ︙ | |||
2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 | *sizePtr = stringPtr->allocated; return objPtr->bytes; } /* *--------------------------------------------------------------------------- * * TclStringCatObjv -- * * Performs the [string cat] function. * * Results: * A standard Tcl result. * | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 | *sizePtr = stringPtr->allocated; return objPtr->bytes; } /* *--------------------------------------------------------------------------- * * TclStringRepeat -- * * Performs the [string repeat] function. * * Results: * A standard Tcl result. * * Side effects: * Writes to *objPtrPtr the address of Tcl_Obj that is concatenation * of count copies of the value in objPtr. * *--------------------------------------------------------------------------- */ int TclStringRepeat( Tcl_Interp *interp, Tcl_Obj *objPtr, int count, Tcl_Obj **objPtrPtr) { Tcl_Obj *objResultPtr; int length = 0, unichar = 0, done = 1; int binary = TclIsPureByteArray(objPtr); /* assert (count >= 2) */ /* * Analyze to determine what representation result should be. * GOALS: Avoid shimmering & string rep generation. * Produce pure bytearray when possible. * Error on overflow. */ if (!binary) { if (objPtr->typePtr == &tclStringType) { String *stringPtr = GET_STRING(objPtr); if (stringPtr->hasUnicode) { unichar = 1; } } } if (binary) { /* Result will be pure byte array. Pre-size it */ Tcl_GetByteArrayFromObj(objPtr, &length); } else if (unichar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ Tcl_GetUnicodeFromObj(objPtr, &length); } else { /* Result will be concat of string reps. Pre-size it. */ Tcl_GetStringFromObj(objPtr, &length); } if (length == 0) { /* Any repeats of empty is empty. */ *objPtrPtr = objPtr; return TCL_OK; } if (count > INT_MAX/length) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max size for a Tcl value (%d bytes) exceeded", INT_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; } if (binary) { /* Efficiently produce a pure byte array result */ objResultPtr = Tcl_IsShared(objPtr) ? Tcl_DuplicateObj(objPtr) : objPtr; Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */ Tcl_SetByteArrayLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } TclAppendBytesToByteArray(objResultPtr, Tcl_GetByteArrayFromObj(objResultPtr, NULL), (count - done) * length); } else if (unichar) { /* Efficiently produce a pure Tcl_UniChar array result */ if (Tcl_IsShared(objPtr)) { objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length); } 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 %llu bytes", (Tcl_WideUInt)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); done *= 2; } Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr), (count - done) * length); } else { /* Efficiently concatenate string reps */ if (Tcl_IsShared(objPtr)) { objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length); } else { TclFreeIntRep(objPtr); objResultPtr = objPtr; } if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "string size overflow: unable to alloc %u bytes", count*length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; } Tcl_SetObjLength(objResultPtr, length); while (count - done > done) { Tcl_AppendObjToObj(objResultPtr, objResultPtr); done *= 2; } Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr), (count - done) * length); } *objPtrPtr = objResultPtr; return TCL_OK; } /* *--------------------------------------------------------------------------- * * TclStringCatObjv -- * * Performs the [string cat] function. * * Results: * A standard Tcl result. * |
︙ | ︙ | |||
2688 2689 2690 2691 2692 2693 2694 | ov = objv; oc = objc; while (oc-- && (length >= 0)) { objPtr = *ov++; if (objPtr->bytes == NULL) { int numBytes; | | | | | 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 | ov = objv; oc = objc; while (oc-- && (length >= 0)) { objPtr = *ov++; if (objPtr->bytes == NULL) { int numBytes; Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */ if (length == 0) { first = objc - oc - 1; } length += numBytes; } } } else if (allowUniChar && requestUniChar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ ov = objv; oc = objc; while (oc-- && (length >= 0)) { objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { int numChars; Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ if (length == 0) { first = objc - oc - 1; } length += numChars; } } } else { /* Result will be concat of string reps. Pre-size it. */ ov = objv; oc = objc; while (oc-- && (length >= 0)) { int numBytes; objPtr = *ov++; Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */ if ((length == 0) && numBytes) { first = objc - oc - 1; } length += numBytes; } } |
︙ | ︙ | |||
2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 | objv += first; objc -= first; if (binary) { /* Efficiently produce a pure byte array result */ unsigned char *dst; if (inPlace && !Tcl_IsShared(*objv)) { int start; objResultPtr = *objv++; objc--; Tcl_GetByteArrayFromObj(objResultPtr, &start); dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; } else { | > > > > > | 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 | objv += first; objc -= first; if (binary) { /* Efficiently produce a pure byte array result */ unsigned char *dst; /* * Broken interface! Byte array value routines offer no way * to handle failure to allocate enough space. Following * stanza may panic. */ if (inPlace && !Tcl_IsShared(*objv)) { int start; objResultPtr = *objv++; objc--; Tcl_GetByteArrayFromObj(objResultPtr, &start); dst = Tcl_SetByteArrayLength(objResultPtr, length) + start; } else { |
︙ | ︙ | |||
2780 2781 2782 2783 2784 2785 2786 | int start; objResultPtr = *objv++; objc--; /* Ugly interface! Force resize of the unicode array. */ Tcl_GetUnicodeFromObj(objResultPtr, &start); Tcl_InvalidateStringRep(objResultPtr); | | > > > > > > > > | | > > > > > > > > | 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 2965 2966 | int start; 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 %llu bytes", (Tcl_WideUInt)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 %llu bytes", (Tcl_WideUInt)STRING_SIZE(length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; } dst = Tcl_GetUnicode(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { int more; |
︙ | ︙ | |||
2810 2811 2812 2813 2814 2815 2816 | if (inPlace && !Tcl_IsShared(*objv)) { int start; objResultPtr = *objv++; objc--; Tcl_GetStringFromObj(objResultPtr, &start); | | > > > > > > > > | | > > > > > > > > | 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 | if (inPlace && !Tcl_IsShared(*objv)) { int start; objResultPtr = *objv++; objc--; Tcl_GetStringFromObj(objResultPtr, &start); if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; } dst = Tcl_GetString(objResultPtr) + start; if (length > start) { TclFreeIntRep(objResultPtr); } } else { objResultPtr = Tcl_NewObj(); /* PANIC? */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "concatenation failed: unable to alloc %u bytes", length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; } dst = Tcl_GetString(objResultPtr); } while (objc--) { Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { int more; |
︙ | ︙ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
6686 6687 6688 6689 6690 6691 6692 | Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } Tcl_SetHashValue(hPtr, INT2PTR(i+42)); } | | | 6686 6687 6688 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 | 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 library/http/http.tcl.
︙ | ︙ | |||
1443 1444 1445 1446 1447 1448 1449 | if {$http(-urlencoding) ne ""} { set string [encoding convertto $http(-urlencoding) $string] return [string map $formMap $string] } set converted [string map $formMap $string] if {[string match "*\[\u0100-\uffff\]*" $converted]} { regexp "\[\u0100-\uffff\]" $converted badChar | | | 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 | if {$http(-urlencoding) ne ""} { set string [encoding convertto $http(-urlencoding) $string] return [string map $formMap $string] } set converted [string map $formMap $string] if {[string match "*\[\u0100-\uffff\]*" $converted]} { regexp "\[\u0100-\uffff\]" $converted badChar # Return this error message for maximum compatibility... :^/ return -code error \ "can't read \"formMap($badChar)\": no such element in array" } return $converted } # http::ProxyRequired -- |
︙ | ︙ |
Changes to tests/trace.test.
︙ | ︙ | |||
1261 1262 1263 1264 1265 1266 1267 | set info {} namespace delete ::ref rename doTrace {} set info } 1110 test trace-18.5 {Bug 7f02ff1efa} -setup { proc constant {name value} { | | | 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 | set info {} namespace delete ::ref rename doTrace {} set info } 1110 test trace-18.5 {Bug 7f02ff1efa} -setup { proc constant {name value} { upvar 1 $name c set c $value trace variable c wu [list reset $value] } proc reset {v a i o} { uplevel 1 [list constant $a $v] } proc demo {} { |
︙ | ︙ |
Changes to unix/tcl.m4.
︙ | ︙ | |||
2702 2703 2704 2705 2706 2707 2708 | # Check for broken function. # # Arguments: # funcName - function to test for # advancedTest - the advanced test to run if the function is present # # Results: | | | 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 | # Check for broken function. # # Arguments: # funcName - function to test for # advancedTest - the advanced test to run if the function is present # # Results: # Might cause compatibility versions of the function to be used. # Might affect the following vars: # USE_COMPAT (implicit) # #-------------------------------------------------------------------- AC_DEFUN([SC_TCL_CHECK_BROKEN_FUNC],[ AC_CHECK_FUNC($1, tcl_ok=1, tcl_ok=0) |
︙ | ︙ |
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/Makefile.in.
︙ | ︙ | |||
617 618 619 620 621 622 623 | do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ else true; \ fi; \ done; | | | 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 | do \ if [ ! -d $$i ] ; then \ echo "Making directory $$i"; \ $(MKDIR) $$i; \ else true; \ fi; \ done; @for i in http1.0 opt0.4 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \ do \ if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \ echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \ $(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \ else true; \ fi; \ done; |
︙ | ︙ |
Changes to win/makefile.vc.
︙ | ︙ | |||
109 110 111 112 113 114 115 | # above may be used (comma separated). 'none' will over-ride # everything to nothing. # # compdbg = Enables byte compilation logging. # memdbg = Enables the debugging memory allocator. # # CHECKS=64bit,fullwarn,nodep,none | | | | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 | # above may be used (comma separated). 'none' will over-ride # everything to nothing. # # compdbg = Enables byte compilation logging. # memdbg = Enables the debugging memory allocator. # # CHECKS=64bit,fullwarn,nodep,none # Sets special macros for checking compatibility. # # 64bit = Enable 64bit portability warnings (if available) # fullwarn = Builds with full compiler and link warnings enabled. # Very verbose. # nodep = Turns off compatibility macros to ensure the core # isn't being built with deprecated functions. # # MACHINE=(ALPHA|AMD64|IA64|IX86) # Set the machine type used for the compiler, linker, and # resource compiler. This hook is needed to tell the tools # when alternate platforms are requested. IX86 is the default # when not specified. If the CPU environment variable has been |
︙ | ︙ |
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) { |
︙ | ︙ |