/*
 * 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.115.2.1 2007/06/05 18:12:42 dgp Exp $
 * RCS: @(#) $Id: tclProc.c,v 1.115.2.2 2007/06/14 17:03:36 dgp Exp $
 */

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

/*
 * Prototypes for static functions in this file

	Interp *iPtr = (Interp *) interp;
	ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;

	/*
	 * When we've got bytecode, this is the check for validity. That is,
	 * the bytecode must be for the right interpreter (no cross-leaks!),
	 * the code must be from the current epoch (so subcommand compilation
	 * is up-to-date), and the namespace must match (so variable handling
	 * is right).
	 * is up-to-date), the namespace must match (so variable handling
	 * is right) and the resolverEpoch must match (so that new shadowed
	 * commands and/or resolver changes are considered).
	 */

 	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)) {
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
	    goto doCompilation;
	}
    } else {
    doCompilation:
	result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
		(isLambda ? "body of lambda term" : "body of proc"),
		TclGetString(objv[isLambda]), &procPtr);

				 * needs special rules for error msg. */
    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. */
{
    register Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
    register Var *varPtr;
    register CompiledLocal *localPtr;
    int localCt, numArgs, argCt, i, imax, result;
    Var *compiledLocals;
    Tcl_Obj *const *argObjs;

    /*

    } else if ((argCt < numArgs) && (localPtr->defValuePtr != NULL)) {
	Tcl_Obj *objPtr = localPtr->defValuePtr;

	varPtr->value.objPtr = objPtr;
	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
    } else {
	Tcl_Obj **desiredObjs;
	ByteCode *codePtr;
	const char *final;

	/*
	 * Do initialise all compiled locals, to avoid problems at
	 * DeleteLocalVars.
	 */

    incorrectArgs:
	final = NULL;
	codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
	InitCompiledLocals(interp, codePtr, localPtr, varPtr, framePtr->nsPtr);

	/*
	 * Build up desired argument list for Tcl_WrongNumArgs
	 */

	desiredObjs = (Tcl_Obj **) TclStackAlloc(interp,

    /*
     * Initialise and resolve the remaining compiledLocals.
     */

  runProc:
    if (localPtr) {
	ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;

	InitCompiledLocals(interp, codePtr, localPtr, varPtr, framePtr->nsPtr);
    }

#if defined(TCL_COMPILE_DEBUG)
    if (tclTraceExec >= 1) {
	if (isLambda) {
	    fprintf(stdout, "Calling lambda ");

#endif /*TCL_COMPILE_DEBUG*/

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

    procPtr->refCount++;
    ((Interp *)interp)->numLevels++;

    /*
     * TIP #280: No need to set the invoking context here. The body has
     * already been compiled, so the part of CompEvalObj using it is bypassed.
    if (TclInterpReady(interp) == TCL_ERROR) {
	result = TCL_ERROR;
     */

    result = TclCompEvalObj(interp, procPtr->bodyPtr, NULL, 0);
    } else {
	codePtr->refCount++;
	result = TclExecuteByteCode(interp, codePtr);
	codePtr->refCount--;
	if (codePtr->refCount <= 0) {
	    TclCleanupByteCode(codePtr);
	}
    }
    
    ((Interp *)interp)->numLevels--;
    procPtr->refCount--;
    if (procPtr->refCount <= 0) {
	TclProcCleanupProc(procPtr);
    }

    /*
     * If the procedure is completing normally, we can skip directly to the

    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;
    int i;
    Tcl_CallFrame *framePtr;
    Proc *saveProcPtr;
    ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr;
    CompiledLocal *localPtr;

    /*
     * If necessary, compile the procedure's body. The compiler will allocate

     * Precompiled procedure bodies, however, are immutable and therefore they
     * are not recompiled, even if things have changed.
     */

    if (bodyPtr->typePtr == &tclByteCodeType) {
 	if (((Interp *) *codePtr->interpHandle == iPtr)
		&& (codePtr->compileEpoch == iPtr->compileEpoch)
		&& (codePtr->nsPtr == nsPtr)) {
		&& (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;

	    Tcl_SetCommandInfoFromToken(token, &info);

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

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

 	if (result == TCL_OK) {
	    /*
	     * TIP #280: We get the invoking context from the cmdFrame which
	     * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
	     */
	/*
	 * TIP #280: We get the invoking context from the cmdFrame which
	 * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
	 */

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

	    /*
	     * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
	     */
	/*
	 * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
	 */

	    iPtr->invokeWord = 0;
	    iPtr->invokeCmdFramePtr =
		    (hePtr ? (CmdFrame *) Tcl_GetHashValue(hePtr) : NULL);
	    result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
	    iPtr->invokeCmdFramePtr = NULL;
	    TclPopStackFrame(interp);
	iPtr->invokeWord = 0;
	iPtr->invokeCmdFramePtr =
		(hePtr ? (CmdFrame *) Tcl_GetHashValue(hePtr) : NULL);
	(void) tclByteCodeType.setFromAnyProc(interp, bodyPtr);
	iPtr->invokeCmdFramePtr = NULL;
	TclPopStackFrame(interp);
	}

 	iPtr->compiledProcPtr = saveProcPtr;

 	if (result != TCL_OK) {
 	    if (result == TCL_ERROR) {
		int length = strlen(procName);
		int limit = 50;
		int overflow = (length > limit);

		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (compiling %s \"%.*s%s\", line %d)",
			description, (overflow ? limit : length), procName,
			(overflow ? "..." : ""), interp->errorLine));
	    }
 	    return result;
 	}
    } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
	/*
	 * The resolver epoch has changed, but we only need to invalidate the
	 * resolver cache.
	 */

	codePtr->nsEpoch = nsPtr->resolverEpoch;
	codePtr->flags |= TCL_BYTECODE_RESOLVE_VARS;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------