/* 
 * 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-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: %Z% $Id: tclProc.c,v 1.10 1998/07/24 13:49:29 surles Exp $ 
 */

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


/*

    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    register Interp *iPtr = (Interp *) interp;
    Proc *procPtr;
    char *fullName, *procName;

    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
    Tcl_Command cmd;
    Tcl_DString ds;
    int result;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "name args body");

	}
	localPtr->nextPtr = NULL;
	localPtr->nameLength = nameLength;
	localPtr->frameIndex = i;
	localPtr->isArg  = 1;
	localPtr->isTemp = 0;
	localPtr->flags = VAR_SCALAR;
	localPtr->resolveInfo = NULL;


	
	if (fieldCount == 2) {
	    localPtr->defValuePtr =
		    Tcl_NewStringObj(fieldValues[1], valueLength);
	    Tcl_IncrRefCount(localPtr->defValuePtr);
	} else {
	    localPtr->defValuePtr = NULL;
	}

				 * invoked. */
    int objc;			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *CONST objv[];	/* Argument value objects. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr = (Proc *) clientData;

    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
    CallFrame frame;
    register CallFrame *framePtr = &frame;
    register Var *varPtr, *resolvedVarPtr;
    register CompiledLocal *localPtr;
    Tcl_ResolvedVarInfo *resVarInfo;

    char *procName, *bytes;
    int nameLen, localCt, numArgs, argCt, length, i, result;

    /*
     * This procedure generates an array "compiledLocals" that holds the
     * storage for local variables. It starts out with stack-allocated space
     * but uses dynamically-allocated storage if needed.

     */
    
    procName = Tcl_GetStringFromObj(objv[0], &nameLen);

    /*
     * 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 = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,

































	    "body of proc", procName);
    






    if (result != TCL_OK) {











        return result;

    }

    /*
     * Create the "compiledLocals" array. Make sure it is large enough to
     * hold all the procedure's compiled local variables, including its
     * formal parameters.
     */

     * and we make the compiled local a link to the real variable.
     */

    varPtr = framePtr->compiledLocals;
    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
	    localPtr = localPtr->nextPtr) {

        resVarInfo = localPtr->resolveInfo;
        resolvedVarPtr = NULL;

        if (resVarInfo && resVarInfo->fetchProc) {
            resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
                resVarInfo->identity);
        }

        if (resolvedVarPtr) {
	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
	    varPtr->nsPtr = NULL;

    return result;
#undef NUM_LOCALS
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcCompileProc --
 *
 *	Called just before a procedure is executed to compile the
 *	body to byte codes.  If the type of the body is not
 *	"byte code" or if the compile conditions have changed
 *	(namespace context, epoch counters, etc.) then the body
 *	is recompiled.  Otherwise, this procedure does nothing.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	May change the internal representation of the body object
  *	to compiled code.
  *
  *----------------------------------------------------------------------
  */
 
int
TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
    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. */
{
    Interp *iPtr = (Interp*)interp;
    int result;
    Tcl_CallFrame frame;
    Proc *saveProcPtr;
 
    /*
     * 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
     * might increase procPtr->numCompiledLocals if new local variables are
     * found while compiling.
     */
 
    if (bodyPtr->typePtr == &tclByteCodeType) {
 	ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
 
 	if ((codePtr->iPtr != iPtr)
 	        || (codePtr->compileEpoch != iPtr->compileEpoch)
 	        || (codePtr->nsPtr != nsPtr)
 	        || (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
 	    tclByteCodeType.freeIntRepProc(bodyPtr);
 	    bodyPtr->typePtr = (Tcl_ObjType *) NULL;
 	}
    }
    if (bodyPtr->typePtr != &tclByteCodeType) {
 	char buf[100];
 	int numChars;
 	char *ellipsis;
 	
 	if (tclTraceCompile >= 1) {
 	    /*
 	     * Display a line summarizing the top level command we
 	     * are about to compile.
 	     */
 
 	    numChars = strlen(procName);
 	    ellipsis = "";
 	    if (numChars > 50) {
 		numChars = 50;
 		ellipsis = "...";
 	    }
 	    fprintf(stdout, "Compiling %s \"%.*s%s\"\n",
 		    description, numChars, procName, ellipsis);
 	}
 	
 	/*
 	 * Plug the current procPtr into the interpreter and coerce
 	 * the code body to byte codes.  The interpreter needs to
 	 * know which proc it's compiling so that it can access its
 	 * list of compiled locals.
 	 *
 	 * 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;
 	iPtr->compiledProcPtr = procPtr;
 
 	result = Tcl_PushCallFrame(interp, &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) {
 		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);
 	    }
 	    return result;
 	}
    }
    return TCL_OK;
}
 

/*
 *----------------------------------------------------------------------
 *
 * TclProcDeleteProc --
 *
 *	This procedure is invoked just before a command procedure is
 *	removed from an interpreter.  Its job is to release all the
 *	resources allocated to the procedure.
 *
 * Results:

    if (bodyPtr != NULL) {
	Tcl_DecrRefCount(bodyPtr);
    }
    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;  ) {
	CompiledLocal *nextPtr = localPtr->nextPtr;

        resVarInfo = localPtr->resolveInfo;
	if (resVarInfo && resVarInfo->deleteProc) {
            (*resVarInfo->deleteProc)(resVarInfo->identity);
            resVarInfo->identity = NULL;
	    ckfree((char *) resVarInfo);
        }

	if (localPtr->defValuePtr != NULL) {
	    defPtr = localPtr->defValuePtr;
	    Tcl_DecrRefCount(defPtr);
	}
	ckfree((char *) localPtr);