Attachment "1779249.patch" to
ticket [1779249fff]
added by
dgp
2007-09-01 01:13:36.
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.234
diff -u -r1.234 tcl.h
--- generic/tcl.h 31 Jul 2007 17:03:35 -0000 1.234
+++ generic/tcl.h 31 Aug 2007 18:10:43 -0000
@@ -835,6 +835,19 @@
* namespace. */
} Tcl_Namespace;
+struct Tcl_Resolve;
+typedef Tcl_Command (Tcl_CmdAliasProc)(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr, CONST char *cmdName,
+ struct Tcl_Resolve *resolvePtr);
+typedef Tcl_Var (Tcl_VarAliasProc)(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr, CONST char *varName,
+ struct Tcl_Resolve *resolvePtr);
+typedef struct Tcl_Resolve {
+ Tcl_VarAliasProc *varProcPtr;
+ Tcl_CmdAliasProc *cmdProcPtr;
+ ClientData clientData;
+} Tcl_Resolve;
+
/*
* The following structure represents a call frame, or activation record. A
* call frame defines a naming context for a procedure call: its local scope
@@ -871,6 +884,7 @@
char *dummy10;
char *dummy11;
char *dummy12;
+ char *dummy13;
} Tcl_CallFrame;
/*
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.333
diff -u -r1.333 tclInt.h
--- generic/tclInt.h 23 Aug 2007 00:27:15 -0000 1.333
+++ generic/tclInt.h 31 Aug 2007 18:10:43 -0000
@@ -320,6 +320,7 @@
NamespacePathEntry *commandPathSourceList;
/* Linked list of path entries that point to
* this namespace. */
+ Tcl_Resolve *resolvePtr;
} Namespace;
/*
@@ -961,6 +962,7 @@
ClientData clientData; /* Value to pass to proc. */
} AssocData;
+
/*
* The structure below defines a call frame. A call frame defines a naming
* context for a procedure call: its local naming scope (for local variables)
@@ -1045,10 +1047,17 @@
* meaning of the value is, which we do not
* specify. */
LocalCache *localCachePtr;
+ Tcl_Resolve *resolvePtr;
+ /* points to a struct with info for command
+ * and variable resolving, may be NULL.
+ * Only relevant if flag FRAME_HAS_RESOLVER in
+ * isProcCallFrame is set
+ */
} CallFrame;
#define FRAME_IS_PROC 0x1
#define FRAME_IS_LAMBDA 0x2
+#define FRAME_HAS_RESOLVER 0x100
/*
* TIP #280
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.148
diff -u -r1.148 tclNamesp.c
--- generic/tclNamesp.c 3 Aug 2007 13:51:40 -0000 1.148
+++ generic/tclNamesp.c 31 Aug 2007 18:10:43 -0000
@@ -813,6 +813,7 @@
nsPtr->commandPathLength = 0;
nsPtr->commandPathArray = NULL;
nsPtr->commandPathSourceList = NULL;
+ nsPtr->resolvePtr = NULL;
if (parentPtr != NULL) {
entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
@@ -2354,6 +2355,11 @@
register Command *cmdPtr;
const char *simpleName;
int result;
+ int frame_has_resolver = 0;
+ if (iPtr->varFramePtr != NULL) {
+ frame_has_resolver = iPtr->varFramePtr->isProcCallFrame &
+ FRAME_HAS_RESOLVER;
+ }
/*
* If this namespace has a command resolver, then give it first crack at
@@ -2396,6 +2402,16 @@
return (Tcl_Command) NULL;
}
}
+ if (frame_has_resolver && (iPtr->varFramePtr->resolvePtr)) {
+ Tcl_Command resolvedCmdPtr = NULL;
+ Tcl_Resolve *resolvePtr = iPtr->varFramePtr->resolvePtr;
+ if (resolvePtr->cmdProcPtr != NULL) {
+ resolvedCmdPtr = (resolvePtr->cmdProcPtr)(interp, (Tcl_Namespace *)iPtr->varFramePtr->nsPtr, name, resolvePtr);
+ if (resolvedCmdPtr != NULL) {
+ return resolvedCmdPtr;
+ }
+ }
+ }
/*
* Find the namespace(s) that contain the command.
@@ -3269,6 +3285,10 @@
*/
Interp *iPtr = (Interp *) interp;
+ if (((Namespace *)namespacePtr)->resolvePtr != NULL) {
+ framePtr->isProcCallFrame |= FRAME_HAS_RESOLVER;
+ framePtr->resolvePtr = ((Namespace *)namespacePtr)->resolvePtr;
+ }
result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr, 3);
} else {
@@ -3280,6 +3300,10 @@
objPtr = Tcl_ConcatObj(objc-3, objv+3);
+ if (((Namespace *)namespacePtr)->resolvePtr != NULL) {
+ framePtr->isProcCallFrame |= FRAME_HAS_RESOLVER;
+ framePtr->resolvePtr = ((Namespace *)namespacePtr)->resolvePtr;
+ }
/*
* TIP #280: Make invoking context available to eval'd script.
*/
@@ -5984,6 +6008,11 @@
int reparseCount = 0; /* Number of reparses. */
if (objc < 2) {
+#ifdef ARNULF_FOR_ITCL_CODE
+ if (ensemblePtr->unknownHandler != NULL) {
+ goto unknownOrAmbiguousSubcommand;
+ }
+#endif
Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?");
return TCL_ERROR;
}
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.131
diff -u -r1.131 tclProc.c
--- generic/tclProc.c 10 Aug 2007 00:43:44 -0000 1.131
+++ generic/tclProc.c 31 Aug 2007 18:10:43 -0000
@@ -1170,6 +1170,8 @@
CompiledLocal *firstLocalPtr, *localPtr;
int varNum;
Tcl_ResolvedVarInfo *resVarInfo;
+ int frame_has_resolver = iPtr->varFramePtr->isProcCallFrame & FRAME_HAS_RESOLVER;
+
/*
* Find the localPtr corresponding to varPtr
@@ -1181,7 +1183,8 @@
localPtr = localPtr->nextPtr;
}
- if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) {
+ if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS)) &&
+ !frame_has_resolver) {
/*
* Initialize the array of local variables stored in the call frame.
* Some variables may have special resolution rules. In that case, we
@@ -1205,7 +1208,7 @@
(*resVarInfo->fetchProc)(interp, resVarInfo);
if (resolvedVarPtr) {
VarHashRefCount(resolvedVarPtr)++;
- varPtr->flags = VAR_LINK;
+ TclSetVarLink(varPtr);
varPtr->value.linkPtr = resolvedVarPtr;
}
}
@@ -1257,6 +1260,23 @@
localPtr->flags |= VAR_RESOLVED;
}
}
+ if (frame_has_resolver &&
+ !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY)) &&
+ (iPtr->varFramePtr->resolvePtr != NULL)) {
+ Tcl_Resolve *resolvePtr = iPtr->varFramePtr->resolvePtr;
+ varPtr->flags = localPtr->flags;
+ varPtr->value.objPtr = NULL;
+ if (resolvePtr->varProcPtr != NULL) {
+ Var *resolvedVarPtr;
+ resolvedVarPtr = (Var *)(resolvePtr->varProcPtr)(interp, (Tcl_Namespace*)iPtr->varFramePtr->nsPtr, localPtr->name, resolvePtr);
+ if (resolvedVarPtr != NULL) {
+ VarHashRefCount(resolvedVarPtr)++;
+ TclSetVarLink(varPtr);
+ varPtr->value.linkPtr = resolvedVarPtr;
+ }
+ }
+ varPtr++;
+ }
}
localPtr = firstLocalPtr;
codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
@@ -1354,6 +1374,7 @@
register Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
+ int haveFrameResolver = framePtr->isProcCallFrame & FRAME_HAS_RESOLVER;
/*
* Make sure that the local cache of variable names and initial values has
@@ -1463,7 +1484,8 @@
correctArgs:
if (numArgs < localCt) {
- if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) {
+ if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr &&
+ !haveFrameResolver) {
memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
} else {
InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.150
diff -u -r1.150 tclVar.c
--- generic/tclVar.c 17 Aug 2007 01:11:43 -0000 1.150
+++ generic/tclVar.c 31 Aug 2007 18:10:43 -0000
@@ -893,6 +893,55 @@
}
}
+ int frame_has_resolver = 0;
+ Tcl_Resolve *resolvePtr = NULL;
+ if (iPtr->varFramePtr != NULL) {
+ frame_has_resolver = iPtr->varFramePtr->isProcCallFrame &
+ FRAME_HAS_RESOLVER;
+ if (frame_has_resolver) {
+ resolvePtr = iPtr->varFramePtr->resolvePtr;
+ } else {
+ if (iPtr->varFramePtr->nsPtr->resolvePtr != NULL) {
+ frame_has_resolver = 1;
+ resolvePtr = iPtr->varFramePtr->nsPtr->resolvePtr;
+ }
+ }
+ }
+ /*
+ * If this namespace has a call frame variable resolver, then give it
+ * first crack at the variable resolution. It may return a Tcl_Var value,
+ * otherwise just continue
+ */
+
+ if (frame_has_resolver && !(flags & LOOKUP_FOR_UPVAR)) {
+ if ((resolvePtr != NULL) && (resolvePtr->varProcPtr != NULL)) {
+ Var *resolvedVarPtr;
+ resolvedVarPtr = (Var *)(resolvePtr->varProcPtr)(interp, (Tcl_Namespace *)iPtr->varFramePtr->nsPtr, varName, resolvePtr);
+ if (resolvedVarPtr != NULL) {
+ CompiledLocal *lPtr;
+ if (iPtr->varFramePtr->procPtr != NULL) {
+ lPtr = iPtr->varFramePtr->procPtr->firstLocalPtr;
+
+ int j = 0;
+ for (;lPtr != NULL; lPtr = lPtr->nextPtr, j++) {
+ if ((varName[0] == lPtr->name[0])
+ && (strcmp(varName, lPtr->name) == 0)) {
+ if (j > varFramePtr->procPtr->numArgs) {
+ break;
+ } else {
+ resolvedVarPtr = NULL;
+ break;
+ }
+ }
+ }
+ }
+ if (resolvedVarPtr != NULL) {
+ return resolvedVarPtr;
+ }
+ }
+ }
+ }
+
/*
* Look up varName. Look it up as either a namespace variable or as a
* local variable in a procedure call frame (varFramePtr). Interpret
