///////////////////////////////////////////////////////////////////////////////////////////////
#region Tcl Command Callbacks
///////////////////////////////////////////////////////////////////////////////////////////////
// **** WARNING ***** BEGIN CODE DIRECTLY CALLED BY THE NATIVE TCL RUNTIME ***** WARNING **** /
///////////////////////////////////////////////////////////////////////////////////////////////
//
// -- ObjCmdProc --
//
// When proc is invoked, the clientData and interp parameters will be copies of
// the clientData and interp arguments given to Tcl_CreateObjCommand. Typically,
// clientData points to an application-specific data structure that describes
// what to do when the command procedure is invoked. Objc and objv describe the
// arguments to the command, objc giving the number of argument objects
// (including the command name) and objv giving the values of the arguments. The
// objv array will contain objc values, pointing to the argument objects. Unlike
// argv[argv] used in a string-based command procedure, objv[objc] will not
// contain NULL. Additionally, when proc is invoked, it must not modify the
// contents of the objv array by assigning new pointer values to any element of
// the array (for example, objv[2] = NULL) because this will cause memory to be
// lost and the runtime stack to be corrupted. The CONST in the declaration of
// objv will cause ANSI-compliant compilers to report any such attempted
// assignment as an error. However, it is acceptable to modify the internal
// representation of any individual object argument. For instance, the user may
// call Tcl_GetIntFromObj on objv[2] to obtain the integer representation of that
// object; that call may change the type of the object that objv[2] points at,
// but will not change where objv[2] points. proc must return an integer code
// that is either TCL_OK, TCL_ERROR, TCL_RETURN, TCL_BREAK, or TCL_CONTINUE. See
// the Tcl overview man page for details on what these codes mean. Most normal
// commands will only return TCL_OK or TCL_ERROR. In addition, if proc needs to
// return a non-empty result, it can call Tcl_SetObjResult to set the
// interpreter's result. In the case of a TCL_OK return code this gives the
// result of the command, and in the case of TCL_ERROR this gives an error
// message. Before invoking a command procedure, Tcl_EvalObjEx sets interpreter's
// result to point to an object representing an empty string, so simple commands
// can return an empty result by doing nothing at all. The contents of the objv
// array belong to Tcl and are not guaranteed to persist once proc returns: proc
// should not modify them. Call Tcl_SetObjResult if you want to return something
// from the objv array.
//
private static ReturnCode ObjCmdProc(
IntPtr clientData,
IntPtr interp,
int objc,
IntPtr objv
)
{
ReturnCode code;
try
{
//
// NOTE: Rehydrate the handle from the clientData that Tcl just
// passed us.
//
GCHandle handle = GCHandle.FromIntPtr(clientData); /* throw */
//
// NOTE: Make sure the handle has a valid target.
//
if (handle.IsAllocated && (handle.Target != null))
{
//
// NOTE: Attempt to cast the handle to a TclBridge object; if this
// fails, we cannot continue to handle this call.
//
TclBridge tclBridge = handle.Target as TclBridge;
if (tclBridge != null)
{
Interlocked.Increment(ref tclBridge.objCmdProcLevels);
try
{
//
// NOTE: Grab the interpreter reference NOW, it may go bye bye if the
// TclBridge object gets disposed.
//
Interpreter interpreter = tclBridge.interpreter;
if (interpreter != null)
{
//
// NOTE: Cache the fields of the interpreter object that we will
// need to access below without holding a lock.
//
ITclApi tclApi = TclApi.GetTclApi(interpreter);
EngineFlags savedEngineFlags = interpreter.BeginExternalExecution();
bool noCacheArgument = false;
#if ARGUMENT_CACHE
if (Engine.HasNoCacheArgument(savedEngineFlags))
{
noCacheArgument = true;
}
#endif
try
{
if (tclApi != null)
{
Result result = null;
IExecute execute = tclBridge.execute;
if (execute != null)
{
ArgumentList arguments = new ArgumentList();
for (int index = 0; index < objc; index++)
{
IntPtr objPtr =
Marshal.ReadIntPtr(objv, index * IntPtr.Size);
string value =
TclWrapper.GetString(tclApi, objPtr);
if (value == null)
{
value = String.Empty;
}
arguments.Add(Argument.GetOrCreate(
interpreter, value, noCacheArgument));
}
string name = (arguments.Count > 0) ? arguments[0] : null;
try
{
code = interpreter.Execute(
name, execute, tclBridge.clientData, arguments,
ref result);
}
catch (Exception e)
{
result = String.Format(
"caught exception while executing: {0}",
e);
code = ReturnCode.Error;
}
}
else
{
result = "invalid execute object";
code = ReturnCode.Error;
}
//
// NOTE: Set the Tcl interpreter result to the result of the
// Eagle command.
//
if (!String.IsNullOrEmpty(result))
{
TclWrapper.SetResult(
tclApi, interp, TclWrapper.NewString(tclApi, result));
}
else
{
TclWrapper.ResetResult(tclApi, interp);
}
}
else
{
//
// NOTE: There is no available Tcl API object; therefore, we
// cannot set the Tcl interpreter result.
//
TraceOps.DebugTrace(
"invalid Tcl API object",
typeof(Tcl_ObjCmdProc).Name,
TracePriority.MarshalError);
code = ReturnCode.Error;
}
}
finally
{
/* IGNORED */
interpreter.EndAndCleanupExternalExecution(savedEngineFlags);
}
}
else
{
//
// NOTE: An invalid interpreter means that we have no Tcl API object to
// work with either, punt on setting the Tcl interpreter result.
//
TraceOps.DebugTrace(
"invalid interpreter",
typeof(Tcl_ObjCmdProc).Name,
TracePriority.MarshalError);
code = ReturnCode.Error;
}
}
finally
{
Interlocked.Decrement(ref tclBridge.objCmdProcLevels);
}
}
else
{
//
// NOTE: What now? We have no way of communicating with Tcl at this
// point.
//
TraceOps.DebugTrace(
"invalid Tcl bridge object",
typeof(Tcl_ObjCmdProc).Name,
TracePriority.MarshalError);
code = ReturnCode.Error;
}
}
else
{
//
// NOTE: Again, nothing we can do at this point.
//
TraceOps.DebugTrace(
"invalid GC handle",
typeof(Tcl_ObjCmdProc).Name,
TracePriority.MarshalError);
code = ReturnCode.Error;
}
}
catch (Exception e)
{
//
// NOTE: Nothing we can do here except log the failure.
//
TraceOps.DebugTrace(
e, typeof(Tcl_ObjCmdProc).Name,
TracePriority.NativeError);
//
// NOTE: At this point, we may not even be able to get to the Tcl API object
// we need to set the Tcl interpreter result; therefore, we are going
// to punt for now.
//
code = ReturnCode.Error;
}
return(code);
}
///////////////////////////////////////////////////////////////////////////////////////////////
private /* protected virtual */ void Dispose(
bool disposing
) /* throw */
{
TraceOps.DebugTrace(String.Format(
"Dispose: called, disposing = {0}, disposed = {1}",
disposing, disposed), typeof(TclBridge).Name,
TracePriority.CleanupDebug);
if (!disposed)
{
if (!this.disposing)
{
//
// NOTE: We are now disposing this object (prevent re-entrancy).
//
this.disposing = true;
//
// NOTE: This method should not normally throw; however, if it does
// we do not want our disposing flag to be stuck set to true.
//
try
{
//if (disposing)
//{
// ////////////////////////////////////
// // dispose managed resources here...
// ////////////////////////////////////
//}
//////////////////////////////////////
// release unmanaged resources here...
//////////////////////////////////////
//
// NOTE: If necessary (and possible), delete the Tcl command via the
// token we saved earlier (when the Tcl command was created).
//
ReturnCode deleteCode = ReturnCode.Ok;
Result deleteError = null;
//
// NOTE: If we have a valid command token then we are still hooked to
// Tcl via our inbound native delegates and we must unhook
// successfully or throw to prevent our internal object state
// from being made inconsistent.
//
if (token != IntPtr.Zero)
{
if (interpreter != null)
{
ITclApi tclApi = TclApi.GetTclApi(interpreter);
//
// BUGFIX: We want to force deletion of this bridged command
// if the force flag was specified upon creation OR
// if the command is not actively being used.
//
deleteCode = TclWrapper.DeleteCommandFromToken(
tclApi, interp, forceDelete || (objCmdProcLevels == 0),
ref token, ref deleteError);
}
else
{
deleteError = "invalid interpreter";
deleteCode = ReturnCode.Error;
}
}
//
// NOTE: Did we succeed in deleting the command from Tcl, if it
// was necessary?
//
if (!noComplain && (deleteCode != ReturnCode.Ok))
{
//
// NOTE: If the command deletion was necessary and it failed
// for any reason, complain very loudly.
//
DebugOps.Complain(interpreter, deleteCode, deleteError);
//
// BUGFIX: Also, we must throw an exception here to prevent
// the delegates from being disposed while Tcl still
// refers to them (tclLoad-1.2 GC race).
//
throw new ScriptException(deleteCode, deleteError);
}
//
// NOTE: If necessary, release the GCHandle that is keeping this
// object alive.
//
if (handle.IsAllocated)
{
handle.Free();
}
//
// NOTE: We do not own these objects; therefore, we just null out
// the references to them (in case we are the only thing
// keeping them alive).
//
interpreter = null;
execute = null;
clientData = null;
//
// NOTE: Zero out our Tcl interpreter. We do not delete it because
// we do not own it.
//
interp = IntPtr.Zero;
//
// NOTE: Zero out our created Tcl command token. We should not need
// to call Tcl to delete the actual command because by this time
// it should already have been deleted.
//
token = IntPtr.Zero;
//
// NOTE: Finally, we should be able to safely remove our references
// to the Tcl callback delegates at this point because we already
// deleted the Tcl command related to them.
//
objCmdProc = null;
cmdDeleteProc = null;
//
// NOTE: Zero out our command nesting level.
//
objCmdProcLevels = 0;
//
// NOTE: This object is now disposed.
//
disposed = true;
}
finally
{
//
// NOTE: We are no longer disposing this object.
//
this.disposing = false;
}
}
}
}
///////////////////////////////////////////////////////////////////////////////////////////////
#region Static "Factory" Members
public static TclBridge Create(
Interpreter interpreter,
IExecute execute,
IClientData clientData,
IntPtr interp,
string name,
bool fromThread,
bool forceDelete,
bool noComplain,
ref Result error
)
{
//
// NOTE: Create and return a TclBridge object that creates and
// associates a named Tcl command with the specified Eagle
// command.
//
// The marshalling of the command arguments and the result
// will be handled by this class (via the ObjCmdProc wrapper).
//
// Tcl command lifetime management will also be handled by
// this class (via the CmdDeleteProc).
//
// Eagle command lifetime management will also be handled by
// this class. The Tcl command will be deleted if the Eagle
// command is deleted.
//
if (interpreter != null)
{
ITclApi tclApi = TclApi.GetTclApi(interpreter);
if (TclApi.CheckModule(tclApi, ref error))
{
if (tclApi.CheckInterp(interp, ref error))
{
if (execute != null)
{
//
// NOTE: *WARNING* Empty Tcl command/procedure names are allowed,
// please do not change this to "!String.IsNullOrEmpty".
//
if (name != null)
{
//
// NOTE: Create a TclBridge object to handle the command
// callbacks from Tcl.
//
ReturnCode code = ReturnCode.Ok;
TclBridge result = null;
try
{
result = new TclBridge(
interpreter,
execute,
clientData,
interp,
new Tcl_ObjCmdProc(ObjCmdProc),
new Tcl_CmdDeleteProc(CmdDeleteProc),
IntPtr.Zero,
fromThread,
forceDelete,
noComplain);
//
// NOTE: Create the Tcl command that calls into the ObjCmdProc
// callback TclBridge dispatcher methods and save the
// created Tcl command token for later deletion.
//
code = TclWrapper.CreateCommand(
tclApi,
interp,
name,
result.objCmdProc,
GCHandle.ToIntPtr(result.handle),
result.cmdDeleteProc,
ref result.token,
ref error);
if (code == ReturnCode.Ok)
{
return(result);
}
}
catch (Exception e)
{
error = e;
code = ReturnCode.Error;
}
finally
{
if ((code != ReturnCode.Ok) &&
(result != null))
{
//
// NOTE: Dispose and clear the partially created TclBridge
// object because the Tcl command creation failed.
// This can throw an exception if the command token
// is valid and we cannot manage to delete it; however,
// since Tcl command creation is the very last step
// above, this corner case should be rare.
//
result.Dispose(); /* throw */
result = null;
}
}
}
else
{
error = "invalid command name";
}
}
else
{
error = "invalid command target";
}
}
}
}
else
{
error = "invalid interpreter";
}
return(null);
}
