summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclCompile.c219
1 files changed, 128 insertions, 91 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index ce607d7..771edaa 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.9 1998/07/24 15:50:11 stanton Exp $
+ * SCCS: %Z% $Id: tclCompile.c,v 1.10 1998/08/07 11:46:30 stanton Exp $
*/
#include "tclInt.h"
@@ -521,14 +521,15 @@ TclPrintByteCodeObj(interp, objPtr)
if (numCompiledLocals > 0) {
CompiledLocal *localPtr = procPtr->firstLocalPtr;
for (i = 0; i < numCompiledLocals; i++) {
- fprintf(stdout, " %d: slot %d%s%s%s%s%s",
+ fprintf(stdout, " %d: slot %d%s%s%s%s%s%s",
i, localPtr->frameIndex,
((localPtr->flags & VAR_SCALAR)? ", scalar" : ""),
((localPtr->flags & VAR_ARRAY)? ", array" : ""),
((localPtr->flags & VAR_LINK)? ", link" : ""),
- (localPtr->isArg? ", arg" : ""),
- (localPtr->isTemp? ", temp" : ""));
- if (localPtr->isTemp) {
+ ((localPtr->flags & VAR_ARGUMENT)? ", arg" : ""),
+ ((localPtr->flags & VAR_TEMPORARY)? ", temp" : ""),
+ ((localPtr->flags & VAR_RESOLVED)? ", resolved" : ""));
+ if (TclIsVarTemporary(localPtr)) {
fprintf(stdout, "\n");
} else {
fprintf(stdout, ", name=\"%s\"\n", localPtr->name);
@@ -782,7 +783,7 @@ TclPrintInstruction(codePtr, pc)
for (j = 0; j < opnd; j++) {
localPtr = localPtr->nextPtr;
}
- if (localPtr->isTemp) {
+ if (TclIsVarTemporary(localPtr)) {
fprintf(stdout, "%u # temp var %u",
(unsigned int) opnd, (unsigned int) opnd);
} else {
@@ -814,7 +815,7 @@ TclPrintInstruction(codePtr, pc)
for (j = 0; j < opnd; j++) {
localPtr = localPtr->nextPtr;
}
- if (localPtr->isTemp) {
+ if (TclIsVarTemporary(localPtr)) {
fprintf(stdout, "%u # temp var %u",
(unsigned int) opnd, (unsigned int) opnd);
} else {
@@ -935,7 +936,7 @@ FreeByteCodeInternalRep(objPtr)
/*
*----------------------------------------------------------------------
*
- * CleanupByteCode --
+ * TclCleanupByteCode --
*
* This procedure does all the real work of freeing up a bytecode
* object's ByteCode structure. It's called only when the structure's
@@ -6615,15 +6616,7 @@ 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;
+ int localCt;
/*
* If not creating a temporary, does a local variable of the specified
@@ -6634,7 +6627,7 @@ LookupCompiledLocal(name, nameChars, createIfNew, flagsIfCreated, procPtr)
localCt = procPtr->numCompiledLocals;
localPtr = procPtr->firstLocalPtr;
for (i = 0; i < localCt; i++) {
- if (!localPtr->isTemp) {
+ if (!TclIsVarTemporary(localPtr)) {
char *localName = localPtr->name;
if ((name[0] == localName[0])
&& (nameChars == localPtr->nameLength)
@@ -6647,71 +6640,9 @@ 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 &&
- (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)
@@ -6726,20 +6657,13 @@ createCompiledLocal:
localPtr->nextPtr = NULL;
localPtr->nameLength = nameChars;
localPtr->frameIndex = localIndex;
- localPtr->isArg = 0;
- localPtr->isTemp = (name == NULL);
localPtr->flags = flagsIfCreated;
+ if (name == NULL) {
+ localPtr->flags |= VAR_TEMPORARY;
+ }
localPtr->defValuePtr = NULL;
localPtr->resolveInfo = NULL;
-
- if (vinfo.fetchProc) {
- localPtr->resolveInfo =
- (Tcl_ResolvedVarInfo *) ckalloc( sizeof(Tcl_ResolvedVarInfo) );
- 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);
}
@@ -6752,6 +6676,119 @@ createCompiledLocal:
/*
*----------------------------------------------------------------------
*
+ * TclInitCompiledLocals --
+ *
+ * This routine is invoked in order to initialize the compiled
+ * locals table for a new call frame.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May invoke various name resolvers in order to determine which
+ * variables are being referenced at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitCompiledLocals(interp, framePtr, nsPtr)
+ Tcl_Interp *interp; /* Current interpreter. */
+ CallFrame *framePtr; /* Call frame to initialize. */
+ Namespace *nsPtr; /* Pointer to current namespace. */
+{
+ register CompiledLocal *localPtr;
+ Interp *iPtr = (Interp*) interp;
+ Tcl_ResolvedVarInfo *vinfo, *resVarInfo;
+ Var *varPtr = framePtr->compiledLocals;
+ Var *resolvedVarPtr;
+ ResolverScheme *resPtr;
+ int result;
+
+ /*
+ * Initialize the array of local variables stored in the call frame.
+ * Some variables may have special resolution rules. In that case,
+ * we call their "resolver" procs to get our hands on the variable,
+ * and we make the compiled local a link to the real variable.
+ */
+
+ for (localPtr = framePtr->procPtr->firstLocalPtr;
+ localPtr != NULL;
+ localPtr = localPtr->nextPtr) {
+
+ /*
+ * Check to see if this local is affected by namespace or
+ * interp resolvers. The resolver to use is cached for the
+ * next invocation of the procedure.
+ */
+
+ if (!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_RESOLVED))
+ && (nsPtr->compiledVarResProc || iPtr->resolverPtr)) {
+ resPtr = iPtr->resolverPtr;
+
+ if (nsPtr->compiledVarResProc) {
+ result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
+ localPtr->name, localPtr->nameLength,
+ (Tcl_Namespace *) nsPtr, &vinfo);
+ } else {
+ result = TCL_CONTINUE;
+ }
+
+ while ((result == TCL_CONTINUE) && resPtr) {
+ if (resPtr->compiledVarResProc) {
+ result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+ localPtr->name, localPtr->nameLength,
+ (Tcl_Namespace *) nsPtr, &vinfo);
+ }
+ resPtr = resPtr->nextPtr;
+ }
+ if (result == TCL_OK) {
+ localPtr->resolveInfo = vinfo;
+ localPtr->flags |= VAR_RESOLVED;
+ }
+ }
+
+ /*
+ * Now invoke the resolvers to determine the exact variables that
+ * should be used.
+ */
+
+ resVarInfo = localPtr->resolveInfo;
+ resolvedVarPtr = NULL;
+
+ if (resVarInfo && resVarInfo->fetchProc) {
+ resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
+ resVarInfo);
+ }
+
+ if (resolvedVarPtr) {
+ varPtr->name = localPtr->name; /* will be just '\0' if temp var */
+ varPtr->nsPtr = NULL;
+ varPtr->hPtr = NULL;
+ varPtr->refCount = 0;
+ varPtr->tracePtr = NULL;
+ varPtr->searchPtr = NULL;
+ varPtr->flags = 0;
+ TclSetVarLink(varPtr);
+ varPtr->value.linkPtr = resolvedVarPtr;
+ resolvedVarPtr->refCount++;
+ } else {
+ varPtr->value.objPtr = NULL;
+ varPtr->name = localPtr->name; /* will be just '\0' if temp var */
+ varPtr->nsPtr = NULL;
+ varPtr->hPtr = NULL;
+ varPtr->refCount = 0;
+ varPtr->tracePtr = NULL;
+ varPtr->searchPtr = NULL;
+ varPtr->flags = (localPtr->flags | VAR_UNDEFINED);
+ }
+ varPtr++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* AdvanceToNextWord --
*
* This procedure is called to skip over any leading white space at the