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