| 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 |
|
|---|
| 24 | static 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 |
|
|---|
| 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 | *
|
|---|
| 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 | *
|
|---|
| 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 |
|
|---|
| 195 | int
|
|---|
| 196 | Tcl_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 |
|
|---|
| 263 | static void
|
|---|
| 264 | BumpCmdRefEpochs(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 |
|
|---|
| 353 | void
|
|---|
| 354 | Tcl_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 |
|
|---|
| 403 | int
|
|---|
| 404 | Tcl_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 | }
|
|---|
