Merge core-8-branch

8 files changed, 48 insertions, 78 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d2a017d..9398aff 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -2713,8 +2713,6 @@ TclCreateObjCommandInNs(
 	    Command *refCmdPtr = oldRefPtr->importedCmdPtr;
 
 	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
-	    cmdPtr->refCount++;
-	    TclCleanupCommandMacro(dataPtr->realCmdPtr);
 	    dataPtr->realCmdPtr = cmdPtr;
 	    oldRefPtr = oldRefPtr->nextPtr;
 	}
@@ -3297,7 +3295,7 @@ Tcl_GetCommandFullName(
      * separator, and the command name.
      */
 
-    if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) {
+    if (cmdPtr != NULL) {
 	if (cmdPtr->nsPtr != NULL) {
 	    Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1);
 	    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
@@ -3387,7 +3385,7 @@ Tcl_DeleteCommandFromToken(
      * and skip nested deletes.
      */
 
-    if (cmdPtr->flags & CMD_DYING) {
+    if (cmdPtr->flags & CMD_IS_DELETED) {
 	/*
 	 * Another deletion is already in progress. Remove the hash table
 	 * entry now, but don't invoke a callback or free the command
@@ -3419,7 +3417,7 @@ Tcl_DeleteCommandFromToken(
      * be ignored.
      */
 
-    cmdPtr->flags |= CMD_DYING;
+    cmdPtr->flags |= CMD_IS_DELETED;
 
     /*
      * Call trace functions for the command being deleted. Then delete its
@@ -3449,7 +3447,7 @@ Tcl_DeleteCommandFromToken(
     }
 
     /*
-     * The list of commands exported from the namespace might have changed.
+     * 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.
      */
@@ -3584,7 +3582,7 @@ CallCommandTraces(
 	 * While a rename trace is active, we will not process any more rename
 	 * traces; while a delete trace is active we will never reach here -
 	 * because Tcl_DeleteCommandFromToken checks for the condition
-	 * (cmdPtr->flags & CMD_DYING) and returns immediately when a
+	 * (cmdPtr->flags & CMD_IS_DELETED) and returns immediately when a
 	 * command deletion is in progress. For all other traces, delete
 	 * traces will not be invoked but a call to TraceCommandProc will
 	 * ensure that tracePtr->clientData is freed whenever the command
@@ -4752,7 +4750,7 @@ TEOV_RunLeaveTraces(
     size_t length;
     const char *command = TclGetStringFromObj(commandPtr, &length);
 
-    if (!(cmdPtr->flags & CMD_DYING)) {
+    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
 	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
 	    traceCode = TclCheckExecutionTraces(interp, command, length,
 		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
@@ -5872,7 +5870,7 @@ TclNREvalObjEx(
 	/*
 	 * Shimmer protection! Always pass an unshared obj. The caller could
 	 * incr the refCount of objPtr AFTER calling us! To be completely safe
-	 * we always make a copy. The callback takes care of the refCounts for
+	 * we always make a copy. The callback takes care od the refCounts for
 	 * both listPtr and objPtr.
 	 *
 	 * TODO: Create a test to demo this need, or eliminate it.
@@ -8759,7 +8757,7 @@ NRCoroutineCallerCallback(
     SAVE_CONTEXT(corPtr->running);
     RESTORE_CONTEXT(corPtr->caller);
 
-    if (cmdPtr->flags & CMD_DYING) {
+    if (cmdPtr->flags & CMD_IS_DELETED) {
 	/*
 	 * The command was deleted while it was running: wind down the
 	 * execEnv, this will do the complete cleanup. RewindCoroutine will
@@ -9528,7 +9526,7 @@ TclInfoCoroutineCmd(
 	return TCL_ERROR;
     }
 
-    if (corPtr && !(corPtr->cmdPtr->flags & CMD_DYING)) {
+    if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
 	Tcl_Obj *namePtr;
 
 	TclNewObj(namePtr);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 55914c8..9d90d61 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1815,7 +1815,7 @@ CompileCmdLiteral(
     bytes = TclGetStringFromObj(cmdObj, &length);
     cmdLitIdx = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);
 
-    if (cmdPtr && TclRoutineHasName(cmdPtr)) {
+    if (cmdPtr) {
 	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
     }
     TclEmitPush(cmdLitIdx, envPtr);
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 02405f5..faa0263 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -3162,7 +3162,7 @@ TclCompileEnsemble(
     }
 
     /*
-     * Now that the mapping process is done we actually try to compile.
+     * Now we've done the mapping process, can now actually try to compile.
      * If there is a subcommand compiler and that successfully produces code,
      * we'll use that. Otherwise, we fall back to generating opcodes to do the
      * invoke at runtime.
@@ -3262,9 +3262,9 @@ TclAttemptCompileProc(
 
     /*
      * Advance parsePtr->tokenPtr so that it points at the last subcommand.
-     * This will be wrong but it will not matter, and it will put the
-     * tokens for the arguments in the right place without the need to
-     * allocate a synthetic Tcl_Parse struct or copy tokens around.
+     * This will be wrong, but it will not matter, and it will put the
+     * tokens for the arguments in the right place without the needed to
+     * allocate a synthetic Tcl_Parse struct, or copy tokens around.
      */
 
     for (i = 0; i < depth - 1; i++) {
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 99db65c..6809d3c 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4254,7 +4254,7 @@ TEBCresume(
 	CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
 
 	TclNewObj(objResultPtr);
-	if (corPtr && !(corPtr->cmdPtr->flags & CMD_DYING)) {
+	if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
 	    Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr,
 		    objResultPtr);
 	}
@@ -4314,18 +4314,6 @@ TEBCresume(
 	TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS)));
 	cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS);
 	if (cmd == NULL) {
-	    goto instOriginError;
-	}
-	origCmd = TclGetOriginalCommand(cmd);
-	if (origCmd == NULL) {
-	    origCmd = cmd;
-	} 
-
-	TclNewObj(objResultPtr);
-	Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
-	if (TclCheckEmptyString(objResultPtr) == TCL_EMPTYSTRING_YES ) {
-	    Tcl_DecrRefCount(objResultPtr);
-	    instOriginError:
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
 	    DECACHE_STACK_INFO();
@@ -4335,6 +4323,12 @@ TEBCresume(
 	    TRACE_APPEND(("ERROR: not command\n"));
 	    goto gotError;
 	}
+	origCmd = TclGetOriginalCommand(cmd);
+	if (origCmd == NULL) {
+	    origCmd = cmd;
+	}
+	TclNewObj(objResultPtr);
+	Tcl_GetCommandFullName(interp, origCmd, objResultPtr);
 	TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS)));
 	NEXT_INST_F(1, 1, 1);
     }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0eecfb3..fc86c21 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1691,18 +1691,18 @@ typedef struct Command {
 /*
  * Flag bits for commands.
  *
- * CMD_DYING -			If 1 the command is in the process of
+ * CMD_IS_DELETED -		Means that the command is in the process of
  *				being deleted (its deleteProc is currently
  *				executing). Other attempts to delete the
  *				command should be ignored.
- * CMD_TRACE_ACTIVE -		If 1 the trace processing is currently
+ * CMD_TRACE_ACTIVE -		1 means that trace processing is currently
  *				underway for a rename/delete change. See the
  *				two flags below for which is currently being
  *				processed.
- * CMD_HAS_EXEC_TRACES -	If 1 means that this command has at least one
+ * CMD_HAS_EXEC_TRACES -	1 means that this command has at least one
  *				execution trace (as opposed to simple
  *				delete/rename traces) in its tracePtr list.
- * CMD_COMPILES_EXPANDED -	If 1 this command has a compiler that
+ * CMD_COMPILES_EXPANDED -	1 means that this command has a compiler that
  *				can handle expansion (provided it is not the
  *				first word).
  * TCL_TRACE_RENAME -		A rename trace is in progress. Further
@@ -1712,7 +1712,7 @@ typedef struct Command {
  * (these last two flags are defined in tcl.h)
  */
 
-#define CMD_DYING		    0x01
+#define CMD_IS_DELETED		    0x01
 #define CMD_TRACE_ACTIVE	    0x02
 #define CMD_HAS_EXEC_TRACES	    0x04
 #define CMD_COMPILES_EXPANDED	    0x08
@@ -4910,30 +4910,10 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
  * the internal stubs, but the core can use the macro instead.
  */
 
-#define TclCleanupCommandMacro(cmdPtr)		\
-    do {					\
-	if ((cmdPtr)->refCount-- <= 1) {	\
-	    Tcl_Free(cmdPtr);			\
-	}					\
-    } while (0)
-
-
-/*
- * inside this routine increment refCount first incase cmdPtr is replacing itself
- */
-#define TclRoutineAssign(location, cmdPtr)	    \
-    do {					    \
-	(cmdPtr)->refCount++;			    \
-	if ((location) != NULL			    \
-	    && (location--) <= 1) {		    \
-	    Tcl_Free(((location)));		    \
-	}					    \
-	(location) = (cmdPtr);			    \
-    } while (0)
-    
-
-#define TclRoutineHasName(cmdPtr) \
-    ((cmdPtr)->hPtr != NULL)
+#define TclCleanupCommandMacro(cmdPtr) \
+    if ((cmdPtr)->refCount-- <= 1) { \
+	ckfree(cmdPtr);\
+    }
 
 /*
  *----------------------------------------------------------------
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 8770105..86823c4 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1771,8 +1771,6 @@ DoImport(
 		TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
 		DeleteImportedCmd);
 	dataPtr->realCmdPtr = cmdPtr;
-	/* corresponding decrement is in DeleteImportedCmd */ 
-	cmdPtr->refCount++;
 	dataPtr->selfPtr = (Command *) importedCmd;
 	dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
 	Tcl_DStringFree(&ds);
@@ -2080,7 +2078,6 @@ DeleteImportedCmd(
 		prevPtr->nextPtr = refPtr->nextPtr;
 	    }
 	    Tcl_Free(refPtr);
-	    TclCleanupCommandMacro(realCmdPtr);
 	    Tcl_Free(dataPtr);
 	    return;
 	}
@@ -3892,7 +3889,7 @@ NamespaceOriginCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Tcl_Command cmd, origCmd;
+    Tcl_Command command, origCommand;
     Tcl_Obj *resultPtr;
 
     if (objc != 2) {
@@ -3900,29 +3897,30 @@ NamespaceOriginCmd(
 	return TCL_ERROR;
     }
 
-    cmd = Tcl_GetCommandFromObj(interp, objv[1]);
-    if (cmd == NULL) {
-	goto namespaceOriginError;
-    }
-    origCmd = TclGetOriginalCommand(cmd);
-    if (origCmd == NULL) {
-	origCmd = cmd;
-    } 
-    TclNewObj(resultPtr);
-    Tcl_GetCommandFullName(interp, origCmd, resultPtr);
-    if (TclCheckEmptyString(resultPtr) == TCL_EMPTYSTRING_YES ) {
-	Tcl_DecrRefCount(resultPtr);
-	namespaceOriginError:
+    command = Tcl_GetCommandFromObj(interp, objv[1]);
+    if (command == NULL) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                 "invalid command name \"%s\"", TclGetString(objv[1])));
 	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
 		TclGetString(objv[1]), NULL);
 	return TCL_ERROR;
     }
+    origCommand = TclGetOriginalCommand(command);
+    TclNewObj(resultPtr);
+    if (origCommand == NULL) {
+	/*
+	 * The specified command isn't an imported command. Return the
+	 * command's name qualified by the full name of the namespace it was
+	 * defined in.
+	 */
+
+	Tcl_GetCommandFullName(interp, command, resultPtr);
+    } else {
+	Tcl_GetCommandFullName(interp, origCommand, resultPtr);
+    }
     Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
-
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 5b685bc..bc8303c 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1177,7 +1177,7 @@ ObjectNamespaceDeleted(
      * freed memory.
      */
 
-    if (((Command *) oPtr->command)->flags && CMD_DYING) {
+    if (((Command *) oPtr->command)->flags && CMD_IS_DELETED) {
 	/*
 	 * Something has already started the command deletion process. We can
 	 * go ahead and clean up the the namespace,
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 6f4e9e8..c9d0e03 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -4223,7 +4223,7 @@ SetCmdNameFromAny(
      * report the failure to find the command as an error.
      */
 
-    if (cmdPtr == NULL || !TclRoutineHasName(cmdPtr)) {
+    if (cmdPtr == NULL) {
 	return TCL_ERROR;
     }