/[dtapublic]/projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclresolve.c
ViewVC logotype

Contents of /projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclresolve.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 66 - (show annotations) (download)
Sun Oct 30 21:57:38 2016 UTC (8 years ago) by dashley
Original Path: projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclresolve.c
File MIME type: text/plain
File size: 14477 byte(s)
Header and footer cleanup.
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 */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25