merged tcl 8.1 branch back into the main trunk

1 files changed, 212 insertions, 154 deletions

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 25b563b..6db0c53 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -14,12 +14,13 @@
  * 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.11 1999/02/03 00:55:04 stanton Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.12 1999/04/16 00:46:43 stanton Exp $
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 #include "tclCompile.h"
+#include "tclRegexp.h"
 
 /*
  * During execution of the "lsort" command, structures of the following
@@ -45,7 +46,7 @@ typedef struct SortInfo {
     int isIncreasing;		/* Nonzero means sort in increasing order. */
     int sortMode;		/* The sort mode.  One of SORTMODE_*
 				 * values defined below */
-    Tcl_DString compareCmd;	/* The Tcl comparison command when sortMode
+    Tcl_Obj *compareCmdPtr;     /* The Tcl comparison command when sortMode
 				 * is SORTMODE_COMMAND.  Pre-initialized to
 				 * hold base of command.*/
     int index;			/* If the -index option was specified, this
@@ -149,7 +150,7 @@ static int		SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_IfCmd --
+ * Tcl_IfObjCmd --
  *
  *	This procedure is invoked to process the "if" Tcl command.
  *	See the user documentation for details on what it does.
@@ -169,44 +170,55 @@ static int		SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
 
 	/* ARGSUSED */
 int
-Tcl_IfCmd(dummy, interp, argc, argv)
+Tcl_IfObjCmd(dummy, interp, objc, objv)
     ClientData dummy;			/* Not used. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
 {
+    int thenScriptIndex = 0;	/* then script to be evaled after syntax check */
     int i, result, value;
-
+    char *clause;
     i = 1;
     while (1) {
 	/*
-	 * At this point in the loop, argv and argc refer to an expression
+	 * At this point in the loop, objv and objc refer to an expression
 	 * to test, either for the main expression or an expression
 	 * following an "elseif".  The arguments after the expression must
 	 * be "then" (optional) and a script to execute if the expression is
 	 * true.
 	 */
 
-	if (i >= argc) {
+	if (i >= objc) {
+	    clause = Tcl_GetString(objv[i-1]);
 	    Tcl_AppendResult(interp, "wrong # args: no expression after \"",
-		    argv[i-1], "\" argument", (char *) NULL);
+		    clause, "\" argument", (char *) NULL);
 	    return TCL_ERROR;
 	}
-	result = Tcl_ExprBoolean(interp, argv[i], &value);
-	if (result != TCL_OK) {
-	    return result;
+	if (!thenScriptIndex) {
+	    result = Tcl_ExprBooleanObj(interp, objv[i], &value);
+	    if (result != TCL_OK) {
+		return result;
+	    }
 	}
 	i++;
-	if ((i < argc) && (strcmp(argv[i], "then") == 0)) {
-	    i++;
-	}
-	if (i >= argc) {
+	if (i >= objc) {
+	    missingScript:
+	    clause = Tcl_GetString(objv[i-1]);
 	    Tcl_AppendResult(interp, "wrong # args: no script following \"",
-		    argv[i-1], "\" argument", (char *) NULL);
+		    clause, "\" argument", (char *) NULL);
 	    return TCL_ERROR;
 	}
+	clause = Tcl_GetString(objv[i]);
+	if ((i < objc) && (strcmp(clause, "then") == 0)) {
+	    i++;
+	}
+	if (i >= objc) {
+	    goto missingScript;
+	}
 	if (value) {
-	    return Tcl_Eval(interp, argv[i]);
+	    thenScriptIndex = i;
+	    value = 0;
 	}
 	
 	/*
@@ -215,10 +227,14 @@ Tcl_IfCmd(dummy, interp, argc, argv)
 	 */
 
 	i++;
-	if (i >= argc) {
+	if (i >= objc) {
+	    if (thenScriptIndex) {
+		return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+	    }
 	    return TCL_OK;
 	}
-	if ((argv[i][0] == 'e') && (strcmp(argv[i], "elseif") == 0)) {
+	clause = Tcl_GetString(objv[i]);
+	if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {
 	    i++;
 	    continue;
 	}
@@ -231,22 +247,31 @@ Tcl_IfCmd(dummy, interp, argc, argv)
      * argument when we get here.
      */
 
-    if (strcmp(argv[i], "else") == 0) {
+    if (strcmp(clause, "else") == 0) {
 	i++;
-	if (i >= argc) {
+	if (i >= objc) {
 	    Tcl_AppendResult(interp,
 		    "wrong # args: no script following \"else\" argument",
 		    (char *) NULL);
 	    return TCL_ERROR;
 	}
     }
-    return Tcl_Eval(interp, argv[i]);
+    if (i < objc - 1) {
+	Tcl_AppendResult(interp,
+		"wrong # args: extra words after \"else\" clause in \"if\" command",
+		(char *) NULL);
+	return TCL_ERROR;
+    }
+    if (thenScriptIndex) {
+	return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+    }
+    return Tcl_EvalObjEx(interp, objv[i], 0);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_IncrCmd --
+ * Tcl_IncrObjCmd --
  *
  *	This procedure is invoked to process the "incr" Tcl command.
  *	See the user documentation for details on what it does.
@@ -266,54 +291,49 @@ Tcl_IfCmd(dummy, interp, argc, argv)
 
     /* ARGSUSED */
 int
-Tcl_IncrCmd(dummy, interp, argc, argv)
+Tcl_IncrObjCmd(dummy, interp, objc, objv)
     ClientData dummy;			/* Not used. */
     Tcl_Interp *interp;			/* Current interpreter. */
-    int argc;				/* Number of arguments. */
-    char **argv;			/* Argument strings. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
 {
-    int value;
-    char *oldString, *result;
-    char newString[30];
-
-    if ((argc != 2) && (argc != 3)) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" varName ?increment?\"", (char *) NULL);
+    long incrAmount;
+    Tcl_Obj *newValuePtr;
+    
+    if ((objc != 2) && (objc != 3)) {
+        Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
 	return TCL_ERROR;
     }
 
-    oldString = Tcl_GetVar(interp, argv[1], TCL_LEAVE_ERR_MSG);
-    if (oldString == NULL) {
-	return TCL_ERROR;
-    }
-    if (Tcl_GetInt(interp, oldString, &value) != TCL_OK) {
-	Tcl_AddErrorInfo(interp,
-		"\n    (reading value of variable to increment)");
-	return TCL_ERROR;
-    }
-    if (argc == 2) {
-	value += 1;
+    /*
+     * Calculate the amount to increment by.
+     */
+    
+    if (objc == 2) {
+	incrAmount = 1;
     } else {
-	int increment;
-
-	if (Tcl_GetInt(interp, argv[2], &increment) != TCL_OK) {
-	    Tcl_AddErrorInfo(interp,
-		    "\n    (reading increment)");
+	if (Tcl_GetLongFromObj(interp, objv[2], &incrAmount) != TCL_OK) {
+	    Tcl_AddErrorInfo(interp, "\n    (reading increment)");
 	    return TCL_ERROR;
 	}
-	value += increment;
     }
-    TclFormatInt(newString, value);
-    result = Tcl_SetVar(interp, argv[1], newString, TCL_LEAVE_ERR_MSG);
-    if (result == NULL) {
+    
+    /*
+     * Increment the variable's value.
+     */
+
+    newValuePtr = TclIncrVar2(interp, objv[1], (Tcl_Obj *) NULL, incrAmount,
+	    TCL_LEAVE_ERR_MSG);
+    if (newValuePtr == NULL) {
 	return TCL_ERROR;
     }
 
     /*
-     * Copy the result since the variable's value might change.
+     * Set the interpreter's object result to refer to the variable's new
+     * value object.
      */
-    
-    Tcl_SetResult(interp, result, TCL_VOLATILE);
+
+    Tcl_SetObjResult(interp, newValuePtr);
     return TCL_OK; 
 }
 
@@ -355,8 +375,8 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
 	    IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,
 	    ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,
 	    IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx
-    } index;
-    int result;
+    };
+    int index, result;
 
     if (objc < 2) {
         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
@@ -472,7 +492,7 @@ InfoArgsCmd(dummy, interp, objc, objv)
         return TCL_ERROR;
     }
 
-    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    name = Tcl_GetString(objv[2]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -533,7 +553,7 @@ InfoBodyCmd(dummy, interp, objc, objv)
         return TCL_ERROR;
     }
 
-    name = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    name = Tcl_GetString(objv[2]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -664,8 +684,9 @@ InfoCommandsCmd(dummy, interp, objc, objv)
 
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
 	
-        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
-       TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+
+	pattern = Tcl_GetString(objv[2]);
+	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
            /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
 
 	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
@@ -812,8 +833,8 @@ InfoDefaultCmd(dummy, interp, objc, objv)
         return TCL_ERROR;
     }
 
-    procName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
-    argName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+    procName = Tcl_GetString(objv[2]);
+    argName = Tcl_GetString(objv[3]);
 
     procPtr = TclFindProc(iPtr, procName);
     if (procPtr == NULL) {
@@ -828,10 +849,10 @@ InfoDefaultCmd(dummy, interp, objc, objv)
 		&& (strcmp(argName, localPtr->name) == 0)) {
             if (localPtr->defValuePtr != NULL) {
 		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
-                        localPtr->defValuePtr, 0);
+			localPtr->defValuePtr, 0);
                 if (valueObjPtr == NULL) {
                     defStoreError:
-		    varName = Tcl_GetStringFromObj(objv[4], (int *) NULL);
+		    varName = Tcl_GetString(objv[4]);
 		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 	                    "couldn't store default value in variable \"",
 			    varName, "\"", (char *) NULL);
@@ -841,7 +862,7 @@ InfoDefaultCmd(dummy, interp, objc, objv)
             } else {
                 Tcl_Obj *nullObjPtr = Tcl_NewObj();
                 valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,
-                    nullObjPtr, 0);
+			nullObjPtr, 0);
                 if (valueObjPtr == NULL) {
                     Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
                     goto defStoreError;
@@ -893,9 +914,9 @@ InfoExistsCmd(dummy, interp, objc, objv)
         return TCL_ERROR;
     }
 
-    varName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+    varName = Tcl_GetString(objv[2]);
     varPtr = TclLookupVar(interp, varName, (char *) NULL,
-            TCL_PARSE_PART1, "access",
+            0, "access",
             /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
     if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
         Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
@@ -943,7 +964,7 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
     if (objc == 2) {
         pattern = NULL;
     } else if (objc == 3) {
-        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+        pattern = Tcl_GetString(objv[2]);
     } else {
         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
         return TCL_ERROR;
@@ -1064,7 +1085,7 @@ InfoLevelCmd(dummy, interp, objc, objv)
                 levelError:
 		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 			"bad level \"",
-			Tcl_GetStringFromObj(objv[2], (int *) NULL),
+			Tcl_GetString(objv[2]),
 			"\"", (char *) NULL);
                 return TCL_ERROR;
             }
@@ -1173,7 +1194,7 @@ InfoLoadedCmd(dummy, interp, objc, objv)
     if (objc == 2) {		/* get loaded pkgs in all interpreters */
 	interpName = NULL;
     } else {			/* get pkgs just in specified interp */
-	interpName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+	interpName = Tcl_GetString(objv[2]);
     }
     result = TclGetLoadedPackages(interp, interpName);
     return result;
@@ -1214,7 +1235,7 @@ InfoLocalsCmd(dummy, interp, objc, objv)
     if (objc == 2) {
         pattern = NULL;
     } else if (objc == 3) {
-        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+        pattern = Tcl_GetString(objv[2]);
     } else {
         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
         return TCL_ERROR;
@@ -1427,13 +1448,13 @@ InfoProcsCmd(dummy, interp, objc, objv)
     Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
     register Tcl_HashEntry *entryPtr;
     Tcl_HashSearch search;
-    Command *cmdPtr;
+    Command *cmdPtr, *realCmdPtr;
     Tcl_Obj *listPtr;
 
     if (objc == 2) {
         pattern = NULL;
     } else if (objc == 3) {
-        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+        pattern = Tcl_GetString(objv[2]);
     } else {
         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
         return TCL_ERROR;
@@ -1450,7 +1471,17 @@ InfoProcsCmd(dummy, interp, objc, objv)
             entryPtr = Tcl_NextHashEntry(&search)) {
         cmdName = Tcl_GetHashKey(&currNsPtr->cmdTable, entryPtr);
         cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
-        if (TclIsProc(cmdPtr)) {
+
+	/*
+	 * If the command isn't itself a proc, it still might be an
+	 * imported command that points to a "real" proc in a different
+	 * namespace.
+	 */
+
+	realCmdPtr = (Command *) TclGetOriginalCommand(
+	        (Tcl_Command) cmdPtr);
+        if (TclIsProc(cmdPtr)
+	        || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) {
             if ((pattern == NULL) || Tcl_StringMatch(cmdName, pattern)) {
                 Tcl_ListObjAppendElement(interp, listPtr,
 		        Tcl_NewStringObj(cmdName, -1));
@@ -1646,9 +1677,10 @@ InfoVarsCmd(dummy, interp, objc, objv)
 
 	Namespace *dummy1NsPtr, *dummy2NsPtr;
 
-        pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
-       TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
-           /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+        pattern = Tcl_GetString(objv[2]);
+	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
+		&simplePattern);
 
 	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
@@ -1913,7 +1945,7 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
     Tcl_Obj *listPtr, *resultPtr;
     Tcl_ObjType *typePtr;
     int index, isDuplicate, len, result;
-
+   
     if (objc < 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
 	return TCL_ERROR;
@@ -2247,7 +2279,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
 	    && (strncmp(firstArg, "end", (unsigned) firstArgLen) != 0)) {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"list doesn't contain element ",
-		Tcl_GetStringFromObj(objv[2], (int *) NULL), (int *) NULL);
+		Tcl_GetString(objv[2]), (int *) NULL);
 	result = TCL_ERROR;
 	goto errorReturn;
     }
@@ -2303,19 +2335,20 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument values. */
 {
-#define EXACT	0
-#define GLOB	1
-#define REGEXP	2
     char *bytes, *patternBytes;
-    int i, match, mode, index, result, listLen, length, elemLen;
-    Tcl_Obj **elemPtrs;
-    static char *switches[] =
-	    {"-exact", "-glob", "-regexp", (char *) NULL};
-
-    mode = GLOB;
+    int i, match, mode, index, result, listc, length, elemLen;
+    Tcl_Obj *patObj, **listv;
+    static char *options[] = {
+	"-exact",	"-glob",	"-regexp",	NULL
+    };
+    enum options {
+	LSEARCH_EXACT,	LSEARCH_GLOB,	LSEARCH_REGEXP
+    };
+
+    mode = LSEARCH_GLOB;
     if (objc == 4) {
-	if (Tcl_GetIndexFromObj(interp, objv[1], switches,
-		"search mode", 0, &mode) != TCL_OK) {
+	if (Tcl_GetIndexFromObj(interp, objv[1], options, "search mode", 0,
+		&mode) != TCL_OK) {
 	    return TCL_ERROR;
 	}
     } else if (objc != 3) {
@@ -2328,46 +2361,43 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
      * a pointer to its array of element pointers.
      */
 
-    result = Tcl_ListObjGetElements(interp, objv[objc-2], &listLen, &elemPtrs);
+    result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv);
     if (result != TCL_OK) {
 	return result;
     }
 
-    patternBytes = Tcl_GetStringFromObj(objv[objc-1], &length);
- 
+    patObj = objv[objc - 1];
+    patternBytes = Tcl_GetStringFromObj(patObj, &length);
+
     index = -1;
-    for (i = 0; i < listLen; i++) {
+    for (i = 0; i < listc; i++) {
 	match = 0;
-	bytes = Tcl_GetStringFromObj(elemPtrs[i], &elemLen);
-	switch (mode) {
-	    case EXACT:
+	bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
+	switch ((enum options) mode) {
+	    case LSEARCH_EXACT: {
 		if (length == elemLen) {
 		    match = (memcmp(bytes, patternBytes,
 			    (size_t) length) == 0);
 		}
 		break;
-	    case GLOB:
-		/*
-		 * WARNING: will not work with data containing NULLs.
-		 */
+	    }
+	    case LSEARCH_GLOB: {
 		match = Tcl_StringMatch(bytes, patternBytes);
 		break;
-	    case REGEXP:
-		/*
-		 * WARNING: will not work with data containing NULLs.
-		 */
-		match = Tcl_RegExpMatch(interp, bytes, patternBytes);
+	    }
+	    case LSEARCH_REGEXP: {
+		match = TclRegExpMatchObj(interp, bytes, patObj);
 		if (match < 0) {
 		    return TCL_ERROR;
 		}
 		break;
+	    }
 	}
-	if (match) {
+	if (match != 0) {
 	    index = i;
 	    break;
 	}
     }
-
     Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
     return TCL_OK;
 }
@@ -2396,7 +2426,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument values. */
 {
-    int i, index, dummy;
+    int i, index;
     Tcl_Obj *resultPtr;
     int length;
     Tcl_Obj *cmdPtr, **listObjPtrs;
@@ -2477,9 +2507,21 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 	}
     }
     if (sortInfo.sortMode == SORTMODE_COMMAND) {
-	Tcl_DStringInit(&sortInfo.compareCmd);
-	Tcl_DStringAppend(&sortInfo.compareCmd,
-		Tcl_GetStringFromObj(cmdPtr, &dummy), -1);
+	/*
+	 * The existing command is a list. We want to flatten it, append
+	 * two dummy arguments on the end, and replace these arguments
+	 * later.
+	 */
+
+        Tcl_Obj *newCommandPtr = Tcl_DuplicateObj(cmdPtr);
+
+	if (Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj()) 
+	        != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
+	sortInfo.compareCmdPtr = newCommandPtr;
+	Tcl_IncrRefCount(newCommandPtr);
     }
 
     sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
@@ -2513,7 +2555,8 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 
     done:
     if (sortInfo.sortMode == SORTMODE_COMMAND) {
-	Tcl_DStringFree(&sortInfo.compareCmd);
+	Tcl_DecrRefCount(sortInfo.compareCmdPtr);
+	sortInfo.compareCmdPtr = NULL;
     }
     return sortInfo.resultCode;
 }
@@ -2666,9 +2709,9 @@ SortCompare(objPtr1, objPtr2, infoPtr)
     SortInfo *infoPtr;                  /* Information passed from the
                                          * top-level "lsort" command */
 {
-    int order, dummy, listLen, index;
+    int order, listLen, index;
     Tcl_Obj *objPtr;
-    char buffer[30];
+    char buffer[TCL_INTEGER_SPACE];
 
     order = 0;
     if (infoPtr->resultCode != TCL_OK) {
@@ -2705,11 +2748,10 @@ SortCompare(objPtr1, objPtr2, infoPtr)
 	if (objPtr == NULL) {
 	    objPtr = objPtr1;
 	    missingElement:
-	    sprintf(buffer, "%d", infoPtr->index);
+	    TclFormatInt(buffer, infoPtr->index);
 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
 			"element ", buffer, " missing from sublist \"",
-			Tcl_GetStringFromObj(objPtr, (int *) NULL),
-			"\"", (char *) NULL);
+			Tcl_GetString(objPtr), "\"", (char *) NULL);
 	    infoPtr->resultCode = TCL_ERROR;
 	    return order;
 	}
@@ -2737,12 +2779,10 @@ SortCompare(objPtr1, objPtr2, infoPtr)
 	objPtr2 = objPtr;
     }
     if (infoPtr->sortMode == SORTMODE_ASCII) {
-	order = strcmp(Tcl_GetStringFromObj(objPtr1, &dummy),
-		Tcl_GetStringFromObj(objPtr2, &dummy));
+	order = strcmp(Tcl_GetString(objPtr1), Tcl_GetString(objPtr2));
     } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
 	order = DictionaryCompare(
-		Tcl_GetStringFromObj(objPtr1, &dummy),
-		Tcl_GetStringFromObj(objPtr2, &dummy));
+		Tcl_GetString(objPtr1),	Tcl_GetString(objPtr2));
     } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
 	int a, b;
 
@@ -2772,22 +2812,26 @@ SortCompare(objPtr1, objPtr2, infoPtr)
 	    order = -1;
 	}
     } else {
-	int oldLength;
+	Tcl_Obj **objv, *paramObjv[2];
+	int objc;
 
-	/*
-	 * Generate and evaluate a command to determine which string comes
-	 * first.
+	paramObjv[0] = objPtr1;
+	paramObjv[1] = objPtr2;
+
+  	/*
+ 	 * We made space in the command list for the two things to
+	 * compare. Replace them and evaluate the result.
 	 */
 
-	oldLength = Tcl_DStringLength(&infoPtr->compareCmd);
-	Tcl_DStringAppendElement(&infoPtr->compareCmd,
-		Tcl_GetStringFromObj(objPtr1, &dummy));
-	Tcl_DStringAppendElement(&infoPtr->compareCmd,
-		Tcl_GetStringFromObj(objPtr2, &dummy));
-	infoPtr->resultCode = Tcl_Eval(infoPtr->interp, 
-		Tcl_DStringValue(&infoPtr->compareCmd));
-	Tcl_DStringTrunc(&infoPtr->compareCmd, oldLength);
-	if (infoPtr->resultCode != TCL_OK) {
+	Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
+	Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
+		2, 2, paramObjv);
+   	Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
+		&objc, &objv);
+
+	infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
+  
+  	if (infoPtr->resultCode != TCL_OK) {
 	    Tcl_AddErrorInfo(infoPtr->interp,
 		    "\n    (-compare command)");
 	    return order;
@@ -2840,11 +2884,13 @@ static int
 DictionaryCompare(left, right)
     char *left, *right;          /* The strings to compare */
 {
+    Tcl_UniChar uniLeft, uniRight;
     int diff, zeros;
     int secondaryDiff = 0;
 
     while (1) {
-	if (isdigit(UCHAR(*right)) && isdigit(UCHAR(*left))) {
+	if (isdigit(UCHAR(*right)) /* INTL: digit */
+		&& isdigit(UCHAR(*left))) { /* INTL: digit */
 	    /*
 	     * There are decimal numbers embedded in the two
 	     * strings.  Compare them as numbers, rather than
@@ -2880,8 +2926,8 @@ DictionaryCompare(left, right)
 		}
 		right++;
 		left++;
-		if (!isdigit(UCHAR(*right))) {
-		    if (isdigit(UCHAR(*left))) {
+		if (!isdigit(UCHAR(*right))) { /* INTL: digit */
+		    if (isdigit(UCHAR(*left))) { /* INTL: digit */
 			return 1;
 		    } else {
 			/*
@@ -2894,23 +2940,40 @@ DictionaryCompare(left, right)
 			}
 			break;
 		    }
-		} else if (!isdigit(UCHAR(*left))) {
+		} else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
 		    return -1;
 		}
 	    }
 	    continue;
 	}
-        diff = UCHAR(*left) - UCHAR(*right);
+
+	/*
+	 * Convert character to Unicode for comparison purposes.  If either
+	 * string is at the terminating null, do a byte-wise comparison and
+	 * bail out immediately.
+	 */
+
+	if ((*left != '\0') && (*right != '\0')) {
+	    left += Tcl_UtfToUniChar(left, &uniLeft);
+	    right += Tcl_UtfToUniChar(right, &uniRight);
+	} else {
+	    diff = UCHAR(*left) - UCHAR(*right);
+	    break;
+	}
+
+        diff = uniLeft - uniRight;
         if (diff) {
-            if (isupper(UCHAR(*left)) && islower(UCHAR(*right))) {
-                diff = UCHAR(tolower(*left)) - UCHAR(*right);
-                if (diff) {
+	    if (Tcl_UniCharIsUpper(uniLeft) &&
+		    Tcl_UniCharIsLower(uniRight)) {
+		diff = Tcl_UniCharToLower(uniLeft) - uniRight;
+		if (diff) {
 		    return diff;
                 } else if (secondaryDiff == 0) {
 		    secondaryDiff = -1;
                 }
-            } else if (isupper(UCHAR(*right)) && islower(UCHAR(*left))) {
-                diff = UCHAR(*left) - UCHAR(tolower(UCHAR(*right)));
+	    } else if (Tcl_UniCharIsUpper(uniRight)
+		    && Tcl_UniCharIsLower(uniLeft)) {
+                diff = uniLeft - Tcl_UniCharToLower(uniRight);
                 if (diff) {
 		    return diff;
                 } else if (secondaryDiff == 0) {
@@ -2920,11 +2983,6 @@ DictionaryCompare(left, right)
                 return diff;
             }
         }
-        if (*left == 0) {
-	    break;
-	}
-        left++;
-        right++;
     }
     if (diff == 0) {
 	diff = secondaryDiff;