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

Contents of /projs/trunk/shared_source/tcl_base/tclresolve.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25