public TclException(TCL.CompletionCode ccode):base() { if (ccode == TCL.CompletionCode.OK) { throw new TclRuntimeError("The reserved completion code TCL.CompletionCode.OK (0) cannot be used"); } compCode = ccode; errIndex = - 1; }
protected internal TclException(Interp interp, string msg, TCL.CompletionCode ccode, int idx):base(msg) { if (ccode == TCL.CompletionCode.OK) { throw new TclRuntimeError("The reserved completion code TCL.CompletionCode.OK (0) cannot be used " + "in TclException"); } compCode = ccode; errIndex = idx; if (interp != null && (System.Object) msg != null) { interp.setResult(msg); } }
public void traceVar( string part1, string part2, VarTrace trace, TCL.VarFlag flags ) { Var.traceVar( this, part1, part2, flags, trace ); }
/// <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> 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> 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> 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> 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> 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 ); } }
public TclException( Interp interp, string msg, TCL.CompletionCode ccode ) : this( interp, msg, ccode, -1 ) { }
internal void setCompletionCode( TCL.CompletionCode ccode ) // New completion code. { if ( ccode == TCL.CompletionCode.OK ) { throw new TclRuntimeError( "The reserved completion code TCL.CompletionCode.OK (0) cannot be used" ); } compCode = ccode; }
public void traceProc(Interp interp, string part1, string part2, TCL.VarFlag flags) { if (((this.flags & flags) != 0) && ((flags & TCL.VarFlag.INTERP_DESTROYED) == 0)) { System.Text.StringBuilder sbuf = new System.Text.StringBuilder(command); try { Util.appendElement(interp, sbuf, part1); if ((System.Object) part2 != null) { Util.appendElement(interp, sbuf, part2); } else { Util.appendElement(interp, sbuf, ""); } if ((flags & TCL.VarFlag.TRACE_READS) != 0) { Util.appendElement(interp, sbuf, "r"); } else if ((flags & TCL.VarFlag.TRACE_WRITES) != 0) { Util.appendElement(interp, sbuf, "w"); } else if ((flags & TCL.VarFlag.TRACE_UNSETS) != 0) { Util.appendElement(interp, sbuf, "u"); } } catch (TclException e) { throw new TclRuntimeError("unexpected TclException: " + e.Message,e); } // Execute the command. interp.eval(sbuf.ToString(), 0); } }
internal CmdTraceProc(string cmd, TCL.VarFlag newFlags) { flags = newFlags; command = cmd; }
public void untraceVar( string part1, string part2, VarTrace trace, TCL.VarFlag flags ) // OR-ed collection of bits describing current // trace, including any of TCL.VarFlag.TRACE_READS, // TCL.VarFlag.TRACE_WRITES, TCL.VarFlag.TRACE_UNSETS, // TCL.VarFlag.GLOBAL_ONLY and TCL.VarFlag.NAMESPACE_ONLY. { Var.untraceVar( this, part1, part2, flags, trace ); }
/// <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> 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> 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_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> 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> 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> 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; }
/// <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> 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> 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> 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> 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> 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_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 ); } 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; } */ }
public void traceProc( Interp interp, string name1, string name2, TCL.VarFlag flags ) { // If the variable is unset, then recreate the trace and restore // the default value of the format string. if ( ( flags & TCL.VarFlag.TRACE_UNSETS ) != 0 ) { if ( ( ( flags & TCL.VarFlag.TRACE_DESTROYED ) != 0 ) && ( ( flags & TCL.VarFlag.INTERP_DESTROYED ) == 0 ) ) { interp.traceVar( name1, name2, new PrecTraceProc(), TCL.VarFlag.GLOBAL_ONLY | TCL.VarFlag.TRACE_WRITES | TCL.VarFlag.TRACE_READS | TCL.VarFlag.TRACE_UNSETS ); Util.precision = Util.DEFAULT_PRECISION; } return; } // When the variable is read, reset its value from our shared // value. This is needed in case the variable was modified in // some other interpreter so that this interpreter's value is // out of date. if ( ( flags & TCL.VarFlag.TRACE_READS ) != 0 ) { interp.setVar( name1, name2, TclInteger.newInstance( Util.precision ), flags & TCL.VarFlag.GLOBAL_ONLY ); return; } // The variable is being written. Check the new value and disallow // it if it isn't reasonable. // // (ToDo) Disallow it if this is a safe interpreter (we don't want // safe interpreters messing up the precision of other // interpreters). TclObject tobj = null; try { tobj = interp.getVar( name1, name2, ( flags & TCL.VarFlag.GLOBAL_ONLY ) ); } catch ( TclException e ) { // Do nothing when var does not exist. } string value; if ( tobj != null ) { value = tobj.ToString(); } else { value = ""; } StrtoulResult r = Util.strtoul( value, 0, 10 ); if ( ( r == null ) || ( r.value <= 0 ) || ( r.value > TCL_MAX_PREC ) || ( r.value > 100 ) || ( r.index == 0 ) || ( r.index != value.Length ) ) { interp.setVar( name1, name2, TclInteger.newInstance( Util.precision ), TCL.VarFlag.GLOBAL_ONLY ); throw new TclException( interp, "improper value for precision" ); } Util.precision = (int)r.value; }
public void traceVar( string name, VarTrace trace, TCL.VarFlag flags ) { Var.traceVar( this, name, flags, trace ); }