summaryrefslogtreecommitdiffstats
path: root/generic/tclObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r--generic/tclObj.c89
1 files changed, 45 insertions, 44 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c
index d3f59ec..f4b81f2 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -49,7 +49,6 @@ Tcl_Mutex tclObjMutex;
*/
char tclEmptyString = '\0';
-char *tclEmptyStringRep = &tclEmptyString;
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
/*
@@ -76,7 +75,7 @@ typedef struct ObjData {
* The structure defined below is used in this file only.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj
* generated by a call to the function
* TclSubstTokens() from a literal text
@@ -345,23 +344,23 @@ typedef struct ResolvedCmdName {
* reference (not the namespace that contains
* the referenced command). NULL if the name
* is fully qualified.*/
- long refNsId; /* refNsPtr's unique namespace id. Used to
+ size_t refNsId; /* refNsPtr's unique namespace id. Used to
* verify that refNsPtr is still valid (e.g.,
* it's possible that the cmd's containing
* namespace was deleted and a new one created
* at the same address). */
- int refNsCmdEpoch; /* Value of the referencing namespace's
+ size_t refNsCmdEpoch; /* Value of the referencing namespace's
* cmdRefEpoch when the pointer was cached.
* Before using the cached pointer, we check
* if the namespace's epoch was incremented;
* if so, this cached pointer is invalid. */
- int cmdEpoch; /* Value of the command's cmdEpoch when this
+ size_t cmdEpoch; /* Value of the command's cmdEpoch when this
* pointer was cached. Before using the cached
* pointer, we check if the cmd's epoch was
* incremented; if so, the cmd was renamed,
* deleted, hidden, or exposed, and so the
* pointer is invalid. */
- int refCount; /* Reference count: 1 for each cmdName object
+ size_t refCount; /* Reference count: 1 for each cmdName object
* that has a pointer to this ResolvedCmdName
* structure as its internal rep. This
* structure can be freed when refCount
@@ -1060,7 +1059,7 @@ TclDbInitNewObj(
* debugging. */
{
objPtr->refCount = 0;
- objPtr->bytes = tclEmptyStringRep;
+ objPtr->bytes = &tclEmptyString;
objPtr->length = 0;
objPtr->typePtr = NULL;
@@ -1733,7 +1732,7 @@ Tcl_InvalidateStringRep(
* is coerced to 1.
*
* When TCL_MEM_DEBUG is defined, this function just returns the result
- * of calling the debugging version Tcl_DbNewBooleanObj.
+ * of calling the debugging version Tcl_DbNewLongObj.
*
* Results:
* The newly created object is returned. This object will have an invalid
@@ -1752,7 +1751,7 @@ Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
{
- return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
+ return Tcl_DbNewLongObj(boolValue!=0, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
@@ -1763,7 +1762,7 @@ Tcl_NewBooleanObj(
{
register Tcl_Obj *objPtr;
- TclNewBooleanObj(objPtr, boolValue);
+ TclNewLongObj(objPtr, boolValue!=0);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
@@ -1794,6 +1793,7 @@ Tcl_NewBooleanObj(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_DbNewBooleanObj
#ifdef TCL_MEM_DEBUG
@@ -1810,7 +1810,7 @@ Tcl_DbNewBooleanObj(
TclDbNewObj(objPtr, file, line);
objPtr->bytes = NULL;
- objPtr->internalRep.longValue = (boolValue? 1 : 0);
+ objPtr->internalRep.longValue = (boolValue != 0);
objPtr->typePtr = &tclIntType;
return objPtr;
}
@@ -1857,8 +1857,9 @@ Tcl_SetBooleanObj(
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
}
- TclSetBooleanObj(objPtr, boolValue);
+ TclSetLongObj(objPtr, boolValue!=0);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -2004,9 +2005,10 @@ static int
ParseBoolean(
register Tcl_Obj *objPtr) /* The object to parse/convert. */
{
- int i, length, newBool;
+ int newBool;
char lowerCase[6];
- const char *str = TclGetStringFromObj(objPtr, &length);
+ const char *str = TclGetString(objPtr);
+ size_t i, length = objPtr->length;
if ((length == 0) || (length > 5)) {
/*
@@ -2058,25 +2060,25 @@ ParseBoolean(
/*
* Checking the 'y' is redundant, but makes the code clearer.
*/
- if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "yes", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'n':
- if (strncmp(lowerCase, "no", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "no", length) == 0) {
newBool = 0;
goto goodBoolean;
}
return TCL_ERROR;
case 't':
- if (strncmp(lowerCase, "true", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "true", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'f':
- if (strncmp(lowerCase, "false", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "false", length) == 0) {
newBool = 0;
goto goodBoolean;
}
@@ -2085,10 +2087,10 @@ ParseBoolean(
if (length < 2) {
return TCL_ERROR;
}
- if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "on", length) == 0) {
newBool = 1;
goto goodBoolean;
- } else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+ } else if (strncmp(lowerCase, "off", length) == 0) {
newBool = 0;
goto goodBoolean;
}
@@ -2425,7 +2427,7 @@ Tcl_NewIntObj(
{
register Tcl_Obj *objPtr;
- TclNewIntObj(objPtr, intValue);
+ TclNewLongObj(objPtr, intValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -2458,7 +2460,7 @@ Tcl_SetIntObj(
Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
}
- TclSetIntObj(objPtr, intValue);
+ TclSetLongObj(objPtr, intValue);
}
/*
@@ -2784,7 +2786,7 @@ Tcl_GetLongFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
- Tcl_GetString(objPtr)));
+ TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3085,7 +3087,7 @@ Tcl_GetWideIntFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
- Tcl_GetString(objPtr)));
+ TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3252,13 +3254,11 @@ UpdateStringOfBignum(
if (status != MP_OKAY) {
Tcl_Panic("radix size failure in UpdateStringOfBignum");
}
- if (size == 3) {
+ if (size < 2) {
/*
- * mp_radix_size() returns 3 when more than INT_MAX bytes would be
+ * mp_radix_size() returns < 2 when more than INT_MAX bytes would be
* needed to hold the string rep (because mp_radix_size ignores
- * integer overflow issues). When we know the string rep will be more
- * than 3, we can conclude the string rep would overflow our string
- * length limits.
+ * integer overflow issues).
*
* Note that so long as we enforce our bignums to the size that fits
* in a packed bignum, this branch will never be taken.
@@ -3396,7 +3396,7 @@ GetBignumFromObj(
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = NULL;
if (objPtr->bytes == NULL) {
- TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+ TclInitStringRep(objPtr, &tclEmptyString, 0);
}
}
return TCL_OK;
@@ -3416,7 +3416,7 @@ GetBignumFromObj(
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"expected integer but got \"%s\"",
- Tcl_GetString(objPtr)));
+ TclGetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3966,7 +3966,7 @@ TclCompareObjKeys(
Tcl_Obj *objPtr1 = keyPtr;
Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
register const char *p1, *p2;
- register int l1, l2;
+ register size_t l1, l2;
/*
* If the object pointers are the same then they match.
@@ -4309,7 +4309,7 @@ FreeCmdNameInternalRep(
* there are no more uses, free the ResolvedCmdName structure.
*/
- if (resPtr->refCount-- == 1) {
+ if (resPtr->refCount-- <= 1) {
/*
* Now free the cached command, unless it is still in its hash
* table or if there are other references to it from other cmdName
@@ -4421,7 +4421,7 @@ SetCmdNameFromAny(
Command *oldCmdPtr = resPtr->cmdPtr;
- if (--oldCmdPtr->refCount == 0) {
+ if (oldCmdPtr->refCount-- <= 1) {
TclCleanupCommandMacro(oldCmdPtr);
}
} else {
@@ -4455,7 +4455,6 @@ Tcl_RepresentationCmd(
int objc,
Tcl_Obj *const objv[])
{
- char ptrBuffer[2*TCL_INTEGER_SPACE+6];
Tcl_Obj *descObj;
if (objc != 2) {
@@ -4469,18 +4468,20 @@ Tcl_RepresentationCmd(
* "1872361827361287"
*/
- 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);
+ " object pointer at %p",
+ objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
+ objv[1]->refCount, objv[1]);
if (objv[1]->typePtr) {
- 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]->typePtr == &tclDoubleType) {
+ Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
+ objv[1]->internalRep.doubleValue);
+ } else {
+ Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p",
+ (void *) objv[1]->internalRep.twoPtrValue.ptr1,
+ (void *) objv[1]->internalRep.twoPtrValue.ptr2);
+ }
}
if (objv[1]->bytes) {
generated by cgit v0.12 at 2025-06-03 08:39:22 (GMT)