/* * Var.java * * Copyright (c) 1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and * redistribution of this file, and for a DISCLAIMER OF ALL * WARRANTIES. * * Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart * * RCS @(#) $Id: Var.java,v 1.11 2003/01/09 02:15:39 mdejong Exp $ * */ using System; using System.Collections; using System.Text; namespace tcl.lang { /// Flag bits for variables. The first three (SCALAR, ARRAY, and /// LINK) are mutually exclusive and give the "type" of the variable. /// UNDEFINED is independent of the variable's type. /// /// SCALAR - 1 means this is a scalar variable and not /// an array or link. The value field points /// to the variable's value, a Tcl object. /// ARRAY - 1 means this is an array variable rather /// than a scalar variable or link. The /// table field points to the array's /// hashtable for its elements. /// LINK - 1 means this Var structure contains a /// reference to another Var structure that /// either has the real value or is itself /// another LINK pointer. Variables like /// this come about through "upvar" and "global" /// commands, or through references to variables /// in enclosing namespaces. /// UNDEFINED - 1 means that the variable is in the process /// of being deleted. An undefined variable /// logically does not exist and survives only /// while it has a trace, or if it is a global /// variable currently being used by some /// procedure. /// IN_HASHTABLE - 1 means this variable is in a hashtable. 0 if /// a local variable that was assigned a slot /// in a procedure frame by the compiler so the /// Var storage is part of the call frame. /// TRACE_ACTIVE - 1 means that trace processing is currently /// underway for a read or write access, so /// new read or write accesses should not cause /// trace procedures to be called and the /// variable can't be deleted. /// ARRAY_ELEMENT - 1 means that this variable is an array /// element, so it is not legal for it to be /// an array itself (the ARRAY flag had /// better not be set). /// NAMESPACE_VAR - 1 means that this variable was declared /// as a namespace variable. This flag ensures /// it persists until its namespace is /// destroyed or until the variable is unset; /// it will persist even if it has not been /// initialized and is marked undefined. /// The variable's refCount is incremented to /// reflect the "reference" from its namespace. /// /// [Flags()] public enum VarFlags { SCALAR = 0x1, ARRAY = 0x2, LINK = 0x4, UNDEFINED = 0x8, IN_HASHTABLE = 0x10, TRACE_ACTIVE = 0x20, ARRAY_ELEMENT = 0x40, NAMESPACE_VAR = 0x80, SQLITE3_LINK_INT = 0x100, SQLITE3_LINK_DOUBLE = 0x200, SQLITE3_LINK_BOOLEAN = 0x400, SQLITE3_LINK_STRING = 0x800, SQLITE3_LINK_WIDE_INT = 0x1000, SQLITE3_LINK = 0x10000, SQLITE3_LINK_READ_ONLY = 0x20000, }; /* * Implements variables in Tcl. The Var class encapsulates most of the functionality * of the methods in generic/tclVar.c and the structure TCL.Tcl_Var from the C version. */ public class Var { /// Used by ArrayCmd to create a unique searchId string. If the /// sidVec Vector is empty then simply return 1. Else return 1 /// plus the SearchId.index value of the last Object in the vector. /// /// /// None /// /// The int value for unique SearchId string. /// protected internal int NextIndex { get { lock ( this ) { if ( sidVec.Count == 0 ) { return 1; } SearchId sid = (SearchId)SupportClass.VectorLastElement( sidVec ); return ( sid.Index + 1 ); } } } // internal const int SCALAR = 0x1; // internal const int ARRAY = 0x2; // internal const int LINK = 0x4; // internal const int UNDEFINED = 0x8; // internal const int IN_HASHTABLE = 0x10; // internal const int TRACE_ACTIVE = 0x20; // internal const int ARRAY_ELEMENT = 0x40; // internal const int NAMESPACE_VAR = 0x80; // Methods to read various flag bits of variables. internal bool isVarScalar() { return ( ( flags & VarFlags.SCALAR ) != 0 ); } internal bool isVarLink() { return ( ( flags & VarFlags.LINK ) != 0 ); } internal bool isVarArray() { return ( ( flags & VarFlags.ARRAY ) != 0 ); } internal bool isVarUndefined() { return ( ( flags & VarFlags.UNDEFINED ) != 0 ); } internal bool isVarArrayElement() { return ( ( flags & VarFlags.ARRAY_ELEMENT ) != 0 ); } // Methods to ensure that various flag bits are set properly for variables. internal void setVarScalar() { flags = ( flags & ~( VarFlags.ARRAY | VarFlags.LINK ) ) | VarFlags.SCALAR; } internal void setVarArray() { flags = ( flags & ~( VarFlags.SCALAR | VarFlags.LINK ) ) | VarFlags.ARRAY; } internal void setVarLink() { flags = ( flags & ~( VarFlags.SCALAR | VarFlags.ARRAY ) ) | VarFlags.LINK; } internal void setVarArrayElement() { flags = ( flags & ~VarFlags.ARRAY ) | VarFlags.ARRAY_ELEMENT; } internal void setVarUndefined() { flags |= VarFlags.UNDEFINED; } internal void clearVarUndefined() { flags &= ~VarFlags.UNDEFINED; } /// Stores the "value" of the variable. It stored different information /// depending on the type of the variable: /// internal Object value; /// Vector that holds the traces that were placed in this Var internal ArrayList traces; internal ArrayList sidVec; /// Miscellaneous bits of information about variable. /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// /// internal VarFlags flags; /// If variable is in a hashtable, either the /// hash table entry that refers to this /// variable or null if the variable has been /// detached from its hash table (e.g. an /// array is deleted, but some of its /// elements are still referred to in /// upvars). null if the variable is not in a /// hashtable. This is used to delete an /// variable from its hashtable if it is no /// longer needed. /// internal Hashtable table; /// The key under which this variable is stored in the hash table. internal string hashKey; /// Counts number of active uses of this /// variable, not including its entry in the /// call frame or the hash table: 1 for each /// additional variable whose link points /// here, 1 for each nested trace active on /// variable, and 1 if the variable is a /// namespace variable. This record can't be /// deleted until refCount becomes 0. /// internal int refCount; /// Reference to the namespace that contains /// this variable or null if the variable is /// a local variable in a Tcl procedure. /// internal NamespaceCmd.Namespace ns; public class SQLITE3_GETSET { string name = ""; int _Integer = 0; // Internal integer value StringBuilder _StringBuilder = null; // Internal string value public SQLITE3_GETSET( string name ) { this._Integer = 0; this._StringBuilder = new StringBuilder( 500 ); this.name = name; } public int iValue { get { return _Integer; } set { _Integer = value; } } public string sValue { get { return _StringBuilder.ToString(); } set { _StringBuilder.Length = 0; _StringBuilder.Append( value ); } } public void Append( byte[] append ) { _StringBuilder.Append( Encoding.UTF8.GetString( append, 0, append.Length ) ); } public void Append( string append ) { _StringBuilder.Append( append ); } public void Trim() { _StringBuilder = new StringBuilder( _StringBuilder.ToString().Trim() ); } public int Length { get { return _StringBuilder.Length; } } } /// Reference to the object the allows getting & setting the sqlite3 linked variable /// internal object sqlite3_get_set; internal TclObject sqlite3_get() { TclObject to; if ( ( flags & VarFlags.SQLITE3_LINK_READ_ONLY ) != 0 && ( flags & VarFlags.SQLITE3_LINK_INT ) != 0 ) if ( sqlite3_get_set.GetType().Name == "Int32" ) to = TclInteger.newInstance( (Int32)sqlite3_get_set ); else to = TclInteger.newInstance( ( (SQLITE3_GETSET)sqlite3_get_set ).iValue ); else if ( ( flags & VarFlags.SQLITE3_LINK_INT ) != 0 ) { if ( sqlite3_get_set.GetType().Name == "Int32" ) to = TclInteger.newInstance( (Int32)sqlite3_get_set ); else to = TclInteger.newInstance( ( (SQLITE3_GETSET)sqlite3_get_set ).iValue ); } else to = TclString.newInstance( ( (SQLITE3_GETSET)sqlite3_get_set ).sValue ); to.preserve(); return to; } internal void sqlite3_set( TclObject to ) { if ( ( flags & VarFlags.SQLITE3_LINK_READ_ONLY ) == 0 ) { if ( ( flags & VarFlags.SQLITE3_LINK_INT ) != 0 ) ( (SQLITE3_GETSET)sqlite3_get_set ).iValue = Convert.ToInt32( to.ToString() ); else if ( ( flags & VarFlags.SQLITE3_LINK_STRING ) != 0 ) ( (SQLITE3_GETSET)sqlite3_get_set ).sValue = to.ToString(); else ( (SQLITE3_GETSET)sqlite3_get_set ).sValue = to.ToString(); } } internal bool isSQLITE3_Link() { return ( ( flags & VarFlags.SQLITE3_LINK ) != 0 ); } /// NewVar -> Var /// /// Construct a variable and initialize its fields. /// internal Var() { value = null; //name = null; // Like hashKey in Jacl ns = null; hashKey = null; // Like hPtr in the C implementation table = null; // Like hPtr in the C implementation refCount = 0; traces = null; //search = null; sidVec = null; // Like search in the C implementation flags = ( VarFlags.SCALAR | VarFlags.UNDEFINED | VarFlags.IN_HASHTABLE ); } /// Used to create a String that describes this variable /// /// public override string ToString() { StringBuilder sb = new StringBuilder(); sb.Append( ns ); if ( sb.Length == 2 ) { // It is in the global namespace sb.Append( hashKey ); } else { // It is not in the global namespaces sb.Append( "::" ); sb.Append( hashKey ); } return sb.ToString(); } /// Find the SearchId that in the sidVec Vector that is equal the /// unique String s and returns the enumeration associated with /// that SearchId. /// /// /// String that ia a unique identifier for a SearchId object /// /// Enumeration if a match is found else null. /// protected internal SearchId getSearch( string s ) { SearchId sid; for ( int i = 0; i < sidVec.Count; i++ ) { sid = (SearchId)sidVec[i]; if ( sid.equals( s ) ) { return sid; } } return null; } /// Find the SearchId object in the sidVec Vector and remove it. /// /// /// String that ia a unique identifier for a SearchId object. /// protected internal bool removeSearch( string sid ) { SearchId curSid; for ( int i = 0; i < sidVec.Count; i++ ) { curSid = (SearchId)sidVec[i]; if ( curSid.equals( sid ) ) { sidVec.RemoveAt( i ); return true; } } return false; } // End of the instance method for the Var class, the rest of the methods // are Var related methods ported from the code in generic/tclVar.c // The strings below are used to indicate what went wrong when a // variable access is denied. internal const string noSuchVar = "no such variable"; internal const string isArray = "variable is array"; internal const string needArray = "variable isn't array"; internal const string noSuchElement = "no such element in array"; internal const string danglingElement = "upvar refers to element in deleted array"; internal const string danglingVar = "upvar refers to variable in deleted namespace"; internal const string badNamespace = "parent namespace doesn't exist"; internal const string missingName = "missing variable name"; /// TclLookupVar -> lookupVar /// /// This procedure is used by virtually all of the variable /// code to locate a variable given its name(s). /// /// /// if part2 isn't NULL, this is the name of an array. /// Otherwise, this is a full variable name that could include /// a parenthesized array elemnt or a scalar. /// /// Name of an element within array, or null. /// /// Only the TCL.VarFlag.GLOBAL_ONLY bit matters. /// /// Verb to use in error messages, e.g. "read" or "set". /// /// OR'ed combination of CRT_PART1 and CRT_PART2. /// Tells which entries to create if they don't already exist. /// /// true if an exception should be throw if the /// variable cannot be found. /// /// a two element array. a[0] is the variable indicated by /// part1 and part2, or null if the variable couldn't be /// found and throwException is false. ///

/// If the variable is found, a[1] is the array that /// contains the variable (or null if the variable is a scalar). /// If the variable can't be found and either createPart1 or /// createPart2 are true, a new as-yet-undefined (VAR_UNDEFINED) /// variable instance is created, entered into a hash /// table, and returned. /// Note: it's possible that var.value of the returned variable /// may be null (variable undefined), even if createPart1 or createPart2 /// are true (these only cause the hash table entry or array to be created). /// For example, the variable might be a global that has been unset but /// is still referenced by a procedure, or a variable that has been unset /// but it only being kept in existence by a trace. /// /// TclException if the variable cannot be found and /// throwException is true. /// /// internal static Var[] lookupVar( Interp interp, string part1, string part2, TCL.VarFlag flags, string msg, bool createPart1, bool createPart2 ) { CallFrame varFrame = interp.varFrame; // Reference to the procedure call frame whose // variables are currently in use. Same as // the current procedure's frame, if any, // unless an "uplevel" is executing. Hashtable table; // to the hashtable, if any, in which // to look up the variable. Var var; // Used to search for global names. string elName; // Name of array element or null. int openParen; // If this procedure parses a name into // array and index, these point to the // parens around the index. Otherwise they // are -1. These are needed to restore // the parens after parsing the name. NamespaceCmd.Namespace varNs, cxtNs; int p; int i, result; var = null; openParen = -1; varNs = null; // set non-null if a nonlocal variable // 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) elName = part2; int len = part1.Length; for ( p = 0; p < len; p++ ) { if ( part1[p] == '(' ) { openParen = p; p = len - 1; if ( part1[p] == ')' ) { if ( (System.Object)part2 != null ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, msg, needArray ); } return null; } elName = part1.Substring( openParen + 1, ( len - 1 ) - ( openParen + 1 ) ); part2 = elName; // same as elName, only used in error reporting part1 = part1.Substring( 0, ( openParen ) - ( 0 ) ); } break; } } // If this namespace has a variable resolver, then give it first // crack at the variable resolution. It may return a Var // value, it may signal to continue onward, or it may signal // an error. if ( ( ( flags & TCL.VarFlag.GLOBAL_ONLY ) != 0 ) || ( interp.varFrame == null ) ) { cxtNs = interp.globalNs; } else { cxtNs = interp.varFrame.ns; } if ( cxtNs.resolver != null || interp.resolvers != null ) { try { if ( cxtNs.resolver != null ) { var = cxtNs.resolver.resolveVar( interp, part1, cxtNs, flags ); } else { var = null; } if ( var == null && interp.resolvers != null ) { IEnumerator enum_Renamed = interp.resolvers.GetEnumerator(); foreach ( Interp.ResolverScheme res in interp.resolvers ) { var = res.resolver.resolveVar( interp, part1, cxtNs, flags ); if ( var != null ) break; } } } catch ( TclException e ) { var = null; } } // Look up part1. Look it up as either a namespace variable or as a // local variable in a procedure call frame (varFrame). // Interpret part1 as a namespace variable if: // 1) so requested by a TCL.VarFlag.GLOBAL_ONLY or TCL.VarFlag.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 varFrame's local var hashtable. if ( ( ( flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) != 0 ) || ( varFrame == null ) || !varFrame.isProcCallFrame || ( part1.IndexOf( "::" ) != -1 ) ) { string tail; // Don't pass TCL.VarFlag.LEAVE_ERR_MSG, we may yet create the variable, // or otherwise generate our own error! var = NamespaceCmd.findNamespaceVar( interp, part1, null, flags & ~TCL.VarFlag.LEAVE_ERR_MSG ); if ( var == null ) { if ( createPart1 ) { // var wasn't found so create it // Java does not support passing an address so we pass // an array of size 1 and then assign arr[0] to the value NamespaceCmd.Namespace[] varNsArr = new NamespaceCmd.Namespace[1]; NamespaceCmd.Namespace[] dummyArr = new NamespaceCmd.Namespace[1]; string[] tailArr = new string[1]; NamespaceCmd.getNamespaceForQualName( interp, part1, null, flags, varNsArr, dummyArr, dummyArr, tailArr ); // Get the values out of the arrays! varNs = varNsArr[0]; tail = tailArr[0]; if ( varNs == null ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, msg, badNamespace ); } return null; } if ( (System.Object)tail == null ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, msg, missingName ); } return null; } var = new Var(); varNs.varTable.Add( tail, var ); // There is no hPtr member in Jacl, The hPtr combines the table // and the key used in a table lookup. var.hashKey = tail; var.table = varNs.varTable; var.ns = varNs; } else { // var wasn't found and not to create it if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, msg, noSuchVar ); } return null; } } } else { // local var: look in frame varFrame // removed code block that searches for local compiled vars if ( var == null ) { // look in the frame's var hash table table = varFrame.varTable; if ( createPart1 ) { if ( table == null ) { table = new Hashtable(); varFrame.varTable = table; } var = (Var)table[part1]; if ( var == null ) { // we are adding a new entry var = new Var(); SupportClass.PutElement( table, part1, var ); // There is no hPtr member in Jacl, The hPtr combines // the table and the key used in a table lookup. var.hashKey = part1; var.table = table; var.ns = null; // a local variable } } else { if ( table != null ) { var = (Var)table[part1]; } if ( var == null ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, msg, noSuchVar ); } return null; } } } } // If var is a link variable, we have a reference to some variable // that was created through an "upvar" or "global" command. Traverse // through any links until we find the referenced variable. while ( var.isVarLink() ) { var = (Var)var.value; } // If we're not dealing with an array element, return var. if ( (System.Object)elName == null ) { var ret = new Var[2]; ret[0] = var; ret[1] = null; return ret; } // We're dealing with an array element. Make sure the variable is an // array and look up the element (create the element if desired). if ( var.isVarUndefined() && !var.isVarArrayElement() ) { if ( !createPart1 ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, msg, noSuchVar ); } return null; } // Make sure we are not resurrecting a namespace variable from a // deleted namespace! if ( ( ( var.flags & VarFlags.IN_HASHTABLE ) != 0 ) && ( var.table == null ) ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, msg, danglingVar ); } return null; } var.setVarArray(); var.clearVarUndefined(); var.value = new Hashtable(); } else if ( !var.isVarArray() ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, msg, needArray ); } return null; } Var arrayVar = var; Hashtable arrayTable = (Hashtable)var.value; if ( createPart2 ) { Var searchvar = (Var)arrayTable[elName]; if ( searchvar == null ) { // new entry if ( var.sidVec != null ) { deleteSearches( var ); } var = new Var(); SupportClass.PutElement( arrayTable, elName, var ); // There is no hPtr member in Jacl, The hPtr combines the table // and the key used in a table lookup. var.hashKey = elName; var.table = arrayTable; var.ns = varNs; var.setVarArrayElement(); } else { var = searchvar; } } else { var = (Var)arrayTable[elName]; if ( var == null ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, msg, noSuchElement ); } return null; } } var ret2 = new Var[2]; ret2[0] = var; // The Var in the array ret2[1] = arrayVar; // The array (Hashtable) Var return ret2; } ///

Query the value of a variable whose name is stored in a Tcl object. /// /// /// the interp that holds the variable /// /// name of the variable. /// /// misc flags that control the actions of this method. /// /// the value of the variable. /// internal static TclObject getVar( Interp interp, TclObject nameObj, TCL.VarFlag flags ) { return getVar( interp, nameObj.ToString(), null, flags ); } /// Query the value of a variable. /// /// /// the interp that holds the variable /// /// name of the variable. /// /// misc flags that control the actions of this method. /// /// the value of the variable. /// internal static TclObject getVar( Interp interp, string name, TCL.VarFlag flags ) { return getVar( interp, name, null, flags ); } /// Tcl_ObjGetVar2 -> getVar /// /// Query the value of a variable. /// /// /// the interp that holds the variable /// /// 1st part of the variable name. /// /// 2nd part of the variable name. /// /// misc flags that control the actions of this method. /// /// the value of the variable. /// internal static TclObject getVar( Interp interp, TclObject part1Obj, TclObject part2Obj, TCL.VarFlag flags ) { string part1, part2; part1 = part1Obj.ToString(); if ( part2Obj != null ) { part2 = part2Obj.ToString(); } else { part2 = null; } return getVar( interp, part1, part2, flags ); } /// TCL.Tcl_GetVar2Ex -> getVar /// /// Query the value of a variable, given a two-part name consisting /// of array name and element within array. /// /// /// the interp that holds the variable /// /// 1st part of the variable name. /// /// 2nd part of the variable name. /// /// misc flags that control the actions of this method. /// /// the value of the variable. /// internal static TclObject getVar( Interp interp, string part1, string part2, TCL.VarFlag flags ) { Var[] result = lookupVar( interp, part1, part2, flags, "read", false, true ); if ( result == null ) { // lookupVar() returns null only if TCL.VarFlag.LEAVE_ERR_MSG is // not part of the flags argument, return null in this case. 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( interp, array, var, part1, part2, ( flags & ( TCL.VarFlag.NAMESPACE_ONLY | TCL.VarFlag.GLOBAL_ONLY ) ) | TCL.VarFlag.TRACE_READS ); if ( (System.Object)msg != null ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, "read", msg ); } return null; } } if ( var.isVarScalar() && !var.isVarUndefined() ) { return (TclObject)var.value; } if ( var.isSQLITE3_Link() ) return var.sqlite3_get(); if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { string msg; if ( var.isVarUndefined() && ( array != null ) && !array.isVarUndefined() ) { msg = noSuchElement; } else if ( var.isVarArray() ) { msg = isArray; } else { msg = noSuchVar; } throw new TclVarException( interp, part1, part2, "read", msg ); } } 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.isVarUndefined() ) { cleanupVar( var, array ); } } return null; } /// Set a variable whose name is stored in a Tcl object. /// /// /// the interp that holds the variable /// /// name of the variable. /// /// the new value for the variable /// /// misc flags that control the actions of this method. /// internal static TclObject setVar( Interp interp, TclObject nameObj, TclObject value, TCL.VarFlag flags ) { return setVar( interp, nameObj.ToString(), null, value, flags ); } /// Set a variable. /// /// /// the interp that holds the variable /// /// name of the variable. /// /// the new value for the variable /// /// misc flags that control the actions of this method /// internal static TclObject setVar( Interp interp, string name, TclObject value, TCL.VarFlag flags ) { return setVar( interp, name, null, value, flags ); } /// Tcl_ObjSetVar2 -> setVar /// /// Set the value of a variable. /// /// /// the interp that holds the variable /// /// 1st part of the variable name. /// /// 2nd part of the variable name. /// /// the new value for the variable /// /// misc flags that control the actions of this method /// internal static TclObject setVar( Interp interp, TclObject part1Obj, TclObject part2Obj, TclObject newValue, TCL.VarFlag flags ) { string part1, part2; part1 = part1Obj.ToString(); if ( part2Obj != null ) { part2 = part2Obj.ToString(); } else { part2 = null; } return setVar( interp, part1, part2, newValue, flags ); } /// TCL.Tcl_SetVar2Ex -> setVar /// /// Given a two-part variable name, which may refer either to a scalar /// variable or an element of an array, change the value of the variable /// to a new Tcl object value. If the named scalar or array or element /// doesn't exist then create one. /// /// /// the interp that holds the variable /// /// 1st part of the variable name. /// /// 2nd part of the variable name. /// /// the new value for the variable /// /// misc flags that control the actions of this method /// /// Returns a pointer to the TclObject holding the new value of the /// variable. If the write operation was disallowed because an array was /// expected but not found (or vice versa), then null is returned; if /// the TCL.VarFlag.LEAVE_ERR_MSG flag is set, then an exception will be raised. /// Note that the returned object may not be the same one referenced /// by newValue because variable traces may modify the variable's value. /// The value of the given variable is set. If either the array or the /// entry didn't exist then a new variable is created. /// /// The reference count is decremented for any old value of the variable /// and incremented for its new value. If the new value for the variable /// is not the same one referenced by newValue (perhaps as a result /// of a variable trace), then newValue's ref count is left unchanged /// by TCL.Tcl_SetVar2Ex. newValue's ref count is also left unchanged if /// we are appending it as a string value: that is, if "flags" includes /// TCL.VarFlag.APPEND_VALUE but not TCL.VarFlag.LIST_ELEMENT. /// /// The reference count for the returned object is _not_ incremented: if /// you want to keep a reference to the object you must increment its /// ref count yourself. /// internal static TclObject setVar( Interp interp, string part1, string part2, TclObject newValue, TCL.VarFlag flags ) { Var var; Var array; TclObject oldValue; string bytes; Var[] result = lookupVar( interp, part1, part2, flags, "set", true, true ); if ( result == null ) { return null; } var = result[0]; array = result[1]; // If the variable is in a hashtable and its table field is null, then we // may have an upvar to an array element where the array was deleted // or an upvar to a namespace variable whose namespace was deleted. // Generate an error (allowing the variable to be reset would screw up // our storage allocation and is meaningless anyway). if ( ( ( var.flags & VarFlags.IN_HASHTABLE ) != 0 ) && ( var.table == null ) ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { if ( var.isVarArrayElement() ) { throw new TclVarException( interp, part1, part2, "set", danglingElement ); } else { throw new TclVarException( interp, part1, part2, "set", danglingVar ); } } return null; } // It's an error to try to set an array variable itself. if ( var.isVarArray() && !var.isVarUndefined() ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, "set", isArray ); } return null; } // At this point, if we were appending, we used to call read traces: we // treated append as a read-modify-write. However, it seemed unlikely to // us that a real program would be interested in such reads being done // during a set operation. // Set the variable's new value. If appending, append the new value to // the variable, either as a list element or as a string. Also, if // appending, then if the variable's old value is unshared we can modify // it directly, otherwise we must create a new copy to modify: this is // "copy on write". try { if ( var.isSQLITE3_Link() ) { var.sqlite3_set( newValue ); return var.sqlite3_get(); } else { oldValue = (TclObject)var.value; if ( ( flags & TCL.VarFlag.APPEND_VALUE ) != 0 ) { if ( var.isVarUndefined() && ( oldValue != null ) ) { oldValue.release(); // discard old value var.value = null; oldValue = null; } if ( ( flags & TCL.VarFlag.LIST_ELEMENT ) != 0 ) { // append list element if ( oldValue == null ) { oldValue = TclList.newInstance(); var.value = oldValue; oldValue.preserve(); // since var is referenced } else if ( oldValue.Shared ) { // append to copy var.value = oldValue.duplicate(); oldValue.release(); oldValue = (TclObject)var.value; oldValue.preserve(); // since var is referenced } TclList.append( interp, oldValue, newValue ); } else { // append string // We append newValuePtr's bytes but don't change its ref count. bytes = newValue.ToString(); if ( oldValue == null ) { var.value = TclString.newInstance( bytes ); ( (TclObject)var.value ).preserve(); } else { if ( oldValue.Shared ) { // append to copy var.value = oldValue.duplicate(); oldValue.release(); oldValue = (TclObject)var.value; oldValue.preserve(); // since var is referenced } TclString.append( oldValue, newValue ); } } } else { if ( ( flags & TCL.VarFlag.LIST_ELEMENT ) != 0 ) { // set var to list element int listFlags; // We set the variable to the result of converting newValue's // string rep to a list element. We do not change newValue's // ref count. if ( oldValue != null ) { oldValue.release(); // discard old value } bytes = newValue.ToString(); listFlags = Util.scanElement( interp, bytes ); oldValue = TclString.newInstance( Util.convertElement( bytes, listFlags ) ); var.value = oldValue; ( (TclObject)var.value ).preserve(); } else if ( newValue != oldValue ) { var.value = newValue.duplicate(); ( (TclObject)var.value ).preserve(); // var is another ref if ( oldValue != null ) { oldValue.release(); // discard old value } } } var.setVarScalar(); var.clearVarUndefined(); if ( array != null ) { array.clearVarUndefined(); } // Invoke any write traces for the variable. if ( ( var.traces != null ) || ( ( array != null ) && ( array.traces != null ) ) ) { string msg = callTraces( interp, array, var, part1, part2, ( flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) | TCL.VarFlag.TRACE_WRITES ); if ( (System.Object)msg != null ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, "set", msg ); } return null; // Same as "goto cleanup" in C verison } } // Return the variable's value unless the variable was changed in some // gross way by a trace (e.g. it was unset and then recreated as an // array). if ( var.isVarScalar() && !var.isVarUndefined() ) { return (TclObject)var.value; } // A trace changed the value in some gross way. Return an empty string // object. 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.isVarUndefined() ) { cleanupVar( var, array ); } } } /// TclIncrVar2 -> incrVar /// /// Given a two-part variable name, which may refer either to a scalar /// variable or an element of an array, increment the Tcl object value /// of the variable by a specified amount. /// /// /// 1st part of the variable name. /// /// 2nd part of the variable name. /// /// Amount to be added to variable. /// /// misc flags that control the actions of this method /// /// Results: /// Returns a reference to the TclObject holding the new value of the /// variable. If the specified variable doesn't exist, or there is a /// clash in array usage, or an error occurs while executing variable /// traces, then a TclException will be raised. /// /// Side effects: /// The value of the given variable is incremented by the specified /// amount. If either the array or the entry didn't exist then a new /// variable is created. The ref count for the returned object is _not_ /// incremented to reflect the returned reference; if you want to keep a /// reference to the object you must increment its ref count yourself. /// /// ---------------------------------------------------------------------- /// internal static TclObject incrVar( Interp interp, TclObject part1, TclObject part2, int incrAmount, TCL.VarFlag flags ) { TclObject varValue = null; bool createdNewObj; // Set to true if var's value object is shared // so we must increment a copy (i.e. copy // on write). int i; bool err; // There are two possible error conditions that depend on the setting of // TCL.VarFlag.LEAVE_ERR_MSG. an exception could be raised or null could be returned err = false; try { varValue = getVar( interp, part1, part2, flags ); } catch ( TclException e ) { err = true; throw; } finally { // FIXME : is this the correct way to catch the error? if ( err || varValue == null ) interp.addErrorInfo( "\n (reading value of variable to increment)" ); } // Increment the variable's value. If the object is unshared we can // modify it directly, otherwise we must create a new copy to modify: // this is "copy on write". Then free the variable's old string // representation, if any, since it will no longer be valid. createdNewObj = false; if ( varValue.Shared ) { varValue = varValue.duplicate(); createdNewObj = true; } try { i = TclInteger.get( interp, varValue ); } catch ( TclException e ) { if ( createdNewObj ) { varValue.release(); // free unneeded copy } throw; } TclInteger.set( varValue, ( i + incrAmount ) ); // Store the variable's new value and run any write traces. return setVar( interp, part1, part2, varValue, flags ); } /// Unset a variable whose name is stored in a Tcl object. /// /// /// name of the variable. /// /// misc flags that control the actions of this method. /// internal static void unsetVar( Interp interp, TclObject nameObj, TCL.VarFlag flags ) { unsetVar( interp, nameObj.ToString(), null, flags ); } /// Unset a variable. /// /// /// name of the variable. /// /// misc flags that control the actions of this method. /// internal static void unsetVar( Interp interp, string name, TCL.VarFlag flags ) { unsetVar( interp, name, null, flags ); } /// TCL.Tcl_UnsetVar2 -> unsetVar /// /// Unset a variable, given a two-part name consisting of array /// name and element within array. /// /// /// 1st part of the variable name. /// /// 2nd part of the variable name. /// /// misc flags that control the actions of this method. /// /// If part1 and part2 indicate a local or global variable in interp, /// it is deleted. If part1 is an array name and part2 is null, then /// the whole array is deleted. /// /// internal static void unsetVar( Interp interp, string part1, string part2, TCL.VarFlag flags ) { Var dummyVar; Var var; Var array; //ActiveVarTrace active; TclObject obj; TCL.CompletionCode result; // FIXME : what about the null return vs exception thing here? Var[] lookup_result = lookupVar( interp, part1, part2, flags, "unset", false, false ); if ( lookup_result == null ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) throw new TclRuntimeError( "unexpected null reference" ); else return; } var = lookup_result[0]; array = lookup_result[1]; result = ( var.isVarUndefined() ? TCL.CompletionCode.ERROR : TCL.CompletionCode.OK ); if ( ( array != null ) && ( array.sidVec != null ) ) { deleteSearches( array ); } // 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 Var structure as undefined. // 2. Invoke traces and clean up the variable, using the dummy 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). dummyVar = new Var(); //FIXME: Var class really should implement clone to make a bit copy. dummyVar.value = var.value; dummyVar.traces = var.traces; dummyVar.flags = var.flags; dummyVar.hashKey = var.hashKey; dummyVar.table = var.table; dummyVar.refCount = var.refCount; dummyVar.ns = var.ns; var.setVarUndefined(); var.setVarScalar(); var.value = null; // dummyVar points to any value object var.traces = null; var.sidVec = null; // Call trace procedures for the variable being deleted. Then delete // its traces. Be sure to abort any other traces for the variable // that are still pending. Special tricks: // 1. We need to increment var's refCount around this: CallTraces // will use dummyVar so it won't increment var's refCount itself. // 2. Turn off the 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 &= ~VarFlags.TRACE_ACTIVE; callTraces( interp, array, dummyVar, part1, part2, ( flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) | TCL.VarFlag.TRACE_UNSETS ); dummyVar.traces = null; // Active trace stuff is not part of Jacl's interp 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 it is a scalar, "discard" its object // (decrement the ref count of its object, if any). if ( dummyVar.isVarArray() && !dummyVar.isVarUndefined() ) { deleteArray( interp, part1, dummyVar, ( flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) | TCL.VarFlag.TRACE_UNSETS ); } if ( dummyVar.isVarScalar() && ( dummyVar.value != null ) ) { obj = (TclObject)dummyVar.value; obj.release(); dummyVar.value = null; } // If the variable was a namespace variable, decrement its reference count. if ( ( var.flags & VarFlags.NAMESPACE_VAR ) != 0 ) { var.flags &= ~VarFlags.NAMESPACE_VAR; var.refCount--; } // Finally, if the variable is truly not in use then free up its Var // structure and remove it from its hash table, if any. The ref count of // its value object, if any, was decremented above. cleanupVar( var, array ); // It's an error to unset an undefined variable. if ( result != TCL.CompletionCode.OK ) { if ( ( flags & TCL.VarFlag.LEAVE_ERR_MSG ) != 0 ) { throw new TclVarException( interp, part1, part2, "unset", ( ( array == null ) ? noSuchVar : noSuchElement ) ); } } } /// Trace a variable whose name is stored in a Tcl object. /// /// /// name of the variable. /// /// the trace to add. /// /// misc flags that control the actions of this method. /// internal static void traceVar( Interp interp, TclObject nameObj, TCL.VarFlag flags, VarTrace proc ) { traceVar( interp, nameObj.ToString(), null, flags, proc ); } /// Trace a variable. /// /// /// name of the variable. /// /// the trace to add. /// /// misc flags that control the actions of this method. /// internal static void traceVar( Interp interp, string name, TCL.VarFlag flags, VarTrace proc ) { traceVar( interp, name, null, flags, proc ); } /// TCL.Tcl_TraceVar2 -> traceVar /// /// Trace a variable, given a two-part name consisting of array /// name and element within array. /// /// /// 1st part of the variable name. /// /// 2nd part of the variable name. /// /// misc flags that control the actions of this method. /// /// the trace to comand to add. /// internal static void traceVar( Interp interp, string part1, string part2, TCL.VarFlag flags, VarTrace proc ) { Var[] result; Var var, array; // FIXME: what about the exception problem here? result = lookupVar( interp, part1, part2, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ), "trace", true, true ); if ( result == null ) { throw new TclException( interp, "" ); } var = result[0]; array = result[1]; // Set up trace information. if ( var.traces == null ) { var.traces = new ArrayList( 10 ); } var rec = new TraceRecord(); rec.trace = proc; rec.flags = flags & ( TCL.VarFlag.TRACE_READS | TCL.VarFlag.TRACE_WRITES | TCL.VarFlag.TRACE_UNSETS | TCL.VarFlag.TRACE_ARRAY ); var.traces.Insert( 0, rec ); // FIXME: is this needed ?? It was in Jacl but not 8.1 /* // When inserting a trace for an array on an UNDEFINED variable, // the search IDs for that array are reset. if (array != null && var.isVarUndefined()) { array.sidVec = null; } */ } /// Untrace a variable whose name is stored in a Tcl object. /// /// /// name of the variable. /// /// the trace to delete. /// /// misc flags that control the actions of this method. /// internal static void untraceVar( Interp interp, TclObject nameObj, TCL.VarFlag flags, VarTrace proc ) { untraceVar( interp, nameObj.ToString(), null, flags, proc ); } /// Untrace a variable. /// /// /// name of the variable. /// /// the trace to delete. /// /// misc flags that control the actions of this method. /// internal static void untraceVar( Interp interp, string name, TCL.VarFlag flags, VarTrace proc ) { untraceVar( interp, name, null, flags, proc ); } /// TCL.Tcl_UntraceVar2 -> untraceVar /// /// Untrace a variable, given a two-part name consisting of array /// name and element within array. This will Remove a /// previously-created trace for a variable. /// /// /// Interpreter containing variable. /// /// 1st part of the variable name. /// /// 2nd part of the variable name. /// /// misc flags that control the actions of this method. /// /// the trace to delete. /// internal static void untraceVar( Interp interp, string part1, string part2, TCL.VarFlag flags, VarTrace proc ) { Var[] result = null; Var var; try { result = lookupVar( interp, part1, part2, flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ), null, false, false ); if ( result == null ) { return; } } catch ( TclException e ) { // FIXME: check for problems in exception in lookupVar // We have set throwException argument to false in the // lookupVar() call, so an exception should never be // thrown. throw new TclRuntimeError( "unexpected TclException: " + e.Message, e ); } var = result[0]; if ( var.traces != null ) { int len = var.traces.Count; for ( int i = 0; i < len; i++ ) { TraceRecord rec = (TraceRecord)var.traces[i]; if ( rec.trace == proc ) { var.traces.RemoveAt( i ); break; } } } // If this is the last trace on the variable, and the variable is // unset and unused, then free up the variable. if ( var.isVarUndefined() ) { cleanupVar( var, null ); } } /// TCL.Tcl_VarTraceInfo -> getTraces /// /// /// Interpreter containing variable. /// /// name of the variable. /// /// flags that control the actions of this method. /// /// the Vector of traces of a variable. /// static protected internal ArrayList getTraces( Interp interp, string name, TCL.VarFlag flags ) { return getTraces( interp, name, null, flags ); } /// TCL.Tcl_VarTraceInfo2 -> getTraces /// /// /// the list of traces of a variable. /// /// /// Interpreter containing variable. /// /// 1st part of the variable name. /// /// 2nd part of the variable name (can be null). /// /// misc flags that control the actions of this method. /// static protected internal ArrayList getTraces( Interp interp, string part1, string part2, TCL.VarFlag flags ) { Var[] result; result = lookupVar( interp, part1, part2, flags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ), null, false, false ); if ( result == null ) { return null; } return result[0].traces; } /// MakeUpvar -> makeUpvar /// /// Create a reference of a variable in otherFrame in the current /// CallFrame, given a two-part name consisting of array name and /// element within array. /// /// /// Interp containing the variables /// /// CallFrame containing "other" variable. /// null means use global context. /// /// the 1st part name of the variable in the "other" frame. /// /// the 2nd part name of the variable in the "other" frame. /// /// the flags for scaope of "other" variable /// /// Name of scalar variable which will refer to otherP1/otherP2. /// /// only the TCL.VarFlag.GLOBAL_ONLY bit matters, /// indicating the scope of myName. /// /// TclException if the upvar cannot be created. /// protected internal static void makeUpvar( Interp interp, CallFrame frame, string otherP1, string otherP2, TCL.VarFlag otherFlags, string myName, TCL.VarFlag myFlags ) { Var other, var, array; Var[] result; CallFrame varFrame; CallFrame savedFrame = null; Hashtable table; NamespaceCmd.Namespace ns, altNs; string tail; bool newvar = false; // Find "other" in "frame". If not looking up other in just the // current namespace, temporarily replace the current var frame // pointer in the interpreter in order to use TclLookupVar. if ( ( otherFlags & TCL.VarFlag.NAMESPACE_ONLY ) == 0 ) { savedFrame = interp.varFrame; interp.varFrame = frame; } result = lookupVar( interp, otherP1, otherP2, ( otherFlags | TCL.VarFlag.LEAVE_ERR_MSG ), "access", true, true ); if ( ( otherFlags & TCL.VarFlag.NAMESPACE_ONLY ) == 0 ) { interp.varFrame = savedFrame; } other = result[0]; array = result[1]; if ( other == null ) { // FIXME : leave error message thing again throw new TclRuntimeError( "unexpected null reference" ); } // Now create a hashtable entry for "myName". Create it as either a // namespace variable or as a local variable in a procedure call // frame. Interpret myName as a namespace variable if: // 1) so requested by a TCL.VarFlag.GLOBAL_ONLY or TCL.VarFlag.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). // If creating myName in the active procedure, look in its // hashtable for runtime-created local variables. Create that // procedure's local variable hashtable if necessary. varFrame = interp.varFrame; if ( ( ( myFlags & ( TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.NAMESPACE_ONLY ) ) != 0 ) || ( varFrame == null ) || !varFrame.isProcCallFrame || ( myName.IndexOf( "::" ) != -1 ) ) { // Java does not support passing an address so we pass // an array of size 1 and then assign arr[0] to the value NamespaceCmd.Namespace[] nsArr = new NamespaceCmd.Namespace[1]; NamespaceCmd.Namespace[] altNsArr = new NamespaceCmd.Namespace[1]; NamespaceCmd.Namespace[] dummyNsArr = new NamespaceCmd.Namespace[1]; string[] tailArr = new string[1]; NamespaceCmd.getNamespaceForQualName( interp, myName, null, myFlags, nsArr, altNsArr, dummyNsArr, tailArr ); // Get the values out of the arrays! ns = nsArr[0]; altNs = altNsArr[0]; tail = tailArr[0]; if ( ns == null ) { ns = altNs; } if ( ns == null ) { throw new TclException( interp, "bad variable name \"" + myName + "\": unknown namespace" ); } // Check that we are not trying to create a namespace var linked to // a local variable in a procedure. If we allowed this, the local // variable in the shorter-lived procedure frame could go away // leaving the namespace var's reference invalid. if ( ( ( (System.Object)otherP2 != null ) ? array.ns : other.ns ) == null ) { throw new TclException( interp, "bad variable name \"" + myName + "\": upvar won't create namespace variable that refers to procedure variable" ); } // AKT var = (Var) ns.varTable.get(tail); var = (Var)ns.varTable[tail]; if ( var == null ) { // we are adding a new entry newvar = true; var = new Var(); // ATK ns.varTable.put(tail, var); ns.varTable.Add( tail, var ); // There is no hPtr member in Jacl, The hPtr combines the table // and the key used in a table lookup. var.hashKey = tail; var.table = ns.varTable; var.ns = ns; } } else { // Skip Compiled Local stuff var = null; if ( var == null ) { // look in frame's local var hashtable table = varFrame.varTable; if ( table == null ) { table = new Hashtable(); varFrame.varTable = table; } var = (Var)table[myName]; if ( var == null ) { // we are adding a new entry newvar = true; var = new Var(); SupportClass.PutElement( table, myName, var ); // There is no hPtr member in Jacl, The hPtr combines the table // and the key used in a table lookup. var.hashKey = myName; var.table = table; var.ns = varFrame.ns; } } } if ( !newvar ) { // The variable already exists. Make sure this variable "var" // isn't the same as "other" (avoid circular links). Also, if // it's not an upvar then it's an error. If it is an upvar, then // just disconnect it from the thing it currently refers to. if ( var == other ) { throw new TclException( interp, "can't upvar from variable to itself" ); } if ( var.isVarLink() ) { Var link = (Var)var.value; if ( link == other ) { return; } link.refCount--; if ( link.isVarUndefined() ) { cleanupVar( link, null ); } } else if ( !var.isVarUndefined() ) { throw new TclException( interp, "variable \"" + myName + "\" already exists" ); } else if ( var.traces != null ) { throw new TclException( interp, "variable \"" + myName + "\" has traces: can't use for upvar" ); } } var.setVarLink(); var.clearVarUndefined(); var.value = other; other.refCount++; return; } /* *---------------------------------------------------------------------- * * TCL.Tcl_GetVariableFullName -> getVariableFullName * * Given a Var token returned by NamespaceCmd.FindNamespaceVar, this * procedure appends to an object the namespace variable's full * name, qualified by a sequence of parent namespace names. * * Results: * None. * * Side effects: * The variable's fully-qualified name is returned. * *---------------------------------------------------------------------- */ internal static string getVariableFullName( Interp interp, Var var ) { StringBuilder buff = new StringBuilder(); // Add the full name of the containing namespace (if any), followed by // the "::" separator, then the variable name. if ( var != null ) { if ( !var.isVarArrayElement() ) { if ( var.ns != null ) { buff.Append( var.ns.fullName ); if ( var.ns != interp.globalNs ) { buff.Append( "::" ); } } // Jacl's Var class does not include the "name" member // We use the "hashKey" member which is equivalent if ( (System.Object)var.hashKey != null ) { buff.Append( var.hashKey ); } } } return buff.ToString(); } /// CallTraces -> callTraces /// /// This procedure is invoked to find and invoke relevant /// trace procedures associated with a particular operation on /// a variable. This procedure invokes traces both on the /// variable and on its containing array (where relevant). /// /// /// Interpreter containing variable. /// /// array variable that contains the variable, or null /// if the variable isn't an element of an array. /// /// Variable whose traces are to be invoked. /// /// the first part of a variable name. /// /// the second part of a variable name. /// /// Flags to pass to trace procedures: indicates /// what's happening to variable, plus other stuff like /// TCL.VarFlag.GLOBAL_ONLY, TCL.VarFlag.NAMESPACE_ONLY, and TCL.VarFlag.INTERP_DESTROYED. /// /// null if no trace procedures were invoked, or /// if all the invoked trace procedures returned successfully. /// The return value is non-null if a trace procedure returned an /// error (in this case no more trace procedures were invoked /// after the error was returned). In this case the return value /// is a pointer to a string describing the error. /// static protected internal string callTraces( Interp interp, Var array, Var var, string part1, string part2, TCL.VarFlag flags ) { TclObject oldResult; int i; // If there are already similar trace procedures active for the // variable, don't call them again. if ( ( var.flags & VarFlags.TRACE_ACTIVE ) != 0 ) { return null; } var.flags |= VarFlags.TRACE_ACTIVE; var.refCount++; // If the variable name hasn't been parsed into array name and // element, do it here. If there really is an array element, // make a copy of the original name so that nulls can be // inserted into it to separate the names (can't modify the name // string in place, because the string might get used by the // callbacks we invoke). // FIXME : come up with parsing code to use for all situations! if ( (System.Object)part2 == null ) { int len = part1.Length; if ( len > 0 ) { if ( part1[len - 1] == ')' ) { for ( i = 0; i < len - 1; i++ ) { if ( part1[i] == '(' ) { break; } } if ( i < len - 1 ) { if ( i < len - 2 ) { part2 = part1.Substring( i + 1, ( len - 1 ) - ( i + 1 ) ); part1 = part1.Substring( 0, ( i ) - ( 0 ) ); } } } } } oldResult = interp.getResult(); oldResult.preserve(); interp.resetResult(); try { // Invoke traces on the array containing the variable, if relevant. if ( array != null ) { array.refCount++; } if ( ( array != null ) && ( array.traces != null ) ) { for ( i = 0; ( array.traces != null ) && ( i < array.traces.Count ); i++ ) { TraceRecord rec = (TraceRecord)array.traces[i]; if ( ( rec.flags & flags ) != 0 ) { try { rec.trace.traceProc( interp, part1, part2, flags ); } catch ( TclException e ) { if ( ( flags & TCL.VarFlag.TRACE_UNSETS ) == 0 ) { return interp.getResult().ToString(); } } } } } // Invoke traces on the variable itself. if ( ( flags & TCL.VarFlag.TRACE_UNSETS ) != 0 ) { flags |= TCL.VarFlag.TRACE_DESTROYED; } for ( i = 0; ( var.traces != null ) && ( i < var.traces.Count ); i++ ) { TraceRecord rec = (TraceRecord)var.traces[i]; if ( ( rec.flags & flags ) != 0 ) { try { rec.trace.traceProc( interp, part1, part2, flags ); } catch ( TclException e ) { if ( ( flags & TCL.VarFlag.TRACE_UNSETS ) == 0 ) { return interp.getResult().ToString(); } } } } return null; } finally { if ( array != null ) { array.refCount--; } var.flags &= ~VarFlags.TRACE_ACTIVE; var.refCount--; interp.setResult( oldResult ); oldResult.release(); } } /// DeleteSearches -> deleteSearches /// /// This procedure is called to free up all of the searches /// associated with an array variable. /// /// /// Interpreter containing array. /// /// the array variable to delete searches from. /// static protected internal void deleteSearches( Var arrayVar ) // Variable whose searches are to be deleted. { arrayVar.sidVec = null; } /// TclDeleteVars -> deleteVars /// /// This procedure is called to recycle all the storage space /// associated with a table of variables. For this procedure /// to work correctly, it must not be possible for any of the /// variables in the table to be accessed from Tcl commands /// (e.g. from trace procedures). /// /// /// Interpreter containing array. /// /// Hashtbale that holds the Vars to delete /// static protected internal void deleteVars( Interp interp, Hashtable table ) { IEnumerator search; string hashKey; Var var; Var link; TCL.VarFlag flags; //ActiveVarTrace active; TclObject obj; NamespaceCmd.Namespace currNs = NamespaceCmd.getCurrentNamespace( interp ); // Determine what flags to pass to the trace callback procedures. flags = TCL.VarFlag.TRACE_UNSETS; if ( table == interp.globalNs.varTable ) { flags |= ( TCL.VarFlag.INTERP_DESTROYED | TCL.VarFlag.GLOBAL_ONLY ); } else if ( table == currNs.varTable ) { flags |= TCL.VarFlag.NAMESPACE_ONLY; } for ( search = table.Values.GetEnumerator(); search.MoveNext(); ) { var = (Var)search.Current; // 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.isVarLink() ) { link = (Var)var.value; link.refCount--; if ( ( link.refCount == 0 ) && link.isVarUndefined() && ( link.traces == null ) && ( ( link.flags & VarFlags.IN_HASHTABLE ) != 0 ) ) { if ( (System.Object)link.hashKey == null ) { var.value = null; // Drops reference to the link Var } else if ( link.table != table ) { SupportClass.HashtableRemove( link.table, link.hashKey ); link.table = null; // Drops the link var's table reference var.value = null; // Drops reference to the link Var } } } // 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). Note that we give callTraces the variable's // fully-qualified name so that any called trace procedures can // refer to these variables being deleted. if ( var.traces != null ) { string fullname = getVariableFullName( interp, var ); callTraces( interp, null, var, fullname, null, flags ); // The var.traces = null statement later will drop all the // references to the traces which will free them up } if ( var.isVarArray() ) { deleteArray( interp, var.hashKey, var, flags ); var.value = null; } if ( var.isVarScalar() && ( var.value != null ) ) { obj = (TclObject)var.value; obj.release(); var.value = null; } // There is no hPtr member in Jacl, The hPtr combines the table // and the key used in a table lookup. var.hashKey = null; var.table = null; var.traces = null; var.setVarUndefined(); var.setVarScalar(); // If the variable was a namespace variable, decrement its // reference count. We are in the process of destroying its // namespace so that namespace will no longer "refer" to the // variable. if ( ( var.flags & VarFlags.NAMESPACE_VAR ) != 0 ) { var.flags &= ~VarFlags.NAMESPACE_VAR; var.refCount--; } // Recycle the variable's memory space if there aren't any upvar's // pointing to it. If there are upvars to this variable, then the // variable will get freed when the last upvar goes away. if ( var.refCount == 0 ) { // When we drop the last reference it will be freeded } } table.Clear(); } /// DeleteArray -> deleteArray /// /// 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. /// /// /// Interpreter containing array. /// /// name of array (used for trace callbacks). /// /// the array variable to delete. /// /// Flags to pass to CallTraces. /// static protected internal void deleteArray( Interp interp, string arrayName, Var var, TCL.VarFlag flags ) { IEnumerator search; Var el; TclObject obj; deleteSearches( var ); Hashtable table = (Hashtable)var.value; Var dummyVar; for ( search = table.Values.GetEnumerator(); search.MoveNext(); ) { el = (Var)search.Current; if ( el.isVarScalar() && ( el.value != null ) ) { obj = (TclObject)el.value; obj.release(); el.value = null; } string tmpkey = (string)el.hashKey; // There is no hPtr member in Jacl, The hPtr combines the table // and the key used in a table lookup. el.hashKey = null; el.table = null; if ( el.traces != null ) { el.flags &= ~VarFlags.TRACE_ACTIVE; // FIXME : Old Jacl impl passed a dummy var to callTraces, should we? callTraces( interp, null, el, arrayName, tmpkey, flags ); el.traces = null; // Active trace stuff is not part of Jacl } el.setVarUndefined(); el.setVarScalar(); if ( el.refCount == 0 ) { // We are no longer using the element // element Vars are IN_HASHTABLE } } ( (Hashtable)var.value ).Clear(); var.value = null; } /// CleanupVar -> cleanupVar /// /// 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. /// /// /// variable that may be a candidate for being expunged. /// /// Array that contains the variable, or NULL if this /// variable isn't an array element. /// static protected internal void cleanupVar( Var var, Var array ) { if ( var.isVarUndefined() && ( var.refCount == 0 ) && ( var.traces == null ) && ( ( var.flags & VarFlags.IN_HASHTABLE ) != 0 ) ) { if ( var.table != null ) { SupportClass.HashtableRemove( var.table, var.hashKey ); var.table = null; var.hashKey = null; } } if ( array != null ) { if ( array.isVarUndefined() && ( array.refCount == 0 ) && ( array.traces == null ) && ( ( array.flags & VarFlags.IN_HASHTABLE ) != 0 ) ) { if ( array.table != null ) { SupportClass.HashtableRemove( array.table, array.hashKey ); array.table = null; array.hashKey = null; } } } } } // End of Var class }