/* 
 * 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.73.2.4 2005/04/12 18:23:33 msofer Exp $
 */

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

/*
 * Prototypes for static functions in this file
 */

static void	ProcBodyDup _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *dupPtr));
static void	ProcBodyFree _ANSI_ARGS_((Tcl_Obj *objPtr));
static int	ProcessProcResultCode _ANSI_ARGS_((Tcl_Interp *interp,
		    char *procName, int nameLen, int returnCode));
static int	TclCompileNoOp _ANSI_ARGS_((Tcl_Interp *interp,
		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));

static void     InitCompiledLocals _ANSI_ARGS_((Tcl_Interp *interp,
		    ByteCode *codePtr, CompiledLocal *localPtr,
		    Var *varPtr, Namespace *nsPtr)); 

/*
 * The ProcBodyObjType type
 */

Tcl_ObjType tclProcBodyType = {
    "procbody",			/* name for this type */

	     * NOTE: code precompiled under older versions of Tcl will not
	     * work properly.
	     */

	    if ((localPtr->nameLength != nameLength)
		    || (strcmp(localPtr->name, fieldValues[0]))
		    || (localPtr->frameIndex != i)
		    || (localPtr->flags !=
			    (VAR_ARGUMENT|VAR_DIRECT_READABLE|VAR_DIRECT_WRITABLE))
		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
		char buf[40 + TCL_INTEGER_SPACE];

		ckfree((char *) fieldValues);
		sprintf(buf, "%d is inconsistent with precompiled body", i);
		Tcl_AppendResult(interp, "procedure \"", procName,

	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;
	    localPtr->nameLength = nameLength;
	    localPtr->frameIndex = i;
	    localPtr->flags = (VAR_ARGUMENT|VAR_DIRECT_READABLE|VAR_DIRECT_WRITABLE);

	    localPtr->resolveInfo = NULL;

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

 */

static void
InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr)
    Tcl_Interp *interp;		/* Current interpreter. */
    ByteCode *codePtr;
    CompiledLocal *localPtr;
    Var *varPtr;
    Namespace *nsPtr;		/* Pointer to current namespace. */
{
    Interp *iPtr = (Interp*) interp;
    int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
    CompiledLocal *firstLocalPtr;
    
    if (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS) {

     * we call their "resolver" procs to get our hands on the variable,
     * and we make the compiled local a link to the real variable.
     */

    if (haveResolvers) {
	Tcl_ResolvedVarInfo *resVarInfo;
	for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {

	    varPtr->value.objPtr = NULL;
	    varPtr->id.name = localPtr->name; /* will be just '\0' if temp var */
	    varPtr->refCount = 0;
	    varPtr->tracePtr = NULL;
	    varPtr->searchPtr = NULL;
	    varPtr->flags = localPtr->flags;
    
	    /*
	     * Now invoke the resolvers to determine the exact variables that
	     * should be used.
	     */
	    
	    resVarInfo = localPtr->resolveInfo;
	    if (resVarInfo && resVarInfo->fetchProc) {
		Var *resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
			resVarInfo);
		if (resolvedVarPtr) {
		    resolvedVarPtr->refCount++;
		    varPtr->value.linkPtr = resolvedVarPtr;
		    varPtr->flags = VAR_LINK;
		}
	    }
	}
    } else {
	for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {

	    varPtr->value.objPtr = NULL;
	    varPtr->id.name = localPtr->name; /* will be just '\0' if temp var */
	    varPtr->refCount = 0;
	    varPtr->tracePtr = NULL;
	    varPtr->searchPtr = NULL;
	    varPtr->flags = localPtr->flags;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *

void
TclInitCompiledLocals(interp, framePtr, nsPtr)
    Tcl_Interp *interp;		/* Current interpreter. */
    CallFrame *framePtr;	/* Call frame to initialize. */
    Namespace *nsPtr;		/* Pointer to current namespace. */
{
    Var *varPtr = framePtr->compiledLocals;
    Tcl_Obj *bodyPtr;
    ByteCode *codePtr;
    CompiledLocal *localPtr = framePtr->procPtr->firstLocalPtr;

    bodyPtr = framePtr->procPtr->bodyPtr;
    if (bodyPtr->typePtr != &tclByteCodeType) {
        Tcl_Panic("body object for proc attached to frame is not a byte code type");

    int objc;			 /* Count of number of arguments to this
				  * procedure. */
    Tcl_Obj *CONST objv[];	 /* Argument value objects. */
{
    register Proc *procPtr = (Proc *) clientData;
    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
    CallFrame *framePtr, **framePtrPtr;
    register Var *varPtr;
    register CompiledLocal *localPtr;
    char *procName;
    int nameLen, localCt, numArgs, argCt, i, imax, result;
    Var *compiledLocals;

    /*
     * Get the procedure's name.
     */

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

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

    localCt = procPtr->numCompiledLocals;
    compiledLocals = (Var *) TclStackAlloc(interp, localCt*sizeof(Var));
    framePtr->numCompiledLocals = localCt;
    framePtr->compiledLocals = compiledLocals;

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

	/*
	 * "Normal" arguments; last formal is special, depends on
	 * it being 'args'.
	 */	
	Tcl_Obj *objPtr = objv[i];
	varPtr->value.objPtr = objPtr;
	Tcl_IncrRefCount(objPtr);  /* local var is a reference */
	varPtr->id.name = localPtr->name;
	varPtr->refCount = 0;
	varPtr->tracePtr = NULL;
	varPtr->searchPtr = NULL;
	varPtr->flags = localPtr->flags;

	varPtr++;
	localPtr = localPtr->nextPtr;
    }
    for (; i < numArgs; i++) {
	/*
	 * This loop is entered if argCt < (numArgs-1).
	 * Set default values; last formal is special.
	 */
	if (localPtr->defValuePtr != NULL) {
	    Tcl_Obj *objPtr = localPtr->defValuePtr;

	    varPtr->value.objPtr = objPtr;
	    Tcl_IncrRefCount(objPtr);  /* local var is a reference */
	    varPtr->id.name = localPtr->name;
	    varPtr->refCount = 0;
	    varPtr->tracePtr = NULL;
	    varPtr->searchPtr = NULL;
	    varPtr->flags = localPtr->flags;
	    varPtr++;
	    localPtr = localPtr->nextPtr;
	} else {
	    goto incorrectArgs;
	}
    }

	    TclDecrRefCount(desiredObjs[i]);
	}
#endif /* AVOID_HACKS_FOR_ITCL */
	ckfree((char *) desiredObjs);
	goto procDone;
    }

    varPtr->id.name = localPtr->name;
    varPtr->refCount = 0;
    varPtr->tracePtr = NULL;
    varPtr->searchPtr = NULL;
    varPtr->flags = localPtr->flags;


    localPtr = localPtr->nextPtr;
    varPtr++;

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