Tcl Source Code

Artifact [1016e6076d]
Login

Artifact 1016e6076d3e1ac56961df32ea07fa5074aab3d9:

Attachment "tclXprofile.diff" to ticket [cd82cec7ce] added by mi 2014-08-02 00:20:51. (unpublished)
--- generic/tclXprofile.c	2012-11-06 18:00:07.000000000 -0500
+++ generic/tclXprofile.c	2014-08-01 20:10:11.000000000 -0400
@@ -68,9 +68,6 @@
     int             commandMode;           /* Prof all commands?             */
     int             evalMode;              /* Use eval stack.                */
-    Command        *currentCmdPtr;         /* Current command table entry.   */
-    Tcl_CmdProc    *savedStrCmdProc;       /* Saved string command function  */
-    ClientData      savedStrCmdClientData; /* and clientData.                */
-    Tcl_ObjCmdProc *savedObjCmdProc;       /* Saved object command function  */
-    ClientData      savedObjCmdClientData; /* and clientData.                */
+    Tcl_Command     currentCmd;            /* Current command table entry.   */
+    Tcl_CmdInfo     savedCmdInfo;          /* Details about the current cmd. */
     int             evalLevel;             /* Eval level when invoked.       */
     clock_t         realTime;              /* Current real and CPU time.     */
@@ -89,5 +86,5 @@
  * Argument to panic on logic errors.  Takes an id number.
  */
-static char *PROF_PANIC = "TclX profile bug id = %d\n";
+static const char *PROF_PANIC = "TclX profile bug id = %d\n";
 
 /*
@@ -96,5 +93,5 @@
 static void
 PushEntry _ANSI_ARGS_((profInfo_t *infoPtr,
-                       char       *cmdName,
+                       const char *cmdName,
                        int         isProc,
                        int         procLevel,
@@ -112,5 +109,5 @@
 UpdateTOSTimes _ANSI_ARGS_((profInfo_t *infoPtr));
 
-static Command *
+static void
 ProfCommandEvalSetup _ANSI_ARGS_((profInfo_t *infoPtr,
                                   int        *isProcPtr));
@@ -132,13 +129,5 @@
                                 Tcl_Obj      *CONST objv[]));
 
-static void
-ProfTraceRoutine _ANSI_ARGS_((ClientData    clientData,
-                              Tcl_Interp   *interp,
-                              int           evalLevel,
-                              char         *command,
-                              Tcl_CmdProc  *cmdProc,
-                              ClientData    cmdClientData,
-                              int           argc,
-                              char        **argv));
+static Tcl_CmdObjTraceProc ProfTraceRoutine;
 
 static void
@@ -194,5 +183,5 @@
 PushEntry (infoPtr, cmdName, isProc, procLevel, scopeLevel, evalLevel)
     profInfo_t *infoPtr;
-    char       *cmdName;
+    const char *cmdName;
     int         isProc;
     int         procLevel;
@@ -396,5 +385,5 @@
  *-----------------------------------------------------------------------------
  */
-static Command *
+static void
 ProfCommandEvalSetup (infoPtr, isProcPtr)
     profInfo_t *infoPtr;
@@ -402,31 +391,33 @@
 {
     Interp *iPtr = (Interp *) infoPtr->interp;
-    Command *currentCmdPtr;
+    Tcl_CmdInfo cmdInfo;
     CallFrame *framePtr;
     int procLevel, scopeLevel, isProc;
     Tcl_Obj *fullCmdNamePtr;
-    char *fullCmdName;
+    const char *fullCmdName;
 
+    Tcl_GetCommandInfoFromToken(infoPtr->currentCmd, &cmdInfo);
     /*
      * Restore the command table entry.  If the command has modified it, don't
      * mess with it.
      */
-    currentCmdPtr = infoPtr->currentCmdPtr;
-    if (currentCmdPtr->proc == ProfStrCommandEval)
-        currentCmdPtr->proc = infoPtr->savedStrCmdProc;
-    if (currentCmdPtr->clientData == (ClientData) infoPtr)
-        currentCmdPtr->clientData = infoPtr->savedStrCmdClientData;
-    if (currentCmdPtr->objProc == ProfObjCommandEval)
-        currentCmdPtr->objProc = infoPtr->savedObjCmdProc;
-    if (currentCmdPtr->objClientData == (ClientData) infoPtr)
-        currentCmdPtr->objClientData = infoPtr->savedObjCmdClientData;
-    infoPtr->currentCmdPtr = NULL;
-    infoPtr->savedStrCmdProc = NULL;
-    infoPtr->savedStrCmdClientData = NULL;
-    infoPtr->savedObjCmdProc = NULL;
-    infoPtr->savedObjCmdClientData = NULL;
+    if (cmdInfo.proc == ProfStrCommandEval)
+        cmdInfo.proc = infoPtr->savedCmdInfo.proc;
+    if (cmdInfo.clientData == (ClientData) infoPtr)
+        cmdInfo.clientData = infoPtr->savedCmdInfo.clientData;
+    if (cmdInfo.objProc == ProfObjCommandEval)
+        cmdInfo.objProc = infoPtr->savedCmdInfo.objProc;
+    if (cmdInfo.objClientData == (ClientData) infoPtr)
+        cmdInfo.objClientData = infoPtr->savedCmdInfo.objClientData;
+    if (cmdInfo.deleteProc == NULL)
+        cmdInfo.deleteProc = infoPtr->savedCmdInfo.deleteProc;
+    if (cmdInfo.deleteData == NULL)
+        cmdInfo.deleteData = infoPtr->savedCmdInfo.deleteData;
+    cmdInfo.isNativeObjectProc = infoPtr->savedCmdInfo.isNativeObjectProc;
+
+    Tcl_SetCommandInfoFromToken(infoPtr->currentCmd, &cmdInfo);
 
     fullCmdNamePtr = Tcl_NewObj ();
-    Tcl_GetCommandFullName (infoPtr->interp, (Tcl_Command) currentCmdPtr, 
+    Tcl_GetCommandFullName (infoPtr->interp, infoPtr->currentCmd, 
                             fullCmdNamePtr);
     fullCmdName = Tcl_GetStringFromObj (fullCmdNamePtr, NULL);
@@ -447,10 +438,11 @@
      * on the stack before we started.  Pop those entries.
      */
-    if (infoPtr->stackPtr->procLevel > procLevel)
+    if (infoPtr->stackPtr->procLevel > procLevel) {
         UpdateTOSTimes (infoPtr);
-    while (infoPtr->stackPtr->procLevel > procLevel) {
-        if (infoPtr->stackPtr->evalLevel != UNKNOWN_LEVEL) 
-            panic (PROF_PANIC, 2);  /* Not an initial entry */
-        PopEntry (infoPtr);
+        do {
+            if (infoPtr->stackPtr->evalLevel != UNKNOWN_LEVEL) 
+                panic (PROF_PANIC, 2);  /* Not an initial entry */
+            PopEntry (infoPtr);
+        } while (infoPtr->stackPtr->procLevel > procLevel);
     }
 
@@ -479,5 +471,4 @@
 
     Tcl_DecrRefCount (fullCmdNamePtr);
-    return currentCmdPtr;
 }
 
@@ -528,10 +519,9 @@
 {
     profInfo_t *infoPtr = (profInfo_t *) clientData;
-    Command *currentCmdPtr;
     int isProc, result;
 
-    currentCmdPtr = ProfCommandEvalSetup (infoPtr, &isProc);
+    ProfCommandEvalSetup (infoPtr, &isProc);
 
-    result = (*currentCmdPtr->proc) (currentCmdPtr->clientData, interp,
+    result = (*infoPtr->savedCmdInfo.proc)(infoPtr->savedCmdInfo.clientData, interp,
                                      argc, argv);
 
@@ -560,11 +550,9 @@
 {
     profInfo_t *infoPtr = (profInfo_t *) clientData;
-    Command *currentCmdPtr;
     int isProc, result;
 
-    currentCmdPtr = ProfCommandEvalSetup (infoPtr,
-                                          &isProc);
+    ProfCommandEvalSetup (infoPtr, &isProc);
 
-    result = (*currentCmdPtr->objProc) (currentCmdPtr->objClientData, interp,
+    result = (*infoPtr->savedCmdInfo.objProc)(infoPtr->savedCmdInfo.objClientData, interp,
                                         objc, objv);
 
@@ -579,54 +567,41 @@
  *-----------------------------------------------------------------------------
  */
-static void
-ProfTraceRoutine (clientData, interp, evalLevel, command, cmdProc,
-                  cmdClientData, argc, argv)
+static int
+ProfTraceRoutine (clientData, interp, evalLevel, command, cmd,
+                  objc, objv)
     ClientData    clientData;
     Tcl_Interp   *interp;
     int           evalLevel;
-    char         *command;
-    Tcl_CmdProc  *cmdProc;
-    ClientData    cmdClientData;
-    int           argc;
-    char        **argv;
+    const char   *command;
+    Tcl_Command   cmd;
+    int           objc;
+    struct Tcl_Obj * const *objv;
 {
     profInfo_t *infoPtr = (profInfo_t *) clientData;
-    Command *cmdPtr;
-    Tcl_Command cmd;
-
-    if (infoPtr->currentCmdPtr != NULL)
-        panic (PROF_PANIC, 3);
+    Tcl_CmdInfo cmdInfo;
 
-    cmd = Tcl_FindCommand (interp, argv [0], NULL, 0);
     if (cmd == NULL)
         panic (PROF_PANIC, 4);
-    cmdPtr = (Command *) cmd;
-
-    if ((cmdPtr->proc != cmdProc) || (cmdPtr->clientData != cmdClientData))
-        panic (PROF_PANIC, 5);
-
-    /*
-     * If command is to be compiled, we can't profile it.
-     */
-    if (cmdPtr->compileProc != NULL)
-        return;
 
     /*
      * Save current state information.
      */
-    infoPtr->currentCmdPtr = cmdPtr;
-    infoPtr->savedStrCmdProc = cmdPtr->proc;
-    infoPtr->savedStrCmdClientData = cmdPtr->clientData;
-    infoPtr->savedObjCmdProc = cmdPtr->objProc;
-    infoPtr->savedObjCmdClientData = cmdPtr->objClientData;
+    Tcl_GetCommandInfoFromToken(cmd, &(infoPtr->savedCmdInfo));
     infoPtr->evalLevel = evalLevel;
+    infoPtr->currentCmd = cmd;
 
     /*
      * Force our routines to be called.
      */
-    cmdPtr->proc = ProfStrCommandEval;
-    cmdPtr->clientData = (ClientData) infoPtr;
-    cmdPtr->objProc = ProfObjCommandEval;
-    cmdPtr->objClientData = (ClientData) infoPtr;
+    cmdInfo.proc = ProfStrCommandEval;
+    cmdInfo.clientData = (ClientData) infoPtr;
+    cmdInfo.objProc = ProfObjCommandEval;
+    cmdInfo.objClientData = (ClientData) infoPtr;
+    cmdInfo.isNativeObjectProc = infoPtr->savedCmdInfo.isNativeObjectProc;
+    cmdInfo.deleteProc = NULL;
+    cmdInfo.deleteData = NULL;
+    Tcl_SetCommandInfoFromToken(cmd, &cmdInfo);
+
+    return TCL_OK;
 }
 
@@ -712,7 +687,7 @@
 
     infoPtr->traceHandle =
-        Tcl_CreateTrace (infoPtr->interp, MAXINT,
-                         (Tcl_CmdTraceProc *) ProfTraceRoutine,
-                         (ClientData) infoPtr);
+        Tcl_CreateObjTrace (infoPtr->interp, 0,
+                         TCL_ALLOW_INLINE_COMPILATION, ProfTraceRoutine,
+                         (ClientData) infoPtr, NULL);
     infoPtr->commandMode = commandMode;
     infoPtr->evalMode = evalMode;
@@ -974,9 +949,5 @@
     infoPtr->commandMode = FALSE;
     infoPtr->evalMode = FALSE;
-    infoPtr->currentCmdPtr = NULL;
-    infoPtr->savedStrCmdProc = NULL;
-    infoPtr->savedStrCmdClientData = NULL;
-    infoPtr->savedObjCmdProc = NULL;
-    infoPtr->savedObjCmdClientData = NULL;
+    infoPtr->currentCmd = NULL;
     infoPtr->evalLevel = UNKNOWN_LEVEL;
     infoPtr->realTime = 0;
@@ -998,5 +969,2 @@
 			  (Tcl_CmdDeleteProc*) NULL);
 }
-
-
-