kpriv/freebsd-ports
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity
freebsd-ports/lang/tclX/files/patch-profile
Mikhail Teterin a4d1570b48 After a lively discussion with Tcl developers, fix the TclX 
profile-code to use the official API-calls instead of modifying
Tcl's internal data-structures directly.

The profile command now works again. Will try to have the change
committed upstream.
2014-08-02 00:39:42 +00:00

362 lines
13 KiB
Text
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

Change TclXOSElapsedTime to better handles clock_t being too narrow
(32-bit on FreeBSD).
Getting it committed upstream...
-mi
--- unix/tclXunixOS.c 2005-07-12 15:03:15.000000000 -0400
+++ unix/tclXunixOS.c 2009-11-27 02:00:57.000000000 -0500
@@ -550,4 +550,10 @@
* o realTime - Elapsed real time, in milliseconds is returned here.
* o cpuTime - Elapsed CPU time, in milliseconds is returned here.
+ *
+ * XXX In some cases, clock_t may not be wide enough, such as when it is
+ * XXX a signed 32-bit value, its maximum is 2^31 or 2147483648. There
+ * XXX are more milliseconds in 25 days: 25*1000*60*60*24 = 2160000000.
+ * XXX If a profile-session is to last longer than that, the API needs
+ * XXX to use 64-bit values. -mi Nov 27, 2009
*-----------------------------------------------------------------------------
*/
@@ -557,4 +563,5 @@
clock_t *cpuTime;
{
+ struct tms cpuTimes;
/*
* If times returns elapsed real time, this is easy. If it returns a status,
@@ -562,25 +569,34 @@
*/
#ifndef TIMES_RETS_STATUS
- struct tms cpuTimes;
+ static clock_t startTime;
+ clock_t currentTime;
- *realTime = TclXOSTicksToMS (times (&cpuTimes));
- *cpuTime = TclXOSTicksToMS (cpuTimes.tms_utime + cpuTimes.tms_stime);
+ /*
+ * If this is the first call, get base time.
+ */
+ currentTime = times (&cpuTimes);
+ if (startTime == 0) {
+ startTime = currentTime;
+ *realTime = 0;
+ } else
+ *realTime = TclXOSTicksToMS (currentTime - startTime);
#else
static struct timeval startTime = {0, 0};
struct timeval currentTime;
- struct tms cpuTimes;
/*
* If this is the first call, get base time.
*/
- if ((startTime.tv_sec == 0) && (startTime.tv_usec == 0))
+ if ((startTime.tv_sec == 0) && (startTime.tv_usec == 0)) {
gettimeofday (&startTime, NULL);
-
- gettimeofday (&currentTime, NULL);
- currentTime.tv_sec = currentTime.tv_sec - startTime.tv_sec;
- currentTime.tv_usec = currentTime.tv_usec - startTime.tv_usec;
- *realTime = (currentTime.tv_sec * 1000) + (currentTime.tv_usec / 1000);
+ *realTime = 0;
+ } else {
+ gettimeofday (&currentTime, NULL);
+ currentTime.tv_sec = currentTime.tv_sec - startTime.tv_sec;
+ currentTime.tv_usec = currentTime.tv_usec - startTime.tv_usec;
+ *realTime = (currentTime.tv_sec * 1000) + (currentTime.tv_usec / 1000);
+ }
times (&cpuTimes);
- *cpuTime = TclXOSTicksToMS (cpuTimes.tms_utime + cpuTimes.tms_stime);
#endif
+ *cpuTime = TclXOSTicksToMS (cpuTimes.tms_utime + cpuTimes.tms_stime);
}
--- unix/tclXunixPort.h 2005-10-07 19:30:28.000000000 -0400
+++ unix/tclXunixPort.h 2009-11-27 02:31:15.000000000 -0500
@@ -66,4 +66,10 @@
* Make sure CLK_TCK is defined.
*/
+#ifdef __FreeBSD__
+# if defined(CLK_TCK) && CLK_TCK == 128
+# undef CLK_TCK
+# define CLK_TCK sysconf(_SC_CLK_TCK)
+# endif
+#endif
#ifndef CLK_TCK
# ifdef HZ
See:
http://core.tcl.tk/tcl/tktview?name=cd82cec7ce46a55af099b32b798398a78a505ef4
for background of this patch.
-mi
--- 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);
}
-
-
-
Reference in a new issue View git blame Copy permalink