kpriv/freebsd-ports
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity
freebsd-ports/lang/tclX/files/patch-profile

363 lines
13 KiB
Text
Raw Normal View History

Upgrade from 8.4 to 8.4.1. The "profile" functionality remains completely broken, when compiled against Tcl-8.6 Fix the bundled self-tests. PR: 192287 Submitted by: gahr
2014-08-01 23:09:00 +02:00
Change TclXOSElapsedTime to better handles clock_t being too narrow
(32-bit on FreeBSD).
Allow building against any Tcl, rather than limit to 8.4. Both 8.3 should now work properly. Add patch to fix profiling on 8.5 AND whenever the system has been up for more than 25 days -- the latter used to overflow the clock_t-sized variables, because TclX uses these 31-bit values to store milliseconds. Use the proper method to obtain CLK_TCK -- if only on FreeBSD.
2009-11-27 08:34:35 +01:00
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
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 02:39:42 +02:00
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 Copy permalink