summaryrefslogtreecommitdiffstats
path: root/generic/tclResolve.c
blob: 44634366468ea42191b52d3e05f3c4a7e39720ce (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
/*
 * tclResolve.c --
 *
 *      Contains hooks for customized command/variable name resolution
 *      schemes.  These hooks allow extensions like [incr Tcl] to add
 *      their own name resolution rules to the Tcl language.  Rules can
 *      be applied to a particular namespace, to the interpreter as a
 *      whole, or both.
 *
 * Copyright (c) 1998 Lucent Technologies, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * Declarations for procedures local to this file:
 */

static void		BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));


/*
 *----------------------------------------------------------------------
 *
 * Tcl_AddInterpResolvers --
 *
 *	Adds a set of command/variable resolution procedures to an
 *	interpreter.  These procedures are consulted when commands
 *	are resolved in Tcl_FindCommand, and when variables are
 *	resolved in TclLookupVar and LookupCompiledLocal.  Each
 *	namespace may also have its own set of resolution procedures
 *	which take precedence over those for the interpreter.
 *
 *	When a name is resolved, it is handled as follows.  First,
 *	the name is passed to the resolution procedures for the
 *	namespace.  If not resolved, the name is passed to each of
 *	the resolution procedures added to the interpreter.  Finally,
 *	if still not resolved, the name is handled using the default
 *	Tcl rules for name resolution.
 *
 * Results:
 *	Returns pointers to the current name resolution procedures
 *	in the cmdProcPtr, varProcPtr and compiledVarProcPtr
 *	arguments.
 *
 * Side effects:
 *	If a compiledVarProc is specified, this procedure bumps the
 *	compileEpoch for the interpreter, forcing all code to be
 *	recompiled.  If a cmdProc is specified, this procedure bumps
 *	the cmdRefEpoch in all namespaces, forcing commands to be
 *	resolved again using the new rules.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)

    Tcl_Interp *interp;			/* Interpreter whose name resolution
					 * rules are being modified. */
    CONST char *name;			/* Name of this resolution scheme. */
    Tcl_ResolveCmdProc *cmdProc;	/* New procedure for command
					 * resolution */
    Tcl_ResolveVarProc *varProc;	/* Procedure for variable resolution
					 * at runtime */
    Tcl_ResolveCompiledVarProc *compiledVarProc;
					/* Procedure for variable resolution
					 * at compile time. */
{
    Interp *iPtr = (Interp*)interp;
    ResolverScheme *resPtr;

    /*
     *  Since we're adding a new name resolution scheme, we must force
     *  all code to be recompiled to use the new scheme.  If there
     *  are new compiled variable resolution rules, bump the compiler
     *  epoch to invalidate compiled code.  If there are new command
     *  resolution rules, bump the cmdRefEpoch in all namespaces.
     */
    if (compiledVarProc) {
        iPtr->compileEpoch++;
    }
    if (cmdProc) {
        BumpCmdRefEpochs(iPtr->globalNsPtr);
    }

    /*
     *  Look for an existing scheme with the given name.  If found,
     *  then replace its rules.
     */
    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
            resPtr->cmdResProc = cmdProc;
            resPtr->varResProc = varProc;
            resPtr->compiledVarResProc = compiledVarProc;
            return;
        }
    }

    /*
     *  Otherwise, this is a new scheme.  Add it to the FRONT
     *  of the linked list, so that it overrides existing schemes.
     */
    resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
    resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
    strcpy(resPtr->name, name);
    resPtr->cmdResProc = cmdProc;
    resPtr->varResProc = varProc;
    resPtr->compiledVarResProc = compiledVarProc;
    resPtr->nextPtr = iPtr->resolverPtr;
    iPtr->resolverPtr = resPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetInterpResolvers --
 *
 *	Looks for a set of command/variable resolution procedures with
 *	the given name in an interpreter.  These procedures are
 *	registered by calling Tcl_AddInterpResolvers.
 *
 * Results:
 *	If the name is recognized, this procedure returns non-zero,
 *	along with pointers to the name resolution procedures in
 *	the Tcl_ResolverInfo structure.  If the name is not recognized,
 *	this procedure returns zero.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetInterpResolvers(interp, name, resInfoPtr)

    Tcl_Interp *interp;			/* Interpreter whose name resolution
					 * rules are being queried. */
    CONST char *name;                   /* Look for a scheme with this name. */
    Tcl_ResolverInfo *resInfoPtr;	/* Returns pointers to the procedures,
					 * if found */
{
    Interp *iPtr = (Interp*)interp;
    ResolverScheme *resPtr;

    /*
     *  Look for an existing scheme with the given name.  If found,
     *  then return pointers to its procedures.
     */
    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
	    resInfoPtr->cmdResProc = resPtr->cmdResProc;
	    resInfoPtr->varResProc = resPtr->varResProc;
	    resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
            return 1;
        }
    }

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RemoveInterpResolvers --
 *
 *	Removes a set of command/variable resolution procedures
 *	previously added by Tcl_AddInterpResolvers.  The next time
 *	a command/variable name is resolved, these procedures
 *	won't be consulted.
 *
 * Results:
 *	Returns non-zero if the name was recognized and the
 *	resolution scheme was deleted.  Returns zero otherwise.
 *
 * Side effects:
 *	If a scheme with a compiledVarProc was deleted, this procedure
 *	bumps the compileEpoch for the interpreter, forcing all code
 *	to be recompiled.  If a scheme with a cmdProc was deleted,
 *	this procedure bumps the cmdRefEpoch in all namespaces,
 *	forcing commands to be resolved again using the new rules.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RemoveInterpResolvers(interp, name)

    Tcl_Interp *interp;			/* Interpreter whose name resolution
					 * rules are being modified. */
    CONST char *name;                   /* Name of the scheme to be removed. */
{
    Interp *iPtr = (Interp*)interp;
    ResolverScheme **prevPtrPtr, *resPtr;

    /*
     *  Look for an existing scheme with the given name.
     */
    prevPtrPtr = &iPtr->resolverPtr;
    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
            break;
        }
        prevPtrPtr = &resPtr->nextPtr;
    }

    /*
     *  If we found the scheme, delete it.
     */
    if (resPtr) {
        /*
         *  If we're deleting a scheme with compiled variable resolution
         *  rules, bump the compiler epoch to invalidate compiled code.
         *  If we're deleting a scheme with command resolution rules,
         *  bump the cmdRefEpoch in all namespaces.
         */
        if (resPtr->compiledVarResProc) {
            iPtr->compileEpoch++;
        }
        if (resPtr->cmdResProc) {
            BumpCmdRefEpochs(iPtr->globalNsPtr);
        }

        *prevPtrPtr = resPtr->nextPtr;
        ckfree(resPtr->name);
        ckfree((char *) resPtr);

        return 1;
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * BumpCmdRefEpochs --
 *
 *	This procedure is used to bump the cmdRefEpoch counters in
 *	the specified namespace and all of its child namespaces.
 *	It is used whenever name resolution schemes are added/removed
 *	from an interpreter, to invalidate all command references.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Bumps the cmdRefEpoch in the specified namespace and its
 *	children, recursively.
 *
 *----------------------------------------------------------------------
 */

static void
BumpCmdRefEpochs(nsPtr)
    Namespace *nsPtr;			/* Namespace being modified. */
{
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    Namespace *childNsPtr;

    nsPtr->cmdRefEpoch++;

    for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
	    entry != NULL;
	    entry = Tcl_NextHashEntry(&search)) {

        childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
        BumpCmdRefEpochs(childNsPtr);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetNamespaceResolvers --
 *
 *	Sets the command/variable resolution procedures for a namespace,
 *	thereby changing the way that command/variable names are
 *	interpreted.  This allows extension writers to support different
 *	name resolution schemes, such as those for object-oriented
 *	packages.
 *
 *	Command resolution is handled by a procedure of the following
 *	type:
 *
 *	  typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
 *		Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
 *              int flags, Tcl_Command *rPtr));
 *          
 *	Whenever a command is executed or Tcl_FindCommand is invoked
 *	within the namespace, this procedure is called to resolve the
 *	command name.  If this procedure is able to resolve the name,
 *	it should return the status code TCL_OK, along with the
 *	corresponding Tcl_Command in the rPtr argument.  Otherwise,
 *	the procedure can return TCL_CONTINUE, and the command will
 *	be treated under the usual name resolution rules.  Or, it can
 *	return TCL_ERROR, and the command will be considered invalid.
 *
 *	Variable resolution is handled by two procedures.  The first
 *	is called whenever a variable needs to be resolved at compile
 *	time:
 *
 *        typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
 *	        Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
 *	        Tcl_ResolvedVarInfo *rPtr));
 *
 *      If this procedure is able to resolve the name, it should return
 *      the status code TCL_OK, along with variable resolution info in
 *      the rPtr argument; this info will be used to set up compiled
 *	locals in the call frame at runtime.  The procedure may also
 *	return TCL_CONTINUE, and the variable will be treated under
 *	the usual name resolution rules.  Or, it can return TCL_ERROR,
 *	and the variable will be considered invalid.
 *
 *	Another procedure is used whenever a variable needs to be
 *	resolved at runtime but it is not recognized as a compiled local.
 *	(For example, the variable may be requested via
 *	Tcl_FindNamespaceVar.) This procedure has the following type:
 *
 *	  typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
 *	        Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
 *	        int flags, Tcl_Var *rPtr));
 *
 *	This procedure is quite similar to the compile-time version.
 *	It returns the same status codes, but if variable resolution
 *	succeeds, this procedure returns a Tcl_Var directly via the
 *	rPtr argument.
 *
 * Results:
 *	Nothing.
 *
 * Side effects:
 *	Bumps the command epoch counter for the namespace, invalidating
 *	all command references in that namespace.  Also bumps the
 *	resolver epoch counter for the namespace, forcing all code
 *	in the namespace to be recompiled.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
    Tcl_Namespace *namespacePtr;	/* Namespace whose resolution rules
					 * are being modified. */
    Tcl_ResolveCmdProc *cmdProc;	/* Procedure for command resolution */
    Tcl_ResolveVarProc *varProc;	/* Procedure for variable resolution
					 * at runtime */
    Tcl_ResolveCompiledVarProc *compiledVarProc;
					/* Procedure for variable resolution
					 * at compile time. */
{
    Namespace *nsPtr = (Namespace*)namespacePtr;

    /*
     *  Plug in the new command resolver, and bump the epoch counters
     *  so that all code will have to be recompiled and all commands
     *  will have to be resolved again using the new policy.
     */
    nsPtr->cmdResProc = cmdProc;
    nsPtr->varResProc = varProc;
    nsPtr->compiledVarResProc = compiledVarProc;

    nsPtr->cmdRefEpoch++;
    nsPtr->resolverEpoch++;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetNamespaceResolvers --
 *
 *	Returns the current command/variable resolution procedures
 *	for a namespace.  By default, these procedures are NULL.
 *	New procedures can be installed by calling
 *	Tcl_SetNamespaceResolvers, to provide new name resolution
 *	rules.
 *
 * Results:
 *	Returns non-zero if any name resolution procedures have been
 *	assigned to this namespace; also returns pointers to the
 *	procedures in the Tcl_ResolverInfo structure.  Returns zero
 *	otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)

    Tcl_Namespace *namespacePtr;	/* Namespace whose resolution rules
					 * are being modified. */
    Tcl_ResolverInfo *resInfoPtr;	/* Returns: pointers for all
					 * name resolution procedures
					 * assigned to this namespace. */
{
    Namespace *nsPtr = (Namespace*)namespacePtr;

    resInfoPtr->cmdResProc = nsPtr->cmdResProc;
    resInfoPtr->varResProc = nsPtr->varResProc;
    resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;

    if (nsPtr->cmdResProc != NULL ||
        nsPtr->varResProc != NULL ||
        nsPtr->compiledVarResProc != NULL) {
	return 1;
    }
    return 0;
}