/* 
 * 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.23.6.2 2001/12/05 18:22:26 andreas_kupries Exp $
 */

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

/*
 * Prototypes for static functions in this file

                    || (strcmp(localPtr->name, fieldValues[0]))
                    || (localPtr->frameIndex != i)
                    || (localPtr->flags != (VAR_SCALAR | VAR_ARGUMENT))
                    || ((localPtr->defValuePtr == NULL)
                            && (fieldCount == 2))
                    || ((localPtr->defValuePtr != NULL)
                            && (fieldCount != 2))) {
	        STRING (80 + TCL_INTEGER_SPACE, buf);
	        NEWSTR (80 + TCL_INTEGER_SPACE, buf);
                sprintf(buf, "\": formal parameter %d is inconsistent with precompiled body",
                        i);
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                        "procedure \"", procName,
                        buf, (char *) NULL);
		RELTEMP (buf);
                ckfree((char *) fieldValues);
                goto procError;
            }

            /*
             * compare the default value if any
             */

 				 * 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. */
{
    Interp *iPtr = (Interp*)interp;
    int result;
    TEMP (Tcl_CallFrame) frame;
    Proc *saveProcPtr;
    ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
 
    NEWTEMP (Tcl_CallFrame, frame);

    /*
     * 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, we recompile it. Note that compiling the body

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

 	 *   proper namespace context, so that the byte codes are
 	 *   compiled in the appropriate class context.
 	 */
 
 	saveProcPtr = iPtr->compiledProcPtr;
 	iPtr->compiledProcPtr = procPtr;
 
 	result = Tcl_PushCallFrame(interp, REF (frame),
		(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
 
 	if (result == TCL_OK) {
	    result = tclByteCodeType.setFromAnyProc(interp, bodyPtr);
	    Tcl_PopCallFrame(interp);
	}
 
 	iPtr->compiledProcPtr = saveProcPtr;
 	
 	if (result != TCL_OK) {
 	    if (result == TCL_ERROR) {
		STRING (100 + TCL_INTEGER_SPACE, buf);
		NEWSTR (100 + TCL_INTEGER_SPACE, buf);

		numChars = strlen(procName);
 		ellipsis = "";
 		if (numChars > 50) {
 		    numChars = 50;
 		    ellipsis = "...";
 		}
 		sprintf(buf, "\n    (compiling %s \"%.*s%s\", line %d)",
 			description, numChars, procName, ellipsis,
 			interp->errorLine);
 		Tcl_AddObjErrorInfo(interp, buf, -1);
		RELTEMP (buf);
 	    }
	    RELTEMP (frame);
 	    return result;
 	}
    } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
	register CompiledLocal *localPtr;
 	
	/*
	 * The resolver epoch has changed, but we only need to invalidate

		} else {
		    ckfree((char*)localPtr->resolveInfo);
		}
		localPtr->resolveInfo = NULL;
	    }
	}
    }
    RELTEMP (frame);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcDeleteProc --