/* 
 * 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.13 1998/08/06 12:15:50 escoffon Exp $ 
 */

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


/*

	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	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 {

    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.
     */

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

    framePtr->objc = objc;
    framePtr->objv = objv;  /* ref counts for args are incremented below */
    framePtr->procPtr = procPtr;
    framePtr->numCompiledLocals = localCt;
    framePtr->compiledLocals = compiledLocals;

    /*
     * Initialize the array of local variables stored in the call frame.
     * Some variables may have special resolution rules.  In that case,
     * we call their "resolver" procs to get our hands on the variable,
     * 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;
	    varPtr->hPtr = NULL;
	    varPtr->refCount = 0;
	    varPtr->tracePtr = NULL;
	    varPtr->searchPtr = NULL;
	    varPtr->flags = 0;
            TclSetVarLink(varPtr);
            varPtr->value.linkPtr = resolvedVarPtr;
            resolvedVarPtr->refCount++;
        }
        else {
	    varPtr->value.objPtr = NULL;
	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
	    varPtr->nsPtr = NULL;
	    varPtr->hPtr = NULL;
	    varPtr->refCount = 0;
	    varPtr->tracePtr = NULL;
	    varPtr->searchPtr = NULL;
	    varPtr->flags = (localPtr->flags | VAR_UNDEFINED);
        }
	varPtr++;
    }

    /*
     * Match and assign the call's actual parameters to the procedure's
     * formal arguments. The formal arguments are described by the first
     * numArgs entries in both the Proc structure's local variable list and
     * the call frame's local variable array.
     */

    numArgs = procPtr->numArgs;
    varPtr = framePtr->compiledLocals;
    localPtr = procPtr->firstLocalPtr;
    argCt = objc;
    for (i = 1, argCt -= 1;  i <= numArgs;  i++, argCt--) {
	if (!localPtr->isArg) {
	    panic("TclObjInterpProc: local variable %s is not argument but should be",
		  localPtr->name);
	    return TCL_ERROR;
	}
	if (localPtr->isTemp) {
	    panic("TclObjInterpProc: local variable %d is temporary but should be an argument", i);
	    return TCL_ERROR;
	}

	/*
	 * Handle the special case of the last formal being "args".  When
	 * it occurs, assign it a list consisting of all the remaining

    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.
     *
     * Precompiled procedure bodies, however, are immutable and therefore
     * they are not recompiled, even if things have changed.
     */
 
    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)) {
            if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
                if (codePtr->iPtr != iPtr) {
                    Tcl_AppendResult(interp,
                            "a precompiled script jumped interps", NULL);
                    return TCL_ERROR;
                }
	        codePtr->compileEpoch = iPtr->compileEpoch;
 	        codePtr->nsEpoch = nsPtr->resolverEpoch;
                codePtr->nsPtr = nsPtr;
            } else {
                tclByteCodeType.freeIntRepProc(bodyPtr);
                bodyPtr->typePtr = (Tcl_ObjType *) NULL;
            }
 	}
    }

 		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;
}
 

/*
 *----------------------------------------------------------------------

    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);