/* * tclResult.c -- * * This file contains code to manage the interpreter result. * * Copyright (c) 1997 by Sun Microsystems, Inc. * * 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.1.1.1 2007/07/10 15:04:23 duncan 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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. * *---------------------------------------------------------------------- */ 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 */ 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. * *---------------------------------------------------------------------- */ 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); }