#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