summaryrefslogtreecommitdiffstats
path: root/generic/tclNamesp.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r--generic/tclNamesp.c171
1 files changed, 89 insertions, 82 deletions
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index cf4ecc4..9f28661 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -25,14 +25,15 @@
#include "tclInt.h"
#include "tclCompile.h" /* for TclLogCommandInfo visibility */
+#include <assert.h>
/*
* Thread-local storage used to avoid having a global lock on data that is not
* limited to a single interpreter.
*/
-typedef struct ThreadSpecificData {
- long numNsCreated; /* Count of the number of namespaces created
+typedef struct {
+ unsigned long numNsCreated; /* Count of the number of namespaces created
* within the thread. This value is used as a
* unique id for each namespace. Cannot be
* per-interp because the nsId is used to
@@ -59,7 +60,7 @@ typedef struct ResolvedNsName {
* the name was resolved. NULL if the name is
* fully qualified and thus the resolution
* does not depend on the context. */
- int refCount; /* Reference count: 1 for each nsName object
+ size_t refCount; /* Reference count: 1 for each nsName object
* that has a pointer to this ResolvedNsName
* structure as its internal rep. This
* structure can be freed when refCount
@@ -89,8 +90,6 @@ static char * EstablishErrorInfoTraces(ClientData clientData,
static void FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int GetNamespaceFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
-static int InvokeImportedCmd(ClientData clientData,
- Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int InvokeImportedNRCmd(ClientData clientData,
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceChildrenCmd(ClientData dummy,
@@ -154,6 +153,22 @@ static const Tcl_ObjType nsNameType = {
SetNsNameFromAny /* setFromAnyProc */
};
+#define NsNameSetIntRep(objPtr, nnPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ (nnPtr)->refCount++; \
+ ir.twoPtrValue.ptr1 = (nnPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &nsNameType, &ir); \
+ } while (0)
+
+#define NsNameGetIntRep(objPtr, nnPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &nsNameType); \
+ (nnPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
* Array of values describing how to implement each standard subcommand of the
* "namespace" command.
@@ -225,7 +240,7 @@ TclInitNamespaceSubsystem(void)
Tcl_Namespace *
Tcl_GetCurrentNamespace(
- register Tcl_Interp *interp)/* Interpreter whose current namespace is
+ Tcl_Interp *interp)/* Interpreter whose current namespace is
* being queried. */
{
return TclGetCurrentNamespace(interp);
@@ -249,7 +264,7 @@ Tcl_GetCurrentNamespace(
Tcl_Namespace *
Tcl_GetGlobalNamespace(
- register Tcl_Interp *interp)/* Interpreter whose global namespace should
+ Tcl_Interp *interp)/* Interpreter whose global namespace should
* be returned. */
{
return TclGetGlobalNamespace(interp);
@@ -301,8 +316,8 @@ Tcl_PushCallFrame(
* variables. */
{
Interp *iPtr = (Interp *) interp;
- register CallFrame *framePtr = (CallFrame *) callFramePtr;
- register Namespace *nsPtr;
+ CallFrame *framePtr = (CallFrame *) callFramePtr;
+ Namespace *nsPtr;
if (namespacePtr == NULL) {
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
@@ -378,8 +393,8 @@ void
Tcl_PopCallFrame(
Tcl_Interp *interp) /* Interpreter with call frame to pop. */
{
- register Interp *iPtr = (Interp *) interp;
- register CallFrame *framePtr = iPtr->framePtr;
+ Interp *iPtr = (Interp *) interp;
+ CallFrame *framePtr = iPtr->framePtr;
Namespace *nsPtr;
/*
@@ -402,7 +417,7 @@ Tcl_PopCallFrame(
}
if (framePtr->numCompiledLocals > 0) {
TclDeleteCompiledLocalVars(iPtr, framePtr);
- if (--framePtr->localCachePtr->refCount == 0) {
+ if (framePtr->localCachePtr->refCount-- <= 1) {
TclFreeLocalCache(interp, framePtr->localCachePtr);
}
framePtr->localCachePtr = NULL;
@@ -664,7 +679,7 @@ Tcl_CreateNamespace(
* function should be called. */
{
Interp *iPtr = (Interp *) interp;
- register Namespace *nsPtr, *ancestorPtr;
+ Namespace *nsPtr, *ancestorPtr;
Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
Namespace *globalNsPtr = iPtr->globalNsPtr;
const char *simpleName;
@@ -833,7 +848,7 @@ Tcl_CreateNamespace(
for (ancestorPtr = nsPtr; ancestorPtr != NULL;
ancestorPtr = ancestorPtr->parentPtr) {
if (ancestorPtr != globalNsPtr) {
- register Tcl_DString *tempPtr = namePtr;
+ Tcl_DString *tempPtr = namePtr;
TclDStringAppendLiteral(buffPtr, "::");
Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
@@ -861,7 +876,7 @@ Tcl_CreateNamespace(
name = Tcl_DStringValue(namePtr);
nameLen = Tcl_DStringLength(namePtr);
nsPtr->fullName = ckalloc(nameLen + 1);
- memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);
+ memcpy(nsPtr->fullName, name, nameLen + 1);
Tcl_DStringFree(&buffer1);
Tcl_DStringFree(&buffer2);
@@ -907,7 +922,7 @@ void
Tcl_DeleteNamespace(
Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
{
- register Namespace *nsPtr = (Namespace *) namespacePtr;
+ Namespace *nsPtr = (Namespace *) namespacePtr;
Interp *iPtr = (Interp *) nsPtr->interp;
Namespace *globalNsPtr = (Namespace *)
TclGetGlobalNamespace((Tcl_Interp *) iPtr);
@@ -1103,11 +1118,11 @@ TclNamespaceDeleted(
void
TclTeardownNamespace(
- register Namespace *nsPtr) /* Points to the namespace to be dismantled
+ Namespace *nsPtr) /* Points to the namespace to be dismantled
* and unlinked from its parent. */
{
Interp *iPtr = (Interp *) nsPtr->interp;
- register Tcl_HashEntry *entryPtr;
+ Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
int i;
@@ -1296,7 +1311,7 @@ TclTeardownNamespace(
static void
NamespaceFree(
- register Namespace *nsPtr) /* Points to the namespace to free. */
+ Namespace *nsPtr) /* Points to the namespace to free. */
{
/*
* Most of the namespace's contents are freed when the namespace is
@@ -1330,8 +1345,7 @@ void
TclNsDecrRefCount(
Namespace *nsPtr)
{
- nsPtr->refCount--;
- if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+ if ((nsPtr->refCount-- <= 1) && (nsPtr->flags & NS_DEAD)) {
NamespaceFree(nsPtr);
}
}
@@ -1455,7 +1469,7 @@ Tcl_Export(
len = strlen(pattern);
patternCpy = ckalloc(len + 1);
- memcpy(patternCpy, pattern, (unsigned) len + 1);
+ memcpy(patternCpy, pattern, len + 1);
nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
nsPtr->numExportPatterns++;
@@ -1572,7 +1586,7 @@ Tcl_Import(
{
Namespace *nsPtr, *importNsPtr, *dummyPtr;
const char *simplePattern;
- register Tcl_HashEntry *hPtr;
+ Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
/*
@@ -1774,7 +1788,7 @@ DoImport(
dataPtr = ckalloc(sizeof(ImportedCmdData));
importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
- InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
+ TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
DeleteImportedCmd);
dataPtr->realCmdPtr = cmdPtr;
dataPtr->selfPtr = (Command *) importedCmd;
@@ -1851,7 +1865,7 @@ Tcl_ForgetImport(
Namespace *nsPtr, *sourceNsPtr, *dummyPtr;
const char *simplePattern;
char *cmdName;
- register Tcl_HashEntry *hPtr;
+ Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
/*
@@ -1978,7 +1992,7 @@ TclGetOriginalCommand(
Tcl_Command command) /* The imported command for which the original
* command should be returned. */
{
- register Command *cmdPtr = (Command *) command;
+ Command *cmdPtr = (Command *) command;
ImportedCmdData *dataPtr;
if (cmdPtr->deleteProc != DeleteImportedCmd) {
@@ -1995,7 +2009,7 @@ TclGetOriginalCommand(
/*
*----------------------------------------------------------------------
*
- * InvokeImportedCmd --
+ * TclInvokeImportedCmd --
*
* Invoked by Tcl whenever the user calls an imported command that was
* created by Tcl_Import. Finds the "real" command (in another
@@ -2026,8 +2040,8 @@ InvokeImportedNRCmd(
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}
-static int
-InvokeImportedCmd(
+int
+TclInvokeImportedCmd(
ClientData clientData, /* Points to the imported command's
* ImportedCmdData structure. */
Tcl_Interp *interp, /* Current interpreter. */
@@ -2067,7 +2081,7 @@ DeleteImportedCmd(
ImportedCmdData *dataPtr = clientData;
Command *realCmdPtr = dataPtr->realCmdPtr;
Command *selfPtr = dataPtr->selfPtr;
- register ImportRef *refPtr, *prevPtr;
+ ImportRef *refPtr, *prevPtr;
prevPtr = NULL;
for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL;
@@ -2487,7 +2501,7 @@ Tcl_FindNamespace(
* points to namespace in which to resolve
* name; if NULL, look up name in the current
* namespace. */
- register int flags) /* Flags controlling namespace lookup: an OR'd
+ int flags) /* Flags controlling namespace lookup: an OR'd
* combination of TCL_GLOBAL_ONLY and
* TCL_LEAVE_ERR_MSG flags. */
{
@@ -2558,8 +2572,8 @@ Tcl_FindCommand(
{
Interp *iPtr = (Interp *) interp;
Namespace *cxtNsPtr;
- register Tcl_HashEntry *entryPtr;
- register Command *cmdPtr;
+ Tcl_HashEntry *entryPtr;
+ Command *cmdPtr;
const char *simpleName;
int result;
@@ -2670,7 +2684,7 @@ Tcl_FindCommand(
}
} else {
Namespace *nsPtr[2];
- register int search;
+ int search;
TclGetNamespaceForQualName(interp, name, cxtNsPtr,
flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
@@ -2744,7 +2758,7 @@ TclResetShadowedCmdRefs(
{
char *cmdName;
Tcl_HashEntry *hPtr;
- register Namespace *nsPtr;
+ Namespace *nsPtr;
Namespace *trailNsPtr, *shadowNsPtr;
Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
int found, i;
@@ -2908,26 +2922,29 @@ GetNamespaceFromObj(
Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */
{
ResolvedNsName *resNamePtr;
- Namespace *nsPtr, *refNsPtr;
- if (objPtr->typePtr == &nsNameType) {
+ NsNameGetIntRep(objPtr, resNamePtr);
+ if (resNamePtr) {
+ Namespace *nsPtr, *refNsPtr;
+
/*
* Check that the ResolvedNsName is still valid; avoid letting the ref
* cross interps.
*/
- resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
nsPtr = resNamePtr->nsPtr;
refNsPtr = resNamePtr->refNsPtr;
- if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
- (!refNsPtr || ((interp == refNsPtr->interp) &&
- (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))){
+ if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
+ && (!refNsPtr || (refNsPtr ==
+ (Namespace *) TclGetCurrentNamespace(interp)))) {
*nsPtrPtr = (Tcl_Namespace *) nsPtr;
return TCL_OK;
}
+ Tcl_StoreIntRep(objPtr, &nsNameType, NULL);
}
if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
- resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ NsNameGetIntRep(objPtr, resNamePtr);
+ assert(resNamePtr != NULL);
*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
return TCL_OK;
}
@@ -2991,7 +3008,7 @@ NamespaceChildrenCmd(
Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
const char *pattern = NULL;
Tcl_DString buffer;
- register Tcl_HashEntry *entryPtr;
+ Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Tcl_Obj *listPtr, *elemPtr;
@@ -3117,7 +3134,7 @@ NamespaceCodeCmd(
{
Namespace *currNsPtr;
Tcl_Obj *listPtr, *objPtr;
- register const char *arg;
+ const char *arg;
int length;
if (objc != 2) {
@@ -3196,7 +3213,7 @@ NamespaceCurrentCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- register Namespace *currNsPtr;
+ Namespace *currNsPtr;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -3261,7 +3278,7 @@ NamespaceDeleteCmd(
{
Tcl_Namespace *namespacePtr;
const char *name;
- register int i;
+ int i;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
@@ -3616,7 +3633,7 @@ NamespaceForgetCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *pattern;
- register int i, result;
+ int i, result;
if (objc < 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
@@ -3682,7 +3699,7 @@ NamespaceImportCmd(
{
int allowOverwrite = 0;
const char *string, *pattern;
- register int i, result;
+ int i, result;
int firstArg;
if (objc < 1) {
@@ -3835,7 +3852,7 @@ NRNamespaceInscopeCmd(
cmdObjPtr = objv[2];
} else {
Tcl_Obj *concatObjv[2];
- register Tcl_Obj *listPtr;
+ Tcl_Obj *listPtr;
listPtr = Tcl_NewListObj(0, NULL);
for (i = 3; i < objc; i++) {
@@ -4236,7 +4253,7 @@ NamespaceQualifiersCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- register const char *name, *p;
+ const char *name, *p;
int length;
if (objc != 2) {
@@ -4491,7 +4508,7 @@ NamespaceTailCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- register const char *name, *p;
+ const char *name, *p;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "string");
@@ -4694,18 +4711,20 @@ NamespaceWhichCmd(
static void
FreeNsNameInternalRep(
- register Tcl_Obj *objPtr) /* nsName object with internal representation
+ Tcl_Obj *objPtr) /* nsName object with internal representation
* to free. */
{
- ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedNsName *resNamePtr;
+
+ NsNameGetIntRep(objPtr, resNamePtr);
+ assert(resNamePtr != NULL);
/*
* Decrement the reference count of the namespace. If there are no more
* references, free it up.
*/
- resNamePtr->refCount--;
- if (resNamePtr->refCount == 0) {
+ if (resNamePtr->refCount-- <= 1) {
/*
* Decrement the reference count for the cached namespace. If the
* namespace is dead, and there are no more references to it, free
@@ -4715,7 +4734,6 @@ FreeNsNameInternalRep(
TclNsDecrRefCount(resNamePtr->nsPtr);
ckfree(resNamePtr);
}
- objPtr->typePtr = NULL;
}
/*
@@ -4740,13 +4758,13 @@ FreeNsNameInternalRep(
static void
DupNsNameInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
- register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedNsName *resNamePtr;
- copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
- resNamePtr->refCount++;
- copyPtr->typePtr = &nsNameType;
+ NsNameGetIntRep(srcPtr, resNamePtr);
+ assert(resNamePtr != NULL);
+ NsNameSetIntRep(copyPtr, resNamePtr);
}
/*
@@ -4776,11 +4794,11 @@ SetNsNameFromAny(
Tcl_Interp *interp, /* Points to the namespace in which to resolve
* name. Also used for error reporting if not
* NULL. */
- register Tcl_Obj *objPtr) /* The object to convert. */
+ Tcl_Obj *objPtr) /* The object to convert. */
{
const char *dummy;
Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
- register ResolvedNsName *resNamePtr;
+ ResolvedNsName *resNamePtr;
const char *name;
if (interp == NULL) {
@@ -4791,36 +4809,25 @@ SetNsNameFromAny(
TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
&nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+ if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
+ return TCL_ERROR;
+ }
+
/*
* If we found a namespace, then create a new ResolvedNsName structure
* that holds a reference to it.
*/
- if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
- /*
- * Our failed lookup proves any previously cached nsName intrep is no
- * longer valid. Get rid of it so we no longer waste memory storing
- * it, nor time determining its invalidity again and again.
- */
-
- if (objPtr->typePtr == &nsNameType) {
- TclFreeIntRep(objPtr);
- }
- return TCL_ERROR;
- }
-
nsPtr->refCount++;
resNamePtr = ckalloc(sizeof(ResolvedNsName));
resNamePtr->nsPtr = nsPtr;
if ((name[0] == ':') && (name[1] == ':')) {
resNamePtr->refNsPtr = NULL;
} else {
- resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
- resNamePtr->refCount = 1;
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
- objPtr->typePtr = &nsNameType;
+ resNamePtr->refCount = 0;
+ NsNameSetIntRep(objPtr, resNamePtr);
return TCL_OK;
}
@@ -4914,7 +4921,7 @@ TclLogCommandInfo(
Tcl_Obj **tosPtr) /* Current stack of bytecode execution
* context */
{
- register const char *p;
+ const char *p;
Interp *iPtr = (Interp *) interp;
int overflow, limit = 150;
Var *varPtr, *arrayPtr;
generated by cgit v0.12 at 2024-10-22 08:38:50 (GMT)