/* 

  * tclResult.c --

  *

  *	This file contains code to manage the interpreter result.

  *

  * Copyright (c) 1997 by Sun Microsystems, Inc.

  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. 

  *

  * See the file "license.terms" for information on usage and redistribution

  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

  *

  * RCS: @(#) $Id: tclResult.c,v 1.5.2.2 2004/09/30 22:45:15 dgp Exp $

  */

 #include "tclInt.h"

 /*

  * Function prototypes for local procedures in this file:

  */

 static void             ResetObjResult _ANSI_ARGS_((Interp *iPtr));

 static void		SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,

 			    int newSpace));

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SaveResult --

  *

  *      Takes a snapshot of the current result state of the interpreter.

  *      The snapshot can be restored at any point by

  *      Tcl_RestoreResult. Note that this routine does not 

  *	preserve the errorCode, errorInfo, or flags fields so it

  *	should not be used if an error is in progress.

  *

  *      Once a snapshot is saved, it must be restored by calling

  *      Tcl_RestoreResult, or discarded by calling

  *      Tcl_DiscardResult.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Resets the interpreter result.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_SaveResult(interp, statePtr)

     Tcl_Interp *interp;		/* Interpreter to save. */

     Tcl_SavedResult *statePtr;	/* Pointer to state structure. */

 {

     Interp *iPtr = (Interp *) interp;

     /*

      * Move the result object into the save state.  Note that we don't need

      * to change its refcount because we're moving it, not adding a new

      * reference.  Put an empty object into the interpreter.

      */

     statePtr->objResultPtr = iPtr->objResultPtr;

     iPtr->objResultPtr = Tcl_NewObj(); 

     Tcl_IncrRefCount(iPtr->objResultPtr); 

     /*

      * Save the string result. 

      */

     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->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.

 	 */

 	statePtr->result = iPtr->result;

 	statePtr->appendResult = NULL;

     }

     iPtr->result = iPtr->resultSpace;

     iPtr->resultSpace[0] = 0;

     iPtr->freeProc = 0;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_RestoreResult --

  *

  *      Restores the state of the interpreter to a snapshot taken

  *      by Tcl_SaveResult.  After this call, the token for

  *      the interpreter state is no longer valid.

  *

  * Results:

  *      None.

  *

  * Side effects:

  *      Restores the interpreter result.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_RestoreResult(interp, statePtr)

     Tcl_Interp* interp;		/* Interpreter being restored. */

     Tcl_SavedResult *statePtr;	/* State returned by Tcl_SaveResult. */

 {

     Interp *iPtr = (Interp *) interp;

     Tcl_ResetResult(interp);

     /*

      * Restore the string 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;

     }

     /*

      * Restore the object result.

      */

     Tcl_DecrRefCount(iPtr->objResultPtr);

     iPtr->objResultPtr = statePtr->objResultPtr;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_DiscardResult --

  *

  *      Frees the memory associated with an interpreter snapshot

  *      taken by Tcl_SaveResult.  If the snapshot is not

  *      restored, this procedure must be called to discard it,

  *      or the memory will be lost.

  *

  * Results:

  *      None.

  *

  * Side effects:

  *      None.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_DiscardResult(statePtr)

     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);

 	}

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetResult --

  *

  *	Arrange for "string" to be the Tcl return value.

  *

  * Results:

  *	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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_SetResult(interp, string, freeProc)

     Tcl_Interp *interp;		/* Interpreter with which to associate the

 				 * return value. */

     register char *string;	/* Value to be returned.  If NULL, the

 				 * result is set to an empty string. */

     Tcl_FreeProc *freeProc;	/* Gives information about the string:

 				 * TCL_STATIC, TCL_VOLATILE, or the address

 				 * 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);

     } 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);

 	}

     }

     /*

      * Reset the object result since we just set the string result.

      */

     ResetObjResult(iPtr);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetStringResult --

  *

  *	Returns an interpreter's result value as a string.

  *

  * Results:

  *	The interpreter's result as a string.

  *

  * Side effects:

  *	If the string result is empty, the object result is moved to the

  *	string result, then the object result is reset.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C CONST char *

 Tcl_GetStringResult(interp)

      register Tcl_Interp *interp; /* Interpreter whose result to return. */

 {

     /*

      * If the string result is empty, move the object result to the

      * string result, then reset the object result.

      */

     if (*(interp->result) == 0) {

 	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),

 	        TCL_VOLATILE);

     }

     return interp->result;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetObjResult --

  *

  *	Arrange for objPtr to be an interpreter's result value.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	interp->objResultPtr is left pointing to the object referenced

  *	by objPtr. The object's reference count is incremented since

  *	there is now a new reference to it. The reference count for any

  *	old objResultPtr value is decremented. Also, the string result

  *	is reset.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_SetObjResult(interp, objPtr)

     Tcl_Interp *interp;		/* Interpreter with which to associate the

 				 * return object value. */

     register Tcl_Obj *objPtr;	/* Tcl object to be returned. If NULL, the

 				 * obj result is made an empty string

 				 * object. */

 {

     register Interp *iPtr = (Interp *) interp;

     register Tcl_Obj *oldObjResult = iPtr->objResultPtr;

     iPtr->objResultPtr = objPtr;

     Tcl_IncrRefCount(objPtr);	/* since interp result is a reference */

     /*

      * We wait until the end to release the old object result, in case

      * we are setting the result to itself.

      */

     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;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_GetObjResult --

  *

  *	Returns an interpreter's result value as a Tcl object. The object's

  *	reference count is not modified; the caller must do that if it

  *	needs to hold on to a long-term reference to it.

  *

  * Results:

  *	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.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C Tcl_Obj *

 Tcl_GetObjResult(interp)

     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;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_AppendResultVA --

  *

  *	Append a variable number of strings onto the interpreter's string

  *	result.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The result of the interpreter given by the first argument is

  *	extended by the strings in the va_list (up to a terminating NULL

  *	argument).

  *

  *	If the string result is empty, the object result is moved to the

  *	string result, then the object result is reset.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_AppendResultVA (interp, argList)

     Tcl_Interp *interp;		/* Interpreter with which to associate the

 				 * 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);

     }

     /*

      * 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) {

 	    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;

     }

     /*

      * 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

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_AppendResult --

  *

  *	Append a variable number of strings onto the interpreter's string

  *	result.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The result of the interpreter given by the first argument is

  *	extended by the strings given by the second and following arguments

  *	(up to a terminating NULL argument).

  *

  *	If the string result is empty, the object result is moved to the

  *	string result, then the object result is reset.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)

 {

     Tcl_Interp *interp;

     va_list argList;

     interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);

     Tcl_AppendResultVA(interp, argList);

     va_end(argList);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_AppendElement --

  *

  *	Convert a string to a valid Tcl list element and append it to the

  *	result (which is ostensibly a list).

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The result in the interpreter given by the first argument is

  *	extended with a list element converted from string. A separator

  *	space is added before the converted list element unless the current

  *	result is empty, contains the single character "{", or ends in " {".

  *

  *	If the string result is empty, the object result is moved to the

  *	string result, then the object result is reset.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_AppendElement(interp, string)

     Tcl_Interp *interp;		/* Interpreter whose result is to be

 				 * extended. */

     CONST char *string;		/* String to convert to list element and

 				 * add to result. */

 {

     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.

      */

     if (*(iPtr->result) == 0) {

 	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),

 	        TCL_VOLATILE);

     }

     /*

      * See how much space is needed, and grow the append buffer if

      * needed to accommodate the list element.

      */

     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);

     }

     /*

      * 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++;

     }

     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.

      */

     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;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_FreeResult --

  *

  *	This procedure frees up the memory associated with an interpreter's

  *	string result. It also resets the interpreter's result object.

  *	Tcl_FreeResult is most commonly used when a procedure is about to

  *	replace one result value with another.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Frees the memory associated with interp's string result and sets

  *	interp->freeProc to zero, but does not change interp->result or

  *	clear error state. Resets interp's result object to an unshared

  *	empty object.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_FreeResult(interp)

     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);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_ResetResult --

  *

  *	This procedure resets both the interpreter's string and object

  *	results.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	It resets the result object to an unshared empty object. It

  *	then restores the interpreter's string result area to its default

  *	initialized state, freeing up any memory that may have been

  *	allocated. It also clears any error information for the interpreter.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_ResetResult(interp)

     register Tcl_Interp *interp; /* Interpreter for which to clear result. */

 {

     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;

     iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);

 }

 /*

  *----------------------------------------------------------------------

  *

  * ResetObjResult --

  *

  *	Procedure used to reset an interpreter's Tcl result object.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Resets the interpreter's result object to an unshared empty string

  *	object with ref count one. It does not clear any error information

  *	in the interpreter.

  *

  *----------------------------------------------------------------------

  */

 static void

 ResetObjResult(iPtr)

     register Interp *iPtr;	/* Points to the interpreter whose result

 				 * object should be reset. */

 {

     register Tcl_Obj *objResultPtr = iPtr->objResultPtr;

     if (Tcl_IsShared(objResultPtr)) {

 	TclDecrRefCount(objResultPtr);

 	TclNewObj(objResultPtr);

 	Tcl_IncrRefCount(objResultPtr);

 	iPtr->objResultPtr = objResultPtr;

     } else {

 	if ((objResultPtr->bytes != NULL)

 	        && (objResultPtr->bytes != tclEmptyStringRep)) {

 	    ckfree((char *) objResultPtr->bytes);

 	}

 	objResultPtr->bytes  = tclEmptyStringRep;

 	objResultPtr->length = 0;

 	if ((objResultPtr->typePtr != NULL)

 	        && (objResultPtr->typePtr->freeIntRepProc != NULL)) {

 	    objResultPtr->typePtr->freeIntRepProc(objResultPtr);

 	}

 	objResultPtr->typePtr = (Tcl_ObjType *) NULL;

     }

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetErrorCodeVA --

  *

  *	This procedure is called to record machine-readable information

  *	about an error that is about to be returned.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The errorCode global variable is modified to hold all of the

  *	arguments to this procedure, in a list form with each argument

  *	becoming one element of the list.  A flag is set internally

  *	to remember that errorCode has been set, so the variable doesn't

  *	get set automatically when the error is returned.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_SetErrorCodeVA (interp, argList)

     Tcl_Interp *interp;		/* Interpreter in which to access the errorCode

 				 * variable. */

     va_list argList;		/* Variable argument list. */

 {

     char *string;

     int flags;

     Interp *iPtr = (Interp *) interp;

     /*

      * Scan through the arguments one at a time, appending them to

      * $errorCode as list elements.

      */

     flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;

     while (1) {

 	string = va_arg(argList, char *);

 	if (string == NULL) {

 	    break;

 	}

 	(void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",

 		(char *) NULL, string, flags);

 	flags |= TCL_APPEND_VALUE;

     }

     iPtr->flags |= ERROR_CODE_SET;

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetErrorCode --

  *

  *	This procedure is called to record machine-readable information

  *	about an error that is about to be returned.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The errorCode global variable is modified to hold all of the

  *	arguments to this procedure, in a list form with each argument

  *	becoming one element of the list.  A flag is set internally

  *	to remember that errorCode has been set, so the variable doesn't

  *	get set automatically when the error is returned.

  *

  *----------------------------------------------------------------------

  */

 	/* VARARGS2 */

 EXPORT_C void

 Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)

 {

     Tcl_Interp *interp;

     va_list argList;

     /*

      * Scan through the arguments one at a time, appending them to

      * $errorCode as list elements.

      */

     interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);

     Tcl_SetErrorCodeVA(interp, argList);

     va_end(argList);

 }

 /*

  *----------------------------------------------------------------------

  *

  * Tcl_SetObjErrorCode --

  *

  *	This procedure is called to record machine-readable information

  *	about an error that is about to be returned. The caller should

  *	build a list object up and pass it to this routine.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	The errorCode global variable is modified to be the new value.

  *	A flag is set internally to remember that errorCode has been

  *	set, so the variable doesn't get set automatically when the

  *	error is returned.

  *

  *----------------------------------------------------------------------

  */

 EXPORT_C void

 Tcl_SetObjErrorCode(interp, errorObjPtr)

     Tcl_Interp *interp;

     Tcl_Obj *errorObjPtr;

 {

     Interp *iPtr;

     iPtr = (Interp *) interp;

     Tcl_SetVar2Ex(interp, "errorCode", NULL, errorObjPtr, TCL_GLOBAL_ONLY);

     iPtr->flags |= ERROR_CODE_SET;

 }

 /*

  *-------------------------------------------------------------------------

  *

  * TclTransferResult --

  *

  *	Copy the result (and error information) from one interp to 

  *	another.  Used when one interp has caused another interp to 

  *	evaluate a script and then wants to transfer the results back

  *	to itself.

  *

  *	This routine copies the string reps of the result and error 

  *	information.  It does not simply increment the refcounts of the

  *	result and error information objects themselves.

  *	It is not legal to exchange objects between interps, because an

  *	object may be kept alive by one interp, but have an internal rep 

  *	that is only valid while some other interp is alive.  

  *

  * Results:

  *	The target interp's result is set to a copy of the source interp's

  *	result.  The source's error information "$errorInfo" may be

  *	appended to the target's error information and the source's error

  *	code "$errorCode" may be stored in the target's error code.

  *

  * Side effects:

  *	None.

  *

  *-------------------------------------------------------------------------

  */

 void

 TclTransferResult(sourceInterp, result, targetInterp)

     Tcl_Interp *sourceInterp;	/* Interp whose result and error information

 				 * should be moved to the target interp.  

 				 * After moving result, this interp's result 

 				 * is reset. */

     int result;			/* TCL_OK if just the result should be copied, 

 				 * TCL_ERROR if both the result and error 

 				 * information should be copied. */

     Tcl_Interp *targetInterp;	/* Interp where result and error information 

 				 * should be stored.  If source and target

 				 * are the same, nothing is done. */

 {

     Interp *iPtr;

     Tcl_Obj *objPtr;

     if (sourceInterp == targetInterp) {

 	return;

     }

     if (result == TCL_ERROR) {

 	/*

 	 * An error occurred, so transfer error information from the source

 	 * interpreter to the target interpreter.  Setting the flags tells

 	 * the target interp that it has inherited a partial traceback

 	 * chain, not just a simple error message.

 	 */

 	iPtr = (Interp *) sourceInterp;

         if ((iPtr->flags & ERR_ALREADY_LOGGED) == 0) {

             Tcl_AddErrorInfo(sourceInterp, "");

         }

         iPtr->flags &= ~(ERR_ALREADY_LOGGED);

         Tcl_ResetResult(targetInterp);

 	objPtr = Tcl_GetVar2Ex(sourceInterp, "errorInfo", NULL,

 		TCL_GLOBAL_ONLY);

 	if (objPtr) {

 	    Tcl_SetVar2Ex(targetInterp, "errorInfo", NULL, objPtr,

 		    TCL_GLOBAL_ONLY);

 	    ((Interp *) targetInterp)->flags |= ERR_IN_PROGRESS;

 	}

 	objPtr = Tcl_GetVar2Ex(sourceInterp, "errorCode", NULL,

 		TCL_GLOBAL_ONLY);

 	if (objPtr) {

 	    Tcl_SetObjErrorCode(targetInterp, objPtr);

 	}

     }

     ((Interp *) targetInterp)->returnCode = ((Interp *) sourceInterp)->returnCode;

     Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp));

     Tcl_ResetResult(sourceInterp);

 }