Attachment "result.diff" to
ticket [1041060fff]
added by
dkf
2004-10-06 05:19:53.
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);
