summaryrefslogtreecommitdiffstats
path: root/generic/tclObj.c
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-16 00:46:29 (GMT)
committerstanton <stanton>1999-04-16 00:46:29 (GMT)
commit97464e6cba8eb0008cf2727c15718671992b913f (patch)
treece9959f2747257d98d52ec8d18bf3b0de99b9535 /generic/tclObj.c
parenta8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff)
downloadtcl-97464e6cba8eb0008cf2727c15718671992b913f.zip
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r--generic/tclObj.c365
1 files changed, 155 insertions, 210 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c
index b053296..c4895ee 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -9,7 +9,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.4 1999/03/10 05:52:49 stanton Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.5 1999/04/16 00:46:50 stanton Exp $
*/
#include "tclInt.h"
@@ -21,24 +21,35 @@
static Tcl_HashTable typeTable;
static int typeTableInitialized = 0; /* 0 means not yet initialized. */
+TCL_DECLARE_MUTEX(tableMutex)
/*
- * Head of the list of free Tcl_Objs we maintain.
+ * Head of the list of free Tcl_Obj structs we maintain.
*/
Tcl_Obj *tclFreeObjList = NULL;
/*
+ * The object allocator is single threaded. This mutex is referenced
+ * by the TclNewObj macro, however, so must be visible.
+ */
+
+#ifdef TCL_THREADS
+Tcl_Mutex tclObjMutex;
+#endif
+
+/*
* Pointer to a heap-allocated string of length zero that the Tcl core uses
* as the value of an empty string representation for an object. This value
* is shared by all new objects allocated by Tcl_NewObj.
*/
-char *tclEmptyStringRep = NULL;
+static char emptyString;
+char *tclEmptyStringRep = &emptyString;
/*
- * Count of the number of Tcl objects every allocated (by Tcl_NewObj) and
- * freed (by TclFreeObj).
+ * The number of Tcl objects ever allocated (by Tcl_NewObj) and freed
+ * (by TclFreeObj).
*/
#ifdef TCL_COMPILE_STATS
@@ -50,15 +61,6 @@ long tclObjsFreed = 0;
* Prototypes for procedures defined later in this file:
*/
-static void DupBooleanInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void DupDoubleInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void DupIntInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
- Tcl_Obj *copyPtr));
-static void FinalizeTypeTable _ANSI_ARGS_((void));
-static void FinalizeFreeObjList _ANSI_ARGS_((void));
-static void InitTypeTable _ANSI_ARGS_((void));
static int SetBooleanFromAny _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *objPtr));
static int SetDoubleFromAny _ANSI_ARGS_((Tcl_Interp *interp,
@@ -79,7 +81,7 @@ static void UpdateStringOfInt _ANSI_ARGS_((Tcl_Obj *objPtr));
Tcl_ObjType tclBooleanType = {
"boolean", /* name */
(Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- DupBooleanInternalRep, /* dupIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
UpdateStringOfBoolean, /* updateStringProc */
SetBooleanFromAny /* setFromAnyProc */
};
@@ -87,7 +89,7 @@ Tcl_ObjType tclBooleanType = {
Tcl_ObjType tclDoubleType = {
"double", /* name */
(Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- DupDoubleInternalRep, /* dupIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
UpdateStringOfDouble, /* updateStringProc */
SetDoubleFromAny /* setFromAnyProc */
};
@@ -95,15 +97,15 @@ Tcl_ObjType tclDoubleType = {
Tcl_ObjType tclIntType = {
"int", /* name */
(Tcl_FreeInternalRepProc *) NULL, /* freeIntRepProc */
- DupIntInternalRep, /* dupIntRepProc */
+ (Tcl_DupInternalRepProc *) NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
/*
- *--------------------------------------------------------------
+ *-------------------------------------------------------------------------
*
- * InitTypeTable --
+ * TclInitObjectSubsystem --
*
* This procedure is invoked to perform once-only initialization of
* the type table. It also registers the object types defined in
@@ -114,20 +116,19 @@ Tcl_ObjType tclIntType = {
*
* Side effects:
* Initializes the table of defined object types "typeTable" with
- * builtin object types defined in this file. It also initializes the
- * value of tclEmptyStringRep, which points to the heap-allocated
- * string of length zero used as the string representation for
- * newly-created objects.
+ * builtin object types defined in this file.
*
- *--------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
-static void
-InitTypeTable()
+void
+TclInitObjSubsystem()
{
+ Tcl_MutexLock(&tableMutex);
typeTableInitialized = 1;
-
Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
+ Tcl_MutexUnlock(&tableMutex);
+
Tcl_RegisterObjType(&tclBooleanType);
Tcl_RegisterObjType(&tclByteArrayType);
Tcl_RegisterObjType(&tclDoubleType);
@@ -137,86 +138,47 @@ InitTypeTable()
Tcl_RegisterObjType(&tclByteCodeType);
Tcl_RegisterObjType(&tclProcBodyType);
- tclEmptyStringRep = (char *) ckalloc((unsigned) 1);
- tclEmptyStringRep[0] = '\0';
+#ifdef TCL_COMPILE_STATS
+ Tcl_MutexLock(&tclObjMutex);
+ tclObjsAlloced = 0;
+ tclObjsFreed = 0;
+ Tcl_MutexUnlock(&tclObjMutex);
+#endif
}
/*
*----------------------------------------------------------------------
*
- * FinalizeTypeTable --
+ * TclFinalizeCompExecEnv --
*
- * This procedure is called by Tcl_Finalize after all exit handlers
- * have been run to free up storage associated with the table of Tcl
- * object types.
+ * This procedure is called by Tcl_Finalize to clean up the Tcl
+ * compilation and execution environment so it can later be properly
+ * reinitialized.
*
* Results:
* None.
*
* Side effects:
- * Deletes all entries in the hash table of object types, "typeTable".
- * Then sets "typeTableInitialized" to 0 so that the Tcl type system
- * will be properly reinitialized if Tcl is restarted. Also deallocates
- * the storage for tclEmptyStringRep.
+ * Cleans up the compilation and execution environment
*
*----------------------------------------------------------------------
*/
-static void
-FinalizeTypeTable()
+void
+TclFinalizeCompExecEnv()
{
+ Tcl_MutexLock(&tableMutex);
if (typeTableInitialized) {
Tcl_DeleteHashTable(&typeTable);
- ckfree(tclEmptyStringRep);
typeTableInitialized = 0;
}
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FinalizeFreeObjList --
- *
- * Resets the free object list so it can later be reinitialized.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Resets the value of tclFreeObjList.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FinalizeFreeObjList()
-{
+ Tcl_MutexUnlock(&tableMutex);
+ Tcl_MutexLock(&tclObjMutex);
tclFreeObjList = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeCompExecEnv --
- *
- * Clean up the compiler execution environment so it can later be
- * properly reinitialized.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Cleans up the execution environment
- *
- *----------------------------------------------------------------------
- */
+ Tcl_MutexUnlock(&tclObjMutex);
-void
-TclFinalizeCompExecEnv()
-{
- FinalizeTypeTable();
- FinalizeFreeObjList();
- TclFinalizeExecEnv();
+ TclFinalizeCompilation();
+ TclFinalizeExecution();
}
/*
@@ -247,14 +209,10 @@ Tcl_RegisterObjType(typePtr)
register Tcl_HashEntry *hPtr;
int new;
- if (!typeTableInitialized) {
- InitTypeTable();
- }
-
/*
* If there's already an object type with the given name, remove it.
*/
-
+ Tcl_MutexLock(&tableMutex);
hPtr = Tcl_FindHashEntry(&typeTable, typePtr->name);
if (hPtr != (Tcl_HashEntry *) NULL) {
Tcl_DeleteHashEntry(hPtr);
@@ -268,6 +226,7 @@ Tcl_RegisterObjType(typePtr)
if (new) {
Tcl_SetHashValue(hPtr, typePtr);
}
+ Tcl_MutexUnlock(&tableMutex);
}
/*
@@ -278,7 +237,7 @@ Tcl_RegisterObjType(typePtr)
* This procedure appends onto the argument object the name of each
* object type as a list element. This includes the builtin object
* types (e.g. int, list) as well as those added using
- * Tcl_CreateObjType. These names can be used, for example, with
+ * Tcl_NewObj. These names can be used, for example, with
* Tcl_GetObjType to get pointers to the corresponding Tcl_ObjType
* structures.
*
@@ -307,23 +266,22 @@ Tcl_AppendAllObjTypes(interp, objPtr)
Tcl_ObjType *typePtr;
int result;
- if (!typeTableInitialized) {
- InitTypeTable();
- }
-
/*
* This code assumes that types names do not contain embedded NULLs.
*/
+ Tcl_MutexLock(&tableMutex);
for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
result = Tcl_ListObjAppendElement(interp, objPtr,
Tcl_NewStringObj(typePtr->name, -1));
if (result == TCL_ERROR) {
+ Tcl_MutexUnlock(&tableMutex);
return result;
}
}
+ Tcl_MutexUnlock(&tableMutex);
return TCL_OK;
}
@@ -352,15 +310,14 @@ Tcl_GetObjType(typeName)
register Tcl_HashEntry *hPtr;
Tcl_ObjType *typePtr;
- if (!typeTableInitialized) {
- InitTypeTable();
- }
-
+ Tcl_MutexLock(&tableMutex);
hPtr = Tcl_FindHashEntry(&typeTable, typeName);
if (hPtr != (Tcl_HashEntry *) NULL) {
typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
+ Tcl_MutexUnlock(&tableMutex);
return typePtr;
}
+ Tcl_MutexUnlock(&tableMutex);
return NULL;
}
@@ -446,9 +403,11 @@ Tcl_NewObj()
register Tcl_Obj *objPtr;
/*
- * Allocate the object using the list of free Tcl_Objs we maintain.
+ * Allocate the object using the list of free Tcl_Obj structs
+ * we maintain.
*/
+ Tcl_MutexLock(&tclObjMutex);
if (tclFreeObjList == NULL) {
TclAllocateFreeObjects();
}
@@ -462,6 +421,7 @@ Tcl_NewObj()
#ifdef TCL_COMPILE_STATS
tclObjsAlloced++;
#endif /* TCL_COMPILE_STATS */
+ Tcl_MutexUnlock(&tclObjMutex);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
@@ -506,7 +466,8 @@ Tcl_DbNewObj(file, line)
/*
* If debugging Tcl's memory usage, allocate the object using ckalloc.
- * Otherwise, allocate it using the list of free Tcl_Objs we maintain.
+ * Otherwise, allocate it using the list of free Tcl_Obj structs we
+ * maintain.
*/
objPtr = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), file, line);
@@ -515,7 +476,9 @@ Tcl_DbNewObj(file, line)
objPtr->length = 0;
objPtr->typePtr = NULL;
#ifdef TCL_COMPILE_STATS
+ Tcl_MutexLock(&tclObjMutex);
tclObjsAlloced++;
+ Tcl_MutexUnlock(&tclObjMutex);
#endif /* TCL_COMPILE_STATS */
return objPtr;
}
@@ -541,6 +504,8 @@ Tcl_DbNewObj(file, line)
* Procedure to allocate a number of free Tcl_Objs. This is done using
* a single ckalloc to reduce the overhead for Tcl_Obj allocation.
*
+ * Assumes mutex is held.
+ *
* Results:
* None.
*
@@ -616,17 +581,18 @@ TclFreeObj(objPtr)
}
#endif /* TCL_MEM_DEBUG */
- Tcl_InvalidateStringRep(objPtr);
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
typePtr->freeIntRepProc(objPtr);
}
+ Tcl_InvalidateStringRep(objPtr);
/*
* If debugging Tcl's memory usage, deallocate the object using ckfree.
* Otherwise, deallocate it by adding it onto the list of free
- * Tcl_Objs we maintain.
+ * Tcl_Obj structs we maintain.
*/
-
+
+ Tcl_MutexLock(&tclObjMutex);
#ifdef TCL_MEM_DEBUG
ckfree((char *) objPtr);
#else
@@ -634,9 +600,10 @@ TclFreeObj(objPtr)
tclFreeObjList = objPtr;
#endif /* TCL_MEM_DEBUG */
-#ifdef TCL_COMPILE_STATS
+#ifdef TCL_COMPILE_STATS
tclObjsFreed++;
-#endif /* TCL_COMPILE_STATS */
+#endif /* TCL_COMPILE_STATS */
+ Tcl_MutexUnlock(&tclObjMutex);
}
/*
@@ -692,7 +659,12 @@ Tcl_DuplicateObj(objPtr)
}
if (typePtr != NULL) {
- typePtr->dupIntRepProc(objPtr, dupPtr);
+ if (typePtr->dupIntRepProc == NULL) {
+ dupPtr->internalRep = objPtr->internalRep;
+ dupPtr->typePtr = typePtr;
+ } else {
+ (*typePtr->dupIntRepProc)(objPtr, dupPtr);
+ }
}
return dupPtr;
}
@@ -700,6 +672,44 @@ Tcl_DuplicateObj(objPtr)
/*
*----------------------------------------------------------------------
*
+ * Tcl_GetString --
+ *
+ * Returns the string representation byte array pointer for an object.
+ *
+ * Results:
+ * Returns a pointer to the string representation of objPtr. The byte
+ * array referenced by the returned pointer must not be modified by the
+ * caller. Furthermore, the caller must copy the bytes if they need to
+ * retain them since the object's string rep can change as a result of
+ * other operations.
+ *
+ * Side effects:
+ * May call the object's updateStringProc to update the string
+ * representation from the internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_GetString(objPtr)
+ register Tcl_Obj *objPtr; /* Object whose string rep byte pointer
+ * should be returned. */
+{
+ if (objPtr->bytes != NULL) {
+ return objPtr->bytes;
+ }
+
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ panic("UpdateStringProc should not be invoked for type %s",
+ objPtr->typePtr->name);
+ }
+ (*objPtr->typePtr->updateStringProc)(objPtr);
+ return objPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_GetStringFromObj --
*
* Returns the string representation's byte array pointer and length
@@ -735,7 +745,11 @@ Tcl_GetStringFromObj(objPtr, lengthPtr)
return objPtr->bytes;
}
- objPtr->typePtr->updateStringProc(objPtr);
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ panic("UpdateStringProc should not be invoked for type %s",
+ objPtr->typePtr->name);
+ }
+ (*objPtr->typePtr->updateStringProc)(objPtr);
if (lengthPtr != NULL) {
*lengthPtr = objPtr->length;
}
@@ -960,33 +974,6 @@ Tcl_GetBooleanFromObj(interp, objPtr, boolPtr)
/*
*----------------------------------------------------------------------
*
- * DupBooleanInternalRep --
- *
- * Initialize the internal representation of a boolean Tcl_Obj to a
- * copy of the internal representation of an existing boolean object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "copyPtr"s internal rep is set to the boolean (an integer)
- * corresponding to "srcPtr"s internal rep.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupBooleanInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
- copyPtr->typePtr = &tclBooleanType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SetBooleanFromAny --
*
* Attempt to generate a boolean internal form for the Tcl object
@@ -1021,7 +1008,7 @@ SetBooleanFromAny(interp, objPtr)
* Get the string representation. Make it up-to-date if necessary.
*/
- string = TclGetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
/*
* Copy the string converting its characters to lower case.
@@ -1029,8 +1016,16 @@ SetBooleanFromAny(interp, objPtr)
for (i = 0; (i < 9) && (i < length); i++) {
c = string[i];
- if (isupper(UCHAR(c))) {
- c = (char) tolower(UCHAR(c));
+ /*
+ * Weed out international characters so we can safely operate
+ * on single bytes.
+ */
+
+ if (c & 0x80) {
+ goto badBoolean;
+ }
+ if (isupper(UCHAR(c))) { /* INTL: ISO only. */
+ c = (char) UCHAR(tolower(UCHAR(c))); /* INTL: ISO only. */
}
lowerCase[i] = c;
}
@@ -1081,7 +1076,8 @@ SetBooleanFromAny(interp, objPtr)
* Make sure the string has no garbage after the end of the double.
*/
- while ((end < (string+length)) && isspace(UCHAR(*end))) {
+ while ((end < (string+length))
+ && isspace(UCHAR(*end))) { /* INTL: ISO only */
end++;
}
if (end != (string+length)) {
@@ -1341,33 +1337,6 @@ Tcl_GetDoubleFromObj(interp, objPtr, dblPtr)
/*
*----------------------------------------------------------------------
*
- * DupDoubleInternalRep --
- *
- * Initialize the internal representation of a double Tcl_Obj to a
- * copy of the internal representation of an existing double object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "copyPtr"s internal rep is set to the double precision floating
- * point number corresponding to "srcPtr"s internal rep.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupDoubleInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- copyPtr->internalRep.doubleValue = srcPtr->internalRep.doubleValue;
- copyPtr->typePtr = &tclDoubleType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SetDoubleFromAny --
*
* Attempt to generate an double-precision floating point internal form
@@ -1399,7 +1368,7 @@ SetDoubleFromAny(interp, objPtr)
* Get the string representation. Make it up-to-date if necessary.
*/
- string = TclGetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
/*
* Now parse "objPtr"s string as an double. Numbers can't have embedded
@@ -1436,7 +1405,8 @@ SetDoubleFromAny(interp, objPtr)
* Make sure that the string has no garbage after the end of the double.
*/
- while ((end < (string+length)) && isspace(UCHAR(*end))) {
+ while ((end < (string+length))
+ && isspace(UCHAR(*end))) { /* INTL: ISO space. */
end++;
}
if (end != (string+length)) {
@@ -1648,33 +1618,6 @@ Tcl_GetIntFromObj(interp, objPtr, intPtr)
/*
*----------------------------------------------------------------------
*
- * DupIntInternalRep --
- *
- * Initialize the internal representation of an int Tcl_Obj to a
- * copy of the internal representation of an existing int object.
- *
- * Results:
- * None.
- *
- * Side effects:
- * "copyPtr"s internal rep is set to the integer corresponding to
- * "srcPtr"s internal rep.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupIntInternalRep(srcPtr, copyPtr)
- register Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
-{
- copyPtr->internalRep.longValue = srcPtr->internalRep.longValue;
- copyPtr->typePtr = &tclIntType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* SetIntFromAny --
*
* Attempt to generate an integer internal form for the Tcl object
@@ -1707,7 +1650,7 @@ SetIntFromAny(interp, objPtr)
* Get the string representation. Make it up-to-date if necessary.
*/
- string = TclGetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
/*
* Now parse "objPtr"s string as an int. We use an implementation here
@@ -1718,7 +1661,7 @@ SetIntFromAny(interp, objPtr)
*/
errno = 0;
- for (p = string; isspace(UCHAR(*p)); p++) {
+ for (p = string; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */
/* Empty loop body. */
}
if (*p == '-') {
@@ -1759,7 +1702,8 @@ SetIntFromAny(interp, objPtr)
* Make sure that the string has no garbage after the end of the int.
*/
- while ((end < (string+length)) && isspace(UCHAR(*end))) {
+ while ((end < (string+length))
+ && isspace(UCHAR(*end))) { /* INTL: ISO space. */
end++;
}
if (end != (string+length)) {
@@ -1805,7 +1749,7 @@ static void
UpdateStringOfInt(objPtr)
register Tcl_Obj *objPtr; /* Int object whose string rep to update. */
{
- char buffer[TCL_DOUBLE_SPACE];
+ char buffer[TCL_INTEGER_SPACE];
register int len;
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
@@ -2045,7 +1989,8 @@ Tcl_GetLongFromObj(interp, objPtr, longPtr)
void
Tcl_DbIncrRefCount(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are adding a reference to. */
+ register Tcl_Obj *objPtr; /* The object we are registering a
+ * reference to. */
char *file; /* The name of the source file calling this
* procedure; used for debugging. */
int line; /* Line number in the source file; used
@@ -2068,9 +2013,9 @@ Tcl_DbIncrRefCount(objPtr, file, line)
*
* This procedure is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. This checks to see whether or not
- * the memory has been freed before incrementing the ref count.
+ * the memory has been freed before decrementing the ref count.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just increments
+ * When TCL_MEM_DEBUG is not defined, this procedure just decrements
* the reference count of the object.
*
* Results:
@@ -2084,7 +2029,8 @@ Tcl_DbIncrRefCount(objPtr, file, line)
void
Tcl_DbDecrRefCount(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are adding a reference to. */
+ register Tcl_Obj *objPtr; /* The object we are releasing a reference
+ * to. */
char *file; /* The name of the source file calling this
* procedure; used for debugging. */
int line; /* Line number in the source file; used
@@ -2108,25 +2054,24 @@ Tcl_DbDecrRefCount(objPtr, file, line)
* Tcl_DbIsShared --
*
* This procedure is normally called when debugging: i.e., when
- * TCL_MEM_DEBUG is defined. This checks to see whether or not
- * the memory has been freed before incrementing the ref count.
+ * TCL_MEM_DEBUG is defined. It tests whether the object has a ref
+ * count greater than one.
*
- * When TCL_MEM_DEBUG is not defined, this procedure just decrements
- * the reference count of the object and throws it away if the count
- * is 0 or less.
+ * When TCL_MEM_DEBUG is not defined, this procedure just tests
+ * if the object has a ref count greater than one.
*
* Results:
* None.
*
* Side effects:
- * The object's ref count is incremented.
+ * None.
*
*----------------------------------------------------------------------
*/
int
Tcl_DbIsShared(objPtr, file, line)
- register Tcl_Obj *objPtr; /* The object we are adding a reference to. */
+ register Tcl_Obj *objPtr; /* The object to test for being shared. */
char *file; /* The name of the source file calling this
* procedure; used for debugging. */
int line; /* Line number in the source file; used