Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | repair tclx profile command for 8.6 |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
c29648d90f7440aa230690265469b5d7 |
| User & Date: | chw 2016-11-21 13:34:00.363 |
References
|
2016-11-21
| ||
| 19:27 | simplification of check-in [c29648d90f] check-in: eec9d69bc1 user: chw tags: trunk | |
Context
|
2016-11-21
| ||
| 14:36 | add missing files to vu widgets directory check-in: 26fbc863bd user: chw tags: trunk | |
| 13:34 | repair tclx profile command for 8.6 check-in: c29648d90f user: chw tags: trunk | |
|
2016-11-19
| ||
| 19:11 | another cleanup in vu widgets check-in: ec154d64d1 user: chw tags: trunk | |
Changes
Changes to jni/tclx/generic/tclXprofile.c.
| ︙ | ︙ | |||
14 15 16 17 18 19 20 21 22 23 24 25 26 27 | *----------------------------------------------------------------------------- * $Id: tclXprofile.c,v 1.4 2009/10/13 19:28:23 kot Exp $ *----------------------------------------------------------------------------- */ #include "tclExtdInt.h" /* * For when the level is not known. */ #define UNKNOWN_LEVEL -1 /* * Stack entry used to keep track of an profiling information for procedures | > > > > > > > > | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | *----------------------------------------------------------------------------- * $Id: tclXprofile.c,v 1.4 2009/10/13 19:28:23 kot Exp $ *----------------------------------------------------------------------------- */ #include "tclExtdInt.h" /* * On Tcl 8.6 and newer, use Tcl_CreateObjTrace() etc. */ #if TCL_MAJOR_VERSION > 8 || \ (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION >= 6) #define OBJ_AND_NRE 1 #endif /* * For when the level is not known. */ #define UNKNOWN_LEVEL -1 /* * Stack entry used to keep track of an profiling information for procedures |
| ︙ | ︙ | |||
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 |
Tcl_Trace traceHandle; /* Handle to current trace. */
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. */
int evalLevel; /* Eval level when invoked. */
clock_t realTime; /* Current real and CPU time. */
clock_t cpuTime;
clock_t prevRealTime; /* Real and CPU time of previous */
clock_t prevCpuTime; /* trace. */
int updatedTimes; /* Has current times been updated?*/
profEntry_t *stackPtr; /* Proc/command nesting stack. */
| > > > > > > > | 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 |
Tcl_Trace traceHandle; /* Handle to current trace. */
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 */
#ifdef OBJ_AND_NRE
Tcl_ObjCmdProc *savedNreProc;
#endif
ClientData savedObjCmdClientData; /* and clientData. */
#ifdef OBJ_AND_NRE
Tcl_CmdDeleteProc *savedDeleteProc;
ClientData savedDeleteData;
#endif
int evalLevel; /* Eval level when invoked. */
clock_t realTime; /* Current real and CPU time. */
clock_t cpuTime;
clock_t prevRealTime; /* Real and CPU time of previous */
clock_t prevCpuTime; /* trace. */
int updatedTimes; /* Has current times been updated?*/
profEntry_t *stackPtr; /* Proc/command nesting stack. */
|
| ︙ | ︙ | |||
127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 |
static int
ProfObjCommandEval _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp,
int objc,
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));
| > > > > > > > > > > > > > > > > > > > > > | | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 |
static int
ProfObjCommandEval _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[]));
#ifdef OBJ_AND_NRE
static int
ProfNreCommandEval _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *CONST objv[]));
static void
ProfCommandDelete _ANSI_ARGS_((ClientData clientData));
#endif
#ifdef OBJ_AND_NRE
static int
ProfObjTraceRoutine _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp,
int evalLevel,
const char *command,
Tcl_Command cmd,
int objc,
Tcl_Obj *const objv[]));
#else
static void
ProfTraceRoutine _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp,
int evalLevel,
char *command,
Tcl_CmdProc *cmdProc,
ClientData cmdClientData,
int argc,
char **argv));
#endif
static void
CleanDataTable _ANSI_ARGS_((profInfo_t *infoPtr));
static void
InitializeProcStack _ANSI_ARGS_((profInfo_t *infoPtr,
CallFrame *framePtr));
|
| ︙ | ︙ | |||
414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 |
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;
fullCmdNamePtr = Tcl_NewObj ();
Tcl_GetCommandFullName (infoPtr->interp, (Tcl_Command) currentCmdPtr,
fullCmdNamePtr);
fullCmdName = Tcl_GetStringFromObj (fullCmdNamePtr, NULL);
/*
| > > > > > > > > > > > > > > > > > | 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 |
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;
#ifdef OBJ_AND_NRE
if (currentCmdPtr->nreProc == ProfNreCommandEval)
currentCmdPtr->nreProc = infoPtr->savedNreProc;
#endif
if (currentCmdPtr->objClientData == (ClientData) infoPtr)
currentCmdPtr->objClientData = infoPtr->savedObjCmdClientData;
#ifdef OBJ_AND_NRE
if (currentCmdPtr->deleteProc == ProfCommandDelete) {
currentCmdPtr->deleteProc = infoPtr->savedDeleteProc;
currentCmdPtr->deleteData = infoPtr->savedDeleteData;
}
#endif
infoPtr->currentCmdPtr = NULL;
infoPtr->savedStrCmdProc = NULL;
infoPtr->savedStrCmdClientData = NULL;
infoPtr->savedObjCmdProc = NULL;
#ifdef OBJ_AND_NRE
infoPtr->savedNreProc = NULL;
#endif
infoPtr->savedObjCmdClientData = NULL;
#ifdef OBJ_AND_NRE
infoPtr->savedDeleteProc = NULL;
infoPtr->savedDeleteData = NULL;
#endif
fullCmdNamePtr = Tcl_NewObj ();
Tcl_GetCommandFullName (infoPtr->interp, (Tcl_Command) currentCmdPtr,
fullCmdNamePtr);
fullCmdName = Tcl_GetStringFromObj (fullCmdNamePtr, NULL);
/*
|
| ︙ | ︙ | |||
460 461 462 463 464 465 466 |
*/
isProc = (TclFindProc (iPtr, fullCmdName) != NULL);
if (infoPtr->commandMode || isProc) {
UpdateTOSTimes (infoPtr);
if (isProc) {
PushEntry (infoPtr, fullCmdName, TRUE,
procLevel + 1, scopeLevel + 1, infoPtr->evalLevel);
| | | 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 |
*/
isProc = (TclFindProc (iPtr, fullCmdName) != NULL);
if (infoPtr->commandMode || isProc) {
UpdateTOSTimes (infoPtr);
if (isProc) {
PushEntry (infoPtr, fullCmdName, TRUE,
procLevel + 1, scopeLevel + 1, infoPtr->evalLevel);
} else if (infoPtr->commandMode) {
PushEntry (infoPtr, fullCmdName, FALSE,
procLevel, scopeLevel, infoPtr->evalLevel);
}
}
/*
* Leaving profiler, must get time again when we reenter.
|
| ︙ | ︙ | |||
567 568 569 570 571 572 573 574 575 576 577 578 579 580 |
result = (*currentCmdPtr->objProc) (currentCmdPtr->objClientData, interp,
objc, objv);
ProfCommandEvalFinishup (infoPtr, isProc);
return result;
}
/*-----------------------------------------------------------------------------
* ProfTraceRoutine --
* Routine called by Tcl_Eval to do profiling. It intercepts the current
* command being executed by temporarily editing the command table.
*-----------------------------------------------------------------------------
*/
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 |
result = (*currentCmdPtr->objProc) (currentCmdPtr->objClientData, interp,
objc, objv);
ProfCommandEvalFinishup (infoPtr, isProc);
return result;
}
#ifdef OBJ_AND_NRE
/*-----------------------------------------------------------------------------
* ProfNreCommandEval --
* Function to evaluate a NRE object command. The procedure trace routine
* substitutes this function for the command executor function in the Tcl
* command table. We restore the command table, record data about the start
* of the command and then actually execute the command. When the command
* returns, we record data about the time it took.
*
* FIX: This all falls apart if another trace is executed between the
* doctoring of the command entry and this function being called.
*-----------------------------------------------------------------------------
*/
static int
ProfNreCommandEval (clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
profInfo_t *infoPtr = (profInfo_t *) clientData;
Command *currentCmdPtr;
int isProc, result;
currentCmdPtr = ProfCommandEvalSetup (infoPtr,
&isProc);
result = (*currentCmdPtr->nreProc) (currentCmdPtr->objClientData, interp,
objc, objv);
ProfCommandEvalFinishup (infoPtr, isProc);
return result;
}
/*-----------------------------------------------------------------------------
* ProfCommandDelete --
* Function to handle command deletion. PANIC for now.
*-----------------------------------------------------------------------------
*/
static void
ProfCommandDelete (clientData)
ClientData clientData;
{
panic (PROF_PANIC, 7);
}
/*-----------------------------------------------------------------------------
* ProfObjTraceRoutine --
* Routine called by Tcl_Eval to do profiling. It intercepts the current
* command being executed by temporarily editing the command table.
*-----------------------------------------------------------------------------
*/
static int
ProfObjTraceRoutine (clientData, interp, evalLevel, command, cmd,
objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int evalLevel;
const char *command;
Tcl_Command cmd;
int objc;
Tcl_Obj *const objv[];
{
profInfo_t *infoPtr = (profInfo_t *) clientData;
Command *cmdPtr;
if (infoPtr->currentCmdPtr != NULL)
panic (PROF_PANIC, 3);
cmdPtr = (Command *) cmd;
/*
* If command is to be compiled, we can't profile it.
*/
if (cmdPtr->compileProc != NULL)
return TCL_OK;
/*
* Save current state information.
*/
infoPtr->currentCmdPtr = cmdPtr;
infoPtr->savedStrCmdProc = cmdPtr->proc;
infoPtr->savedStrCmdClientData = cmdPtr->clientData;
infoPtr->savedObjCmdProc = cmdPtr->objProc;
infoPtr->savedNreProc = cmdPtr->nreProc;
infoPtr->savedObjCmdClientData = cmdPtr->objClientData;
infoPtr->savedDeleteProc = cmdPtr->deleteProc;
infoPtr->savedDeleteData = cmdPtr->deleteData;
infoPtr->evalLevel = evalLevel;
/*
* Force our routines to be called.
*/
cmdPtr->proc = ProfStrCommandEval;
cmdPtr->clientData = (ClientData) infoPtr;
cmdPtr->objProc = ProfObjCommandEval;
if (cmdPtr->nreProc != NULL) {
cmdPtr->nreProc = ProfNreCommandEval;
}
cmdPtr->objClientData = (ClientData) infoPtr;
cmdPtr->deleteProc = ProfCommandDelete;
cmdPtr->deleteData = (ClientData) infoPtr;
return TCL_OK;
}
#else
/*-----------------------------------------------------------------------------
* ProfTraceRoutine --
* Routine called by Tcl_Eval to do profiling. It intercepts the current
* command being executed by temporarily editing the command table.
*-----------------------------------------------------------------------------
*/
|
| ︙ | ︙ | |||
625 626 627 628 629 630 631 632 633 634 635 636 637 638 |
* Force our routines to be called.
*/
cmdPtr->proc = ProfStrCommandEval;
cmdPtr->clientData = (ClientData) infoPtr;
cmdPtr->objProc = ProfObjCommandEval;
cmdPtr->objClientData = (ClientData) infoPtr;
}
/*-----------------------------------------------------------------------------
* CleanDataTable --
* Clean up the hash data table, releasing all resources and setting it
* to the empty state.
*
* Parameters:
| > | 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 |
* Force our routines to be called.
*/
cmdPtr->proc = ProfStrCommandEval;
cmdPtr->clientData = (ClientData) infoPtr;
cmdPtr->objProc = ProfObjCommandEval;
cmdPtr->objClientData = (ClientData) infoPtr;
}
#endif /* OBJ_AND_NRE */
/*-----------------------------------------------------------------------------
* CleanDataTable --
* Clean up the hash data table, releasing all resources and setting it
* to the empty state.
*
* Parameters:
|
| ︙ | ︙ | |||
706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 |
{
Interp *iPtr = (Interp *) infoPtr->interp;
int scopeLevel;
profEntry_t *scanPtr;
CleanDataTable (infoPtr);
infoPtr->traceHandle =
Tcl_CreateTrace (infoPtr->interp, MAXINT,
(Tcl_CmdTraceProc *) ProfTraceRoutine,
(ClientData) infoPtr);
infoPtr->commandMode = commandMode;
infoPtr->evalMode = evalMode;
infoPtr->realTime = 0;
infoPtr->cpuTime = 0;
infoPtr->prevRealTime = 0;
infoPtr->prevCpuTime = 0;
infoPtr->updatedTimes = FALSE;
| > > > > > > > > > | 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 |
{
Interp *iPtr = (Interp *) infoPtr->interp;
int scopeLevel;
profEntry_t *scanPtr;
CleanDataTable (infoPtr);
#ifdef OBJ_AND_NRE
infoPtr->traceHandle =
Tcl_CreateObjTrace (infoPtr->interp, MAXINT,
infoPtr->commandMode ? 0 :
TCL_ALLOW_INLINE_COMPILATION,
(Tcl_CmdObjTraceProc *) ProfObjTraceRoutine,
(ClientData) infoPtr, NULL);
#else
infoPtr->traceHandle =
Tcl_CreateTrace (infoPtr->interp, MAXINT,
(Tcl_CmdTraceProc *) ProfTraceRoutine,
(ClientData) infoPtr);
#endif
infoPtr->commandMode = commandMode;
infoPtr->evalMode = evalMode;
infoPtr->realTime = 0;
infoPtr->cpuTime = 0;
infoPtr->prevRealTime = 0;
infoPtr->prevCpuTime = 0;
infoPtr->updatedTimes = FALSE;
|
| ︙ | ︙ | |||
973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 |
infoPtr->traceHandle = NULL;
infoPtr->commandMode = FALSE;
infoPtr->evalMode = FALSE;
infoPtr->currentCmdPtr = NULL;
infoPtr->savedStrCmdProc = NULL;
infoPtr->savedStrCmdClientData = NULL;
infoPtr->savedObjCmdProc = NULL;
infoPtr->savedObjCmdClientData = NULL;
infoPtr->evalLevel = UNKNOWN_LEVEL;
infoPtr->realTime = 0;
infoPtr->cpuTime = 0;
infoPtr->prevRealTime = 0;
infoPtr->prevCpuTime = 0;
infoPtr->updatedTimes = FALSE;
infoPtr->stackPtr = NULL;
infoPtr->stackSize = 0;
infoPtr->scopeChainPtr = NULL;
Tcl_InitHashTable (&infoPtr->profDataTable, TCL_STRING_KEYS);
Tcl_CallWhenDeleted (interp, ProfMonCleanUp, (ClientData) infoPtr);
Tcl_CreateObjCommand (interp,
| > > > > > > > | | | < < < | 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 |
infoPtr->traceHandle = NULL;
infoPtr->commandMode = FALSE;
infoPtr->evalMode = FALSE;
infoPtr->currentCmdPtr = NULL;
infoPtr->savedStrCmdProc = NULL;
infoPtr->savedStrCmdClientData = NULL;
infoPtr->savedObjCmdProc = NULL;
#ifdef OBJ_AND_NRE
infoPtr->savedNreProc = NULL;
#endif
infoPtr->savedObjCmdClientData = NULL;
#ifdef OBJ_AND_NRE
infoPtr->savedDeleteProc = NULL;
infoPtr->savedDeleteData = NULL;
#endif
infoPtr->evalLevel = UNKNOWN_LEVEL;
infoPtr->realTime = 0;
infoPtr->cpuTime = 0;
infoPtr->prevRealTime = 0;
infoPtr->prevCpuTime = 0;
infoPtr->updatedTimes = FALSE;
infoPtr->stackPtr = NULL;
infoPtr->stackSize = 0;
infoPtr->scopeChainPtr = NULL;
Tcl_InitHashTable (&infoPtr->profDataTable, TCL_STRING_KEYS);
Tcl_CallWhenDeleted (interp, ProfMonCleanUp, (ClientData) infoPtr);
Tcl_CreateObjCommand (interp,
"profile",
TclX_ProfileObjCmd,
(ClientData) infoPtr,
(Tcl_CmdDeleteProc*) NULL);
}
|