update to tcl/tk 8.6.7

1 files changed, 0 insertions, 4519 deletions

diff --git a/tcl8.6/generic/tclObj.c b/tcl8.6/generic/tclObj.c
deleted file mode 100644
index 628c3a7..0000000
--- a/tcl8.6/generic/tclObj.c
+++ /dev/null
@@ -1,4519 +0,0 @@
-/*
- * tclObj.c --
- *
- *	This file contains Tcl object-related functions that are used by many
- *	Tcl commands.
- *
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
- * Copyright (c) 1999 by Scriptics Corporation.
- * Copyright (c) 2001 by ActiveState Corporation.
- * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
- * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-#include "tommath.h"
-#include <math.h>
-
-/*
- * Table of all object types.
- */
-
-static Tcl_HashTable typeTable;
-static int typeTableInitialized = 0;	/* 0 means not yet initialized. */
-TCL_DECLARE_MUTEX(tableMutex)
-
-/*
- * 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
-MODULE_SCOPE Tcl_Mutex tclObjMutex;
-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 tclEmptyString = '\0';
-char *tclEmptyStringRep = &tclEmptyString;
-
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
-/*
- * Structure for tracking the source file and line number where a given
- * Tcl_Obj was allocated.  We also track the pointer to the Tcl_Obj itself,
- * for sanity checking purposes.
- */
-
-typedef struct ObjData {
-    Tcl_Obj *objPtr;		/* The pointer to the allocated Tcl_Obj. */
-    const char *file;		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line;			/* Line number in the source file; used for
-				 * debugging. */
-} ObjData;
-#endif /* TCL_MEM_DEBUG && TCL_THREADS */
-
-/*
- * All static variables used in this file are collected into a single instance
- * of the following structure.  For multi-threaded implementations, there is
- * one instance of this structure for each thread.
- *
- * Notice that different structures with the same name appear in other files.
- * The structure defined below is used in this file only.
- */
-
-typedef struct ThreadSpecificData {
-    Tcl_HashTable *lineCLPtr;   /* This table remembers for each Tcl_Obj
-                                 * generated by a call to the function
-                                 * 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.
-                                 * 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)
-    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             TclThreadFinalizeContLines(ClientData clientData);
-static ThreadSpecificData *TclGetContLineTable(void);
-
-/*
- * Nested Tcl_Obj deletion management support
- *
- * All context references used in the object freeing code are pointers to this
- * structure; every thread will have its own structure instance. The purpose
- * of this structure is to allow deeply nested collections of Tcl_Objs to be
- * freed without taking a vast depth of C stack (which could cause all sorts
- * of breakage.)
- */
-
-typedef struct PendingObjData {
-    int deletionCount;		/* Count of the number of invokations of
-				 * TclFreeObj() are on the stack (at least
-				 * conceptually; many are actually expanded
-				 * macros). */
-    Tcl_Obj *deletionStack;	/* Stack of objects that have had TclFreeObj()
-				 * invoked upon them but which can't be
-				 * deleted yet because they are in a nested
-				 * invokation of TclFreeObj(). By postponing
-				 * this way, we limit the maximum overall C
-				 * stack depth when deleting a complex object.
-				 * The down-side is that we alter the overall
-				 * behaviour by altering the order in which
-				 * objects are deleted, and we change the
-				 * order in which the string rep and the
-				 * internal rep of an object are deleted. Note
-				 * that code which assumes the previous
-				 * behaviour in either of these respects is
-				 * unsafe anyway; it was never documented as
-				 * to exactly what would happen in these
-				 * cases, and the overall contract of a
-				 * user-level Tcl_DecrRefCount() is still
-				 * preserved (assuming that a particular T_DRC
-				 * would delete an object is not very
-				 * safe). */
-} PendingObjData;
-
-/*
- * These are separated out so that some semantic content is attached
- * to them.
- */
-#define ObjDeletionLock(contextPtr)	((contextPtr)->deletionCount++)
-#define ObjDeletionUnlock(contextPtr)	((contextPtr)->deletionCount--)
-#define ObjDeletePending(contextPtr)	((contextPtr)->deletionCount > 0)
-#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);           \
-    (contextPtr)->deletionStack = (objPtr)
-#define PopObjToDelete(contextPtr,objPtrVar) \
-    (objPtrVar) = (contextPtr)->deletionStack;                          \
-    (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes
-
-/*
- * Macro to set up the local reference to the deletion context.
- */
-#ifndef TCL_THREADS
-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) \
-    PendingObjData *const contextPtr =                                  \
-	    Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
-#endif
-
-/*
- * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
- */
-
-#define PACK_BIGNUM(bignum, objPtr) \
-    if ((bignum).used > 0x7fff) {                                       \
-	mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int));     \
-	*temp = bignum;                                                 \
-	(objPtr)->internalRep.twoPtrValue.ptr1 = temp;                 \
-	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
-    } else {                                                            \
-	if ((bignum).alloc > 0x7fff) {                                  \
-	    mp_shrink(&(bignum));                                       \
-	}                                                               \
-	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \
-	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
-		| ((bignum).alloc << 15) | ((bignum).used));            \
-    }
-
-#define UNPACK_BIGNUM(objPtr, bignum) \
-    if ((objPtr)->internalRep.twoPtrValue.ptr2 == INT2PTR(-1)) { \
-	(bignum) = *((mp_int *) ((objPtr)->internalRep.twoPtrValue.ptr1)); \
-    } else {                                                            \
-	(bignum).dp = (objPtr)->internalRep.twoPtrValue.ptr1;          \
-	(bignum).sign = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 30; \
-	(bignum).alloc =                                                \
-		(PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) >> 15) & 0x7fff; \
-	(bignum).used = PTR2INT((objPtr)->internalRep.twoPtrValue.ptr2) & 0x7fff; \
-    }
-
-/*
- * Prototypes for functions defined later in this file:
- */
-
-static int		ParseBoolean(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 TCL_WIDE_INT_IS_LONG
-static void		UpdateStringOfWideInt(Tcl_Obj *objPtr);
-static int		SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
-#endif
-static void		FreeBignum(Tcl_Obj *objPtr);
-static void		DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
-static void		UpdateStringOfBignum(Tcl_Obj *objPtr);
-static int		GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-			    int copy, mp_int *bignumValue);
-
-/*
- * Prototypes for the array hash key methods.
- */
-
-static Tcl_HashEntry *	AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);
-
-/*
- * Prototypes for the CommandName object type.
- */
-
-static void		DupCmdNameInternalRep(Tcl_Obj *objPtr,
-			    Tcl_Obj *copyPtr);
-static void		FreeCmdNameInternalRep(Tcl_Obj *objPtr);
-static int		SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
-
-/*
- * The structures below defines the Tcl object types defined in this file by
- * means of functions that can be invoked by generic object code. See also
- * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
- * implementations.
- */
-
-static const Tcl_ObjType oldBooleanType = {
-    "boolean",			/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    NULL,			/* updateStringProc */
-    TclSetBooleanFromAny		/* setFromAnyProc */
-};
-const Tcl_ObjType tclBooleanType = {
-    "booleanString",		/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    NULL,			/* updateStringProc */
-    TclSetBooleanFromAny		/* setFromAnyProc */
-};
-const Tcl_ObjType tclDoubleType = {
-    "double",			/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    UpdateStringOfDouble,	/* updateStringProc */
-    SetDoubleFromAny		/* setFromAnyProc */
-};
-const Tcl_ObjType tclIntType = {
-    "int",			/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    UpdateStringOfInt,		/* updateStringProc */
-    SetIntFromAny		/* setFromAnyProc */
-};
-#ifndef TCL_WIDE_INT_IS_LONG
-const Tcl_ObjType tclWideIntType = {
-    "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 */
-};
-
-/*
- * The structure below defines the Tcl obj hash key type.
- */
-
-const Tcl_HashKeyType tclObjHashKeyType = {
-    TCL_HASH_KEY_TYPE_VERSION,	/* version */
-    0,				/* flags */
-    TclHashObjKey,		/* hashKeyProc */
-    TclCompareObjKeys,		/* compareKeysProc */
-    AllocObjEntry,		/* allocEntryProc */
-    TclFreeObjEntry		/* freeEntryProc */
-};
-
-/*
- * The structure below defines the command name Tcl object type by means of
- * functions that can be invoked by generic object code. Objects of this type
- * cache the Command pointer that results from looking up command names in the
- * command hashtable. Such objects appear as the zeroth ("command name")
- * argument in a Tcl command.
- *
- * NOTE: the ResolvedCmdName that gets cached is stored in the
- * twoPtrValue.ptr1 field, and the twoPtrValue.ptr2 field is unused. You might
- * think you could use the simpler otherValuePtr field to store the single
- * ResolvedCmdName pointer, but DO NOT DO THIS. It seems that some extensions
- * use the second internal pointer field of the twoPtrValue field for their
- * own purposes.
- *
- * TRICKY POINT! Some extensions update this structure! (Notably, these
- * include TclBlend and TCom). This is highly ill-advised on their part, but
- * does allow them to delete a command when references to it are gone, which
- * is fragile but useful given their somewhat-OO style. Because of this, this
- * structure MUST NOT be const so that the C compiler puts the data in
- * writable memory. [Bug 2558422] [Bug 07d13d99b0a9]
- * TODO: Provide a better API for those extensions so that they can coexist...
- */
-
-Tcl_ObjType tclCmdNameType = {
-    "cmdName",			/* name */
-    FreeCmdNameInternalRep,	/* freeIntRepProc */
-    DupCmdNameInternalRep,	/* dupIntRepProc */
-    NULL,			/* updateStringProc */
-    SetCmdNameFromAny		/* setFromAnyProc */
-};
-
-/*
- * Structure containing a cached pointer to a command that is the result of
- * resolving the command's name in some namespace. It is the internal
- * representation for a cmdName object. It contains the pointer along with
- * some information that is used to check the pointer's validity.
- */
-
-typedef struct ResolvedCmdName {
-    Command *cmdPtr;		/* A cached Command pointer. */
-    Namespace *refNsPtr;	/* Points to the namespace containing the
-				 * 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
-				 * 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
-				 * 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
-				 * 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
-				 * that has a pointer to this ResolvedCmdName
-				 * structure as its internal rep. This
-				 * structure can be freed when refCount
-				 * becomes zero. */
-} ResolvedCmdName;
-
-/*
- *-------------------------------------------------------------------------
- *
- * TclInitObjectSubsystem --
- *
- *	This function is invoked to perform once-only initialization of the
- *	type table. It also registers the object types defined in this file.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Initializes the table of defined object types "typeTable" with builtin
- *	object types defined in this file.
- *
- *-------------------------------------------------------------------------
- */
-
-void
-TclInitObjSubsystem(void)
-{
-    Tcl_MutexLock(&tableMutex);
-    typeTableInitialized = 1;
-    Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
-    Tcl_MutexUnlock(&tableMutex);
-
-    Tcl_RegisterObjType(&tclByteArrayType);
-    Tcl_RegisterObjType(&tclDoubleType);
-    Tcl_RegisterObjType(&tclEndOffsetType);
-    Tcl_RegisterObjType(&tclIntType);
-    Tcl_RegisterObjType(&tclStringType);
-    Tcl_RegisterObjType(&tclListType);
-    Tcl_RegisterObjType(&tclDictType);
-    Tcl_RegisterObjType(&tclByteCodeType);
-    Tcl_RegisterObjType(&tclArraySearchType);
-    Tcl_RegisterObjType(&tclCmdNameType);
-    Tcl_RegisterObjType(&tclRegexpType);
-    Tcl_RegisterObjType(&tclProcBodyType);
-
-    /* For backward compatibility only ... */
-    Tcl_RegisterObjType(&oldBooleanType);
-#ifndef TCL_WIDE_INT_IS_LONG
-    Tcl_RegisterObjType(&tclWideIntType);
-#endif
-
-#ifdef TCL_COMPILE_STATS
-    Tcl_MutexLock(&tclObjMutex);
-    tclObjsAlloced = 0;
-    tclObjsFreed = 0;
-    {
-	int i;
-
-	for (i=0 ; i<TCL_MAX_SHARED_OBJ_STATS ; i++) {
-	    tclObjsShared[i] = 0;
-	}
-    }
-    Tcl_MutexUnlock(&tclObjMutex);
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeThreadObjects --
- *
- *	This function is called by Tcl_FinalizeThread to clean up thread
- *	specific Tcl_Obj information.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclFinalizeThreadObjects(void)
-{
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
-    Tcl_HashEntry *hPtr;
-    Tcl_HashSearch hSearch;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
-
-    if (tablePtr != NULL) {
-	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
-		hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
-	    ObjData *objData = Tcl_GetHashValue(hPtr);
-
-	    if (objData != NULL) {
-		ckfree(objData);
-	    }
-	}
-
-	Tcl_DeleteHashTable(tablePtr);
-	ckfree(tablePtr);
-	tsdPtr->objThreadMap = NULL;
-    }
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeObjects --
- *
- *	This function is called by Tcl_Finalize to clean up all registered
- *	Tcl_ObjType's and to reset the tclFreeObjList.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclFinalizeObjects(void)
-{
-    Tcl_MutexLock(&tableMutex);
-    if (typeTableInitialized) {
-	Tcl_DeleteHashTable(&typeTable);
-	typeTableInitialized = 0;
-    }
-    Tcl_MutexUnlock(&tableMutex);
-
-    /*
-     * All we do here is reset the head pointer of the linked list of free
-     * Tcl_Obj's to NULL; the memory finalization will take care of releasing
-     * memory for us.
-     */
-    Tcl_MutexLock(&tclObjMutex);
-    tclFreeObjList = NULL;
-    Tcl_MutexUnlock(&tclObjMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetContLineTable --
- *
- *	This procedure is a helper which returns the thread-specific
- *	hash-table used to track continuation line information associated with
- *	Tcl_Obj*, and the objThreadMap, etc.
- *
- * Results:
- *	A reference to the thread-data.
- *
- * Side effects:
- *	May allocate memory for the thread-data.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-static ThreadSpecificData *
-TclGetContLineTable(void)
-{
-    /*
-     * Initialize the hashtable tracking invisible continuation lines.  For
-     * the release we use a thread exit handler to ensure that this is done
-     * before TSD blocks are made invalid. The TclFinalizeObjects() which
-     * would be the natural place for this is invoked afterwards, meaning that
-     * we try to operate on a data structure already gone.
-     */
-
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    if (!tsdPtr->lineCLPtr) {
-	tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
-	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
-    }
-    return tsdPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclContinuationsEnter --
- *
- *	This procedure is a helper which saves the continuation line
- *	information associated with a Tcl_Obj*.
- *
- * Results:
- *	A reference to the newly created continuation line location table.
- *
- * Side effects:
- *	Allocates memory for the table of continuation line locations.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-ContLineLoc *
-TclContinuationsEnter(
-    Tcl_Obj *objPtr,
-    int num,
-    int *loc)
-{
-    int newEntry;
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr =
-	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
-    ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
-
-    if (!newEntry) {
-	/*
-	 * We're entering ContLineLoc data for the same value more than one
-	 * time. Taking care not to leak the old entry.
-	 *
-	 * This can happen when literals in a proc body are shared. See for
-	 * example test info-30.19 where the action (code) for all branches of
-	 * the switch command is identical, mapping them all to the same
-	 * literal. An interesting result of this is that the number and
-	 * locations (offset) of invisible continuation lines in the literal
-	 * are the same for all occurences.
-	 *
-	 * Note that while reusing the existing entry is possible it requires
-	 * the same actions as for a new entry because we have to copy the
-	 * incoming num/loc data even so. Because we are called from
-	 * TclContinuationsEnterDerived for this case, which modified the
-	 * stored locations (Rebased to the proper relative offset). Just
-	 * returning the stored entry would rebase them a second time, or
-	 * more, hosing the data. It is easier to simply replace, as we are
-	 * doing.
-	 */
-
-	ckfree(Tcl_GetHashValue(hPtr));
-    }
-
-    clLocPtr->num = num;
-    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
-    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
-    Tcl_SetHashValue(hPtr, clLocPtr);
-
-    return clLocPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclContinuationsEnterDerived --
- *
- *	This procedure is a helper which computes the continuation line
- *	information associated with a Tcl_Obj* cut from the middle of a
- *	script.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Allocates memory for the table of continuation line locations.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-void
-TclContinuationsEnterDerived(
-    Tcl_Obj *objPtr,
-    int start,
-    int *clNext)
-{
-    int length, end, num;
-    int *wordCLLast = clNext;
-
-    /*
-     * We have to handle invisible continuations lines here as well, despite
-     * the code we have in TclSubstTokens (TST) for that. Why ?  Nesting. If
-     * our script is the sole argument to an 'eval' command, for example, the
-     * scriptCLLocPtr we are using was generated by a previous call to TST,
-     * and while the words we have here may contain continuation lines they
-     * are invisible already, and the inner call to TST had no bs+nl sequences
-     * to trigger its code.
-     *
-     * Luckily for us, the table we have to create here for the current word
-     * has to be a slice of the table currently in use, with the locations
-     * suitably modified to be relative to the start of the word instead of
-     * relative to the script.
-     *
-     * That is what we are doing now. Determine the slice we need, and if not
-     * empty, wrap it into a new table, and save the result into our
-     * thread-global hashtable, as usual.
-     */
-
-    /*
-     * First compute the range of the word within the script. (Is there a
-     * better way which doesn't shimmer?)
-     */
-
-    Tcl_GetStringFromObj(objPtr, &length);
-    end = start + length;       /* First char after the word */
-
-    /*
-     * Then compute the table slice covering the range of the word.
-     */
-
-    while (*wordCLLast >= 0 && *wordCLLast < end) {
-	wordCLLast++;
-    }
-
-    /*
-     * 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);
-
-	/*
-	 * Re-base the locations.
-	 */
-
-	for (i=0 ; i<num ; i++) {
-	    clLocPtr->loc[i] -= start;
-
-	    /*
-	     * Continuation lines coming before the string and affecting us
-	     * should not happen, due to the proper maintenance of clNext
-	     * during compilation.
-	     */
-
-	    if (clLocPtr->loc[i] < 0) {
-		Tcl_Panic("Derived ICL data for object using offsets from before the script");
-	    }
-	}
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Allocates memory for the table of continuation line locations.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-void
-TclContinuationsCopy(
-    Tcl_Obj *objPtr,
-    Tcl_Obj *originObjPtr)
-{
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr =
-            Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);
-
-    if (hPtr) {
-	ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);
-
-	TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclContinuationsGet --
- *
- *	This procedure is a helper which retrieves the continuation line
- *	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.
- *
- * Side effects:
- *	None.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-ContLineLoc *
-TclContinuationsGet(
-    Tcl_Obj *objPtr)
-{
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr =
-            Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
-
-    if (!hPtr) {
-        return NULL;
-    }
-    return Tcl_GetHashValue(hPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclThreadFinalizeContLines --
- *
- *	This procedure is a helper which releases all continuation line
- *	information currently known. It is run as a thread exit handler.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Releases memory.
- *
- * TIP #280
- *----------------------------------------------------------------------
- */
-
-static void
-TclThreadFinalizeContLines(
-    ClientData clientData)
-{
-    /*
-     * Release the hashtable tracking invisible continuation lines.
-     */
-
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr;
-    Tcl_HashSearch hSearch;
-
-    for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
-	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
-	ckfree(Tcl_GetHashValue(hPtr));
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
-    ckfree(tsdPtr->lineCLPtr);
-    tsdPtr->lineCLPtr = NULL;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_RegisterObjType --
- *
- *	This function is called to register a new Tcl object type in the table
- *	of all object types supported by Tcl.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The type is registered in the Tcl type table. If there was already a
- *	type with the same name as in typePtr, it is replaced with the new
- *	type.
- *
- *--------------------------------------------------------------
- */
-
-void
-Tcl_RegisterObjType(
-    const Tcl_ObjType *typePtr)	/* Information about object type; storage must
-				 * be statically allocated (must live
-				 * forever). */
-{
-    int isNew;
-
-    Tcl_MutexLock(&tableMutex);
-    Tcl_SetHashValue(
-	    Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
-    Tcl_MutexUnlock(&tableMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_AppendAllObjTypes --
- *
- *	This function 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_NewObj. These names can be
- *	used, for example, with Tcl_GetObjType to get pointers to the
- *	corresponding Tcl_ObjType structures.
- *
- * Results:
- *	The return value is normally TCL_OK; in this case the object
- *	referenced by objPtr has each type name appended to it. If an error
- *	occurs, TCL_ERROR is returned and the interpreter's result holds an
- *	error message.
- *
- * Side effects:
- *	If necessary, the object referenced by objPtr is converted into a list
- *	object.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_AppendAllObjTypes(
-    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
-    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
-				 * name of each registered type is appended as
-				 * a list element. */
-{
-    register Tcl_HashEntry *hPtr;
-    Tcl_HashSearch search;
-    int numElems;
-
-    /*
-     * Get the test for a valid list out of the way first.
-     */
-
-    if (TclListObjLength(interp, objPtr, &numElems) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Type names are NUL-terminated, not counted strings. This code relies on
-     * that.
-     */
-
-    Tcl_MutexLock(&tableMutex);
-    for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
-	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	Tcl_ListObjAppendElement(NULL, objPtr,
-		Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
-    }
-    Tcl_MutexUnlock(&tableMutex);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetObjType --
- *
- *	This function looks up an object type by name.
- *
- * Results:
- *	If an object type with name matching "typeName" is found, a pointer to
- *	its Tcl_ObjType structure is returned; otherwise, NULL is returned.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-const Tcl_ObjType *
-Tcl_GetObjType(
-    const char *typeName)	/* Name of Tcl object type to look up. */
-{
-    register Tcl_HashEntry *hPtr;
-    const Tcl_ObjType *typePtr = NULL;
-
-    Tcl_MutexLock(&tableMutex);
-    hPtr = Tcl_FindHashEntry(&typeTable, typeName);
-    if (hPtr != NULL) {
-	typePtr = Tcl_GetHashValue(hPtr);
-    }
-    Tcl_MutexUnlock(&tableMutex);
-    return typePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ConvertToType --
- *
- *	Convert the Tcl object "objPtr" to have type "typePtr" if possible.
- *
- * Results:
- *	The return value is TCL_OK on success and TCL_ERROR on failure. If
- *	TCL_ERROR is returned, then the interpreter's result contains an error
- *	message unless "interp" is NULL. Passing a NULL "interp" allows this
- *	function to be used as a test whether the conversion could be done
- *	(and in fact was done).
- *
- * Side effects:
- *	Any internal representation for the old type is freed.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ConvertToType(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr,		/* The object to convert. */
-    const Tcl_ObjType *typePtr)	/* The target type. */
-{
-    if (objPtr->typePtr == typePtr) {
-	return TCL_OK;
-    }
-
-    /*
-     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form
-     * as appropriate for the target type. This frees the old internal
-     * representation.
-     */
-
-    if (typePtr->setFromAnyProc == NULL) {
-	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);
-}
-
-/*
- *--------------------------------------------------------------
- *
- * TclDbDumpActiveObjects --
- *
- *	This function is called to dump all of the active Tcl_Obj structs this
- *	allocator knows about.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *--------------------------------------------------------------
- */
-
-void
-TclDbDumpActiveObjects(
-    FILE *outFile)
-{
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
-    Tcl_HashSearch hSearch;
-    Tcl_HashEntry *hPtr;
-    Tcl_HashTable *tablePtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    tablePtr = tsdPtr->objThreadMap;
-
-    if (tablePtr != NULL) {
-	fprintf(outFile, "total objects: %d\n", tablePtr->numEntries);
-	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
-		hPtr = Tcl_NextHashEntry(&hSearch)) {
-	    ObjData *objData = Tcl_GetHashValue(hPtr);
-
-	    if (objData != NULL) {
-		fprintf(outFile,
-			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",
-			Tcl_GetHashKey(tablePtr, hPtr), objData->objPtr,
-			objData->file, objData->line);
-	    } else {
-		fprintf(outFile, "key = 0x%p\n",
-			Tcl_GetHashKey(tablePtr, hPtr));
-	    }
-	}
-    }
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDbInitNewObj --
- *
- *	Called via the TclNewObj or TclDbNewObj macros when TCL_MEM_DEBUG is
- *	enabled. This function will initialize the members of a Tcl_Obj
- *	struct. Initilization would be done inline via the TclNewObj macro
- *	when compiling without TCL_MEM_DEBUG.
- *
- * Results:
- *	The Tcl_Obj struct members are initialized.
- *
- * Side effects:
- *	None.
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-void
-TclDbInitNewObj(
-    register Tcl_Obj *objPtr,
-    register const char *file,	/* The name of the source file calling this
-				 * function; used for debugging. */
-    register int line)		/* Line number in the source file; used for
-				 * debugging. */
-{
-    objPtr->refCount = 0;
-    objPtr->bytes = tclEmptyStringRep;
-    objPtr->length = 0;
-    objPtr->typePtr = NULL;
-
-#ifdef TCL_THREADS
-    /*
-     * Add entry to a thread local map used to check if a Tcl_Obj was
-     * allocated by the currently executing thread.
-     */
-
-    if (!TclInExit()) {
-	Tcl_HashEntry *hPtr;
-	Tcl_HashTable *tablePtr;
-	int isNew;
-	ObjData *objData;
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-	if (tsdPtr->objThreadMap == NULL) {
-	    tsdPtr->objThreadMap = ckalloc(sizeof(Tcl_HashTable));
-	    Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
-	}
-	tablePtr = tsdPtr->objThreadMap;
-	hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew);
-	if (!isNew) {
-	    Tcl_Panic("expected to create new entry for object map");
-	}
-
-	/*
-	 * Record the debugging information.
-	 */
-
-	objData = ckalloc(sizeof(ObjData));
-	objData->objPtr = objPtr;
-	objData->file = file;
-	objData->line = line;
-	Tcl_SetHashValue(hPtr, objData);
-    }
-#endif /* TCL_THREADS */
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NewObj --
- *
- *	This function is normally called when not debugging: i.e., when
- *	TCL_MEM_DEBUG is not defined. It creates new Tcl objects that denote
- *	the empty string. These objects have a NULL object type and NULL
- *	string representation byte pointer. Type managers call this routine to
- *	allocate new objects that they further initialize.
- *
- *	When TCL_MEM_DEBUG is defined, this function just returns the result
- *	of calling the debugging version Tcl_DbNewObj.
- *
- * Results:
- *	The result is a newly allocated object that represents the empty
- *	string. The new object's typePtr is set NULL and its ref count is set
- *	to 0.
- *
- * Side effects:
- *	If compiling with TCL_COMPILE_STATS, this function increments the
- *	global count of allocated objects (tclObjsAlloced).
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewObj
-
-Tcl_Obj *
-Tcl_NewObj(void)
-{
-    return Tcl_DbNewObj("unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewObj(void)
-{
-    register Tcl_Obj *objPtr;
-
-    /*
-     * Use the macro defined in tclInt.h - it will use the correct allocator.
-     */
-
-    TclNewObj(objPtr);
-    return objPtr;
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewObj --
- *
- *	This function is normally called when debugging: i.e., when
- *	TCL_MEM_DEBUG is defined. It creates new Tcl objects that denote the
- *	empty string. It is the same as the Tcl_NewObj function above except
- *	that it calls Tcl_DbCkalloc directly with the file name and line
- *	number from its caller. This simplifies debugging since then the
- *	[memory active] command will report the correct file name and line
- *	number when reporting objects that haven't been freed.
- *
- *	When TCL_MEM_DEBUG is not defined, this function just returns the
- *	result of calling Tcl_NewObj.
- *
- * Results:
- *	The result is a newly allocated that represents the empty string. The
- *	new object's typePtr is set NULL and its ref count is set to 0.
- *
- * Side effects:
- *	If compiling with TCL_COMPILE_STATS, this function increments the
- *	global count of allocated objects (tclObjsAlloced).
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewObj(
-    register const char *file,	/* The name of the source file calling this
-				 * function; used for debugging. */
-    register int line)		/* Line number in the source file; used for
-				 * debugging. */
-{
-    register Tcl_Obj *objPtr;
-
-    /*
-     * Use the macro defined in tclInt.h - it will use the correct allocator.
-     */
-
-    TclDbNewObj(objPtr, file, line);
-    return objPtr;
-}
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewObj(
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-    return Tcl_NewObj();
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * TclAllocateFreeObjects --
- *
- *	Function 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.
- *
- * 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.twoPtrValue.ptr1's.
- *
- *----------------------------------------------------------------------
- */
-
-#define OBJS_TO_ALLOC_EACH_TIME 100
-
-void
-TclAllocateFreeObjects(void)
-{
-    size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
-    char *basePtr;
-    register Tcl_Obj *prevPtr, *objPtr;
-    register int i;
-
-    /*
-     * This has been noted by Purify to be a potential leak. The problem is
-     * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
-     * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
-     * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
-     * but leaves it to Tcl's memory subsystem finalization to release it.
-     * Purify apparently can't figure that out, and fires a false alarm.
-     */
-
-    basePtr = ckalloc(bytesToAlloc);
-
-    prevPtr = NULL;
-    objPtr = (Tcl_Obj *) basePtr;
-    for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
-	objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
-	prevPtr = objPtr;
-	objPtr++;
-    }
-    tclFreeObjList = prevPtr;
-}
-#undef OBJS_TO_ALLOC_EACH_TIME
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFreeObj --
- *
- *	This function frees the memory associated with the argument object.
- *	It is called by the tcl.h macro Tcl_DecrRefCount when an object's ref
- *	count is zero. It is only "public" since it must be callable by that
- *	macro wherever the macro is used. It should not be directly called by
- *	clients.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Deallocates the storage for the object's Tcl_Obj structure after
- *	deallocating the string representation and calling the type-specific
- *	Tcl_FreeInternalRepProc to deallocate the object's internal
- *	representation. If compiling with TCL_COMPILE_STATS, this function
- *	increments the global count of freed objects (tclObjsFreed).
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-void
-TclFreeObj(
-    register Tcl_Obj *objPtr)	/* The object to be freed. */
-{
-    register const Tcl_ObjType *typePtr = objPtr->typePtr;
-
-    /*
-     * This macro declares a variable, so must come here...
-     */
-
-    ObjInitDeletionContext(context);
-
-# ifdef TCL_THREADS
-    /*
-     * Check to make sure that the Tcl_Obj was allocated by the current
-     * thread. Don't do this check when shutting down since thread local
-     * storage can be finalized before the last Tcl_Obj is freed.
-     */
-
-    if (!TclInExit()) {
-	Tcl_HashTable *tablePtr;
-	Tcl_HashEntry *hPtr;
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-	tablePtr = tsdPtr->objThreadMap;
-	if (!tablePtr) {
-	    Tcl_Panic("TclFreeObj: object table not initialized");
-	}
-	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
-	if (hPtr) {
-	    /*
-	     * As the Tcl_Obj is going to be deleted we remove the entry.
-	     */
-
-	    ObjData *objData = Tcl_GetHashValue(hPtr);
-
-	    if (objData != NULL) {
-		ckfree(objData);
-	    }
-
-	    Tcl_DeleteHashEntry(hPtr);
-	}
-    }
-# endif
-
-    /*
-     * 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 %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
-     * pointer chain, and signal an obj deletion (as opposed to shimmering)
-     * with 'length == -1'.
-     */
-
-    TclInvalidateStringRep(objPtr);
-    objPtr->length = -1;
-
-    if (ObjDeletePending(context)) {
-	PushObjToDelete(context, objPtr);
-    } else {
-	TCL_DTRACE_OBJ_FREE(objPtr);
-	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
-	    ObjDeletionLock(context);
-	    typePtr->freeIntRepProc(objPtr);
-	    ObjDeletionUnlock(context);
-	}
-
-	Tcl_MutexLock(&tclObjMutex);
-	ckfree(objPtr);
-	Tcl_MutexUnlock(&tclObjMutex);
-	TclIncrObjsFreed();
-	ObjDeletionLock(context);
-	while (ObjOnStack(context)) {
-	    Tcl_Obj *objToFree;
-
-	    PopObjToDelete(context, objToFree);
-	    TCL_DTRACE_OBJ_FREE(objToFree);
-	    TclFreeIntRep(objToFree);
-
-	    Tcl_MutexLock(&tclObjMutex);
-	    ckfree(objToFree);
-	    Tcl_MutexUnlock(&tclObjMutex);
-	    TclIncrObjsFreed();
-	}
-	ObjDeletionUnlock(context);
-    }
-
-    /*
-     * 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).
-     */
-
-    {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-        Tcl_HashEntry *hPtr;
-
-	if (tsdPtr->lineCLPtr) {
-            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
-	    if (hPtr) {
-		ckfree(Tcl_GetHashValue(hPtr));
-		Tcl_DeleteHashEntry(hPtr);
-	    }
-	}
-    }
-}
-#else /* TCL_MEM_DEBUG */
-
-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'.
-     */
-
-    TclInvalidateStringRep(objPtr);
-    objPtr->length = -1;
-
-    if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) {
-	/*
-	 * objPtr can be freed safely, as it will not attempt to free any
-	 * other objects: it will not cause recursive calls to this function.
-	 */
-
-	TCL_DTRACE_OBJ_FREE(objPtr);
-	TclFreeObjStorage(objPtr);
-	TclIncrObjsFreed();
-    } else {
-	/*
-	 * This macro declares a variable, so must come here...
-	 */
-
-	ObjInitDeletionContext(context);
-
-	if (ObjDeletePending(context)) {
-	    PushObjToDelete(context, objPtr);
-	} else {
-	    /*
-	     * Note that the contents of the while loop assume that the string
-	     * rep has already been freed and we don't want to do anything
-	     * fancy with adding to the queue inside ourselves. Must take care
-	     * to unstack the object first since freeing the internal rep can
-	     * add further objects to the stack. The code assumes that it is
-	     * the first thing in a block; all current usages in the core
-	     * satisfy this.
-	     */
-
-	    TCL_DTRACE_OBJ_FREE(objPtr);
-	    ObjDeletionLock(context);
-	    objPtr->typePtr->freeIntRepProc(objPtr);
-	    ObjDeletionUnlock(context);
-
-	    TclFreeObjStorage(objPtr);
-	    TclIncrObjsFreed();
-	    ObjDeletionLock(context);
-	    while (ObjOnStack(context)) {
-		Tcl_Obj *objToFree;
-
-		PopObjToDelete(context, objToFree);
-		TCL_DTRACE_OBJ_FREE(objToFree);
-		if ((objToFree->typePtr != NULL)
-			&& (objToFree->typePtr->freeIntRepProc != NULL)) {
-		    objToFree->typePtr->freeIntRepProc(objToFree);
-		}
-		TclFreeObjStorage(objToFree);
-		TclIncrObjsFreed();
-	    }
-	    ObjDeletionUnlock(context);
-	}
-    }
-
-    /*
-     * 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).
-     */
-
-    {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-        Tcl_HashEntry *hPtr;
-
-	if (tsdPtr->lineCLPtr) {
-            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
-	    if (hPtr) {
-		ckfree(Tcl_GetHashValue(hPtr));
-		Tcl_DeleteHashEntry(hPtr);
-	    }
-	}
-    }
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * TclObjBeingDeleted --
- *
- *	This function returns 1 when the Tcl_Obj is being deleted. It is
- *	provided for the rare cases where the reason for the loss of an
- *	internal rep might be relevant. [FR 1512138]
- *
- * Results:
- *	1 if being deleted, 0 otherwise.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclObjBeingDeleted(
-    Tcl_Obj *objPtr)
-{
-    return (objPtr->length == -1);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DuplicateObj --
- *
- *	Create and return a new object that is a duplicate of the argument
- *	object.
- *
- * Results:
- *	The return value is a pointer to a newly created Tcl_Obj. This object
- *	has reference count 0 and the same type, if any, as the source object
- *	objPtr. Also:
- *	  1) If the source object has a valid string rep, we copy it;
- *	     otherwise, the duplicate's string rep is set NULL to mark it
- *	     invalid.
- *	  2) If the source object has an internal representation (i.e. its
- *	     typePtr is non-NULL), the new object's internal rep is set to a
- *	     copy; otherwise the new internal rep is marked invalid.
- *
- * Side effects:
- *	What constitutes "copying" the internal representation depends on the
- *	type. For example, if the argument object is a list, the element
- *	objects it points to will not actually be copied but will be shared
- *	with the duplicate list. That is, the ref counts of the element
- *	objects will be incremented.
- *
- *----------------------------------------------------------------------
- */
-
-#define SetDuplicateObj(dupPtr, objPtr)					\
-    {									\
-	const Tcl_ObjType *typePtr = (objPtr)->typePtr;			\
-	const char *bytes = (objPtr)->bytes;				\
-	if (bytes) {							\
-	    TclInitStringRep((dupPtr), bytes, (objPtr)->length);	\
-	} else {							\
-	    (dupPtr)->bytes = NULL;					\
-	}								\
-	if (typePtr) {							\
-	    if (typePtr->dupIntRepProc) {				\
-		typePtr->dupIntRepProc((objPtr), (dupPtr));		\
-	    } else {							\
-		(dupPtr)->internalRep = (objPtr)->internalRep;		\
-		(dupPtr)->typePtr = typePtr;				\
-	    }								\
-	}								\
-    }
-
-Tcl_Obj *
-Tcl_DuplicateObj(
-    Tcl_Obj *objPtr)		/* The object to duplicate. */
-{
-    Tcl_Obj *dupPtr;
-
-    TclNewObj(dupPtr);
-    SetDuplicateObj(dupPtr, objPtr);
-    return dupPtr;
-}
-
-void
-TclSetDuplicateObj(
-    Tcl_Obj *dupPtr,
-    Tcl_Obj *objPtr)
-{
-    if (Tcl_IsShared(dupPtr)) {
-	Tcl_Panic("%s called with shared object", "TclSetDuplicateObj");
-    }
-    TclInvalidateStringRep(dupPtr);
-    TclFreeIntRep(dupPtr);
-    SetDuplicateObj(dupPtr, 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(
-    register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
-				 * be returned. */
-{
-    if (objPtr->bytes != NULL) {
-	return objPtr->bytes;
-    }
-
-    /*
-     * Note we do not check for objPtr->typePtr == NULL.  An invariant of
-     * a properly maintained Tcl_Obj is that at least  one of objPtr->bytes
-     * and objPtr->typePtr must not be NULL.  If broken extensions fail to
-     * maintain that invariant, we can crash here.
-     */
-
-    if (objPtr->typePtr->updateStringProc == NULL) {
-	/*
-	 * Those Tcl_ObjTypes which choose not to define an updateStringProc
-	 * 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);
-    }
-    objPtr->typePtr->updateStringProc(objPtr);
-    if (objPtr->bytes == NULL || objPtr->length < 0
-	    || objPtr->bytes[objPtr->length] != '\0') {
-	Tcl_Panic("UpdateStringProc for type '%s' "
-		"failed to create a valid string rep", objPtr->typePtr->name);
-    }
-    return objPtr->bytes;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetStringFromObj --
- *
- *	Returns the string representation's byte array pointer and length for
- *	an object.
- *
- * Results:
- *	Returns a pointer to the string representation of objPtr. If lengthPtr
- *	isn't NULL, the length of the string representation is stored at
- *	*lengthPtr. 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_GetStringFromObj(
-    register Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
-				 * be returned. */
-    register int *lengthPtr)	/* If non-NULL, the location where the string
-				 * rep's byte array length should * be stored.
-				 * If NULL, no length is stored. */
-{
-    (void) TclGetString(objPtr);
-
-    if (lengthPtr != NULL) {
-	*lengthPtr = objPtr->length;
-    }
-    return objPtr->bytes;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_InvalidateStringRep --
- *
- *	This function is called to invalidate an object's string
- *	representation.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Deallocates the storage for any old string representation, then sets
- *	the string representation NULL to mark it invalid.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_InvalidateStringRep(
-    register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
-				 * be freed. */
-{
-    TclInvalidateStringRep(objPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NewBooleanObj --
- *
- *	This function is normally called when not debugging: i.e., when
- *	TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
- *	initializes it from the argument boolean value. A nonzero "boolValue"
- *	is coerced to 1.
- *
- *	When TCL_MEM_DEBUG is defined, this function just returns the result
- *	of calling the debugging version Tcl_DbNewBooleanObj.
- *
- * Results:
- *	The newly created object is returned. This object will have an invalid
- *	string representation. The returned object has ref count 0.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_NewBooleanObj
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_NewBooleanObj(
-    register int boolValue)	/* Boolean used to initialize new object. */
-{
-    return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewBooleanObj(
-    register int boolValue)	/* Boolean used to initialize new object. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclNewBooleanObj(objPtr, boolValue);
-    return objPtr;
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewBooleanObj --
- *
- *	This function is normally called when debugging: i.e., when
- *	TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
- *	same as the Tcl_NewBooleanObj function above except that it calls
- *	Tcl_DbCkalloc directly with the file name and line number from its
- *	caller. This simplifies debugging since then the [memory active]
- *	command will report the correct file name and line number when
- *	reporting objects that haven't been freed.
- *
- *	When TCL_MEM_DEBUG is not defined, this function just returns the
- *	result of calling Tcl_NewBooleanObj.
- *
- * Results:
- *	The newly created object is returned. This object will have an invalid
- *	string representation. The returned object has ref count 0.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_DbNewBooleanObj
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewBooleanObj(
-    register int boolValue,	/* Boolean used to initialize new object. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclDbNewObj(objPtr, file, line);
-    objPtr->bytes = NULL;
-
-    objPtr->internalRep.longValue = (boolValue? 1 : 0);
-    objPtr->typePtr = &tclIntType;
-    return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewBooleanObj(
-    register int boolValue,	/* Boolean used to initialize new object. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-    return Tcl_NewBooleanObj(boolValue);
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetBooleanObj --
- *
- *	Modify an object to be a boolean object and to have the specified
- *	boolean value. A nonzero "boolValue" is coerced to 1.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old internal
- *	rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_SetBooleanObj
-void
-Tcl_SetBooleanObj(
-    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    register int boolValue)	/* Boolean used to set object's value. */
-{
-    if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
-    }
-
-    TclSetBooleanObj(objPtr, boolValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetBooleanFromObj --
- *
- *	Attempt to return a boolean from the Tcl object "objPtr". This
- *	includes conversion from any of Tcl's numeric types.
- *
- * Results:
- *	The return value is a standard Tcl object result. If an error occurs
- *	during conversion, an error message is left in the interpreter's
- *	result unless "interp" is NULL.
- *
- * Side effects:
- *	The intrep of *objPtr may be changed.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetBooleanFromObj(
-    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr,	/* The object from which to get boolean. */
-    register int *boolPtr)	/* Place to store resulting boolean. */
-{
-    do {
-	if (objPtr->typePtr == &tclIntType) {
-	    *boolPtr = (objPtr->internalRep.longValue != 0);
-	    return TCL_OK;
-	}
-	if (objPtr->typePtr == &tclBooleanType) {
-	    *boolPtr = (int) objPtr->internalRep.longValue;
-	    return TCL_OK;
-	}
-	if (objPtr->typePtr == &tclDoubleType) {
-	    /*
-	     * Caution: Don't be tempted to check directly for the "double"
-	     * Tcl_ObjType and then compare the intrep to 0.0. This isn't
-	     * reliable because a "double" Tcl_ObjType can hold the NaN value.
-	     * Use the API Tcl_GetDoubleFromObj, which does the checking and
-	     * sets the proper error message for us.
-	     */
-
-	    double d;
-
-	    if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    *boolPtr = (d != 0.0);
-	    return TCL_OK;
-	}
-	if (objPtr->typePtr == &tclBignumType) {
-	    *boolPtr = 1;
-	    return TCL_OK;
-	}
-#ifndef TCL_WIDE_INT_IS_LONG
-	if (objPtr->typePtr == &tclWideIntType) {
-	    *boolPtr = (objPtr->internalRep.wideValue != 0);
-	    return TCL_OK;
-	}
-#endif
-    } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
-	    TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetBooleanFromAny --
- *
- *	Attempt to generate a boolean internal form for the Tcl object
- *	"objPtr".
- *
- * Results:
- *	The return value is a standard Tcl result. If an error occurs during
- *	conversion, an error message is left in the interpreter's result
- *	unless "interp" is NULL.
- *
- * Side effects:
- *	If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
- *	representation and the type of "objPtr" is set to boolean.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclSetBooleanFromAny(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
-{
-    /*
-     * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
-     * whether a boolean conversion is possible without generating the string
-     * rep.
-     */
-
-    if (objPtr->bytes == NULL) {
-	if (objPtr->typePtr == &tclIntType) {
-	    switch (objPtr->internalRep.longValue) {
-	    case 0L: case 1L:
-		return TCL_OK;
-	    }
-	    goto badBoolean;
-	}
-
-	if (objPtr->typePtr == &tclBignumType) {
-	    goto badBoolean;
-	}
-
-#ifndef TCL_WIDE_INT_IS_LONG
-	if (objPtr->typePtr == &tclWideIntType) {
-	    goto badBoolean;
-	}
-#endif
-
-	if (objPtr->typePtr == &tclDoubleType) {
-	    goto badBoolean;
-	}
-    }
-
-    if (ParseBoolean(objPtr) == TCL_OK) {
-	return TCL_OK;
-    }
-
-  badBoolean:
-    if (interp != NULL) {
-	int length;
-	const char *str = Tcl_GetStringFromObj(objPtr, &length);
-	Tcl_Obj *msg;
-
-	TclNewLiteralStringObj(msg, "expected boolean value but got \"");
-	Tcl_AppendLimitedToObj(msg, str, length, 50, "");
-	Tcl_AppendToObj(msg, "\"", -1);
-	Tcl_SetObjResult(interp, msg);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
-    }
-    return TCL_ERROR;
-}
-
-static int
-ParseBoolean(
-    register Tcl_Obj *objPtr)	/* The object to parse/convert. */
-{
-    int i, length, newBool;
-    char lowerCase[6];
-    const char *str = TclGetStringFromObj(objPtr, &length);
-
-    if ((length == 0) || (length > 5)) {
-	/*
-         * Longest valid boolean string rep. is "false".
-         */
-
-	return TCL_ERROR;
-    }
-
-    switch (str[0]) {
-    case '0':
-	if (length == 1) {
-	    newBool = 0;
-	    goto numericBoolean;
-	}
-	return TCL_ERROR;
-    case '1':
-	if (length == 1) {
-	    newBool = 1;
-	    goto numericBoolean;
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * Force to lower case for case-insensitive detection. Filter out known
-     * invalid characters at the same time.
-     */
-
-    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':
-	    lowerCase[i] = c + (char) ('a' - 'A');
-	    break;
-	case 'a': case 'e': case 'f': case 'l': case 'n':
-	case 'o': case 'r': case 's': case 't': case 'u': case 'y':
-	    lowerCase[i] = c;
-	    break;
-	default:
-	    return TCL_ERROR;
-	}
-    }
-    lowerCase[length] = 0;
-    switch (lowerCase[0]) {
-    case 'y':
-	/*
-	 * Checking the 'y' is redundant, but makes the code clearer.
-	 */
-	if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
-	    newBool = 1;
-	    goto goodBoolean;
-	}
-	return TCL_ERROR;
-    case 'n':
-	if (strncmp(lowerCase, "no", (size_t) length) == 0) {
-	    newBool = 0;
-	    goto goodBoolean;
-	}
-	return TCL_ERROR;
-    case 't':
-	if (strncmp(lowerCase, "true", (size_t) length) == 0) {
-	    newBool = 1;
-	    goto goodBoolean;
-	}
-	return TCL_ERROR;
-    case 'f':
-	if (strncmp(lowerCase, "false", (size_t) length) == 0) {
-	    newBool = 0;
-	    goto goodBoolean;
-	}
-	return TCL_ERROR;
-    case 'o':
-	if (length < 2) {
-	    return TCL_ERROR;
-	}
-	if (strncmp(lowerCase, "on", (size_t) length) == 0) {
-	    newBool = 1;
-	    goto goodBoolean;
-	} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
-	    newBool = 0;
-	    goto goodBoolean;
-	}
-	return TCL_ERROR;
-    default:
-	return TCL_ERROR;
-    }
-
-    /*
-     * Free the old internalRep before setting the new one. We do this as late
-     * as possible to allow the conversion code, in particular
-     * Tcl_GetStringFromObj, to use that old internalRep.
-     */
-
-  goodBoolean:
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.longValue = newBool;
-    objPtr->typePtr = &tclBooleanType;
-    return TCL_OK;
-
-  numericBoolean:
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.longValue = newBool;
-    objPtr->typePtr = &tclIntType;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NewDoubleObj --
- *
- *	This function is normally called when not debugging: i.e., when
- *	TCL_MEM_DEBUG is not defined. It creates a new double object and
- *	initializes it from the argument double value.
- *
- *	When TCL_MEM_DEBUG is defined, this function just returns the result
- *	of calling the debugging version Tcl_DbNewDoubleObj.
- *
- * Results:
- *	The newly created object is returned. This object will have an
- *	invalid string representation. The returned object has ref count 0.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewDoubleObj
-
-Tcl_Obj *
-Tcl_NewDoubleObj(
-    register double dblValue)	/* Double used to initialize the object. */
-{
-    return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewDoubleObj(
-    register double dblValue)	/* Double used to initialize the object. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclNewDoubleObj(objPtr, dblValue);
-    return objPtr;
-}
-#endif /* if TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewDoubleObj --
- *
- *	This function is normally called when debugging: i.e., when
- *	TCL_MEM_DEBUG is defined. It creates new double objects. It is the
- *	same as the Tcl_NewDoubleObj function above except that it calls
- *	Tcl_DbCkalloc directly with the file name and line number from its
- *	caller. This simplifies debugging since then the [memory active]
- *	command will report the correct file name and line number when
- *	reporting objects that haven't been freed.
- *
- *	When TCL_MEM_DEBUG is not defined, this function just returns the
- *	result of calling Tcl_NewDoubleObj.
- *
- * Results:
- *	The newly created object is returned. This object will have an invalid
- *	string representation. The returned object has ref count 0.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewDoubleObj(
-    register double dblValue,	/* Double used to initialize the object. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclDbNewObj(objPtr, file, line);
-    objPtr->bytes = NULL;
-
-    objPtr->internalRep.doubleValue = dblValue;
-    objPtr->typePtr = &tclDoubleType;
-    return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewDoubleObj(
-    register double dblValue,	/* Double used to initialize the object. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-    return Tcl_NewDoubleObj(dblValue);
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetDoubleObj --
- *
- *	Modify an object to be a double object and to have the specified
- *	double value.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old internal
- *	rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetDoubleObj(
-    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    register double dblValue)	/* Double used to set the object's value. */
-{
-    if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj");
-    }
-
-    TclSetDoubleObj(objPtr, dblValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetDoubleFromObj --
- *
- *	Attempt to return a double from the Tcl object "objPtr". If the object
- *	is not already a double, an attempt will be made to convert it to one.
- *
- * Results:
- *	The return value is a standard Tcl object result. If an error occurs
- *	during conversion, an error message is left in the interpreter's
- *	result unless "interp" is NULL.
- *
- * Side effects:
- *	If the object is not already a double, the conversion will free any
- *	old internal representation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetDoubleFromObj(
-    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr,	/* The object from which to get a double. */
-    register double *dblPtr)	/* Place to store resulting double. */
-{
-    do {
-	if (objPtr->typePtr == &tclDoubleType) {
-	    if (TclIsNaN(objPtr->internalRep.doubleValue)) {
-		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;
-	    }
-	    *dblPtr = (double) objPtr->internalRep.doubleValue;
-	    return TCL_OK;
-	}
-	if (objPtr->typePtr == &tclIntType) {
-	    *dblPtr = objPtr->internalRep.longValue;
-	    return TCL_OK;
-	}
-	if (objPtr->typePtr == &tclBignumType) {
-	    mp_int big;
-
-	    UNPACK_BIGNUM(objPtr, big);
-	    *dblPtr = TclBignumToDouble(&big);
-	    return TCL_OK;
-	}
-#ifndef TCL_WIDE_INT_IS_LONG
-	if (objPtr->typePtr == &tclWideIntType) {
-	    *dblPtr = (double) objPtr->internalRep.wideValue;
-	    return TCL_OK;
-	}
-#endif
-    } while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetDoubleFromAny --
- *
- *	Attempt to generate an double-precision floating point internal form
- *	for the Tcl object "objPtr".
- *
- * Results:
- *	The return value is a standard Tcl object result. If an error occurs
- *	during conversion, an error message is left in the interpreter's
- *	result unless "interp" is NULL.
- *
- * Side effects:
- *	If no error occurs, a double is stored as "objPtr"s internal
- *	representation.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetDoubleFromAny(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
-{
-    return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1,
-	    NULL, 0);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfDouble --
- *
- *	Update the string representation for a double-precision floating point
- *	object. This must obey the current tcl_precision value for
- *	double-to-string conversions. Note: This function does not free an
- *	existing old string rep so storage will be lost if this has not
- *	already been done.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's string is set to a valid string that results from the
- *	double-to-string conversion.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfDouble(
-    register Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
-{
-    char buffer[TCL_DOUBLE_SPACE];
-    register int len;
-
-    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
-    len = strlen(buffer);
-
-    objPtr->bytes = ckalloc(len + 1);
-    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
-    objPtr->length = len;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NewIntObj --
- *
- *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *	Tcl_NewIntObj to create a new integer object end up calling the
- *	debugging function Tcl_DbNewLongObj instead.
- *
- *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
- *	calls to Tcl_NewIntObj result in a call to one of the two
- *	Tcl_NewIntObj implementations below. We provide two implementations so
- *	that the Tcl core can be compiled to do memory debugging of the core
- *	even if a client does not request it for itself.
- *
- *	Integer and long integer objects share the same "integer" type
- *	implementation. We store all integers as longs and Tcl_GetIntFromObj
- *	checks whether the current value of the long can be represented by an
- *	int.
- *
- * Results:
- *	The newly created object is returned. This object will have an invalid
- *	string representation. The returned object has ref count 0.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_NewIntObj
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_NewIntObj(
-    register int intValue)	/* Int used to initialize the new object. */
-{
-    return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewIntObj(
-    register int intValue)	/* Int used to initialize the new object. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclNewIntObj(objPtr, intValue);
-    return objPtr;
-}
-#endif /* if TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetIntObj --
- *
- *	Modify an object to be an integer and to have the specified integer
- *	value.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old internal
- *	rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-#undef Tcl_SetIntObj
-void
-Tcl_SetIntObj(
-    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    register int intValue)	/* Integer used to set object's value. */
-{
-    if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
-    }
-
-    TclSetIntObj(objPtr, intValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetIntFromObj --
- *
- *	Attempt to return an int from the Tcl object "objPtr". If the object
- *	is not already an int, an attempt will be made to convert it to one.
- *
- *	Integer and long integer objects share the same "integer" type
- *	implementation. We store all integers as longs and Tcl_GetIntFromObj
- *	checks whether the current value of the long can be represented by an
- *	int.
- *
- * Results:
- *	The return value is a standard Tcl object result. If an error occurs
- *	during conversion or if the long integer held by the object can not be
- *	represented by an int, an error message is left in the interpreter's
- *	result unless "interp" is NULL.
- *
- * Side effects:
- *	If the object is not already an int, the conversion will free any old
- *	internal representation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetIntFromObj(
-    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr,	/* The object from which to get a int. */
-    register int *intPtr)	/* Place to store resulting int. */
-{
-#if (LONG_MAX == INT_MAX)
-    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
-#else
-    long l;
-
-    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
-	if (interp != NULL) {
-	    const char *s =
-		    "integer value too large to represent as non-long integer";
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
-	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
-	}
-	return TCL_ERROR;
-    }
-    *intPtr = (int) l;
-    return TCL_OK;
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetIntFromAny --
- *
- *	Attempts to force the internal representation for a Tcl object to
- *	tclIntType, specifically.
- *
- * Results:
- *	The return value is a standard object Tcl result. If an error occurs
- *	during conversion, an error message is left in the interpreter's
- *	result unless "interp" is NULL.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetIntFromAny(
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
-{
-    long l;
-
-    return TclGetLongFromObj(interp, objPtr, &l);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfInt --
- *
- *	Update the string representation for an integer object. Note: This
- *	function does not free an existing old string rep so storage will be
- *	lost if this has not already been done.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's string is set to a valid string that results from the
- *	int-to-string conversion.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfInt(
-    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
-{
-    char buffer[TCL_INTEGER_SPACE];
-    register int len;
-
-    len = TclFormatInt(buffer, objPtr->internalRep.longValue);
-
-    objPtr->bytes = ckalloc(len + 1);
-    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
-    objPtr->length = len;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NewLongObj --
- *
- *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *	Tcl_NewLongObj to create a new long integer object end up calling the
- *	debugging function Tcl_DbNewLongObj instead.
- *
- *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
- *	calls to Tcl_NewLongObj result in a call to one of the two
- *	Tcl_NewLongObj implementations below. We provide two implementations
- *	so that the Tcl core can be compiled to do memory debugging of the
- *	core even if a client does not request it for itself.
- *
- *	Integer and long integer objects share the same "integer" type
- *	implementation. We store all integers as longs and Tcl_GetIntFromObj
- *	checks whether the current value of the long can be represented by an
- *	int.
- *
- * Results:
- *	The newly created object is returned. This object will have an invalid
- *	string representation. The returned object has ref count 0.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewLongObj
-
-Tcl_Obj *
-Tcl_NewLongObj(
-    register long longValue)	/* Long integer used to initialize the
-				 * new object. */
-{
-    return Tcl_DbNewLongObj(longValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewLongObj(
-    register long longValue)	/* Long integer used to initialize the
-				 * new object. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclNewLongObj(objPtr, longValue);
-    return objPtr;
-}
-#endif /* if TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewLongObj --
- *
- *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *	Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
- *	objects end up calling the debugging function Tcl_DbNewLongObj
- *	instead. We provide two implementations of Tcl_DbNewLongObj so that
- *	whether the Tcl core is compiled to do memory debugging of the core is
- *	independent of whether a client requests debugging for itself.
- *
- *	When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj
- *	calls Tcl_DbCkalloc directly with the file name and line number from
- *	its caller. This simplifies debugging since then the [memory active]
- *	command will report the caller's file name and line number when
- *	reporting objects that haven't been freed.
- *
- *	Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- *	this function just returns the result of calling Tcl_NewLongObj.
- *
- * Results:
- *	The newly created long integer object is returned. This object will
- *	have an invalid string representation. The returned object has ref
- *	count 0.
- *
- * Side effects:
- *	Allocates memory.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewLongObj(
-    register long longValue,	/* Long integer used to initialize the new
-				 * object. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclDbNewObj(objPtr, file, line);
-    objPtr->bytes = NULL;
-
-    objPtr->internalRep.longValue = longValue;
-    objPtr->typePtr = &tclIntType;
-    return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewLongObj(
-    register long longValue,	/* Long integer used to initialize the new
-				 * object. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-    return Tcl_NewLongObj(longValue);
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetLongObj --
- *
- *	Modify an object to be an integer object and to have the specified
- *	long integer value.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old internal
- *	rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetLongObj(
-    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    register long longValue)	/* Long integer used to initialize the
-				 * object's value. */
-{
-    if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
-    }
-
-    TclSetLongObj(objPtr, longValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetLongFromObj --
- *
- *	Attempt to return an long integer from the Tcl object "objPtr". If the
- *	object is not already an int object, an attempt will be made to
- *	convert it to one.
- *
- * Results:
- *	The return value is a standard Tcl object result. If an error occurs
- *	during conversion, an error message is left in the interpreter's
- *	result unless "interp" is NULL.
- *
- * Side effects:
- *	If the object is not already an int object, the conversion will free
- *	any old internal representation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetLongFromObj(
-    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr,	/* The object from which to get a long. */
-    register long *longPtr)	/* Place to store resulting long. */
-{
-    do {
-	if (objPtr->typePtr == &tclIntType) {
-	    *longPtr = objPtr->internalRep.longValue;
-	    return TCL_OK;
-	}
-#ifndef TCL_WIDE_INT_IS_LONG
-	if (objPtr->typePtr == &tclWideIntType) {
-	    /*
-	     * We return any integer in the range -ULONG_MAX to ULONG_MAX
-	     * converted to a long, ignoring overflow. The rule preserves
-	     * existing semantics for conversion of integers on input, but
-	     * avoids inadvertent demotion of wide integers to 32-bit ones in
-	     * the internal rep.
-	     */
-
-	    Tcl_WideInt w = objPtr->internalRep.wideValue;
-
-	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
-		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
-		*longPtr = Tcl_WideAsLong(w);
-		return TCL_OK;
-	    }
-	    goto tooLarge;
-	}
-#endif
-	if (objPtr->typePtr == &tclDoubleType) {
-	    if (interp != NULL) {
-                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        Tcl_GetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-	if (objPtr->typePtr == &tclBignumType) {
-	    /*
-	     * Must check for those bignum values that can fit in a long, even
-	     * when auto-narrowing is enabled. Only those values in the signed
-	     * long range get auto-narrowed to tclIntType, while all the
-	     * values in the unsigned long range will fit in a long.
-	     */
-
-	    mp_int big;
-
-	    UNPACK_BIGNUM(objPtr, big);
-	    if ((size_t) big.used <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
-		    / DIGIT_BIT) {
-		unsigned long value = 0, numBytes = sizeof(long);
-		long 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++;
-		    }
-		    if (big.sign) {
-			*longPtr = - (long) value;
-		    } else {
-			*longPtr = (long) value;
-		    }
-		    return TCL_OK;
-		}
-	    }
-#ifndef TCL_WIDE_INT_IS_LONG
-	tooLarge:
-#endif
-	    if (interp != NULL) {
-		const char *s = "integer value too large to represent";
-		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
-
-		Tcl_SetObjResult(interp, msg);
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
-	    }
-	    return TCL_ERROR;
-	}
-    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
-	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
-    return TCL_ERROR;
-}
-#ifndef TCL_WIDE_INT_IS_LONG
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfWideInt --
- *
- *	Update the string representation for a wide integer object. Note: this
- *	function does not free an existing old string rep so storage will be
- *	lost if this has not already been done.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's string is set to a valid string that results from the
- *	wideInt-to-string conversion.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfWideInt(
-    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
-{
-    char buffer[TCL_INTEGER_SPACE+2];
-    register unsigned len;
-    register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
-
-    /*
-     * Note that sprintf will generate a compiler warning under Mingw claiming
-     * %I64 is an unknown format specifier. Just ignore this warning. We can't
-     * use %L as the format specifier since that gets printed as a 32 bit
-     * value.
-     */
-
-    sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
-    len = strlen(buffer);
-    objPtr->bytes = ckalloc(len + 1);
-    memcpy(objPtr->bytes, buffer, len + 1);
-    objPtr->length = len;
-}
-#endif /* !TCL_WIDE_INT_IS_LONG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NewWideIntObj --
- *
- *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *	Tcl_NewWideIntObj to create a new 64-bit integer object end up calling
- *	the debugging function Tcl_DbNewWideIntObj instead.
- *
- *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
- *	calls to Tcl_NewWideIntObj result in a call to one of the two
- *	Tcl_NewWideIntObj implementations below. We provide two
- *	implementations so that the Tcl core can be compiled to do memory
- *	debugging of the core even if a client does not request it for itself.
- *
- * Results:
- *	The newly created object is returned. This object will have an invalid
- *	string representation. The returned object has ref count 0.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewWideIntObj
-
-Tcl_Obj *
-Tcl_NewWideIntObj(
-    register Tcl_WideInt wideValue)
-				/* Wide integer used to initialize the new
-				 * object. */
-{
-    return Tcl_DbNewWideIntObj(wideValue, "unknown", 0);
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_NewWideIntObj(
-    register Tcl_WideInt wideValue)
-				/* Wide integer used to initialize the new
-				 * object. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclNewObj(objPtr);
-    Tcl_SetWideIntObj(objPtr, wideValue);
-    return objPtr;
-}
-#endif /* if TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewWideIntObj --
- *
- *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
- *	Tcl_NewWideIntObj to create new wide integer end up calling the
- *	debugging function Tcl_DbNewWideIntObj instead. We provide two
- *	implementations of Tcl_DbNewWideIntObj so that whether the Tcl core is
- *	compiled to do memory debugging of the core is independent of whether
- *	a client requests debugging for itself.
- *
- *	When the core is compiled with TCL_MEM_DEBUG defined,
- *	Tcl_DbNewWideIntObj calls Tcl_DbCkalloc directly with the file name
- *	and line number from its caller. This simplifies debugging since then
- *	the checkmem command will report the caller's file name and line
- *	number when reporting objects that haven't been freed.
- *
- *	Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- *	this function just returns the result of calling Tcl_NewWideIntObj.
- *
- * Results:
- *	The newly created wide integer object is returned. This object will
- *	have an invalid string representation. The returned object has ref
- *	count 0.
- *
- * Side effects:
- *	Allocates memory.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-
-Tcl_Obj *
-Tcl_DbNewWideIntObj(
-    register Tcl_WideInt wideValue,
-				/* Wide integer used to initialize the new
-				 * object. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-    register Tcl_Obj *objPtr;
-
-    TclDbNewObj(objPtr, file, line);
-    Tcl_SetWideIntObj(objPtr, wideValue);
-    return objPtr;
-}
-
-#else /* if not TCL_MEM_DEBUG */
-
-Tcl_Obj *
-Tcl_DbNewWideIntObj(
-    register Tcl_WideInt wideValue,
-				/* Long integer used to initialize the new
-				 * object. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-    return Tcl_NewWideIntObj(wideValue);
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetWideIntObj --
- *
- *	Modify an object to be a wide integer object and to have the specified
- *	wide integer value.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's old string rep, if any, is freed. Also, any old internal
- *	rep is freed.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetWideIntObj(
-    register Tcl_Obj *objPtr,	/* Object w. internal rep to init. */
-    register Tcl_WideInt wideValue)
-				/* Wide integer used to initialize the
-				 * object's value. */
-{
-    if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
-    }
-
-    if ((wideValue >= (Tcl_WideInt) LONG_MIN)
-	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
-	TclSetLongObj(objPtr, (long) wideValue);
-    } else {
-#ifndef TCL_WIDE_INT_IS_LONG
-	TclSetWideIntObj(objPtr, wideValue);
-#else
-	mp_int big;
-
-	TclBNInitBignumFromWideInt(&big, wideValue);
-	Tcl_SetBignumObj(objPtr, &big);
-#endif
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetWideIntFromObj --
- *
- *	Attempt to return a wide integer from the Tcl object "objPtr". If the
- *	object is not already a wide int object, an attempt will be made to
- *	convert it to one.
- *
- * Results:
- *	The return value is a standard Tcl object result. If an error occurs
- *	during conversion, an error message is left in the interpreter's
- *	result unless "interp" is NULL.
- *
- * Side effects:
- *	If the object is not already an int object, the conversion will free
- *	any old internal representation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetWideIntFromObj(
-    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
-    register Tcl_WideInt *wideIntPtr)
-				/* Place to store resulting long. */
-{
-    do {
-#ifndef TCL_WIDE_INT_IS_LONG
-	if (objPtr->typePtr == &tclWideIntType) {
-	    *wideIntPtr = objPtr->internalRep.wideValue;
-	    return TCL_OK;
-	}
-#endif
-	if (objPtr->typePtr == &tclIntType) {
-	    *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
-	    return TCL_OK;
-	}
-	if (objPtr->typePtr == &tclDoubleType) {
-	    if (interp != NULL) {
-                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        Tcl_GetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-	if (objPtr->typePtr == &tclBignumType) {
-	    /*
-	     * Must check for those bignum values that can fit in a
-	     * Tcl_WideInt, even when auto-narrowing is enabled.
-	     */
-
-	    mp_int big;
-
-	    UNPACK_BIGNUM(objPtr, big);
-	    if ((size_t) big.used <= (CHAR_BIT * sizeof(Tcl_WideInt)
-		     + DIGIT_BIT - 1) / DIGIT_BIT) {
-		Tcl_WideUInt value = 0;
-		unsigned long numBytes = sizeof(Tcl_WideInt);
-		Tcl_WideInt 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++;
-		    }
-		    if (big.sign) {
-			*wideIntPtr = - (Tcl_WideInt) value;
-		    } else {
-			*wideIntPtr = (Tcl_WideInt) value;
-		    }
-		    return TCL_OK;
-		}
-	    }
-	    if (interp != NULL) {
-		const char *s = "integer value too large to represent";
-		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
-
-		Tcl_SetObjResult(interp, msg);
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
-	    }
-	    return TCL_ERROR;
-	}
-    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
-	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
-    return TCL_ERROR;
-}
-#ifndef TCL_WIDE_INT_IS_LONG
-
-/*
- *----------------------------------------------------------------------
- *
- * SetWideIntFromAny --
- *
- *	Attempts to force the internal representation for a Tcl object to
- *	tclWideIntType, specifically.
- *
- * Results:
- *	The return value is a standard object Tcl result. If an error occurs
- *	during conversion, an error message is left in the interpreter's
- *	result unless "interp" is NULL.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetWideIntFromAny(
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
-{
-    Tcl_WideInt w;
-    return Tcl_GetWideIntFromObj(interp, objPtr, &w);
-}
-#endif /* !TCL_WIDE_INT_IS_LONG */
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeBignum --
- *
- *	This function frees the internal rep of a bignum.
- *
- * Results:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeBignum(
-    Tcl_Obj *objPtr)
-{
-    mp_int toFree;		/* Bignum to free */
-
-    UNPACK_BIGNUM(objPtr, toFree);
-    mp_clear(&toFree);
-    if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
-	ckfree(objPtr->internalRep.twoPtrValue.ptr1);
-    }
-    objPtr->typePtr = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupBignum --
- *
- *	This function duplicates the internal rep of a bignum.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The destination object receies a copy of the source object
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupBignum(
-    Tcl_Obj *srcPtr,
-    Tcl_Obj *copyPtr)
-{
-    mp_int bignumVal;
-    mp_int bignumCopy;
-
-    copyPtr->typePtr = &tclBignumType;
-    UNPACK_BIGNUM(srcPtr, bignumVal);
-    if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
-	Tcl_Panic("initialization failure in DupBignum");
-    }
-    PACK_BIGNUM(bignumCopy, copyPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfBignum --
- *
- *	This function updates the string representation of a bignum object.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's string is set to whatever results from the bignum-
- *	to-string conversion.
- *
- * The object's existing string representation is NOT freed; memory will leak
- * if the string rep is still valid at the time this function is called.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfBignum(
-    Tcl_Obj *objPtr)
-{
-    mp_int bignumVal;
-    int size;
-    int status;
-    char *stringVal;
-
-    UNPACK_BIGNUM(objPtr, bignumVal);
-    status = mp_radix_size(&bignumVal, 10, &size);
-    if (status != MP_OKAY) {
-	Tcl_Panic("radix size failure in UpdateStringOfBignum");
-    }
-    if (size == 3) {
-	/*
-	 * mp_radix_size() returns 3 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.
-	 *
-	 * Note that so long as we enforce our bignums to the size that fits
-	 * in a packed bignum, this branch will never be taken.
-	 */
-
-	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
-    }
-    stringVal = ckalloc(size);
-    status = mp_toradix_n(&bignumVal, stringVal, 10, size);
-    if (status != MP_OKAY) {
-	Tcl_Panic("conversion failure in UpdateStringOfBignum");
-    }
-    objPtr->bytes = stringVal;
-    objPtr->length = size - 1;	/* size includes a trailing NUL byte. */
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NewBignumObj --
- *
- *	Creates an initializes a bignum object.
- *
- * Results:
- *	Returns the newly created object.
- *
- * Side effects:
- *	The bignum value is cleared, since ownership has transferred to Tcl.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-#undef Tcl_NewBignumObj
-
-Tcl_Obj *
-Tcl_NewBignumObj(
-    mp_int *bignumValue)
-{
-    return Tcl_DbNewBignumObj(bignumValue, "unknown", 0);
-}
-#else
-Tcl_Obj *
-Tcl_NewBignumObj(
-    mp_int *bignumValue)
-{
-    Tcl_Obj *objPtr;
-
-    TclNewObj(objPtr);
-    Tcl_SetBignumObj(objPtr, bignumValue);
-    return objPtr;
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbNewBignumObj --
- *
- *	This function is normally called when debugging: that is, when
- *	TCL_MEM_DEBUG is defined. It constructs a bignum object, recording the
- *	creation point so that [memory active] can report it.
- *
- * Results:
- *	Returns the newly created object.
- *
- * Side effects:
- *	The bignum value is cleared, since ownership has transferred to Tcl.
- *
- *----------------------------------------------------------------------
- */
-
-#ifdef TCL_MEM_DEBUG
-Tcl_Obj *
-Tcl_DbNewBignumObj(
-    mp_int *bignumValue,
-    const char *file,
-    int line)
-{
-    Tcl_Obj *objPtr;
-
-    TclDbNewObj(objPtr, file, line);
-    Tcl_SetBignumObj(objPtr, bignumValue);
-    return objPtr;
-}
-#else
-Tcl_Obj *
-Tcl_DbNewBignumObj(
-    mp_int *bignumValue,
-    const char *file,
-    int line)
-{
-    return Tcl_NewBignumObj(bignumValue);
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * GetBignumFromObj --
- *
- *	This function retrieves a 'bignum' value from a Tcl object, converting
- *	the object if necessary. Either copies or transfers the mp_int value
- *	depending on the copy flag value passed in.
- *
- * Results:
- *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
- *
- * Side effects:
- *	A copy of bignum is stored in *bignumValue, which is expected to be
- *	uninitialized or cleared. If conversion fails, and the 'interp'
- *	argument is not NULL, an error message is stored in the interpreter
- *	result.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GetBignumFromObj(
-    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
-    Tcl_Obj *objPtr,		/* Object to read */
-    int copy,			/* Whether to copy the returned bignum value */
-    mp_int *bignumValue)	/* Returned bignum value. */
-{
-    do {
-	if (objPtr->typePtr == &tclBignumType) {
-	    if (copy || Tcl_IsShared(objPtr)) {
-		mp_int temp;
-
-		UNPACK_BIGNUM(objPtr, temp);
-		mp_init_copy(bignumValue, &temp);
-	    } else {
-		UNPACK_BIGNUM(objPtr, *bignumValue);
-		objPtr->internalRep.twoPtrValue.ptr1 = NULL;
-		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-		objPtr->typePtr = NULL;
-		if (objPtr->bytes == NULL) {
-		    TclInitStringRep(objPtr, tclEmptyStringRep, 0);
-		}
-	    }
-	    return TCL_OK;
-	}
-	if (objPtr->typePtr == &tclIntType) {
-	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
-	    return TCL_OK;
-	}
-#ifndef TCL_WIDE_INT_IS_LONG
-	if (objPtr->typePtr == &tclWideIntType) {
-	    TclBNInitBignumFromWideInt(bignumValue,
-		    objPtr->internalRep.wideValue);
-	    return TCL_OK;
-	}
-#endif
-	if (objPtr->typePtr == &tclDoubleType) {
-	    if (interp != NULL) {
-                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        Tcl_GetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
-	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetBignumFromObj --
- *
- *	This function retrieves a 'bignum' value from a Tcl object, converting
- *	the object if necessary.
- *
- * Results:
- *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
- *
- * Side effects:
- *	A copy of bignum is stored in *bignumValue, which is expected to be
- *	uninitialized or cleared. If conversion fails, an the 'interp'
- *	argument is not NULL, an error message is stored in the interpreter
- *	result.
- *
- *	It is expected that the caller will NOT have invoked mp_init on the
- *	bignum value before passing it in. Tcl will initialize the mp_int as
- *	it sets the value. The value is a copy of the value in objPtr, so it
- *	becomes the responsibility of the caller to call mp_clear on it.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetBignumFromObj(
-    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
-    Tcl_Obj *objPtr,		/* Object to read */
-    mp_int *bignumValue)	/* Returned bignum value. */
-{
-    return GetBignumFromObj(interp, objPtr, 1, bignumValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_TakeBignumFromObj --
- *
- *	This function retrieves a 'bignum' value from a Tcl object, converting
- *	the object if necessary.
- *
- * Results:
- *	Returns TCL_OK if the conversion is successful, TCL_ERROR otherwise.
- *
- * Side effects:
- *	A copy of bignum is stored in *bignumValue, which is expected to be
- *	uninitialized or cleared. If conversion fails, an the 'interp'
- *	argument is not NULL, an error message is stored in the interpreter
- *	result.
- *
- *	It is expected that the caller will NOT have invoked mp_init on the
- *	bignum value before passing it in. Tcl will initialize the mp_int as
- *	it sets the value. The value is transferred from the internals of
- *	objPtr to the caller, passing responsibility of the caller to call
- *	mp_clear on it. The objPtr is cleared to hold an empty value.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_TakeBignumFromObj(
-    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
-    Tcl_Obj *objPtr,		/* Object to read */
-    mp_int *bignumValue)	/* Returned bignum value. */
-{
-    return GetBignumFromObj(interp, objPtr, 0, bignumValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetBignumObj --
- *
- *	This function sets the value of a Tcl_Obj to a large integer.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Object value is stored. The bignum value is cleared, since ownership
- *	has transferred to Tcl.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_SetBignumObj(
-    Tcl_Obj *objPtr,		/* Object to set */
-    mp_int *bignumValue)	/* Value to store */
-{
-    if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
-    }
-    if ((size_t) bignumValue->used
-	    <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) {
-	unsigned long value = 0, numBytes = sizeof(long);
-	long scratch;
-	unsigned char *bytes = (unsigned char *) &scratch;
-
-	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
-	    goto tooLargeForLong;
-	}
-	while (numBytes-- > 0) {
-	    value = (value << CHAR_BIT) | *bytes++;
-	}
-	if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) {
-	    goto tooLargeForLong;
-	}
-	if (bignumValue->sign) {
-	    TclSetLongObj(objPtr, -(long)value);
-	} else {
-	    TclSetLongObj(objPtr, (long)value);
-	}
-	mp_clear(bignumValue);
-	return;
-    }
-  tooLargeForLong:
-#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;
-	unsigned long numBytes = sizeof(Tcl_WideInt);
-	Tcl_WideInt scratch;
-	unsigned char *bytes = (unsigned char *)&scratch;
-
-	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
-	    goto tooLargeForWide;
-	}
-	while (numBytes-- > 0) {
-	    value = (value << CHAR_BIT) | *bytes++;
-	}
-	if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) {
-	    goto tooLargeForWide;
-	}
-	if (bignumValue->sign) {
-	    TclSetWideIntObj(objPtr, -(Tcl_WideInt)value);
-	} else {
-	    TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
-	}
-	mp_clear(bignumValue);
-	return;
-    }
-  tooLargeForWide:
-#endif
-    TclInvalidateStringRep(objPtr);
-    TclFreeIntRep(objPtr);
-    TclSetBignumIntRep(objPtr, bignumValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetBignumIntRep --
- *
- *	Install a bignum into the internal representation of an object.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Object internal representation is updated and object type is set. The
- *	bignum value is cleared, since ownership has transferred to the
- *	object.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSetBignumIntRep(
-    Tcl_Obj *objPtr,
-    mp_int *bignumValue)
-{
-    objPtr->typePtr = &tclBignumType;
-    PACK_BIGNUM(*bignumValue, objPtr);
-
-    /*
-     * Clear the mp_int value.
-     *
-     * Don't call mp_clear() because it would free the digit array we just
-     * packed into the Tcl_Obj.
-     */
-
-    bignumValue->dp = NULL;
-    bignumValue->alloc = bignumValue->used = 0;
-    bignumValue->sign = MP_NEG;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetNumberFromObj --
- *
- *      Extracts a number (of any possible numeric type) from an object.
- *
- * Results:
- *      Whether the extraction worked. The type is stored in the variable
- *      referred to by the typePtr argument, and a pointer to the
- *      representation is stored in the variable referred to by the
- *      clientDataPtr.
- *
- * Side effects:
- *      Can allocate thread-specific data for handling the copy-out space for
- *      bignums; this space is shared within a thread.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGetNumberFromObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr,
-    ClientData *clientDataPtr,
-    int *typePtr)
-{
-    do {
-	if (objPtr->typePtr == &tclDoubleType) {
-	    if (TclIsNaN(objPtr->internalRep.doubleValue)) {
-		*typePtr = TCL_NUMBER_NAN;
-	    } else {
-		*typePtr = TCL_NUMBER_DOUBLE;
-	    }
-	    *clientDataPtr = &objPtr->internalRep.doubleValue;
-	    return TCL_OK;
-	}
-	if (objPtr->typePtr == &tclIntType) {
-	    *typePtr = TCL_NUMBER_LONG;
-	    *clientDataPtr = &objPtr->internalRep.longValue;
-	    return TCL_OK;
-	}
-#ifndef TCL_WIDE_INT_IS_LONG
-	if (objPtr->typePtr == &tclWideIntType) {
-	    *typePtr = TCL_NUMBER_WIDE;
-	    *clientDataPtr = &objPtr->internalRep.wideValue;
-	    return TCL_OK;
-	}
-#endif
-	if (objPtr->typePtr == &tclBignumType) {
-	    static Tcl_ThreadDataKey bignumKey;
-	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
-		    (int) sizeof(mp_int));
-
-	    UNPACK_BIGNUM(objPtr, *bigPtr);
-	    *typePtr = TCL_NUMBER_BIG;
-	    *clientDataPtr = bigPtr;
-	    return TCL_OK;
-	}
-    } while (TCL_OK ==
-	    TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0));
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbIncrRefCount --
- *
- *	This function 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.
- *
- *	When TCL_MEM_DEBUG is not defined, this function just increments the
- *	reference count of the object.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's ref count is incremented.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DbIncrRefCount(
-    register Tcl_Obj *objPtr,	/* The object we are registering a reference
-				 * to. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-#ifdef TCL_MEM_DEBUG
-    if (objPtr->refCount == 0x61616161) {
-	fprintf(stderr, "file = %s, line = %d\n", file, line);
-	fflush(stderr);
-	Tcl_Panic("incrementing refCount of previously disposed object");
-    }
-
-# ifdef TCL_THREADS
-    /*
-     * Check to make sure that the Tcl_Obj was allocated by the current
-     * thread. Don't do this check when shutting down since thread local
-     * storage can be finalized before the last Tcl_Obj is freed.
-     */
-
-    if (!TclInExit()) {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-	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("Trying to %s of Tcl_Obj allocated in another thread",
-                    "incr ref count");
-	}
-    }
-# endif /* TCL_THREADS */
-#endif /* TCL_MEM_DEBUG */
-    ++(objPtr)->refCount;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbDecrRefCount --
- *
- *	This function 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 decrementing the ref count.
- *
- *	When TCL_MEM_DEBUG is not defined, this function just decrements the
- *	reference count of the object.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's ref count is incremented.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DbDecrRefCount(
-    register Tcl_Obj *objPtr,	/* The object we are releasing a reference
-				 * to. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-#ifdef TCL_MEM_DEBUG
-    if (objPtr->refCount == 0x61616161) {
-	fprintf(stderr, "file = %s, line = %d\n", file, line);
-	fflush(stderr);
-	Tcl_Panic("decrementing refCount of previously disposed object");
-    }
-
-# ifdef TCL_THREADS
-    /*
-     * Check to make sure that the Tcl_Obj was allocated by the current
-     * thread. Don't do this check when shutting down since thread local
-     * storage can be finalized before the last Tcl_Obj is freed.
-     */
-
-    if (!TclInExit()) {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-	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("Trying to %s of Tcl_Obj allocated in another thread",
-                    "decr ref count");
-	}
-    }
-# endif /* TCL_THREADS */
-#endif /* TCL_MEM_DEBUG */
-
-    if (objPtr->refCount-- <= 1) {
-	TclFreeObj(objPtr);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DbIsShared --
- *
- *	This function is normally called when debugging: i.e., when
- *	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 function just tests if the
- *	object has a ref count greater than one.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_DbIsShared(
-    register Tcl_Obj *objPtr,	/* The object to test for being shared. */
-    const char *file,		/* The name of the source file calling this
-				 * function; used for debugging. */
-    int line)			/* Line number in the source file; used for
-				 * debugging. */
-{
-#ifdef TCL_MEM_DEBUG
-    if (objPtr->refCount == 0x61616161) {
-	fprintf(stderr, "file = %s, line = %d\n", file, line);
-	fflush(stderr);
-	Tcl_Panic("checking whether previously disposed object is shared");
-    }
-
-# ifdef TCL_THREADS
-    /*
-     * Check to make sure that the Tcl_Obj was allocated by the current
-     * thread. Don't do this check when shutting down since thread local
-     * storage can be finalized before the last Tcl_Obj is freed.
-     */
-
-    if (!TclInExit()) {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-	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("Trying to %s of Tcl_Obj allocated in another thread",
-                    "check shared status");
-	}
-    }
-# endif /* TCL_THREADS */
-#endif /* TCL_MEM_DEBUG */
-
-#ifdef TCL_COMPILE_STATS
-    Tcl_MutexLock(&tclObjMutex);
-    if ((objPtr)->refCount <= 1) {
-	tclObjsShared[1]++;
-    } else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) {
-	tclObjsShared[(objPtr)->refCount]++;
-    } else {
-	tclObjsShared[0]++;
-    }
-    Tcl_MutexUnlock(&tclObjMutex);
-#endif /* TCL_COMPILE_STATS */
-
-    return ((objPtr)->refCount > 1);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_InitObjHashTable --
- *
- *	Given storage for a hash table, set up the fields to prepare the hash
- *	table for use, the keys are Tcl_Obj *.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
- *	Tcl_CreateHashEntry.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_InitObjHashTable(
-    register Tcl_HashTable *tablePtr)
-				/* Pointer to table record, which is supplied
-				 * by the caller. */
-{
-    Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS,
-	    &tclObjHashKeyType);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AllocObjEntry --
- *
- *	Allocate space for a Tcl_HashEntry containing the Tcl_Obj * key.
- *
- * Results:
- *	The return value is a pointer to the created entry.
- *
- * Side effects:
- *	Increments the reference count on the object.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_HashEntry *
-AllocObjEntry(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key to store in the hash table entry. */
-{
-    Tcl_Obj *objPtr = keyPtr;
-    Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));
-
-    hPtr->key.objPtr = objPtr;
-    Tcl_IncrRefCount(objPtr);
-    hPtr->clientData = NULL;
-
-    return hPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompareObjKeys --
- *
- *	Compares two Tcl_Obj * keys.
- *
- * Results:
- *	The return value is 0 if they are different and 1 if they are the
- *	same.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompareObjKeys(
-    void *keyPtr,		/* New key to compare. */
-    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
-{
-    Tcl_Obj *objPtr1 = keyPtr;
-    Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
-    register const char *p1, *p2;
-    register int l1, l2;
-
-    /*
-     * If the object pointers are the same then they match.
-     * OPT: this comparison was moved to the caller
-
-       if (objPtr1 == objPtr2) return 1;
-    */
-
-    /*
-     * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being
-     * in a register.
-     */
-
-    p1 = TclGetString(objPtr1);
-    l1 = objPtr1->length;
-    p2 = TclGetString(objPtr2);
-    l2 = objPtr2->length;
-
-    /*
-     * Only compare if the string representations are of the same length.
-     */
-
-    if (l1 == l2) {
-	for (;; p1++, p2++, l1--) {
-	    if (*p1 != *p2) {
-		break;
-	    }
-	    if (l1 == 0) {
-		return 1;
-	    }
-	}
-    }
-
-    return 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFreeObjEntry --
- *
- *	Frees space for a Tcl_HashEntry containing the Tcl_Obj * key.
- *
- * Results:
- *	The return value is a pointer to the created entry.
- *
- * Side effects:
- *	Decrements the reference count of the object.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclFreeObjEntry(
-    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
-{
-    Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
-
-    Tcl_DecrRefCount(objPtr);
-    ckfree(hPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclHashObjKey --
- *
- *	Compute a one-word summary of the string representation of the
- *	Tcl_Obj, which can be used to generate a hash index.
- *
- * Results:
- *	The return value is a one-word summary of the information in the
- *	string representation of the Tcl_Obj.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-unsigned int
-TclHashObjKey(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key from which to compute hash value. */
-{
-    Tcl_Obj *objPtr = keyPtr;
-    int length;
-    const char *string = TclGetStringFromObj(objPtr, &length);
-    unsigned int result = 0;
-
-    /*
-     * I tried a zillion different hash functions and asked many other people
-     * for advice. Many people had their own favorite functions, all
-     * different, but no-one had much idea why they were good ones. I chose
-     * the one below (multiply by 9 and add new character) because of the
-     * following reasons:
-     *
-     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
-     *    multiplying by 9 is just about as good.
-     * 2. Times-9 is (shift-left-3) plus (old). This means that each
-     *    character's bits hang around in the low-order bits of the hash value
-     *    for ever, plus they spread fairly rapidly up to the high-order bits
-     *    to fill out the hash value. This seems works well both for decimal
-     *    and non-decimal strings.
-     *
-     * Note that this function is very weak against malicious strings; it's
-     * very easy to generate multiple keys that have the same hashcode. On the
-     * other hand, that hardly ever actually occurs and this function *is*
-     * very cheap, even by comparison with industry-standard hashes like FNV.
-     * If real strength of hash is required though, use a custom hash based on
-     * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
-     * Tcl does not use that level of strength because it typically does not
-     * need it (and some of the aspects of that strength are genuinely
-     * unnecessary given the rest of Tcl's hash machinery, and the fact that
-     * we do not either transfer hashes to another machine, use them as a true
-     * substitute for equality, or attempt to minimize work in rebuilding the
-     * hash table).
-     *
-     * See also HashStringKey in tclHash.c.
-     * See also HashString in tclLiteral.c.
-     *
-     * See [tcl-Feature Request #2958832]
-     */
-
-    if (length > 0) {
-	result = UCHAR(*string);
-	while (--length) {
-	    result += (result << 3) + UCHAR(*++string);
-	}
-    }
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetCommandFromObj --
- *
- *	Returns the command specified by the name in a Tcl_Obj.
- *
- * Results:
- *	Returns a token for the command if it is found. Otherwise, if it can't
- *	be found or there is an error, returns NULL.
- *
- * Side effects:
- *	May update the internal representation for the object, caching the
- *	command reference so that the next time this function is called with
- *	the same object, the command can be found quickly.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Command
-Tcl_GetCommandFromObj(
-    Tcl_Interp *interp,		/* The interpreter in which to resolve the
-				 * command and to report errors. */
-    register Tcl_Obj *objPtr)	/* The object containing the command's name.
-				 * If the name starts with "::", will be
-				 * looked up in global namespace. Else, looked
-				 * up first in the current namespace, then in
-				 * global namespace. */
-{
-    register ResolvedCmdName *resPtr;
-
-    /*
-     * Get the internal representation, converting to a command type if
-     * needed. The internal representation is a ResolvedCmdName that points to
-     * the actual command.
-     *
-     * Check the context namespace and the namespace epoch of the resolved
-     * symbol to make sure that it is fresh. Note that we verify that the
-     * namespace id of the context namespace is the same as the one we cached;
-     * this insures that the namespace wasn't deleted and a new one created at
-     * the same address with the same command epoch. Note that fully qualified
-     * names have a NULL refNsPtr, these checks needn't be made.
-     *
-     * Check also that the command's epoch is up to date, and that the command
-     * is not deleted.
-     *
-     * If any check fails, then force another conversion to the command type,
-     * to discard the old rep and create a new one.
-     */
-
-    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
-        register Command *cmdPtr = resPtr->cmdPtr;
-
-        if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
-                && !(cmdPtr->flags & CMD_IS_DELETED)
-                && (interp == cmdPtr->nsPtr->interp)
-                && !(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;
-            }
-        }
-    }
-
-    /*
-     * OK, must create a new internal representation (or fail) as any cache we
-     * had is invalid one way or another.
-     */
-
-    /* See [] why we cannot call SetCmdNameFromAny() directly here. */
-    if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
-        return NULL;
-    }
-    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetCmdNameObj --
- *
- *	Modify an object to be an CmdName object that refers to the argument
- *	Command structure.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The object's old internal rep is freed. It's string rep is not
- *	changed. The refcount in the Command structure is incremented to keep
- *	it from being freed if the command is later deleted until
- *	TclNRExecuteByteCode has a chance to recognize that it was deleted.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSetCmdNameObj(
-    Tcl_Interp *interp,		/* Points to interpreter containing command
-				 * that should be cached in objPtr. */
-    register Tcl_Obj *objPtr,	/* Points to Tcl object to be changed to a
-				 * CmdName object. */
-    Command *cmdPtr)		/* Points to Command structure that the
-				 * CmdName object should refer to. */
-{
-    Interp *iPtr = (Interp *) interp;
-    register ResolvedCmdName *resPtr;
-    register Namespace *currNsPtr;
-    const char *name;
-
-    if (objPtr->typePtr == &tclCmdNameType) {
-	return;
-    }
-
-    cmdPtr->refCount++;
-    resPtr = ckalloc(sizeof(ResolvedCmdName));
-    resPtr->cmdPtr = cmdPtr;
-    resPtr->cmdEpoch = cmdPtr->cmdEpoch;
-    resPtr->refCount = 1;
-
-    name = TclGetString(objPtr);
-    if ((*name++ == ':') && (*name == ':')) {
-	/*
-	 * The name is fully qualified: set the referring namespace to
-	 * NULL.
-	 */
-
-	resPtr->refNsPtr = NULL;
-    } else {
-	/*
-	 * Get the current namespace.
-	 */
-
-	currNsPtr = iPtr->varFramePtr->nsPtr;
-
-	resPtr->refNsPtr = currNsPtr;
-	resPtr->refNsId = currNsPtr->nsId;
-	resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
-    }
-
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    objPtr->typePtr = &tclCmdNameType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeCmdNameInternalRep --
- *
- *	Frees the resources associated with a cmdName object's internal
- *	representation.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Decrements the ref count of any cached ResolvedCmdName structure
- *	pointed to by the cmdName's internal representation. If this is the
- *	last use of the ResolvedCmdName, it is freed. This in turn decrements
- *	the ref count of the Command structure pointed to by the
- *	ResolvedSymbol, which may free the Command structure.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeCmdNameInternalRep(
-    register Tcl_Obj *objPtr)	/* CmdName object with internal
-				 * representation to free. */
-{
-    register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
-    if (resPtr != NULL) {
-	/*
-	 * Decrement the reference count of the ResolvedCmdName structure. If
-	 * there are no more uses, free the ResolvedCmdName structure.
-	 */
-
-	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
-	     * objects.
-	     */
-
-	    Command *cmdPtr = resPtr->cmdPtr;
-
-	    TclCleanupCommandMacro(cmdPtr);
-	    ckfree(resPtr);
-	}
-    }
-    objPtr->typePtr = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupCmdNameInternalRep --
- *
- *	Initialize the internal representation of an cmdName Tcl_Obj to a copy
- *	of the internal representation of an existing cmdName object.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	"copyPtr"s internal rep is set to point to the ResolvedCmdName
- *	structure corresponding to "srcPtr"s internal rep. Increments the ref
- *	count of the ResolvedCmdName structure pointed to by the cmdName's
- *	internal representation.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupCmdNameInternalRep(
-    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
-    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
-{
-    register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-
-    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
-    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    if (resPtr != NULL) {
-	resPtr->refCount++;
-    }
-    copyPtr->typePtr = &tclCmdNameType;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetCmdNameFromAny --
- *
- *	Generate an cmdName internal form for the Tcl object "objPtr".
- *
- * Results:
- *	The return value is a standard Tcl result. The conversion always
- *	succeeds and TCL_OK is returned.
- *
- * Side effects:
- *	A pointer to a ResolvedCmdName structure that holds a cached pointer
- *	to the command with a name that matches objPtr's string rep is stored
- *	as objPtr's internal representation. This ResolvedCmdName pointer will
- *	be NULL if no matching command was found. The ref count of the cached
- *	Command's structure (if any) is also incremented.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetCmdNameFromAny(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
-{
-    Interp *iPtr = (Interp *) interp;
-    const char *name;
-    register Command *cmdPtr;
-    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
-     * Command, and bump the reference count in the referenced Command
-     * structure. A Command structure will not be deleted as long as it is
-     * referenced from a CmdName object.
-     */
-
-    name = TclGetString(objPtr);
-    cmdPtr = (Command *)
-	    Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
-
-    /*
-     * Free the old internalRep before setting the new one. Do this after
-     * getting the string rep to allow the conversion code (in particular,
-     * Tcl_GetStringFromObj) to use that old internalRep.
-     */
-
-    if (cmdPtr) {
-	cmdPtr->refCount++;
-	resPtr = objPtr->internalRep.twoPtrValue.ptr1;
-	if ((objPtr->typePtr == &tclCmdNameType)
-		&& resPtr && (resPtr->refCount == 1)) {
-	    /*
-	     * Reuse the old ResolvedCmdName struct instead of freeing it
-	     */
-
-	    Command *oldCmdPtr = resPtr->cmdPtr;
-
-	    if (--oldCmdPtr->refCount == 0) {
-		TclCleanupCommandMacro(oldCmdPtr);
-	    }
-	} else {
-	    TclFreeIntRep(objPtr);
-	    resPtr = ckalloc(sizeof(ResolvedCmdName));
-	    resPtr->refCount = 1;
-	    objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
-	    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	    objPtr->typePtr = &tclCmdNameType;
-	}
-	resPtr->cmdPtr = cmdPtr;
-	resPtr->cmdEpoch = cmdPtr->cmdEpoch;
-	if ((*name++ == ':') && (*name == ':')) {
-	    /*
-	     * The name is fully qualified: set the referring namespace to
-	     * NULL.
-	     */
-
-	    resPtr->refNsPtr = NULL;
-	} else {
-	    /*
-	     * Get the current namespace.
-	     */
-
-	    currNsPtr = iPtr->varFramePtr->nsPtr;
-
-	    resPtr->refNsPtr = currNsPtr;
-	    resPtr->refNsId = currNsPtr->nsId;
-	    resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
-	}
-    } else {
-	TclFreeIntRep(objPtr);
-	objPtr->internalRep.twoPtrValue.ptr1 = NULL;
-	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	objPtr->typePtr = &tclCmdNameType;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_RepresentationCmd --
- *
- *	Implementation of the "tcl::unsupported::representation" command.
- *
- * Results:
- *	Reports the current representation (Tcl_Obj type) of its argument.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_RepresentationCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    char ptrBuffer[2*TCL_INTEGER_SPACE+6];
-    Tcl_Obj *descObj;
-
-    if (objc != 2) {
-	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"
-     */
-
-    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(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) {
-        Tcl_AppendToObj(descObj, ", string representation \"", -1);
-	Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
-                16, "...");
-	Tcl_AppendToObj(descObj, "\"", -1);
-    } else {
-	Tcl_AppendToObj(descObj, ", no string representation", -1);
-    }
-
-    Tcl_SetObjResult(interp, descObj);
-    return TCL_OK;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
- * End:
- */