1/* -*- Mode: c++ -*- 2 * $Id: xotclProfile.c,v 1.2 2006/02/18 22:17:33 neumann Exp $ 3 * 4 * Extended Object Tcl (XOTcl) 5 * 6 * Copyright (C) 1999-2008 Gustaf Neumann, Uwe Zdun 7 * 8 * 9 * xotclProfile.c -- 10 * 11 * Profiling information printout for XOTcl 12 * 13 * For profiling infos PROFILE (xotcl.h) flag must be activated 14 * 15 */ 16 17#include "xotclInt.h" 18 19#if defined(PROFILE) 20void 21XOTclProfileFillTable(Tcl_HashTable* table, Tcl_DString* key, 22 double totalMicroSec) { 23 Tcl_HashEntry* hPtr; 24 char* keyStr = Tcl_DStringValue(key); 25 long int* value; 26 27 hPtr = Tcl_FindHashEntry(table, keyStr); 28 if (!hPtr) { 29 int nw; 30 hPtr = Tcl_CreateHashEntry(table, keyStr, &nw); 31 if (!nw) 32 return; 33 value = (long int*) ckalloc (sizeof(long int)); 34 *value = 0; 35 Tcl_SetHashValue(hPtr, (ClientData) value); 36 } else 37 value = (long int*) Tcl_GetHashValue (hPtr); 38 39 *value += totalMicroSec; 40 41 42 /* { 43 long int* d = (long int*) Tcl_GetHashValue (hPtr); 44 fprintf(stderr, "Entered %s ... %ld\n", Tcl_GetHashKey(table, hPtr), *d); 45 }*/ 46 47} 48 49void 50XOTclProfileEvaluateData(Tcl_Interp* interp, long int startSec, long int startUsec, 51 XOTclObject* obj, XOTclClass *cl, char *methodName) { 52 double totalMicroSec; 53 struct timeval trt; 54 Tcl_DString objectKey, methodKey; 55 56 XOTclProfile* profile = &RUNTIME_STATE(interp)->profile; 57 58 gettimeofday(&trt, NULL); 59 60 totalMicroSec = (trt.tv_sec - startSec) * 1000000 + 61 (trt.tv_usec - startUsec); 62 63 profile->overallTime += totalMicroSec; 64 65 if (obj->teardown == 0 || !obj->id || obj->destroyCalled) 66 return; 67 68 ALLOC_DSTRING(&objectKey, ObjStr(obj->cmdName)); 69 70 if (cl) 71 ALLOC_DSTRING(&methodKey, ObjStr(cl->object.cmdName)); 72 else 73 ALLOC_DSTRING(&methodKey, ObjStr(obj->cmdName)); 74 Tcl_DStringAppend(&methodKey, "->", 2); 75 Tcl_DStringAppend(&methodKey, methodName, -1); 76 if (cl) 77 Tcl_DStringAppend(&methodKey, " (instproc)", 11); 78 else 79 Tcl_DStringAppend(&methodKey, " (proc)", 7); 80 81 XOTclProfileFillTable(&profile->objectData, &objectKey, totalMicroSec); 82 XOTclProfileFillTable(&profile->methodData, &methodKey, totalMicroSec); 83 DSTRING_FREE(&objectKey); 84 DSTRING_FREE(&methodKey); 85} 86 87void 88XOTclProfilePrintTable(Tcl_HashTable* table) { 89 Tcl_HashEntry* topValueHPtr; 90 long int* topValue; 91 92 do { 93 Tcl_HashSearch hSrch; 94 Tcl_HashEntry* hPtr = table ? 95 Tcl_FirstHashEntry(table, &hSrch) : 0; 96 char* topKey = 0; 97 98 topValueHPtr = 0; 99 topValue = 0; 100 101 for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) { 102 long int *val = (long int*) Tcl_GetHashValue(hPtr); 103 if (val && (!topValue || (topValue && *val >= *topValue))) { 104 topValue = val; 105 topValueHPtr = hPtr; 106 topKey = Tcl_GetHashKey(table, hPtr); 107 } 108 } 109 110 if (topValueHPtr) { 111 fprintf(stderr, " %15ld %s\n", *topValue, topKey); 112 ckfree((char*) topValue); 113 Tcl_DeleteHashEntry(topValueHPtr); 114 } 115 } while (topValueHPtr); 116} 117 118void 119XOTclProfilePrintData(Tcl_Interp *interp) { 120 XOTclProfile* profile = &RUNTIME_STATE(interp)->profile; 121 122 fprintf(stderr, "------------------------------------------------------------------\n"); 123 fprintf(stderr, "\nXOTcl Profile Information\n\n"); 124 fprintf(stderr, "------------------------------------------------------------------\n"); 125 fprintf(stderr, "Overall Elapsed Time %ld\n", 126 profile->overallTime); 127 fprintf(stderr, "------------------------------------------------------------------\n"); 128 fprintf(stderr, " MICROSECONDS OBJECT-NAME\n"); 129 XOTclProfilePrintTable(&profile->objectData); 130 fprintf(stderr, "------------------------------------------------------------------\n"); 131 fprintf(stderr, " MICROSECONDS (CL/OBJ)->METHOD-NAME\n"); 132 XOTclProfilePrintTable(&profile->methodData); 133 fprintf(stderr, "------------------------------------------------------------------\n"); 134} 135 136void 137XOTclProfileInit(Tcl_Interp *interp) { 138 RUNTIME_STATE(interp)->profile.overallTime = 0; 139 Tcl_InitHashTable(&RUNTIME_STATE(interp)->profile.objectData, 140 TCL_STRING_KEYS); 141 Tcl_InitHashTable(&RUNTIME_STATE(interp)->profile.methodData, 142 TCL_STRING_KEYS); 143} 144 145#endif 146