/// <summary> Tcl_UpvarObjCmd -> UpvarCmd.cmdProc
///
/// This procedure is invoked to process the "upvar" Tcl command.
/// See the user documentation for details on what it does.
/// </summary>
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] objv)
{
CallFrame frame;
string frameSpec, otherVarName, myVarName;
int p;
int objc = objv.Length, objv_index;
int result;
if (objv.Length < 3)
{
throw new TclNumArgsException(interp, 1, objv, "?level? otherVar localVar ?otherVar localVar ...?");
}
// Find the call frame containing each of the "other variables" to be
// linked to.
frameSpec = objv[1].ToString();
// Java does not support passing a reference by refernece so use an array
CallFrame[] frameArr = new CallFrame[1];
result = CallFrame.GetFrame(interp, frameSpec, frameArr);
frame = frameArr[0];
objc -= (result + 1);
if ((objc & 1) != 0)
{
throw new TclNumArgsException(interp, 1, objv, "?level? otherVar localVar ?otherVar localVar ...?");
}
objv_index = result + 1;
// Iterate over each (other variable, local variable) pair.
// Divide the other variable name into two parts, then call
// MakeUpvar to do all the work of linking it to the local variable.
for (; objc > 0; objc -= 2, objv_index += 2)
{
myVarName = objv[objv_index + 1].ToString();
otherVarName = objv[objv_index].ToString();
int otherLength = otherVarName.Length;
p = otherVarName.IndexOf((System.Char) '(');
if ((p != -1) && (otherVarName[otherLength - 1] == ')'))
{
// This is an array variable name
Var.makeUpvar(interp, frame, otherVarName.Substring(0, (p) - (0)), otherVarName.Substring(p + 1, (otherLength - 1) - (p + 1)), 0, myVarName, 0);
}
else
{
// This is a scalar variable name
Var.makeUpvar(interp, frame, otherVarName, null, 0, myVarName, 0);
}
}
interp.ResetResult();
return(TCL.CompletionCode.RETURN);
}
protected internal Hashtable VarTable; // Stores the variables of this CallFrame.
/// <summary>
/// Creates a CallFrame for the global variables.</summary>
/// <param name="interp">
/// current interpreter.
/// </param>
internal CallFrame(Interp i)
{
Interp = i;
NS = i.GlobalNS;
VarTable = new Hashtable();
Caller = null;
CallerVar = null;
Objv = null;
Level = 0;
IsProcCallFrame = true;
}
protected internal Hashtable VarTable; // Stores the variables of this CallFrame.
/// <summary>
/// Creates a CallFrame for the global variables.</summary>
/// <param name="interp">
/// current interpreter.
/// </param>
internal CallFrame(Interp i)
{
Interp = i;
NS = i.GlobalNS;
VarTable = new Hashtable();
Caller = null;
CallerVar = null;
Objv = null;
Level = 0;
IsProcCallFrame = true;
}
/// <summary>
/// Chain this frame into the call frame stack and binds the parameters values to the formal parameters of the procedure.
/// </summary>
/// <param name="proc">
/// the procedure.
/// </param>
/// <param name="proc">
/// argv the parameter values.
/// </param>
/// <exception cref="">
/// TclException if wrong number of arguments.
/// </exception>
internal void Chain(Procedure proc, TclObject[] objv)
{
// FIXME: double check this ns thing in case where proc is renamed to different ns.
NS = proc.NS;
Objv = objv;
// FIXME : quick level hack : fix later
Level = (Interp.VarFrame == null ? 1 : Interp.VarFrame.Level + 1);
Caller = Interp.Frame;
CallerVar = Interp.VarFrame;
Interp.Frame = this;
Interp.VarFrame = this;
// parameter bindings
int numArgs = proc.ArgList.Length;
if (!proc.isVarArgs && objv.Length - 1 > numArgs)
{
WrongNumProcArgs(objv[0], proc);
}
for (int i = 0, j = 1; i < numArgs; i++, j++)
{
// Handle the special case of the last formal being "args". When it occurs, assign it a list consisting of
// all the remaining actual arguments.
TclObject varName = proc.ArgList[i][0];
TclObject value = null;
if (i == (numArgs - 1) && proc.isVarArgs)
{
value = TclList.NewInstance();
value.Preserve();
for (int k = j; k < objv.Length; k++)
{
TclList.Append(Interp, value, objv[k]);
}
Interp.SetVar(varName, value, 0);
value.Release();
}
else
{
if (j < objv.Length)
{
value = objv[j];
}
else if (proc.ArgList[i][1] != null)
{
value = proc.ArgList[i][1];
}
else
{
WrongNumProcArgs(objv[0], proc);
}
Interp.SetVar(varName, value, 0);
}
}
}
/// <summary>
/// This method is called when this CallFrame is no longer needed. Removes the reference of this object from the interpreter so
/// that this object can be garbage collected.
///
/// For this procedure to work correctly, it must not be possible for any of the variable in the table to be accessed from Tcl
/// commands (e.g. from trace procedures).
/// </summary>
protected internal void Dispose()
{
// Unchain this frame from the call stack.
Interp.Frame = Caller;
Interp.VarFrame = CallerVar;
Caller = null;
CallerVar = null;
if (VarTable != null)
{
Var.DeleteVars(Interp, VarTable);
VarTable.Clear(); VarTable = null;
}
}
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] argv)
{
// Create the call frame and parameter bindings
CallFrame frame = interp.newCallFrame(this, argv);
// Execute the body
interp.pushDebugStack(srcFileName, srcLineNumber);
try
{
Parser.eval2(interp, body._array, body._index, body_length, 0);
}
catch (TclException e)
{
TCL.CompletionCode code = e.GetCompletionCode();
if (code == TCL.CompletionCode.RETURN)
{
TCL.CompletionCode realCode = interp.updateReturnInfo();
if (realCode != TCL.CompletionCode.OK)
{
e.setCompletionCode(realCode);
throw;
}
}
else if (code == TCL.CompletionCode.ERROR)
{
interp.AddErrorInfo("\n (procedure \"" + argv[0] + "\" line " + interp._errorLine + ")");
throw;
}
else if (code == TCL.CompletionCode.BREAK)
{
throw new TclException(interp, "invoked \"break\" outside of a loop");
}
else if (code == TCL.CompletionCode.CONTINUE)
{
throw new TclException(interp, "invoked \"continue\" outside of a loop");
}
else
{
throw;
}
}
finally
{
interp.popDebugStack();
// The check below is a hack. The problem is that there
// could be unset traces on the variables, which cause
// scripts to be evaluated. This will clear the
// errInProgress flag, losing stack trace information if
// the procedure was exiting with an error. The code
// below preserves the flag. Unfortunately, that isn't
// really enough: we really should preserve the errorInfo
// variable too (otherwise a nested error in the trace
// script will trash errorInfo). What's really needed is
// a general-purpose mechanism for saving and restoring
// interpreter state.
if (interp._errInProgress)
{
frame.Dispose();
interp._errInProgress = true;
}
else
{
frame.Dispose();
}
}
return(TCL.CompletionCode.RETURN);
}
/// <summary>
/// This method is called when this CallFrame is no longer needed. Removes the reference of this object from the interpreter so
/// that this object can be garbage collected.
///
/// For this procedure to work correctly, it must not be possible for any of the variable in the table to be accessed from Tcl
/// commands (e.g. from trace procedures).
/// </summary>
protected internal void Dispose()
{
// Unchain this frame from the call stack.
Interp.Frame = Caller;
Interp.VarFrame = CallerVar;
Caller = null;
CallerVar = null;
if (VarTable != null)
{
Var.DeleteVars(Interp, VarTable);
VarTable.Clear(); VarTable = null;
}
}
/// <summary>
/// Tcl_GetFrame -> getFrame
///
/// Given a description of a procedure frame, such as the first argument to an "uplevel" or "upvar" command, locate the
/// call frame for the appropriate level of procedure.
///
/// The return value is 1 if string was either a number or a number preceded by "#" and it specified a valid frame. 0 is returned
/// if string isn't one of the two things above (in this case, the lookup acts as if string were "1"). The frameArr[0] reference
/// will be filled by the reference of the desired frame (unless an error occurs, in which case it isn't modified).
/// </summary>
/// <param name="string">
/// a string that specifies the level.
/// </param>
/// <returns>
/// an Vector the names of the (defined) variables in this CallFrame.
/// </returns>
/// <exception cref="">
/// TclException if s is a valid level specifier but refers to a bad level that doesn't exist.
/// </exception>
internal static int GetFrame(Interp interp, string inString, CallFrame[] frameArr)
{
// Parse string to figure out which level number to go to.
int level;
int result = 1;
int curLevel = (interp.VarFrame == null ? 0 : interp.VarFrame.Level);
if (inString.Length > 0 && inString[0] == '#')
{
level = Util.getInt(interp, inString.Substring(1));
if (level < 0)
throw new TclException(interp, "bad level \"" + inString + "\"");
}
else if (inString.Length > 0 && Char.IsDigit(inString[0]))
{
level = Util.getInt(interp, inString);
level = curLevel - level;
}
else
{
level = curLevel - 1;
result = 0;
}
// FIXME: is this a bad comment from some other proc?
// Figure out which frame to use, and modify the interpreter so its variables come from that frame.
CallFrame frame;
if (level == 0)
frame = null;
else
{
for (frame = interp.VarFrame; frame != null; frame = frame.CallerVar)
if (frame.Level == level)
break;
if (frame == null)
throw new TclException(interp, "bad level \"" + inString + "\"");
}
frameArr[0] = frame;
return result;
}
/// <summary>
/// Chain this frame into the call frame stack and binds the parameters values to the formal parameters of the procedure.
/// </summary>
/// <param name="proc">
/// the procedure.
/// </param>
/// <param name="proc">
/// argv the parameter values.
/// </param>
/// <exception cref="">
/// TclException if wrong number of arguments.
/// </exception>
internal void Chain(Procedure proc, TclObject[] objv)
{
// FIXME: double check this ns thing in case where proc is renamed to different ns.
NS = proc.NS;
Objv = objv;
// FIXME : quick level hack : fix later
Level = (Interp.VarFrame == null ? 1 : Interp.VarFrame.Level + 1);
Caller = Interp.Frame;
CallerVar = Interp.VarFrame;
Interp.Frame = this;
Interp.VarFrame = this;
// parameter bindings
int numArgs = proc.ArgList.Length;
if (!proc.isVarArgs && objv.Length - 1 > numArgs)
WrongNumProcArgs(objv[0], proc);
for (int i = 0, j = 1; i < numArgs; i++, j++)
{
// Handle the special case of the last formal being "args". When it occurs, assign it a list consisting of
// all the remaining actual arguments.
TclObject varName = proc.ArgList[i][0];
TclObject value = null;
if (i == (numArgs - 1) && proc.isVarArgs)
{
value = TclList.NewInstance();
value.Preserve();
for (int k = j; k < objv.Length; k++)
TclList.Append(Interp, value, objv[k]);
Interp.SetVar(varName, value, 0);
value.Release();
}
else
{
if (j < objv.Length)
value = objv[j];
else if (proc.ArgList[i][1] != null)
value = proc.ArgList[i][1];
else
WrongNumProcArgs(objv[0], proc);
Interp.SetVar(varName, value, 0);
}
}
}
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) { } // Do nothing when var does not exist.
if (errorInfoObj != null)
errorInfoObj.Preserve();
try { errorCodeObj = GetVar("errorCode", null, TCL.VarFlag.GLOBAL_ONLY); }
catch (TclException) { } // 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) { } // 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.
if (_assocData != null)
{
foreach (IAssocData data in _assocData.Values)
data.Dispose(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) { } // Ignore any IO errors
}
// Finish deleting the global namespace.
NamespaceCmd.DeleteNamespace(GlobalNS); GlobalNS = null; // FIXME : check impl of Tcl_DeleteNamespace
// 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();
}
internal TCL.CompletionCode invokeGlobal(TclObject[] objv, int flags)
{
CallFrame savedVarFrame = VarFrame;
try
{
VarFrame = null;
return invoke(objv, flags);
}
finally
{
VarFrame = savedVarFrame;
}
}
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.
_nullResult = TclString.NewInstance(string.Empty);
_nullResult.Preserve(); // Increment refCount to 1
_nullResult.Preserve(); // Increment refCount to 2 (shared)
_result = TclString.NewInstance(string.Empty); // _nullResult; // correcponds to iPtr->objResultPtr
_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 = 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)
{
Debug.WriteLine(GetResult().ToString());
SupportClass.WriteStackTrace(e, Console.Error);
throw new TclRuntimeError("unexpected TclException: " + e.Message, e);
}
}
public TCL.CompletionCode CmdProc(Interp interp, TclObject[] objv)
{
string optLevel;
int result;
CallFrame savedVarFrame, frame;
int objc = objv.Length;
int objv_index;
TclObject cmd;
if (objv.Length < 2)
{
throw new TclNumArgsException(interp, 1, objv, "?level? command ?arg ...?");
}
// Find the level to use for executing the command.
optLevel = objv[1].ToString();
// Java does not support passing a reference by refernece so use an array
CallFrame[] frameArr = new CallFrame[1];
result = CallFrame.GetFrame(interp, optLevel, frameArr);
frame = frameArr[0];
objc -= (result + 1);
if (objc == 0)
{
throw new TclNumArgsException(interp, 1, objv, "?level? command ?arg ...?");
}
objv_index = (result + 1);
// Modify the interpreter state to execute in the given frame.
savedVarFrame = interp.VarFrame;
interp.VarFrame = frame;
// Execute the residual arguments as a command.
if (objc == 1)
{
cmd = objv[objv_index];
}
else
{
cmd = TclString.NewInstance(Util.concat(objv_index, objv.Length - 1, objv));
}
cmd.Preserve();
try
{
interp.Eval(cmd, 0);
}
catch (TclException e)
{
if (e.GetCompletionCode() == TCL.CompletionCode.ERROR)
{
interp.AddErrorInfo("\n (\"uplevel\" body line " + interp._errorLine + ")");
}
throw;
}
finally
{
interp.VarFrame = savedVarFrame;
cmd.Release();
}
return(TCL.CompletionCode.RETURN);
}
