#undef DEBUG /* * Interp.java -- * * Implements the core Tcl interpreter. * * Copyright (c) 1997 Cornell University. * Copyright (c) 1997-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and * redistribution of this file, and for a DISCLAIMER OF ALL * WARRANTIES. * * Included in SQLite3 port to C# for use in testharness only; 2008 Noah B Hart * * RCS @(#) $Id: Interp.java,v 1.44 2003/07/25 16:38:35 mdejong Exp $ * */ using System; using System.Collections; using System.IO; using System.Text; namespace tcl.lang { /// The Tcl interpreter class. public class Interp : EventuallyFreed { private void InitBlock() { reflectObjTable = new Hashtable(); reflectConflictTable = new Hashtable(); importTable = new Hashtable[] { new Hashtable(), new Hashtable() }; } /// Returns the name of the script file currently under execution. /// /// /// the name of the script file currently under execution. /// internal string ScriptFile { get { return dbg.fileName; } } // The following three variables are used to maintain a translation // table between ReflectObject's and their string names. These // variables are accessed by the ReflectObject class, they // are defined here be cause we need them to be per interp data. // Translates Object to ReflectObject. This makes sure we have only // one ReflectObject internalRep for the same Object -- this // way Object identity can be done by string comparison. internal Hashtable reflectObjTable; // Number of reflect objects created so far inside this Interp // (including those that have be freed) internal long reflectObjCount = 0; // Table used to store reflect hash index conflicts, see // ReflectObject implementation for more details internal Hashtable reflectConflictTable; // The number of chars to copy from an offending command into error // message. private const int MAX_ERR_LENGTH = 200; // We pretend this is Tcl 8.0, patch level 0. internal const string TCL_VERSION = "8.0"; internal const string TCL_PATCH_LEVEL = "8.0"; // Total number of times a command procedure // has been called for this interpreter. protected internal int cmdCount; // FIXME : remove later // Table of commands for this interpreter. //Hashtable cmdTable; // Table of channels currently registered in this interp. internal Hashtable interpChanTable; // The Notifier associated with this Interp. private Notifier notifier; // Hash table for associating data with this interpreter. Cleaned up // when this interpreter is deleted. internal Hashtable assocData; // Current working directory. private FileInfo workingDir; // Points to top-most in stack of all nested procedure // invocations. null means there are no active procedures. internal CallFrame frame; // Points to the call frame whose variables are currently in use // (same as frame unless an "uplevel" command is being // executed). null means no procedure is active or "uplevel 0" is // being exec'ed. internal CallFrame varFrame; // The interpreter's global namespace. internal NamespaceCmd.Namespace globalNs; // Hash table used to keep track of hidden commands on a per-interp basis. internal Hashtable hiddenCmdTable; // Information used by InterpCmd.java to keep // track of master/slave interps on a per-interp basis. // Keeps track of all interps for which this interp is the Master. // First, slaveTable (a hashtable) maps from names of commands to // slave interpreters. This hashtable is used to store information // about slave interpreters of this interpreter, to map over all slaves, etc. internal Hashtable slaveTable; // Hash table for Target Records. Contains all Target records which denote // aliases from slaves or sibling interpreters that direct to commands in // this interpreter. This table is used to remove dangling pointers // from the slave (or sibling) interpreters when this interpreter is deleted. internal Hashtable targetTable; // Information necessary for this interp to function as a slave. internal InterpSlaveCmd slave; // Table which maps from names of commands in slave interpreter to // InterpAliasCmd objects. internal Hashtable aliasTable; // FIXME : does globalFrame need to be replaced by globalNs? // Points to the global variable frame. //CallFrame globalFrame; // The script file currently under execution. Can be null if the // interpreter is not evaluating any script file. internal string scriptFile; // Number of times the interp.eval() routine has been recursively // invoked. internal int nestLevel; // Used to catch infinite loops in Parser.eval2. internal int maxNestingDepth; // Flags used when evaluating a command. internal int evalFlags; // Flags used when evaluating a command. public int flags; // Is this interpreted marked as safe? internal bool isSafe; // Offset of character just after last one compiled or executed // by Parser.eval2(). internal int termOffset; // List of name resolution schemes added to this interpreter. // Schemes are added/removed by calling addInterpResolver and // removeInterpResolver. internal ArrayList resolvers; // The expression parser for this interp. internal Expression expr; // Used by the Expression class. If it is equal to zero, then the // parser will evaluate commands and retrieve variable values from // the interp. internal int noEval; // Used in the Expression.java file for the // SrandFunction.class and RandFunction.class. // Set to true if a seed has been set. internal bool randSeedInit; // Used in the Expression.java file for the SrandFunction.class and // RandFunction.class. Stores the value of the seed. internal long randSeed; // If returnCode is TCL.CompletionCode.ERROR, stores the errorInfo. internal string errorInfo; // If returnCode is TCL.CompletionCode.ERROR, stores the errorCode. internal string errorCode; // Completion code to return if current procedure exits with a // TCL_RETURN code. protected internal TCL.CompletionCode returnCode; // True means the interpreter has been deleted: don't process any // more commands for it, and destroy the structure as soon as all // nested invocations of eval() are done. protected internal bool deleted; // True means an error unwind is already in progress. False // means a command proc has been invoked since last error occurred. protected internal bool errInProgress; // True means information has already been logged in $errorInfo // for the current eval() instance, so eval() needn't log it // (used to implement the "error" command). protected internal bool errAlreadyLogged; // True means that addErrorInfo has been called to record // information for the current error. False means Interp.eval // must clear the errorCode variable if an error is returned. protected internal bool errCodeSet; // When TCL_ERROR is returned, this gives the line number within // the command where the error occurred (1 means first line). internal int errorLine; // Stores the current result in the interpreter. private TclObject m_result; // Value m_result is set to when resetResult() is called. private TclObject m_nullResult; // Used ONLY by PackageCmd. internal Hashtable packageTable; internal string packageUnknown; // Used ONLY by the Parser. internal TclObject[][][] parserObjv; internal int[] parserObjvUsed; internal TclToken[] parserTokens; internal int parserTokensUsed; // Used ONLY by JavaImportCmd internal Hashtable[] importTable; // List of unsafe commands: internal static readonly string[] unsafeCmds = new string[] { "encoding", "exit", "load", "cd", "fconfigure", "file", "glob", "open", "pwd", "socket", "beep", "echo", "ls", "resource", "source", "exec", "source" }; // Flags controlling the call of invoke. internal const int INVOKE_HIDDEN = 1; internal const int INVOKE_NO_UNKNOWN = 2; internal const int INVOKE_NO_TRACEBACK = 4; public Interp() { InitBlock(); //freeProc = null; errorLine = 0; // An empty result is used pretty often. We will use a shared // TclObject instance to represent the empty result so that we // don't need to create a new TclObject instance every time the // interpreter result is set to empty. m_nullResult = TclString.newInstance( "" ); m_nullResult.preserve(); // Increment refCount to 1 m_nullResult.preserve(); // Increment refCount to 2 (shared) m_result = TclString.newInstance( "" ); //m_nullResult; // correcponds to iPtr->objResultPtr m_result.preserve(); expr = new Expression(); nestLevel = 0; maxNestingDepth = 1000; frame = null; varFrame = null; returnCode = TCL.CompletionCode.OK; errorInfo = null; errorCode = null; packageTable = new Hashtable(); packageUnknown = null; cmdCount = 0; termOffset = 0; resolvers = null; evalFlags = 0; scriptFile = null; flags = 0; isSafe = false; assocData = null; globalNs = null; // force creation of global ns below globalNs = NamespaceCmd.createNamespace( this, null, null ); if ( globalNs == null ) { throw new TclRuntimeError( "Interp(): can't create global namespace" ); } // Init things that are specific to the Jacl implementation workingDir = new FileInfo( System.Environment.CurrentDirectory ); noEval = 0; notifier = Notifier.getNotifierForThread( System.Threading.Thread.CurrentThread ); notifier.preserve(); randSeedInit = false; deleted = false; errInProgress = false; errAlreadyLogged = false; errCodeSet = false; dbg = initDebugInfo(); slaveTable = new Hashtable(); targetTable = new Hashtable(); aliasTable = new Hashtable(); // init parser variables Parser.init( this ); TclParse.init( this ); // Initialize the Global (static) channel table and the local // interp channel table. interpChanTable = TclIO.getInterpChanTable( this ); // Sets up the variable trace for tcl_precision. Util.setupPrecisionTrace( this ); // Create the built-in commands. createCommands(); try { // Set up tcl_platform, tcl_version, tcl_library and other // global variables. setVar( "tcl_platform", "platform", "windows", TCL.VarFlag.GLOBAL_ONLY ); setVar( "tcl_platform", "byteOrder", "bigEndian", TCL.VarFlag.GLOBAL_ONLY ); setVar( "tcl_platform", "os", Environment.OSVersion.Platform.ToString(), TCL.VarFlag.GLOBAL_ONLY ); setVar( "tcl_platform", "osVersion", Environment.OSVersion.Version.ToString(), TCL.VarFlag.GLOBAL_ONLY ); setVar( "tcl_platform", "machine", Util.tryGetSystemProperty( "os.arch", "?" ), TCL.VarFlag.GLOBAL_ONLY ); setVar( "tcl_version", TCL_VERSION, TCL.VarFlag.GLOBAL_ONLY ); setVar( "tcl_patchLevel", TCL_PATCH_LEVEL, TCL.VarFlag.GLOBAL_ONLY ); setVar( "tcl_library", "resource:/tcl/lang/library", TCL.VarFlag.GLOBAL_ONLY ); if ( Util.Windows ) { setVar( "tcl_platform", "host_platform", "windows", TCL.VarFlag.GLOBAL_ONLY ); } else if ( Util.Mac ) { setVar( "tcl_platform", "host_platform", "macintosh", TCL.VarFlag.GLOBAL_ONLY ); } else { setVar( "tcl_platform", "host_platform", "unix", TCL.VarFlag.GLOBAL_ONLY ); } // Create the env array an populated it with proper // values. Env.initialize( this ); // Register Tcl's version number. Note: This MUST be // done before the call to evalResource, otherwise // calls to "package require tcl" will fail. pkgProvide( "Tcl", TCL_VERSION ); // Source the init.tcl script to initialize auto-loading. evalResource( "/tcl/lang/library/init.tcl" ); } catch ( TclException e ) { System.Diagnostics.Debug.WriteLine( getResult().ToString() ); SupportClass.WriteStackTrace( e, Console.Error ); throw new TclRuntimeError( "unexpected TclException: " + e.Message, e ); } } public override void eventuallyDispose() { if ( deleted ) { return; } deleted = true; if ( nestLevel > 0 ) { //-- TODO -- Determine why this is an error throw new TclRuntimeError("dispose() called with active evals"); } // Remove our association with the notifer (if we had one). if ( notifier != null ) { notifier.release(); notifier = null; } // Dismantle everything in the global namespace except for the // "errorInfo" and "errorCode" variables. These might be needed // later on if errors occur while deleting commands. We are careful // to destroy and recreate the "errorInfo" and "errorCode" // variables, in case they had any traces on them. // // Dismantle the namespace here, before we clear the assocData. If any // background errors occur here, they will be deleted below. // FIXME : check impl of TclTeardownNamespace NamespaceCmd.teardownNamespace( globalNs ); // Delete all variables. TclObject errorInfoObj = null, errorCodeObj = null; try { errorInfoObj = getVar( "errorInfo", null, TCL.VarFlag.GLOBAL_ONLY ); } catch ( TclException e ) { // Do nothing when var does not exist. } if ( errorInfoObj != null ) { errorInfoObj.preserve(); } try { errorCodeObj = getVar( "errorCode", null, TCL.VarFlag.GLOBAL_ONLY ); } catch ( TclException e ) { // Do nothing when var does not exist. } if ( errorCodeObj != null ) { errorCodeObj.preserve(); } frame = null; varFrame = null; try { if ( errorInfoObj != null ) { setVar( "errorInfo", null, errorInfoObj, TCL.VarFlag.GLOBAL_ONLY ); errorInfoObj.release(); } if ( errorCodeObj != null ) { setVar( "errorCode", null, errorCodeObj, TCL.VarFlag.GLOBAL_ONLY ); errorCodeObj.release(); } } catch ( TclException e ) { // Ignore it -- same behavior as Tcl 8.0. } // Tear down the math function table. expr = null; // Remove all the assoc data tied to this interp and invoke // deletion callbacks; note that a callback can create new // callbacks, so we iterate. // ATK The java code was somethink strong if ( assocData != null ) { foreach ( AssocData data in assocData.Values ) { data.disposeAssocData( this ); } assocData.Clear(); } // Close any remaining channels for ( IDictionaryEnumerator e = interpChanTable.GetEnumerator(); e.MoveNext(); ) { Object key = e.Key; Channel chan = (Channel)e.Value; try { chan.close(); } catch ( IOException ex ) { // Ignore any IO errors } } // Finish deleting the global namespace. // FIXME : check impl of Tcl_DeleteNamespace NamespaceCmd.deleteNamespace( globalNs ); globalNs = null; // Free up the result *after* deleting variables, since variable // deletion could have transferred ownership of the result string // to Tcl. frame = null; varFrame = null; resolvers = null; resetResult(); } ~Interp() { dispose(); } protected internal void createCommands() { Extension.loadOnDemand( this, "after", "tcl.lang.AfterCmd" ); Extension.loadOnDemand( this, "append", "tcl.lang.AppendCmd" ); Extension.loadOnDemand( this, "array", "tcl.lang.ArrayCmd" ); Extension.loadOnDemand( this, "binary", "tcl.lang.BinaryCmd" ); Extension.loadOnDemand( this, "break", "tcl.lang.BreakCmd" ); Extension.loadOnDemand( this, "case", "tcl.lang.CaseCmd" ); Extension.loadOnDemand( this, "catch", "tcl.lang.CatchCmd" ); Extension.loadOnDemand( this, "cd", "tcl.lang.CdCmd" ); Extension.loadOnDemand( this, "clock", "tcl.lang.ClockCmd" ); Extension.loadOnDemand( this, "close", "tcl.lang.CloseCmd" ); Extension.loadOnDemand( this, "continue", "tcl.lang.ContinueCmd" ); Extension.loadOnDemand( this, "concat", "tcl.lang.ConcatCmd" ); Extension.loadOnDemand( this, "encoding", "tcl.lang.EncodingCmd" ); Extension.loadOnDemand( this, "eof", "tcl.lang.EofCmd" ); Extension.loadOnDemand( this, "eval", "tcl.lang.EvalCmd" ); Extension.loadOnDemand( this, "error", "tcl.lang.ErrorCmd" ); if ( !Util.Mac ) { Extension.loadOnDemand( this, "exec", "tcl.lang.ExecCmd" ); } Extension.loadOnDemand( this, "exit", "tcl.lang.ExitCmd" ); Extension.loadOnDemand( this, "expr", "tcl.lang.ExprCmd" ); Extension.loadOnDemand( this, "fblocked", "tcl.lang.FblockedCmd" ); Extension.loadOnDemand( this, "fconfigure", "tcl.lang.FconfigureCmd" ); Extension.loadOnDemand( this, "file", "tcl.lang.FileCmd" ); Extension.loadOnDemand( this, "flush", "tcl.lang.FlushCmd" ); Extension.loadOnDemand( this, "for", "tcl.lang.ForCmd" ); Extension.loadOnDemand( this, "foreach", "tcl.lang.ForeachCmd" ); Extension.loadOnDemand( this, "format", "tcl.lang.FormatCmd" ); Extension.loadOnDemand( this, "gets", "tcl.lang.GetsCmd" ); Extension.loadOnDemand( this, "global", "tcl.lang.GlobalCmd" ); Extension.loadOnDemand( this, "glob", "tcl.lang.GlobCmd" ); Extension.loadOnDemand( this, "if", "tcl.lang.IfCmd" ); Extension.loadOnDemand( this, "incr", "tcl.lang.IncrCmd" ); Extension.loadOnDemand( this, "info", "tcl.lang.InfoCmd" ); Extension.loadOnDemand( this, "interp", "tcl.lang.InterpCmd" ); Extension.loadOnDemand( this, "list", "tcl.lang.ListCmd" ); Extension.loadOnDemand( this, "join", "tcl.lang.JoinCmd" ); Extension.loadOnDemand( this, "lappend", "tcl.lang.LappendCmd" ); Extension.loadOnDemand( this, "lindex", "tcl.lang.LindexCmd" ); Extension.loadOnDemand( this, "linsert", "tcl.lang.LinsertCmd" ); Extension.loadOnDemand( this, "llength", "tcl.lang.LlengthCmd" ); Extension.loadOnDemand( this, "lrange", "tcl.lang.LrangeCmd" ); Extension.loadOnDemand( this, "lreplace", "tcl.lang.LreplaceCmd" ); Extension.loadOnDemand( this, "lsearch", "tcl.lang.LsearchCmd" ); Extension.loadOnDemand( this, "lset", "tcl.lang.LsetCmd" ); Extension.loadOnDemand( this, "lsort", "tcl.lang.LsortCmd" ); Extension.loadOnDemand( this, "namespace", "tcl.lang.NamespaceCmd" ); Extension.loadOnDemand( this, "open", "tcl.lang.OpenCmd" ); Extension.loadOnDemand( this, "package", "tcl.lang.PackageCmd" ); Extension.loadOnDemand( this, "proc", "tcl.lang.ProcCmd" ); Extension.loadOnDemand( this, "puts", "tcl.lang.PutsCmd" ); Extension.loadOnDemand( this, "pwd", "tcl.lang.PwdCmd" ); Extension.loadOnDemand( this, "read", "tcl.lang.ReadCmd" ); Extension.loadOnDemand( this, "regsub", "tcl.lang.RegsubCmd" ); Extension.loadOnDemand( this, "rename", "tcl.lang.RenameCmd" ); Extension.loadOnDemand( this, "return", "tcl.lang.ReturnCmd" ); Extension.loadOnDemand( this, "scan", "tcl.lang.ScanCmd" ); Extension.loadOnDemand( this, "seek", "tcl.lang.SeekCmd" ); Extension.loadOnDemand( this, "set", "tcl.lang.SetCmd" ); Extension.loadOnDemand( this, "socket", "tcl.lang.SocketCmd" ); Extension.loadOnDemand( this, "source", "tcl.lang.SourceCmd" ); Extension.loadOnDemand( this, "split", "tcl.lang.SplitCmd" ); Extension.loadOnDemand( this, "string", "tcl.lang.StringCmd" ); Extension.loadOnDemand( this, "subst", "tcl.lang.SubstCmd" ); Extension.loadOnDemand( this, "switch", "tcl.lang.SwitchCmd" ); Extension.loadOnDemand( this, "tell", "tcl.lang.TellCmd" ); Extension.loadOnDemand( this, "time", "tcl.lang.TimeCmd" ); Extension.loadOnDemand( this, "trace", "tcl.lang.TraceCmd" ); Extension.loadOnDemand( this, "unset", "tcl.lang.UnsetCmd" ); Extension.loadOnDemand( this, "update", "tcl.lang.UpdateCmd" ); Extension.loadOnDemand( this, "uplevel", "tcl.lang.UplevelCmd" ); Extension.loadOnDemand( this, "upvar", "tcl.lang.UpvarCmd" ); Extension.loadOnDemand( this, "variable", "tcl.lang.VariableCmd" ); Extension.loadOnDemand( this, "vwait", "tcl.lang.VwaitCmd" ); Extension.loadOnDemand( this, "while", "tcl.lang.WhileCmd" ); // Add "regexp" and related commands to this interp. RegexpCmd.init( this ); // The Java package is only loaded when the user does a // "package require java" in the interp. We need to create a small // command that will load when "package require java" is called. Extension.loadOnDemand( this, "jaclloadjava", "tcl.lang.JaclLoadJavaCmd" ); try { eval( "package ifneeded java 1.3.1 jaclloadjava" ); } catch ( TclException e ) { System.Diagnostics.Debug.WriteLine( getResult().ToString() ); SupportClass.WriteStackTrace( e, Console.Error ); throw new TclRuntimeError( "unexpected TclException: " + e.Message, e ); } } public void setAssocData( string name, AssocData data ) // Object associated with the name. { if ( assocData == null ) { assocData = new Hashtable(); } SupportClass.PutElement( assocData, name, data ); } public void deleteAssocData( string name ) // Name of association. { if ( assocData == null ) { return; } SupportClass.HashtableRemove( assocData, name ); } public AssocData getAssocData( string name ) // Name of association. { if ( assocData == null ) { return null; } else { return (AssocData)assocData[name]; } } public void backgroundError() { BgErrorMgr mgr = (BgErrorMgr)getAssocData( "tclBgError" ); if ( mgr == null ) { mgr = new BgErrorMgr( this ); setAssocData( "tclBgError", mgr ); } mgr.addBgError(); } /*----------------------------------------------------------------- * * VARIABLES * *----------------------------------------------------------------- */ public TclObject setVar( TclObject nameObj, TclObject value, TCL.VarFlag flags ) { return Var.setVar( this, nameObj, value, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public TclObject setVar( string name, TclObject value, TCL.VarFlag flags ) { return Var.setVar( this, name, value, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public TclObject setVar( string name1, string name2, TclObject value, TCL.VarFlag flags ) { return Var.setVar( this, name1, name2, value, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public void setVar( string name, string strValue, TCL.VarFlag flags ) { Var.setVar( this, name, TclString.newInstance( strValue ), ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public void setVar( string name1, string name2, string strValue, TCL.VarFlag flags ) { Var.setVar( this, name1, name2, TclString.newInstance( strValue ), ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public TclObject getVar( TclObject nameObj, TCL.VarFlag flags ) { return Var.getVar( this, nameObj, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public TclObject getVar( string name, TCL.VarFlag flags ) { return Var.getVar( this, name, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public TclObject getVar( string name1, string name2, TCL.VarFlag flags ) { return Var.getVar( this, name1, name2, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public void unsetVar( TclObject nameObj, TCL.VarFlag flags ) { Var.unsetVar( this, nameObj, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public void unsetVar( string name, TCL.VarFlag flags ) { Var.unsetVar( this, name, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public void unsetVar( string name1, string name2, TCL.VarFlag flags ) { Var.unsetVar( this, name1, name2, ( flags | TCL.VarFlag.LEAVE_ERR_MSG ) ); } public void traceVar( TclObject nameObj, VarTrace trace, TCL.VarFlag flags ) { Var.traceVar( this, nameObj, flags, trace ); } public void traceVar( string name, VarTrace trace, TCL.VarFlag flags ) { Var.traceVar( this, name, flags, trace ); } public void traceVar( string part1, string part2, VarTrace trace, TCL.VarFlag flags ) { Var.traceVar( this, part1, part2, flags, trace ); } public void untraceVar( TclObject nameObj, 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, nameObj, flags, trace ); } public void untraceVar( string name, 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, name, flags, trace ); } 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 ); } public void createCommand( string cmdName, Command cmdImpl ) // Command object to associate with // cmdName. { ImportRef oldRef = null; NamespaceCmd.Namespace ns; WrappedCommand cmd, refCmd; string tail; ImportedCmdData data; if ( deleted ) { // The interpreter is being deleted. Don't create any new // commands; it's not safe to muck with the interpreter anymore. return; } // Determine where the command should reside. If its name contains // namespace qualifiers, we put it in the specified namespace; // otherwise, we always put it in the global namespace. if ( cmdName.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[] dummyArr = new NamespaceCmd.Namespace[1]; string[] tailArr = new string[1]; NamespaceCmd.getNamespaceForQualName( this, cmdName, null, TCL.VarFlag.CREATE_NS_IF_UNKNOWN, nsArr, dummyArr, dummyArr, tailArr ); ns = nsArr[0]; tail = tailArr[0]; if ( ( ns == null ) || ( (System.Object)tail == null ) ) { return; } } else { ns = globalNs; tail = cmdName; } cmd = (WrappedCommand)ns.cmdTable[tail]; if ( cmd != null ) { // Command already exists. Delete the old one. // Be careful to preserve any existing import links so we can // restore them down below. That way, you can redefine a // command and its import status will remain intact. oldRef = cmd.importRef; cmd.importRef = null; deleteCommandFromToken( cmd ); // FIXME : create a test case for this condition! cmd = (WrappedCommand)ns.cmdTable[tail]; if ( cmd != null ) { // If the deletion callback recreated the command, just throw // away the new command (if we try to delete it again, we // could get stuck in an infinite loop). SupportClass.HashtableRemove( cmd.table, cmd.hashKey ); } } cmd = new WrappedCommand(); ns.cmdTable.Add( tail, cmd ); cmd.table = ns.cmdTable; cmd.hashKey = tail; cmd.ns = ns; cmd.cmd = cmdImpl; cmd.deleted = false; // FIXME : import feature not implemented //cmd.importRef = null; // Plug in any existing import references found above. Be sure // to update all of these references to point to the new command. if ( oldRef != null ) { cmd.importRef = oldRef; while ( oldRef != null ) { refCmd = oldRef.importedCmd; data = (ImportedCmdData)refCmd.cmd; data.realCmd = cmd; oldRef = oldRef.next; } } // There are no shadowed commands in Jacl because they are only // used in the 8.0 compiler return; } /* *---------------------------------------------------------------------- * * Tcl_CreateObjCommand -- * * Define a new object-based command in a command table. * * Results: * The return value is a token for the command, which can * be used in future calls to Tcl_GetCommandName. * * Side effects: * If no command named "cmdName" already exists for interp, one is * created. Otherwise, if a command does exist, then if the * object-based Tcl_ObjCmdProc is TclInvokeStringCommand, we assume * Tcl_CreateCommand was called previously for the same command and * just set its Tcl_ObjCmdProc to the argument "proc"; otherwise, we * delete the old command. * * In the future, during bytecode evaluation when "cmdName" is seen as * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based * Tcl_ObjCmdProc proc will be called. When the command is deleted from * the table, deleteProc will be called. See the manual entry for * details on the calling sequence. * *---------------------------------------------------------------------- */ public delegate int dxObjCmdProc( object clientData, Interp interp, int argc, TclObject[] argv ); public delegate void dxCmdDeleteProc( ref object clientData ); public void createObjCommand( string cmdName, dxObjCmdProc proc, object clientData, dxCmdDeleteProc deleteProc ) // Command object to associate with cmdName. { ImportRef oldRef = null; NamespaceCmd.Namespace ns; WrappedCommand cmd, refCmd; string tail; ImportedCmdData data; int _new; if ( deleted ) { // The interpreter is being deleted. Don't create any new // commands; it's not safe to muck with the interpreter anymore. return; } // Determine where the command should reside. If its name contains // namespace qualifiers, we put it in the specified namespace; // otherwise, we always put it in the global namespace. if ( cmdName.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[] dummyArr = new NamespaceCmd.Namespace[1]; string[] tailArr = new string[1]; NamespaceCmd.getNamespaceForQualName( this, cmdName, null, TCL.VarFlag.CREATE_NS_IF_UNKNOWN, nsArr, dummyArr, dummyArr, tailArr ); ns = nsArr[0]; tail = tailArr[0]; if ( ( ns == null ) || ( (System.Object)tail == null ) ) { return; } } else { ns = globalNs; tail = cmdName; } cmd = (WrappedCommand)ns.cmdTable[tail]; if ( cmd != null ) { /* * Command already exists. If its object-based Tcl_ObjCmdProc is * TclInvokeStringCommand, we just set its Tcl_ObjCmdProc to the * argument "proc". Otherwise, we delete the old command. */ if ( cmd.objProc != null && cmd.objProc.GetType().Name == "TclInvokeStringCommand" ) { cmd.objProc = proc; cmd.objClientData = clientData; cmd.deleteProc = deleteProc; cmd.deleteData = clientData; return; } /* * Otherwise, we delete the old command. Be careful to preserve * any existing import links so we can restore them down below. * That way, you can redefine a command and its import status * will remain intact. */ oldRef = cmd.importRef; cmd.importRef = null; deleteCommandFromToken( cmd ); // FIXME : create a test case for this condition! cmd = (WrappedCommand)ns.cmdTable[tail]; if ( cmd != null ) { // If the deletion callback recreated the command, just throw // away the new command (if we try to delete it again, we // could get stuck in an infinite loop). SupportClass.HashtableRemove( cmd.table, cmd.hashKey ); } } cmd = new WrappedCommand(); ns.cmdTable.Add( tail, cmd ); cmd.table = ns.cmdTable; cmd.hashKey = tail; cmd.ns = ns; cmd.cmd = null; cmd.deleted = false; // FIXME : import feature not implemented //cmd.importRef = null; // TODO -- Determine if this is all correct cmd.objProc = proc; cmd.objClientData = clientData; //cmd.proc = TclInvokeObjectCommand; cmd.clientData = (object)cmd; cmd.deleteProc = deleteProc; cmd.deleteData = clientData; cmd.flags = 0; // Plug in any existing import references found above. Be sure // to update all of these references to point to the new command. if ( oldRef != null ) { cmd.importRef = oldRef; while ( oldRef != null ) { refCmd = oldRef.importedCmd; data = (ImportedCmdData)refCmd.cmd; data.realCmd = cmd; oldRef = oldRef.next; } } // There are no shadowed commands in Jacl because they are only // used in the 8.0 compiler return; } internal string getCommandFullName( WrappedCommand cmd ) // Token for the command. { Interp interp = this; StringBuilder name = new StringBuilder(); // Add the full name of the containing namespace, followed by the "::" // separator, and the command name. if ( cmd != null ) { if ( cmd.ns != null ) { name.Append( cmd.ns.fullName ); if ( cmd.ns != interp.globalNs ) { name.Append( "::" ); } } if ( cmd.table != null ) { name.Append( cmd.hashKey ); } } return name.ToString(); } public int deleteCommand( string cmdName ) // Name of command to remove. { WrappedCommand cmd; // Find the desired command and delete it. try { cmd = NamespaceCmd.findCommand( this, cmdName, null, 0 ); } catch ( TclException e ) { throw new TclRuntimeError( "unexpected TclException: " + e.Message, e ); } if ( cmd == null ) { return -1; } if ( cmd.deleteProc != null ) cmd.deleteProc( ref cmd.deleteData ); return deleteCommandFromToken( cmd ); } protected internal int deleteCommandFromToken( WrappedCommand cmd ) // Wrapper Token for command to delete. { if ( cmd == null ) { return -1; } ImportRef ref_Renamed, nextRef; WrappedCommand importCmd; // The code here is tricky. We can't delete the hash table entry // before invoking the deletion callback because there are cases // where the deletion callback needs to invoke the command (e.g. // object systems such as OTcl). However, this means that the // callback could try to delete or rename the command. The deleted // flag allows us to detect these cases and skip nested deletes. if ( cmd.deleted ) { // Another deletion is already in progress. Remove the hash // table entry now, but don't invoke a callback or free the // command structure. if ( (System.Object)cmd.hashKey != null && cmd.table != null ) { SupportClass.HashtableRemove( cmd.table, cmd.hashKey ); cmd.table = null; cmd.hashKey = null; } return 0; } cmd.deleted = true; if ( cmd.cmd is CommandWithDispose ) { ( (CommandWithDispose)cmd.cmd ).disposeCmd(); } if ( cmd.deleteProc != null ) { cmd.deleteProc( ref cmd.objClientData ); } // If this command was imported into other namespaces, then imported // commands were created that refer back to this command. Delete these // imported commands now. for ( ref_Renamed = cmd.importRef; ref_Renamed != null; ref_Renamed = nextRef ) { nextRef = ref_Renamed.next; importCmd = ref_Renamed.importedCmd; deleteCommandFromToken( importCmd ); } // FIXME : what does this mean? Is this a mistake in the C comment? // Don't use hPtr to delete the hash entry here, because it's // possible that the deletion callback renamed the command. // Instead, use cmdPtr->hptr, and make sure that no-one else // has already deleted the hash entry. if ( cmd.table != null ) { SupportClass.HashtableRemove( cmd.table, cmd.hashKey ); cmd.table = null; cmd.hashKey = null; } // Drop the reference to the Command instance inside the WrappedCommand cmd.cmd = null; // We do not need to cleanup the WrappedCommand because GC will get it. return 0; } protected internal void renameCommand( string oldName, string newName ) { Interp interp = this; string newTail; NamespaceCmd.Namespace cmdNs, newNs; WrappedCommand cmd; Hashtable table, oldTable; string hashKey, oldHashKey; // Find the existing command. An error is returned if cmdName can't // be found. cmd = NamespaceCmd.findCommand( interp, oldName, null, 0 ); if ( cmd == null ) { throw new TclException( interp, "can't " + ( ( ( (System.Object)newName == null ) || ( newName.Length == 0 ) ) ? "delete" : "rename" ) + " \"" + oldName + "\": command doesn't exist" ); } cmdNs = cmd.ns; // If the new command name is NULL or empty, delete the command. Do this // with Tcl_DeleteCommandFromToken, since we already have the command. if ( ( (System.Object)newName == null ) || ( newName.Length == 0 ) ) { deleteCommandFromToken( cmd ); return; } // Make sure that the destination command does not already exist. // The rename operation is like creating a command, so we should // automatically create the containing namespaces just like // Tcl_CreateCommand would. NamespaceCmd.Namespace[] newNsArr = new NamespaceCmd.Namespace[1]; NamespaceCmd.Namespace[] dummyArr = new NamespaceCmd.Namespace[1]; string[] newTailArr = new string[1]; NamespaceCmd.getNamespaceForQualName( interp, newName, null, TCL.VarFlag.CREATE_NS_IF_UNKNOWN, newNsArr, dummyArr, dummyArr, newTailArr ); newNs = newNsArr[0]; newTail = newTailArr[0]; if ( ( newNs == null ) || ( (System.Object)newTail == null ) ) { throw new TclException( interp, "can't rename to \"" + newName + "\": bad command name" ); } if ( newNs.cmdTable[newTail] != null ) { throw new TclException( interp, "can't rename to \"" + newName + "\": command already exists" ); } // Warning: any changes done in the code here are likely // to be needed in Tcl_HideCommand() code too. // (until the common parts are extracted out) --dl // Put the command in the new namespace so we can check for an alias // loop. Since we are adding a new command to a namespace, we must // handle any shadowing of the global commands that this might create. oldTable = cmd.table; oldHashKey = cmd.hashKey; newNs.cmdTable.Add( newTail, cmd ); cmd.table = newNs.cmdTable; cmd.hashKey = newTail; cmd.ns = newNs; // FIXME : this is a nasty hack that fixes renaming for Procedures // that move from one namespace to another, but the real problem // is that a rename does not work for Command instances in general if ( cmd.cmd is Procedure ) { Procedure p = (Procedure)cmd.cmd; p.ns = cmd.ns; } // Now check for an alias loop. If we detect one, put everything back // the way it was and report the error. try { interp.preventAliasLoop( interp, cmd ); } catch ( TclException e ) { newNs.cmdTable.Remove( newTail ); cmd.table = oldTable; cmd.hashKey = oldHashKey; cmd.ns = cmdNs; throw; } // The new command name is okay, so remove the command from its // current namespace. This is like deleting the command, so bump // the cmdEpoch to invalidate any cached references to the command. SupportClass.HashtableRemove( oldTable, oldHashKey ); return; } internal void preventAliasLoop( Interp cmdInterp, WrappedCommand cmd ) { // If we are not creating or renaming an alias, then it is // always OK to create or rename the command. if ( !( cmd.cmd is InterpAliasCmd ) ) { return; } // OK, we are dealing with an alias, so traverse the chain of aliases. // If we encounter the alias we are defining (or renaming to) any in // the chain then we have a loop. InterpAliasCmd alias = (InterpAliasCmd)cmd.cmd; InterpAliasCmd nextAlias = alias; while ( true ) { // If the target of the next alias in the chain is the same as // the source alias, we have a loop. WrappedCommand aliasCmd = nextAlias.getTargetCmd( this ); if ( aliasCmd == null ) { return; } if ( aliasCmd.cmd == cmd.cmd ) { throw new TclException( this, "cannot define or rename alias \"" + alias.name + "\": would create a loop" ); } // Otherwise, follow the chain one step further. See if the target // command is an alias - if so, follow the loop to its target // command. Otherwise we do not have a loop. if ( !( aliasCmd.cmd is InterpAliasCmd ) ) { return; } nextAlias = (InterpAliasCmd)aliasCmd.cmd; } } public Command getCommand( string cmdName ) // String name of the command. { // Find the desired command and return it. WrappedCommand cmd; try { cmd = NamespaceCmd.findCommand( this, cmdName, null, 0 ); } catch ( TclException e ) { throw new TclRuntimeError( "unexpected TclException: " + e.Message, e ); } return ( ( cmd == null ) ? null : cmd.cmd ); } public WrappedCommand getObjCommand( string cmdName ) // String name of the command. { // Find the desired command and return it. WrappedCommand cmd; try { cmd = NamespaceCmd.findCommand( this, cmdName, null, 0 ); } catch ( TclException e ) { throw new TclRuntimeError( "unexpected TclException: " + e.Message, e ); } return ( ( cmd == null ) ? null : cmd ); } public static bool commandComplete( string inString ) // The string to check. { return Parser.commandComplete( inString, inString.Length ); } /*----------------------------------------------------------------- * * EVAL * *----------------------------------------------------------------- */ public TclObject getResult() { return m_result; } public void setResult( TclObject r ) // A Tcl Object to be set as the result. { if ( r == null ) { throw new System.NullReferenceException( "Interp.setResult() called with null TclObject argument." ); } if ( r == m_result ) { // Setting to current value (including m_nullResult) is a no-op. return; } if ( m_result != m_nullResult ) { m_result.release(); } m_result = r; if ( m_result != m_nullResult ) { m_result.preserve(); } } public void setResult( string r ) // A string result. { if ( (System.Object)r == null ) { resetResult(); } else { setResult( TclString.newInstance( r ) ); } } public void setResult( int r ) // An int result. { setResult( TclInteger.newInstance( r ) ); } public void setResult( double r ) // A double result. { setResult( TclDouble.newInstance( r ) ); } public void setResult( bool r ) // A boolean result. { setResult( TclBoolean.newInstance( r ) ); } public void resetResult() { if ( m_result != m_nullResult ) { m_result.release(); m_result = TclString.newInstance( "" ); //m_nullResult; m_result.preserve(); if ( !m_nullResult.Shared ) { throw new TclRuntimeError( "m_nullResult is not shared" ); } } errAlreadyLogged = false; errInProgress = false; errCodeSet = false; returnCode = TCL.CompletionCode.OK; } public void appendElement( object Element ) { TclObject result; result = getResult(); if ( result.Shared ) { result = result.duplicate(); } TclList.append( this, result, TclObj.newInstance( Element ) ); setResult( result ); } public void appendElement( string Element ) { TclObject result; result = getResult(); if ( result.Shared ) { result = result.duplicate(); } TclList.append( this, result, TclString.newInstance( Element ) ); setResult( result ); } public void eval( string inString, int flags ) { int evalFlags = this.evalFlags; this.evalFlags &= ~Parser.TCL_ALLOW_EXCEPTIONS; CharPointer script = new CharPointer( inString ); try { Parser.eval2( this, script.array, script.index, script.length(), flags ); } catch ( TclException e ) { if ( nestLevel != 0 ) { throw; } // Update the interpreter's evaluation level count. If we are again at // the top level, process any unusual return code returned by the // evaluated code. Note that we don't propagate an exception that // has a TCL.CompletionCode.RETURN error code when updateReturnInfo() returns TCL.CompletionCode.OK. TCL.CompletionCode result = e.getCompletionCode(); if ( result == TCL.CompletionCode.RETURN ) { result = updateReturnInfo(); } if ( result != TCL.CompletionCode.EXIT && result != TCL.CompletionCode.OK && result != TCL.CompletionCode.ERROR && ( evalFlags & Parser.TCL_ALLOW_EXCEPTIONS ) == 0 ) { processUnexpectedResult( result ); } if ( result != TCL.CompletionCode.OK ) { e.setCompletionCode( result ); throw; } } } public void eval( string script ) { eval( script, 0 ); } public void eval( TclObject tobj, int flags ) { eval( tobj.ToString(), flags ); } public void recordAndEval( TclObject script, int flags ) { // Append the script to the event list by calling "history add