Posted to tcl by apw at Sun Aug 19 09:30:04 GMT 2007view raw
- 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
Comments
Posted by apw at Sun Aug 19 09:40:20 GMT 2007 [text] [code]
The idea of the CallFrame resolvers is to lookup variables in just another namespace the the callframe namespace using the Tcl_FindNamespaceVar function and return the result of that call. Similar for Commands. The resolution ther includes where to lookup namespace1::method1 stuff where the class namespaces are not in hierarchical order concerning namespace names. example: namespace eval ::class1::ns1 { proc ns1m1 {} {} } namespace eval ::class2::ns2 { proc ns2m1 {} { ns1::ns1m1 } } In that case normal namespace resolution does not work and for Itcl I cannot use namespace path for other reasons