summaryrefslogtreecommitdiffstats
path: root/generic/tclLiteral.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclLiteral.c')
-rw-r--r--generic/tclLiteral.c855
1 files changed, 453 insertions, 402 deletions
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 0c88303..2c91b82 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -1,76 +1,74 @@
-/*
+/*
* tclLiteral.c --
*
- * Implementation of the global and ByteCode-local literal tables
- * used to manage the Tcl objects created for literal values during
- * compilation of Tcl scripts. This implementation borrows heavily
- * from the more general hashtable implementation of Tcl hash tables
- * that appears in tclHash.c.
+ * Implementation of the global and ByteCode-local literal tables used to
+ * manage the Tcl objects created for literal values during compilation
+ * of Tcl scripts. This implementation borrows heavily from the more
+ * general hashtable implementation of Tcl hash tables that appears in
+ * tclHash.c.
*
* Copyright (c) 1997-1998 Sun Microsystems, Inc.
+ * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * 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 "tclCompile.h"
-#include "tclPort.h"
+
/*
- * When there are this many entries per bucket, on average, rebuild
- * a literal's hash table to make it larger.
+ * When there are this many entries per bucket, on average, rebuild a
+ * literal's hash table to make it larger.
*/
#define REBUILD_MULTIPLIER 3
/*
- * Procedure prototypes for static procedures in this file:
+ * Function prototypes for static functions in this file:
*/
-static int AddLocalLiteralEntry _ANSI_ARGS_((
- CompileEnv *envPtr, LiteralEntry *globalPtr,
- int localHash));
-static void ExpandLocalLiteralArray _ANSI_ARGS_((
- CompileEnv *envPtr));
-static unsigned int HashString _ANSI_ARGS_((CONST char *bytes,
- int length));
-static void RebuildLiteralTable _ANSI_ARGS_((
- LiteralTable *tablePtr));
+static int AddLocalLiteralEntry(CompileEnv *envPtr,
+ Tcl_Obj *objPtr, int localHash);
+static void ExpandLocalLiteralArray(CompileEnv *envPtr);
+static unsigned int HashString(const char *bytes, int length);
+static void RebuildLiteralTable(LiteralTable *tablePtr);
/*
*----------------------------------------------------------------------
*
* TclInitLiteralTable --
*
- * This procedure is called to initialize the fields of a literal table
+ * This function is called to initialize the fields of a literal table
* structure for either an interpreter or a compilation's CompileEnv
* structure.
*
* Results:
* None.
*
- * Side effects:
+ * Side effects:
* The literal table is made ready for use.
*
*----------------------------------------------------------------------
*/
void
-TclInitLiteralTable(tablePtr)
- register LiteralTable *tablePtr; /* Pointer to table structure, which
- * is supplied by the caller. */
+TclInitLiteralTable(
+ register LiteralTable *tablePtr)
+ /* Pointer to table structure, which is
+ * supplied by the caller. */
{
-#if (TCL_SMALL_HASH_TABLE != 4)
- panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
+#if (TCL_SMALL_HASH_TABLE != 4)
+ Tcl_Panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4",
TCL_SMALL_HASH_TABLE);
#endif
-
+
tablePtr->buckets = tablePtr->staticBuckets;
tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
tablePtr->numEntries = 0;
- tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
+ tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE * REBUILD_MULTIPLIER;
tablePtr->mask = 3;
}
@@ -79,49 +77,58 @@ TclInitLiteralTable(tablePtr)
*
* TclDeleteLiteralTable --
*
- * This procedure frees up everything associated with a literal table
- * except for the table's structure itself.
+ * This function frees up everything associated with a literal table
+ * except for the table's structure itself. It is called when the
+ * interpreter is deleted.
*
* Results:
* None.
*
* Side effects:
- * Each literal in the table is released: i.e., its reference count
- * in the global literal table is decremented and, if it becomes zero,
- * the literal is freed. In addition, the table's bucket array is
- * freed.
+ * Each literal in the table is released: i.e., its reference count in
+ * the global literal table is decremented and, if it becomes zero, the
+ * literal is freed. In addition, the table's bucket array is freed.
*
*----------------------------------------------------------------------
*/
void
-TclDeleteLiteralTable(interp, tablePtr)
- Tcl_Interp *interp; /* Interpreter containing shared literals
+TclDeleteLiteralTable(
+ Tcl_Interp *interp, /* Interpreter containing shared literals
* referenced by the table to delete. */
- LiteralTable *tablePtr; /* Points to the literal table to delete. */
+ LiteralTable *tablePtr) /* Points to the literal table to delete. */
{
- LiteralEntry *entryPtr;
- int i, start;
+ LiteralEntry *entryPtr, *nextPtr;
+ Tcl_Obj *objPtr;
+ int i;
/*
- * Release remaining literals in the table. Note that releasing a
- * literal might release other literals, modifying the table, so we
- * restart the search from the bucket chain we last found an entry.
+ * Release remaining literals in the table. Note that releasing a literal
+ * might release other literals, modifying the table, so we restart the
+ * search from the bucket chain we last found an entry.
*/
#ifdef TCL_COMPILE_DEBUG
TclVerifyGlobalLiteralTable((Interp *) interp);
#endif /*TCL_COMPILE_DEBUG*/
- start = 0;
- while (tablePtr->numEntries > 0) {
- for (i = start; i < tablePtr->numBuckets; i++) {
- entryPtr = tablePtr->buckets[i];
- if (entryPtr != NULL) {
- TclReleaseLiteral(interp, entryPtr->objPtr);
- start = i;
- break;
- }
+ /*
+ * We used to call TclReleaseLiteral for each literal in the table, which
+ * is rather inefficient as it causes one lookup-by-hash for each
+ * reference to the literal. We now rely at interp-deletion on each
+ * bytecode object to release its references to the literal Tcl_Obj
+ * without requiring that it updates the global table itself, and deal
+ * here only with the table.
+ */
+
+ for (i=0 ; i<tablePtr->numBuckets ; i++) {
+ entryPtr = tablePtr->buckets[i];
+ while (entryPtr != NULL) {
+ objPtr = entryPtr->objPtr;
+ TclDecrRefCount(objPtr);
+ nextPtr = entryPtr->nextPtr;
+ ckfree((char *) entryPtr);
+ entryPtr = nextPtr;
}
}
@@ -137,199 +144,266 @@ TclDeleteLiteralTable(interp, tablePtr)
/*
*----------------------------------------------------------------------
*
- * TclRegisterLiteral --
+ * TclCreateLiteral --
*
- * Find, or if necessary create, an object in a CompileEnv literal
- * array that has a string representation matching the argument string.
+ * Find, or if necessary create, an object in the interpreter's literal
+ * table that has a string representation matching the argument
+ * string. If nsPtr!=NULL then only literals stored for the namespace are
+ * considered.
*
* Results:
- * The index in the CompileEnv's literal array that references a
- * shared literal matching the string. The object is created if
- * necessary.
+ * The literal object. If it was created in this call *newPtr is set to
+ * 1, else 0. NULL is returned if newPtr==NULL and no literal is found.
*
* Side effects:
- * To maximize sharing, we look up the string in the interpreter's
- * global literal table. If not found, we create a new shared literal
- * in the global table. We then add a reference to the shared
- * literal in the CompileEnv's literal array.
- *
- * If onHeap is 1, this procedure is given ownership of the string: if
- * an object is created then its string representation is set directly
- * from string, otherwise the string is freed. Typically, a caller sets
- * onHeap 1 if "string" is an already heap-allocated buffer holding the
- * result of backslash substitutions.
+ * Increments the ref count of the global LiteralEntry since the caller
+ * now holds a reference.
+ * If LITERAL_ON_HEAP is set in flags, this function is given ownership
+ * of the string: if an object is created then its string representation
+ * is set directly from string, otherwise the string is freed. Typically,
+ * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
+ * buffer holding the result of backslash substitutions.
*
*----------------------------------------------------------------------
*/
-int
-TclRegisterLiteral(envPtr, bytes, length, onHeap)
- CompileEnv *envPtr; /* Points to the CompileEnv in whose object
- * array an object is found or created. */
- register char *bytes; /* Points to string for which to find or
- * create an object in CompileEnv's object
- * array. */
- int length; /* Number of bytes in the string. If < 0,
- * the string consists of all bytes up to
- * the first null character. */
- int onHeap; /* If 1 then the caller already malloc'd
- * bytes and ownership is passed to this
- * procedure. */
+Tcl_Obj *
+TclCreateLiteral(
+ Interp *iPtr,
+ char *bytes,
+ int length,
+ unsigned int hash, /* The string's hash. If -1, it will be computed here */
+ int *newPtr,
+ Namespace *nsPtr,
+ int flags,
+ LiteralEntry **globalPtrPtr)
{
- Interp *iPtr = envPtr->iPtr;
LiteralTable *globalTablePtr = &(iPtr->literalTable);
- LiteralTable *localTablePtr = &(envPtr->localLitTable);
- register LiteralEntry *globalPtr, *localPtr;
- register Tcl_Obj *objPtr;
- unsigned int hash;
- int localHash, globalHash, objIndex;
- long n;
- char buf[TCL_INTEGER_SPACE];
-
- if (length < 0) {
- length = (bytes? strlen(bytes) : 0);
- }
- hash = HashString(bytes, length);
-
+ LiteralEntry *globalPtr;
+ int globalHash;
+ Tcl_Obj *objPtr;
+
/*
- * Is the literal already in the CompileEnv's local literal array?
- * If so, just return its index.
+ * Is it in the interpreter's global literal table?
*/
- localHash = (hash & localTablePtr->mask);
- for (localPtr = localTablePtr->buckets[localHash];
- localPtr != NULL; localPtr = localPtr->nextPtr) {
- objPtr = localPtr->objPtr;
- if ((objPtr->length == length) && ((length == 0)
- || ((objPtr->bytes[0] == bytes[0])
- && (memcmp(objPtr->bytes, bytes, (unsigned) length)
- == 0)))) {
- if (onHeap) {
- ckfree(bytes);
- }
- objIndex = (localPtr - envPtr->literalArrayPtr);
-#ifdef TCL_COMPILE_DEBUG
- TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
-
- return objIndex;
- }
+ if (hash == (unsigned int) -1) {
+ hash = HashString(bytes, length);
}
-
- /*
- * The literal is new to this CompileEnv. Is it in the interpreter's
- * global literal table?
- */
-
globalHash = (hash & globalTablePtr->mask);
- for (globalPtr = globalTablePtr->buckets[globalHash];
- globalPtr != NULL; globalPtr = globalPtr->nextPtr) {
+ for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
+ globalPtr = globalPtr->nextPtr) {
objPtr = globalPtr->objPtr;
- if ((objPtr->length == length) && ((length == 0)
+ if ((globalPtr->nsPtr == nsPtr)
+ && (objPtr->length == length) && ((length == 0)
|| ((objPtr->bytes[0] == bytes[0])
- && (memcmp(objPtr->bytes, bytes, (unsigned) length)
- == 0)))) {
+ && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
/*
- * A global literal was found. Add an entry to the CompileEnv's
- * local literal array.
+ * A literal was found: return it
*/
-
- if (onHeap) {
- ckfree(bytes);
+
+ if (newPtr) {
+ *newPtr = 0;
}
- objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
-#ifdef TCL_COMPILE_DEBUG
- if (globalPtr->refCount < 1) {
- panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
- (length>60? 60 : length), bytes,
- globalPtr->refCount);
+ if (globalPtrPtr) {
+ *globalPtrPtr = globalPtr;
}
- TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
- return objIndex;
+ if (flags & LITERAL_ON_HEAP) {
+ ckfree(bytes);
+ }
+ globalPtr->refCount++;
+ return objPtr;
+ }
+ }
+ if (!newPtr) {
+ if (flags & LITERAL_ON_HEAP) {
+ ckfree(bytes);
}
+ return NULL;
}
/*
* The literal is new to the interpreter. Add it to the global literal
- * table then add an entry to the CompileEnv's local literal array.
- * Convert the object to an integer object if possible.
+ * table.
*/
TclNewObj(objPtr);
Tcl_IncrRefCount(objPtr);
- if (onHeap) {
+ if (flags & LITERAL_ON_HEAP) {
objPtr->bytes = bytes;
objPtr->length = length;
} else {
TclInitStringRep(objPtr, bytes, length);
}
- if (TclLooksLikeInt(bytes, length)) {
- /*
- * From here we use the objPtr, because it is NULL terminated
- */
- if (TclGetLong((Tcl_Interp *) NULL, objPtr->bytes, &n) == TCL_OK) {
- TclFormatInt(buf, n);
- if (strcmp(objPtr->bytes, buf) == 0) {
- objPtr->internalRep.longValue = n;
- objPtr->typePtr = &tclIntType;
- }
- }
- }
-
#ifdef TCL_COMPILE_DEBUG
if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
- panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
- (length>60? 60 : length), bytes);
+ Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
+ (length>60? 60 : length), bytes);
}
#endif
globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
globalPtr->objPtr = objPtr;
- globalPtr->refCount = 0;
+ globalPtr->refCount = 1;
+ globalPtr->nsPtr = nsPtr;
globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
globalTablePtr->buckets[globalHash] = globalPtr;
globalTablePtr->numEntries++;
/*
- * If the global literal table has exceeded a decent size, rebuild it
- * with more buckets.
+ * If the global literal table has exceeded a decent size, rebuild it with
+ * more buckets.
*/
if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
RebuildLiteralTable(globalTablePtr);
}
- objIndex = AddLocalLiteralEntry(envPtr, globalPtr, localHash);
#ifdef TCL_COMPILE_DEBUG
TclVerifyGlobalLiteralTable(iPtr);
- TclVerifyLocalLiteralTable(envPtr);
{
LiteralEntry *entryPtr;
int found, i;
+
found = 0;
- for (i = 0; i < globalTablePtr->numBuckets; i++) {
- for (entryPtr = globalTablePtr->buckets[i];
- entryPtr != NULL; entryPtr = entryPtr->nextPtr) {
- if ((entryPtr == globalPtr)
- && (entryPtr->objPtr == objPtr)) {
+ for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
+ for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ;
+ entryPtr=entryPtr->nextPtr) {
+ if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) {
found = 1;
}
}
}
if (!found) {
- panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
- (length>60? 60 : length), bytes);
+ Tcl_Panic("TclRegisterLiteral: literal \"%.*s\" wasn't global",
+ (length>60? 60 : length), bytes);
}
}
#endif /*TCL_COMPILE_DEBUG*/
-#ifdef TCL_COMPILE_STATS
+
+#ifdef TCL_COMPILE_STATS
iPtr->stats.numLiteralsCreated++;
- iPtr->stats.totalLitStringBytes += (double) (length + 1);
+ iPtr->stats.totalLitStringBytes += (double) (length + 1);
iPtr->stats.currentLitStringBytes += (double) (length + 1);
iPtr->stats.literalCount[TclLog2(length)]++;
#endif /*TCL_COMPILE_STATS*/
+
+ if (globalPtrPtr) {
+ *globalPtrPtr = globalPtr;
+ }
+ *newPtr = 1;
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRegisterLiteral --
+ *
+ * Find, or if necessary create, an object in a CompileEnv literal array
+ * that has a string representation matching the argument string.
+ *
+ * Results:
+ * The index in the CompileEnv's literal array that references a shared
+ * literal matching the string. The object is created if necessary.
+ *
+ * Side effects:
+ * To maximize sharing, we look up the string in the interpreter's global
+ * literal table. If not found, we create a new shared literal in the
+ * global table. We then add a reference to the shared literal in the
+ * CompileEnv's literal array.
+ *
+ * If LITERAL_ON_HEAP is set in flags, this function is given ownership
+ * of the string: if an object is created then its string representation
+ * is set directly from string, otherwise the string is freed. Typically,
+ * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
+ * buffer holding the result of backslash substitutions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRegisterLiteral(
+ CompileEnv *envPtr, /* Points to the CompileEnv in whose object
+ * array an object is found or created. */
+ register char *bytes, /* Points to string for which to find or
+ * create an object in CompileEnv's object
+ * array. */
+ int length, /* Number of bytes in the string. If < 0, the
+ * string consists of all bytes up to the
+ * first null character. */
+ int flags) /* If LITERAL_ON_HEAP then the caller already
+ * malloc'd bytes and ownership is passed to
+ * this function. If LITERAL_NS_SCOPE then
+ * the literal shouldnot be shared accross
+ * namespaces. */
+{
+ Interp *iPtr = envPtr->iPtr;
+ LiteralTable *localTablePtr = &(envPtr->localLitTable);
+ LiteralEntry *globalPtr, *localPtr;
+ Tcl_Obj *objPtr;
+ unsigned int hash;
+ int localHash, objIndex, new;
+ Namespace *nsPtr;
+
+ if (length < 0) {
+ length = (bytes ? strlen(bytes) : 0);
+ }
+ hash = HashString(bytes, length);
+
+ /*
+ * Is the literal already in the CompileEnv's local literal array? If so,
+ * just return its index.
+ */
+
+ localHash = (hash & localTablePtr->mask);
+ for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
+ localPtr = localPtr->nextPtr) {
+ objPtr = localPtr->objPtr;
+ if ((objPtr->length == length) && ((length == 0)
+ || ((objPtr->bytes[0] == bytes[0])
+ && (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
+ if (flags & LITERAL_ON_HEAP) {
+ ckfree(bytes);
+ }
+ objIndex = (localPtr - envPtr->literalArrayPtr);
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
+
+ return objIndex;
+ }
+ }
+
+ /*
+ * The literal is new to this CompileEnv. Should it be shared accross
+ * namespaces? If it is a fully qualified name, the namespace
+ * specification is not needed to avoid sharing.
+ */
+
+ if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr
+ && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) {
+ nsPtr = iPtr->varFramePtr->nsPtr;
+ } else {
+ nsPtr = NULL;
+ }
+
+ /*
+ * Is it in the interpreter's global literal table? If not, create it.
+ */
+
+ objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr,
+ flags, &globalPtr);
+ objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);
+
+#ifdef TCL_COMPILE_DEBUG
+ if (globalPtr->refCount < 1) {
+ Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
+ (length>60? 60 : length), bytes, globalPtr->refCount);
+ }
+ TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/
return objIndex;
}
@@ -339,24 +413,24 @@ TclRegisterLiteral(envPtr, bytes, length, onHeap)
* TclLookupLiteralEntry --
*
* Finds the LiteralEntry that corresponds to a literal Tcl object
- * holding a literal.
+ * holding a literal.
*
* Results:
- * Returns the matching LiteralEntry if found, otherwise NULL.
+ * Returns the matching LiteralEntry if found, otherwise NULL.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
LiteralEntry *
-TclLookupLiteralEntry(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter for which objPtr was created
- * to hold a literal. */
- register Tcl_Obj *objPtr; /* Points to a Tcl object holding a
- * literal that was previously created by a
- * call to TclRegisterLiteral. */
+TclLookupLiteralEntry(
+ Tcl_Interp *interp, /* Interpreter for which objPtr was created to
+ * hold a literal. */
+ register Tcl_Obj *objPtr) /* Points to a Tcl object holding a literal
+ * that was previously created by a call to
+ * TclRegisterLiteral. */
{
Interp *iPtr = (Interp *) interp;
LiteralTable *globalTablePtr = &(iPtr->literalTable);
@@ -364,13 +438,13 @@ TclLookupLiteralEntry(interp, objPtr)
char *bytes;
int length, globalHash;
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ bytes = TclGetStringFromObj(objPtr, &length);
globalHash = (HashString(bytes, length) & globalTablePtr->mask);
- for (entryPtr = globalTablePtr->buckets[globalHash];
- entryPtr != NULL; entryPtr = entryPtr->nextPtr) {
- if (entryPtr->objPtr == objPtr) {
- return entryPtr;
- }
+ for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
+ entryPtr=entryPtr->nextPtr) {
+ if (entryPtr->objPtr == objPtr) {
+ return entryPtr;
+ }
}
return NULL;
}
@@ -380,10 +454,10 @@ TclLookupLiteralEntry(interp, objPtr)
*
* TclHideLiteral --
*
- * Remove a literal entry from the literal hash tables, leaving it in
- * the literal array so existing references continue to function.
- * This makes it possible to turn a shared literal into a private
- * literal that cannot be shared.
+ * Remove a literal entry from the literal hash tables, leaving it in the
+ * literal array so existing references continue to function. This makes
+ * it possible to turn a shared literal into a private literal that
+ * cannot be shared.
*
* Results:
* None.
@@ -396,13 +470,13 @@ TclLookupLiteralEntry(interp, objPtr)
*/
void
-TclHideLiteral(interp, envPtr, index)
- Tcl_Interp *interp; /* Interpreter for which objPtr was created
- * to hold a literal. */
- register CompileEnv *envPtr; /* Points to CompileEnv whose literal array
- * contains the entry being hidden. */
- int index; /* The index of the entry in the literal
- * array. */
+TclHideLiteral(
+ Tcl_Interp *interp, /* Interpreter for which objPtr was created to
+ * hold a literal. */
+ register CompileEnv *envPtr,/* Points to CompileEnv whose literal array
+ * contains the entry being hidden. */
+ int index) /* The index of the entry in the literal
+ * array. */
{
LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
LiteralTable *localTablePtr = &(envPtr->localLitTable);
@@ -414,9 +488,9 @@ TclHideLiteral(interp, envPtr, index)
/*
* To avoid unwanted sharing we need to copy the object and remove it from
- * the local and global literal tables. It still has a slot in the literal
- * array so it can be referred to by byte codes, but it will not be matched
- * by literal searches.
+ * the local and global literal tables. It still has a slot in the literal
+ * array so it can be referred to by byte codes, but it will not be
+ * matched by literal searches.
*/
newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
@@ -424,11 +498,11 @@ TclHideLiteral(interp, envPtr, index)
TclReleaseLiteral(interp, lPtr->objPtr);
lPtr->objPtr = newObjPtr;
- bytes = Tcl_GetStringFromObj(newObjPtr, &length);
+ bytes = TclGetStringFromObj(newObjPtr, &length);
localHash = (HashString(bytes, length) & localTablePtr->mask);
nextPtrPtr = &localTablePtr->buckets[localHash];
- for (entryPtr = *nextPtrPtr; entryPtr != NULL; entryPtr = *nextPtrPtr) {
+ for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
if (entryPtr == lPtr) {
*nextPtrPtr = lPtr->nextPtr;
lPtr->nextPtr = NULL;
@@ -444,31 +518,30 @@ TclHideLiteral(interp, envPtr, index)
*
* TclAddLiteralObj --
*
- * Add a single literal object to the literal array. This
- * function does not add the literal to the local or global
- * literal tables. The caller is expected to add the entry
- * to whatever tables are appropriate.
+ * Add a single literal object to the literal array. This function does
+ * not add the literal to the local or global literal tables. The caller
+ * is expected to add the entry to whatever tables are appropriate.
*
* Results:
* The index in the CompileEnv's literal array that references the
- * literal. Stores the pointer to the new literal entry in the
- * location referenced by the localPtrPtr argument.
+ * literal. Stores the pointer to the new literal entry in the location
+ * referenced by the localPtrPtr argument.
*
* Side effects:
- * Expands the literal array if necessary. Increments the refcount
- * on the literal object.
+ * Expands the literal array if necessary. Increments the refcount on the
+ * literal object.
*
*----------------------------------------------------------------------
*/
int
-TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
- register CompileEnv *envPtr; /* Points to CompileEnv in whose literal
- * array the object is to be inserted. */
- Tcl_Obj *objPtr; /* The object to insert into the array. */
- LiteralEntry **litPtrPtr; /* The location where the pointer to the
- * new literal entry should be stored.
- * May be NULL. */
+TclAddLiteralObj(
+ register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
+ * the object is to be inserted. */
+ Tcl_Obj *objPtr, /* The object to insert into the array. */
+ LiteralEntry **litPtrPtr) /* The location where the pointer to the new
+ * literal entry should be stored. May be
+ * NULL. */
{
register LiteralEntry *lPtr;
int objIndex;
@@ -504,27 +577,24 @@ TclAddLiteralObj(envPtr, objPtr, litPtrPtr)
* literal.
*
* Side effects:
- * Increments the ref count of the global LiteralEntry since the
- * CompileEnv now refers to the literal. Expands the literal array
- * if necessary. May rebuild the hash bucket array of the CompileEnv's
- * literal array if it becomes too large.
+ * Expands the literal array if necessary. May rebuild the hash bucket
+ * array of the CompileEnv's literal array if it becomes too large.
*
*----------------------------------------------------------------------
*/
static int
-AddLocalLiteralEntry(envPtr, globalPtr, localHash)
- register CompileEnv *envPtr; /* Points to CompileEnv in whose literal
- * array the object is to be inserted. */
- LiteralEntry *globalPtr; /* Points to the global LiteralEntry for
- * the literal to add to the CompileEnv. */
- int localHash; /* Hash value for the literal's string. */
+AddLocalLiteralEntry(
+ register CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
+ * the object is to be inserted. */
+ Tcl_Obj *objPtr, /* The literal to add to the CompileEnv. */
+ int localHash) /* Hash value for the literal's string. */
{
register LiteralTable *localTablePtr = &(envPtr->localLitTable);
LiteralEntry *localPtr;
int objIndex;
-
- objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr);
+
+ objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr);
/*
* Add the literal to the local table.
@@ -534,8 +604,6 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
localTablePtr->buckets[localHash] = localPtr;
localTablePtr->numEntries++;
- globalPtr->refCount++;
-
/*
* If the CompileEnv's local literal table has exceeded a decent size,
* rebuild it with more buckets.
@@ -550,22 +618,25 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
{
char *bytes;
int length, found, i;
+
found = 0;
- for (i = 0; i < localTablePtr->numBuckets; i++) {
- for (localPtr = localTablePtr->buckets[i];
- localPtr != NULL; localPtr = localPtr->nextPtr) {
- if (localPtr->objPtr == globalPtr->objPtr) {
+ for (i=0 ; i<localTablePtr->numBuckets ; i++) {
+ for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
+ localPtr=localPtr->nextPtr) {
+ if (localPtr->objPtr == objPtr) {
found = 1;
}
}
}
+
if (!found) {
- bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
- panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
- (length>60? 60 : length), bytes);
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
+ (length>60? 60 : length), bytes);
}
}
#endif /*TCL_COMPILE_DEBUG*/
+
return objIndex;
}
@@ -574,72 +645,72 @@ AddLocalLiteralEntry(envPtr, globalPtr, localHash)
*
* ExpandLocalLiteralArray --
*
- * Procedure that uses malloc to allocate more storage for a
- * CompileEnv's local literal array.
+ * Function that uses malloc to allocate more storage for a CompileEnv's
+ * local literal array.
*
* Results:
* None.
*
* Side effects:
- * The literal array in *envPtr is reallocated to a new array of
- * double the size, and if envPtr->mallocedLiteralArray is non-zero
- * the old array is freed. Entries are copied from the old array
- * to the new one. The local literal table is updated to refer to
- * the new entries.
+ * The literal array in *envPtr is reallocated to a new array of double
+ * the size, and if envPtr->mallocedLiteralArray is non-zero the old
+ * array is freed. Entries are copied from the old array to the new one.
+ * The local literal table is updated to refer to the new entries.
*
*----------------------------------------------------------------------
*/
static void
-ExpandLocalLiteralArray(envPtr)
- register CompileEnv *envPtr; /* Points to the CompileEnv whose object
- * array must be enlarged. */
+ExpandLocalLiteralArray(
+ register CompileEnv *envPtr)/* Points to the CompileEnv whose object array
+ * must be enlarged. */
{
/*
- * The current allocated local literal entries are stored between
- * elements 0 and (envPtr->literalArrayNext - 1) [inclusive].
+ * The current allocated local literal entries are stored between elements
+ * 0 and (envPtr->literalArrayNext - 1) [inclusive].
*/
LiteralTable *localTablePtr = &(envPtr->localLitTable);
int currElems = envPtr->literalArrayNext;
size_t currBytes = (currElems * sizeof(LiteralEntry));
- register LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
- register LiteralEntry *newArrayPtr =
- (LiteralEntry *) ckalloc((unsigned) (2 * currBytes));
+ LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
+ LiteralEntry *newArrayPtr;
int i;
-
+
+ if (envPtr->mallocedLiteralArray) {
+ newArrayPtr = (LiteralEntry *) ckrealloc(
+ (char *)currArrayPtr, 2 * currBytes);
+ } else {
+ /*
+ * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
+ * code a ckrealloc equivalent for ourselves
+ */
+ newArrayPtr = (LiteralEntry *) ckalloc(2 * currBytes);
+ memcpy(newArrayPtr, currArrayPtr, currBytes);
+ envPtr->mallocedLiteralArray = 1;
+ }
+
/*
- * Copy from the old literal array to the new, then update the local
- * literal table's bucket array.
+ * Update the local literal table's bucket array.
*/
- memcpy((VOID *) newArrayPtr, (VOID *) currArrayPtr, currBytes);
- for (i = 0; i < currElems; i++) {
- if (currArrayPtr[i].nextPtr == NULL) {
- newArrayPtr[i].nextPtr = NULL;
- } else {
- newArrayPtr[i].nextPtr = newArrayPtr
- + (currArrayPtr[i].nextPtr - currArrayPtr);
+ if (currArrayPtr != newArrayPtr) {
+ for (i=0 ; i<currElems ; i++) {
+ if (newArrayPtr[i].nextPtr != NULL) {
+ newArrayPtr[i].nextPtr = newArrayPtr
+ + (newArrayPtr[i].nextPtr - currArrayPtr);
+ }
}
- }
- for (i = 0; i < localTablePtr->numBuckets; i++) {
- if (localTablePtr->buckets[i] != NULL) {
- localTablePtr->buckets[i] = newArrayPtr
- + (localTablePtr->buckets[i] - currArrayPtr);
+ for (i=0 ; i<localTablePtr->numBuckets ; i++) {
+ if (localTablePtr->buckets[i] != NULL) {
+ localTablePtr->buckets[i] = newArrayPtr
+ + (localTablePtr->buckets[i] - currArrayPtr);
+ }
}
}
- /*
- * Free the old literal array if needed, and mark the new literal
- * array as malloced.
- */
-
- if (envPtr->mallocedLiteralArray) {
- ckfree((char *) currArrayPtr);
- }
envPtr->literalArrayPtr = newArrayPtr;
envPtr->literalArrayEnd = (2 * currElems);
- envPtr->mallocedLiteralArray = 1;
}
/*
@@ -647,59 +718,56 @@ ExpandLocalLiteralArray(envPtr)
*
* TclReleaseLiteral --
*
- * This procedure releases a reference to one of the shared Tcl objects
- * that hold literals. It is called to release the literals referenced
- * by a ByteCode that is being destroyed, and it is also called by
+ * This function releases a reference to one of the shared Tcl objects
+ * that hold literals. It is called to release the literals referenced by
+ * a ByteCode that is being destroyed, and it is also called by
* TclDeleteLiteralTable.
*
* Results:
* None.
*
* Side effects:
- * The reference count for the global LiteralTable entry that
- * corresponds to the literal is decremented. If no other reference
- * to a global literal object remains, it is freed.
+ * The reference count for the global LiteralTable entry that corresponds
+ * to the literal is decremented. If no other reference to a global
+ * literal object remains, it is freed.
*
*----------------------------------------------------------------------
*/
void
-TclReleaseLiteral(interp, objPtr)
- Tcl_Interp *interp; /* Interpreter for which objPtr was created
- * to hold a literal. */
- register Tcl_Obj *objPtr; /* Points to a literal object that was
+TclReleaseLiteral(
+ Tcl_Interp *interp, /* Interpreter for which objPtr was created to
+ * hold a literal. */
+ register Tcl_Obj *objPtr) /* Points to a literal object that was
* previously created by a call to
* TclRegisterLiteral. */
{
Interp *iPtr = (Interp *) interp;
LiteralTable *globalTablePtr = &(iPtr->literalTable);
register LiteralEntry *entryPtr, *prevPtr;
- ByteCode* codePtr;
char *bytes;
int length, index;
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ bytes = TclGetStringFromObj(objPtr, &length);
index = (HashString(bytes, length) & globalTablePtr->mask);
/*
- * Check to see if the object is in the global literal table and
- * remove this reference. The object may not be in the table if
- * it is a hidden local literal.
+ * Check to see if the object is in the global literal table and remove
+ * this reference. The object may not be in the table if it is a hidden
+ * local literal.
*/
- for (prevPtr = NULL, entryPtr = globalTablePtr->buckets[index];
- entryPtr != NULL;
- prevPtr = entryPtr, entryPtr = entryPtr->nextPtr) {
+ for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
+ entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
if (entryPtr->objPtr == objPtr) {
entryPtr->refCount--;
/*
- * If the literal is no longer being used by any ByteCode,
- * delete the entry then remove the reference corresponding
- * to the global literal table entry (decrement the ref count
- * of the object).
+ * If the literal is no longer being used by any ByteCode, delete
+ * the entry then remove the reference corresponding to the global
+ * literal table entry (decrement the ref count of the object).
*/
-
+
if (entryPtr->refCount == 0) {
if (prevPtr == NULL) {
globalTablePtr->buckets[index] = entryPtr->nextPtr;
@@ -711,22 +779,6 @@ TclReleaseLiteral(interp, objPtr)
TclDecrRefCount(objPtr);
- /*
- * Check if the LiteralEntry is only being kept alive by
- * a circular reference from a ByteCode stored as its
- * internal rep. In that case, set the ByteCode object array
- * entry NULL to signal to TclCleanupByteCode to not try to
- * release this about to be freed literal again.
- */
-
- if (objPtr->typePtr == &tclByteCodeType) {
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- if ((codePtr->numLitObjects == 1)
- && (codePtr->objArrayPtr[0] == objPtr)) {
- codePtr->objArrayPtr[0] = NULL;
- }
- }
-
#ifdef TCL_COMPILE_STATS
iPtr->stats.currentLitStringBytes -= (double) (length + 1);
#endif /*TCL_COMPILE_STATS*/
@@ -734,10 +786,9 @@ TclReleaseLiteral(interp, objPtr)
break;
}
}
-
+
/*
- * Remove the reference corresponding to the local literal table
- * entry.
+ * Remove the reference corresponding to the local literal table entry.
*/
Tcl_DecrRefCount(objPtr);
@@ -748,12 +799,11 @@ TclReleaseLiteral(interp, objPtr)
*
* HashString --
*
- * Compute a one-word summary of a text string, which can be
- * used to generate a hash index.
+ * Compute a one-word summary of a text string, which can be used to
+ * generate a hash index.
*
* Results:
- * The return value is a one-word summary of the information in
- * string.
+ * The return value is a one-word summary of the information in string.
*
* Side effects:
* None.
@@ -762,33 +812,32 @@ TclReleaseLiteral(interp, objPtr)
*/
static unsigned int
-HashString(bytes, length)
- register CONST char *bytes; /* String for which to compute hash
- * value. */
- int length; /* Number of bytes in the string. */
+HashString(
+ register const char *bytes, /* String for which to compute hash value. */
+ int length) /* Number of bytes in the string. */
{
register unsigned int result;
register int i;
/*
- * 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:
+ * 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.
+ * 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.
*/
result = 0;
- for (i = 0; i < length; i++) {
- result += (result<<3) + *bytes++;
+ for (i=0 ; i<length ; i++) {
+ result += (result<<3) + bytes[i];
}
return result;
}
@@ -798,9 +847,9 @@ HashString(bytes, length)
*
* RebuildLiteralTable --
*
- * This procedure is invoked when the ratio of entries to hash buckets
- * becomes too large in a local or global literal table. It allocates
- * a larger bucket array and moves the entries into the new buckets.
+ * This function is invoked when the ratio of entries to hash buckets
+ * becomes too large in a local or global literal table. It allocates a
+ * larger bucket array and moves the entries into the new buckets.
*
* Results:
* None.
@@ -812,8 +861,9 @@ HashString(bytes, length)
*/
static void
-RebuildLiteralTable(tablePtr)
- register LiteralTable *tablePtr; /* Local or global table to enlarge. */
+RebuildLiteralTable(
+ register LiteralTable *tablePtr)
+ /* Local or global table to enlarge. */
{
LiteralEntry **oldBuckets;
register LiteralEntry **oldChainPtr, **newChainPtr;
@@ -826,16 +876,15 @@ RebuildLiteralTable(tablePtr)
oldBuckets = tablePtr->buckets;
/*
- * Allocate and initialize the new bucket array, and set up
- * hashing constants for new array size.
+ * Allocate and initialize the new bucket array, and set up hashing
+ * constants for new array size.
*/
tablePtr->numBuckets *= 4;
tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
(tablePtr->numBuckets * sizeof(LiteralEntry *)));
- for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
- count > 0;
- count--, newChainPtr++) {
+ for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
+ count>0 ; count--, newChainPtr++) {
*newChainPtr = NULL;
}
tablePtr->rebuildSize *= 4;
@@ -845,14 +894,11 @@ RebuildLiteralTable(tablePtr)
* Rehash all of the existing entries into the new bucket array.
*/
- for (oldChainPtr = oldBuckets;
- oldSize > 0;
- oldSize--, oldChainPtr++) {
- for (entryPtr = *oldChainPtr; entryPtr != NULL;
- entryPtr = *oldChainPtr) {
- bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length);
+ for (oldChainPtr=oldBuckets ; oldSize>0 ; oldSize--,oldChainPtr++) {
+ for (entryPtr=*oldChainPtr ; entryPtr!=NULL ; entryPtr=*oldChainPtr) {
+ bytes = TclGetStringFromObj(entryPtr->objPtr, &length);
index = (HashString(bytes, length) & tablePtr->mask);
-
+
*oldChainPtr = entryPtr->nextPtr;
bucketPtr = &(tablePtr->buckets[index]);
entryPtr->nextPtr = *bucketPtr;
@@ -875,13 +921,12 @@ RebuildLiteralTable(tablePtr)
*
* TclLiteralStats --
*
- * Return statistics describing the layout of the hash table
- * in its hash buckets.
+ * Return statistics describing the layout of the hash table in its hash
+ * buckets.
*
* Results:
- * The return value is a malloc-ed string containing information
- * about tablePtr. It is the caller's responsibility to free
- * this string.
+ * The return value is a malloc-ed string containing information about
+ * tablePtr. It is the caller's responsibility to free this string.
*
* Side effects:
* None.
@@ -890,8 +935,8 @@ RebuildLiteralTable(tablePtr)
*/
char *
-TclLiteralStats(tablePtr)
- LiteralTable *tablePtr; /* Table for which to produce stats. */
+TclLiteralStats(
+ LiteralTable *tablePtr) /* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
int count[NUM_COUNTERS], overflow, i, j;
@@ -900,19 +945,19 @@ TclLiteralStats(tablePtr)
char *result, *p;
/*
- * Compute a histogram of bucket usage. For each bucket chain i,
- * j is the number of entries in the chain.
+ * Compute a histogram of bucket usage. For each bucket chain i, j is the
+ * number of entries in the chain.
*/
- for (i = 0; i < NUM_COUNTERS; i++) {
+ for (i=0 ; i<NUM_COUNTERS ; i++) {
count[i] = 0;
}
overflow = 0;
average = 0.0;
- for (i = 0; i < tablePtr->numBuckets; i++) {
+ for (i=0 ; i<tablePtr->numBuckets ; i++) {
j = 0;
- for (entryPtr = tablePtr->buckets[i]; entryPtr != NULL;
- entryPtr = entryPtr->nextPtr) {
+ for (entryPtr=tablePtr->buckets[i] ; entryPtr!=NULL;
+ entryPtr=entryPtr->nextPtr) {
j++;
}
if (j < NUM_COUNTERS) {
@@ -932,7 +977,7 @@ TclLiteralStats(tablePtr)
sprintf(result, "%d entries in table, %d buckets\n",
tablePtr->numEntries, tablePtr->numBuckets);
p = result + strlen(result);
- for (i = 0; i < NUM_COUNTERS; i++) {
+ for (i=0 ; i<NUM_COUNTERS ; i++) {
sprintf(p, "number of buckets with %d entries: %d\n",
i, count[i]);
p += strlen(p);
@@ -957,15 +1002,15 @@ TclLiteralStats(tablePtr)
* None.
*
* Side effects:
- * Panics if problems are found.
+ * Tcl_Panic if problems are found.
*
*----------------------------------------------------------------------
*/
void
-TclVerifyLocalLiteralTable(envPtr)
- CompileEnv *envPtr; /* Points to CompileEnv whose literal
- * table is to be validated. */
+TclVerifyLocalLiteralTable(
+ CompileEnv *envPtr) /* Points to CompileEnv whose literal table is
+ * to be validated. */
{
register LiteralTable *localTablePtr = &(envPtr->localLitTable);
register LiteralEntry *localPtr;
@@ -974,30 +1019,29 @@ TclVerifyLocalLiteralTable(envPtr)
int length, count;
count = 0;
- for (i = 0; i < localTablePtr->numBuckets; i++) {
- for (localPtr = localTablePtr->buckets[i];
- localPtr != NULL; localPtr = localPtr->nextPtr) {
+ for (i=0 ; i<localTablePtr->numBuckets ; i++) {
+ for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
+ localPtr=localPtr->nextPtr) {
count++;
if (localPtr->refCount != -1) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
- panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d",
- (length>60? 60 : length), bytes,
- localPtr->refCount);
+ Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d",
+ (length>60? 60 : length), bytes, localPtr->refCount);
}
if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
localPtr->objPtr) == NULL) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
- panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
- (length>60? 60 : length), bytes);
+ Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
+ (length>60? 60 : length), bytes);
}
if (localPtr->objPtr->bytes == NULL) {
- panic("TclVerifyLocalLiteralTable: literal has NULL string rep");
+ Tcl_Panic("TclVerifyLocalLiteralTable: literal has NULL string rep");
}
}
}
if (count != localTablePtr->numEntries) {
- panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d",
- count, localTablePtr->numEntries);
+ Tcl_Panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d",
+ count, localTablePtr->numEntries);
}
}
@@ -1012,15 +1056,15 @@ TclVerifyLocalLiteralTable(envPtr)
* None.
*
* Side effects:
- * Panics if problems are found.
+ * Tcl_Panic if problems are found.
*
*----------------------------------------------------------------------
*/
void
-TclVerifyGlobalLiteralTable(iPtr)
- Interp *iPtr; /* Points to interpreter whose global
- * literal table is to be validated. */
+TclVerifyGlobalLiteralTable(
+ Interp *iPtr) /* Points to interpreter whose global literal
+ * table is to be validated. */
{
register LiteralTable *globalTablePtr = &(iPtr->literalTable);
register LiteralEntry *globalPtr;
@@ -1029,24 +1073,31 @@ TclVerifyGlobalLiteralTable(iPtr)
int length, count;
count = 0;
- for (i = 0; i < globalTablePtr->numBuckets; i++) {
- for (globalPtr = globalTablePtr->buckets[i];
- globalPtr != NULL; globalPtr = globalPtr->nextPtr) {
+ for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
+ for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
+ globalPtr=globalPtr->nextPtr) {
count++;
if (globalPtr->refCount < 1) {
bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
- panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d",
- (length>60? 60 : length), bytes,
- globalPtr->refCount);
+ Tcl_Panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d",
+ (length>60? 60 : length), bytes, globalPtr->refCount);
}
if (globalPtr->objPtr->bytes == NULL) {
- panic("TclVerifyGlobalLiteralTable: literal has NULL string rep");
+ Tcl_Panic("TclVerifyGlobalLiteralTable: literal has NULL string rep");
}
}
}
if (count != globalTablePtr->numEntries) {
- panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d",
- count, globalTablePtr->numEntries);
+ Tcl_Panic("TclVerifyGlobalLiteralTable: global literal table had %d entries, should be %d",
+ count, globalTablePtr->numEntries);
}
}
#endif /*TCL_COMPILE_DEBUG*/
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */