summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-12-29 16:54:44 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-12-29 16:54:44 (GMT)
commit9f8ac71040a91b045d4d51b21a7539e889e53638 (patch)
tree8f00f66bfe4b4849da6385febca66a72e3d82cfb
parentf529e237b5116ef60425a6cd231f88167ff6bf05 (diff)
downloadtcl-9f8ac71040a91b045d4d51b21a7539e889e53638.zip
tcl-9f8ac71040a91b045d4d51b21a7539e889e53638.tar.gz
tcl-9f8ac71040a91b045d4d51b21a7539e889e53638.tar.bz2
Simplify the logic in Tcl_GetCommandFromObj
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclObj.c393
2 files changed, 212 insertions, 185 deletions
diff --git a/ChangeLog b/ChangeLog
index 0e4307e..2b51700 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2009-12-29 Donal K. Fellows <dkf@users.sf.net>
+ * generic/tclObj.c (Tcl_GetCommandFromObj): Rewrite the logic so
+ that it does not require making assignments part way through an
+ 'if' condition, which was deeply unclear.
+
* generic/tclInterp.c (Tcl_MakeSafe): [Bug 2895741]: Make sure that
the min() and max() functions are supported in safe interpreters.
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 667fd90..28d7a8a 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclObj.c,v 1.165 2009/12/10 19:13:26 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.166 2009/12/29 16:54:44 dkf Exp $
*/
#include "tclInt.h"
@@ -80,33 +80,29 @@ typedef struct ObjData {
*/
typedef struct ThreadSpecificData {
- Tcl_HashTable* lineCLPtr; /* This table remembers for each Tcl_Obj
- * generated by a call to the function
- * EvalTokensStandard() from a literal text
- * where bs+nl sequences occured in it, if
- * any. I.e. this table keeps track of
- * invisible/stripped continuation lines. Its
- * keys are Tcl_Obj pointers, the values are
- * ContLineLoc pointers. See the file
- * tclCompile.h for the definition of this
- * structure, and for references to all related
- * places in the core.
- */
+ Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj
+ * generated by a call to the function
+ * EvalTokensStandard() from a literal text
+ * where bs+nl sequences occured in it, if
+ * any. I.e. this table keeps track of
+ * invisible and stripped continuation lines.
+ * Its keys are Tcl_Obj pointers, the values
+ * are ContLineLoc pointers. See the file
+ * tclCompile.h for the definition of this
+ * structure, and for references to all
+ * related places in the core. */
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
- /*
- * Thread local table that is used to check that a Tcl_Obj was not
- * allocated by some other thread.
- */
-
- Tcl_HashTable *objThreadMap;
+ Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
+ * that a Tcl_Obj was not allocated by some
+ * other thread. */
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
-static void ContLineLocFree (char* clientData);
-static void TclThreadFinalizeContLines (ClientData clientData);
-static ThreadSpecificData* TclGetContLineTable (void);
+static void ContLineLocFree(char *clientData);
+static void TclThreadFinalizeContLines(ClientData clientData);
+static ThreadSpecificData *TclGetContLineTable(void);
/*
* Nested Tcl_Obj deletion management support
@@ -155,11 +151,11 @@ typedef struct PendingObjData {
#define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL)
#define PushObjToDelete(contextPtr,objPtr) \
/* The string rep is already invalidated so we can use the bytes value \
- * for our pointer chain: push onto the head of the stack. */ \
- (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
+ * for our pointer chain: push onto the head of the stack. */ \
+ (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
(contextPtr)->deletionStack = (objPtr)
#define PopObjToDelete(contextPtr,objPtrVar) \
- (objPtrVar) = (contextPtr)->deletionStack; \
+ (objPtrVar) = (contextPtr)->deletionStack; \
(contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes
/*
@@ -172,7 +168,7 @@ static PendingObjData pendingObjData;
#else
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
- PendingObjData *const contextPtr = (PendingObjData *) \
+ PendingObjData *const contextPtr = \
Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
#endif
@@ -181,27 +177,27 @@ static Tcl_ThreadDataKey pendingObjDataKey;
*/
#define PACK_BIGNUM(bignum, objPtr) \
- if ((bignum).used > 0x7fff) { \
- mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
- *temp = bignum; \
- (objPtr)->internalRep.ptrAndLongRep.ptr = temp; \
+ if ((bignum).used > 0x7fff) { \
+ mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
+ *temp = bignum; \
+ (objPtr)->internalRep.ptrAndLongRep.ptr = temp; \
(objPtr)->internalRep.ptrAndLongRep.value = (unsigned long)(-1); \
- } else { \
- if ((bignum).alloc > 0x7fff) { \
- mp_shrink(&(bignum)); \
- } \
+ } else { \
+ if ((bignum).alloc > 0x7fff) { \
+ mp_shrink(&(bignum)); \
+ } \
(objPtr)->internalRep.ptrAndLongRep.ptr = (void *) (bignum).dp; \
(objPtr)->internalRep.ptrAndLongRep.value = ( ((bignum).sign << 30) \
- | ((bignum).alloc << 15) | ((bignum).used)); \
+ | ((bignum).alloc << 15) | ((bignum).used)); \
}
#define UNPACK_BIGNUM(objPtr, bignum) \
if ((objPtr)->internalRep.ptrAndLongRep.value == (unsigned long)(-1)) { \
(bignum) = *((mp_int *) ((objPtr)->internalRep.ptrAndLongRep.ptr)); \
- } else { \
- (bignum).dp = (objPtr)->internalRep.ptrAndLongRep.ptr; \
+ } else { \
+ (bignum).dp = (objPtr)->internalRep.ptrAndLongRep.ptr; \
(bignum).sign = (objPtr)->internalRep.ptrAndLongRep.value >> 30; \
- (bignum).alloc = \
+ (bignum).alloc = \
((objPtr)->internalRep.ptrAndLongRep.value >> 15) & 0x7fff; \
(bignum).used = (objPtr)->internalRep.ptrAndLongRep.value & 0x7fff; \
}
@@ -249,48 +245,48 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
*/
static const Tcl_ObjType oldBooleanType = {
- "boolean", /* name */
- NULL, /* freeIntRepProc */
- NULL, /* dupIntRepProc */
- NULL, /* updateStringProc */
- SetBooleanFromAny /* setFromAnyProc */
+ "boolean", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetBooleanFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclBooleanType = {
- "booleanString", /* name */
- NULL, /* freeIntRepProc */
- NULL, /* dupIntRepProc */
- NULL, /* updateStringProc */
- SetBooleanFromAny /* setFromAnyProc */
+ "booleanString", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetBooleanFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclDoubleType = {
- "double", /* name */
- NULL, /* freeIntRepProc */
- NULL, /* dupIntRepProc */
- UpdateStringOfDouble, /* updateStringProc */
- SetDoubleFromAny /* setFromAnyProc */
+ "double", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfDouble, /* updateStringProc */
+ SetDoubleFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclIntType = {
- "int", /* name */
- NULL, /* freeIntRepProc */
- NULL, /* dupIntRepProc */
- UpdateStringOfInt, /* updateStringProc */
- SetIntFromAny /* setFromAnyProc */
+ "int", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfInt, /* updateStringProc */
+ SetIntFromAny /* setFromAnyProc */
};
#ifndef NO_WIDE_TYPE
const Tcl_ObjType tclWideIntType = {
- "wideInt", /* name */
- NULL, /* freeIntRepProc */
- NULL, /* dupIntRepProc */
- UpdateStringOfWideInt, /* updateStringProc */
- SetWideIntFromAny /* setFromAnyProc */
+ "wideInt", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfWideInt, /* updateStringProc */
+ SetWideIntFromAny /* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBignumType = {
- "bignum", /* name */
- FreeBignum, /* freeIntRepProc */
- DupBignum, /* dupIntRepProc */
- UpdateStringOfBignum, /* updateStringProc */
- NULL /* setFromAnyProc */
+ "bignum", /* name */
+ FreeBignum, /* freeIntRepProc */
+ DupBignum, /* dupIntRepProc */
+ UpdateStringOfBignum, /* updateStringProc */
+ NULL /* setFromAnyProc */
};
/*
@@ -330,11 +326,11 @@ const Tcl_HashKeyType tclObjHashKeyType = {
*/
Tcl_ObjType tclCmdNameType = {
- "cmdName", /* name */
- FreeCmdNameInternalRep, /* freeIntRepProc */
- DupCmdNameInternalRep, /* dupIntRepProc */
- NULL, /* updateStringProc */
- SetCmdNameFromAny /* setFromAnyProc */
+ "cmdName", /* name */
+ FreeCmdNameInternalRep, /* freeIntRepProc */
+ DupCmdNameInternalRep, /* dupIntRepProc */
+ NULL, /* updateStringProc */
+ SetCmdNameFromAny /* setFromAnyProc */
};
/*
@@ -424,6 +420,7 @@ TclInitObjSubsystem(void)
tclObjsFreed = 0;
{
int i;
+
for (i=0 ; i<TCL_MAX_SHARED_OBJ_STATS ; i++) {
tclObjsShared[i] = 0;
}
@@ -531,8 +528,8 @@ TclFinalizeObjects(void)
*----------------------------------------------------------------------
*/
-static ThreadSpecificData*
-TclGetContLineTable()
+static ThreadSpecificData *
+TclGetContLineTable(void)
{
/*
* Initialize the hashtable tracking invisible continuation lines. For
@@ -543,10 +540,11 @@ TclGetContLineTable()
*/
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
if (!tsdPtr->lineCLPtr) {
- tsdPtr->lineCLPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
+ tsdPtr->lineCLPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
- Tcl_CreateThreadExitHandler (TclThreadFinalizeContLines,NULL);
+ Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
}
return tsdPtr;
}
@@ -569,18 +567,18 @@ TclGetContLineTable()
*----------------------------------------------------------------------
*/
-ContLineLoc*
-TclContinuationsEnter(Tcl_Obj* objPtr,
- int num,
- int* loc)
+ContLineLoc *
+TclContinuationsEnter(
+ Tcl_Obj *objPtr,
+ int num,
+ int *loc)
{
int newEntry;
ThreadSpecificData *tsdPtr = TclGetContLineTable();
- Tcl_HashEntry* hPtr =
- Tcl_CreateHashEntry (tsdPtr->lineCLPtr, (char*) objPtr, &newEntry);
-
- ContLineLoc* clLocPtr =
- (ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int));
+ Tcl_HashEntry *hPtr =
+ Tcl_CreateHashEntry(tsdPtr->lineCLPtr, (char *) objPtr, &newEntry);
+ ContLineLoc *clLocPtr = (ContLineLoc *)
+ ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
if (!newEntry) {
/*
@@ -608,9 +606,9 @@ TclContinuationsEnter(Tcl_Obj* objPtr,
}
clLocPtr->num = num;
- memcpy (&clLocPtr->loc, loc, num*sizeof(int));
- clLocPtr->loc[num] = CLL_END; /* Sentinel */
- Tcl_SetHashValue (hPtr, clLocPtr);
+ memcpy(&clLocPtr->loc, loc, num*sizeof(int));
+ clLocPtr->loc[num] = CLL_END; /* Sentinel */
+ Tcl_SetHashValue(hPtr, clLocPtr);
return clLocPtr;
}
@@ -635,7 +633,10 @@ TclContinuationsEnter(Tcl_Obj* objPtr,
*/
void
-TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
+TclContinuationsEnterDerived(
+ Tcl_Obj *objPtr,
+ int start,
+ int *clNext)
{
/*
* We have to handle invisible continuations lines here as well, despite
@@ -661,16 +662,15 @@ TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
*/
int length, end, num;
- int* wordCLLast = clNext;
+ int *wordCLLast = clNext;
Tcl_GetStringFromObj(objPtr, &length);
/* Is there a better way which doesn't shimmer ? */
- end = start + length; /* first char after the word */
+ end = start + length; /* First char after the word */
/*
- * Then compute the table slice covering the range of
- * the word.
+ * Then compute the table slice covering the range of the word.
*/
while (*wordCLLast >= 0 && *wordCLLast < end) {
@@ -678,15 +678,13 @@ TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
}
/*
- * And generate the table from the slice, if it was
- * not empty.
+ * And generate the table from the slice, if it was not empty.
*/
num = wordCLLast - clNext;
if (num) {
int i;
- ContLineLoc* clLocPtr =
- TclContinuationsEnter(objPtr, num, clNext);
+ ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
/*
* Re-base the locations.
@@ -714,9 +712,9 @@ TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
* TclContinuationsCopy --
*
* This procedure is a helper which copies the continuation line
- * information associated with a Tcl_Obj* to another Tcl_Obj*.
- * It is assumed that both contain the same string/script. Use
- * this when a script is duplicated because it was shared.
+ * information associated with a Tcl_Obj* to another Tcl_Obj*. It is
+ * assumed that both contain the same string/script. Use this when a
+ * script is duplicated because it was shared.
*
* Results:
* None.
@@ -729,13 +727,16 @@ TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
*/
void
-TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
+TclContinuationsCopy(
+ Tcl_Obj *objPtr,
+ Tcl_Obj *originObjPtr)
{
ThreadSpecificData *tsdPtr = TclGetContLineTable();
- Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) originObjPtr);
+ Tcl_HashEntry *hPtr =
+ Tcl_FindHashEntry(tsdPtr->lineCLPtr, (char *) originObjPtr);
if (hPtr) {
- ContLineLoc* clLocPtr = (ContLineLoc*) Tcl_GetHashValue (hPtr);
+ ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);
TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
}
@@ -750,8 +751,8 @@ TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
* information associated with a Tcl_Obj*, if it has any.
*
* Results:
- * A reference to the continuation line location table, or NULL
- * if the Tcl_Obj* has no such information associated with it.
+ * A reference to the continuation line location table, or NULL if the
+ * Tcl_Obj* has no such information associated with it.
*
* Side effects:
* None.
@@ -760,17 +761,18 @@ TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
*----------------------------------------------------------------------
*/
-ContLineLoc*
-TclContinuationsGet(Tcl_Obj* objPtr)
+ContLineLoc *
+TclContinuationsGet(
+ Tcl_Obj *objPtr)
{
ThreadSpecificData *tsdPtr = TclGetContLineTable();
- Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) objPtr);
+ Tcl_HashEntry *hPtr =
+ Tcl_FindHashEntry(tsdPtr->lineCLPtr, (char *) objPtr);
- if (hPtr) {
- return (ContLineLoc*) Tcl_GetHashValue (hPtr);
- } else {
- return NULL;
+ if (!hPtr) {
+ return NULL;
}
+ return Tcl_GetHashValue(hPtr);
}
/*
@@ -792,7 +794,8 @@ TclContinuationsGet(Tcl_Obj* objPtr)
*/
static void
-TclThreadFinalizeContLines (ClientData clientData)
+TclThreadFinalizeContLines(
+ ClientData clientData)
{
/*
* Release the hashtable tracking invisible continuation lines.
@@ -803,18 +806,18 @@ TclThreadFinalizeContLines (ClientData clientData)
Tcl_HashSearch hSearch;
for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
- hPtr != NULL;
- hPtr = Tcl_NextHashEntry(&hSearch)) {
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
/*
* We are not using Tcl_EventuallyFree (as in TclFreeObj()) because
* here we can be sure that the compiler will not hold references to
* the data in the hashtable, and using TEF might bork the
* finalization sequence.
*/
- ContLineLocFree (Tcl_GetHashValue (hPtr));
- Tcl_DeleteHashEntry (hPtr);
+
+ ContLineLocFree(Tcl_GetHashValue(hPtr));
+ Tcl_DeleteHashEntry(hPtr);
}
- Tcl_DeleteHashTable (tsdPtr->lineCLPtr);
+ Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
ckfree((char *) tsdPtr->lineCLPtr);
tsdPtr->lineCLPtr = NULL;
}
@@ -837,9 +840,10 @@ TclThreadFinalizeContLines (ClientData clientData)
*/
static void
-ContLineLocFree (char* clientData)
+ContLineLocFree(
+ char *clientData)
{
- ckfree (clientData);
+ ckfree(clientData);
}
/*
@@ -1331,9 +1335,11 @@ TclFreeObj(
Tcl_Panic("Reference count for %lx was negative", objPtr);
}
- /* Invalidate the string rep first so we can use the bytes value
- * for our pointer chain, and signal an obj deletion (as opposed
- * to shimmering) with 'length == -1' */
+ /*
+ * Invalidate the string rep first so we can use the bytes value for our
+ * pointer chain, and signal an obj deletion (as opposed to shimmering)
+ * with 'length == -1'.
+ */
TclInvalidateStringRep(objPtr);
objPtr->length = -1;
@@ -1356,7 +1362,7 @@ TclFreeObj(
while (ObjOnStack(context)) {
Tcl_Obj *objToFree;
- PopObjToDelete(context,objToFree);
+ PopObjToDelete(context, objToFree);
TCL_DTRACE_OBJ_FREE(objToFree);
TclFreeIntRep(objToFree);
@@ -1370,22 +1376,23 @@ TclFreeObj(
/*
* We cannot use TclGetContinuationTable() here, because that may
- * re-initialize the thread-data for calls coming after the
- * finalization. We have to access it using the low-level call and then
- * check for validity. This function can be called after
- * TclFinalizeThreadData() has already killed the thread-global data
- * structures. Performing TCL_TSD_INIT will leave us with an
- * un-initialized memory block upon which we crash (if we where to access
- * the uninitialized hashtable).
+ * re-initialize the thread-data for calls coming after the finalization.
+ * We have to access it using the low-level call and then check for
+ * validity. This function can be called after TclFinalizeThreadData() has
+ * already killed the thread-global data structures. Performing
+ * TCL_TSD_INIT will leave us with an un-initialized memory block upon
+ * which we crash (if we where to access the uninitialized hashtable).
*/
{
- ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_HashEntry *hPtr;
+
if (tsdPtr->lineCLPtr) {
- Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
+ hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, (char *) objPtr);
if (hPtr) {
- Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
- Tcl_DeleteHashEntry (hPtr);
+ Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
+ Tcl_DeleteHashEntry(hPtr);
}
}
}
@@ -1396,9 +1403,11 @@ void
TclFreeObj(
register Tcl_Obj *objPtr) /* The object to be freed. */
{
- /* Invalidate the string rep first so we can use the bytes value
- * for our pointer chain, and signal an obj deletion (as opposed
- * to shimmering) with 'length == -1' */
+ /*
+ * Invalidate the string rep first so we can use the bytes value for our
+ * pointer chain, and signal an obj deletion (as opposed to shimmering)
+ * with 'length == -1'.
+ */
TclInvalidateStringRep(objPtr);
objPtr->length = -1;
@@ -1442,7 +1451,8 @@ TclFreeObj(
ObjDeletionLock(context);
while (ObjOnStack(context)) {
Tcl_Obj *objToFree;
- PopObjToDelete(context,objToFree);
+
+ PopObjToDelete(context, objToFree);
TCL_DTRACE_OBJ_FREE(objToFree);
if ((objToFree->typePtr != NULL)
&& (objToFree->typePtr->freeIntRepProc != NULL)) {
@@ -1457,22 +1467,23 @@ TclFreeObj(
/*
* We cannot use TclGetContinuationTable() here, because that may
- * re-initialize the thread-data for calls coming after the
- * finalization. We have to access it using the low-level call and then
- * check for validity. This function can be called after
- * TclFinalizeThreadData() has already killed the thread-global data
- * structures. Performing TCL_TSD_INIT will leave us with an
- * un-initialized memory block upon which we crash (if we where to access
- * the uninitialized hashtable).
+ * re-initialize the thread-data for calls coming after the finalization.
+ * We have to access it using the low-level call and then check for
+ * validity. This function can be called after TclFinalizeThreadData() has
+ * already killed the thread-global data structures. Performing
+ * TCL_TSD_INIT will leave us with an un-initialized memory block upon
+ * which we crash (if we where to access the uninitialized hashtable).
*/
{
- ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_HashEntry *hPtr;
+
if (tsdPtr->lineCLPtr) {
- Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
+ hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, (char *) objPtr);
if (hPtr) {
- Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
- Tcl_DeleteHashEntry (hPtr);
+ Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
+ Tcl_DeleteHashEntry(hPtr);
}
}
}
@@ -1620,6 +1631,7 @@ Tcl_GetString(
* must be written in such a way that (objPtr->bytes) never becomes
* NULL. This panic was added in Tcl 8.1.
*/
+
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
objPtr->typePtr->name);
}
@@ -1983,7 +1995,10 @@ ParseBoolean(
const char *str = TclGetStringFromObj(objPtr, &length);
if ((length == 0) || (length > 5)) {
- /* longest valid boolean string rep. is "false" */
+ /*
+ * Longest valid boolean string rep. is "false".
+ */
+
return TCL_ERROR;
}
@@ -2009,6 +2024,7 @@ ParseBoolean(
for (i=0; i < length; i++) {
char c = str[i];
+
switch (c) {
case 'A': case 'E': case 'F': case 'L': case 'N':
case 'O': case 'R': case 'S': case 'T': case 'U': case 'Y':
@@ -2504,6 +2520,7 @@ SetIntFromAny(
Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
long l;
+
return TclGetLongFromObj(interp, objPtr, &l);
}
@@ -2737,6 +2754,7 @@ Tcl_GetLongFromObj(
*/
Tcl_WideInt w = objPtr->internalRep.wideValue;
+
if (w >= -(Tcl_WideInt)(ULONG_MAX)
&& w <= (Tcl_WideInt)(ULONG_MAX)) {
*longPtr = Tcl_WideAsLong(w);
@@ -2772,7 +2790,8 @@ Tcl_GetLongFromObj(
/ DIGIT_BIT) {
unsigned long value = 0, numBytes = sizeof(long);
long scratch;
- unsigned char *bytes = (unsigned char *)&scratch;
+ unsigned char *bytes = (unsigned char *) &scratch;
+
if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
@@ -3357,6 +3376,7 @@ GetBignumFromObj(
if (objPtr->typePtr == &tclBignumType) {
if (copy || Tcl_IsShared(objPtr)) {
mp_int temp;
+
UNPACK_BIGNUM(objPtr, temp);
mp_init_copy(bignumValue, &temp);
} else {
@@ -3579,7 +3599,8 @@ TclSetBignumIntRep(
*----------------------------------------------------------------------
*/
-int TclGetNumberFromObj(
+int
+TclGetNumberFromObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr,
ClientData *clientDataPtr,
@@ -3926,7 +3947,7 @@ TclCompareObjKeys(
void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
- Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
+ Tcl_Obj *objPtr1 = keyPtr;
Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
register const char *p1, *p2;
register int l1, l2;
@@ -4074,9 +4095,6 @@ Tcl_GetCommandFromObj(
* global namespace. */
{
register ResolvedCmdName *resPtr;
- register Command *cmdPtr;
- Namespace *refNsPtr;
- int result;
/*
* Get the internal representation, converting to a command type if
@@ -4098,30 +4116,35 @@ Tcl_GetCommandFromObj(
*/
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if ((objPtr->typePtr != &tclCmdNameType)
- || (resPtr == NULL)
- || (cmdPtr = resPtr->cmdPtr, cmdPtr->cmdEpoch != resPtr->cmdEpoch)
- || (interp != cmdPtr->nsPtr->interp)
- || (cmdPtr->flags & CMD_IS_DELETED)
- || (cmdPtr->nsPtr->flags & NS_DYING)
- || ((resPtr->refNsPtr != NULL) &&
- (((refNsPtr = (Namespace *) TclGetCurrentNamespace(interp))
- != resPtr->refNsPtr)
- || (resPtr->refNsId != refNsPtr->nsId)
- || (resPtr->refNsCmdEpoch != refNsPtr->cmdRefEpoch)))
- ) {
-
- result = tclCmdNameType.setFromAnyProc(interp, objPtr);
-
- resPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if ((result == TCL_OK) && resPtr) {
- cmdPtr = resPtr->cmdPtr;
- } else {
- cmdPtr = NULL;
- }
+ if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
+ register Command *cmdPtr = resPtr->cmdPtr;
+
+ if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
+ && (interp == cmdPtr->nsPtr->interp)
+ && !(cmdPtr->flags & CMD_IS_DELETED)
+ && !(cmdPtr->nsPtr->flags & NS_DYING)) {
+ register Namespace *refNsPtr = (Namespace *)
+ TclGetCurrentNamespace(interp);
+
+ if ((resPtr->refNsPtr == NULL)
+ || ((refNsPtr == resPtr->refNsPtr)
+ && (resPtr->refNsId == refNsPtr->nsId)
+ && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {
+ return (Tcl_Command) cmdPtr;
+ }
+ }
}
- return (Tcl_Command) cmdPtr;
+ /*
+ * OK, must create a new internal representation (or fail) as any cache we
+ * had is invalid one way or another.
+ */
+
+ if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
+ return NULL;
+ }
+ resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
}
/*
@@ -4389,7 +4412,7 @@ SetCmdNameFromAny(
* Implementation of the "tcl::unsupported::representation" command.
*
* Results:
- * Reports the current representation (Tcl_Obj type) of its argument.
+ * Reports the current representation (Tcl_Obj type) of its argument.
*
* Side effects:
* None.
@@ -4414,11 +4437,11 @@ Tcl_RepresentationCmd(
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
}
-
+
/*
- * value is a bignum with a refcount of 14, object pointer at
- * 0x12345678, internal representation 0x45671234:0x98765432,
- * string representation "1872361827361287"
+ * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
+ * internal representation 0x45671234:0x98765432, string representation
+ * "1872361827361287"
*/
sprintf(refcountBuffer, "%d", objv[1]->refCount);