/* 

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