diff options
Diffstat (limited to 'tcl8.6/generic/tclResolve.c')
| -rw-r--r-- | tcl8.6/generic/tclResolve.c | 424 |
1 files changed, 424 insertions, 0 deletions
diff --git a/tcl8.6/generic/tclResolve.c b/tcl8.6/generic/tclResolve.c new file mode 100644 index 0000000..974737e --- /dev/null +++ b/tcl8.6/generic/tclResolve.c @@ -0,0 +1,424 @@ +/* + * 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 functions local to this file: + */ + +static void BumpCmdRefEpochs(Namespace *nsPtr); + +/* + *---------------------------------------------------------------------- + * + * Tcl_AddInterpResolvers -- + * + * Adds a set of command/variable resolution functions to an interpreter. + * These functions 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 functions 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 functions for the namespace. If not resolved, + * the name is passed to each of the resolution functions 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 functions in the + * cmdProcPtr, varProcPtr and compiledVarProcPtr arguments. + * + * Side effects: + * If a compiledVarProc is specified, this function bumps the + * compileEpoch for the interpreter, forcing all code to be recompiled. + * If a cmdProc is specified, this function bumps the cmdRefEpoch in all + * namespaces, forcing commands to be resolved again using the new rules. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AddInterpResolvers( + Tcl_Interp *interp, /* Interpreter whose name resolution rules are + * being modified. */ + const char *name, /* Name of this resolution scheme. */ + Tcl_ResolveCmdProc *cmdProc,/* New function for command resolution. */ + Tcl_ResolveVarProc *varProc,/* Function for variable resolution at + * runtime. */ + Tcl_ResolveCompiledVarProc *compiledVarProc) + /* Function for variable resolution at compile + * time. */ +{ + Interp *iPtr = (Interp *) interp; + ResolverScheme *resPtr; + unsigned len; + + /* + * 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 = ckalloc(sizeof(ResolverScheme)); + len = strlen(name) + 1; + resPtr->name = ckalloc(len); + memcpy(resPtr->name, name, len); + 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 functions with the + * given name in an interpreter. These functions are registered by + * calling Tcl_AddInterpResolvers. + * + * Results: + * If the name is recognized, this function returns non-zero, along with + * pointers to the name resolution functions in the Tcl_ResolverInfo + * structure. If the name is not recognized, this function returns zero. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_GetInterpResolvers( + 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 functions, if + * found */ +{ + Interp *iPtr = (Interp *) interp; + ResolverScheme *resPtr; + + /* + * Look for an existing scheme with the given name. If found, then return + * pointers to its functions. + */ + + 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 functions previously + * added by Tcl_AddInterpResolvers. The next time a command/variable name + * is resolved, these functions 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 function bumps + * the compileEpoch for the interpreter, forcing all code to be + * recompiled. If a scheme with a cmdProc was deleted, this function + * bumps the cmdRefEpoch in all namespaces, forcing commands to be + * resolved again using the new rules. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_RemoveInterpResolvers( + 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(resPtr); + + return 1; + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * BumpCmdRefEpochs -- + * + * This function 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( + Namespace *nsPtr) /* Namespace being modified. */ +{ + Tcl_HashEntry *entry; + Tcl_HashSearch search; + + nsPtr->cmdRefEpoch++; + +#ifndef BREAK_NAMESPACE_COMPAT + for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search); + entry != NULL; entry = Tcl_NextHashEntry(&search)) { + Namespace *childNsPtr = Tcl_GetHashValue(entry); + + BumpCmdRefEpochs(childNsPtr); + } +#else + if (nsPtr->childTablePtr != NULL) { + for (entry = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search); + entry != NULL; entry = Tcl_NextHashEntry(&search)) { + Namespace *childNsPtr = Tcl_GetHashValue(entry); + + BumpCmdRefEpochs(childNsPtr); + } + } +#endif + TclInvalidateNsPath(nsPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetNamespaceResolvers -- + * + * Sets the command/variable resolution functions 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 function of the following type: + * + * typedef int (Tcl_ResolveCmdProc)(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 function is called to resolve the command name. If + * this function 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 function 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 functions. The first is called + * whenever a variable needs to be resolved at compile time: + * + * typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp, + * const char *name, Tcl_Namespace *context, + * Tcl_ResolvedVarInfo *rPtr); + * + * If this function 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 function 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 function 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 function + * has the following type: + * + * typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, + * const char *name, Tcl_Namespace *context, + * int flags, Tcl_Var *rPtr); + * + * This function is quite similar to the compile-time version. It returns + * the same status codes, but if variable resolution succeeds, this + * function 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( + Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being + * modified. */ + Tcl_ResolveCmdProc *cmdProc,/* Function for command resolution */ + Tcl_ResolveVarProc *varProc,/* Function for variable resolution at + * run-time */ + Tcl_ResolveCompiledVarProc *compiledVarProc) + /* Function 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++; + TclInvalidateNsPath(nsPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetNamespaceResolvers -- + * + * Returns the current command/variable resolution functions for a + * namespace. By default, these functions are NULL. New functions can be + * installed by calling Tcl_SetNamespaceResolvers, to provide new name + * resolution rules. + * + * Results: + * Returns non-zero if any name resolution functions have been assigned + * to this namespace; also returns pointers to the functions in the + * Tcl_ResolverInfo structure. Returns zero otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_GetNamespaceResolvers( + Tcl_Namespace *namespacePtr,/* Namespace whose resolution rules are being + * modified. */ + Tcl_ResolverInfo *resInfoPtr) + /* Returns: pointers for all name resolution + * functions 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; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |