/* * CallFrame.java * * Copyright (c) 1997 Cornell University. * Copyright (c) 1997-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: CallFrame.java,v 1.1.1.1 1998/10/14 21:09:20 cvsadmin Exp $ * */ package tcl.lang; import java.util.*; /** * This class implements a frame in the call stack. * * This class can be overridden to define new variable scoping rules for * the Tcl interpreter. */ class CallFrame { /* * Strings for making error messages. */ static final String noSuchVar = "no such variable"; static final String isArray = "variable is array"; static final String needArray = "variable isn't array"; static final String noSuchElement = "no such element in array"; static final String danglingUpvar = "upvar refers to element in deleted array"; /** * Used in flags for lookupVar(). Indicates that if part1 of the * variable doesn't exist, then it should be created. * * @see CallFrame#lookupVar */ protected static final int CRT_PART1 = 1; /** * Used in flags for lookupVar(). Indicates that if part2 of the * variable doesn't exist, then it should be created. * * @see CallFrame#lookupVar */ protected static final int CRT_PART2 = 2; /** * The interpreter associated with this call frame. */ protected Interp interp; /** * Stores the variables of this CallFrame. */ protected Hashtable varTable; /** * Stores the arguments of the procedure associated with this CallFrame. * Is null for global level. */ TclObject m_argv[]; /** * Value of interp.frame when this procedure was invoked * (i.e. next in stack of all active procedures). */ protected CallFrame caller; /** * Value of interp.varFrame when this procedure was invoked * (i.e. determines variable scoping within caller; same as * caller unless an "uplevel" command or something equivalent * was active in the caller). */ protected CallFrame callerVar; /** * Level of recursion. = 0 for the global level. */ protected int m_level; /** * Creates a CallFrame for the global variables. * @param interp current interpreter. */ CallFrame(Interp i) { interp = i; varTable = new Hashtable(); caller = null; callerVar = null; m_argv = null; m_level = 0; } /** * Creates a CallFrame. It changes the following (global) variables: * * @param ainterp current interpreter. * @param proc the procedure to invoke in this call frame. * @param argv the arguments to the procedure. * @exception TclException if error occurs in parameter bindings. */ CallFrame(Interp ainterp, Procedure proc, TclObject argv[]) throws TclException { interp = ainterp; varTable = new Hashtable(); try { chain(proc, argv); } catch (TclException e) { dispose(); throw e; } } /** * Chain this frame into the call frame stack and binds the parameters * values to the formal parameters of the procedure. * * @param proc the procedure. * @param proc argv the parameter values. * @exception TclException if wrong number of arguments. */ void chain(Procedure proc, TclObject argv[]) throws TclException { m_argv = argv; m_level = interp.varFrame.m_level + 1; caller = interp.frame; callerVar = interp.varFrame; interp.frame = this; interp.varFrame = this; /* * parameter bindings */ int numArgs = proc.argList.length; if ((!proc.isVarArgs) && (argv.length-1 > numArgs)) { throw new TclException(interp, "called \"" + argv[0] + "\" with too many arguments"); } int i, j; for (i=0, j=1; i * If the variable is found, a[1] is the array that * contains the variable (or null if the variable is a scalar). * Note: it's possible that var.value of the returned variable * may be null (variable undefined), even if CRT_PART1 and * CRT_PART2 are specified (these only cause the hash table * entry and/or array to be created). * @exception TclException if the variable cannot be found and * throwException is true. * */ Var[] lookupVar(String part1, String part2, int flags, String msg, int create, boolean throwException) throws TclException { Hashtable table; Var var; /* * Parse part1 into array name and index. * Always check if part1 is an array element name and allow it only if * part2 is not given. * (if one does not care about creating array elements that can't be used * from tcl, and prefer slightly better performance, one can put * the following in an if (part2 == NULL) { ... } block and remove * the part2's test and error reporting or move that code in array set) */ int len = part1.length(); if (len > 0) { if (part1.charAt(len-1) == ')') { int i = part1.indexOf('('); if (i != -1) { if (part2 != null) { throw new TclVarException(interp, part1, part2, msg, needArray); } char n1[]; char n2[]; if (i < len-2) { n1 = new char[i]; n2 = new char[len-2-i]; part1.getChars(0, i, n1, 0); part1.getChars(i+1, len-1, n2, 0); part1 = new String(n1); part2 = new String(n2); } } } } /* * Lookup part1. Look it up as either a namespace variable or as a * local variable in a procedure call frame (varFramePtr). * Interpret part1 as a namespace variable if: * 1) so requested by a TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY flag, * 2) there is no active frame (we're at the global :: scope), * 3) the active frame was pushed to define the namespace context * for a "namespace eval" or "namespace inscope" command, * 4) the name has namespace qualifiers ("::"s). * Otherwise, if part1 is a local variable, search first in the * frame's array of compiler-allocated local variables, then in its * hashtable for runtime-created local variables. * * If createPart1 and the variable isn't found, create the variable and, * if necessary, create varFramePtr's local var hashtable. */ if ((flags & TCL.GLOBAL_ONLY) != 0) { table = interp.globalFrame.varTable; } else { table = interp.varFrame.varTable; } if ((create & CRT_PART1) != 0) { var = (Var)table.get(part1); if (var == null) { var = new Var(); var.table = table; var.hashKey = part1; table.put(part1, var); } } else { var = (Var)table.get(part1); if (var == null) { if (throwException) { throw new TclVarException(interp, part1, part2, msg, noSuchVar); } return null; } } if ((var.flags & Var.UPVAR) != 0) { var = ((Var)var.value); } if (part2 == null) { Var[] ret = new Var[2]; ret[0] = var; ret[1] = null; return ret; } /* * We're dealing with an array element, so make sure the variable * is an array and lookup the element (create it if desired). */ if ((var.flags & Var.UNDEFINED) != 0) { if ((create & CRT_PART1) == 0) { if (throwException) { throw new TclVarException(interp, part1, part2, msg, noSuchVar); } return null; } var.flags = Var.ARRAY; var.value = new Hashtable(); } else if ((var.flags & Var.ARRAY) == 0) { if (throwException) { throw new TclVarException(interp, part1, part2, msg, needArray); } return null; } Var av = var; Hashtable arrayTable = (Hashtable)av.value; if ((create & CRT_PART2) != 0) { var = (Var)arrayTable.get(part2); if (var == null) { var = new Var(); var.table = arrayTable; var.hashKey = part2; arrayTable.put(part2, var); /* * We have added one new element into the array. Remove all * outstanding searches. */ var.sidVec = null; } } else { var = (Var)arrayTable.get(part2); if (var == null) { if (throwException) { throw new TclVarException(interp, part1, part2, msg, noSuchElement); } return null; } } Var[] ret = new Var[2]; ret[0] = var; ret[1] = av; return ret; } /** * Set a variable whose name is stored in a Tcl object. * * @param nameObj name of the variable. * @param value the new value for the variable * @param flags misc flags that control the actions of this method. */ TclObject setVar(TclObject nameObj, TclObject value, int flags) throws TclException { return setVar(nameObj.toString(), null, value, flags); } /** * Set a variable. * * @param name name of the variable. * @param value the new value for the variable * @param flags misc flags that control the actions of this method */ TclObject setVar(String name, TclObject value, int flags) throws TclException { return setVar(name, null, value, flags); } /** * Set a variable, given a two-part name consisting of array name and * element within array.. * * @param part1 1st part of the variable name. * @param part2 2nd part of the variable name. * @param tobj the new value for the variable * @param flags misc flags that control the actions of this method * * @return the value of the variable after the set operation. */ TclObject setVar(String part1, String part2, TclObject tobj, int flags) throws TclException { Var result[] = lookupVar(part1, part2, flags, "set", CRT_PART1|CRT_PART2, true); Var var = result[0]; Var array = result[1]; /* * If the variable's table field is null, it means that this is an * upvar to an array element where the array was deleted, leaving * the element dangling at the end of the upvar. Generate an error * (allowing the variable to be reset would screw up our storage * allocation and is meaningless anyway). */ if (var.table == null) { throw new TclVarException(interp, part1, part2, "set", danglingUpvar); } if ((var.flags & Var.ARRAY) != 0) { throw new TclVarException(interp, part1, part2, "set", isArray); } boolean hasTraces = ((var.traces != null) || ((array != null) && (array.traces != null))); try { /* * Call read trace if variable is being appended to. */ if (((flags & TCL.APPEND_VALUE) != 0) && hasTraces) { String msg = callTraces(array, var, part1, part2, (flags & TCL.GLOBAL_ONLY) | TCL.TRACE_READS); if (msg != null) { throw new TclVarException(interp, part1, part2, "read", msg); } } TclObject value = (TclObject)var.value; if (value == null) { if ((flags & TCL.LIST_ELEMENT) == 0) { value = tobj; value.preserve(); } else { value = TclList.newInstance(); value.preserve(); TclList.append(interp, value, tobj); } } else if ((flags & TCL.APPEND_VALUE) == 0) { if (value != tobj) { /* * Change to another value. */ value.release(); value = tobj; value.preserve(); } } else { /* * value != null && (flag & TCL.APPEND_VALUE) != 0 */ if ((flags & TCL.LIST_ELEMENT) == 0) { /* * A string append. */ value = value.takeExclusive(); TclString.append(value, tobj); } else { /* * A list append. */ value = value.takeExclusive(); TclList.append(interp, value, tobj); } } /* * If an array is being set, remove all search IDs associated * with this array UNLESS the array index is already defined. */ if ((array != null) && (var.flags & Var.UNDEFINED) != 0) { array.sidVec = null; } var.value = value; var.flags &= ~Var.UNDEFINED; /* * Invoke any write traces for the variable. */ if (hasTraces) { String msg = callTraces(array, var, part1, part2, (flags & TCL.GLOBAL_ONLY) | TCL.TRACE_WRITES); if (msg != null) { throw new TclVarException(interp, part1, part2, "set", msg); } } /* * If the variable was changed in some gross way by a trace (e.g. * it was unset and then recreated as an array) then just return * an empty string; otherwise return the variable's current * value. */ if ((var.flags & (Var.UNDEFINED|Var.UPVAR|Var.ARRAY)) == 0) { return (TclObject)(var.value); } else { return TclString.newInstance(""); } } finally { /* * If the variable doesn't exist anymore and no-one's using it, * then free up the relevant structures and hash table entries. */ if ((var.flags & Var.UNDEFINED) != 0) { cleanupVar(var, array); } } } /** * Query the value of a variable whose name is stored in a Tcl object. * * @param nameObj name of the variable. * @param flags misc flags that control the actions of this method. * @return the value of the variable. */ TclObject getVar(TclObject nameObj, int flags) throws TclException { return getVar(nameObj.toString(), null, flags); } /** * Query the value of a variable. * * @param name name of the variable. * @param flags misc flags that control the actions of this method. * @return the value of the variable. */ TclObject getVar(String name, int flags) throws TclException { return getVar(name, null, flags); } /** * Query the value of a variable, given a two-part name consisting * of array name and element within array. * * @param part1 1st part of the variable name. * @param part2 2nd part of the variable name. * @param flags misc flags that control the actions of this method. * @return the value of the variable. */ TclObject getVar(String part1, String part2, int flags) throws TclException { boolean throwException = ((flags & TCL.DONT_THROW_EXCEPTION) == 0); Var result[] = lookupVar(part1, part2, flags, "read", CRT_PART2, throwException); if (result == null) { /* * lookupVar() returns null only if throwException is true * and the variable cannot be found. We return null to * indicate error. */ return null; } Var var = result[0]; Var array = result[1]; try { /* * Invoke any traces that have been set for the variable. */ if ((var.traces != null) || ((array != null) && (array.traces != null))) { String msg = callTraces(array, var, part1, part2, (flags & TCL.GLOBAL_ONLY) | TCL.TRACE_READS); if (msg != null) { if (throwException) { throw new TclVarException(interp, part1, part2, "read", msg); } return null; } } if ((var.flags & (Var.UNDEFINED|Var.UPVAR|Var.ARRAY)) == 0) { return (TclObject)var.value; } if (throwException) { String msg; if (((var.flags & Var.UNDEFINED) != 0) && (array != null) && ((array.flags & Var.UNDEFINED) == 0)) { msg = noSuchElement; } else if ((var.flags & Var.ARRAY) != 0) { msg = isArray; } else { msg = noSuchVar; } throw new TclVarException(interp, part1, part2, "read", msg); } return null; } finally { /* * If the variable doesn't exist anymore and no-one's using it, * then free up the relevant structures and hash table entries. */ if ((var.flags & Var.UNDEFINED) != 0) { cleanupVar(var, array); } } } /** * Unset a variable whose name is stored in a Tcl object. * * @param nameObj name of the variable. * @param flags misc flags that control the actions of this method. */ void unsetVar(TclObject nameObj, int flags) throws TclException { unsetVar(nameObj.toString(), null, flags); } /** * Unset a variable. * * @param name name of the variable. * @param flags misc flags that control the actions of this method. */ void unsetVar(String name, int flags) throws TclException { unsetVar(name, null, flags); } /** * Unset a variable, given a two-part name consisting of array * name and element within array. * * @param part1 1st part of the variable name. * @param part2 2nd part of the variable name. * @param flags misc flags that control the actions of this method. */ void unsetVar(String part1, String part2, int flags) throws TclException { Var result[] = lookupVar(part1, part2, flags, "unset", 0, true); Var var = result[0]; Var array = result[1]; boolean undefined = ((var.flags & Var.UNDEFINED) != 0); if (array != null) { array.sidVec = null; } /* * The code below is tricky, because of the possibility that * a trace procedure might try to access a variable being * deleted. To handle this situation gracefully, do things * in three steps: * 1. Copy the contents of the variable to a dummy variable * structure, and mark the original structure as undefined. * 2. Invoke traces and clean up the variable, using the copy. * 3. If at the end of this the original variable is still * undefined and has no outstanding references, then delete * it (but it could have gotten recreated by a trace). */ if ((var.value != null) && (var.value instanceof TclObject)) { ((TclObject)(var.value)).release(); var.value = null; } Var dummyVar = new Var(); dummyVar.value = var.value; dummyVar.traces = var.traces; dummyVar.flags = var.flags; dummyVar.hashKey = var.hashKey; dummyVar.table = var.table; dummyVar.refCount = var.refCount; var.flags = Var.UNDEFINED; var.traces = null; var.value = null; var.sidVec = null; /* * Call trace procedures for the variable being deleted and delete * its traces. Be sure to abort any other traces for the variable * that are still pending. Special tricks: * 1. Increment var's refCount around this: callTraces() will * use dummyVar so it won't increment var's refCount. * 2. Turn off the Var.TRACE_ACTIVE flag in dummyVar: we want to * call unset traces even if other traces are pending. */ if ((dummyVar.traces != null) || ((array != null) && (array.traces != null))) { var.refCount++; dummyVar.flags &= ~Var.TRACE_ACTIVE; callTraces(array, dummyVar, part1, part2, (flags & TCL.GLOBAL_ONLY) | TCL.TRACE_UNSETS); dummyVar.traces = null; var.refCount--; } /* * If the variable is an array, delete all of its elements. This * must be done after calling the traces on the array, above (that's * the way traces are defined). */ if ((dummyVar.flags & Var.ARRAY) != 0) { deleteArray(part1, dummyVar, (flags & TCL.GLOBAL_ONLY) | TCL.TRACE_UNSETS); } /* * Finally, if the variable is truly not in use then free up its * record and remove it from the hash table. */ cleanupVar(var, array); if (undefined) { throw new TclVarException(interp, part1, part2, "unset", (array == null) ? noSuchVar : noSuchElement); } } /** * Trace a variable whose name is stored in a Tcl object. * * @param nameObj name of the variable. * @param trace the trace to add. * @param flags misc flags that control the actions of this method. */ void traceVar(TclObject nameObj, VarTrace trace, int flags) throws TclException { traceVar(nameObj.toString(), null, trace, flags); } /** * Trace a variable. * * @param name name of the variable. * @param trace the trace to add. * @param flags misc flags that control the actions of this method. */ void traceVar(String name, VarTrace trace, int flags) throws TclException { traceVar(name, null, trace, flags); } /** * Trace a variable, given a two-part name consisting of array * name and element within array. * * @param part1 1st part of the variable name. * @param part2 2nd part of the variable name. * @param trace the trace to add. * @param flags misc flags that control the actions of this method. */ void traceVar(String part1, String part2, VarTrace trace,int flags) throws TclException { Var result[], var, array; result = lookupVar(part1, part2, flags, "trace", CRT_PART1|CRT_PART2, true); var = result[0]; array = result[1]; if (var.traces == null) { var.traces = new Vector(); } TraceRecord rec = new TraceRecord(); rec.flags = flags; rec.trace = trace; var.traces.insertElementAt(rec, 0); /* * When inserting a trace for an array on an UNDEFINED variable, * the search IDs for that array are reset. */ if(array != null && (var.flags & Var.UNDEFINED) != 0) { array.sidVec = null; } } /** * Untrace a variable whose name is stored in a Tcl object. * * @param nameObj name of the variable. * @param trace the trace to delete. * @param flags misc flags that control the actions of this method. */ void untraceVar(TclObject nameObj, VarTrace trace, int flags) { untraceVar(nameObj.toString(), null, trace, flags); } /** * Untrace a variable. * * @param name name of the variable. * @param trace the trace to delete. * @param flags misc flags that control the actions of this method. */ void untraceVar(String name, VarTrace trace, int flags) { untraceVar(name, null, trace, flags); } /** * Untrace a variable, given a two-part name consisting of array * name and element within array. * * @param part1 1st part of the variable name. * @param part2 2nd part of the variable name. * @param trace the trace to delete. * @param flags misc flags that control the actions of this method. */ void untraceVar(String part1, String part2, VarTrace trace, int flags) { Var result[], var; try { result = lookupVar(part1, part2, flags, "trace", CRT_PART1|CRT_PART2, false); if (result == null) { return; } } catch (TclException e) { /* * We have set throwException argument to false in the * lookupVar() call, so an exception should never be * thrown. */ throw new TclRuntimeError("unexpected TclException: " + e); } var = result[0]; if (var.traces != null) { int len = var.traces.size(); for (int i=0; i 0) && (s.charAt(0) == '#')) { String sub = s.substring(1, s.length()); int j = Util.getInt(interp, sub); if (j < 0) { throw new TclException(interp, "bad level \"" + s + "\""); } i = m_level - j; } else { try { i = Util.getInt(interp, s); } catch (TclException e) { if (interp.varFrame == interp.globalFrame) { throw new TclException(interp, "bad level \"" + s + "\""); } return null; } } if (i < 0) { throw new TclException(interp, "bad level \"" + s + "\""); } CallFrame frame = interp.varFrame; for (int j=0; j 0) { if (part1.charAt(len-1) == ')') { int i; for (i=0; i * For this procedure to work correctly, it must not be possible * for any of the variable in the table to be accessed from Tcl * commands (e.g. from trace procedures). */ protected void dispose() { /* * Unchain this frame from the call stack. */ interp.frame = caller; interp.varFrame = callerVar; caller = null; callerVar = null; int flags = TCL.TRACE_UNSETS; if (this == interp.globalFrame) { flags |= TCL.INTERP_DESTROYED | TCL.GLOBAL_ONLY; } for (Enumeration e = varTable.elements(); e.hasMoreElements(); ) { Var var = (Var)e.nextElement(); /* * For global/upvar variables referenced in procedures, * decrement the reference count on the variable referred * to, and free the referenced variable if it's no longer * needed. Don't delete the hash entry for the other * variable if it's in the same table as us: this will * happen automatically later on. */ if ((var.flags & Var.UPVAR) != 0) { Var upvar = (Var)(var.value); upvar.refCount--; if ((upvar.refCount == 0) && ((upvar.flags & Var.UNDEFINED)!=0) && (upvar.traces == null)) { if ((upvar.table != null) && (upvar.table != varTable)) { /* * No need to remove upvar.value because it is already * undefined. */ upvar.table.remove(upvar.hashKey); upvar.table = null; } } } /* * Invoke traces on the variable that is being deleted, then * free up the variable's space (no need to free the hash entry * here, unless we're dealing with a global variable: the * hash entries will be deleted automatically when the whole * table is deleted). */ if (var.traces != null) { callTraces(null, var, var.hashKey, null, flags); } if ((var.flags & Var.ARRAY) != 0) { deleteArray(var.hashKey, var, flags); } else { if ((var.value != null) && (var.value instanceof TclObject)) { ((TclObject)var.value).release(); } } var.value = null; var.traces = null; var.flags = Var.UNDEFINED; var.table = null; var.hashKey= null; } varTable = null; } /** * This procedure is called to free up everything in an array * variable. It's the caller's responsibility to make sure * that the array is no longer accessible before this procedure * is called. * * @param arrayName name of array (used for trace callbacks). * @param var the array variable to delete. * @param flags Flags to pass to CallTraces: TCL.TRACE_UNSETS and * sometimes TCL.INTERP_DESTROYED and/or TCL.GLOBAL_ONLY. */ protected void deleteArray(String arrayName, Var var, int flags) { var.sidVec = null; Hashtable table = (Hashtable)var.value; Var dummyVar = null; for (Enumeration e1 = table.elements(); e1.hasMoreElements(); ) { Var el = (Var)e1.nextElement(); TclObject value = (TclObject)el.value; if (value != null) { value.release(); } el.table = null; if (el.traces != null) { if (dummyVar == null) { dummyVar = new Var(); } dummyVar.traces = el.traces; dummyVar.flags = el.flags; dummyVar.flags &= ~Var.TRACE_ACTIVE; el.traces = null; el.refCount ++; callTraces(null, dummyVar, arrayName, el.hashKey, flags); el.refCount --; } el.flags = Var.UNDEFINED; } var.value = null; } /** * This procedure is called when it looks like it may be OK * to free up the variable's record and hash table entry, and * those of its containing parent. It's called, for example, * when a trace on a variable deletes the variable. * * @param var variable that may be a candidate for being expunged. * @param array Array that contains the variable, or NULL if this * variable isn't an array element. */ protected void cleanupVar(Var var, Var array) { if (((var.flags & Var.UNDEFINED) != 0) && (var.refCount == 0) && (var.traces == null)) { if (var.table != null) { var.table.remove(var.hashKey); var.table = null; } } if (array != null) { if (((array.flags & Var.UNDEFINED) != 0) && (array.refCount == 0) && (array.traces == null)) { if (array.table != null) { array.table.remove(array.hashKey); array.table = null; } } } } }