source: trunk/tcl/tclResolve.c@ 8

Last change on this file since 8 was 2, checked in by Pavel Demin, 16 years ago

first commit
File size: 13.7 KB
Line 
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.1 2008-06-04 13:58:10 demin Exp $
16 */
17
18#include "tclInt.h"
19
20/*
21 * Declarations for procedures local to this file:
22 */
23
24static void BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
25
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
62void
63Tcl_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 *
124 * Tcl_GetInterpResolvers --
125 *
126 * Looks for a set of command/variable resolution procedures with
127 * the given name in an interpreter. These procedures are
128 * registered by calling Tcl_AddInterpResolvers.
129 *
130 * Results:
131 * If the name is recognized, this procedure returns non-zero,
132 * along with pointers to the name resolution procedures in
133 * the Tcl_ResolverInfo structure. If the name is not recognized,
134 * this procedure returns zero.
135 *
136 * Side effects:
137 * None.
138 *
139 *----------------------------------------------------------------------
140 */
141
142int
143Tcl_GetInterpResolvers(interp, name, resInfoPtr)
144
145 Tcl_Interp *interp; /* Interpreter whose name resolution
146 * rules are being queried. */
147 char *name; /* Look for a scheme with this name. */
148 Tcl_ResolverInfo *resInfoPtr; /* Returns pointers to the procedures,
149 * if found */
150{
151 Interp *iPtr = (Interp*)interp;
152 ResolverScheme *resPtr;
153
154 /*
155 * Look for an existing scheme with the given name. If found,
156 * then return pointers to its procedures.
157 */
158 for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
159 if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
160 resInfoPtr->cmdResProc = resPtr->cmdResProc;
161 resInfoPtr->varResProc = resPtr->varResProc;
162 resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
163 return 1;
164 }
165 }
166
167 return 0;
168}
169
170
171/*
172 *----------------------------------------------------------------------
173 *
174 * Tcl_RemoveInterpResolvers --
175 *
176 * Removes a set of command/variable resolution procedures
177 * previously added by Tcl_AddInterpResolvers. The next time
178 * a command/variable name is resolved, these procedures
179 * won't be consulted.
180 *
181 * Results:
182 * Returns non-zero if the name was recognized and the
183 * resolution scheme was deleted. Returns zero otherwise.
184 *
185 * Side effects:
186 * If a scheme with a compiledVarProc was deleted, this procedure
187 * bumps the compileEpoch for the interpreter, forcing all code
188 * to be recompiled. If a scheme with a cmdProc was deleted,
189 * this procedure bumps the cmdRefEpoch in all namespaces,
190 * forcing commands to be resolved again using the new rules.
191 *
192 *----------------------------------------------------------------------
193 */
194
195int
196Tcl_RemoveInterpResolvers(interp, name)
197
198 Tcl_Interp *interp; /* Interpreter whose name resolution
199 * rules are being modified. */
200 char *name; /* Name of the scheme to be removed. */
201{
202 Interp *iPtr = (Interp*)interp;
203 ResolverScheme **prevPtrPtr, *resPtr;
204
205 /*
206 * Look for an existing scheme with the given name.
207 */
208 prevPtrPtr = &iPtr->resolverPtr;
209 for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
210 if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
211 break;
212 }
213 prevPtrPtr = &resPtr->nextPtr;
214 }
215
216 /*
217 * If we found the scheme, delete it.
218 */
219 if (resPtr) {
220 /*
221 * If we're deleting a scheme with compiled variable resolution
222 * rules, bump the compiler epoch to invalidate compiled code.
223 * If we're deleting a scheme with command resolution rules,
224 * bump the cmdRefEpoch in all namespaces.
225 */
226 if (resPtr->compiledVarResProc) {
227 iPtr->compileEpoch++;
228 }
229 if (resPtr->cmdResProc) {
230 BumpCmdRefEpochs(iPtr->globalNsPtr);
231 }
232
233 *prevPtrPtr = resPtr->nextPtr;
234 ckfree(resPtr->name);
235 ckfree((char *) resPtr);
236
237 return 1;
238 }
239 return 0;
240}
241
242
243/*
244 *----------------------------------------------------------------------
245 *
246 * BumpCmdRefEpochs --
247 *
248 * This procedure is used to bump the cmdRefEpoch counters in
249 * the specified namespace and all of its child namespaces.
250 * It is used whenever name resolution schemes are added/removed
251 * from an interpreter, to invalidate all command references.
252 *
253 * Results:
254 * None.
255 *
256 * Side effects:
257 * Bumps the cmdRefEpoch in the specified namespace and its
258 * children, recursively.
259 *
260 *----------------------------------------------------------------------
261 */
262
263static void
264BumpCmdRefEpochs(nsPtr)
265 Namespace *nsPtr; /* Namespace being modified. */
266{
267 Tcl_HashEntry *entry;
268 Tcl_HashSearch search;
269 Namespace *childNsPtr;
270
271 nsPtr->cmdRefEpoch++;
272
273 for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
274 entry != NULL;
275 entry = Tcl_NextHashEntry(&search)) {
276
277 childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
278 BumpCmdRefEpochs(childNsPtr);
279 }
280}
281
282
283
284/*
285 *----------------------------------------------------------------------
286 *
287 * Tcl_SetNamespaceResolvers --
288 *
289 * Sets the command/variable resolution procedures for a namespace,
290 * thereby changing the way that command/variable names are
291 * interpreted. This allows extension writers to support different
292 * name resolution schemes, such as those for object-oriented
293 * packages.
294 *
295 * Command resolution is handled by a procedure of the following
296 * type:
297 *
298 * typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
299 * Tcl_Interp* interp, char* name, Tcl_Namespace *context,
300 * int flags, Tcl_Command *rPtr));
301 *
302 * Whenever a command is executed or Tcl_FindCommand is invoked
303 * within the namespace, this procedure is called to resolve the
304 * command name. If this procedure is able to resolve the name,
305 * it should return the status code TCL_OK, along with the
306 * corresponding Tcl_Command in the rPtr argument. Otherwise,
307 * the procedure can return TCL_CONTINUE, and the command will
308 * be treated under the usual name resolution rules. Or, it can
309 * return TCL_ERROR, and the command will be considered invalid.
310 *
311 * Variable resolution is handled by two procedures. The first
312 * is called whenever a variable needs to be resolved at compile
313 * time:
314 *
315 * typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
316 * Tcl_Interp* interp, char* name, Tcl_Namespace *context,
317 * Tcl_ResolvedVarInfo *rPtr));
318 *
319 * If this procedure is able to resolve the name, it should return
320 * the status code TCL_OK, along with variable resolution info in
321 * the rPtr argument; this info will be used to set up compiled
322 * locals in the call frame at runtime. The procedure may also
323 * return TCL_CONTINUE, and the variable will be treated under
324 * the usual name resolution rules. Or, it can return TCL_ERROR,
325 * and the variable will be considered invalid.
326 *
327 * Another procedure is used whenever a variable needs to be
328 * resolved at runtime but it is not recognized as a compiled local.
329 * (For example, the variable may be requested via
330 * Tcl_FindNamespaceVar.) This procedure has the following type:
331 *
332 * typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
333 * Tcl_Interp* interp, char* name, Tcl_Namespace *context,
334 * int flags, Tcl_Var *rPtr));
335 *
336 * This procedure is quite similar to the compile-time version.
337 * It returns the same status codes, but if variable resolution
338 * succeeds, this procedure returns a Tcl_Var directly via the
339 * rPtr argument.
340 *
341 * Results:
342 * Nothing.
343 *
344 * Side effects:
345 * Bumps the command epoch counter for the namespace, invalidating
346 * all command references in that namespace. Also bumps the
347 * resolver epoch counter for the namespace, forcing all code
348 * in the namespace to be recompiled.
349 *
350 *----------------------------------------------------------------------
351 */
352
353void
354Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
355 Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules
356 * are being modified. */
357 Tcl_ResolveCmdProc *cmdProc; /* Procedure for command resolution */
358 Tcl_ResolveVarProc *varProc; /* Procedure for variable resolution
359 * at runtime */
360 Tcl_ResolveCompiledVarProc *compiledVarProc;
361 /* Procedure for variable resolution
362 * at compile time. */
363{
364 Namespace *nsPtr = (Namespace*)namespacePtr;
365
366 /*
367 * Plug in the new command resolver, and bump the epoch counters
368 * so that all code will have to be recompiled and all commands
369 * will have to be resolved again using the new policy.
370 */
371 nsPtr->cmdResProc = cmdProc;
372 nsPtr->varResProc = varProc;
373 nsPtr->compiledVarResProc = compiledVarProc;
374
375 nsPtr->cmdRefEpoch++;
376 nsPtr->resolverEpoch++;
377}
378
379
380/*
381 *----------------------------------------------------------------------
382 *
383 * Tcl_GetNamespaceResolvers --
384 *
385 * Returns the current command/variable resolution procedures
386 * for a namespace. By default, these procedures are NULL.
387 * New procedures can be installed by calling
388 * Tcl_SetNamespaceResolvers, to provide new name resolution
389 * rules.
390 *
391 * Results:
392 * Returns non-zero if any name resolution procedures have been
393 * assigned to this namespace; also returns pointers to the
394 * procedures in the Tcl_ResolverInfo structure. Returns zero
395 * otherwise.
396 *
397 * Side effects:
398 * None.
399 *
400 *----------------------------------------------------------------------
401 */
402
403int
404Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
405
406 Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules
407 * are being modified. */
408 Tcl_ResolverInfo *resInfoPtr; /* Returns: pointers for all
409 * name resolution procedures
410 * assigned to this namespace. */
411{
412 Namespace *nsPtr = (Namespace*)namespacePtr;
413
414 resInfoPtr->cmdResProc = nsPtr->cmdResProc;
415 resInfoPtr->varResProc = nsPtr->varResProc;
416 resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;
417
418 if (nsPtr->cmdResProc != NULL ||
419 nsPtr->varResProc != NULL ||
420 nsPtr->compiledVarResProc != NULL) {
421 return 1;
422 }
423 return 0;
424}
Note: See TracBrowser for help on using the repository browser.