* Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004-2006 Miguel Sofer
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclProc.c,v 1.46.2.42 2008/06/16 03:17:13 dgp Exp $
 * RCS: @(#) $Id: tclProc.c,v 1.46.2.43 2008/07/29 20:13:46 dgp Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclNRE.h"

/*
 * Variables that are part of the [apply] command implementation and which
 * have to be passed to the other side of the NRE call.
 */

typedef struct {
    int isRootEnsemble;
    Command cmd;
    ExtraFrameInfo efi;
} ApplyExtraData;

/*
 * Prototypes for static functions in this file
 */

static void		DupLambdaInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);

static void		MakeLambdaError(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj);
static int		SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		ProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
			    Tcl_Obj *bodyPtr, Namespace *nsPtr,
			    const char *description, const char *procName,
			    Proc **procPtrPtr);
static Tcl_NRPostProc ApplyNR2;
static Tcl_NRPostProc InterpProcNR2;
static Tcl_NRPostProc Uplevel_Callback;

/*
 * The ProcBodyObjType type
 */

Tcl_ObjType tclProcBodyType = {
    "procbody",			/* name for this type */

    Tcl_DStringInit(&ds);
    if (nsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	Tcl_DStringAppend(&ds, "::", 2);
    }
    Tcl_DStringAppend(&ds, procName, -1);

    cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
	    TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);
    cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
	    TclNRInterpProc, procPtr, TclProcDeleteProc);

    Tcl_DStringFree(&ds);

    /*
     * Now initialize the new procedure's cmdPtr field. This will be used
     * later when the procedure is called to determine what namespace the
     * procedure will run in. This will be different than the current
     * namespace if the proc was renamed into a different namespace.

 *	A standard Tcl object result value.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
Uplevel_Callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallFrame *savedVarFramePtr = data[0];

    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"uplevel\" body line %d)", interp->errorLine));
    }

    /*
     * Restore the variable frame, and return.
     */

    ((Interp *)interp)->varFramePtr = savedVarFramePtr;
    return result;
}

	/* ARGSUSED */
int
Tcl_UplevelObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRUplevelObjCmd, dummy, objc, objv);
}

int
TclNRUplevelObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    register Interp *iPtr = (Interp *) interp;
    CmdFrame* invoker = NULL;
    int word          = 0;
    int result;
    CallFrame *savedVarFramePtr, *framePtr;
    Tcl_Obj *objPtr;

    if (objc < 2) {
    uplevelSyntax:
	Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
	return TCL_ERROR;
    }

    iPtr->varFramePtr = framePtr;

    /*
     * Execute the residual arguments as a command.
     */

    if (objc == 1) {
	/*
	 * TIP #280. Make actual argument location available to eval'd script
	 */

	result = Tcl_EvalObjEx(interp, objv[0], 0);
	TclArgumentGet (interp, objv[0], &invoker, &word);
	objPtr = objv[0];

    } else {
	/*
	 * More than one argument: concatenate them together with spaces
	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
	 * object when it decrements its refcount after eval'ing it.
	 */

	Tcl_Obj *objPtr;

	objPtr = Tcl_ConcatObj(objc, objv);
	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
    }
    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"uplevel\" body line %d)", interp->errorLine));
    }


    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
    /*
     * Restore the variable frame, and return.
     */

	    NULL);
    iPtr->varFramePtr = savedVarFramePtr;
    return result;
    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFindProc --
 *

Proc *
TclFindProc(
    Interp *iPtr,		/* Interpreter in which to look. */
    const char *procName)	/* Name of desired procedure. */
{
    Tcl_Command cmd;
    Tcl_Command origCmd;
    Command *cmdPtr;

    cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName, NULL, /*flags*/ 0);
    if (cmd == (Tcl_Command) NULL) {
	return NULL;
    }
    cmdPtr = (Command *) cmd;

    origCmd = TclGetOriginalCommand(cmd);
    if (origCmd != NULL) {
	cmdPtr = (Command *) origCmd;
    }
    if (cmdPtr->objProc != TclObjInterpProc) {
	return NULL;
    return TclIsProc(cmdPtr);
    }
    return (Proc *) cmdPtr->objClientData;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIsProc --
 *

{
    Tcl_Command origCmd;

    origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
    if (origCmd != NULL) {
	cmdPtr = (Command *) origCmd;
    }
    if (cmdPtr->objProc == TclObjInterpProc) {
    if (cmdPtr->deleteProc == TclProcDeleteProc) {
	return (Proc *) cmdPtr->objClientData;
    }
    return (Proc *) 0;
}

/*
 *----------------------------------------------------------------------

	Tcl_Obj *namePtr = localName(framePtr, i-1);

	if (defPtr->value.objPtr != NULL) {
	    TclNewObj(argObj);
	    Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
	} else if (defPtr->flags & VAR_IS_ARGS) {
	    numArgs--;
	    final = "...";
	    final = "?arg ...?";
	    break;
	} else {
	    argObj = namePtr;
	    Tcl_IncrRefCount(namePtr);
	}
	desiredObjs[i] = argObj;
    }

    }

    /*
     * When we get here, the last formal argument remains to be defined:
     * defPtr and varPtr point to the last argument to be initialized.
     */


    varPtr->flags = 0;
    if (defPtr->flags & VAR_IS_ARGS) {
	Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);

	varPtr->value.objPtr = listPtr;
	Tcl_IncrRefCount(listPtr);	/* Local var is a reference. */
    } else if (argCt == numArgs) {

    /*
     * Initialise and resolve the remaining compiledLocals. In the absence of
     * resolvers, they are undefined local vars: (flags=0, value=NULL).
     */

  correctArgs:
    if (numArgs < localCt) {
	if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) {
	if (!framePtr->nsPtr->compiledVarResProc
		&& !((Interp *)interp)->resolverPtr) {
	    memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
	} else {
	    InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
	}
    }

    return TCL_OK;


    incorrectArgs:
    /*
     * Initialise all compiled locals to avoid problems at DeleteLocalVars.
     */

  incorrectArgs:
    memset(varPtr, 0,
    memset(varPtr, 0, ((framePtr->compiledLocals + localCt)-varPtr)*sizeof(Var));
	    ((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var));
    return ProcWrongNumArgs(interp, skip);
}

/*
 *----------------------------------------------------------------------
 *
 * PushProcCallFrame --

				 * interpreted. */
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
{
    /*
     * Not used much in the core; external interface for iTcl
     */
    
    return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
}

    int result;

    result = PushProcCallFrame(clientData, interp, objc, objv, /*isLambda*/ 0);
    if (result == TCL_OK) {
int
TclNRInterpProc(
    ClientData clientData, 	/* Record describing procedure to be
				 * interpreted. */
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
{
    int result = PushProcCallFrame(clientData, interp, objc, objv,
	    /*isLambda*/ 0);

    if (result != TCL_OK) {
	return TclObjInterpProcCore(interp, objv[0], 1, &MakeProcError);
    } else {
	return TCL_ERROR;
    }
    return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjInterpProcCore --
 * TclNRInterpProcCore --
 *
 *	When a Tcl procedure, lambda term or anything else that works like a
 *	procedure gets invoked during bytecode evaluation, this object-based
 *	routine gets invoked to interpret the body.
 *
 * Results:
 *	A standard Tcl object result value.
 *
 * Side effects:
 *	Nearly anything; depends on the commands in the procedure body.
 *
 *----------------------------------------------------------------------
 */

int
TclObjInterpProcCore(
TclNRInterpProcCore(
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    Tcl_Obj *procNameObj,	/* Procedure name for error reporting. */
    int skip,			/* Number of initial arguments to be skipped,
				 * i.e., words in the "command name". */
    ProcErrorProc errorProc)	/* How to convert results from the script into
				 * results of the overall procedure. */
{
    Interp *iPtr = (Interp *) interp;
    register Proc *procPtr = iPtr->varFramePtr->procPtr;
    int result;
    CallFrame *freePtr;
    ByteCode *codePtr;

    result = InitArgsAndLocals(interp, procNameObj, skip);
    if (result != TCL_OK) {
	freePtr = iPtr->framePtr;
	Tcl_PopCallFrame(interp);	/* Pop but do not free. */
	TclStackFree(interp, freePtr->compiledLocals);
	goto procDone;
	                                /* Free compiledLocals. */
	TclStackFree(interp, freePtr);	/* Free CallFrame. */
	return TCL_ERROR;
    }

#if defined(TCL_COMPILE_DEBUG)
    if (tclTraceExec >= 1) {
	register CallFrame *framePtr = iPtr->varFramePtr;
	register int i;

	fprintf(stdout, "\n");
	fflush(stdout);
    }
#endif /*TCL_COMPILE_DEBUG*/

    if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
	char *a[10];
	int i = 0;
	int i;
	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;

	while (i < 10) {
	for (i=0 ; i<10 ; i++) {
	    a[i] = (l < iPtr->varFramePtr->objc ? 
		    TclGetString(iPtr->varFramePtr->objv[l]) : NULL); i++; l++;
		    TclGetString(iPtr->varFramePtr->objv[l]) : NULL);
	    l++;
	}
	TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
		a[8], a[9]);
    }
    if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
	char *a[4]; int i[2];
	
	TclDTraceInfo(info, a, i);
	TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
	TclDecrRefCount(info);
    }

    /*
     * Invoke the commands in the procedure's body.
     */

    TclResetCancellation(interp, 0);

    procPtr->refCount++;
    iPtr->numLevels++;

    if (TclInterpReady(interp) == TCL_ERROR) {
	result = TCL_ERROR;
    } else {
	register ByteCode *codePtr =
		procPtr->bodyPtr->internalRep.otherValuePtr;
    codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;

	codePtr->refCount++;
	if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
	    int l;
	    
	    l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 2 : 1;
	    TCL_DTRACE_PROC_ENTRY(TclGetString(procNameObj),
		    iPtr->varFramePtr->objc - l,
		    (Tcl_Obj **)(iPtr->varFramePtr->objv + l));
	}
    if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
	int l;
	
	l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 2 : 1;
	TCL_DTRACE_PROC_ENTRY(TclGetString(procNameObj),
		iPtr->varFramePtr->objc - l,
		(Tcl_Obj **)(iPtr->varFramePtr->objv + l));
    }
	result = TclExecuteByteCode(interp, codePtr);
	if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
	    TCL_DTRACE_PROC_RETURN(TclGetString(procNameObj), result);
	}
	codePtr->refCount--;
	if (codePtr->refCount <= 0) {

    TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
	    NULL, NULL);
    TclNRAddCallback(interp, NRRunBytecode, codePtr, NULL, NULL, NULL);
    return TCL_OK;
	    TclCleanupByteCode(codePtr);
	}
    }

    iPtr->numLevels--;
    procPtr->refCount--;
    if (procPtr->refCount <= 0) {
}

static int
InterpProcNR2(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr = iPtr->varFramePtr->procPtr;
    CallFrame *freePtr;
    Tcl_Obj *procNameObj = data[0];
    ProcErrorProc errorProc = data[1];
    
    if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
	TCL_DTRACE_PROC_RETURN(TclGetString(procNameObj), result);
    }
    if (--procPtr->refCount <= 0) {
	TclProcCleanupProc(procPtr);
    }

    /*
     * Process the result code.
     */

	Tcl_Obj *r;

	r = Tcl_GetObjResult(interp);
	TCL_DTRACE_PROC_RESULT(TclGetString(procNameObj), result,
		TclGetString(r), r);
    }

  procDone:
    /*
     * Free the stack-allocated compiled locals and CallFrame. It is important
     * to pop the call frame without freeing it first: the compiledLocals
     * cannot be freed before the frame is popped, as the local variables must
     * be deleted. But the compiledLocals must be freed first, as they were
     * allocated later on the stack.
     */

    freePtr = iPtr->framePtr;
    Tcl_PopCallFrame(interp);		/* Pop but do not free. */
    TclStackFree(interp, freePtr->compiledLocals);
					/* Free compiledLocals. */
    TclStackFree(interp, freePtr);	/* Free CallFrame. */

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcCompileProc --

    if (bodyPtr->typePtr == &tclByteCodeType) {
 	if (((Interp *) *codePtr->interpHandle == iPtr)
		&& (codePtr->compileEpoch == iPtr->compileEpoch)
		&& (codePtr->nsPtr == nsPtr)
		&& (codePtr->nsEpoch == nsPtr->resolverEpoch)) {
	    return TCL_OK;
	}
	} else {
	    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
		if ((Interp *) *codePtr->interpHandle != iPtr) {
		    Tcl_AppendResult(interp,
			    "a precompiled script jumped interps", NULL);
		    return TCL_ERROR;
		}
		codePtr->compileEpoch = iPtr->compileEpoch;
		codePtr->nsPtr = nsPtr;
	    } else {
		bodyPtr->typePtr->freeIntRepProc(bodyPtr);
		bodyPtr->typePtr = NULL;
	    }
 	}
    }

	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	    if ((Interp *) *codePtr->interpHandle != iPtr) {
		Tcl_AppendResult(interp,
			"a precompiled script jumped interps", NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    codePtr->nsPtr = nsPtr;
	} else {
	    bodyPtr->typePtr->freeIntRepProc(bodyPtr);
	    bodyPtr->typePtr = NULL;
 	}
    }

    if (bodyPtr->typePtr != &tclByteCodeType) {
	Tcl_HashEntry *hePtr;

#ifdef TCL_COMPILE_DEBUG
 	if (tclTraceCompile >= 1) {
 	    /*
 	     * Display a line summarizing the top level command we are about

	localPtr = nextPtr;
    }
    ckfree((char *) procPtr);

    /*
     * TIP #280: Release the location data associated with this Proc
     * structure, if any. The interpreter may not exist (For example for
     * procbody structurues created by tbcload.
     * procbody structures created by tbcload.
     */

    if (!iPtr) {
	return;
    }

    hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);

int
Tcl_ApplyObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRApplyObjCmd, dummy, objc, objv);
}

int
TclNRApplyObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr = NULL;
    Tcl_Obj *lambdaPtr, *nsObjPtr;
    int result, isRootEnsemble;
    Command cmd;
    Tcl_Namespace *nsPtr;
    ExtraFrameInfo efi;
    ApplyExtraData *extraPtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg1 arg2 ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Set lambdaPtr, convert it to lambdaType in the current interp if
     * necessary.
     */

    lambdaPtr = objv[1];
    if (lambdaPtr->typePtr == &lambdaType) {
	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
    }

#define JOE_EXTENSION 0
/*
 * Note: this code is NOT FUNCTIONAL due to the NR implementation; DO NOT
 * ENABLE! Leaving here as reminder to (a) TIP the suggestion, and (b) adapt
 * the code. (MS)
 */
    
#if JOE_EXTENSION
    else {
	/*
	 * Joe English's suggestion to allow cmdNames to function as lambdas.
	 * Also requires making tclCmdNameType non-static in tclObj.c
	 */

	result = SetLambdaFromAny(interp, lambdaPtr);
	if (result != TCL_OK) {
	    return result;
	}
	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
    }

    /*
     * Find the namespace where this lambda should run, and push a call frame
     * for that namespace. Note that TclObjInterpProc() will pop it.
     */

    nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
    result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    extraPtr = TclStackAlloc(interp, sizeof(ApplyExtraData));
    memset(&cmd, 0, sizeof(Command));
    procPtr->cmdPtr = &cmd;
    memset(&extraPtr->cmd, 0, sizeof(Command));
    procPtr->cmdPtr = &extraPtr->cmd;
    extraPtr->cmd.nsPtr = (Namespace *) nsPtr;

    /*
     * TIP#280 (semi-)HACK!
     *
     * Using cmd.clientData to tell [info frame] how to render the
     * 'lambdaPtr'. The InfoFrameCmd will detect this case by testing cmd.hPtr
     * for NULL. This condition holds here because of the 'memset' above, and
     * nowhere else (in the core). Regular commands always have a valid
     * 'hPtr', and lambda's never.
     */

    efi.length = 1;
    efi.fields[0].name = "lambda";
    efi.fields[0].proc = NULL;
    efi.fields[0].clientData = lambdaPtr;
    cmd.clientData = &efi;
    extraPtr->efi.length = 1;
    extraPtr->efi.fields[0].name = "lambda";
    extraPtr->efi.fields[0].proc = NULL;
    extraPtr->efi.fields[0].clientData = lambdaPtr;
    extraPtr->cmd.clientData = &extraPtr->efi;

    /*
     * Find the namespace where this lambda should run, and push a call frame
     * for that namespace. Note that TclObjInterpProc() will pop it.
     */

    nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
    result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
    if (result != TCL_OK) {
	return result;
    }

    cmd.nsPtr = (Namespace *) nsPtr;

    isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 1;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    } else {
	iPtr->ensembleRewrite.numInsertedObjs -= 1;
    }
    extraPtr->isRootEnsemble = isRootEnsemble;

    result = PushProcCallFrame((ClientData) procPtr, interp, objc, objv, 1);
    if (result == TCL_OK) {
	TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
	result = TclObjInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
	result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
    }
    return result;

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = NULL;
}

static int
ApplyNR2(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ApplyExtraData *extraPtr = data[0];
    
    if (extraPtr->isRootEnsemble) {
	((Interp *) interp)->ensembleRewrite.sourceObjs = NULL;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }

    TclStackFree(interp, extraPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * MakeLambdaError --

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (lambda term \"%.*s%s\" line %d)",
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), interp->errorLine));
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_DisassembleObjCmd --
 *
 *	Implementation of the "::tcl::unsupported::disassemble" command. This