void
XOTclProfileInit(Tcl_Interp *interp) {
RUNTIME_STATE(interp)->profile.overallTime = 0;
Tcl_InitHashTable(&RUNTIME_STATE(interp)->profile.objectData,
TCL_STRING_KEYS);
Tcl_InitHashTable(&RUNTIME_STATE(interp)->profile.methodData,
TCL_STRING_KEYS);
}
void
Nsf_PointerExit(Tcl_Interp *interp) {
nonnull_assert(interp != NULL);
NsfMutexLock(&pointerMutex);
if (--pointerTableRefCount == 0) {
if (RUNTIME_STATE(interp)->logSeverity == NSF_LOG_DEBUG) {
Tcl_HashSearch hSrch;
const Tcl_HashEntry *hPtr;
for (hPtr = Tcl_FirstHashEntry(pointerHashTablePtr, &hSrch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSrch)) {
const char *key = Tcl_GetHashKey(pointerHashTablePtr, hPtr);
const void *valuePtr = Tcl_GetHashValue(hPtr);
/*
* We can't use NsfLog here any more, since the Tcl procs are
* already deleted.
*/
fprintf(stderr, "Nsf_PointerExit: we have still an entry %s with value %p\n", key, valuePtr);
}
}
Tcl_DeleteHashTable(pointerHashTablePtr);
}
/*fprintf(stderr, "Nsf_PointerExit pointerTableRefCount == %d\n", pointerTableRefCount);*/
NsfMutexUnlock(&pointerMutex);
}
void
XOTclCallStackDump(Tcl_Interp *interp) {
XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs;
XOTclCallStackContent *csc;
int i=1, entries = cs->top - cs->content;
fprintf (stderr, " XOTCL CALLSTACK: (%d entries, top: %p) \n", entries, cs->top);
for (csc = &cs->content[1]; csc <= cs->top; csc++) {
fprintf(stderr, " %d: %p ",i++,csc);
if (csc->self)
fprintf(stderr, "OBJ %s (%p), ", ObjStr(csc->self->cmdName), csc->self);
if (csc->cl)
fprintf(stderr, "INSTPROC %s->", className(csc->cl));
else
fprintf(stderr, "PROC ");
/*fprintf(stderr, " cmd %p, obj %p, ",csc->cmdPtr, csc->self);*/
if (csc->cmdPtr && !csc->destroyedCmd)
fprintf(stderr, "%s (%p), ", Tcl_GetCommandName(interp, (Tcl_Command)csc->cmdPtr),
csc->cmdPtr);
else
fprintf(stderr, "NULL, ");
fprintf(stderr, "frameType: %d, ", csc->frameType);
fprintf(stderr, "callType: %d ", csc->callType);
fprintf(stderr, "cframe %p ", csc->currentFramePtr);
if (csc->currentFramePtr)
fprintf(stderr,"l=%d ",Tcl_CallFrame_level(csc->currentFramePtr));
if (csc->destroyedCmd)
fprintf(stderr, "--destroyed cmd set (%p) ", csc->destroyedCmd);
fprintf(stderr, "\n");
}
/*
if (entries > 0) {
XOTclCallStackContent *c;
c = XOTclCallStackFindLastInvocation(interp);
fprintf(stderr," --- findLastInvocation %p ",c);
if (c) {
if (c <= cs->top && c->currentFramePtr)
fprintf(stderr," l=%d", Tcl_CallFrame_level(c->currentFramePtr));
}
c = XOTclCallStackFindActiveFrame(interp, 1);
fprintf(stderr," findActiveFrame %p ",c);
if (c) {
if (c <= cs->top && c->currentFramePtr)
fprintf(stderr," l=%d", Tcl_CallFrame_level(c->currentFramePtr));
}
fprintf(stderr," --- \n");
}
*/
}
void
XOTclProfilePrintData(Tcl_Interp *interp) {
XOTclProfile* profile = &RUNTIME_STATE(interp)->profile;
fprintf(stderr, "------------------------------------------------------------------\n");
fprintf(stderr, "\nXOTcl Profile Information\n\n");
fprintf(stderr, "------------------------------------------------------------------\n");
fprintf(stderr, "Overall Elapsed Time %ld\n",
profile->overallTime);
fprintf(stderr, "------------------------------------------------------------------\n");
fprintf(stderr, " MICROSECONDS OBJECT-NAME\n");
XOTclProfilePrintTable(&profile->objectData);
fprintf(stderr, "------------------------------------------------------------------\n");
fprintf(stderr, " MICROSECONDS (CL/OBJ)->METHOD-NAME\n");
XOTclProfilePrintTable(&profile->methodData);
fprintf(stderr, "------------------------------------------------------------------\n");
}
void
XOTclProfileEvaluateData(Tcl_Interp* interp, long int startSec, long int startUsec,
XOTclObject* obj, XOTclClass *cl, char *methodName) {
double totalMicroSec;
struct timeval trt;
Tcl_DString objectKey, methodKey;
XOTclProfile* profile = &RUNTIME_STATE(interp)->profile;
gettimeofday(&trt, NULL);
totalMicroSec = (trt.tv_sec - startSec) * 1000000 +
(trt.tv_usec - startUsec);
profile->overallTime += totalMicroSec;
if (obj->teardown == 0 || !obj->id || obj->destroyCalled)
return;
ALLOC_DSTRING(&objectKey, ObjStr(obj->cmdName));
if (cl)
ALLOC_DSTRING(&methodKey, ObjStr(cl->object.cmdName));
else
ALLOC_DSTRING(&methodKey, ObjStr(obj->cmdName));
Tcl_DStringAppend(&methodKey, "->", 2);
Tcl_DStringAppend(&methodKey, methodName, -1);
if (cl)
Tcl_DStringAppend(&methodKey, " (instproc)", 11);
else
Tcl_DStringAppend(&methodKey, " (proc)", 7);
XOTclProfileFillTable(&profile->objectData, &objectKey, totalMicroSec);
XOTclProfileFillTable(&profile->methodData, &methodKey, totalMicroSec);
DSTRING_FREE(&objectKey);
DSTRING_FREE(&methodKey);
}