2006-05-13  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclProc.c (ProcCompileProc):	When a bump of the compile
	epoch forces the re-compile of a proc body, take care not to
	overwrite any Proc struct that may be referred to on the active
	call stack.  This fixes [Bug 148218].  Note that the fix will not be
	effective for code that calls the private routine TclProcCompileProc()
	directly.

2006-05-13  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tclEvent.c (HandleBgErrors): fix leak. [Coverity issue 86]

2006-05-05  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclMain.c (Tcl_Main):		Corrected flaw that required

/*
 * tclProc.c --
 *
 *	This file contains routines that implement Tcl procedures, including
 *	the "proc" and "uplevel" commands.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004-2006 Miguel Sofer
 *
 * 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.90 2006/05/13 17:14:26 dgp Exp $
 */

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

/*
 * Prototypes for static functions in this file

static void		ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void		ProcBodyFree(Tcl_Obj *objPtr);
static int		ProcessProcResultCode(Tcl_Interp *interp,
			    char *procName, int nameLen, int returnCode);
static int		SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		TclCompileNoOp(Tcl_Interp *interp, Tcl_Parse *parsePtr,
			    struct CompileEnv *envPtr);
static int		ProcCompileProc (Tcl_Interp *interp, Proc *procPtr,
			    Tcl_Obj *bodyPtr, Namespace *nsPtr, 
			    CONST char *description, CONST char *procName,
			    Proc **procPtrPtr);

/*
 * The ProcBodyObjType type
 */

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

				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *CONST objv[],	/* Argument value objects. */
    int skip)			/* Number of initial arguments to be skipped,
				 * ie, words in the "command name" */ 
{
    Proc *procPtr = (Proc *) clientData;
    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
    CallFrame *framePtr, **framePtrPtr;
    register Var *varPtr;
    register CompiledLocal *localPtr;
    char *procName;
    int nameLen, localCt, numArgs, argCt, i, imax, result;
    Var *compiledLocals;

    /*
     * If necessary, compile the procedure's body. The compiler will allocate
     * frame slots for the procedure's non-argument local variables. Note that
     * compiling the body might increase procPtr->numCompiledLocals if new
     * local variables are found while compiling.
     */

    result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
	    "body of proc", procName, &procPtr);

    if (result != TCL_OK) {
	return result;
    }


    /*

    Tcl_Obj *bodyPtr,		/* Body of proc. (Usually procPtr->bodyPtr,
 				 * but could be any code fragment compiled in
 				 * the context of this procedure.) */
    Namespace *nsPtr,		/* Namespace containing procedure. */
    CONST char *description,	/* string describing this body of code. */
    CONST char *procName)	/* Name of this procedure. */
{
    return ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
	    procName, NULL);
}

static int
ProcCompileProc(
    Tcl_Interp *interp,		/* Interpreter containing procedure. */
    Proc *procPtr,		/* Data associated with procedure. */
    Tcl_Obj *bodyPtr,		/* Body of proc. (Usually procPtr->bodyPtr,
 				 * but could be any code fragment compiled in
 				 * the context of this procedure.) */
    Namespace *nsPtr,		/* Namespace containing procedure. */
    CONST char *description,	/* string describing this body of code. */
    CONST char *procName,	/* Name of this procedure. */
    Proc **procPtrPtr)		/* Points to storage where a replacement
				 * (Proc *) value may be written. */
{
    Interp *iPtr = (Interp*)interp;
    int i, result;
    Tcl_CallFrame *framePtr;
    Proc *saveProcPtr;
    ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
    CompiledLocal *localPtr;

    /*
     * If necessary, compile the procedure's body. The compiler will allocate
     * frame slots for the procedure's non-argument local variables. If the
     * ByteCode already exists, make sure it hasn't been invalidated by
     * someone redefining a core command (this might make the compiled code
     * wrong). Also, if the code was compiled in/for a different interpreter,

 	 *
 	 * TRICKY NOTE: Be careful to push a call frame with the proper
 	 *   namespace context, so that the byte codes are compiled in the
 	 *   appropriate class context.
 	 */

 	saveProcPtr = iPtr->compiledProcPtr;

	if (procPtrPtr != NULL && procPtr->refCount > 1) {
	    Tcl_Command token;
	    Tcl_CmdInfo info;
	    Proc *new = (Proc *) ckalloc(sizeof(Proc));

	    new->iPtr = procPtr->iPtr;
	    new->refCount = 1;
	    token = (Tcl_Command) new->cmdPtr = procPtr->cmdPtr;
	    new->bodyPtr = Tcl_DuplicateObj(bodyPtr);
	    bodyPtr = new->bodyPtr;
	    Tcl_IncrRefCount(bodyPtr);
	    new->numArgs = procPtr->numArgs;

	    new->numCompiledLocals = new->numArgs;
	    new->firstLocalPtr = NULL;
	    new->lastLocalPtr = NULL;
	    localPtr = procPtr->firstLocalPtr;
	    for (i = 0; i < new->numArgs; i++, localPtr = localPtr->nextPtr) {
		CompiledLocal *copy = (CompiledLocal *) ckalloc((unsigned)
			(sizeof(CompiledLocal) -sizeof(localPtr->name)
			+ localPtr->nameLength + 1));
		if (new->firstLocalPtr == NULL) {
		    new->firstLocalPtr = new->lastLocalPtr = copy;
		} else {
		    new->lastLocalPtr->nextPtr = copy;
		    new->lastLocalPtr = copy;
		}
		copy->nextPtr = NULL;
		copy->nameLength = localPtr->nameLength;
		copy->frameIndex = localPtr->frameIndex;
		copy->flags = localPtr->flags;
		copy->defValuePtr = localPtr->defValuePtr;
		if (copy->defValuePtr) {
		    Tcl_IncrRefCount(copy->defValuePtr);
		}
		copy->resolveInfo = localPtr->resolveInfo;
		strcpy(copy->name, localPtr->name);
	    }

	    /* Reset the ClientData */
	    Tcl_GetCommandInfoFromToken(token, &info);
	    if (info.objClientData == (ClientData) procPtr) {
		info.objClientData = (ClientData) new;
	    }
	    if (info.clientData == (ClientData) procPtr) {
		info.clientData = (ClientData) new;
	    }
	    if (info.deleteData == (ClientData) procPtr) {
		info.deleteData = (ClientData) new;
	    }
	    Tcl_SetCommandInfoFromToken(token, &info);

	    procPtr->refCount--;
	    *procPtrPtr = procPtr = new;
	}
 	iPtr->compiledProcPtr = procPtr;

 	result = TclPushStackFrame(interp, &framePtr,
		(Tcl_Namespace *) nsPtr, /* isProcCallFrame */ 0);

 	if (result == TCL_OK) {
	    result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);