diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2004-10-14 15:05:59 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2004-10-14 15:05:59 (GMT) |
commit | 97449587f00016cab8acc385844a1d82f26332c6 (patch) | |
tree | f89998d33d66eb6a7f9fe5e3f2d931293830c8a9 /generic/tclCmdIL.c | |
parent | 98a60867761d8d1991cee931a2c8c21423e5dcd1 (diff) | |
download | tcl-97449587f00016cab8acc385844a1d82f26332c6.zip tcl-97449587f00016cab8acc385844a1d82f26332c6.tar.gz tcl-97449587f00016cab8acc385844a1d82f26332c6.tar.bz2 |
Speed up [info <thing> <simplePattern>]
Diffstat (limited to 'generic/tclCmdIL.c')
-rw-r--r-- | generic/tclCmdIL.c | 205 |
1 files changed, 158 insertions, 47 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 7f58df2..2997509 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.64 2004/10/06 09:37:46 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.65 2004/10/14 15:06:01 dkf Exp $ */ #include "tclInt.h" @@ -746,6 +746,14 @@ InfoCommandsCmd(dummy, interp, objc, objv) } /* + * Exit as quickly as possible if we couldn't find the namespace. + */ + + if (nsPtr == NULL) { + return TCL_OK; + } + + /* * Scan through the effective namespace's command table and create a * list with all commands that match the pattern. If a specific * namespace was requested in the pattern, qualify the command names @@ -754,7 +762,33 @@ InfoCommandsCmd(dummy, interp, objc, objv) listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); - if (nsPtr != NULL) { + if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { + /* + * Special case for when the pattern doesn't include any of + * glob's special characters. This lets us avoid scans of any + * hash tables. + */ + entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); + if (entryPtr != NULL) { + if (specificNsInPattern) { + cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); + elemObjPtr = Tcl_NewObj(); + Tcl_GetCommandFullName(interp, cmd, elemObjPtr); + } else { + cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); + elemObjPtr = Tcl_NewStringObj(cmdName, -1); + } + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); + } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) { + entryPtr = Tcl_FindHashEntry(&globalNsPtr->cmdTable, + simplePattern); + if (entryPtr != NULL) { + cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj(cmdName, -1)); + } + } + } else { entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); @@ -1069,17 +1103,25 @@ InfoGlobalsCmd(dummy, interp, objc, objv) */ listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); - for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); - entryPtr != NULL; - entryPtr = Tcl_NextHashEntry(&search)) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (TclIsVarUndefined(varPtr)) { - continue; - } - varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr); - if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { + if (pattern != NULL && TclMatchIsTrivial(pattern)) { + entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern); + if (entryPtr != NULL) { Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(varName, -1)); + Tcl_NewStringObj(pattern, -1)); + } + } else { + for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); + entryPtr != NULL; + entryPtr = Tcl_NextHashEntry(&search)) { + varPtr = (Var *) Tcl_GetHashValue(entryPtr); + if (TclIsVarUndefined(varPtr)) { + continue; + } + varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr); + if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj(varName, -1)); + } } } Tcl_SetObjResult(interp, listPtr); @@ -1585,6 +1627,10 @@ InfoProcsCmd(dummy, interp, objc, objv) return TCL_ERROR; } + if (nsPtr == NULL) { + return TCL_OK; + } + /* * Scan through the effective namespace's command table and create a * list with all procs that match the pattern. If a specific @@ -1593,7 +1639,33 @@ InfoProcsCmd(dummy, interp, objc, objv) */ listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); - if (nsPtr != NULL) { +#ifndef INFO_PROCS_SEARCH_GLOBAL_NS + if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { + entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); + if (entryPtr != NULL) { + cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + + if (!TclIsProc(cmdPtr)) { + realCmdPtr = (Command *) + TclGetOriginalCommand((Tcl_Command) cmdPtr); + if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) { + goto simpleProcOK; + } + } else { + simpleProcOK: + if (specificNsInPattern) { + elemObjPtr = Tcl_NewObj(); + Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, + elemObjPtr); + } else { + elemObjPtr = Tcl_NewStringObj(simplePattern, -1); + } + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); + } + } + } else +#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */ + { entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); @@ -1601,11 +1673,14 @@ InfoProcsCmd(dummy, interp, objc, objv) || Tcl_StringMatch(cmdName, simplePattern)) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); - realCmdPtr = (Command *) - TclGetOriginalCommand((Tcl_Command) cmdPtr); - - if (TclIsProc(cmdPtr) - || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) { + if (!TclIsProc(cmdPtr)) { + realCmdPtr = (Command *) + TclGetOriginalCommand((Tcl_Command) cmdPtr); + if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) { + goto procOK; + } + } else { + procOK: if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, @@ -1613,7 +1688,6 @@ InfoProcsCmd(dummy, interp, objc, objv) } else { elemObjPtr = Tcl_NewStringObj(cmdName, -1); } - Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } @@ -1893,54 +1967,91 @@ InfoVarsCmd(dummy, interp, objc, objv) * only the variables in the effective namespace's variable table. */ - entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search); - while (entryPtr != NULL) { - varPtr = (Var *) Tcl_GetHashValue(entryPtr); - if (!TclIsVarUndefined(varPtr) - || (varPtr->flags & VAR_NAMESPACE_VAR)) { - varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr); - if ((simplePattern == NULL) - || Tcl_StringMatch(varName, simplePattern)) { + if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { + /* + * If we can just do hash lookups, that simplifies things + * a lot. + */ + + entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern); + if (entryPtr != NULL) { + varPtr = (Var *) Tcl_GetHashValue(entryPtr); + if (!TclIsVarUndefined(varPtr) + || (varPtr->flags & VAR_NAMESPACE_VAR)) { if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, - elemObjPtr); + elemObjPtr); } else { - elemObjPtr = Tcl_NewStringObj(varName, -1); + elemObjPtr = Tcl_NewStringObj(simplePattern, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } + } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) { + entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, + simplePattern); + varPtr = (Var *) Tcl_GetHashValue(entryPtr); + if (!TclIsVarUndefined(varPtr) + || (varPtr->flags & VAR_NAMESPACE_VAR)) { + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj(simplePattern, -1)); + } } - entryPtr = Tcl_NextHashEntry(&search); - } - - /* - * If the effective namespace isn't the global :: namespace, and a - * specific namespace wasn't requested in the pattern (i.e., the - * pattern only specifies variable names), then add in all global :: - * variables that match the simple pattern. Of course, add in only - * those variables that aren't hidden by a variable in the effective - * namespace. - */ + } else { + /* + * Have to scan the tables of variables. + */ - if ((nsPtr != globalNsPtr) && !specificNsInPattern) { - entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); + entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search); while (entryPtr != NULL) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (!TclIsVarUndefined(varPtr) || (varPtr->flags & VAR_NAMESPACE_VAR)) { - varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr); + varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(varName, simplePattern)) { - if (Tcl_FindHashEntry(&nsPtr->varTable, - varName) == NULL) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(varName, -1)); + if (specificNsInPattern) { + elemObjPtr = Tcl_NewObj(); + Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, elemObjPtr); + } else { + elemObjPtr = Tcl_NewStringObj(varName, -1); } + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } entryPtr = Tcl_NextHashEntry(&search); } + + /* + * If the effective namespace isn't the global :: + * namespace, and a specific namespace wasn't requested in + * the pattern (i.e., the pattern only specifies variable + * names), then add in all global :: variables that match + * the simple pattern. Of course, add in only those + * variables that aren't hidden by a variable in the + * effective namespace. + */ + + if ((nsPtr != globalNsPtr) && !specificNsInPattern) { + entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); + while (entryPtr != NULL) { + varPtr = (Var *) Tcl_GetHashValue(entryPtr); + if (!TclIsVarUndefined(varPtr) + || (varPtr->flags & VAR_NAMESPACE_VAR)) { + varName = Tcl_GetHashKey(&globalNsPtr->varTable, + entryPtr); + if ((simplePattern == NULL) + || Tcl_StringMatch(varName, simplePattern)) { + if (Tcl_FindHashEntry(&nsPtr->varTable, + varName) == NULL) { + Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj(varName, -1)); + } + } + } + entryPtr = Tcl_NextHashEntry(&search); + } + } } } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) { AppendLocals(interp, listPtr, simplePattern, 1); |