/TCL/src/base/Var.cs
C# | 2476 lines | 1298 code | 322 blank | 856 comment | 384 complexity | ec8718890f57b9b9f6bb101cdb5b9eb8 MD5 | raw file
- /*
- * 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
- * $Header$
- * 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
- {
- /// <summary> 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.
- ///
- /// </summary>
- [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
- {
- /// <summary> 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.
- ///
- /// </summary>
- /// <param name="">None
- /// </param>
- /// <returns> The int value for unique SearchId string.
- /// </returns>
- 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;
- }
- /// <summary> Stores the "value" of the variable. It stored different information
- /// depending on the type of the variable: <ul>
- /// <li>Scalar variable - (TclObject) value is the object stored in the
- /// variable.
- /// <li> Array variable - (Hashtable) value is the hashtable that stores
- /// all the elements. <p>
- /// <li> Upvar (Link) - (Var) value is the variable associated by this upvar.
- /// </ul>
- /// </summary>
- internal Object value;
- /// <summary> Vector that holds the traces that were placed in this Var</summary>
- internal ArrayList traces;
- internal ArrayList sidVec;
- /// <summary> Miscellaneous bits of information about variable.
- ///
- /// </summary>
- /// <seealso cref="Var#SCALAR">
- /// </seealso>
- /// <seealso cref="Var#ARRAY">
- /// </seealso>
- /// <seealso cref="Var#LINK">
- /// </seealso>
- /// <seealso cref="Var#UNDEFINED">
- /// </seealso>
- /// <seealso cref="Var#IN_HASHTABLE">
- /// </seealso>
- /// <seealso cref="Var#TRACE_ACTIVE">
- /// </seealso>
- /// <seealso cref="Var#ARRAY_ELEMENT">
- /// </seealso>
- /// <seealso cref="Var#NAMESPACE_VAR">
- /// </seealso>
- internal VarFlags flags;
- /// <summary> 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.
- /// </summary>
- internal Hashtable table;
- /// <summary> The key under which this variable is stored in the hash table.</summary>
- internal string hashKey;
- /// <summary> 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.
- /// </summary>
- internal int refCount;
- /// <summary> Reference to the namespace that contains
- /// this variable or null if the variable is
- /// a local variable in a Tcl procedure.
- /// </summary>
- 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 ) );
- }
- public void Append( string append )
- {
- _StringBuilder.Append( append );
- }
- public void Trim()
- {
- _StringBuilder = new StringBuilder( _StringBuilder.ToString().Trim() );
- }
- public int Length
- {
- get { return _StringBuilder.Length; }
- }
- }
- /// <summary> Reference to the object the allows getting & setting the sqlite3 linked variable
- /// </summary>
- 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 );
- }
- /// <summary> NewVar -> Var
- ///
- /// Construct a variable and initialize its fields.
- /// </summary>
- 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 );
- }
- /// <summary> Used to create a String that describes this variable
- ///
- /// </summary>
- public override string ToString()
- {
- System.Text.StringBuilder sb = new System.Text.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();
- }
- /// <summary> Find the SearchId that in the sidVec Vector that is equal the
- /// unique String s and returns the enumeration associated with
- /// that SearchId.
- ///
- /// </summary>
- /// <param name="s">String that ia a unique identifier for a SearchId object
- /// </param>
- /// <returns> Enumeration if a match is found else null.
- /// </returns>
- 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;
- }
- /// <summary> Find the SearchId object in the sidVec Vector and remove it.
- ///
- /// </summary>
- /// <param name="sid">String that ia a unique identifier for a SearchId object.
- /// </param>
- 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";
- /// <summary> TclLookupVar -> lookupVar
- ///
- /// This procedure is used by virtually all of the variable
- /// code to locate a variable given its name(s).
- ///
- /// </summary>
- /// <param name="part1">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.
- /// </param>
- /// <param name="part2">Name of an element within array, or null.
- /// </param>
- /// <param name="flags">Only the TCL.VarFlag.GLOBAL_ONLY bit matters.
- /// </param>
- /// <param name="msg">Verb to use in error messages, e.g. "read" or "set".
- /// </param>
- /// <param name="create">OR'ed combination of CRT_PART1 and CRT_PART2.
- /// Tells which entries to create if they don't already exist.
- /// </param>
- /// <param name="throwException">true if an exception should be throw if the
- /// variable cannot be found.
- /// </param>
- /// <returns> 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.
- /// <p>
- /// 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.
- /// </returns>
- /// <exception cref=""> TclException if the variable cannot be found and
- /// throwException is true.
- ///
- /// </exception>
- 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;
- }
- /// <summary> Query the value of a variable whose name is stored in a Tcl object.
- ///
- /// </summary>
- /// <param name="interp">the interp that holds the variable
- /// </param>
- /// <param name="nameObj">name of the variable.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- /// <returns> the value of the variable.
- /// </returns>
- internal static TclObject getVar( Interp interp, TclObject nameObj, TCL.VarFlag flags )
- {
- return getVar( interp, nameObj.ToString(), null, flags );
- }
- /// <summary> Query the value of a variable.
- ///
- /// </summary>
- /// <param name="interp">the interp that holds the variable
- /// </param>
- /// <param name="name">name of the variable.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- /// <returns> the value of the variable.
- /// </returns>
- internal static TclObject getVar( Interp interp, string name, TCL.VarFlag flags )
- {
- return getVar( interp, name, null, flags );
- }
- /// <summary> Tcl_ObjGetVar2 -> getVar
- ///
- /// Query the value of a variable.
- ///
- /// </summary>
- /// <param name="interp">the interp that holds the variable
- /// </param>
- /// <param name="part1">1st part of the variable name.
- /// </param>
- /// <param name="part2">2nd part of the variable name.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- /// <returns> the value of the variable.
- /// </returns>
- 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 );
- }
- /// <summary> TCL.Tcl_GetVar2Ex -> getVar
- ///
- /// Query the value of a variable, given a two-part name consisting
- /// of array name and element within array.
- ///
- /// </summary>
- /// <param name="interp">the interp that holds the variable
- /// </param>
- /// <param name="part1">1st part of the variable name.
- /// </param>
- /// <param name="part2">2nd part of the variable name.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- /// <returns> the value of the variable.
- /// </returns>
- 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;
- }
- /// <summary> Set a variable whose name is stored in a Tcl object.
- ///
- /// </summary>
- /// <param name="interp">the interp that holds the variable
- /// </param>
- /// <param name="nameObj">name of the variable.
- /// </param>
- /// <param name="value">the new value for the variable
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- internal static TclObject setVar( Interp interp, TclObject nameObj, TclObject value, TCL.VarFlag flags )
- {
- return setVar( interp, nameObj.ToString(), null, value, flags );
- }
- /// <summary> Set a variable.
- ///
- /// </summary>
- /// <param name="interp">the interp that holds the variable
- /// </param>
- /// <param name="name">name of the variable.
- /// </param>
- /// <param name="value">the new value for the variable
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method
- /// </param>
- internal static TclObject setVar( Interp interp, string name, TclObject value, TCL.VarFlag flags )
- {
- return setVar( interp, name, null, value, flags );
- }
- /// <summary> Tcl_ObjSetVar2 -> setVar
- ///
- /// Set the value of a variable.
- ///
- /// </summary>
- /// <param name="interp">the interp that holds the variable
- /// </param>
- /// <param name="part1">1st part of the variable name.
- /// </param>
- /// <param name="part2">2nd part of the variable name.
- /// </param>
- /// <param name="newValue">the new value for the variable
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method
- /// </param>
- 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 );
- }
- /// <summary> 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.
- ///
- /// </summary>
- /// <param name="interp">the interp that holds the variable
- /// </param>
- /// <param name="part1">1st part of the variable name.
- /// </param>
- /// <param name="part2">2nd part of the variable name.
- /// </param>
- /// <param name="newValue">the new value for the variable
- /// </param>
- /// <param name="flags">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.
- /// </param>
- 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 );
- }
- }
- }
- /// <summary> 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.
- ///
- /// </summary>
- /// <param name="part1">1st part of the variable name.
- /// </param>
- /// <param name="part2">2nd part of the variable name.
- /// </param>
- /// <param name="incrAmount">Amount to be added to variable.
- /// </param>
- /// <param name="flags">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.
- ///
- /// ----------------------------------------------------------------------
- /// </param>
- 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 );
- }
- /// <summary> Unset a variable whose name is stored in a Tcl object.
- ///
- /// </summary>
- /// <param name="nameObj">name of the variable.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- internal static void unsetVar( Interp interp, TclObject nameObj, TCL.VarFlag flags )
- {
- unsetVar( interp, nameObj.ToString(), null, flags );
- }
- /// <summary> Unset a variable.
- ///
- /// </summary>
- /// <param name="name">name of the variable.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- internal static void unsetVar( Interp interp, string name, TCL.VarFlag flags )
- {
- unsetVar( interp, name, null, flags );
- }
- /// <summary> TCL.Tcl_UnsetVar2 -> unsetVar
- ///
- /// Unset a variable, given a two-part name consisting of array
- /// name and element within array.
- ///
- /// </summary>
- /// <param name="part1">1st part of the variable name.
- /// </param>
- /// <param name="part2">2nd part of the variable name.
- /// </param>
- /// <param name="flags">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.
- ///
- /// </param>
- 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 ) );
- }
- }
- }
- /// <summary> Trace a variable whose name is stored in a Tcl object.
- ///
- /// </summary>
- /// <param name="nameObj">name of the variable.
- /// </param>
- /// <param name="trace">the trace to add.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- internal static void traceVar( Interp interp, TclObject nameObj, TCL.VarFlag flags, VarTrace proc )
- {
- traceVar( interp, nameObj.ToString(), null, flags, proc );
- }
- /// <summary> Trace a variable.
- ///
- /// </summary>
- /// <param name="name">name of the variable.
- /// </param>
- /// <param name="trace">the trace to add.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- internal static void traceVar( Interp interp, string name, TCL.VarFlag flags, VarTrace proc )
- {
- traceVar( interp, name, null, flags, proc );
- }
- /// <summary> TCL.Tcl_TraceVar2 -> traceVar
- ///
- /// Trace a variable, given a two-part name consisting of array
- /// name and element within array.
- ///
- /// </summary>
- /// <param name="part1">1st part of the variable name.
- /// </param>
- /// <param name="part2">2nd part of the variable name.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- /// <param name="trace">the trace to comand to add.
- /// </param>
- 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 );
- }
- TraceRecord 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;
- }
- */
- }
- /// <summary> Untrace a variable whose name is stored in a Tcl object.
- ///
- /// </summary>
- /// <param name="nameObj">name of the variable.
- /// </param>
- /// <param name="trace">the trace to delete.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- internal static void untraceVar( Interp interp, TclObject nameObj, TCL.VarFlag flags, VarTrace proc )
- {
- untraceVar( interp, nameObj.ToString(), null, flags, proc );
- }
- /// <summary> Untrace a variable.
- ///
- /// </summary>
- /// <param name="name">name of the variable.
- /// </param>
- /// <param name="trace">the trace to delete.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- internal static void untraceVar( Interp interp, string name, TCL.VarFlag flags, VarTrace proc )
- {
- untraceVar( interp, name, null, flags, proc );
- }
- /// <summary> 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.
- ///
- /// </summary>
- /// <param name="interp">Interpreter containing variable.
- /// </param>
- /// <param name="part1">1st part of the variable name.
- /// </param>
- /// <param name="part2">2nd part of the variable name.
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- /// <param name="proc">the trace to delete.
- /// </param>
- 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 );
- }
- }
- /// <summary> TCL.Tcl_VarTraceInfo -> getTraces
- ///
- /// </summary>
- /// <param name="interp">Interpreter containing variable.
- /// </param>
- /// <param name="name">name of the variable.
- /// </param>
- /// <param name="flags">flags that control the actions of this method.
- /// </param>
- /// <returns> the Vector of traces of a variable.
- /// </returns>
- static protected internal ArrayList getTraces( Interp interp, string name, TCL.VarFlag flags )
- {
- return getTraces( interp, name, null, flags );
- }
- /// <summary> TCL.Tcl_VarTraceInfo2 -> getTraces
- ///
- /// </summary>
- /// <returns> the list of traces of a variable.
- ///
- /// </returns>
- /// <param name="interp">Interpreter containing variable.
- /// </param>
- /// <param name="part1">1st part of the variable name.
- /// </param>
- /// <param name="part2">2nd part of the variable name (can be null).
- /// </param>
- /// <param name="flags">misc flags that control the actions of this method.
- /// </param>
- 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;
- }
- /// <summary> 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.
- ///
- /// </summary>
- /// <param name="interp">Interp containing the variables
- /// </param>
- /// <param name="frame">CallFrame containing "other" variable.
- /// null means use global context.
- /// </param>
- /// <param name="otherP1">the 1st part name of the variable in the "other" frame.
- /// </param>
- /// <param name="otherP2">the 2nd part name of the variable in the "other" frame.
- /// </param>
- /// <param name="otherFlags">the flags for scaope of "other" variable
- /// </param>
- /// <param name="myName">Name of scalar variable which will refer to otherP1/otherP2.
- /// </param>
- /// <param name="myFlags">only the TCL.VarFlag.GLOBAL_ONLY bit matters,
- /// indicating the scope of myName.
- /// </param>
- /// <exception cref=""> TclException if the upvar cannot be created.
- /// </exception>
- 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 )
- {
- System.Text.StringBuilder buff = new System.Text.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();
- }
- /// <summary> 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).
- ///
- /// </summary>
- /// <param name="interp">Interpreter containing variable.
- /// </param>
- /// <param name="array">array variable that contains the variable, or null
- /// if the variable isn't an element of an array.
- /// </param>
- /// <param name="var">Variable whose traces are to be invoked.
- /// </param>
- /// <param name="part1">the first part of a variable name.
- /// </param>
- /// <param name="part2">the second part of a variable name.
- /// </param>
- /// <param name="flags">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.
- /// </param>
- /// <returns> 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.
- /// </returns>
- 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();
- }
- }
- /// <summary> DeleteSearches -> deleteSearches
- ///
- /// This procedure is called to free up all of the searches
- /// associated with an array variable.
- ///
- /// </summary>
- /// <param name="interp">Interpreter containing array.
- /// </param>
- /// <param name="arrayVar">the array variable to delete searches from.
- /// </param>
- static protected internal void deleteSearches( Var arrayVar )
- // Variable whose searches are to be deleted.
- {
- arrayVar.sidVec = null;
- }
- /// <summary> 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).
- ///
- /// </summary>
- /// <param name="interp">Interpreter containing array.
- /// </param>
- /// <param name="table">Hashtbale that holds the Vars to delete
- /// </param>
- 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();
- }
- /// <summary> 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.
- ///
- /// </summary>
- /// <param name="interp">Interpreter containing array.
- /// </param>
- /// <param name="arrayName">name of array (used for trace callbacks).
- /// </param>
- /// <param name="var">the array variable to delete.
- /// </param>
- /// <param name="flags">Flags to pass to CallTraces.
- /// </param>
- 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;
- }
- /// <summary> 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.
- ///
- /// </summary>
- /// <param name="var">variable that may be a candidate for being expunged.
- /// </param>
- /// <param name="array">Array that contains the variable, or NULL if this
- /// variable isn't an array element.
- /// </param>
- 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
- }