1 |
dashley |
71 |
/* $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 */ |