summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclNamesp.c404
2 files changed, 243 insertions, 168 deletions
diff --git a/ChangeLog b/ChangeLog
index 7fe38d3..5484e06 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2008-07-15 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclNamesp.c (EnsembleUnknownCallback): Factor out some of
+ the more complex parts of the ensemble code to make it easier to
+ understand and hence to permit tighter compilation of code on the
+ critical path.
+
2008-07-14 Miguel Sofer <msofer@users.sf.net>
* generic/tclParse.c: reverting the "fix" for [Bug 2017583],
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index a0a651b..3faae95 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.165 2008/07/13 09:03:35 msofer Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.166 2008/07/15 10:15:52 dkf Exp $
*/
#include "tclInt.h"
@@ -154,6 +154,9 @@ static int DoImport(Tcl_Interp *interp,
const char *cmdName, const char *pattern,
Namespace *importNsPtr, int allowOverwrite);
static void DupNsNameInternalRep(Tcl_Obj *objPtr,Tcl_Obj *copyPtr);
+static inline int EnsembleUnknownCallback(Tcl_Interp *interp,
+ EnsembleConfig *ensemblePtr, int objc,
+ Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
static char * ErrorCodeRead(ClientData clientData,Tcl_Interp *interp,
const char *name1, const char *name2, int flags);
static char * ErrorInfoRead(ClientData clientData,Tcl_Interp *interp,
@@ -1645,7 +1648,8 @@ DoImport(
dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData));
importedCmd = TclNR_CreateCommand(interp, Tcl_DStringValue(&ds),
- InvokeImportedCmd, InvokeImportedNRCmd, dataPtr, DeleteImportedCmd);
+ InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
+ DeleteImportedCmd);
dataPtr->realCmdPtr = cmdPtr;
dataPtr->selfPtr = (Command *) importedCmd;
dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
@@ -1893,11 +1897,10 @@ InvokeImportedNRCmd(
register Command *realCmdPtr = dataPtr->realCmdPtr;
if (!realCmdPtr->nreProc) {
- return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
- objc, objv);
+ return realCmdPtr->objProc(realCmdPtr->objClientData, interp,
+ objc, objv);
}
- return (*realCmdPtr->nreProc)(realCmdPtr->objClientData, interp,
- objc, objv);
+ return realCmdPtr->nreProc(realCmdPtr->objClientData, interp, objc, objv);
}
static int
@@ -1911,8 +1914,7 @@ InvokeImportedCmd(
register ImportedCmdData *dataPtr = clientData;
register Command *realCmdPtr = dataPtr->realCmdPtr;
- return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
- objc, objv);
+ return realCmdPtr->objProc(realCmdPtr->objClientData, interp, objc, objv);
}
/*
@@ -2797,7 +2799,8 @@ Tcl_NamespaceObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- return TclNR_CallObjProc(interp, TclNRNamespaceObjCmd, clientData, objc, objv);
+ return TclNR_CallObjProc(interp, TclNRNamespaceObjCmd, clientData, objc,
+ objv);
}
int
@@ -3260,35 +3263,6 @@ NamespaceDeleteCmd(
*/
static int
-NsEval_Callback(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Tcl_Namespace *namespacePtr = data[0];
-
- if (result == TCL_ERROR) {
- int length = strlen(namespacePtr->fullName);
- int limit = 200;
- int overflow = (length > limit);
- char *cmd = data[1];
-
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (in namespace %s \"%.*s%s\" script line %d)",
- cmd,
- (overflow ? limit : length), namespacePtr->fullName,
- (overflow ? "..." : ""), interp->errorLine));
- }
-
- /*
- * Restore the previous "current" namespace.
- */
-
- TclPopStackFrame(interp);
- return result;
-}
-
-static int
NamespaceEvalCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
@@ -3358,9 +3332,39 @@ NamespaceEvalCmd(
* TIP #280: Make invoking context available to eval'd script.
*/
- TclNR_AddCallback(interp, NsEval_Callback, namespacePtr, "eval", NULL, NULL);
+ TclNR_AddCallback(interp, NsEval_Callback, namespacePtr, "eval",
+ NULL, NULL);
return TclNREvalObjEx(interp, objPtr, 0, iPtr->cmdFramePtr, 3);
}
+
+static int
+NsEval_Callback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Namespace *namespacePtr = data[0];
+
+ if (result == TCL_ERROR) {
+ int length = strlen(namespacePtr->fullName);
+ int limit = 200;
+ int overflow = (length > limit);
+ char *cmd = data[1];
+
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (in namespace %s \"%.*s%s\" script line %d)",
+ cmd,
+ (overflow ? limit : length), namespacePtr->fullName,
+ (overflow ? "..." : ""), interp->errorLine));
+ }
+
+ /*
+ * Restore the previous "current" namespace.
+ */
+
+ TclPopStackFrame(interp);
+ return result;
+}
/*
*----------------------------------------------------------------------
@@ -3774,7 +3778,8 @@ NamespaceInscopeCmd(
Tcl_DecrRefCount(listPtr); /* We're done with the list object. */
}
- TclNR_AddCallback(interp, NsEval_Callback, namespacePtr, "inscope", NULL, NULL);
+ TclNR_AddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
+ NULL, NULL);
return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
}
@@ -6045,21 +6050,6 @@ NsEnsembleImplementationCmd(
clientData, objc, objv);
}
-int
-TclClearRootEnsemble(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Interp *iPtr = (Interp *) interp;
-
- iPtr->ensembleRewrite.sourceObjs = NULL;
- iPtr->ensembleRewrite.numRemovedObjs = 0;
- iPtr->ensembleRewrite.numInsertedObjs = 0;
-
- return result;
-}
-
static int
NsEnsembleImplementationCmdNR(
ClientData clientData,
@@ -6069,19 +6059,12 @@ NsEnsembleImplementationCmdNR(
{
EnsembleConfig *ensemblePtr = clientData;
/* The ensemble itself. */
- 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. */
Tcl_Obj *prefixObj; /* An object containing the prefix words of
* the command that implements the
* subcommand. */
Tcl_HashEntry *hPtr; /* Used for efficient lookup of fully
* specified but not yet cached command
* names. */
- Tcl_Obj **prefixObjv; /* The list of objects to substitute in as the
- * target command prefix. */
- int prefixObjc; /* Size of prefixObjv of course! */
int reparseCount = 0; /* Number of reparses. */
if (objc < 2) {
@@ -6133,7 +6116,7 @@ NsEnsembleImplementationCmdNR(
/*
* Look in the hashtable for the subcommand name; this is the fastest way
- * of all.
+ * of all if there is no cache in operation.
*/
hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
@@ -6232,48 +6215,58 @@ NsEnsembleImplementationCmdNR(
*/
{
+ Tcl_Obj **prefixObjv; /* The list of objects to substitute in as the
+ * target command prefix. */
+ Tcl_Obj *copyPtr; /* The actual list of words to dispatch to.
+ * Will be freed by the dispatch engine. */
+ int prefixObjc, copyObjc;
Interp *iPtr = (Interp *) interp;
- int isRootEnsemble, i, tempObjc;
- Tcl_Obj *copyPtr;
- List *listRepPtr;
/*
* Get the prefix that we're rewriting to. To do this we need to
* ensure that the internal representation of the list does not change
* so that we can safely keep the internal representations of the
* elements in the list.
+ *
+ * TODO: Use conventional list operations to make this code sane!
*/
TclListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
- tempObjc = objc - 2 + prefixObjc;
- copyPtr = Tcl_NewListObj(tempObjc, NULL);
- if (tempObjc > 0) {
- listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
- listRepPtr->elemCount = tempObjc;
- tempObjv = &listRepPtr->elements;
-
- memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
- memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
-
- for (i=0; i < tempObjc; i++) {
- Tcl_IncrRefCount(tempObjv[i]);
+ copyObjc = objc - 2 + prefixObjc;
+ copyPtr = Tcl_NewListObj(copyObjc, NULL);
+ if (copyObjc > 0) {
+ register Tcl_Obj **copyObjv;
+ /* Space used to construct the list of
+ * arguments to pass to the command that
+ * implements the ensemble subcommand. */
+ register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
+ register int i;
+
+ listRepPtr->elemCount = copyObjc;
+ copyObjv = &listRepPtr->elements;
+ memcpy(copyObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
+ memcpy(copyObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));
+
+ for (i=0; i < copyObjc; i++) {
+ Tcl_IncrRefCount(copyObjv[i]);
}
}
- Tcl_DecrRefCount(prefixObj);
+ TclDecrRefCount(prefixObj);
/*
* Record what arguments the script sent in so that things like
* Tcl_WrongNumArgs can give the correct error message.
*/
- isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
- if (isRootEnsemble) {
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs = 2;
iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
+ TclNR_AddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
+ NULL);
} else {
- int ni = iPtr->ensembleRewrite.numInsertedObjs;
+ register int ni = iPtr->ensembleRewrite.numInsertedObjs;
if (ni < 2) {
iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
@@ -6287,10 +6280,6 @@ NsEnsembleImplementationCmdNR(
* Hand off to the target command.
*/
- if (isRootEnsemble) {
- TclNR_AddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
- }
-
return TclNREvalCmd(interp, copyPtr, TCL_EVAL_INVOKE);
}
@@ -6303,90 +6292,15 @@ NsEnsembleImplementationCmdNR(
*/
if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
- int paramc, i;
- Tcl_Obj **paramv, *unknownCmd, *ensObj;
-
- unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
- TclNewObj(ensObj);
- Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
- Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
- for (i=1 ; i<objc ; i++) {
- Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
- }
- TclListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
- Tcl_Preserve(ensemblePtr);
- Tcl_IncrRefCount(unknownCmd);
- result = Tcl_EvalObjv(interp, paramc, paramv, 0);
- if (result == TCL_OK) {
- prefixObj = Tcl_GetObjResult(interp);
- Tcl_IncrRefCount(prefixObj);
- Tcl_DecrRefCount(unknownCmd);
- Tcl_Release(ensemblePtr);
- Tcl_ResetResult(interp);
- if (ensemblePtr->flags & ENS_DEAD) {
- Tcl_DecrRefCount(prefixObj);
- Tcl_SetResult(interp,
- "unknown subcommand handler deleted its ensemble",
- TCL_STATIC);
- return TCL_ERROR;
- }
-
- /*
- * Namespace is still there. Check if the result is a valid list.
- * If it is, and it is non-empty, that list is what we are using
- * as our replacement.
- */
-
- if (TclListObjLength(interp, prefixObj, &prefixObjc) != TCL_OK) {
- Tcl_DecrRefCount(prefixObj);
- Tcl_AddErrorInfo(interp, "\n while parsing result of "
- "ensemble unknown subcommand handler");
- return TCL_ERROR;
- }
- if (prefixObjc > 0) {
- goto runResultingSubcommand;
- }
-
- /*
- * Namespace alive & empty result => reparse.
- */
-
- Tcl_DecrRefCount(prefixObj);
+ switch (EnsembleUnknownCallback(interp, ensemblePtr, objc, objv,
+ &prefixObj)) {
+ case TCL_OK:
+ goto runResultingSubcommand;
+ case TCL_ERROR:
+ return TCL_ERROR;
+ case TCL_CONTINUE:
goto restartEnsembleParse;
}
- if (!Tcl_InterpDeleted(interp)) {
- if (result != TCL_ERROR) {
- char buf[TCL_INTEGER_SPACE];
-
- Tcl_ResetResult(interp);
- Tcl_SetResult(interp,
- "unknown subcommand handler returned bad code: ",
- TCL_STATIC);
- switch (result) {
- case TCL_RETURN:
- Tcl_AppendResult(interp, "return", NULL);
- break;
- case TCL_BREAK:
- Tcl_AppendResult(interp, "break", NULL);
- break;
- case TCL_CONTINUE:
- Tcl_AppendResult(interp, "continue", NULL);
- break;
- default:
- sprintf(buf, "%d", result);
- Tcl_AppendResult(interp, buf, NULL);
- }
- Tcl_AddErrorInfo(interp, "\n result of "
- "ensemble unknown subcommand handler: ");
- Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
- } else {
- Tcl_AddErrorInfo(interp,
- "\n (ensemble unknown subcommand handler)");
- }
- }
- Tcl_DecrRefCount(unknownCmd);
- Tcl_Release(ensemblePtr);
- return TCL_ERROR;
}
/*
@@ -6426,6 +6340,160 @@ NsEnsembleImplementationCmdNR(
TclGetString(objv[1]), NULL);
return TCL_ERROR;
}
+
+int
+TclClearRootEnsemble(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ iPtr->ensembleRewrite.sourceObjs = NULL;
+ iPtr->ensembleRewrite.numRemovedObjs = 0;
+ iPtr->ensembleRewrite.numInsertedObjs = 0;
+
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * EnsmebleUnknownCallback --
+ *
+ * Helper for the ensemble engine that handles the procesing of unknown
+ * callbacks. See the user documentation of the ensemble unknown handler
+ * for details; this function is only ever called when such a function is
+ * defined, and is only ever called once per ensemble dispatch (i.e. if a
+ * reparse still fails, this isn't called again).
+ *
+ * Results:
+ * TCL_OK - *prefixObjPtr contains the command words to dispatch
+ * to.
+ * TCL_CONTINUE - Need to reparse (*prefixObjPtr is invalid).
+ * TCL_ERROR - Something went wrong! Error message in interpreter.
+ *
+ * Side effects:
+ * Calls the Tcl interpreter, so arbitrary.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+EnsembleUnknownCallback(
+ Tcl_Interp *interp,
+ EnsembleConfig *ensemblePtr,
+ int objc,
+ Tcl_Obj *const objv[],
+ Tcl_Obj **prefixObjPtr)
+{
+ int paramc, i, result, prefixObjc;
+ Tcl_Obj **paramv, *unknownCmd, *ensObj;
+ char buf[TCL_INTEGER_SPACE];
+
+ /*
+ * Create the unknown command callback to determine what to do.
+ */
+
+ unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
+ TclNewObj(ensObj);
+ Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
+ Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
+ for (i=1 ; i<objc ; i++) {
+ Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
+ }
+ TclListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
+ Tcl_IncrRefCount(unknownCmd);
+
+ /*
+ * Now call the unknown handler. (We don't bother NRE-enabling this; deep
+ * recursing through unknown handlers is horribly perverse.) Note that it
+ * is always an error for an unknown handler to delete its ensemble; don't
+ * do that!
+ */
+
+ Tcl_Preserve(ensemblePtr);
+ result = Tcl_EvalObjv(interp, paramc, paramv, 0);
+ if ((result == TCL_OK) && (ensemblePtr->flags & ENS_DEAD)) {
+ Tcl_SetResult(interp,
+ "unknown subcommand handler deleted its ensemble",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ }
+ Tcl_Release(ensemblePtr);
+
+ /*
+ * If we succeeded, we should either have a list of words that form the
+ * command to be executed, or an empty list. In the empty-list case, the
+ * ensemble is believed to be updated so we should ask the ensemble engine
+ * to reparse the original command.
+ */
+
+ if (result == TCL_OK) {
+ *prefixObjPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(*prefixObjPtr);
+ TclDecrRefCount(unknownCmd);
+ Tcl_ResetResult(interp);
+
+ /*
+ * Namespace is still there. Check if the result is a valid list. If
+ * it is, and it is non-empty, that list is what we are using as our
+ * replacement.
+ */
+
+ if (TclListObjLength(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) {
+ TclDecrRefCount(*prefixObjPtr);
+ Tcl_AddErrorInfo(interp, "\n while parsing result of "
+ "ensemble unknown subcommand handler");
+ return TCL_ERROR;
+ }
+ if (prefixObjc > 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * Namespace alive & empty result => reparse.
+ */
+
+ TclDecrRefCount(*prefixObjPtr);
+ return TCL_CONTINUE;
+ }
+
+ /*
+ * Oh no! An exceptional result. Convert to an error.
+ */
+
+ if (!Tcl_InterpDeleted(interp)) {
+ if (result != TCL_ERROR) {
+ Tcl_ResetResult(interp);
+ Tcl_SetResult(interp,
+ "unknown subcommand handler returned bad code: ",
+ TCL_STATIC);
+ switch (result) {
+ case TCL_RETURN:
+ Tcl_AppendResult(interp, "return", NULL);
+ break;
+ case TCL_BREAK:
+ Tcl_AppendResult(interp, "break", NULL);
+ break;
+ case TCL_CONTINUE:
+ Tcl_AppendResult(interp, "continue", NULL);
+ break;
+ default:
+ sprintf(buf, "%d", result);
+ Tcl_AppendResult(interp, buf, NULL);
+ }
+ Tcl_AddErrorInfo(interp, "\n result of "
+ "ensemble unknown subcommand handler: ");
+ Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
+ } else {
+ Tcl_AddErrorInfo(interp,
+ "\n (ensemble unknown subcommand handler)");
+ }
+ }
+ TclDecrRefCount(unknownCmd);
+ return TCL_ERROR;
+}
/*
*----------------------------------------------------------------------