summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2004-10-05 21:21:45 (GMT)
committerdgp <dgp@users.sourceforge.net>2004-10-05 21:21:45 (GMT)
commitfba428714c97529bd8a332d353fb90dffebbd5eb (patch)
treeccec37373044dd0dfb559022b18107e1f496deae
parenteab3283014b276dd97ea9817fb75bf47c6181959 (diff)
downloadtcl-fba428714c97529bd8a332d353fb90dffebbd5eb.zip
tcl-fba428714c97529bd8a332d353fb90dffebbd5eb.tar.gz
tcl-fba428714c97529bd8a332d353fb90dffebbd5eb.tar.bz2
* generic/tclBasic.c (TclObjInvoke): More simplification of the
TclObjInvoke routine toward unification with the rest of the evaluation stack.
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclBasic.c78
2 files changed, 28 insertions, 54 deletions
diff --git a/ChangeLog b/ChangeLog
index 4632978..4249bc0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
2004-10-05 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclBasic.c (TclObjInvoke): More simplification of the
+ TclObjInvoke routine toward unification with the rest of the
+ evaluation stack.
+
* generic/tclBasic.c (Tcl_CreateInterp,Tcl_DeleteInterp,
TclEvalObjvInternal,Tcl_LogCommandInfo):
* generic/tclCmdAH.c (Tcl_CatchObjCmd):
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ca01b83..7cd40db 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.123 2004/10/05 18:14:27 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.124 2004/10/05 21:21:45 dgp Exp $
*/
#include "tclInt.h"
@@ -4234,9 +4234,8 @@ TclObjInvoke(interp, objc, objv, flags)
register Interp *iPtr = (Interp *) interp;
Tcl_HashTable *hTblPtr; /* Table of hidden commands. */
char *cmdName; /* Name of the command from objv[0]. */
- register Tcl_HashEntry *hPtr;
+ Tcl_HashEntry *hPtr = NULL;
Command *cmdPtr;
- Tcl_Obj **localObjv = NULL; /* command is not found. */
int result;
if (interp == (Tcl_Interp *) NULL) {
@@ -4249,37 +4248,29 @@ TclObjInvoke(interp, objc, objv, flags)
return TCL_ERROR;
}
- cmdName = Tcl_GetString(objv[0]);
- if (flags & TCL_INVOKE_HIDDEN) {
- /*
- * We never invoke "unknown" for hidden commands.
- */
-
- hPtr = NULL;
- hTblPtr = ((Interp *) interp)->hiddenCmdTablePtr;
- if (hTblPtr != NULL) {
- hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
- }
- if (hPtr == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "invalid hidden command name \"", cmdName, "\"",
- (char *) NULL);
- return TCL_ERROR;
- }
- cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
- } else {
- cmdPtr = NULL; /* Avoid warning */
+ if ((flags & TCL_INVOKE_HIDDEN) == 0) {
Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
}
- /*
- * Invoke the command procedure. First reset the interpreter's string
- * and object results to their default empty values since they could
- * have gotten changed by earlier invocations.
- */
+ if (TclInterpReady(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ cmdName = Tcl_GetString(objv[0]);
+ hTblPtr = iPtr->hiddenCmdTablePtr;
+ if (hTblPtr != NULL) {
+ hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
+ }
+ if (hPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid hidden command name \"", cmdName, "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
+
+ /* Invoke the command procedure. */
- Tcl_ResetResult(interp);
iPtr->cmdCount++;
result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
@@ -4292,33 +4283,12 @@ TclObjInvoke(interp, objc, objv, flags)
&& ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
&& ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
int length;
- CONST char* cmdString;
- Tcl_Obj *message, *command = Tcl_NewListObj(objc, objv);
+ Tcl_Obj *command = Tcl_NewListObj(objc, objv);
+ CONST char* cmdString = Tcl_GetStringFromObj(command, &length);
- if (!(iPtr->flags & ERR_IN_PROGRESS)) {
- message = Tcl_NewStringObj("\n while invoking\n\"", -1);
- } else {
- message = Tcl_NewStringObj("\n invoked from within\n\"", -1);
- }
- Tcl_IncrRefCount(message);
- Tcl_IncrRefCount(command);
- cmdString = Tcl_GetStringFromObj(command, &length);
- TclAppendLimitedToObj(message, cmdString, length, 100, NULL);
- Tcl_DecrRefCount(command);
- Tcl_AppendToObj(message, "\"", -1);
- TclAppendObjToErrorInfo(interp, message);
- Tcl_DecrRefCount(message);
+ Tcl_LogCommandInfo(interp, cmdString, cmdString, length);
iPtr->flags &= ~ERR_ALREADY_LOGGED;
}
-
- /*
- * Free any locally allocated storage used to call "unknown".
- */
-
- if (localObjv != (Tcl_Obj **) NULL) {
- Tcl_DecrRefCount(localObjv[0]);
- ckfree((char *) localObjv);
- }
return result;
}