Index: generic/tclResult.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclResult.c,v
retrieving revision 1.12
diff -u -u -r1.12 tclResult.c
--- generic/tclResult.c	5 Oct 2004 18:14:28 -0000	1.12
+++ generic/tclResult.c	5 Oct 2004 22:12:58 -0000
@@ -4,6 +4,7 @@
  *	This file contains code to manage the interpreter result.
  *
  * Copyright (c) 1997 by Sun Microsystems, Inc.
+ * Copyright (c) 2004 by Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -18,8 +19,6 @@
  */
 
 static void             ResetObjResult _ANSI_ARGS_((Interp *iPtr));
-static void		SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
-			    int newSpace));
 
 
 /*
@@ -64,42 +63,22 @@
     Tcl_IncrRefCount(iPtr->objResultPtr); 
 
     /*
-     * Save the string result. 
+     * Save the string result of the interpreter.
      */
 
-    statePtr->freeProc = iPtr->freeProc;
-    if (iPtr->result == iPtr->resultSpace) {
-	/*
-	 * Copy the static string data out of the interp buffer.
-	 */
-
-	statePtr->result = statePtr->resultSpace;
-	strcpy(statePtr->result, iPtr->result);
-	statePtr->appendResult = NULL;
-    } else if (iPtr->result == iPtr->appendResult) {
-	/*
-	 * Move the append buffer out of the interp.
-	 */
+    statePtr->result = iPtr->result;
+    iPtr->result = NULL;
 
-	statePtr->appendResult = iPtr->appendResult;
-	statePtr->appendAvl = iPtr->appendAvl;
-	statePtr->appendUsed = iPtr->appendUsed;
-	statePtr->result = statePtr->appendResult;
-	iPtr->appendResult = NULL;
-	iPtr->appendAvl = 0;
-	iPtr->appendUsed = 0;
-    } else {
-	/*
-	 * Move the dynamic or static string out of the interpreter.
-	 */
+    /*
+     * Zero out some unused fields
+     */
 
-	statePtr->result = iPtr->result;
-	statePtr->appendResult = NULL;
-    }
+    statePtr->appendAvl = 0;
+    statePtr->appendUsed = 0;
+    statePtr->appendResult = NULL;
+    statePtr->freeProc = 0;
 
-    iPtr->result = iPtr->resultSpace;
-    iPtr->resultSpace[0] = 0;
-    iPtr->freeProc = 0;
+    (void) Tcl_GetStringResult(interp);
 }
 
 /*
@@ -130,44 +109,20 @@
     Tcl_ResetResult(interp);
 
     /*
-     * Restore the string result.
+     * Restore the object result.
      */
 
-    iPtr->freeProc = statePtr->freeProc;
-    if (statePtr->result == statePtr->resultSpace) {
-	/*
-	 * Copy the static string data into the interp buffer.
-	 */
-
-	iPtr->result = iPtr->resultSpace;
-	strcpy(iPtr->result, statePtr->result);
-    } else if (statePtr->result == statePtr->appendResult) {
-	/*
-	 * Move the append buffer back into the interp.
-	 */
-
-	if (iPtr->appendResult != NULL) {
-	    ckfree((char *)iPtr->appendResult);
-	}
-
-	iPtr->appendResult = statePtr->appendResult;
-	iPtr->appendAvl = statePtr->appendAvl;
-	iPtr->appendUsed = statePtr->appendUsed;
-	iPtr->result = iPtr->appendResult;
-    } else {
-	/*
-	 * Move the dynamic or static string back into the interpreter.
-	 */
-
-	iPtr->result = statePtr->result;
-    }
+    Tcl_DecrRefCount(iPtr->objResultPtr);
+    iPtr->objResultPtr = statePtr->objResultPtr;
 
     /*
-     * Restore the object result.
+     * Recreate the string result if necessary.
      */
 
-    Tcl_DecrRefCount(iPtr->objResultPtr);
-    iPtr->objResultPtr = statePtr->objResultPtr;
+    iPtr->result = NULL;
+    if (statePtr->result != NULL) {
+	(void) Tcl_GetStringResult(interp);
+    }
 }
 
 /*
@@ -194,16 +149,6 @@
     Tcl_SavedResult *statePtr;	/* State returned by Tcl_SaveResult. */
 {
     TclDecrRefCount(statePtr->objResultPtr);
-
-    if (statePtr->result == statePtr->appendResult) {
-	ckfree(statePtr->appendResult);
-    } else if (statePtr->freeProc) {
-	if (statePtr->freeProc == TCL_DYNAMIC) {
-	    ckfree(statePtr->result);
-	} else {
-	    (*statePtr->freeProc)(statePtr->result);
-	}
-    }
 }
 
 /*
@@ -217,8 +162,8 @@
  *	None.
  *
  * Side effects:
- *	interp->result is left pointing either to "string" (if "copy" is 0)
- *	or to a copy of string. Also, the object result is reset.
+ *	The string is copied into an object and (if it was allocated)
+ *	immediately freed.
  *
  *----------------------------------------------------------------------
  */
@@ -234,48 +179,23 @@
 				 * of a Tcl_FreeProc such as free. */
 {
     Interp *iPtr = (Interp *) interp;
-    int length;
-    register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
-    char *oldResult = iPtr->result;
 
     if (string == NULL) {
-	iPtr->resultSpace[0] = 0;
-	iPtr->result = iPtr->resultSpace;
-	iPtr->freeProc = 0;
-    } else if (freeProc == TCL_VOLATILE) {
-	length = strlen(string);
-	if (length > TCL_RESULT_SIZE) {
-	    iPtr->result = (char *) ckalloc((unsigned) length+1);
-	    iPtr->freeProc = TCL_DYNAMIC;
-	} else {
-	    iPtr->result = iPtr->resultSpace;
-	    iPtr->freeProc = 0;
-	}
-	strcpy(iPtr->result, string);
+	Tcl_SetObjResult(interp, Tcl_NewObj());
     } else {
-	iPtr->result = string;
-	iPtr->freeProc = freeProc;
-    }
-
-    /*
-     * If the old result was dynamically-allocated, free it up.  Do it
-     * here, rather than at the beginning, in case the new result value
-     * was part of the old result value.
-     */
-
-    if (oldFreeProc != 0) {
-	if (oldFreeProc == TCL_DYNAMIC) {
-	    ckfree(oldResult);
-	} else {
-	    (*oldFreeProc)(oldResult);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(string, -1));
+	if (freeProc == TCL_DYNAMIC) {
+	    ckfree(string);
+	} else if (freeProc != TCL_STATIC && freeProc != TCL_VOLATILE) {
+	    (*freeProc)(string);
 	}
     }
 
     /*
-     * Reset the object result since we just set the string result.
+     * Leave the result/freeProc with believable values...
      */
 
-    ResetObjResult(iPtr);
+    (void) Tcl_GetStringResult(interp);
 }
 
 /*
@@ -299,16 +219,15 @@
 Tcl_GetStringResult(interp)
      register Tcl_Interp *interp; /* Interpreter whose result to return. */
 {
+    Interp *iPtr = (Interp *) interp;
+
     /*
-     * If the string result is empty, move the object result to the
-     * string result, then reset the object result.
+     * Might as well do this every time; the object does the real caching.
      */
-    
-    if (*(interp->result) == 0) {
-	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	        TCL_VOLATILE);
-    }
-    return interp->result;
+
+    iPtr->result = TclGetString(Tcl_GetObjResult(interp));
+    iPtr->freeProc = 0;
+    return iPtr->result;
 }
 
 /*
@@ -352,20 +271,8 @@
     
     TclDecrRefCount(oldObjResult);
 
-    /*
-     * Reset the string result since we just set the result object.
-     */
-
-    if (iPtr->freeProc != NULL) {
-	if (iPtr->freeProc == TCL_DYNAMIC) {
-	    ckfree(iPtr->result);
-	} else {
-	    (*iPtr->freeProc)(iPtr->result);
-	}
-	iPtr->freeProc = 0;
-    }
-    iPtr->result = iPtr->resultSpace;
-    iPtr->resultSpace[0] = 0;
+    iPtr->result = NULL;
+    iPtr->freeProc = 0;
 }
 
 /*
@@ -381,10 +288,7 @@
  *	The interpreter's result as an object.
  *
  * Side effects:
- *	If the interpreter has a non-empty string result, the result object
- *	is either empty or stale because some procedure set interp->result
- *	directly. If so, the string result is moved to the result object
- *	then the string result is reset.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
@@ -394,32 +298,6 @@
     Tcl_Interp *interp;		/* Interpreter whose result to return. */
 {
     register Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *objResultPtr;
-    int length;
-
-    /*
-     * If the string result is non-empty, move the string result to the
-     * object result, then reset the string result.
-     */
-    
-    if (*(iPtr->result) != 0) {
-	ResetObjResult(iPtr);
-	
-	objResultPtr = iPtr->objResultPtr;
-	length = strlen(iPtr->result);
-	TclInitStringRep(objResultPtr, iPtr->result, length);
-	
-	if (iPtr->freeProc != NULL) {
-	    if (iPtr->freeProc == TCL_DYNAMIC) {
-		ckfree(iPtr->result);
-	    } else {
-		(*iPtr->freeProc)(iPtr->result);
-	    }
-	    iPtr->freeProc = 0;
-	}
-	iPtr->result = iPtr->resultSpace;
-	iPtr->resultSpace[0] = 0;
-    }
     return iPtr->objResultPtr;
 }
 
@@ -451,87 +329,19 @@
 				 * return value. */
     va_list argList;		/* Variable argument list. */
 {
-#define STATIC_LIST_SIZE 16
     Interp *iPtr = (Interp *) interp;
-    char *string, *static_list[STATIC_LIST_SIZE];
-    char **args = static_list;
-    int nargs_space = STATIC_LIST_SIZE;
-    int nargs, newSpace, i;
-
-    /*
-     * If the string result is empty, move the object result to the
-     * string result, then reset the object result.
-     */
-
-    if (*(iPtr->result) == 0) {
-	Tcl_SetResult((Tcl_Interp *) iPtr,
-	        TclGetString(Tcl_GetObjResult((Tcl_Interp *) iPtr)),
-	        TCL_VOLATILE);
+    if (Tcl_IsShared(iPtr->objResultPtr)) {
+	Tcl_DecrRefCount(iPtr->objResultPtr);
+	iPtr->objResultPtr = Tcl_DuplicateObj(iPtr->objResultPtr);
     }
-    
-    /*
-     * Scan through all the arguments to see how much space is needed
-     * and save pointers to the arguments in the args array,
-     * reallocating as necessary.
-     */
-
-    nargs = 0;
-    newSpace = 0;
     while (1) {
- 	string = va_arg(argList, char *);
-	if (string == NULL) {
+	char *stringPtr = va_arg(argList, char *);
+	if (stringPtr == NULL) {
 	    break;
 	}
- 	if (nargs >= nargs_space) {
- 	    /* 
- 	     * Expand the args buffer
- 	     */
- 	    nargs_space += STATIC_LIST_SIZE;
- 	    if (args == static_list) {
- 	    	args = (void *)ckalloc(nargs_space * sizeof(char *));
- 		for (i = 0; i < nargs; ++i) {
- 		    args[i] = static_list[i];
- 		}
- 	    } else {
- 		args = (void *)ckrealloc((void *)args,
-			nargs_space * sizeof(char *));
- 	    }
- 	}
-  	newSpace += strlen(string);
-	args[nargs++] = string;
+	Tcl_AppendToObj(iPtr->objResultPtr, stringPtr, -1);
     }
-
-    /*
-     * If the append buffer isn't already setup and large enough to hold
-     * the new data, set it up.
-     */
-
-    if ((iPtr->result != iPtr->appendResult)
-	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
-	    || ((newSpace + iPtr->appendUsed) >= iPtr->appendAvl)) {
-       SetupAppendBuffer(iPtr, newSpace);
-    }
-
-    /*
-     * Now go through all the argument strings again, copying them into the
-     * buffer.
-     */
-
-    for (i = 0; i < nargs; ++i) {
- 	string = args[i];
-  	strcpy(iPtr->appendResult + iPtr->appendUsed, string);
-  	iPtr->appendUsed += strlen(string);
-    }
- 
-    /*
-     * If we had to allocate a buffer from the heap, 
-     * free it now.
-     */
- 
-    if (args != static_list) {
-     	ckfree((void *)args);
-    }
-#undef STATIC_LIST_SIZE
+    (void) Tcl_GetStringResult(interp);
 }
 
 /*
@@ -599,129 +409,50 @@
 {
     Interp *iPtr = (Interp *) interp;
     char *dst;
-    int size;
-    int flags;
-
-    /*
-     * If the string result is empty, move the object result to the
-     * string result, then reset the object result.
-     */
+    int size, length, flags;
+    Tcl_Obj *objPtr = iPtr->objResultPtr;
 
-    if (*(iPtr->result) == 0) {
-	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-	        TCL_VOLATILE);
+    if (Tcl_IsShared(objPtr)) {
+	Tcl_DecrRefCount(objPtr);
+	iPtr->objResultPtr = objPtr = Tcl_DuplicateObj(objPtr);
     }
 
     /*
-     * See how much space is needed, and grow the append buffer if
-     * needed to accommodate the list element.
+     * See how much space is needed and how much space we've got in
+     * the result object.
      */
 
-    size = Tcl_ScanElement(string, &flags) + 1;
-    if ((iPtr->result != iPtr->appendResult)
-	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
-	    || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
-       SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
-    }
+    size = Tcl_ScanElement(string, &flags);
+    dst = Tcl_GetStringFromObj(objPtr, &length);
 
     /*
      * Convert the string into a list element and copy it to the
      * buffer that's forming, with a space separator if needed.
      */
 
-    dst = iPtr->appendResult + iPtr->appendUsed;
-    if (TclNeedSpace(iPtr->appendResult, dst)) {
-	iPtr->appendUsed++;
-	*dst = ' ';
-	dst++;
+    if (TclNeedSpace(dst, dst+length)) {
+	Tcl_SetObjLength(objPtr, length+size+1);
+	dst = Tcl_GetString(objPtr)+length;
+	*(dst++) = ' ';
 	/*
 	 * If we need a space to separate this element from preceding
 	 * stuff, then this element will not lead a list, and need not
 	 * have it's leading '#' quoted.
 	 */
 	flags |= TCL_DONT_QUOTE_HASH;
+    } else {
+	Tcl_SetObjLength(objPtr, length+size);
+	dst = Tcl_GetString(objPtr)+length;
     }
-    iPtr->appendUsed += Tcl_ConvertElement(string, dst, flags);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * SetupAppendBuffer --
- *
- *	This procedure makes sure that there is an append buffer properly
- *	initialized, if necessary, from the interpreter's result, and
- *	that it has at least enough room to accommodate newSpace new
- *	bytes of information.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SetupAppendBuffer(iPtr, newSpace)
-    Interp *iPtr;		/* Interpreter whose result is being set up. */
-    int newSpace;		/* Make sure that at least this many bytes
-				 * of new information may be added. */
-{
-    int totalSpace;
-
     /*
-     * Make the append buffer larger, if that's necessary, then copy the
-     * result into the append buffer and make the append buffer the official
-     * Tcl result.
+     * Write the string directly into the object!
      */
+    Tcl_ConvertElement(string, dst, flags);
 
-    if (iPtr->result != iPtr->appendResult) {
-	/*
-	 * If an oversized buffer was used recently, then free it up
-	 * so we go back to a smaller buffer.  This avoids tying up
-	 * memory forever after a large operation.
-	 */
-
-	if (iPtr->appendAvl > 500) {
-	    ckfree(iPtr->appendResult);
-	    iPtr->appendResult = NULL;
-	    iPtr->appendAvl = 0;
-	}
-	iPtr->appendUsed = strlen(iPtr->result);
-    } else if (iPtr->result[iPtr->appendUsed] != 0) {
-	/*
-	 * Most likely someone has modified a result created by
-	 * Tcl_AppendResult et al. so that it has a different size.
-	 * Just recompute the size.
-	 */
-
-	iPtr->appendUsed = strlen(iPtr->result);
-    }
-    
-    totalSpace = newSpace + iPtr->appendUsed;
-    if (totalSpace >= iPtr->appendAvl) {
-	char *new;
-
-	if (totalSpace < 100) {
-	    totalSpace = 200;
-	} else {
-	    totalSpace *= 2;
-	}
-	new = (char *) ckalloc((unsigned) totalSpace);
-	strcpy(new, iPtr->result);
-	if (iPtr->appendResult != NULL) {
-	    ckfree(iPtr->appendResult);
-	}
-	iPtr->appendResult = new;
-	iPtr->appendAvl = totalSpace;
-    } else if (iPtr->result != iPtr->appendResult) {
-	strcpy(iPtr->appendResult, iPtr->result);
-    }
-    
-    Tcl_FreeResult((Tcl_Interp *) iPtr);
-    iPtr->result = iPtr->appendResult;
+    /*
+     * Ensure that interp->result looks kosher
+     */
+    (void) Tcl_GetStringResult(interp);
 }
 
 /*
@@ -751,17 +482,8 @@
     register Tcl_Interp *interp; /* Interpreter for which to free result. */
 {
     register Interp *iPtr = (Interp *) interp;
-    
-    if (iPtr->freeProc != NULL) {
-	if (iPtr->freeProc == TCL_DYNAMIC) {
-	    ckfree(iPtr->result);
-	} else {
-	    (*iPtr->freeProc)(iPtr->result);
-	}
-	iPtr->freeProc = 0;
-    }
-    
     ResetObjResult(iPtr);
+    iPtr->freeProc = 0;
 }
 
 /*
@@ -791,16 +513,7 @@
     register Interp *iPtr = (Interp *) interp;
 
     ResetObjResult(iPtr);
-    if (iPtr->freeProc != NULL) {
-	if (iPtr->freeProc == TCL_DYNAMIC) {
-	    ckfree(iPtr->result);
-	} else {
-	    (*iPtr->freeProc)(iPtr->result);
-	}
-	iPtr->freeProc = 0;
-    }
-    iPtr->result = iPtr->resultSpace;
-    iPtr->resultSpace[0] = 0;
+    (void) Tcl_GetStringResult(interp);
     if (iPtr->errorCode) {
 	Tcl_ObjSetVar2(interp, iPtr->execEnvPtr->errorCode, NULL,
 		iPtr->errorCode, TCL_GLOBAL_ONLY);
