summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2013-08-22 20:21:15 (GMT)
committerdgp <dgp@users.sourceforge.net>2013-08-22 20:21:15 (GMT)
commitf12764701b58ae91225b1ce8311378ef722b7a00 (patch)
tree1e723e49d8ea5057c363a70eb2f2578fae3b529b /generic
parentf8dfc60a3d144141a5b93a3b9326e162cbf5cdef (diff)
downloadtcl-f12764701b58ae91225b1ce8311378ef722b7a00.zip
tcl-f12764701b58ae91225b1ce8311378ef722b7a00.tar.gz
tcl-f12764701b58ae91225b1ce8311378ef722b7a00.tar.bz2
Make Dispatch() the single point for calling a Tcl_ObjCmdProc, and attach
the DTRACE machinery there (one place, not two).
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c91
1 files changed, 32 insertions, 59 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c1032f9..5371f31 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4196,6 +4196,31 @@ TclNREvalObjv(
}
}
+ /*
+ * Fix the original callback to point to the now known cmdPtr. Insure that
+ * the Command struct lives until the command returns.
+ */
+
+ *cmdPtrPtr = cmdPtr;
+ cmdPtr->refCount++;
+
+ TclNRAddCallback(interp, Dispatch,
+ cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc,
+ cmdPtr->objClientData, INT2PTR(objc), objv);
+ return TCL_OK;
+}
+
+static int
+Dispatch(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_ObjCmdProc *objProc = data[0];
+ ClientData clientData = data[1];
+ int objc = PTR2INT(data[2]);
+ Tcl_Obj **objv = data[3];
+ Interp *iPtr = (Interp *) interp;
#ifdef USE_DTRACE
if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
@@ -4216,41 +4241,17 @@ TclNREvalObjv(
TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
TclDecrRefCount(info);
}
- if (TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) {
+ if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED())
+ && objc) {
TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL);
}
- if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
+ if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
(Tcl_Obj **)(objv + 1));
}
#endif /* USE_DTRACE */
- /*
- * Fix the original callback to point to the now known cmdPtr. Insure that
- * the Command struct lives until the command returns.
- */
-
- *cmdPtrPtr = cmdPtr;
- cmdPtr->refCount++;
-
- TclNRAddCallback(interp, Dispatch, cmdPtr, INT2PTR(objc), objv, NULL);
- return TCL_OK;
-}
-
-static int
-Dispatch(
- ClientData data[],
- Tcl_Interp *interp,
- int result)
-{
- Command *cmdPtr = data[0];
- int objc = PTR2INT(data[1]);
- Tcl_Obj **objv = data[2];
- if (cmdPtr->nreProc) {
- return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv);
- } else {
- return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
- }
+ return objProc(clientData, interp, objc, objv);
}
int
@@ -7981,39 +7982,11 @@ Tcl_NRCallObjProc(
int objc,
Tcl_Obj *const objv[])
{
- int result = TCL_OK;
NRE_callback *rootPtr = TOP_CB(interp);
-#ifdef USE_DTRACE
- if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
- const char *a[10];
- int i = 0;
-
- while (i < 10) {
- a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
- }
- TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
- a[8], a[9]);
- }
- if (TCL_DTRACE_CMD_INFO_ENABLED() && ((Interp *) interp)->cmdFramePtr) {
- Tcl_Obj *info = TclInfoFrame(interp, ((Interp *) interp)->cmdFramePtr);
- const char *a[6]; int i[2];
-
- TclDTraceInfo(info, a, i);
- TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
- TclDecrRefCount(info);
- }
- if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED())
- && objc) {
- TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL);
- }
- if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
- TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
- (Tcl_Obj **)(objv + 1));
- }
-#endif /* USE_DTRACE */
- result = objProc(clientData, interp, objc, objv);
- return TclNRRunCallbacks(interp, result, rootPtr);
+ TclNRAddCallback(interp, Dispatch, objProc, clientData,
+ INT2PTR(objc), objv);
+ return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}
/*