/*
 * 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.
 * Copyright (c) 2004-2006 Miguel Sofer
 *
 * 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.127 2007/08/04 18:32:27 msofer Exp $
 * RCS: @(#) $Id: tclProc.c,v 1.128 2007/08/08 18:34:40 msofer Exp $
 */

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

/*
 * Prototypes for static functions in this file

    Var *varPtr,
    Namespace *nsPtr)		/* Pointer to current namespace. */
{
    Interp *iPtr = (Interp *) interp;
    int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
    CompiledLocal *firstLocalPtr, *localPtr;
    int varNum;
    Tcl_ResolvedVarInfo *resVarInfo;
	

    /*
     * Find the localPtr corresponding to varPtr
     */

    varNum = varPtr - iPtr->framePtr->compiledLocals;
    localPtr = iPtr->framePtr->procPtr->firstLocalPtr;
    while (varNum--) {
	localPtr = localPtr->nextPtr;
    }

    /*
        //FIXME: old bytecompiled code: drop whatever flags are coming in (except
        //maybe for VAR_TEMPORARY? Who cares really?) A job for tbcload, not us.
    */
    
    if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) {
	/*
	 * 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.
	 */

    doInitCompiledLocals:
	if (!haveResolvers) {
	    /*
	     * Should not be called: deadwood.
	     */
	    
	    for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
		varPtr->flags = localPtr->flags;
		varPtr->value.objPtr = NULL;
	    }
	for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
	    varPtr->flags = 0;
	    varPtr->value.objPtr = NULL;
	    
	    return;
	} else {
	    Tcl_ResolvedVarInfo *resVarInfo;

	    for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
		varPtr->flags = localPtr->flags;
		varPtr->value.objPtr = NULL;

		/*
		 * 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) {
			VarHashRefCount(resolvedVarPtr)++;
			varPtr->flags = VAR_LINK;
			varPtr->value.linkPtr = resolvedVarPtr;
		    }
		}
	    }
	    return;
	}
    } else {
	/*
	 * This is the first run after a recompile, or else the resolver epoch
	 * has changed: update the resolver cache.
	 */

	firstLocalPtr = localPtr;
	for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
	    if (localPtr->resolveInfo) {
		if (localPtr->resolveInfo->deleteProc) {
		    localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
		} else {
		    ckfree((char *) localPtr->resolveInfo);
		}
		localPtr->resolveInfo = NULL;
	    }
	    localPtr->flags &= ~VAR_RESOLVED;

	    if (haveResolvers &&
		    !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
		ResolverScheme *resPtr = iPtr->resolverPtr;
		Tcl_ResolvedVarInfo *vinfo;
		int result;

		if (nsPtr->compiledVarResProc) {
		    result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
			    localPtr->name, localPtr->nameLength,
			    (Tcl_Namespace *) nsPtr, &vinfo);
		} else {
		    result = TCL_CONTINUE;
		}
	    /*
	     * 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) {
		    VarHashRefCount(resolvedVarPtr)++;
		    varPtr->flags = VAR_LINK;
		    varPtr->value.linkPtr = resolvedVarPtr;
		}
	    }
	}
	return;
    }

    /*
     * This is the first run after a recompile, or else the resolver epoch
     * has changed: update the resolver cache.
     */
    
    firstLocalPtr = localPtr;
    for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
	if (localPtr->resolveInfo) {
	    if (localPtr->resolveInfo->deleteProc) {
		localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
	    } else {
		ckfree((char *) localPtr->resolveInfo);
	    }
	    localPtr->resolveInfo = NULL;
	}
	localPtr->flags &= ~VAR_RESOLVED;
	
	if (haveResolvers &&
		!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
	    ResolverScheme *resPtr = iPtr->resolverPtr;
	    Tcl_ResolvedVarInfo *vinfo;
	    int result;
	    
	    if (nsPtr->compiledVarResProc) {
		result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
			localPtr->name, localPtr->nameLength,
			(Tcl_Namespace *) nsPtr, &vinfo);
	    } else {
		result = TCL_CONTINUE;
	    }

		while ((result == TCL_CONTINUE) && resPtr) {
		    if (resPtr->compiledVarResProc) {
			result = (*resPtr->compiledVarResProc)(nsPtr->interp,
				localPtr->name, localPtr->nameLength,
				(Tcl_Namespace *) nsPtr, &vinfo);
		    }
		    resPtr = resPtr->nextPtr;
		}
		if (result == TCL_OK) {
		    localPtr->resolveInfo = vinfo;
		    localPtr->flags |= VAR_RESOLVED;
		}
	    }
	}
	localPtr = firstLocalPtr;
	codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
	goto doInitCompiledLocals;
	    while ((result == TCL_CONTINUE) && resPtr) {
		if (resPtr->compiledVarResProc) {
		    result = (*resPtr->compiledVarResProc)(nsPtr->interp,
			    localPtr->name, localPtr->nameLength,
			    (Tcl_Namespace *) nsPtr, &vinfo);
		}
		resPtr = resPtr->nextPtr;
	    }
	    if (result == TCL_OK) {
		localPtr->resolveInfo = vinfo;
		localPtr->flags |= VAR_RESOLVED;
	    }
	}
    }
    localPtr = firstLocalPtr;
    codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
    goto doInitCompiledLocals;
    }
}

void
TclFreeLocalCache(
    Tcl_Interp *interp,
    LocalCache *localCachePtr)
{