diff options
Diffstat (limited to 'generic/tclLiteral.c')
| -rw-r--r-- | generic/tclLiteral.c | 270 |
1 files changed, 166 insertions, 104 deletions
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 3f1d059..ba9b812 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLiteral.c,v 1.30 2007/03/21 16:25:28 dgp Exp $ + * RCS: @(#) $Id: tclLiteral.c,v 1.31 2007/07/31 17:03:39 msofer Exp $ */ #include "tclInt.h" @@ -31,7 +31,7 @@ */ static int AddLocalLiteralEntry(CompileEnv *envPtr, - LiteralEntry *globalPtr, int localHash); + Tcl_Obj *objPtr, int localHash); static void ExpandLocalLiteralArray(CompileEnv *envPtr); static unsigned int HashString(const char *bytes, int length); static void RebuildLiteralTable(LiteralTable *tablePtr); @@ -216,21 +216,20 @@ TclDeleteLiteralTable( /* *---------------------------------------------------------------------- * - * 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. - * + * 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, @@ -240,77 +239,29 @@ TclDeleteLiteralTable( *---------------------------------------------------------------------- */ -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. */ +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; - 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; - } - + LiteralEntry *globalPtr; + int globalHash; + Tcl_Obj *objPtr; + /* * Is it in the interpreter's global literal table? */ + if (hash == (unsigned int) -1) { + hash = HashString(bytes, length); + } globalHash = (hash & globalTablePtr->mask); for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL; globalPtr = globalPtr->nextPtr) { @@ -320,29 +271,32 @@ TclRegisterLiteral( || ((objPtr->bytes[0] == bytes[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 (newPtr) { + *newPtr = 0; + } + if (globalPtrPtr) { + *globalPtrPtr = globalPtr; + } if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } - objIndex = AddLocalLiteralEntry(envPtr, globalPtr, 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; + 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); @@ -363,7 +317,7 @@ TclRegisterLiteral( 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; @@ -377,11 +331,9 @@ TclRegisterLiteral( 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; @@ -409,6 +361,121 @@ TclRegisterLiteral( 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; } @@ -582,10 +649,8 @@ TclAddLiteralObj( * 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. * *---------------------------------------------------------------------- */ @@ -594,15 +659,14 @@ static int AddLocalLiteralEntry( 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. */ + 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. @@ -612,8 +676,6 @@ AddLocalLiteralEntry( 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. @@ -633,14 +695,14 @@ AddLocalLiteralEntry( for (i=0 ; i<localTablePtr->numBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ; localPtr=localPtr->nextPtr) { - if (localPtr->objPtr == globalPtr->objPtr) { + if (localPtr->objPtr == objPtr) { found = 1; } } } if (!found) { - bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length); + bytes = Tcl_GetStringFromObj(objPtr, &length); Tcl_Panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally", (length>60? 60 : length), bytes); } |