OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [generic/] [tclResolve.c] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/*
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.1.1 2002-01-16 10:25:29 markom Exp $
16
 */
17
 
18
#include "tclInt.h"
19
 
20
/*
21
 * Declarations for procedures local to this file:
22
 */
23
 
24
static void             BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
25
 
26
 
27
/*
28
 *----------------------------------------------------------------------
29
 *
30
 * Tcl_AddInterpResolvers --
31
 *
32
 *      Adds a set of command/variable resolution procedures to an
33
 *      interpreter.  These procedures are consulted when commands
34
 *      are resolved in Tcl_FindCommand, and when variables are
35
 *      resolved in TclLookupVar and LookupCompiledLocal.  Each
36
 *      namespace may also have its own set of resolution procedures
37
 *      which take precedence over those for the interpreter.
38
 *
39
 *      When a name is resolved, it is handled as follows.  First,
40
 *      the name is passed to the resolution procedures for the
41
 *      namespace.  If not resolved, the name is passed to each of
42
 *      the resolution procedures added to the interpreter.  Finally,
43
 *      if still not resolved, the name is handled using the default
44
 *      Tcl rules for name resolution.
45
 *
46
 * Results:
47
 *      Returns pointers to the current name resolution procedures
48
 *      in the cmdProcPtr, varProcPtr and compiledVarProcPtr
49
 *      arguments.
50
 *
51
 * Side effects:
52
 *      If a compiledVarProc is specified, this procedure bumps the
53
 *      compileEpoch for the interpreter, forcing all code to be
54
 *      recompiled.  If a cmdProc is specified, this procedure bumps
55
 *      the cmdRefEpoch in all namespaces, forcing commands to be
56
 *      resolved again using the new rules.
57
 *
58
 *----------------------------------------------------------------------
59
 */
60
 
61
void
62
Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
63
 
64
    Tcl_Interp *interp;                 /* Interpreter whose name resolution
65
                                         * rules are being modified. */
66
    char *name;                         /* Name of this resolution scheme. */
67
    Tcl_ResolveCmdProc *cmdProc;        /* New procedure for command
68
                                         * resolution */
69
    Tcl_ResolveVarProc *varProc;        /* Procedure for variable resolution
70
                                         * at runtime */
71
    Tcl_ResolveCompiledVarProc *compiledVarProc;
72
                                        /* Procedure for variable resolution
73
                                         * at compile time. */
74
{
75
    Interp *iPtr = (Interp*)interp;
76
    ResolverScheme *resPtr;
77
 
78
    /*
79
     *  Since we're adding a new name resolution scheme, we must force
80
     *  all code to be recompiled to use the new scheme.  If there
81
     *  are new compiled variable resolution rules, bump the compiler
82
     *  epoch to invalidate compiled code.  If there are new command
83
     *  resolution rules, bump the cmdRefEpoch in all namespaces.
84
     */
85
    if (compiledVarProc) {
86
        iPtr->compileEpoch++;
87
    }
88
    if (cmdProc) {
89
        BumpCmdRefEpochs(iPtr->globalNsPtr);
90
    }
91
 
92
    /*
93
     *  Look for an existing scheme with the given name.  If found,
94
     *  then replace its rules.
95
     */
96
    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
97
        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
98
            resPtr->cmdResProc = cmdProc;
99
            resPtr->varResProc = varProc;
100
            resPtr->compiledVarResProc = compiledVarProc;
101
            return;
102
        }
103
    }
104
 
105
    /*
106
     *  Otherwise, this is a new scheme.  Add it to the FRONT
107
     *  of the linked list, so that it overrides existing schemes.
108
     */
109
    resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
110
    resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
111
    strcpy(resPtr->name, name);
112
    resPtr->cmdResProc = cmdProc;
113
    resPtr->varResProc = varProc;
114
    resPtr->compiledVarResProc = compiledVarProc;
115
    resPtr->nextPtr = iPtr->resolverPtr;
116
    iPtr->resolverPtr = resPtr;
117
}
118
 
119
/*
120
 *----------------------------------------------------------------------
121
 *
122
 * Tcl_GetInterpResolvers --
123
 *
124
 *      Looks for a set of command/variable resolution procedures with
125
 *      the given name in an interpreter.  These procedures are
126
 *      registered by calling Tcl_AddInterpResolvers.
127
 *
128
 * Results:
129
 *      If the name is recognized, this procedure returns non-zero,
130
 *      along with pointers to the name resolution procedures in
131
 *      the Tcl_ResolverInfo structure.  If the name is not recognized,
132
 *      this procedure returns zero.
133
 *
134
 * Side effects:
135
 *      None.
136
 *
137
 *----------------------------------------------------------------------
138
 */
139
 
140
int
141
Tcl_GetInterpResolvers(interp, name, resInfoPtr)
142
 
143
    Tcl_Interp *interp;                 /* Interpreter whose name resolution
144
                                         * rules are being queried. */
145
    char *name;                         /* Look for a scheme with this name. */
146
    Tcl_ResolverInfo *resInfoPtr;       /* Returns pointers to the procedures,
147
                                         * if found */
148
{
149
    Interp *iPtr = (Interp*)interp;
150
    ResolverScheme *resPtr;
151
 
152
    /*
153
     *  Look for an existing scheme with the given name.  If found,
154
     *  then return pointers to its procedures.
155
     */
156
    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
157
        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
158
            resInfoPtr->cmdResProc = resPtr->cmdResProc;
159
            resInfoPtr->varResProc = resPtr->varResProc;
160
            resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
161
            return 1;
162
        }
163
    }
164
 
165
    return 0;
166
}
167
 
168
/*
169
 *----------------------------------------------------------------------
170
 *
171
 * Tcl_RemoveInterpResolvers --
172
 *
173
 *      Removes a set of command/variable resolution procedures
174
 *      previously added by Tcl_AddInterpResolvers.  The next time
175
 *      a command/variable name is resolved, these procedures
176
 *      won't be consulted.
177
 *
178
 * Results:
179
 *      Returns non-zero if the name was recognized and the
180
 *      resolution scheme was deleted.  Returns zero otherwise.
181
 *
182
 * Side effects:
183
 *      If a scheme with a compiledVarProc was deleted, this procedure
184
 *      bumps the compileEpoch for the interpreter, forcing all code
185
 *      to be recompiled.  If a scheme with a cmdProc was deleted,
186
 *      this procedure bumps the cmdRefEpoch in all namespaces,
187
 *      forcing commands to be resolved again using the new rules.
188
 *
189
 *----------------------------------------------------------------------
190
 */
191
 
192
int
193
Tcl_RemoveInterpResolvers(interp, name)
194
 
195
    Tcl_Interp *interp;                 /* Interpreter whose name resolution
196
                                         * rules are being modified. */
197
    char *name;                         /* Name of the scheme to be removed. */
198
{
199
    Interp *iPtr = (Interp*)interp;
200
    ResolverScheme **prevPtrPtr, *resPtr;
201
 
202
    /*
203
     *  Look for an existing scheme with the given name.
204
     */
205
    prevPtrPtr = &iPtr->resolverPtr;
206
    for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
207
        if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
208
            break;
209
        }
210
        prevPtrPtr = &resPtr->nextPtr;
211
    }
212
 
213
    /*
214
     *  If we found the scheme, delete it.
215
     */
216
    if (resPtr) {
217
        /*
218
         *  If we're deleting a scheme with compiled variable resolution
219
         *  rules, bump the compiler epoch to invalidate compiled code.
220
         *  If we're deleting a scheme with command resolution rules,
221
         *  bump the cmdRefEpoch in all namespaces.
222
         */
223
        if (resPtr->compiledVarResProc) {
224
            iPtr->compileEpoch++;
225
        }
226
        if (resPtr->cmdResProc) {
227
            BumpCmdRefEpochs(iPtr->globalNsPtr);
228
        }
229
 
230
        *prevPtrPtr = resPtr->nextPtr;
231
        ckfree(resPtr->name);
232
        ckfree((char *) resPtr);
233
 
234
        return 1;
235
    }
236
    return 0;
237
}
238
 
239
/*
240
 *----------------------------------------------------------------------
241
 *
242
 * BumpCmdRefEpochs --
243
 *
244
 *      This procedure is used to bump the cmdRefEpoch counters in
245
 *      the specified namespace and all of its child namespaces.
246
 *      It is used whenever name resolution schemes are added/removed
247
 *      from an interpreter, to invalidate all command references.
248
 *
249
 * Results:
250
 *      None.
251
 *
252
 * Side effects:
253
 *      Bumps the cmdRefEpoch in the specified namespace and its
254
 *      children, recursively.
255
 *
256
 *----------------------------------------------------------------------
257
 */
258
 
259
static void
260
BumpCmdRefEpochs(nsPtr)
261
    Namespace *nsPtr;                   /* Namespace being modified. */
262
{
263
    Tcl_HashEntry *entry;
264
    Tcl_HashSearch search;
265
    Namespace *childNsPtr;
266
 
267
    nsPtr->cmdRefEpoch++;
268
 
269
    for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
270
            entry != NULL;
271
            entry = Tcl_NextHashEntry(&search)) {
272
 
273
        childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
274
        BumpCmdRefEpochs(childNsPtr);
275
    }
276
}
277
 
278
 
279
/*
280
 *----------------------------------------------------------------------
281
 *
282
 * Tcl_SetNamespaceResolvers --
283
 *
284
 *      Sets the command/variable resolution procedures for a namespace,
285
 *      thereby changing the way that command/variable names are
286
 *      interpreted.  This allows extension writers to support different
287
 *      name resolution schemes, such as those for object-oriented
288
 *      packages.
289
 *
290
 *      Command resolution is handled by a procedure of the following
291
 *      type:
292
 *
293
 *        typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
294
 *              Tcl_Interp* interp, char* name, Tcl_Namespace *context,
295
 *              int flags, Tcl_Command *rPtr));
296
 *
297
 *      Whenever a command is executed or Tcl_FindCommand is invoked
298
 *      within the namespace, this procedure is called to resolve the
299
 *      command name.  If this procedure is able to resolve the name,
300
 *      it should return the status code TCL_OK, along with the
301
 *      corresponding Tcl_Command in the rPtr argument.  Otherwise,
302
 *      the procedure can return TCL_CONTINUE, and the command will
303
 *      be treated under the usual name resolution rules.  Or, it can
304
 *      return TCL_ERROR, and the command will be considered invalid.
305
 *
306
 *      Variable resolution is handled by two procedures.  The first
307
 *      is called whenever a variable needs to be resolved at compile
308
 *      time:
309
 *
310
 *        typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
311
 *              Tcl_Interp* interp, char* name, Tcl_Namespace *context,
312
 *              Tcl_ResolvedVarInfo *rPtr));
313
 *
314
 *      If this procedure is able to resolve the name, it should return
315
 *      the status code TCL_OK, along with variable resolution info in
316
 *      the rPtr argument; this info will be used to set up compiled
317
 *      locals in the call frame at runtime.  The procedure may also
318
 *      return TCL_CONTINUE, and the variable will be treated under
319
 *      the usual name resolution rules.  Or, it can return TCL_ERROR,
320
 *      and the variable will be considered invalid.
321
 *
322
 *      Another procedure is used whenever a variable needs to be
323
 *      resolved at runtime but it is not recognized as a compiled local.
324
 *      (For example, the variable may be requested via
325
 *      Tcl_FindNamespaceVar.) This procedure has the following type:
326
 *
327
 *        typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
328
 *              Tcl_Interp* interp, char* name, Tcl_Namespace *context,
329
 *              int flags, Tcl_Var *rPtr));
330
 *
331
 *      This procedure is quite similar to the compile-time version.
332
 *      It returns the same status codes, but if variable resolution
333
 *      succeeds, this procedure returns a Tcl_Var directly via the
334
 *      rPtr argument.
335
 *
336
 * Results:
337
 *      Nothing.
338
 *
339
 * Side effects:
340
 *      Bumps the command epoch counter for the namespace, invalidating
341
 *      all command references in that namespace.  Also bumps the
342
 *      resolver epoch counter for the namespace, forcing all code
343
 *      in the namespace to be recompiled.
344
 *
345
 *----------------------------------------------------------------------
346
 */
347
 
348
void
349
Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
350
    Tcl_Namespace *namespacePtr;        /* Namespace whose resolution rules
351
                                         * are being modified. */
352
    Tcl_ResolveCmdProc *cmdProc;        /* Procedure for command resolution */
353
    Tcl_ResolveVarProc *varProc;        /* Procedure for variable resolution
354
                                         * at runtime */
355
    Tcl_ResolveCompiledVarProc *compiledVarProc;
356
                                        /* Procedure for variable resolution
357
                                         * at compile time. */
358
{
359
    Namespace *nsPtr = (Namespace*)namespacePtr;
360
 
361
    /*
362
     *  Plug in the new command resolver, and bump the epoch counters
363
     *  so that all code will have to be recompiled and all commands
364
     *  will have to be resolved again using the new policy.
365
     */
366
    nsPtr->cmdResProc = cmdProc;
367
    nsPtr->varResProc = varProc;
368
    nsPtr->compiledVarResProc = compiledVarProc;
369
 
370
    nsPtr->cmdRefEpoch++;
371
    nsPtr->resolverEpoch++;
372
}
373
 
374
/*
375
 *----------------------------------------------------------------------
376
 *
377
 * Tcl_GetNamespaceResolvers --
378
 *
379
 *      Returns the current command/variable resolution procedures
380
 *      for a namespace.  By default, these procedures are NULL.
381
 *      New procedures can be installed by calling
382
 *      Tcl_SetNamespaceResolvers, to provide new name resolution
383
 *      rules.
384
 *
385
 * Results:
386
 *      Returns non-zero if any name resolution procedures have been
387
 *      assigned to this namespace; also returns pointers to the
388
 *      procedures in the Tcl_ResolverInfo structure.  Returns zero
389
 *      otherwise.
390
 *
391
 * Side effects:
392
 *      None.
393
 *
394
 *----------------------------------------------------------------------
395
 */
396
 
397
int
398
Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
399
 
400
    Tcl_Namespace *namespacePtr;        /* Namespace whose resolution rules
401
                                         * are being modified. */
402
    Tcl_ResolverInfo *resInfoPtr;       /* Returns: pointers for all
403
                                         * name resolution procedures
404
                                         * assigned to this namespace. */
405
{
406
    Namespace *nsPtr = (Namespace*)namespacePtr;
407
 
408
    resInfoPtr->cmdResProc = nsPtr->cmdResProc;
409
    resInfoPtr->varResProc = nsPtr->varResProc;
410
    resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;
411
 
412
    if (nsPtr->cmdResProc != NULL ||
413
        nsPtr->varResProc != NULL ||
414
        nsPtr->compiledVarResProc != NULL) {
415
        return 1;
416
    }
417
    return 0;
418
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.