diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2009-12-29 16:54:44 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2009-12-29 16:54:44 (GMT) |
commit | 9f8ac71040a91b045d4d51b21a7539e889e53638 (patch) | |
tree | 8f00f66bfe4b4849da6385febca66a72e3d82cfb /generic/tclObj.c | |
parent | f529e237b5116ef60425a6cd231f88167ff6bf05 (diff) | |
download | tcl-9f8ac71040a91b045d4d51b21a7539e889e53638.zip tcl-9f8ac71040a91b045d4d51b21a7539e889e53638.tar.gz tcl-9f8ac71040a91b045d4d51b21a7539e889e53638.tar.bz2 |
Simplify the logic in Tcl_GetCommandFromObj
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r-- | generic/tclObj.c | 393 |
1 files changed, 208 insertions, 185 deletions
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); |