/* 
 * 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.6 2005/04/14 18:39:10 msofer Exp $
 * RCS: @(#) $Id: tclProc.c,v 1.73.2.7 2005/06/13 01:46:15 msofer Exp $
 */

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

/*
 * Prototypes for static functions in this file

 * field, encoding the type of level reference in ptr1 and the actual
 * parsed out offset in ptr2.
 *
 * Uses the default behaviour throughout, and never disposes of the
 * string rep; it's just a cache type.
 */

Tcl_ObjType tclLevelReferenceType = {
static Tcl_ObjType levelReferenceType = {
    "levelReference",
    NULL, NULL, NULL, NULL
};

/*
 *----------------------------------------------------------------------
 *

    /*
     * Parse object to figure out which level number to go to.
     */

    result = 1;
    curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
    if (objPtr->typePtr == &tclLevelReferenceType) {
    if (objPtr->typePtr == &levelReferenceType) {
	if ((int) objPtr->internalRep.twoPtrValue.ptr1) {
	    level = curLevel - (int) objPtr->internalRep.twoPtrValue.ptr2;
	} else {
	    level = (int) objPtr->internalRep.twoPtrValue.ptr2;
	}
	if (level < 0) {
	    goto levelError;

	    if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
		goto levelError;
	    }
	    /*
	     * Cache for future reference.
	     */
	    TclFreeIntRep(objPtr);
	    objPtr->typePtr = &tclLevelReferenceType;
	    objPtr->typePtr = &levelReferenceType;
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 0;
	    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
	} else if (isdigit(UCHAR(*name))) { /* INTL: digit */
	    if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
		return -1;
	    }
	    /*
	     * Cache for future reference.
	     */
	    TclFreeIntRep(objPtr);
	    objPtr->typePtr = &tclLevelReferenceType;
	    objPtr->typePtr = &levelReferenceType;
	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) 1;
	    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) level;
	    level = curLevel - level;
	} else {
	    /*
	     * Don't cache as the object *isn't* a level reference.
	     */

    iPtr->returnLevel--;
    if (iPtr->returnLevel < 0) {
	Tcl_Panic("TclUpdateReturnInfo: negative return level");
    }
    if (iPtr->returnLevel == 0) {
	/* Now we've reached the level to return the requested -code */
	return iPtr->returnCode;
	code = iPtr->returnCode;
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *