From 99b5d44e0551941d42119fadc9d92fb7bcf00a74 Mon Sep 17 00:00:00 2001 From: welch Date: Mon, 6 Jul 1998 14:54:30 +0000 Subject: Merged changes between child workspace "/home/welch/ws/tcl8.0.3i" and parent workspace "/home/welch/ws/tcl8.0.3". --- generic/tclCompile.c | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++-- generic/tclCompile.h | 10 +++++- 2 files changed, 93 insertions(+), 3 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 4c40d64..7f07a27 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * SCCS: %Z% $Id: tclCompile.c,v 1.6 1998/07/01 19:12:42 escoffon Exp $ + * SCCS: %Z% $Id: tclCompile.c,v 1.7 1998/07/06 14:54:30 welch Exp $ */ #include "tclInt.h" @@ -1296,6 +1296,7 @@ TclInitByteCodeObj(objPtr, envPtr) unsigned char *nextPtr; int srcLen = envPtr->termOffset; int numObjects, i; + Namespace *namespacePtr; #ifdef TCL_COMPILE_STATS int srcLenLog2, sizeLog2; #endif /*TCL_COMPILE_STATS*/ @@ -1350,11 +1351,19 @@ TclInitByteCodeObj(objPtr, envPtr) tclSourceCount[srcLenLog2]++; tclByteCodeCount[sizeLog2]++; #endif /* TCL_COMPILE_STATS */ + + if (envPtr->iPtr->varFramePtr != NULL) { + namespacePtr = envPtr->iPtr->varFramePtr->nsPtr; + } else { + namespacePtr = envPtr->iPtr->globalNsPtr; + } p = (unsigned char *) ckalloc(size); codePtr = (ByteCode *) p; codePtr->iPtr = envPtr->iPtr; codePtr->compileEpoch = envPtr->iPtr->compileEpoch; + codePtr->nsPtr = namespacePtr; + codePtr->nsEpoch = namespacePtr->resolverEpoch; codePtr->refCount = 1; codePtr->flags = 0; codePtr->source = envPtr->source; @@ -6606,6 +6615,15 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr) register CompiledLocal *localPtr; int localIndex = -1; register int i; + int localCt, result; + Interp *iPtr; + Namespace *cxtNsPtr; + Tcl_ResolvedVarInfo vinfo; + ResolverScheme *resPtr; + + vinfo.identity = NULL; + vinfo.fetchProc = NULL; + vinfo.deleteProc = NULL; /* * If not creating a temporary, does a local variable of the specified @@ -6613,7 +6631,7 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr) */ if (name != NULL) { - int localCt = procPtr->numCompiledLocals; + localCt = procPtr->numCompiledLocals; localPtr = procPtr->firstLocalPtr; for (i = 0; i < localCt; i++) { if (!localPtr->isTemp) { @@ -6629,9 +6647,70 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr) } /* + * If the namespace or the interpreter have special name resolution + * rules, give them a chance to resolve the name. + * + * TRICKY NOTE: It is important to do this check here, after + * looking for an existing compiled local above. This lets + * procedures supply compiled locals for arguments, and the + * arguments take precedence over any other name resolution + * rules. + */ + cxtNsPtr = procPtr->cmdPtr->nsPtr; + iPtr = (Interp*)cxtNsPtr->interp; + + if (cxtNsPtr->compiledVarResProc != NULL || iPtr->resolverPtr != NULL) { + resPtr = iPtr->resolverPtr; + + if (cxtNsPtr->compiledVarResProc) { + result = (*cxtNsPtr->compiledVarResProc)(cxtNsPtr->interp, + name, nameChars, (Tcl_Namespace *) cxtNsPtr, &vinfo); + } else { + result = TCL_CONTINUE; + } + + while (result == TCL_CONTINUE && resPtr) { + if (resPtr->compiledVarResProc) { + result = (*resPtr->compiledVarResProc)(cxtNsPtr->interp, + name, nameChars, (Tcl_Namespace *) cxtNsPtr, &vinfo); + } + resPtr = resPtr->nextPtr; + } + + /* + * If the resolver returned a valid result, then look for + * an existing variable with matching resolution info. + * If a matching variable is not found, then create one + * if appropriate. + */ + if (result == TCL_OK) { + Tcl_ResolvedVarInfo *currInfo; + + localCt = procPtr->numCompiledLocals; + localPtr = procPtr->firstLocalPtr; + for (i = 0; i < localCt; i++) { + if (!localPtr->isTemp) { + currInfo = &localPtr->resolveInfo; + if ( (currInfo->fetchProc == vinfo.fetchProc) && + (currInfo->identity == vinfo.identity) ) { + return i; + } + } + localPtr = localPtr->nextPtr; + } + goto createCompiledLocal; + } + else if (result != TCL_CONTINUE) { + return -1; + } + } + + /* * Create a new variable if appropriate. */ +createCompiledLocal: + if (createIfNew || (name == NULL)) { localIndex = procPtr->numCompiledLocals; localPtr = (CompiledLocal *) ckalloc((unsigned) @@ -6650,6 +6729,9 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr) localPtr->isTemp = (name == NULL); localPtr->flags = flagsIfCreated; localPtr->defValuePtr = NULL; + localPtr->resolveInfo.identity = vinfo.identity; + localPtr->resolveInfo.fetchProc = vinfo.fetchProc; + localPtr->resolveInfo.deleteProc = vinfo.deleteProc; if (name != NULL) { memcpy((VOID *) localPtr->name, (VOID *) name, (size_t) nameChars); } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 67435a3..62581f2 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -6,7 +6,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * SCCS: %Z% $Id: tclCompile.h,v 1.3 1998/07/01 17:57:17 escoffon Exp $ + * SCCS: %Z% $Id: tclCompile.h,v 1.4 1998/07/06 14:54:36 welch Exp $ */ #ifndef _TCLCOMPILATION @@ -339,6 +339,14 @@ typedef struct ByteCode { * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ + Namespace *nsPtr; /* Namespace context in which this code + * was compiled. If the code is executed + * if a different namespace, it must be + * recompiled. */ + int nsEpoch; /* Value of nsPtr->resolverEpoch when this + * ByteCode was compiled. Used to invalidate + * code when new namespace resolution rules + * are put into effect. */ int refCount; /* Reference count: set 1 when created * plus 1 for each execution of the code * currently active. This structure can be -- cgit v0.12