/*
 * 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.
 *
 * 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.78 2005/07/21 14:38:50 dkf Exp $
 * RCS: @(#) $Id: tclProc.c,v 1.79 2005/09/14 18:35:56 dgp Exp $
 */

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

/*
 * Prototypes for static functions in this file

	    TclPopStackFrame(interp);
	}

 	iPtr->compiledProcPtr = saveProcPtr;

 	if (result != TCL_OK) {
 	    if (result == TCL_ERROR) {
		Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
		Tcl_Obj *message =
			Tcl_NewStringObj("\n    (compiling ", -1);
		int length = strlen(procName);
		int limit = 50;
		int overflow = (length > limit);

		Tcl_IncrRefCount(message);
		Tcl_AppendStringsToObj(message, description, " \"", NULL);
		TclFormatToErrorInfo(interp,
			"\n    (compiling %s \"%.*s%s\", line %d)",
			description, (overflow ? limit : length), procName,
		TclAppendLimitedToObj(message, procName, -1, 50, NULL);
		Tcl_AppendToObj(message, "\", line ", -1);
		Tcl_AppendObjToObj(message, errorLine);
		Tcl_DecrRefCount(errorLine);
			(overflow ? "..." : ""), interp->errorLine);
		Tcl_AppendToObj(message, ")", -1);
 		TclAppendObjToErrorInfo(interp, message);
		Tcl_DecrRefCount(message);
	    }
 	    return result;
 	}
    } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
	/*
	 * The resolver epoch has changed, but we only need to invalidate the
	 * resolver cache.

				 * called and returned returnCode. */
    char *procName;		/* Name of the procedure. Used for error
				 * messages and trace information. */
    int nameLen;		/* Number of bytes in procedure's name. */
    int returnCode;		/* The unexpected result code. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *message, *errorLine;
    int overflow, limit = 60;

    if (returnCode == TCL_OK) {
	return TCL_OK;
    }
    if ((returnCode > TCL_CONTINUE) || (returnCode < TCL_OK)) {
	return returnCode;
    }
    if (returnCode == TCL_RETURN) {
	return TclUpdateReturnInfo(iPtr);
    }
    if (returnCode != TCL_ERROR) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "invoked \"",
		((returnCode == TCL_BREAK) ? "break" : "continue"),
		"\" outside of a loop", NULL);
    }
    errorLine = Tcl_NewIntObj(interp->errorLine);
    message = Tcl_NewStringObj("\n    (procedure \"", -1);
    overflow = (nameLen > limit);
    TclFormatToErrorInfo(interp, "\n    (procedure \"%.*s%s\" line %d)",
    Tcl_IncrRefCount(message);
    TclAppendLimitedToObj(message, procName, nameLen, 60, NULL);
	    (overflow ? limit : nameLen), procName,
    Tcl_AppendToObj(message, "\" line ", -1);
    Tcl_AppendObjToObj(message, errorLine);
    Tcl_DecrRefCount(errorLine);
	    (overflow ? "..." : ""), interp->errorLine);
    Tcl_AppendToObj(message, ")", -1);
    TclAppendObjToErrorInfo(interp, message);
    Tcl_DecrRefCount(message);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcDeleteProc --