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