os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclResolve.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclResolve.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,418 @@
1.4 +/*
1.5 + * tclResolve.c --
1.6 + *
1.7 + * Contains hooks for customized command/variable name resolution
1.8 + * schemes. These hooks allow extensions like [incr Tcl] to add
1.9 + * their own name resolution rules to the Tcl language. Rules can
1.10 + * be applied to a particular namespace, to the interpreter as a
1.11 + * whole, or both.
1.12 + *
1.13 + * Copyright (c) 1998 Lucent Technologies, Inc.
1.14 + *
1.15 + * See the file "license.terms" for information on usage and redistribution
1.16 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.17 + *
1.18 + * RCS: @(#) $Id: tclResolve.c,v 1.4 2002/01/25 22:01:32 dgp Exp $
1.19 + */
1.20 +
1.21 +#include "tclInt.h"
1.22 +
1.23 +/*
1.24 + * Declarations for procedures local to this file:
1.25 + */
1.26 +
1.27 +static void BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
1.28 +
1.29 +
1.30 +/*
1.31 + *----------------------------------------------------------------------
1.32 + *
1.33 + * Tcl_AddInterpResolvers --
1.34 + *
1.35 + * Adds a set of command/variable resolution procedures to an
1.36 + * interpreter. These procedures are consulted when commands
1.37 + * are resolved in Tcl_FindCommand, and when variables are
1.38 + * resolved in TclLookupVar and LookupCompiledLocal. Each
1.39 + * namespace may also have its own set of resolution procedures
1.40 + * which take precedence over those for the interpreter.
1.41 + *
1.42 + * When a name is resolved, it is handled as follows. First,
1.43 + * the name is passed to the resolution procedures for the
1.44 + * namespace. If not resolved, the name is passed to each of
1.45 + * the resolution procedures added to the interpreter. Finally,
1.46 + * if still not resolved, the name is handled using the default
1.47 + * Tcl rules for name resolution.
1.48 + *
1.49 + * Results:
1.50 + * Returns pointers to the current name resolution procedures
1.51 + * in the cmdProcPtr, varProcPtr and compiledVarProcPtr
1.52 + * arguments.
1.53 + *
1.54 + * Side effects:
1.55 + * If a compiledVarProc is specified, this procedure bumps the
1.56 + * compileEpoch for the interpreter, forcing all code to be
1.57 + * recompiled. If a cmdProc is specified, this procedure bumps
1.58 + * the cmdRefEpoch in all namespaces, forcing commands to be
1.59 + * resolved again using the new rules.
1.60 + *
1.61 + *----------------------------------------------------------------------
1.62 + */
1.63 +
1.64 +void
1.65 +Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
1.66 +
1.67 + Tcl_Interp *interp; /* Interpreter whose name resolution
1.68 + * rules are being modified. */
1.69 + CONST char *name; /* Name of this resolution scheme. */
1.70 + Tcl_ResolveCmdProc *cmdProc; /* New procedure for command
1.71 + * resolution */
1.72 + Tcl_ResolveVarProc *varProc; /* Procedure for variable resolution
1.73 + * at runtime */
1.74 + Tcl_ResolveCompiledVarProc *compiledVarProc;
1.75 + /* Procedure for variable resolution
1.76 + * at compile time. */
1.77 +{
1.78 + Interp *iPtr = (Interp*)interp;
1.79 + ResolverScheme *resPtr;
1.80 +
1.81 + /*
1.82 + * Since we're adding a new name resolution scheme, we must force
1.83 + * all code to be recompiled to use the new scheme. If there
1.84 + * are new compiled variable resolution rules, bump the compiler
1.85 + * epoch to invalidate compiled code. If there are new command
1.86 + * resolution rules, bump the cmdRefEpoch in all namespaces.
1.87 + */
1.88 + if (compiledVarProc) {
1.89 + iPtr->compileEpoch++;
1.90 + }
1.91 + if (cmdProc) {
1.92 + BumpCmdRefEpochs(iPtr->globalNsPtr);
1.93 + }
1.94 +
1.95 + /*
1.96 + * Look for an existing scheme with the given name. If found,
1.97 + * then replace its rules.
1.98 + */
1.99 + for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
1.100 + if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
1.101 + resPtr->cmdResProc = cmdProc;
1.102 + resPtr->varResProc = varProc;
1.103 + resPtr->compiledVarResProc = compiledVarProc;
1.104 + return;
1.105 + }
1.106 + }
1.107 +
1.108 + /*
1.109 + * Otherwise, this is a new scheme. Add it to the FRONT
1.110 + * of the linked list, so that it overrides existing schemes.
1.111 + */
1.112 + resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
1.113 + resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
1.114 + strcpy(resPtr->name, name);
1.115 + resPtr->cmdResProc = cmdProc;
1.116 + resPtr->varResProc = varProc;
1.117 + resPtr->compiledVarResProc = compiledVarProc;
1.118 + resPtr->nextPtr = iPtr->resolverPtr;
1.119 + iPtr->resolverPtr = resPtr;
1.120 +}
1.121 +
1.122 +/*
1.123 + *----------------------------------------------------------------------
1.124 + *
1.125 + * Tcl_GetInterpResolvers --
1.126 + *
1.127 + * Looks for a set of command/variable resolution procedures with
1.128 + * the given name in an interpreter. These procedures are
1.129 + * registered by calling Tcl_AddInterpResolvers.
1.130 + *
1.131 + * Results:
1.132 + * If the name is recognized, this procedure returns non-zero,
1.133 + * along with pointers to the name resolution procedures in
1.134 + * the Tcl_ResolverInfo structure. If the name is not recognized,
1.135 + * this procedure returns zero.
1.136 + *
1.137 + * Side effects:
1.138 + * None.
1.139 + *
1.140 + *----------------------------------------------------------------------
1.141 + */
1.142 +
1.143 +int
1.144 +Tcl_GetInterpResolvers(interp, name, resInfoPtr)
1.145 +
1.146 + Tcl_Interp *interp; /* Interpreter whose name resolution
1.147 + * rules are being queried. */
1.148 + CONST char *name; /* Look for a scheme with this name. */
1.149 + Tcl_ResolverInfo *resInfoPtr; /* Returns pointers to the procedures,
1.150 + * if found */
1.151 +{
1.152 + Interp *iPtr = (Interp*)interp;
1.153 + ResolverScheme *resPtr;
1.154 +
1.155 + /*
1.156 + * Look for an existing scheme with the given name. If found,
1.157 + * then return pointers to its procedures.
1.158 + */
1.159 + for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
1.160 + if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
1.161 + resInfoPtr->cmdResProc = resPtr->cmdResProc;
1.162 + resInfoPtr->varResProc = resPtr->varResProc;
1.163 + resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
1.164 + return 1;
1.165 + }
1.166 + }
1.167 +
1.168 + return 0;
1.169 +}
1.170 +
1.171 +/*
1.172 + *----------------------------------------------------------------------
1.173 + *
1.174 + * Tcl_RemoveInterpResolvers --
1.175 + *
1.176 + * Removes a set of command/variable resolution procedures
1.177 + * previously added by Tcl_AddInterpResolvers. The next time
1.178 + * a command/variable name is resolved, these procedures
1.179 + * won't be consulted.
1.180 + *
1.181 + * Results:
1.182 + * Returns non-zero if the name was recognized and the
1.183 + * resolution scheme was deleted. Returns zero otherwise.
1.184 + *
1.185 + * Side effects:
1.186 + * If a scheme with a compiledVarProc was deleted, this procedure
1.187 + * bumps the compileEpoch for the interpreter, forcing all code
1.188 + * to be recompiled. If a scheme with a cmdProc was deleted,
1.189 + * this procedure bumps the cmdRefEpoch in all namespaces,
1.190 + * forcing commands to be resolved again using the new rules.
1.191 + *
1.192 + *----------------------------------------------------------------------
1.193 + */
1.194 +
1.195 +int
1.196 +Tcl_RemoveInterpResolvers(interp, name)
1.197 +
1.198 + Tcl_Interp *interp; /* Interpreter whose name resolution
1.199 + * rules are being modified. */
1.200 + CONST char *name; /* Name of the scheme to be removed. */
1.201 +{
1.202 + Interp *iPtr = (Interp*)interp;
1.203 + ResolverScheme **prevPtrPtr, *resPtr;
1.204 +
1.205 + /*
1.206 + * Look for an existing scheme with the given name.
1.207 + */
1.208 + prevPtrPtr = &iPtr->resolverPtr;
1.209 + for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
1.210 + if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) {
1.211 + break;
1.212 + }
1.213 + prevPtrPtr = &resPtr->nextPtr;
1.214 + }
1.215 +
1.216 + /*
1.217 + * If we found the scheme, delete it.
1.218 + */
1.219 + if (resPtr) {
1.220 + /*
1.221 + * If we're deleting a scheme with compiled variable resolution
1.222 + * rules, bump the compiler epoch to invalidate compiled code.
1.223 + * If we're deleting a scheme with command resolution rules,
1.224 + * bump the cmdRefEpoch in all namespaces.
1.225 + */
1.226 + if (resPtr->compiledVarResProc) {
1.227 + iPtr->compileEpoch++;
1.228 + }
1.229 + if (resPtr->cmdResProc) {
1.230 + BumpCmdRefEpochs(iPtr->globalNsPtr);
1.231 + }
1.232 +
1.233 + *prevPtrPtr = resPtr->nextPtr;
1.234 + ckfree(resPtr->name);
1.235 + ckfree((char *) resPtr);
1.236 +
1.237 + return 1;
1.238 + }
1.239 + return 0;
1.240 +}
1.241 +
1.242 +/*
1.243 + *----------------------------------------------------------------------
1.244 + *
1.245 + * BumpCmdRefEpochs --
1.246 + *
1.247 + * This procedure is used to bump the cmdRefEpoch counters in
1.248 + * the specified namespace and all of its child namespaces.
1.249 + * It is used whenever name resolution schemes are added/removed
1.250 + * from an interpreter, to invalidate all command references.
1.251 + *
1.252 + * Results:
1.253 + * None.
1.254 + *
1.255 + * Side effects:
1.256 + * Bumps the cmdRefEpoch in the specified namespace and its
1.257 + * children, recursively.
1.258 + *
1.259 + *----------------------------------------------------------------------
1.260 + */
1.261 +
1.262 +static void
1.263 +BumpCmdRefEpochs(nsPtr)
1.264 + Namespace *nsPtr; /* Namespace being modified. */
1.265 +{
1.266 + Tcl_HashEntry *entry;
1.267 + Tcl_HashSearch search;
1.268 + Namespace *childNsPtr;
1.269 +
1.270 + nsPtr->cmdRefEpoch++;
1.271 +
1.272 + for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
1.273 + entry != NULL;
1.274 + entry = Tcl_NextHashEntry(&search)) {
1.275 +
1.276 + childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
1.277 + BumpCmdRefEpochs(childNsPtr);
1.278 + }
1.279 +}
1.280 +
1.281 +
1.282 +/*
1.283 + *----------------------------------------------------------------------
1.284 + *
1.285 + * Tcl_SetNamespaceResolvers --
1.286 + *
1.287 + * Sets the command/variable resolution procedures for a namespace,
1.288 + * thereby changing the way that command/variable names are
1.289 + * interpreted. This allows extension writers to support different
1.290 + * name resolution schemes, such as those for object-oriented
1.291 + * packages.
1.292 + *
1.293 + * Command resolution is handled by a procedure of the following
1.294 + * type:
1.295 + *
1.296 + * typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
1.297 + * Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
1.298 + * int flags, Tcl_Command *rPtr));
1.299 + *
1.300 + * Whenever a command is executed or Tcl_FindCommand is invoked
1.301 + * within the namespace, this procedure is called to resolve the
1.302 + * command name. If this procedure is able to resolve the name,
1.303 + * it should return the status code TCL_OK, along with the
1.304 + * corresponding Tcl_Command in the rPtr argument. Otherwise,
1.305 + * the procedure can return TCL_CONTINUE, and the command will
1.306 + * be treated under the usual name resolution rules. Or, it can
1.307 + * return TCL_ERROR, and the command will be considered invalid.
1.308 + *
1.309 + * Variable resolution is handled by two procedures. The first
1.310 + * is called whenever a variable needs to be resolved at compile
1.311 + * time:
1.312 + *
1.313 + * typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
1.314 + * Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
1.315 + * Tcl_ResolvedVarInfo *rPtr));
1.316 + *
1.317 + * If this procedure is able to resolve the name, it should return
1.318 + * the status code TCL_OK, along with variable resolution info in
1.319 + * the rPtr argument; this info will be used to set up compiled
1.320 + * locals in the call frame at runtime. The procedure may also
1.321 + * return TCL_CONTINUE, and the variable will be treated under
1.322 + * the usual name resolution rules. Or, it can return TCL_ERROR,
1.323 + * and the variable will be considered invalid.
1.324 + *
1.325 + * Another procedure is used whenever a variable needs to be
1.326 + * resolved at runtime but it is not recognized as a compiled local.
1.327 + * (For example, the variable may be requested via
1.328 + * Tcl_FindNamespaceVar.) This procedure has the following type:
1.329 + *
1.330 + * typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
1.331 + * Tcl_Interp* interp, CONST char* name, Tcl_Namespace *context,
1.332 + * int flags, Tcl_Var *rPtr));
1.333 + *
1.334 + * This procedure is quite similar to the compile-time version.
1.335 + * It returns the same status codes, but if variable resolution
1.336 + * succeeds, this procedure returns a Tcl_Var directly via the
1.337 + * rPtr argument.
1.338 + *
1.339 + * Results:
1.340 + * Nothing.
1.341 + *
1.342 + * Side effects:
1.343 + * Bumps the command epoch counter for the namespace, invalidating
1.344 + * all command references in that namespace. Also bumps the
1.345 + * resolver epoch counter for the namespace, forcing all code
1.346 + * in the namespace to be recompiled.
1.347 + *
1.348 + *----------------------------------------------------------------------
1.349 + */
1.350 +
1.351 +void
1.352 +Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
1.353 + Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules
1.354 + * are being modified. */
1.355 + Tcl_ResolveCmdProc *cmdProc; /* Procedure for command resolution */
1.356 + Tcl_ResolveVarProc *varProc; /* Procedure for variable resolution
1.357 + * at runtime */
1.358 + Tcl_ResolveCompiledVarProc *compiledVarProc;
1.359 + /* Procedure for variable resolution
1.360 + * at compile time. */
1.361 +{
1.362 + Namespace *nsPtr = (Namespace*)namespacePtr;
1.363 +
1.364 + /*
1.365 + * Plug in the new command resolver, and bump the epoch counters
1.366 + * so that all code will have to be recompiled and all commands
1.367 + * will have to be resolved again using the new policy.
1.368 + */
1.369 + nsPtr->cmdResProc = cmdProc;
1.370 + nsPtr->varResProc = varProc;
1.371 + nsPtr->compiledVarResProc = compiledVarProc;
1.372 +
1.373 + nsPtr->cmdRefEpoch++;
1.374 + nsPtr->resolverEpoch++;
1.375 +}
1.376 +
1.377 +/*
1.378 + *----------------------------------------------------------------------
1.379 + *
1.380 + * Tcl_GetNamespaceResolvers --
1.381 + *
1.382 + * Returns the current command/variable resolution procedures
1.383 + * for a namespace. By default, these procedures are NULL.
1.384 + * New procedures can be installed by calling
1.385 + * Tcl_SetNamespaceResolvers, to provide new name resolution
1.386 + * rules.
1.387 + *
1.388 + * Results:
1.389 + * Returns non-zero if any name resolution procedures have been
1.390 + * assigned to this namespace; also returns pointers to the
1.391 + * procedures in the Tcl_ResolverInfo structure. Returns zero
1.392 + * otherwise.
1.393 + *
1.394 + * Side effects:
1.395 + * None.
1.396 + *
1.397 + *----------------------------------------------------------------------
1.398 + */
1.399 +
1.400 +int
1.401 +Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
1.402 +
1.403 + Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules
1.404 + * are being modified. */
1.405 + Tcl_ResolverInfo *resInfoPtr; /* Returns: pointers for all
1.406 + * name resolution procedures
1.407 + * assigned to this namespace. */
1.408 +{
1.409 + Namespace *nsPtr = (Namespace*)namespacePtr;
1.410 +
1.411 + resInfoPtr->cmdResProc = nsPtr->cmdResProc;
1.412 + resInfoPtr->varResProc = nsPtr->varResProc;
1.413 + resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;
1.414 +
1.415 + if (nsPtr->cmdResProc != NULL ||
1.416 + nsPtr->varResProc != NULL ||
1.417 + nsPtr->compiledVarResProc != NULL) {
1.418 + return 1;
1.419 + }
1.420 + return 0;
1.421 +}