/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclresolve.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclresolve.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclresolve.c revision 29 by dashley, Sat Oct 8 07:08:47 2016 UTC projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclresolve.c revision 98 by dashley, Sun Dec 18 00:57:31 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclresolve.c,v 1.1.1.1 2001/06/13 04:45:45 dtashley Exp $ */  
   
 /*  
  * tclResolve.c --  
  *  
  *      Contains hooks for customized command/variable name resolution  
  *      schemes.  These hooks allow extensions like [incr Tcl] to add  
  *      their own name resolution rules to the Tcl language.  Rules can  
  *      be applied to a particular namespace, to the interpreter as a  
  *      whole, or both.  
  *  
  * Copyright (c) 1998 Lucent Technologies, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tclresolve.c,v 1.1.1.1 2001/06/13 04:45:45 dtashley Exp $  
  */  
   
 #include "tclInt.h"  
   
 /*  
  * Declarations for procedures local to this file:  
  */  
   
 static void             BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_AddInterpResolvers --  
  *  
  *      Adds a set of command/variable resolution procedures to an  
  *      interpreter.  These procedures are consulted when commands  
  *      are resolved in Tcl_FindCommand, and when variables are  
  *      resolved in TclLookupVar and LookupCompiledLocal.  Each  
  *      namespace may also have its own set of resolution procedures  
  *      which take precedence over those for the interpreter.  
  *  
  *      When a name is resolved, it is handled as follows.  First,  
  *      the name is passed to the resolution procedures for the  
  *      namespace.  If not resolved, the name is passed to each of  
  *      the resolution procedures added to the interpreter.  Finally,  
  *      if still not resolved, the name is handled using the default  
  *      Tcl rules for name resolution.  
  *  
  * Results:  
  *      Returns pointers to the current name resolution procedures  
  *      in the cmdProcPtr, varProcPtr and compiledVarProcPtr  
  *      arguments.  
  *  
  * Side effects:  
  *      If a compiledVarProc is specified, this procedure bumps the  
  *      compileEpoch for the interpreter, forcing all code to be  
  *      recompiled.  If a cmdProc is specified, this procedure bumps  
  *      the cmdRefEpoch in all namespaces, forcing commands to be  
  *      resolved again using the new rules.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)  
   
     Tcl_Interp *interp;                 /* Interpreter whose name resolution  
                                          * rules are being modified. */  
     char *name;                         /* Name of this resolution scheme. */  
     Tcl_ResolveCmdProc *cmdProc;        /* New procedure for command  
                                          * resolution */  
     Tcl_ResolveVarProc *varProc;        /* Procedure for variable resolution  
                                          * at runtime */  
     Tcl_ResolveCompiledVarProc *compiledVarProc;  
                                         /* Procedure for variable resolution  
                                          * at compile time. */  
 {  
     Interp *iPtr = (Interp*)interp;  
     ResolverScheme *resPtr;  
   
     /*  
      *  Since we're adding a new name resolution scheme, we must force  
      *  all code to be recompiled to use the new scheme.  If there  
      *  are new compiled variable resolution rules, bump the compiler  
      *  epoch to invalidate compiled code.  If there are new command  
      *  resolution rules, bump the cmdRefEpoch in all namespaces.  
      */  
     if (compiledVarProc) {  
         iPtr->compileEpoch++;  
     }  
     if (cmdProc) {  
         BumpCmdRefEpochs(iPtr->globalNsPtr);  
     }  
   
     /*  
      *  Look for an existing scheme with the given name.  If found,  
      *  then replace its rules.  
      */  
     for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {  
         if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {  
             resPtr->cmdResProc = cmdProc;  
             resPtr->varResProc = varProc;  
             resPtr->compiledVarResProc = compiledVarProc;  
             return;  
         }  
     }  
   
     /*  
      *  Otherwise, this is a new scheme.  Add it to the FRONT  
      *  of the linked list, so that it overrides existing schemes.  
      */  
     resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));  
     resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));  
     strcpy(resPtr->name, name);  
     resPtr->cmdResProc = cmdProc;  
     resPtr->varResProc = varProc;  
     resPtr->compiledVarResProc = compiledVarProc;  
     resPtr->nextPtr = iPtr->resolverPtr;  
     iPtr->resolverPtr = resPtr;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetInterpResolvers --  
  *  
  *      Looks for a set of command/variable resolution procedures with  
  *      the given name in an interpreter.  These procedures are  
  *      registered by calling Tcl_AddInterpResolvers.  
  *  
  * Results:  
  *      If the name is recognized, this procedure returns non-zero,  
  *      along with pointers to the name resolution procedures in  
  *      the Tcl_ResolverInfo structure.  If the name is not recognized,  
  *      this procedure returns zero.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetInterpResolvers(interp, name, resInfoPtr)  
   
     Tcl_Interp *interp;                 /* Interpreter whose name resolution  
                                          * rules are being queried. */  
     char *name;                         /* Look for a scheme with this name. */  
     Tcl_ResolverInfo *resInfoPtr;       /* Returns pointers to the procedures,  
                                          * if found */  
 {  
     Interp *iPtr = (Interp*)interp;  
     ResolverScheme *resPtr;  
   
     /*  
      *  Look for an existing scheme with the given name.  If found,  
      *  then return pointers to its procedures.  
      */  
     for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {  
         if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {  
             resInfoPtr->cmdResProc = resPtr->cmdResProc;  
             resInfoPtr->varResProc = resPtr->varResProc;  
             resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;  
             return 1;  
         }  
     }  
   
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_RemoveInterpResolvers --  
  *  
  *      Removes a set of command/variable resolution procedures  
  *      previously added by Tcl_AddInterpResolvers.  The next time  
  *      a command/variable name is resolved, these procedures  
  *      won't be consulted.  
  *  
  * Results:  
  *      Returns non-zero if the name was recognized and the  
  *      resolution scheme was deleted.  Returns zero otherwise.  
  *  
  * Side effects:  
  *      If a scheme with a compiledVarProc was deleted, this procedure  
  *      bumps the compileEpoch for the interpreter, forcing all code  
  *      to be recompiled.  If a scheme with a cmdProc was deleted,  
  *      this procedure bumps the cmdRefEpoch in all namespaces,  
  *      forcing commands to be resolved again using the new rules.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_RemoveInterpResolvers(interp, name)  
   
     Tcl_Interp *interp;                 /* Interpreter whose name resolution  
                                          * rules are being modified. */  
     char *name;                         /* Name of the scheme to be removed. */  
 {  
     Interp *iPtr = (Interp*)interp;  
     ResolverScheme **prevPtrPtr, *resPtr;  
   
     /*  
      *  Look for an existing scheme with the given name.  
      */  
     prevPtrPtr = &iPtr->resolverPtr;  
     for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {  
         if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {  
             break;  
         }  
         prevPtrPtr = &resPtr->nextPtr;  
     }  
   
     /*  
      *  If we found the scheme, delete it.  
      */  
     if (resPtr) {  
         /*  
          *  If we're deleting a scheme with compiled variable resolution  
          *  rules, bump the compiler epoch to invalidate compiled code.  
          *  If we're deleting a scheme with command resolution rules,  
          *  bump the cmdRefEpoch in all namespaces.  
          */  
         if (resPtr->compiledVarResProc) {  
             iPtr->compileEpoch++;  
         }  
         if (resPtr->cmdResProc) {  
             BumpCmdRefEpochs(iPtr->globalNsPtr);  
         }  
   
         *prevPtrPtr = resPtr->nextPtr;  
         ckfree(resPtr->name);  
         ckfree((char *) resPtr);  
   
         return 1;  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * BumpCmdRefEpochs --  
  *  
  *      This procedure is used to bump the cmdRefEpoch counters in  
  *      the specified namespace and all of its child namespaces.  
  *      It is used whenever name resolution schemes are added/removed  
  *      from an interpreter, to invalidate all command references.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Bumps the cmdRefEpoch in the specified namespace and its  
  *      children, recursively.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 BumpCmdRefEpochs(nsPtr)  
     Namespace *nsPtr;                   /* Namespace being modified. */  
 {  
     Tcl_HashEntry *entry;  
     Tcl_HashSearch search;  
     Namespace *childNsPtr;  
   
     nsPtr->cmdRefEpoch++;  
   
     for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);  
             entry != NULL;  
             entry = Tcl_NextHashEntry(&search)) {  
   
         childNsPtr = (Namespace *) Tcl_GetHashValue(entry);  
         BumpCmdRefEpochs(childNsPtr);  
     }  
 }  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_SetNamespaceResolvers --  
  *  
  *      Sets the command/variable resolution procedures for a namespace,  
  *      thereby changing the way that command/variable names are  
  *      interpreted.  This allows extension writers to support different  
  *      name resolution schemes, such as those for object-oriented  
  *      packages.  
  *  
  *      Command resolution is handled by a procedure of the following  
  *      type:  
  *  
  *        typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((  
  *              Tcl_Interp* interp, char* name, Tcl_Namespace *context,  
  *              int flags, Tcl_Command *rPtr));  
  *            
  *      Whenever a command is executed or Tcl_FindCommand is invoked  
  *      within the namespace, this procedure is called to resolve the  
  *      command name.  If this procedure is able to resolve the name,  
  *      it should return the status code TCL_OK, along with the  
  *      corresponding Tcl_Command in the rPtr argument.  Otherwise,  
  *      the procedure can return TCL_CONTINUE, and the command will  
  *      be treated under the usual name resolution rules.  Or, it can  
  *      return TCL_ERROR, and the command will be considered invalid.  
  *  
  *      Variable resolution is handled by two procedures.  The first  
  *      is called whenever a variable needs to be resolved at compile  
  *      time:  
  *  
  *        typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((  
  *              Tcl_Interp* interp, char* name, Tcl_Namespace *context,  
  *              Tcl_ResolvedVarInfo *rPtr));  
  *  
  *      If this procedure is able to resolve the name, it should return  
  *      the status code TCL_OK, along with variable resolution info in  
  *      the rPtr argument; this info will be used to set up compiled  
  *      locals in the call frame at runtime.  The procedure may also  
  *      return TCL_CONTINUE, and the variable will be treated under  
  *      the usual name resolution rules.  Or, it can return TCL_ERROR,  
  *      and the variable will be considered invalid.  
  *  
  *      Another procedure is used whenever a variable needs to be  
  *      resolved at runtime but it is not recognized as a compiled local.  
  *      (For example, the variable may be requested via  
  *      Tcl_FindNamespaceVar.) This procedure has the following type:  
  *  
  *        typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((  
  *              Tcl_Interp* interp, char* name, Tcl_Namespace *context,  
  *              int flags, Tcl_Var *rPtr));  
  *  
  *      This procedure is quite similar to the compile-time version.  
  *      It returns the same status codes, but if variable resolution  
  *      succeeds, this procedure returns a Tcl_Var directly via the  
  *      rPtr argument.  
  *  
  * Results:  
  *      Nothing.  
  *  
  * Side effects:  
  *      Bumps the command epoch counter for the namespace, invalidating  
  *      all command references in that namespace.  Also bumps the  
  *      resolver epoch counter for the namespace, forcing all code  
  *      in the namespace to be recompiled.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)  
     Tcl_Namespace *namespacePtr;        /* Namespace whose resolution rules  
                                          * are being modified. */  
     Tcl_ResolveCmdProc *cmdProc;        /* Procedure for command resolution */  
     Tcl_ResolveVarProc *varProc;        /* Procedure for variable resolution  
                                          * at runtime */  
     Tcl_ResolveCompiledVarProc *compiledVarProc;  
                                         /* Procedure for variable resolution  
                                          * at compile time. */  
 {  
     Namespace *nsPtr = (Namespace*)namespacePtr;  
   
     /*  
      *  Plug in the new command resolver, and bump the epoch counters  
      *  so that all code will have to be recompiled and all commands  
      *  will have to be resolved again using the new policy.  
      */  
     nsPtr->cmdResProc = cmdProc;  
     nsPtr->varResProc = varProc;  
     nsPtr->compiledVarResProc = compiledVarProc;  
   
     nsPtr->cmdRefEpoch++;  
     nsPtr->resolverEpoch++;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetNamespaceResolvers --  
  *  
  *      Returns the current command/variable resolution procedures  
  *      for a namespace.  By default, these procedures are NULL.  
  *      New procedures can be installed by calling  
  *      Tcl_SetNamespaceResolvers, to provide new name resolution  
  *      rules.  
  *  
  * Results:  
  *      Returns non-zero if any name resolution procedures have been  
  *      assigned to this namespace; also returns pointers to the  
  *      procedures in the Tcl_ResolverInfo structure.  Returns zero  
  *      otherwise.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)  
   
     Tcl_Namespace *namespacePtr;        /* Namespace whose resolution rules  
                                          * are being modified. */  
     Tcl_ResolverInfo *resInfoPtr;       /* Returns: pointers for all  
                                          * name resolution procedures  
                                          * assigned to this namespace. */  
 {  
     Namespace *nsPtr = (Namespace*)namespacePtr;  
   
     resInfoPtr->cmdResProc = nsPtr->cmdResProc;  
     resInfoPtr->varResProc = nsPtr->varResProc;  
     resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;  
   
     if (nsPtr->cmdResProc != NULL ||  
         nsPtr->varResProc != NULL ||  
         nsPtr->compiledVarResProc != NULL) {  
         return 1;  
     }  
     return 0;  
 }  
   
   
 /* $History: tclresolve.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:04a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLRESOLVE.C */  
1    /* $Header$ */
2    /*
3     * tclResolve.c --
4     *
5     *      Contains hooks for customized command/variable name resolution
6     *      schemes.  These hooks allow extensions like [incr Tcl] to add
7     *      their own name resolution rules to the Tcl language.  Rules can
8     *      be applied to a particular namespace, to the interpreter as a
9     *      whole, or both.
10     *
11     * Copyright (c) 1998 Lucent Technologies, Inc.
12     *
13     * See the file "license.terms" for information on usage and redistribution
14     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15     *
16     * RCS: @(#) $Id: tclresolve.c,v 1.1.1.1 2001/06/13 04:45:45 dtashley Exp $
17     */
18    
19    #include "tclInt.h"
20    
21    /*
22     * Declarations for procedures local to this file:
23     */
24    
25    static void             BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
26    
27    
28    /*
29     *----------------------------------------------------------------------
30     *
31     * Tcl_AddInterpResolvers --
32     *
33     *      Adds a set of command/variable resolution procedures to an
34     *      interpreter.  These procedures are consulted when commands
35     *      are resolved in Tcl_FindCommand, and when variables are
36     *      resolved in TclLookupVar and LookupCompiledLocal.  Each
37     *      namespace may also have its own set of resolution procedures
38     *      which take precedence over those for the interpreter.
39     *
40     *      When a name is resolved, it is handled as follows.  First,
41     *      the name is passed to the resolution procedures for the
42     *      namespace.  If not resolved, the name is passed to each of
43     *      the resolution procedures added to the interpreter.  Finally,
44     *      if still not resolved, the name is handled using the default
45     *      Tcl rules for name resolution.
46     *
47     * Results:
48     *      Returns pointers to the current name resolution procedures
49     *      in the cmdProcPtr, varProcPtr and compiledVarProcPtr
50     *      arguments.
51     *
52     * Side effects:
53     *      If a compiledVarProc is specified, this procedure bumps the
54     *      compileEpoch for the interpreter, forcing all code to be
55     *      recompiled.  If a cmdProc is specified, this procedure bumps
56     *      the cmdRefEpoch in all namespaces, forcing commands to be
57     *      resolved again using the new rules.
58     *
59     *----------------------------------------------------------------------
60     */
61    
62    void
63    Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
64    
65        Tcl_Interp *interp;                 /* Interpreter whose name resolution
66                                             * rules are being modified. */
67        char *name;                         /* Name of this resolution scheme. */
68        Tcl_ResolveCmdProc *cmdProc;        /* New procedure for command
69                                             * resolution */
70        Tcl_ResolveVarProc *varProc;        /* Procedure for variable resolution
71                                             * at runtime */
72        Tcl_ResolveCompiledVarProc *compiledVarProc;
73                                            /* Procedure for variable resolution
74                                             * at compile time. */
75    {
76        Interp *iPtr = (Interp*)interp;
77        ResolverScheme *resPtr;
78    
79        /*
80         *  Since we're adding a new name resolution scheme, we must force
81         *  all code to be recompiled to use the new scheme.  If there
82         *  are new compiled variable resolution rules, bump the compiler
83         *  epoch to invalidate compiled code.  If there are new command
84         *  resolution rules, bump the cmdRefEpoch in all namespaces.
85         */
86        if (compiledVarProc) {
87            iPtr->compileEpoch++;
88        }
89        if (cmdProc) {
90            BumpCmdRefEpochs(iPtr->globalNsPtr);
91        }
92    
93        /*
94         *  Look for an existing scheme with the given name.  If found,
95         *  then replace its rules.
96         */
97        for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
98            if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
99                resPtr->cmdResProc = cmdProc;
100                resPtr->varResProc = varProc;
101                resPtr->compiledVarResProc = compiledVarProc;
102                return;
103            }
104        }
105    
106        /*
107         *  Otherwise, this is a new scheme.  Add it to the FRONT
108         *  of the linked list, so that it overrides existing schemes.
109         */
110        resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
111        resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
112        strcpy(resPtr->name, name);
113        resPtr->cmdResProc = cmdProc;
114        resPtr->varResProc = varProc;
115        resPtr->compiledVarResProc = compiledVarProc;
116        resPtr->nextPtr = iPtr->resolverPtr;
117        iPtr->resolverPtr = resPtr;
118    }
119    
120    /*
121     *----------------------------------------------------------------------
122     *
123     * Tcl_GetInterpResolvers --
124     *
125     *      Looks for a set of command/variable resolution procedures with
126     *      the given name in an interpreter.  These procedures are
127     *      registered by calling Tcl_AddInterpResolvers.
128     *
129     * Results:
130     *      If the name is recognized, this procedure returns non-zero,
131     *      along with pointers to the name resolution procedures in
132     *      the Tcl_ResolverInfo structure.  If the name is not recognized,
133     *      this procedure returns zero.
134     *
135     * Side effects:
136     *      None.
137     *
138     *----------------------------------------------------------------------
139     */
140    
141    int
142    Tcl_GetInterpResolvers(interp, name, resInfoPtr)
143    
144        Tcl_Interp *interp;                 /* Interpreter whose name resolution
145                                             * rules are being queried. */
146        char *name;                         /* Look for a scheme with this name. */
147        Tcl_ResolverInfo *resInfoPtr;       /* Returns pointers to the procedures,
148                                             * if found */
149    {
150        Interp *iPtr = (Interp*)interp;
151        ResolverScheme *resPtr;
152    
153        /*
154         *  Look for an existing scheme with the given name.  If found,
155         *  then return pointers to its procedures.
156         */
157        for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
158            if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
159                resInfoPtr->cmdResProc = resPtr->cmdResProc;
160                resInfoPtr->varResProc = resPtr->varResProc;
161                resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
162                return 1;
163            }
164        }
165    
166        return 0;
167    }
168    
169    /*
170     *----------------------------------------------------------------------
171     *
172     * Tcl_RemoveInterpResolvers --
173     *
174     *      Removes a set of command/variable resolution procedures
175     *      previously added by Tcl_AddInterpResolvers.  The next time
176     *      a command/variable name is resolved, these procedures
177     *      won't be consulted.
178     *
179     * Results:
180     *      Returns non-zero if the name was recognized and the
181     *      resolution scheme was deleted.  Returns zero otherwise.
182     *
183     * Side effects:
184     *      If a scheme with a compiledVarProc was deleted, this procedure
185     *      bumps the compileEpoch for the interpreter, forcing all code
186     *      to be recompiled.  If a scheme with a cmdProc was deleted,
187     *      this procedure bumps the cmdRefEpoch in all namespaces,
188     *      forcing commands to be resolved again using the new rules.
189     *
190     *----------------------------------------------------------------------
191     */
192    
193    int
194    Tcl_RemoveInterpResolvers(interp, name)
195    
196        Tcl_Interp *interp;                 /* Interpreter whose name resolution
197                                             * rules are being modified. */
198        char *name;                         /* Name of the scheme to be removed. */
199    {
200        Interp *iPtr = (Interp*)interp;
201        ResolverScheme **prevPtrPtr, *resPtr;
202    
203        /*
204         *  Look for an existing scheme with the given name.
205         */
206        prevPtrPtr = &iPtr->resolverPtr;
207        for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
208            if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
209                break;
210            }
211            prevPtrPtr = &resPtr->nextPtr;
212        }
213    
214        /*
215         *  If we found the scheme, delete it.
216         */
217        if (resPtr) {
218            /*
219             *  If we're deleting a scheme with compiled variable resolution
220             *  rules, bump the compiler epoch to invalidate compiled code.
221             *  If we're deleting a scheme with command resolution rules,
222             *  bump the cmdRefEpoch in all namespaces.
223             */
224            if (resPtr->compiledVarResProc) {
225                iPtr->compileEpoch++;
226            }
227            if (resPtr->cmdResProc) {
228                BumpCmdRefEpochs(iPtr->globalNsPtr);
229            }
230    
231            *prevPtrPtr = resPtr->nextPtr;
232            ckfree(resPtr->name);
233            ckfree((char *) resPtr);
234    
235            return 1;
236        }
237        return 0;
238    }
239    
240    /*
241     *----------------------------------------------------------------------
242     *
243     * BumpCmdRefEpochs --
244     *
245     *      This procedure is used to bump the cmdRefEpoch counters in
246     *      the specified namespace and all of its child namespaces.
247     *      It is used whenever name resolution schemes are added/removed
248     *      from an interpreter, to invalidate all command references.
249     *
250     * Results:
251     *      None.
252     *
253     * Side effects:
254     *      Bumps the cmdRefEpoch in the specified namespace and its
255     *      children, recursively.
256     *
257     *----------------------------------------------------------------------
258     */
259    
260    static void
261    BumpCmdRefEpochs(nsPtr)
262        Namespace *nsPtr;                   /* Namespace being modified. */
263    {
264        Tcl_HashEntry *entry;
265        Tcl_HashSearch search;
266        Namespace *childNsPtr;
267    
268        nsPtr->cmdRefEpoch++;
269    
270        for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
271                entry != NULL;
272                entry = Tcl_NextHashEntry(&search)) {
273    
274            childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
275            BumpCmdRefEpochs(childNsPtr);
276        }
277    }
278    
279    
280    /*
281     *----------------------------------------------------------------------
282     *
283     * Tcl_SetNamespaceResolvers --
284     *
285     *      Sets the command/variable resolution procedures for a namespace,
286     *      thereby changing the way that command/variable names are
287     *      interpreted.  This allows extension writers to support different
288     *      name resolution schemes, such as those for object-oriented
289     *      packages.
290     *
291     *      Command resolution is handled by a procedure of the following
292     *      type:
293     *
294     *        typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
295     *              Tcl_Interp* interp, char* name, Tcl_Namespace *context,
296     *              int flags, Tcl_Command *rPtr));
297     *          
298     *      Whenever a command is executed or Tcl_FindCommand is invoked
299     *      within the namespace, this procedure is called to resolve the
300     *      command name.  If this procedure is able to resolve the name,
301     *      it should return the status code TCL_OK, along with the
302     *      corresponding Tcl_Command in the rPtr argument.  Otherwise,
303     *      the procedure can return TCL_CONTINUE, and the command will
304     *      be treated under the usual name resolution rules.  Or, it can
305     *      return TCL_ERROR, and the command will be considered invalid.
306     *
307     *      Variable resolution is handled by two procedures.  The first
308     *      is called whenever a variable needs to be resolved at compile
309     *      time:
310     *
311     *        typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
312     *              Tcl_Interp* interp, char* name, Tcl_Namespace *context,
313     *              Tcl_ResolvedVarInfo *rPtr));
314     *
315     *      If this procedure is able to resolve the name, it should return
316     *      the status code TCL_OK, along with variable resolution info in
317     *      the rPtr argument; this info will be used to set up compiled
318     *      locals in the call frame at runtime.  The procedure may also
319     *      return TCL_CONTINUE, and the variable will be treated under
320     *      the usual name resolution rules.  Or, it can return TCL_ERROR,
321     *      and the variable will be considered invalid.
322     *
323     *      Another procedure is used whenever a variable needs to be
324     *      resolved at runtime but it is not recognized as a compiled local.
325     *      (For example, the variable may be requested via
326     *      Tcl_FindNamespaceVar.) This procedure has the following type:
327     *
328     *        typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
329     *              Tcl_Interp* interp, char* name, Tcl_Namespace *context,
330     *              int flags, Tcl_Var *rPtr));
331     *
332     *      This procedure is quite similar to the compile-time version.
333     *      It returns the same status codes, but if variable resolution
334     *      succeeds, this procedure returns a Tcl_Var directly via the
335     *      rPtr argument.
336     *
337     * Results:
338     *      Nothing.
339     *
340     * Side effects:
341     *      Bumps the command epoch counter for the namespace, invalidating
342     *      all command references in that namespace.  Also bumps the
343     *      resolver epoch counter for the namespace, forcing all code
344     *      in the namespace to be recompiled.
345     *
346     *----------------------------------------------------------------------
347     */
348    
349    void
350    Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
351        Tcl_Namespace *namespacePtr;        /* Namespace whose resolution rules
352                                             * are being modified. */
353        Tcl_ResolveCmdProc *cmdProc;        /* Procedure for command resolution */
354        Tcl_ResolveVarProc *varProc;        /* Procedure for variable resolution
355                                             * at runtime */
356        Tcl_ResolveCompiledVarProc *compiledVarProc;
357                                            /* Procedure for variable resolution
358                                             * at compile time. */
359    {
360        Namespace *nsPtr = (Namespace*)namespacePtr;
361    
362        /*
363         *  Plug in the new command resolver, and bump the epoch counters
364         *  so that all code will have to be recompiled and all commands
365         *  will have to be resolved again using the new policy.
366         */
367        nsPtr->cmdResProc = cmdProc;
368        nsPtr->varResProc = varProc;
369        nsPtr->compiledVarResProc = compiledVarProc;
370    
371        nsPtr->cmdRefEpoch++;
372        nsPtr->resolverEpoch++;
373    }
374    
375    /*
376     *----------------------------------------------------------------------
377     *
378     * Tcl_GetNamespaceResolvers --
379     *
380     *      Returns the current command/variable resolution procedures
381     *      for a namespace.  By default, these procedures are NULL.
382     *      New procedures can be installed by calling
383     *      Tcl_SetNamespaceResolvers, to provide new name resolution
384     *      rules.
385     *
386     * Results:
387     *      Returns non-zero if any name resolution procedures have been
388     *      assigned to this namespace; also returns pointers to the
389     *      procedures in the Tcl_ResolverInfo structure.  Returns zero
390     *      otherwise.
391     *
392     * Side effects:
393     *      None.
394     *
395     *----------------------------------------------------------------------
396     */
397    
398    int
399    Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
400    
401        Tcl_Namespace *namespacePtr;        /* Namespace whose resolution rules
402                                             * are being modified. */
403        Tcl_ResolverInfo *resInfoPtr;       /* Returns: pointers for all
404                                             * name resolution procedures
405                                             * assigned to this namespace. */
406    {
407        Namespace *nsPtr = (Namespace*)namespacePtr;
408    
409        resInfoPtr->cmdResProc = nsPtr->cmdResProc;
410        resInfoPtr->varResProc = nsPtr->varResProc;
411        resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;
412    
413        if (nsPtr->cmdResProc != NULL ||
414            nsPtr->varResProc != NULL ||
415            nsPtr->compiledVarResProc != NULL) {
416            return 1;
417        }
418        return 0;
419    }
420    
421    /* End of tclresolve.c */
Legend:
Removed from v.29  
changed lines
  Added in v.98
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25