///////////////////////////////////////////////////////////////////////////////////////////////
#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);
}
///////////////////////////////////////////////////////////////////////////////////////////////
//
// -- CmdDeleteProc --
//
// DeleteProc will be invoked when (if) name is deleted. This can occur through a
// call to Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, or Tcl_DeleteInterp, or
// by replacing name in another call to Tcl_CreateObjCommand. DeleteProc is
// invoked before the command is deleted, and gives the application an
// opportunity to release any structures associated with the command.
//
private static void CmdDeleteProc(
IntPtr clientData
)
{
//
// NOTE: We need to kill the associated TclBridge object
// instance and remove any references to the bridge
// from the containing interpreter.
//
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)
{
//
// NOTE: Skip messing with the TclBridge or interpreter object if it is
// already being disposed (i.e. we are NOT being called directly
// due to the command being removed from the Tcl interpreter or
// the Tcl interpreter being deleted). The caller of the dispose
// method will handle removing the TclBridge object from the
// collection in the interpreter.
//
if (!tclBridge.disposing)
{
//
// NOTE: Grab the associated interpreter from the TclBridge
// object.
//
Interpreter interpreter = tclBridge.interpreter;
//
// NOTE: Remove all instances of the TclBridge object from its
// interpreter.
//
if (interpreter != null)
{
/* IGNORED */
interpreter.RemoveTclBridges(tclBridge);
}
//
// NOTE: Prevent the Dispose method from trying to delete the Tcl
// command itself (since it is already being deleted).
//
tclBridge.token = IntPtr.Zero;
//
// NOTE: Cleanup all the resources used by this TclBridge object.
// In theory, this object disposal can throw; however, in
// practice we know that it does not attempt to do anything
// that can actually "fail" unless it has a valid command
// token, which we have already cleared (Tcl has notified us,
// by calling this delegate, that it has already deleted the
// command in question).
//
tclBridge.Dispose(); /* throw */
}
}
else
{
TraceOps.DebugTrace(
"invalid Tcl bridge object",
typeof(Tcl_CmdDeleteProc).Name,
TracePriority.MarshalError);
}
}
else
{
TraceOps.DebugTrace(
"invalid GC handle",
typeof(Tcl_CmdDeleteProc).Name,
TracePriority.MarshalError);
}
}
catch (Exception e)
{
//
// NOTE: Nothing we can do here except log the failure.
//
TraceOps.DebugTrace(
e, typeof(Tcl_CmdDeleteProc).Name,
TracePriority.NativeError);
}
}
///////////////////////////////////////////////////////////////////////////////////////////////
#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);
}
