summaryrefslogtreecommitdiffstats
path: root/generic/tclObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r--generic/tclObj.c295
1 files changed, 138 insertions, 157 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 4742f9d..930e1fd 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -79,7 +79,7 @@ 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
+ * TclSubstTokens() 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.
@@ -97,7 +97,6 @@ typedef struct ThreadSpecificData {
static Tcl_ThreadDataKey dataKey;
-static void ContLineLocFree(char *clientData);
static void TclThreadFinalizeContLines(ClientData clientData);
static ThreadSpecificData *TclGetContLineTable(void);
@@ -162,6 +161,10 @@ typedef struct PendingObjData {
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
PendingObjData *const contextPtr = &pendingObjData
+#elif HAVE_FAST_TSD
+static __thread PendingObjData pendingObjData;
+#define ObjInitDeletionContext(contextPtr) \
+ PendingObjData *const contextPtr = &pendingObjData
#else
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
@@ -204,12 +207,11 @@ static Tcl_ThreadDataKey pendingObjDataKey;
*/
static int ParseBoolean(Tcl_Obj *objPtr);
-static int SetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfDouble(Tcl_Obj *objPtr);
static void UpdateStringOfInt(Tcl_Obj *objPtr);
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
static void UpdateStringOfWideInt(Tcl_Obj *objPtr);
static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
#endif
@@ -246,14 +248,14 @@ static const Tcl_ObjType oldBooleanType = {
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
- SetBooleanFromAny /* setFromAnyProc */
+ TclSetBooleanFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclBooleanType = {
"booleanString", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
NULL, /* updateStringProc */
- SetBooleanFromAny /* setFromAnyProc */
+ TclSetBooleanFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclDoubleType = {
"double", /* name */
@@ -269,7 +271,7 @@ const Tcl_ObjType tclIntType = {
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
const Tcl_ObjType tclWideIntType = {
"wideInt", /* name */
NULL, /* freeIntRepProc */
@@ -407,7 +409,7 @@ TclInitObjSubsystem(void)
/* For backward compatibility only ... */
Tcl_RegisterObjType(&oldBooleanType);
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
Tcl_RegisterObjType(&tclWideIntType);
#endif
@@ -458,12 +460,12 @@ TclFinalizeThreadObjects(void)
ObjData *objData = Tcl_GetHashValue(hPtr);
if (objData != NULL) {
- ckfree((char *) objData);
+ ckfree(objData);
}
}
Tcl_DeleteHashTable(tablePtr);
- ckfree((char *) tablePtr);
+ ckfree(tablePtr);
tsdPtr->objThreadMap = NULL;
}
#endif
@@ -539,7 +541,7 @@ TclGetContLineTable(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->lineCLPtr) {
- tsdPtr->lineCLPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
}
@@ -574,8 +576,7 @@ TclContinuationsEnter(
ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr =
Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
- ContLineLoc *clLocPtr = (ContLineLoc *)
- ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
+ ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
if (!newEntry) {
/*
@@ -803,46 +804,15 @@ TclThreadFinalizeContLines(
for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &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));
+ ckfree(Tcl_GetHashValue(hPtr));
Tcl_DeleteHashEntry(hPtr);
}
Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
- ckfree((char *) tsdPtr->lineCLPtr);
+ ckfree(tsdPtr->lineCLPtr);
tsdPtr->lineCLPtr = NULL;
}
/*
- *----------------------------------------------------------------------
- *
- * ContLineLocFree --
- *
- * The freProc for continuation line location tables.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Releases memory.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-static void
-ContLineLocFree(
- char *clientData)
-{
- ckfree(clientData);
-}
-
-/*
*--------------------------------------------------------------
*
* Tcl_RegisterObjType --
@@ -1003,7 +973,12 @@ Tcl_ConvertToType(
*/
if (typePtr->setFromAnyProc == NULL) {
- Tcl_Panic("may not convert object to type %s", typePtr->name);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't convert value to type %s", typePtr->name));
+ Tcl_SetErrorCode(interp, "TCL", "API_ABUSE", NULL);
+ }
+ return TCL_ERROR;
}
return typePtr->setFromAnyProc(interp, objPtr);
@@ -1104,8 +1079,7 @@ TclDbInitNewObj(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->objThreadMap == NULL) {
- tsdPtr->objThreadMap = (Tcl_HashTable *)
- ckalloc(sizeof(Tcl_HashTable));
+ tsdPtr->objThreadMap = ckalloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
}
tablePtr = tsdPtr->objThreadMap;
@@ -1118,7 +1092,7 @@ TclDbInitNewObj(
* Record the debugging information.
*/
- objData = (ObjData *) ckalloc(sizeof(ObjData));
+ objData = ckalloc(sizeof(ObjData));
objData->objPtr = objPtr;
objData->file = file;
objData->line = line;
@@ -1253,7 +1227,7 @@ Tcl_DbNewObj(
* Side effects:
* tclFreeObjList, the head of the list of free Tcl_Objs, is set to the
* first of a number of free Tcl_Obj's linked together by their
- * internalRep.otherValuePtrs.
+ * internalRep.twoPtrValue.ptr1's.
*
*----------------------------------------------------------------------
*/
@@ -1277,12 +1251,12 @@ TclAllocateFreeObjects(void)
* Purify apparently can't figure that out, and fires a false alarm.
*/
- basePtr = (char *) ckalloc(bytesToAlloc);
+ basePtr = ckalloc(bytesToAlloc);
prevPtr = NULL;
objPtr = (Tcl_Obj *) basePtr;
for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
- objPtr->internalRep.otherValuePtr = prevPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
prevPtr = objPtr;
objPtr++;
}
@@ -1327,9 +1301,21 @@ TclFreeObj(
ObjInitDeletionContext(context);
+ /*
+ * Check for a double free of the same value. This is slightly tricky
+ * because it is customary to free a Tcl_Obj when its refcount falls
+ * either from 1 to 0, or from 0 to -1. Falling from -1 to -2, though,
+ * and so on, is always a sign of a botch in the caller.
+ */
if (objPtr->refCount < -1) {
- Tcl_Panic("Reference count for %lx was negative", objPtr);
+ Tcl_Panic("Reference count for %p was negative", objPtr);
}
+ /*
+ * Now, in case we just approved drop from 1 to 0 as acceptable, make
+ * sure we do not accept a second free when falling from 0 to -1.
+ * Skip that possibility so any double free will trigger the panic.
+ */
+ objPtr->refCount = -1;
/*
* Invalidate the string rep first so we can use the bytes value for our
@@ -1351,7 +1337,7 @@ TclFreeObj(
}
Tcl_MutexLock(&tclObjMutex);
- ckfree((char *) objPtr);
+ ckfree(objPtr);
Tcl_MutexUnlock(&tclObjMutex);
TclIncrObjsFreed();
ObjDeletionLock(context);
@@ -1363,7 +1349,7 @@ TclFreeObj(
TclFreeIntRep(objToFree);
Tcl_MutexLock(&tclObjMutex);
- ckfree((char *) objToFree);
+ ckfree(objToFree);
Tcl_MutexUnlock(&tclObjMutex);
TclIncrObjsFreed();
}
@@ -1387,7 +1373,7 @@ TclFreeObj(
if (tsdPtr->lineCLPtr) {
hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
if (hPtr) {
- Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
+ ckfree(Tcl_GetHashValue(hPtr));
Tcl_DeleteHashEntry(hPtr);
}
}
@@ -1478,7 +1464,7 @@ TclFreeObj(
if (tsdPtr->lineCLPtr) {
hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
if (hPtr) {
- Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
+ ckfree(Tcl_GetHashValue(hPtr));
Tcl_DeleteHashEntry(hPtr);
}
}
@@ -1727,8 +1713,8 @@ Tcl_InvalidateStringRep(
*----------------------------------------------------------------------
*/
-#ifdef TCL_MEM_DEBUG
#undef Tcl_NewBooleanObj
+#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewBooleanObj(
@@ -1776,6 +1762,7 @@ Tcl_NewBooleanObj(
*----------------------------------------------------------------------
*/
+#undef Tcl_DbNewBooleanObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
@@ -1828,6 +1815,7 @@ Tcl_DbNewBooleanObj(
*----------------------------------------------------------------------
*/
+#undef Tcl_SetBooleanObj
void
Tcl_SetBooleanObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
@@ -1895,7 +1883,7 @@ Tcl_GetBooleanFromObj(
*boolPtr = 1;
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
@@ -1909,7 +1897,7 @@ Tcl_GetBooleanFromObj(
/*
*----------------------------------------------------------------------
*
- * SetBooleanFromAny --
+ * TclSetBooleanFromAny --
*
* Attempt to generate a boolean internal form for the Tcl object
* "objPtr".
@@ -1926,8 +1914,8 @@ Tcl_GetBooleanFromObj(
*----------------------------------------------------------------------
*/
-static int
-SetBooleanFromAny(
+int
+TclSetBooleanFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
@@ -1950,7 +1938,7 @@ SetBooleanFromAny(
goto badBoolean;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
goto badBoolean;
}
@@ -2263,6 +2251,8 @@ Tcl_GetDoubleFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"floating point value is Not a Number", -1));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
+ NULL);
}
return TCL_ERROR;
}
@@ -2280,7 +2270,7 @@ Tcl_GetDoubleFromObj(
*dblPtr = TclBignumToDouble(&big);
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
@@ -2350,7 +2340,7 @@ UpdateStringOfDouble(
Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
len = strlen(buffer);
- objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
+ objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
@@ -2385,8 +2375,8 @@ UpdateStringOfDouble(
*----------------------------------------------------------------------
*/
-#ifdef TCL_MEM_DEBUG
#undef Tcl_NewIntObj
+#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewIntObj(
@@ -2426,6 +2416,7 @@ Tcl_NewIntObj(
*----------------------------------------------------------------------
*/
+#undef Tcl_SetIntObj
void
Tcl_SetIntObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
@@ -2546,7 +2537,7 @@ UpdateStringOfInt(
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
- objPtr->bytes = ckalloc((unsigned) len + 1);
+ objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
objPtr->length = len;
}
@@ -2737,7 +2728,7 @@ Tcl_GetLongFromObj(
*longPtr = objPtr->internalRep.longValue;
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
/*
* We return any integer in the range -ULONG_MAX to ULONG_MAX
@@ -2759,12 +2750,9 @@ Tcl_GetLongFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -2798,7 +2786,7 @@ Tcl_GetLongFromObj(
return TCL_OK;
}
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
tooLarge:
#endif
if (interp != NULL) {
@@ -2814,7 +2802,7 @@ Tcl_GetLongFromObj(
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
/*
*----------------------------------------------------------------------
@@ -2852,11 +2840,11 @@ UpdateStringOfWideInt(
sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
len = strlen(buffer);
- objPtr->bytes = ckalloc((unsigned) len + 1);
+ objPtr->bytes = ckalloc(len + 1);
memcpy(objPtr->bytes, buffer, len + 1);
objPtr->length = len;
}
-#endif /* !NO_WIDE_TYPE */
+#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
@@ -3011,7 +2999,7 @@ Tcl_SetWideIntObj(
&& (wideValue <= (Tcl_WideInt) LONG_MAX)) {
TclSetLongObj(objPtr, (long) wideValue);
} else {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
TclSetWideIntObj(objPtr, wideValue);
#else
mp_int big;
@@ -3051,7 +3039,7 @@ Tcl_GetWideIntFromObj(
/* Place to store resulting long. */
{
do {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
@@ -3063,12 +3051,9 @@ Tcl_GetWideIntFromObj(
}
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3114,7 +3099,7 @@ Tcl_GetWideIntFromObj(
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
/*
*----------------------------------------------------------------------
@@ -3140,7 +3125,7 @@ SetWideIntFromAny(
Tcl_WideInt w;
return Tcl_GetWideIntFromObj(interp, objPtr, &w);
}
-#endif /* !NO_WIDE_TYPE */
+#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
@@ -3164,7 +3149,7 @@ FreeBignum(
UNPACK_BIGNUM(objPtr, toFree);
mp_clear(&toFree);
if ((long) objPtr->internalRep.ptrAndLongRep.value < 0) {
- ckfree((char *) objPtr->internalRep.ptrAndLongRep.ptr);
+ ckfree(objPtr->internalRep.ptrAndLongRep.ptr);
}
objPtr->typePtr = NULL;
}
@@ -3249,7 +3234,7 @@ UpdateStringOfBignum(
Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
}
- stringVal = ckalloc((size_t) size);
+ stringVal = ckalloc(size);
status = mp_toradix_n(&bignumVal, stringVal, 10, size);
if (status != MP_OKAY) {
Tcl_Panic("conversion failure in UpdateStringOfBignum");
@@ -3388,7 +3373,7 @@ GetBignumFromObj(
TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
TclBNInitBignumFromWideInt(bignumValue,
objPtr->internalRep.wideValue);
@@ -3397,12 +3382,9 @@ GetBignumFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3530,7 +3512,7 @@ Tcl_SetBignumObj(
return;
}
tooLargeForLong:
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if ((size_t) bignumValue->used
<= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
Tcl_WideUInt value = 0;
@@ -3642,7 +3624,7 @@ TclGetNumberFromObj(
*clientDataPtr = &objPtr->internalRep.longValue;
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*typePtr = TCL_NUMBER_WIDE;
*clientDataPtr = &objPtr->internalRep.wideValue;
@@ -3709,23 +3691,21 @@ Tcl_DbIncrRefCount(
*/
if (!TclInExit()) {
- Tcl_HashTable *tablePtr;
- Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+ Tcl_HashEntry *hPtr;
- tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
Tcl_Panic("object table not initialized");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
- Tcl_Panic("%s%s",
- "Trying to incr ref count of "
- "Tcl_Obj allocated in another thread");
+ Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
+ "incr ref count");
}
}
-# endif
-#endif
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
++(objPtr)->refCount;
}
@@ -3774,19 +3754,17 @@ Tcl_DbDecrRefCount(
*/
if (!TclInExit()) {
- Tcl_HashTable *tablePtr;
- Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+ Tcl_HashEntry *hPtr;
- tablePtr = tsdPtr->objThreadMap;
if (!tablePtr) {
Tcl_Panic("object table not initialized");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
- Tcl_Panic("%s%s",
- "Trying to decr ref count of "
- "Tcl_Obj allocated in another thread");
+ Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
+ "decr ref count");
}
/*
@@ -3797,14 +3775,15 @@ Tcl_DbDecrRefCount(
ObjData *objData = Tcl_GetHashValue(hPtr);
if (objData != NULL) {
- ckfree((char *) objData);
+ ckfree(objData);
}
Tcl_DeleteHashEntry(hPtr);
}
}
-# endif
-#endif
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
+
if (--(objPtr)->refCount <= 0) {
TclFreeObj(objPtr);
}
@@ -3854,22 +3833,21 @@ Tcl_DbIsShared(
*/
if (!TclInExit()) {
- Tcl_HashTable *tablePtr;
- Tcl_HashEntry *hPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- tablePtr = tsdPtr->objThreadMap;
+ Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
+ Tcl_HashEntry *hPtr;
+
if (!tablePtr) {
Tcl_Panic("object table not initialized");
}
hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
if (!hPtr) {
- Tcl_Panic("%s%s",
- "Trying to check shared status of"
- "Tcl_Obj allocated in another thread");
+ Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
+ "check shared status");
}
}
-# endif
-#endif
+# endif /* TCL_THREADS */
+#endif /* TCL_MEM_DEBUG */
#ifdef TCL_COMPILE_STATS
Tcl_MutexLock(&tclObjMutex);
@@ -3881,7 +3859,7 @@ Tcl_DbIsShared(
tclObjsShared[0]++;
}
Tcl_MutexUnlock(&tclObjMutex);
-#endif
+#endif /* TCL_COMPILE_STATS */
return ((objPtr)->refCount > 1);
}
@@ -3935,11 +3913,10 @@ AllocObjEntry(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key to store in the hash table entry. */
{
- Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
- Tcl_HashEntry *hPtr;
+ Tcl_Obj *objPtr = keyPtr;
+ Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));
- hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
- hPtr->key.oneWordValue = (char *) objPtr;
+ hPtr->key.objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
hPtr->clientData = NULL;
@@ -4032,7 +4009,7 @@ TclFreeObjEntry(
Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
Tcl_DecrRefCount(objPtr);
- ckfree((char *) hPtr);
+ ckfree(hPtr);
}
/*
@@ -4181,7 +4158,7 @@ Tcl_GetCommandFromObj(
* had is invalid one way or another.
*/
- if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
+ if (SetCmdNameFromAny(interp, objPtr) != TCL_OK) {
return NULL;
}
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
@@ -4227,7 +4204,7 @@ TclSetCmdNameObj(
}
cmdPtr->refCount++;
- resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+ resPtr = ckalloc(sizeof(ResolvedCmdName));
resPtr->cmdPtr = cmdPtr;
resPtr->cmdEpoch = cmdPtr->cmdEpoch;
resPtr->refCount = 1;
@@ -4303,7 +4280,7 @@ FreeCmdNameInternalRep(
Command *cmdPtr = resPtr->cmdPtr;
TclCleanupCommandMacro(cmdPtr);
- ckfree((char *) resPtr);
+ ckfree(resPtr);
}
}
objPtr->typePtr = NULL;
@@ -4376,6 +4353,10 @@ SetCmdNameFromAny(
Namespace *currNsPtr;
register ResolvedCmdName *resPtr;
+ if (interp == NULL) {
+ return TCL_ERROR;
+ }
+
/*
* Find the Command structure, if any, that describes the command called
* "name". Build a ResolvedCmdName that holds a cached pointer to this
@@ -4396,7 +4377,7 @@ SetCmdNameFromAny(
if (cmdPtr) {
cmdPtr->refCount++;
- resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr;
+ resPtr = objPtr->internalRep.twoPtrValue.ptr1;
if ((objPtr->typePtr == &tclCmdNameType)
&& resPtr && (resPtr->refCount == 1)) {
/*
@@ -4410,7 +4391,7 @@ SetCmdNameFromAny(
}
} else {
TclFreeIntRep(objPtr);
- resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
+ resPtr = ckalloc(sizeof(ResolvedCmdName));
resPtr->refCount = 1;
objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
@@ -4468,11 +4449,8 @@ Tcl_RepresentationCmd(
int objc,
Tcl_Obj *const objv[])
{
- char refcountBuffer[TCL_INTEGER_SPACE+1];
- char objPtrBuffer[TCL_INTEGER_SPACE+3];
- char internalRepBuffer[2*(TCL_INTEGER_SPACE+2)+2];
-#define TCLOBJ_TRUNCATE_STRINGREP 16
- char stringRepBuffer[TCLOBJ_TRUNCATE_STRINGREP+1];
+ char ptrBuffer[2*TCL_INTEGER_SPACE+6];
+ Tcl_Obj *descObj;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
@@ -4485,27 +4463,30 @@ Tcl_RepresentationCmd(
* "1872361827361287"
*/
- sprintf(refcountBuffer, "%d", objv[1]->refCount);
- sprintf(objPtrBuffer, "%p", (void *)objv[1]);
- Tcl_AppendResult(interp, "value is a ", objv[1]->typePtr ?
- objv[1]->typePtr->name : "pure string", " with a refcount of ",
- refcountBuffer, ", object pointer at ", objPtrBuffer, NULL);
+ sprintf(ptrBuffer, "%p", (void *) objv[1]);
+ descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
+ " object pointer at %s",
+ objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
+ objv[1]->refCount, ptrBuffer);
+
if (objv[1]->typePtr) {
- sprintf(internalRepBuffer, "%p:%p",
- (void *)objv[1]->internalRep.twoPtrValue.ptr1,
- (void *)objv[1]->internalRep.twoPtrValue.ptr2);
- Tcl_AppendResult(interp, ", internal representation ",
- internalRepBuffer, NULL);
+ sprintf(ptrBuffer, "%p:%p",
+ (void *) objv[1]->internalRep.twoPtrValue.ptr1,
+ (void *) objv[1]->internalRep.twoPtrValue.ptr2);
+ Tcl_AppendPrintfToObj(descObj, ", internal representation %s",
+ ptrBuffer);
}
+
if (objv[1]->bytes) {
- strncpy(stringRepBuffer, objv[1]->bytes, TCLOBJ_TRUNCATE_STRINGREP);
- stringRepBuffer[TCLOBJ_TRUNCATE_STRINGREP] = 0;
- Tcl_AppendResult(interp, ", string representation \"",
- stringRepBuffer, objv[1]->length > TCLOBJ_TRUNCATE_STRINGREP ?
- "\"..." : "\".", NULL);
+ Tcl_AppendToObj(descObj, ", string representation \"", -1);
+ Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
+ 16, "...");
+ Tcl_AppendToObj(descObj, "\"", -1);
} else {
- Tcl_AppendResult(interp, ", no string representation.", NULL);
+ Tcl_AppendToObj(descObj, ", no string representation", -1);
}
+
+ Tcl_SetObjResult(interp, descObj);
return TCL_OK;
}
generated by cgit v0.12 at 2025-10-23 09:48:43 (GMT)