summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorwelch <welch>1998-06-28 21:41:31 (GMT)
committerwelch <welch>1998-06-28 21:41:31 (GMT)
commit61317caad1a51589029679818be0470c99d704b7 (patch)
treeea3511810ea37e883b917dd9984e350660149412 /generic
parent7d1f7120682cc4d944681bad0c1c5c38cf5bac4b (diff)
downloadtcl-61317caad1a51589029679818be0470c99d704b7.zip
tcl-61317caad1a51589029679818be0470c99d704b7.tar.gz
tcl-61317caad1a51589029679818be0470c99d704b7.tar.bz2
Initial revision
Diffstat (limited to 'generic')
-rw-r--r--generic/tclResolve.c423
1 files changed, 423 insertions, 0 deletions
diff --git a/generic/tclResolve.c b/generic/tclResolve.c
new file mode 100644
index 0000000..a2bbe46
--- /dev/null
+++ b/generic/tclResolve.c
@@ -0,0 +1,423 @@
+/*
+ * 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.
+ *
+ * Originally implemented by
+ * Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: %Z% $Id: tclResolve.c,v 1.1 1998/06/28 21:41:31 welch Exp $
+ */
+
+#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. */
+ 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. */
+ 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. */
+ 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, 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, 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, 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;
+}