Attachment "ensemble.patch" to
ticket [650046ffff]
added by
dkf
2003-02-14 21:39:39.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.72
diff -u -r1.72 tclBasic.c
--- generic/tclBasic.c 3 Feb 2003 20:16:52 -0000 1.72
+++ generic/tclBasic.c 14 Feb 2003 14:22:05 -0000
@@ -1167,7 +1169,7 @@
if (strstr(hiddenCmdToken, "::") != NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"cannot use namespace qualifiers as hidden command",
- "token (rename)", (char *) NULL);
+ " token (rename)", (char *) NULL);
return TCL_ERROR;
}
@@ -1241,6 +1243,14 @@
}
/*
+ * The list of command exported from the namespace might have
+ * changed. However, we do not need to recompute this just yet;
+ * next time we need the info will be soon enough.
+ */
+
+ TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
+
+ /*
* Now link the hash table entry with the command structure.
* We ensured above that the nsPtr was right.
*/
@@ -1370,6 +1380,14 @@
}
/*
+ * The list of command exported from the namespace might have
+ * changed. However, we do not need to recompute this just yet;
+ * next time we need the info will be soon enough.
+ */
+
+ TclInvalidateNsCmdLookup(nsPtr);
+
+ /*
* Remove the hash entry for the command from the interpreter hidden
* command table.
*/
@@ -1508,6 +1526,14 @@
ckfree((char*) Tcl_GetHashValue(hPtr));
}
+ } else {
+ /*
+ * The list of command exported from the namespace might have
+ * changed. However, we do not need to recompute this just
+ * yet; next time we need the info will be soon enough.
+ */
+
+ TclInvalidateNsCmdLookup(nsPtr);
}
cmdPtr = (Command *) ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
@@ -1670,6 +1696,14 @@
ckfree((char *) Tcl_GetHashValue(hPtr));
}
+ } else {
+ /*
+ * The list of command exported from the namespace might have
+ * changed. However, we do not need to recompute this just
+ * yet; next time we need the info will be soon enough.
+ */
+
+ TclInvalidateNsCmdLookup(nsPtr);
}
cmdPtr = (Command *) ckalloc(sizeof(Command));
Tcl_SetHashValue(hPtr, cmdPtr);
@@ -2006,6 +2040,16 @@
}
/*
+ * The list of command exported from the namespace might have
+ * changed. However, we do not need to recompute this just yet;
+ * next time we need the info will be soon enough. These might
+ * refer to the same variable, but that's no big deal.
+ */
+
+ TclInvalidateNsCmdLookup(cmdNsPtr);
+ TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
+
+ /*
* Script for rename traces can delete the command "oldName".
* Therefore increment the reference count for cmdPtr so that
* it's Command structure is freed only towards the end of this
@@ -2448,7 +2492,15 @@
}
cmdPtr->tracePtr = NULL;
}
-
+
+ /*
+ * The list of command exported from the namespace might have
+ * changed. However, we do not need to recompute this just yet;
+ * next time we need the info will be soon enough.
+ */
+
+ TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
+
/*
* If the command being deleted has a compile procedure, increment the
* interpreter's compileEpoch to invalidate its compiled code. This
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.118
diff -u -r1.118 tclInt.h
--- generic/tclInt.h 10 Feb 2003 10:26:25 -0000 1.118
+++ generic/tclInt.h 14 Feb 2003 14:22:07 -0000
@@ -212,6 +212,16 @@
* within LookupCompiledLocal to resolve
* variable references within the namespace
* at compile time. */
+ int exportLookupEpoch; /* Incremented whenever a command is added to
+ * a namespace, removed from a namespace or
+ * the exports of a namespace are changed.
+ * Allows TIP#112-driven command lists to be
+ * validated efficiently. */
+ Tcl_Command ensembleToken; /* The token for the command that provides
+ * ensemble support for this namespace, or
+ * NULL if the command has been deleted (or
+ * never existed; the global namespace never
+ * has an ensemble command.) */
} Namespace;
/*
@@ -1597,6 +1607,7 @@
#ifndef TCL_WIDE_INT_IS_LONG
extern Tcl_ObjType tclWideIntType;
#endif
+extern Tcl_ObjType tclEnsembleCmdType;
/*
* Variables denoting the hash key types defined in the core.
@@ -2269,11 +2285,27 @@
* CONST Tcl_UniChar *ct, unsigned long n));
*----------------------------------------------------------------
*/
+
#ifdef WORDS_BIGENDIAN
# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
#else /* !WORDS_BIGENDIAN */
# define TclUniCharNcmp Tcl_UniCharNcmp
#endif /* WORDS_BIGENDIAN */
+
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to increment a namespace's export
+ * export epoch counter.
+ * The ANSI C "prototype" for this macro is:
+ *
+ * EXTERN void TclInvalidateNsCmdLookup _ANSI_ARGS_((Namespace *nsPtr));
+ *----------------------------------------------------------------
+ */
+
+#define TclInvalidateNsCmdLookup(nsPtr) \
+ if ((nsPtr)->numExportPatterns) { \
+ (nsPtr)->exportLookupEpoch++; \
+ }
#include "tclIntDecls.h"
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.31
diff -u -r1.31 tclNamesp.c
--- generic/tclNamesp.c 15 Jul 2002 22:18:07 -0000 1.31
+++ generic/tclNamesp.c 14 Feb 2003 14:22:08 -0000
@@ -10,6 +10,7 @@
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 2002-2003 Donal K. Fellows.
*
* Originally implemented by
* Michael J. McLennan
@@ -74,15 +75,55 @@
} ResolvedNsName;
/*
+ * The client data for an ensemble command. This consists of the
+ * table of commands that are actually exported by the namespace, and
+ * an epoch counter that, combined with the exportLookupEpoch field of
+ * the namespace structure, defines whether the table contains valid
+ * data or will need to be recomputed next time the ensemble command
+ * is called.
+ */
+
+typedef struct EnsembleData {
+ Namespace *nsPtr; /* The namspace backing this ensemble up. */
+ int epoch; /* The epoch at which this ensemble's table of
+ * exported commands is valid. */
+ int numSubcommands; /* Number of commands exported by the
+ * namespace as ensemble subcommands. */
+ char **subcommandArrayPtr; /* Array of ensemble subcommand names. */
+ Tcl_HashTable subcommandTable;
+ /* Hash table of ensemble subcommand names,
+ * which are its keys so this also provides
+ * the storage management for those subcommand
+ * names. */
+} EnsembleData;
+
+/*
+ * The data cached in a subcommand's Tcl_Obj rep. This structure is
+ * not shared between Tcl_Objs referring to the same subcommand, even
+ * where one is a duplicate of another.
+ */
+
+typedef struct EnsembleCmd {
+ Namespace *nsPtr; /* The namespace backing the ensemble which
+ * this is a subcommand of. */
+ int epoch; /* Used to confirm when the data in this
+ * really structure matches up with the
+ * ensemble. */
+ char *fullSubcmdName; /* The full (local) name of the subcommand,
+ * allocated with ckalloc(). */
+ Tcl_Obj *realCmdObj; /* Object containing the fully qualified
+ * command in the namespace that implements
+ * this ensemble subcommand. */
+} EnsembleCmd;
+
+/*
* Declarations for procedures local to this file:
*/
-static void DeleteImportedCmd _ANSI_ARGS_((
- ClientData clientData));
+static void DeleteImportedCmd _ANSI_ARGS_((ClientData clientData));
static void DupNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
Tcl_Obj *copyPtr));
-static void FreeNsNameInternalRep _ANSI_ARGS_((
- Tcl_Obj *objPtr));
+static void FreeNsNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static int GetNamespaceFromObj _ANSI_ARGS_((
Tcl_Interp *interp, Tcl_Obj *objPtr,
Tcl_Namespace **nsPtrPtr));
@@ -138,6 +179,17 @@
static int SetNsNameFromAny _ANSI_ARGS_((
Tcl_Interp *interp, Tcl_Obj *objPtr));
static void UpdateStringOfNsName _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int NsEnsembleImplementationCmd _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
+static int NsEnsembleStringOrder _ANSI_ARGS_((CONST VOID *strPtr1,
+ CONST VOID *strPtr2));
+static void DeleteEnsembleData _ANSI_ARGS_((
+ ClientData clientData));
+static void FreeEnsembleCmdRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void DupEnsembleCmdRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+ Tcl_Obj *copyPtr));
+static void StringOfEnsembleCmd _ANSI_ARGS_((Tcl_Obj *objPtr));
/*
* This structure defines a Tcl object type that contains a
@@ -153,6 +205,21 @@
UpdateStringOfNsName, /* updateStringProc */
SetNsNameFromAny /* setFromAnyProc */
};
+
+/*
+ * This structure defines a Tcl object type that contains a reference
+ * to an ensemble subcommand (e.g. the "length" in [string length ab])
+ * It is used to cache the mapping between the subcommand itself and
+ * the real command that implements it.
+ */
+
+Tcl_ObjType tclEnsembleCmdType = {
+ "ensembleCommand", /* the type's name */
+ FreeEnsembleCmdRep, /* freeIntRepProc */
+ DupEnsembleCmdRep, /* dupIntRepProc */
+ StringOfEnsembleCmd, /* updateStringProc */
+ NULL /* setFromAnyProc */
+};
/*
*----------------------------------------------------------------------
@@ -534,11 +601,25 @@
nsPtr->cmdResProc = NULL;
nsPtr->varResProc = NULL;
nsPtr->compiledVarResProc = NULL;
+ nsPtr->exportLookupEpoch = 0;
+ nsPtr->ensembleToken = NULL;
if (parentPtr != NULL) {
+ EnsembleData *ensemblePtr;
+
entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
&newEntry);
Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
+
+ ensemblePtr = (EnsembleData *) ckalloc(sizeof(EnsembleData));
+ ensemblePtr->nsPtr = nsPtr;
+ Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
+ ensemblePtr->subcommandArrayPtr = NULL;
+ ensemblePtr->numSubcommands = 0;
+ ensemblePtr->epoch = 0;
+ nsPtr->ensembleToken = Tcl_CreateObjCommand(interp, simpleName,
+ NsEnsembleImplementationCmd, (ClientData)ensemblePtr,
+ DeleteEnsembleData);
}
/*
@@ -604,6 +685,20 @@
Tcl_HashEntry *entryPtr;
/*
+ * If the namespace has an associated ensemble command, delete it
+ * first. This leaves the actual contents of the namespace alone.
+ * Note that a namespace might not have an ensemble command
+ * associated with it; the global namespace never does, this might
+ * be a reentrant call to Tcl_DeleteNamespace(), or the user might
+ * have nuked the command.
+ */
+
+ if (nsPtr->ensembleToken != NULL) {
+ Tcl_DeleteCommandFromToken(nsPtr->interp, nsPtr->ensembleToken);
+ nsPtr->ensembleToken = NULL;
+ }
+
+ /*
* If the namespace is on the call frame stack, it is marked as "dying"
* (NS_DYING is OR'd into its flags): the namespace can't be looked up
* by name but its commands and variables are still usable by those
@@ -941,6 +1036,7 @@
}
ckfree((char *) nsPtr->exportArrayPtr);
nsPtr->exportArrayPtr = NULL;
+ TclInvalidateNsCmdLookup(nsPtr);
nsPtr->numExportPatterns = 0;
nsPtr->maxExportPatterns = 0;
}
@@ -1010,6 +1106,16 @@
nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
nsPtr->numExportPatterns++;
+
+ /*
+ * The list of commands actually exported from the namespace might
+ * have changed (probably will have!) However, we do not need to
+ * recompute this just yet; next time we need the info will be
+ * soon enough.
+ */
+
+ TclInvalidateNsCmdLookup(nsPtr);
+
return TCL_OK;
#undef INIT_EXPORT_PATTERNS
}
@@ -3980,4 +4086,512 @@
objPtr->bytes[length] = '\0';
}
objPtr->length = length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NsEnsembleImplementationCmd --
+ *
+ * Implements an ensemble of commands (being those exported by a
+ * namespace other than the global namespace) as a command with
+ * the same (short) name as the namespace in the parent namespace.
+ *
+ * Results:
+ * A standard Tcl result code. Will be TCL_ERROR if the command
+ * is not an unambiguous prefix of any command exported by the
+ * ensemble's namespace.
+ *
+ * Side effects:
+ * Depends on the command within the namespace that gets executed.
+ * If the ensemble itself returns TCL_ERROR, a descriptive error
+ * message will be placed in the interpreter's result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NsEnsembleImplementationCmd(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ EnsembleData *ensemblePtr = (EnsembleData *) clientData;
+ /* The ensemble itself. */
+ EnsembleCmd *ensembleCmd; /* Internal rep. of a subcommand in
+ * the ensemble. */
+ Tcl_Obj **tempObjv; /* Space used to construct the list of
+ * arguments to pass to the command
+ * that implements the ensemble
+ * subcommand. */
+ int result; /* The result of the subcommand
+ * execution. */
+ char *fullCommandName; /* Full name of the implementation
+ * command within the context of the
+ * namespace. */
+ int tableLength; /* Number of subcommands in the
+ * ensemble. */
+ Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
+ /* Hash table of all subcommands in
+ * the ensemble. Note that each hash
+ * entry has no value associated with
+ * it; it is only there for its key. */
+ Tcl_Obj *cmdObj; /* An object containing the full name
+ * of the implementation subcommand. */
+ Tcl_HashEntry *hPtr;
+ int stringLength;
+ int i, j;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?");
+ return TCL_ERROR;
+ }
+
+ if (ensemblePtr->epoch != ensemblePtr->nsPtr->exportLookupEpoch) {
+ Tcl_HashSearch search; /* Used for scanning the set of
+ * commands in the namespace that
+ * backs up this ensemble. */
+
+ if (ensemblePtr->numSubcommands != 0) {
+ /*
+ * Remove pre-existing table.
+ */
+ ckfree((char *)ensemblePtr->subcommandArrayPtr);
+ Tcl_DeleteHashTable(hash);
+ Tcl_InitHashTable(hash, TCL_STRING_KEYS);
+ }
+ /*
+ * Discover what commands are actually exported by the
+ * namespace. What we have is an array of patterns and a hash
+ * table whose keys are the command names exported by the
+ * namespace (the contents do not matter here.) We must find
+ * out what commands are actually exported by filtering each
+ * command in the namespace against each of the patterns in
+ * the export list. Note that we use an intermediate hash
+ * table to make memory management easier, and because that
+ * makes exact matching far easier too.
+ *
+ * Suggestion for future enhancement: compute the unique
+ * prefixes and place them in the hash too, which should make
+ * for even faster matching.
+ */
+ for (hPtr=Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
+ hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
+ int isNew; /* Dummy. */
+ char *nsCmdName = /* Name of command in namespace. */
+ Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);
+
+ for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
+ if (Tcl_StringMatch(nsCmdName,
+ ensemblePtr->nsPtr->exportArrayPtr[i])) {
+ Tcl_CreateHashEntry(hash, nsCmdName, &isNew);
+ /*
+ * Remember, hash entries have no content!
+ */
+ break;
+ }
+ }
+ }
+ tableLength = ensemblePtr->numSubcommands = hash->numEntries;
+ if (tableLength == 0) {
+ ensemblePtr->subcommandArrayPtr = NULL;
+ } else {
+ /*
+ * Create a sorted array of all subcommands in the
+ * ensemble; hash tables are all very well for a quick
+ * look for an exact match, but they can't determine
+ * things like whether a string is a prefix of another
+ * (not without lots of preparation anyway) and they're no
+ * good for when we're generating the error message
+ * either.
+ *
+ * We do this by filling an array with the names (we use
+ * the hash keys directly to save a copy, since any time
+ * we change the array we change the hash too, and vice
+ * versa) and running quicksort over the array.
+ */
+
+ ensemblePtr->subcommandArrayPtr = (char **)
+ ckalloc(sizeof(char *)*tableLength);
+ /*
+ * Fill array from both ends as this makes us less likely
+ * to end up with performance problems in qsort(), which
+ * is good. Note that doing this makes this code much
+ * more opaque, but the naive alternatve:
+ *
+ * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;
+ * hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search),i++) {
+ * ensemblePtr->subcommandArrayPtr[i] =
+ * Tcl_GetHashKey(hash, &hPtr);
+ * }
+ *
+ * can produce long runs of precisely ordered table
+ * entries when the commands in the namespace are declared
+ * in a sorted fashion (an ordering some people like) and
+ * the hashing functions (or the command names themselves)
+ * are fairly unfortunate. By filling from both ends, it
+ * requires active malice (and probably a debugger) to get
+ * qsort() to have awful runtime behaviour.
+ */
+ i = 0;
+ j = tableLength;
+ hPtr = Tcl_FirstHashEntry(hash, &search);
+ while (hPtr != NULL) {
+ ensemblePtr->subcommandArrayPtr[i++] =
+ Tcl_GetHashKey(hash, hPtr);
+ hPtr = Tcl_NextHashEntry(&search);
+ if (hPtr == NULL) {
+ break;
+ }
+ ensemblePtr->subcommandArrayPtr[--j] =
+ Tcl_GetHashKey(hash, hPtr);
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ if (tableLength > 1) {
+ qsort(ensemblePtr->subcommandArrayPtr,
+ (unsigned)tableLength, sizeof(char *),
+ NsEnsembleStringOrder);
+ }
+ }
+ ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch;
+ } else {
+ /*
+ * Table of subcommands is still valid; therefore there might
+ * be a valid cache of discovered information which we can
+ * reuse. Do the check here, and if we're still valid, we can
+ * jump straight to the part where we do the invocation of the
+ * subcommand.
+ */
+
+ if (objv[1]->typePtr == &tclEnsembleCmdType) {
+ ensembleCmd = (EnsembleCmd *) objv[1]->internalRep.otherValuePtr;
+ if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
+ ensembleCmd->epoch == ensemblePtr->epoch) {
+ cmdObj = ensembleCmd->realCmdObj;
+ goto runSubcommand;
+ }
+ }
+
+ tableLength = ensemblePtr->numSubcommands;
+ }
+
+ /*
+ * Look in the hashtable for the subcommand name; this is the
+ * fastest way of all.
+ */
+
+ hPtr = Tcl_FindHashEntry(hash, TclGetString(objv[1]));
+ if (hPtr != NULL) {
+ fullCommandName = Tcl_GetHashKey(hash, hPtr);
+ } else {
+ /*
+ * If we've not already confirmed the command with the hash as
+ * part of building our export table, we need to scan the
+ * sorted array for matches.
+ */
+
+ int matched = 0; /* Have we found anything yet? */
+ char *subcmdName = Tcl_GetStringFromObj(objv[1], &stringLength);
+ for (i=0 ; i<tableLength ; i++) {
+ register int cmp = strncmp(subcmdName,
+ ensemblePtr->subcommandArrayPtr[i],
+ (unsigned)stringLength);
+ if (cmp == 0) {
+ if (matched) {
+ /*
+ * Since there's never the exact-match case to
+ * worry about (hash search filters this), getting
+ * here indicates that our subcommand is an
+ * ambiguous prefix of (at least) two exported
+ * subcommands, which is an error case.
+ */
+ goto unknownOrAmbiguousSubcommand;
+ }
+ matched = 1;
+ fullCommandName = ensemblePtr->subcommandArrayPtr[i];
+ } else if (cmp == 1) {
+ /*
+ * Because we are searching a sorted table, we can now
+ * stop searching because we have gone past anything
+ * that could possibly match.
+ */
+ break;
+ }
+ }
+ if (!matched) {
+ /*
+ * The subcommand is not a prefix of anything, so bail out!
+ */
+ goto unknownOrAmbiguousSubcommand;
+ }
+ }
+
+ /*
+ * Now we are here, we know the name of the command to use as
+ * implementation and the name of the namespace that contains it
+ * (namespaces know their names!) so we can construct the
+ * qualified name of the real command that we're going to execute.
+ */
+ cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
+ Tcl_AppendStringsToObj(cmdObj, "::", fullCommandName, NULL);
+
+ /*
+ * Cache what we've computed so far; it's not nice to repeatedly
+ * copy strings about. Note that to do this, we start by deleting
+ * any old representation that there was (though if it was an out
+ * of date ensemble rep, we can skip some of the deallocation
+ * process.)
+ */
+ if (objv[1]->typePtr == &tclEnsembleCmdType) {
+ ensembleCmd = (EnsembleCmd *) objv[1]->internalRep.otherValuePtr;
+ Tcl_DecrRefCount(ensembleCmd->realCmdObj);
+ ensembleCmd->nsPtr->refCount--;
+ if ((ensembleCmd->nsPtr->refCount == 0)
+ && (ensembleCmd->nsPtr->flags & NS_DEAD)) {
+ NamespaceFree(ensembleCmd->nsPtr);
+ }
+ ckfree(ensembleCmd->fullSubcmdName);
+ } else {
+ /*
+ * Kill the old internal rep, and replace it with a brand new
+ * one of our own.
+ */
+ if ((objv[1]->typePtr != NULL)
+ && (objv[1]->typePtr->freeIntRepProc != NULL)) {
+ objv[1]->typePtr->freeIntRepProc(objv[1]);
+ }
+ ensembleCmd = (EnsembleCmd *) ckalloc(sizeof(EnsembleCmd));
+ objv[1]->internalRep.otherValuePtr = (VOID *) ensembleCmd;
+ objv[1]->typePtr = &tclEnsembleCmdType;
+ }
+ /*
+ * Populate the internal rep.
+ */
+ ensembleCmd->nsPtr = ensemblePtr->nsPtr;
+ ensembleCmd->realCmdObj = cmdObj;
+ stringLength = strlen(fullCommandName)+1;
+ ensembleCmd->fullSubcmdName = ckalloc((unsigned)stringLength);
+ memcpy(ensembleCmd->fullSubcmdName, fullCommandName,
+ (unsigned)stringLength);
+ Tcl_IncrRefCount(ensembleCmd->realCmdObj);
+
+ runSubcommand:
+ /*
+ * Do the real work of execution of the subcommand by building an
+ * array of objects (note that this is one shorter than the number
+ * of arguments to this ensemble command), populating it and then
+ * feeding it back through the main command-lookup engine. In
+ * theory, we could look up the command in the namespace
+ * ourselves, as we already have the namespace in which it is
+ * guaranteed to exist, but we don't do that (the cacheing of the
+ * command object used should help with that.)
+ */
+ tempObjv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *)*(objc-1));
+ tempObjv[0] = cmdObj;
+ Tcl_IncrRefCount(cmdObj);
+ memcpy(tempObjv+1, objv+2, sizeof(Tcl_Obj *)*(objc-2));
+ result = Tcl_EvalObjv(interp, objc-1, tempObjv, 0);
+ Tcl_DecrRefCount(cmdObj);
+ ckfree((char *)tempObjv);
+ return result;
+
+ unknownOrAmbiguousSubcommand:
+ /*
+ * Cannot determine what subcommand to hand off to, so generate a
+ * (standard) failure message. Note the one odd case compared
+ * with standard ensemble-like command, which is where a namespace
+ * has no exported commands at all...
+ */
+ Tcl_ResetResult(interp);
+ if (ensemblePtr->numSubcommands == 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown subcommand \"", TclGetString(objv[1]),
+ "\": namespace ", ensemblePtr->nsPtr->fullName,
+ " does not export any commands", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown or ambiguous subcommand \"", TclGetString(objv[1]),
+ "\": must be ", NULL);
+ if (ensemblePtr->numSubcommands == 1) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ ensemblePtr->subcommandArrayPtr[0], NULL);
+ } else {
+ for (i=0 ; i<ensemblePtr->numSubcommands-1 ; i++) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ ensemblePtr->subcommandArrayPtr[i], ", ", NULL);
+ }
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "or ", ensemblePtr->subcommandArrayPtr[i], NULL);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NsEnsembleStringOrder --
+ *
+ * Helper function to compare two pointers to two strings for use
+ * with qsort().
+ *
+ * Results:
+ * -1 if the first string is smaller, 1 if the second string is
+ * smaller, and 0 if they are equal.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NsEnsembleStringOrder(strPtr1, strPtr2)
+ const void *strPtr1, *strPtr2;
+{
+ return strcmp(*(const char **)strPtr1, *(const char **)strPtr2);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteEnsembleData --
+ *
+ * Destroys the data structure used to represent an ensemble.
+ * This is called when the ensemble's command is deleted (which
+ * happens automatically if the ensemble's namespace is deleted.)
+ * Maintainers should note that the ensemble command's
+ * implementation does not read from this structure once it has
+ * invoked a subcommand, so no attempt is made to Tcl_Preserve()
+ * this structure. Also note that because an ensemble command is
+ * always deleted very early in the destruction of a namespace,
+ * there is no reference count in the main namespace structure
+ * associated with the ensemble structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteEnsembleData(clientData)
+ ClientData clientData;
+{
+ EnsembleData *ensemblePtr = (EnsembleData *)clientData;
+
+ if (ensemblePtr->numSubcommands != 0) {
+ ckfree((char *)ensemblePtr->subcommandArrayPtr);
+ }
+ Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
+ ckfree((char *)ensemblePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeEnsembleCmdRep --
+ *
+ * Destroys the internal representation of a Tcl_Obj that has been
+ * holding information about a command in an ensemble.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is deallocated. If this held the last reference to a
+ * namespace's main structure, that main structure will also be
+ * destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeEnsembleCmdRep(objPtr)
+ Tcl_Obj *objPtr;
+{
+ EnsembleCmd *ensembleCmd = (EnsembleCmd *)
+ objPtr->internalRep.otherValuePtr;
+
+ Tcl_DecrRefCount(ensembleCmd->realCmdObj);
+ ckfree(ensembleCmd->fullSubcmdName);
+ ensembleCmd->nsPtr->refCount--;
+ if ((ensembleCmd->nsPtr->refCount == 0)
+ && (ensembleCmd->nsPtr->flags & NS_DEAD)) {
+ NamespaceFree(ensembleCmd->nsPtr);
+ }
+ ckfree((char *)ensembleCmd);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupEnsembleCmdRep --
+ *
+ * Makes one Tcl_Obj into a copy of another that is a subcommand
+ * of an ensemble.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is allocated, and the namespace that the ensemble is
+ * built on top of gains another reference.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupEnsembleCmdRep(objPtr, copyPtr)
+ Tcl_Obj *objPtr, *copyPtr;
+{
+ EnsembleCmd *ensembleCmd = (EnsembleCmd *)
+ objPtr->internalRep.otherValuePtr;
+ EnsembleCmd *ensembleCopy = (EnsembleCmd *) ckalloc(sizeof(EnsembleCmd));
+ unsigned int length = strlen(ensembleCmd->fullSubcmdName);
+
+ copyPtr->typePtr = &tclEnsembleCmdType;
+ copyPtr->internalRep.otherValuePtr = (VOID *) ensembleCopy;
+ ensembleCopy->nsPtr = ensembleCmd->nsPtr;
+ ensembleCopy->epoch = ensembleCmd->epoch;
+ ensembleCopy->nsPtr->refCount++;
+ ensembleCopy->realCmdObj = ensembleCmd->realCmdObj;
+ Tcl_IncrRefCount(ensembleCopy->realCmdObj);
+ ensembleCopy->fullSubcmdName = ckalloc(length+1);
+ memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
+ length+1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringOfEnsembleCmd --
+ *
+ * Creates a string representation of a Tcl_Obj that holds a
+ * subcommand of an ensemble.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object gains a string (UTF-8) representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StringOfEnsembleCmd(objPtr)
+ Tcl_Obj *objPtr;
+{
+ EnsembleCmd *ensembleCmd = (EnsembleCmd *)
+ objPtr->internalRep.otherValuePtr;
+ unsigned int length = strlen(ensembleCmd->fullSubcmdName);
+
+ objPtr->length = length;
+ objPtr->bytes = ckalloc(length+1);
+ memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, length+1);
}
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.42
diff -u -r1.42 tclObj.c
--- generic/tclObj.c 17 Jan 2003 22:11:02 -0000 1.42
+++ generic/tclObj.c 14 Feb 2003 14:22:08 -0000
@@ -243,6 +243,7 @@
Tcl_RegisterObjType(&tclArraySearchType);
Tcl_RegisterObjType(&tclIndexType);
Tcl_RegisterObjType(&tclNsNameType);
+ Tcl_RegisterObjType(&tclEnsembleCmdType);
Tcl_RegisterObjType(&tclCmdNameType);
#ifdef TCL_COMPILE_STATS
