merged tcl 8.1 branch back into the main trunk

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