Index: tcl.h =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v retrieving revision 1.234 diff -d -u -r1.234 tcl.h --- tcl.h 31 Jul 2007 17:03:35 -0000 1.234 +++ tcl.h 19 Aug 2007 09:14:33 -0000 @@ -835,6 +835,21 @@ * namespace. */ } Tcl_Namespace; +#ifdef ARNULF_FOR_ITCL_CODE +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; +#endif + /* * 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 +886,9 @@ char *dummy10; char *dummy11; char *dummy12; +#ifdef ARNULF_FOR_ITCL_CODE + char *dummy13; +#endif } Tcl_CallFrame; /* Index: tclInt.h =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v retrieving revision 1.329 diff -d -u -r1.329 tclInt.h --- tclInt.h 7 Aug 2007 17:28:39 -0000 1.329 +++ tclInt.h 19 Aug 2007 09:15:16 -0000 @@ -320,6 +320,9 @@ NamespacePathEntry *commandPathSourceList; /* Linked list of path entries that point to * this namespace. */ +#ifdef ARNULF_FOR_ITCL_CODE + Tcl_Resolve *resolvePtr; +#endif } Namespace; /* @@ -960,6 +963,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) @@ -1044,10 +1048,21 @@ * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; +#ifdef ARNULF_FOR_ITCL_CODE + 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 + */ +#endif } CallFrame; #define FRAME_IS_PROC 0x1 #define FRAME_IS_LAMBDA 0x2 +#ifdef ARNULF_FOR_ITCL_CODE +#define FRAME_HAS_RESOLVER 0x100 +#endif /* * TIP #280 Index: tclNamesp.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v retrieving revision 1.148 diff -d -u -r1.148 tclNamesp.c --- tclNamesp.c 3 Aug 2007 13:51:40 -0000 1.148 +++ tclNamesp.c 19 Aug 2007 09:16:19 -0000 @@ -813,6 +813,9 @@ nsPtr->commandPathLength = 0; nsPtr->commandPathArray = NULL; nsPtr->commandPathSourceList = NULL; +#ifdef ARNULF_FOR_ITCL_CODE + nsPtr->resolvePtr = NULL; +#endif if (parentPtr != NULL) { entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName, @@ -2354,6 +2357,13 @@ register Command *cmdPtr; const char *simpleName; int result; +#ifdef ARNULF_FOR_ITCL_CODE + int frame_has_resolver = 0; + if (iPtr->varFramePtr != NULL) { + frame_has_resolver = iPtr->varFramePtr->isProcCallFrame & + FRAME_HAS_RESOLVER; + } +#endif /* * If this namespace has a command resolver, then give it first crack at @@ -2396,6 +2406,18 @@ return (Tcl_Command) NULL; } } +#ifdef ARNULF_FOR_ITCL_CODE + 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; + } + } + } +#endif /* * Find the namespace(s) that contain the command. @@ -3269,6 +3291,12 @@ */ Interp *iPtr = (Interp *) interp; +#ifdef ARNULF_FOR_ITCL_CODE + if (((Namespace *)namespacePtr)->resolvePtr != NULL) { + framePtr->isProcCallFrame |= FRAME_HAS_RESOLVER; + framePtr->resolvePtr = ((Namespace *)namespacePtr)->resolvePtr; + } +#endif result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr, 3); } else { @@ -3284,6 +3312,12 @@ * TIP #280: Make invoking context available to eval'd script. */ +#ifdef ARNULF_FOR_ITCL_CODE + if (((Namespace *)namespacePtr)->resolvePtr != NULL) { + framePtr->isProcCallFrame |= FRAME_HAS_RESOLVER; + framePtr->resolvePtr = ((Namespace *)namespacePtr)->resolvePtr; + } +#endif result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0); } @@ -5984,6 +6018,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: tclProc.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v retrieving revision 1.127 diff -d -u -r1.127 tclProc.c --- tclProc.c 4 Aug 2007 18:32:27 -0000 1.127 +++ tclProc.c 19 Aug 2007 09:16:35 -0000 @@ -1114,6 +1114,7 @@ * *---------------------------------------------------------------------- */ + void TclInitCompiledLocals( Tcl_Interp *interp, /* Current interpreter. */ @@ -1170,6 +1171,10 @@ int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr); CompiledLocal *firstLocalPtr, *localPtr; int varNum; +#ifdef ARNULF_FOR_ITCL_CODE + int frame_has_resolver = iPtr->varFramePtr->isProcCallFrame & FRAME_HAS_RESOLVER; +#endif + /* * Find the localPtr corresponding to varPtr @@ -1186,7 +1191,11 @@ //maybe for VAR_TEMPORARY? Who cares really?) A job for tbcload, not us. */ - if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) { + if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS)) +#ifdef ARNULF_FOR_ITCL_CODE + && !frame_has_resolver +#endif + ) { /* * Initialize the array of local variables stored in the call frame. * Some variables may have special resolution rules. In that case, we @@ -1195,7 +1204,11 @@ */ doInitCompiledLocals: - if (!haveResolvers) { + if (!haveResolvers +#ifdef ARNULF_FOR_ITCL_CODE + && !frame_has_resolver +#endif + ) { /* * Should not be called: deadwood. */ @@ -1223,7 +1236,7 @@ (*resVarInfo->fetchProc)(interp, resVarInfo); if (resolvedVarPtr) { VarHashRefCount(resolvedVarPtr)++; - varPtr->flags = VAR_LINK; + TclSetVarLink(varPtr); varPtr->value.linkPtr = resolvedVarPtr; } } @@ -1275,6 +1288,25 @@ localPtr->flags |= VAR_RESOLVED; } } +#ifdef ARNULF_FOR_ITCL_CODE + 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++; + } +#endif } localPtr = firstLocalPtr; codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS; @@ -1373,6 +1405,9 @@ register Var *varPtr, *defPtr; int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax; Tcl_Obj *const *argObjs; +#ifdef ARNULF_FOR_ITCL_CODE + int haveFrameResolver = framePtr->isProcCallFrame & FRAME_HAS_RESOLVER; +#endif /* * Make sure that the local cache of variable names and initial values has @@ -1482,7 +1517,11 @@ correctArgs: if (numArgs < localCt) { - if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) { + if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr +#ifdef ARNULF_FOR_ITCL_CODE + && !haveFrameResolver +#endif + ) { memset(varPtr, 0, (localCt - numArgs)*sizeof(Var)); } else { InitCompiledLocals(interp, codePtr, varPtr, framePtr->nsPtr); @@ -2711,6 +2750,9 @@ (overflow ? limit : nameLen), procName, (overflow ? "..." : ""), interp->errorLine)); } /* * Local Variables: Index: tclVar.c =================================================================== RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v retrieving revision 1.149 diff -d -u -r1.149 tclVar.c --- tclVar.c 4 Aug 2007 18:32:28 -0000 1.149 +++ tclVar.c 19 Aug 2007 09:17:05 -0000 @@ -880,6 +880,50 @@ } } +#ifdef ARNULF_FOR_ITCL_CODE + int frame_has_resolver = 0; + if (iPtr->varFramePtr != NULL) { + frame_has_resolver = iPtr->varFramePtr->isProcCallFrame & + FRAME_HAS_RESOLVER; + } + /* + * 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 && (iPtr->varFramePtr->resolvePtr) && + !(flags & LOOKUP_FOR_UPVAR)) { + Var *resolvedVarPtr = NULL; + Tcl_Resolve *resolvePtr = iPtr->varFramePtr->resolvePtr; + if (resolvePtr->varProcPtr != NULL) { + 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; + } + } + } + } +#endif + /* * Look up varName. Look it up as either a namespace variable or as a * local variable in a procedure call frame (varFramePtr). Interpret