Make the wired-in packages code handle ndp mapping to ndp-seq or ndp-par
[ghc-hetmet.git] / utils / prof / cgprof / cgprof.c
1 /* ------------------------------------------------------------------------
2  * $Id: cgprof.c,v 1.6 2004/08/13 13:11:22 simonmar Exp $
3  *                                                                      
4  *      Copyright (C) 1995-2000 University of Oxford
5  *                                                                      
6  * Permission to use, copy, modify, and distribute this software,
7  * and to incorporate it, in whole or in part, into other software,
8  * is hereby granted without fee, provided that
9  *   (1) the above copyright notice and this permission notice appear in
10  *       all copies of the source code, and the above copyright notice
11  *       appear in clearly visible form on all supporting documentation
12  *       and distribution media;
13  *   (2) modified versions of this software be accompanied by a complete
14  *       change history describing author, date, and modifications made;
15  *       and
16  *   (3) any redistribution of the software, in original or modified
17  *       form, be without fee and subject to these same conditions.
18  * --------------------------------------------------------------------- */
19
20 #include "ghcconfig.h"
21 #if HAVE_STRING_H
22 #include <string.h>
23 #endif
24
25 #include "daVinci.h"
26 #include "symbol.h"
27 #include "cgprof.h"
28 #include "matrix.h"
29
30 /* -----------------------------------------------------------------------------
31  * Data structures
32  * -------------------------------------------------------------------------- */
33
34 int                 raw_profile_next=0;
35 int                 raw_profile_size=0;
36 parsed_cost_object *raw_profile=NULL;
37
38 /* -----------------------------------------------------------------------------
39  * Create/grow data sequence of raw profile data
40  * -------------------------------------------------------------------------- */
41
42 void enlargeRawProfile() {
43
44   if (raw_profile_size==0) {
45     raw_profile_next = 0;
46     raw_profile_size = RAW_PROFILE_INIT_SIZE;
47     raw_profile      = calloc(raw_profile_size,sizeof(parsed_cost_object));
48   } else {
49     raw_profile_size += RAW_PROFILE_INIT_SIZE;
50     raw_profile       = realloc(raw_profile,
51                                  raw_profile_size*sizeof(parsed_cost_object));
52   }
53   if (raw_profile==NULL) {
54     fprintf(stderr,"{enlargeRawProfile} unable to allocate %d elements",
55             raw_profile_size);
56     exit(1);
57   }
58 }
59
60 /* -----------------------------------------------------------------------------
61  * Function that adds two cost centers together
62  *
63  * This will be used to generate the inheretance profile.
64  * -------------------------------------------------------------------------- */
65
66 void add_costs(object_cost *left, object_cost right) {
67
68   left->syncs         += right.syncs;
69   left->comp_max      += right.comp_max;
70   left->comp_avg      += right.comp_avg;
71   left->comp_min      += right.comp_min;
72   left->comm_max      += right.comm_max;
73   left->comm_avg      += right.comm_avg;
74   left->comm_min      += right.comm_min;
75   left->comp_idle_max += right.comp_idle_max;
76   left->comp_idle_avg += right.comp_idle_avg;
77   left->comp_idle_min += right.comp_idle_min;
78   left->hrel_max      += right.hrel_max;
79   left->hrel_avg      += right.hrel_avg;
80   left->hrel_min      += right.hrel_min;
81   if ((left->proc==NULL) || (right.proc==NULL)) {
82     fprintf(stderr,"Cost is null");
83     exit(0);
84   }
85 }
86
87
88 int ignore_function(char *fname) {
89   return 0;
90 }
91
92 /* -----------------------------------------------------------------------------
93  * GHC specific data structures
94  * -------------------------------------------------------------------------- */
95
96 /* Globals */
97 /* You will need to update these when you increase the number of */
98 /*   cost centres, cost centre stacks, heap objects              */
99
100    #define MAX_IDENTIFIERS 2000 /* maximum number of identifiers */
101                                 /* or size of matrix structure   */
102
103   /* make this dynamic */
104
105    #define MAX_TIME    100      /* Maximum serial time for heap profile */
106    #define MAX_SAMPLES 50       /* Maximum heap samples */
107
108                                 /* To do: modify this to be dynamic */
109
110    #define MAX_STRING_SIZE 70
111    #define MAX_LINE_LENGTH 80
112    #define EOF (-1)
113
114 /* Cost centre data structure */
115
116    struct cost_centre { char *name;
117                         char *module;
118                         char *group;
119    } _cc_;
120
121    typedef struct cost_centre cc_matrix[MAX_IDENTIFIERS];
122
123    //typedef struct cost_centre *cc_matrix;
124
125    typedef cc_matrix* p_cc_matrix;
126    typedef char* MY_STRING;
127
128 /* Heap sample structure */
129
130    struct heap_sample { 
131                         int count; /* heap_sample */
132    };
133
134    typedef struct heap_sample heap_sample_matrix[MAX_IDENTIFIERS];
135    typedef heap_sample_matrix* p_heap_sample_matrix;
136
137 /* Cost centre stack data structure */
138
139    struct cost_centre_stack { 
140                       int cc;
141                       int ccs;
142                       int scc;   /* scc_sample  */
143                       int ticks; /* scc_sample  */
144                       int bytes; /* scc_sample  */
145                       p_heap_sample_matrix hsm; /* heap_sample */
146    };
147
148    typedef struct cost_centre_stack ccs_matrix[MAX_IDENTIFIERS];
149    typedef ccs_matrix* p_ccs_matrix;
150
151 /* Heap object data structure */
152
153    struct heap_object { int   type;            /* type of heap object */
154                         char* descriptor; 
155                         int   type_constr_ref; /* if present */
156                       };
157
158    typedef struct heap_object heap_object_matrix[MAX_IDENTIFIERS];
159    typedef heap_object_matrix* p_heap_object_matrix;
160
161 /* Type constructor structure */
162
163    struct type_constr { char* module;
164                         char* name;
165                       };
166
167    typedef struct type_constr type_constr_matrix[MAX_IDENTIFIERS];
168    typedef type_constr_matrix* p_type_constr_matrix;
169
170 /* Heap update structure */
171
172    struct heap_update_sample { int ccs;   /* associated cost centre stack */
173                                int ho;    /* associated heap object */
174                                int count; 
175                               };
176
177    typedef struct heap_update_sample heap_update_list[MAX_SAMPLES];
178    typedef heap_update_list* p_heap_update_list;
179
180    struct heap_update_record { int no_samples; /* Number of samples */
181                                p_heap_update_list acc_samples;
182                              };
183
184    typedef struct heap_update_record TheHeap[MAX_TIME];
185    typedef TheHeap* p_TheHeap;
186
187
188 /* -----------------------------------------------------------------------------
189  * GHC specific functions
190  * -------------------------------------------------------------------------- */
191
192 // Initialisation routines
193
194 void initialise_heap_update_list(heap_update_list *m)
195 {
196   int i;
197   for (i=0; i<MAX_SAMPLES;i++)
198   {
199     (*m)[i].ccs   = -1;
200     (*m)[i].ho    = -1;
201     (*m)[i].count    = -1;
202   }
203 }
204
205 void add_to_heap_update_list(heap_update_list *m, int ccs, int ho, int count, int pos)
206 {
207   (*m)[pos].ccs    = ccs;
208   (*m)[pos].ho     = ho;
209   (*m)[pos].count    = count;
210 }
211
212 void initialise_TheHeap(TheHeap *h)
213 {
214   int i;
215   for (i=0; i<MAX_TIME;i++)
216   {
217     heap_update_list *h_u_l;
218     h_u_l = (p_heap_update_list) malloc (sizeof(heap_update_list));
219     initialise_heap_update_list(h_u_l);
220     (*h)[i].acc_samples = h_u_l;
221     (*h)[i].no_samples   = 0;
222   }
223 }
224
225 void add_to_TheHeap(TheHeap *h, int time, int ccs, int ho, int count)
226 {
227   add_to_heap_update_list((*h)[time].acc_samples,ccs,ho,count,(*h)[time].no_samples);
228   (*h)[time].no_samples++;
229 }
230
231 void initialise_cc_matrix(cc_matrix *m)
232
233   int i;
234   char *blank="blank"; /* To do: Modify this terminator string */
235   for (i=0; i<MAX_IDENTIFIERS; i++)
236     { 
237       (*m)[i].name =  (MY_STRING) malloc ((MAX_STRING_SIZE));
238       (*m)[i].module = (MY_STRING) malloc ((MAX_STRING_SIZE));
239       (*m)[i].group = (MY_STRING) malloc ((MAX_STRING_SIZE));
240
241       strcpy((*m)[i].name,blank); 
242       strcpy((*m)[i].module,blank);
243       strcpy((*m)[i].group,blank);  
244     }
245 }
246
247 void free_cc_matrix(cc_matrix *m)
248 {
249   int i;
250   for (i=0; i<MAX_IDENTIFIERS; i++)
251     {
252       free((*m)[i].name);
253       free((*m)[i].module);
254       free((*m)[i].group);
255     }
256     free(m);
257 }
258
259 void initialise_heap_object_matrix(heap_object_matrix *m)
260 {
261   int i;
262   char *blank="blank"; /* To do: ditto */
263   for (i=0; i<MAX_IDENTIFIERS; i++)
264   {
265     (*m)[i].type = -1;
266     (*m)[i].descriptor = (MY_STRING) malloc ((MAX_STRING_SIZE));
267     strcpy((*m)[i].descriptor,blank);
268     (*m)[i].type_constr_ref = -1; 
269   }
270 }
271
272 void initialise_type_constr_matrix(type_constr_matrix *m)
273 {
274   int i;
275   char *blank="blank";
276   for (i=0; i<MAX_IDENTIFIERS; i++)
277   {
278     (*m)[i].module = (MY_STRING) malloc ((MAX_STRING_SIZE));
279     (*m)[i].name   = (MY_STRING) malloc ((MAX_STRING_SIZE));
280     strcpy((*m)[i].module,blank);
281     strcpy((*m)[i].name,blank);
282   }
283 }
284
285 void initialise_heap_sample_matrix(heap_sample_matrix *m)
286 {
287   int i;
288   for (i=0; i<MAX_IDENTIFIERS; i++)
289   { (*m)[i].count = -1; }
290 }
291
292 void initialise_ccs_matrix(ccs_matrix *m)
293
294   int i;
295   for (i=0; i<MAX_IDENTIFIERS; i++)
296     { 
297       /* Stack heap samples */
298       heap_sample_matrix *hs_m;
299       hs_m = (p_heap_sample_matrix) malloc (sizeof(heap_sample_matrix));
300       initialise_heap_sample_matrix(hs_m);
301       (*m)[i].hsm = hs_m;
302       /* Stack scc samples */
303       (*m)[i].cc    = 0; 
304       (*m)[i].ccs   = 0;
305       (*m)[i].scc   = 0;
306       (*m)[i].ticks = 0; 
307       (*m)[i].bytes = 0; 
308     }
309 }
310
311
312 // Filling matrix routines
313
314 char* StripDoubleQuotes(char* s) /* For fussy daVinci! */
315 {
316   char *p = s;
317   char *tempchar;
318   char *empty="";
319   char *tempstring = (MY_STRING) malloc ((MAX_STRING_SIZE));
320   strcpy(tempstring,empty);
321   while (*p)
322   { if (*p!='"')
323     { tempchar = p; strncat(tempstring,p,1);
324      }
325     p++; 
326   }
327   return tempstring;
328 }
329
330 void fill_cc_matrix(cc_matrix *m,char* name,char* module,char* group,int i)
331
332   if (i>MAX_IDENTIFIERS) 
333   {  fprintf(logFile,"Cost centre MAX_IDENTIFIERS exceeded: %i \n",i); exit(1); }
334   name = StripDoubleQuotes(name);
335   strcpy((*m)[i].name,name); 
336   module = StripDoubleQuotes(module);
337   strcpy((*m)[i].module,module);
338   group = StripDoubleQuotes(group);
339   strcpy((*m)[i].group,group);
340 }
341
342 void fill_ccs_matrix(ccs_matrix *m,int cc, int ccs, int scc, int ticks, int bytes, int h_o, int count, int i)
343 {
344   heap_sample_matrix *hsm;
345
346   if ((*m)[i].cc == 0)  /* added for type 2 stack semantics, but should not */
347                         /* change behaviour of type 1 (apart from CAF:REP.  */
348   {
349     if (i>MAX_IDENTIFIERS) 
350     {  fprintf(logFile,"Cost centre stack MAX_IDENTIFIERS exceeded: %i \n",i); exit(1); }
351     hsm = (*m)[i].hsm;
352     (*m)[i].cc = cc; (*m)[i].ccs = ccs; 
353     (*m)[i].ticks = ticks; (*m)[i].bytes = bytes; (*m)[i].scc = scc;
354     (*hsm)[h_o].count = count;
355   }
356   else fprintf(logFile,"Ignoring redeclaration of stack %i\n",i);
357 }
358
359 void add_ccs_costs(ccs_matrix *m, int b,int c,int d,int x,int y,int h_o, int co)
360 {
361   (*m)[c].scc    = (*m)[c].scc + d;
362   (*m)[c].ticks  = (*m)[c].ticks + x;
363   (*m)[c].bytes  = (*m)[c].bytes + y;
364 }
365
366 void add_heap_sample_costs(ccs_matrix *m, int b,int c,int d,int x,int y,int h_o, int co)
367
368   heap_sample_matrix *hsm = (*m)[c].hsm;
369   if (((*hsm)[h_o].count)==-1)
370      (*hsm)[h_o].count = (*hsm)[h_o].count + co + 1; /* as init is -1 */
371   else 
372      (*hsm)[h_o].count = (*hsm)[h_o].count + co;
373 }
374
375 void add_heap_object(heap_object_matrix *m, int pos, int t, char* des, int tr)
376 {
377   if (pos>MAX_IDENTIFIERS) 
378   {  fprintf(logFile,"Heap object MAX_IDENTIFIERS exceeded: %i \n",pos); exit(1); }
379   (*m)[pos].type = t;
380   strcpy((*m)[pos].descriptor,des);
381   (*m)[pos].type_constr_ref = tr;
382
383
384 void add_type_constr_object(type_constr_matrix *m, int pos, char* mod, char* n)
385 {
386   if (pos>MAX_IDENTIFIERS) 
387   {  fprintf(logFile,"Type constructor MAX_IDENTIFIERS exceeded: %i \n",pos); exit(1); }
388   strcpy((*m)[pos].module,mod);
389   strcpy((*m)[pos].name,n);
390 }
391
392
393 // Printing routines
394
395 void print_heap_update_list(heap_update_list *m, int number)
396 {
397   int i;
398   fprintf(logFile,"[");
399   for (i=0; i<number;i++)
400   {
401     fprintf(logFile," (%i,%i,%i) ",(*m)[i].ccs,(*m)[i].ho,(*m)[i].count);
402   }
403   fprintf(logFile,"]\n");
404 }
405
406 void print_TheHeap(TheHeap *h)
407 {
408   int i;
409   fprintf(logFile,"The Heap\n========\n");
410   for (i=0; i<MAX_TIME;i++)
411   {
412     if ((*h)[i].no_samples>0)
413     {
414       fprintf(logFile,"Sample time %i, number of samples %i actual samples "
415                  ,i,(*h)[i].no_samples);
416       print_heap_update_list((*h)[i].acc_samples,(*h)[i].no_samples);
417     }
418   }
419 }
420
421 void PrintXaxis(FILE *HEAP_PROFILE, TheHeap *h)
422 {
423   int i;
424   fprintf(HEAP_PROFILE," ");
425   for (i=0; i<MAX_TIME;i++)
426   {
427     if ((*h)[i].no_samples>0)
428        fprintf(HEAP_PROFILE,"%i ",i);
429   }
430 }
431
432 int FindSample(heap_update_list *m, int number, int element)
433 {
434   int i;
435   for (i=0; i<number;i++)
436   {
437     if ((*m)[i].ho==element)
438         return ((*m)[i].count);
439   }
440   return 0;
441 }
442
443 void PrintSampleCosts(FILE *hfp, TheHeap *h, int element)
444 {
445   int i;
446   int total = 0;
447   for (i=0; i<MAX_TIME;i++)
448   {
449     if ((*h)[i].no_samples>0)
450     {
451       total = total + FindSample((*h)[i].acc_samples,(*h)[i].no_samples,element);
452       fprintf(hfp," %i ",total);
453     }
454   }
455 }
456
457 void print_cc_matrix(cc_matrix *m)
458
459   int i;
460   char *blank="blank";
461   fprintf(logFile,"Cost centre matrix\n");
462   fprintf(logFile,"==================\n");
463   for (i=0; i<MAX_IDENTIFIERS; i++)
464     { if (strcmp((*m)[i].name,blank)!=0) 
465          fprintf(logFile,"%s %s %s\n",(*m)[i].name,(*m)[i].module,(*m)[i].group); }
466   fprintf(logFile,"\n");
467 }
468
469 void print_heap_object_matrix(FILE* hfp, TheHeap *h, heap_object_matrix *m)
470 {
471   int i;
472   for (i=0; i<MAX_IDENTIFIERS; i++)
473   { 
474     if (((*m)[i].type)!=-1)
475     {
476       fprintf(hfp,"Y%i set {",i);
477       /* if ((*m)[i].type==1) fprintf(hfp,"data_contr ");
478       if ((*m)[i].type==2) fprintf(hfp,"PAP ");
479       if ((*m)[i].type==3) fprintf(hfp,"thunk ");
480       if ((*m)[i].type==4) fprintf(hfp,"function ");
481       if ((*m)[i].type==5) fprintf(hfp,"dictionary ");
482       if ((*m)[i].type==1) 
483          fprintf(hfp,"%s %i ",(*m)[i].descriptor,(*m)[i].type_constr_ref);
484       else
485          fprintf(hfp,"%s ",(*m)[i].descriptor); */
486       PrintSampleCosts(hfp,h,i);
487       fprintf(hfp,"}\n");
488     }
489   }         
490 }
491
492 int number_of_heap_objects(heap_object_matrix *m)
493 {
494   int i;
495   int count = 0;
496   for (i=0; i<MAX_IDENTIFIERS; i++)
497   {
498     if (((*m)[i].type)!=-1) count++;
499   }
500   return count;
501 }
502
503 void names_of_heap_objects(FILE *hfp, heap_object_matrix *m)
504 {
505   int i;
506   for (i=0; i<MAX_IDENTIFIERS; i++)
507   {
508     if (((*m)[i].type)!=-1) 
509       fprintf(hfp,"Y%i ",i);
510   }
511   fprintf(hfp,"\n");
512 }
513
514 void names_and_colour_assignment(FILE *hfp, heap_object_matrix *m)
515 {
516   int i;
517   int colour=0;
518   for (i=0; i<MAX_IDENTIFIERS; i++)
519   {
520     if (((*m)[i].type)!=-1) 
521     {
522       switch(colour)
523       {
524         case 0 : fprintf(hfp,"%s \t Y%i \t red \t fdiagonal1\n",(*m)[i].descriptor,i); 
525                  colour++; break;
526         case 1 : fprintf(hfp,"%s \t Y%i \t blue \t fdiagonal1\n",(*m)[i].descriptor,i);
527                  colour++; break;
528         case 2 : fprintf(hfp,"%s \t Y%i \t green \t fdiagonal1\n",(*m)[i].descriptor,i);
529                  colour++; break;
530         case 3 : fprintf(hfp,"%s \t Y%i \t yellow \t fdiagonal1\n",(*m)[i].descriptor,i);
531                  colour++; break;
532         case 4 : fprintf(hfp,"%s \t Y%i \t pink \t fdiagonal1\n",(*m)[i].descriptor,i);
533                  colour++; break;
534         case 5 : fprintf(hfp,"%s \t Y%i \t goldenrod \t fdiagonal1\n",(*m)[i].descriptor,i);
535                  colour++; break;
536         case 6 : fprintf(hfp,"%s \t Y%i \t orange \t fdiagonal1\n",(*m)[i].descriptor,i);
537                  colour++; break;
538         default: fprintf(hfp,"%s \t Y%i \t purple \t fdiagonal1\n",(*m)[i].descriptor,i);
539                  colour=0; break;
540       }
541     }
542   }
543 }
544
545 void print_type_constr_matrix(type_constr_matrix *m)
546 {
547   int i;
548   char *blank="blank";
549   fprintf(logFile,"Type constructor matrix\n");
550   fprintf(logFile,"=======================\n");
551   for (i=0; i<MAX_IDENTIFIERS; i++)
552   {
553     if (strcmp((*m)[i].name,blank)!=0)
554          fprintf(logFile,"%i %s %s\n",i,(*m)[i].module,(*m)[i].name);
555   }
556 }
557
558 void print_heap_sample_matrix(heap_sample_matrix *m)
559 {
560   int i;
561   fprintf(logFile,"HeapSamples[");
562   for (i=0; i<MAX_IDENTIFIERS; i++)
563   {
564     if ((*m)[i].count!=-1) fprintf(logFile,"(%i,%i),",i,(*m)[i].count);
565   }
566   fprintf(logFile,"]\n");
567 }
568
569 void print_ccs_matrix(ccs_matrix *m)
570
571   int i;
572   fprintf(logFile,"Cost centre stack matrix\n");
573   fprintf(logFile,"========================\n");
574   for (i=0; i<MAX_IDENTIFIERS; i++)
575   {  if ((*m)[i].cc!=0)
576      {
577        fprintf(logFile,"%i %i %i %i %i \n",(*m)[i].cc,(*m)[i].ccs,(*m)[i].scc,
578                                (*m)[i].ticks,(*m)[i].bytes); 
579      } 
580   }
581   fprintf(logFile,"\n");
582 }
583
584
585 /* No longer used */
586
587 void FormStack(ccs_matrix *m, cc_matrix *n, int i, char s[])
588 {
589   int j = i;
590   if ((*m)[j].cc != 0)
591   {
592     strcat(s,(*n)[(*m)[j].cc].name);
593     strcat(s," ");
594     while ((*m)[j].ccs != (-1))
595     {
596       strcat(s,(*n)[(*m)[(*m)[j].ccs].cc].name);
597       strcat(s,",");
598       j = (*m)[j].ccs;
599     }
600   }
601   else fprintf(logFile,"ERROR: Form Stack %i\n",i);
602 }
603
604 /* This version, which is used, adds the module and group name to the cost centre name*/
605 /* This means the cost centre name remains unique when it is textualised and fed into */
606 /* daVinci. It also allows the module and group name to be extracted at the display   */
607 /* level */
608
609 void FormStack2(ccs_matrix *m, cc_matrix *n, int i, char s[])
610 {
611   int j = i;
612   if ((*m)[j].cc != 0)
613   {
614     strcat(s,(*n)[(*m)[j].cc].name);
615     strcat(s,"&");
616     strcat(s,(*n)[(*m)[j].cc].module);
617     strcat(s,"&");
618     strcat(s,(*n)[(*m)[j].cc].group);
619     strcat(s," ");
620     while ((*m)[j].ccs != (-1))
621     {
622       strcat(s,(*n)[(*m)[(*m)[j].ccs].cc].name);
623       strcat(s,"&");
624       strcat(s,(*n)[(*m)[(*m)[j].ccs].cc].module);
625       strcat(s,"&");
626       strcat(s,(*n)[(*m)[(*m)[j].ccs].cc].group);
627       strcat(s,",");
628       j = (*m)[j].ccs;
629     }
630   }
631   else fprintf(logFile,"ERROR: Form Stack %i\n",i);
632 }
633
634 void PrintStack(ccs_matrix *m, cc_matrix *n, int i)
635 {
636   int j = i;
637   if ((*m)[j].cc != 0)
638   {
639     fprintf(logFile,"<"); 
640     fprintf(logFile,"%s,",(*n)[(*m)[j].cc].name);
641     while ((*m)[j].ccs != (-1))
642     {
643       fprintf(logFile,"%s,",(*n)[(*m)[(*m)[j].ccs].cc].name);
644       j = (*m)[j].ccs;
645     }
646     fprintf(logFile,"> ");
647     fprintf(logFile,"%i scc %i ticks %i bytes  ",
648             (*m)[i].scc,(*m)[i].ticks,(*m)[i].bytes);
649     print_heap_sample_matrix((*m)[i].hsm);
650   }
651   else
652   { /* fprintf(logFile,"empty stack\n"); */ }
653 }
654
655 int CountStacks(ccs_matrix *m)
656 {
657   int j;
658   int count = 0;
659   for (j=0; j<MAX_IDENTIFIERS;j++) if ((*m)[j].cc != 0) count++;
660   return count;
661 }
662
663 void PrintAllStacks(ccs_matrix *m, cc_matrix *n)
664 {
665   int i;
666   fprintf(logFile,"Stacks\n======\n");
667   for (i=0;i<MAX_IDENTIFIERS;i++) { PrintStack(m,n,i); }
668 }
669
670
671 /* -----------------------------------------------------------------------------
672  * TCL Heap profile generator
673  * -------------------------------------------------------------------------- */
674
675 void produce_HEAP_PROFILE(FILE *HEAP_PROFILE, TheHeap *th, heap_object_matrix *ho_m)
676 {
677   // First the header information 
678   fprintf(HEAP_PROFILE,"#!/home/sj/blt2.4o/src/bltwish\n");
679   fprintf(HEAP_PROFILE,"package require BLT\n");
680   fprintf(HEAP_PROFILE,"if { $tcl_version >= 8.0 } {\n");
681   fprintf(HEAP_PROFILE,"\t \t namespace import blt::*\n");
682   fprintf(HEAP_PROFILE,"namespace import -force blt::tile::*\n");
683   fprintf(HEAP_PROFILE,"}\n");
684   fprintf(HEAP_PROFILE,"source scripts/demo.tcl\n");
685   fprintf(HEAP_PROFILE,"proc FormatXTicks { w value } {\n");
686   fprintf(HEAP_PROFILE,"\t \t set index [expr round($value)]\n");
687   fprintf(HEAP_PROFILE,"\t \t if { $index != $value } {\n");
688   fprintf(HEAP_PROFILE,"\t \t \t return $value\n");
689   fprintf(HEAP_PROFILE,"\t \t}\n");
690   fprintf(HEAP_PROFILE,"incr index -1\n");
691
692   // Now the code to generate the units in the X axis
693
694   fprintf(HEAP_PROFILE,"set name [lindex { ");
695   PrintXaxis(HEAP_PROFILE,th);
696   fprintf(HEAP_PROFILE," } $index]\n");
697
698   fprintf(HEAP_PROFILE,"return $name\n");
699   fprintf(HEAP_PROFILE,"}\n");
700   
701   // more general graph stuff 
702
703   fprintf(HEAP_PROFILE,"source scripts/stipples.tcl\n");
704   fprintf(HEAP_PROFILE,"image create photo bgTexture -file ./images/chalk.gif\n");
705   fprintf(HEAP_PROFILE,"option add *Button.padX                 5\n");
706   fprintf(HEAP_PROFILE,"option add *tile                        bgTexture\n");
707   fprintf(HEAP_PROFILE,"option add *Radiobutton.font            -*-courier*-medium-r-*-*-14-*-*\n");
708   fprintf(HEAP_PROFILE,"option add *Radiobutton.relief          flat\n");
709   fprintf(HEAP_PROFILE,"option add *Radiobutton.borderWidth     2\n");
710   fprintf(HEAP_PROFILE,"option add *Radiobutton.highlightThickness 0\n");
711   fprintf(HEAP_PROFILE,"option add *Htext.font                  -*-times*-bold-r-*-*-14-*-*\n");
712   fprintf(HEAP_PROFILE,"option add *Htext.tileOffset            no\n");
713   fprintf(HEAP_PROFILE,"option add *header.font                 -*-times*-medium-r-*-*-14-*-*\n");
714   fprintf(HEAP_PROFILE,"option add *Barchart.font                -*-helvetica-bold-r-*-*-14-*-*\n");
715
716   fprintf(HEAP_PROFILE,"option add *Barchart.title              \"Heap profile of program ");
717   // TO DO: Add program name in here
718   fprintf(HEAP_PROFILE,"\"\n");
719
720   fprintf(HEAP_PROFILE,"option add *Axis.tickFont               -*-helvetica-medium-r-*-*-12-*-*\n");
721   fprintf(HEAP_PROFILE,"option add *Axis.titleFont              -*-helvetica-bold-r-*-*-12-*-*\n");
722   fprintf(HEAP_PROFILE,"option add *x.Command                   FormatXTicks\n");
723   fprintf(HEAP_PROFILE,"option add *x.Title                     \"Time (seconds)\"\n");
724   fprintf(HEAP_PROFILE,"option add *y.Title                     \"Heap usage (000 bytes)\"\n");
725   fprintf(HEAP_PROFILE,"option add *activeBar.Foreground        pink\noption add *activeBar.stipple             dot3\noption add *Element.Background            red\noption add *Element.Relief         raised\n");
726   fprintf(HEAP_PROFILE,"option add *Grid.dashes                 { 2 4 }\noption add *Grid.hide                  no\noption add *Grid.mapX                       \"\"\n");
727   fprintf(HEAP_PROFILE,"option add *Legend.Font                 \"-*-helvetica*-bold-r-*-*-12-*-*\"\noption add *Legend.activeBorderWidth       2\noption add *Legend.activeRelief              raised \noption add *Legend.anchor              ne \noption add *Legend.borderWidth             0\noption add *Legend.position          right\n");
728   fprintf(HEAP_PROFILE,"option add *TextMarker.Font             *Helvetica-Bold-R*14*\n");
729   fprintf(HEAP_PROFILE,"set visual [winfo screenvisual .] \nif { $visual != \"staticgray\" && $visual != \"grayscale\" } {\n    option add *print.background    yellow\n    option add *quit.background         red\n    option add *quit.activeBackground      red2\n}\n");
730   fprintf(HEAP_PROFILE,"htext .title -text {\n    Heap profile\n}\n");
731   fprintf(HEAP_PROFILE,"htext .header -text {\n    %%%% \n");
732   fprintf(HEAP_PROFILE,"      radiobutton .header.stacked -text stacked -variable barMode \\\n            -anchor w -value \"stacked\" -selectcolor red -command {\n            .graph configure -barmode $barMode\n        } \n        .header append .header.stacked -width 1.5i -anchor w\n");
733   fprintf(HEAP_PROFILE,"    %%%%      Heap usage stacked: overall height is the sum of the heap used. \n    %%%% \n");
734   fprintf(HEAP_PROFILE,"        radiobutton .header.aligned -text aligned -variable barMode \\\n          -anchor w -value \"aligned\" -selectcolor yellow -command {\n            .graph configure -barmode $barMode        }\n        .header append .header.aligned -width 1.5i -fill x\n");
735   fprintf(HEAP_PROFILE,"    %%%%      Heap usage components displayed side-by-side.\n    %%%%\n");
736   fprintf(HEAP_PROFILE,"        radiobutton .header.overlap -text \"overlap\" -variable barMode \\\n            -anchor w -value \"overlap\" -selectcolor green -command {\n            .graph configure -barmode $barMode\n        }\n         .header append .header.overlap -width 1.5i -fill x\n");
737   fprintf(HEAP_PROFILE,"    %%%%      Heap  usage shown as an overlapped histogram.\n    %%%%\n");
738   fprintf(HEAP_PROFILE,"        radiobutton .header.normal -text \"normal\" -variable barMode \\\n            -anchor w -value \"normal\" -selectcolor blue -command {\n            .graph configure -barmode $barMode\n        }\n         .header append .header.normal -width 1.5i -fill x\n");
739   fprintf(HEAP_PROFILE,"    %%%%      Heap components overlayed one on top of the next. \n}\n");
740   fprintf(HEAP_PROFILE,"htext .footer -text { To create a postscript file \"heap_profile.ps\", press the %%%%\n  button $htext(widget).print -text print -command {\n        puts stderr [time {.graph postscript output heap_profile.ps}]\n  }\n  $htext(widget) append $htext(widget).print\n%%%% button.}\n");
741   fprintf(HEAP_PROFILE,"barchart .graph -tile bgTexture\n");
742
743   // This is where the actual data comes in
744
745   fprintf(HEAP_PROFILE,"vector X ");
746   names_of_heap_objects(HEAP_PROFILE,ho_m);
747   fprintf(HEAP_PROFILE,"\nX set { ");
748   PrintXaxis(HEAP_PROFILE,th);
749   fprintf(HEAP_PROFILE," }\n");
750
751   print_heap_object_matrix(HEAP_PROFILE,th, ho_m);
752
753   // NAMES FOR THE ATTRIBUTES 
754   fprintf(HEAP_PROFILE,"set attributes {\n");
755   names_and_colour_assignment(HEAP_PROFILE,ho_m);
756   fprintf(HEAP_PROFILE,"}\n");
757   
758   fprintf(HEAP_PROFILE,"foreach {label yData color stipple} $attributes {\n    .graph element create $yData -label $label -bd 1 \\\n    -ydata $yData -xdata X -fg ${color}3 -bg ${color}1 -stipple $stipple\n}\n");
759   fprintf(HEAP_PROFILE,".header.stacked invoke\n");
760   fprintf(HEAP_PROFILE,"scrollbar .xbar -command { .graph axis view x } -orient horizontal\nscrollbar .ybar -command { .graph axis view y } -orient vertical\n.graph axis configure x -scrollcommand { .xbar set } -logscale no -loose no\n.graph axis configure y -scrollcommand { .ybar set } -logscale no -loose no\n");
761   fprintf(HEAP_PROFILE,"table . \\\n    0,0 .title -fill x \\\n    1,0 .header -fill x  \\\n    2,0 .graph -fill both \\\n    3,0 .xbar -fill x \\\n    5,0 .footer -fill x\n");
762   fprintf(HEAP_PROFILE,"table configure . r0 r1 r3 r4 r5 -resize none\n");
763   fprintf(HEAP_PROFILE,"Blt_ZoomStack .graph\nBlt_Crosshairs .graph\nBlt_ActiveLegend .graph\nBlt_ClosestPoint .graph\n");
764   fprintf(HEAP_PROFILE,".graph marker bind all <B2-Motion> {\n    set coords [%%W invtransform %%x %%y]\n    catch { %%W marker configure [%%W marker get current] -coords $coords }\n}\n.graph marker bind all <Enter> {\n    set marker [%%W marker get current]\n    catch { %%W marker configure $marker -bg green}\n}\n.graph marker bind all <Leave> {\n    set marker [%%W marker get current]\n    catch { %%W marker configure $marker -bg \"\"}\n}\n");
765
766 }
767
768
769 /* -----------------------------------------------------------------------------
770  * Read and create the raw profile data structure
771  * -------------------------------------------------------------------------- */
772
773 /* void readRawProfile(FILE *fptr,int *nonodes) { */
774
775 void readRawProfile(FILE *fp,int *nonodes, int MaxNoNodes) {
776   char    stack[MAX_PROFILE_LINE_LENGTH];
777   int     i,nolines,sstepline,syncs;
778   char   *ptr,*drag;
779
780   float   comp_max,      comp_avg,      comp_min,          /* SYNCS    */
781           comm_max,      comm_avg,      comm_min,          /* COMP     */
782           comp_idle_max, comp_idle_avg, comp_idle_min;     /* COMM     */
783
784   /* Cost  relationships are comp=scc, comm=ticks, comp_idle=bytes */
785
786   long int hmax,havg,hmin;                                 /* COMPIDLE */
787
788   /* set to zero for now. Might use these later for heap costs. */
789
790   /* GHC specific variables */
791
792   int a,b,c,d,x,z,count, next;
793   int newloop;
794   char e[MAX_STRING_SIZE];
795   char f[MAX_STRING_SIZE];
796   char lline[MAX_PROFILE_LINE_LENGTH];
797
798   /* identifiers generated by the XML handler */
799   char *ccentre=">>cost_centre";
800   char *ccstack=">>cost_centre_stack";
801   char *sccsample=">>scc_sample";
802   char *heapsample=">>heap_sample";
803   char *heapupdate=">>heap_update";
804   char *heapobject=">>heap_object";
805   char *typeconstr=">>type_constr";
806   char *ending=">>";
807
808   /* FILE *fp; */
809
810   cc_matrix *cc_m;
811   ccs_matrix *ccs_m;
812   heap_object_matrix *ho_m;
813   type_constr_matrix *tc_m;
814   TheHeap *th;
815
816   FILE *HEAP_PROFILE;
817
818   HEAP_PROFILE = fopen("GHCbarchart.tcl", "w");
819   if (HEAP_PROFILE == NULL){
820    fprintf(stderr,"tcl script generator: ERROR- GHCbarchart.tcl cannot be created\a\n");
821     exit(1);
822   }
823
824   th = (p_TheHeap) malloc (sizeof(TheHeap));
825   cc_m = (p_cc_matrix) malloc (sizeof(cc_matrix));
826   //cc_m = (p_cc_matrix) calloc(MAX_IDENTIFIERS,sizeof(_cc_));
827   ccs_m = (p_ccs_matrix) malloc (sizeof(ccs_matrix));
828   ho_m  = (p_heap_object_matrix) malloc (sizeof(heap_object_matrix));
829   tc_m  = (p_type_constr_matrix) malloc (sizeof(type_constr_matrix));
830
831   /* End of GHC specific variables */
832
833   //fprintf(logFile,"Number 1 %i \n",MAX_IDENTIFIERS*sizeof(_cc_));
834   //fprintf(logFile,"Number 2 %i \n",sizeof(cc_matrix));
835
836   nolines=0; /* Number of lines read in from profile log file */
837
838   /* GHC specific */
839   count = 0;
840   next = 0;
841
842   initialise_cc_matrix(cc_m);
843   initialise_ccs_matrix(ccs_m);
844   initialise_heap_object_matrix(ho_m);
845   initialise_type_constr_matrix(tc_m);
846   initialise_TheHeap(th);
847
848   fprintf(logFile,"MAX_IDENTIFIERS = %i \n",MAX_IDENTIFIERS);
849   
850   /* end GHC specific */
851
852   /* CAF fixing */
853   fill_cc_matrix(cc_m,"CAF:REPOSITORY","PROFILER","PROFILER",MAX_IDENTIFIERS-1);
854   fill_ccs_matrix(ccs_m,MAX_IDENTIFIERS-1,1,0.0,0.0,0.0,0,-1,MAX_IDENTIFIERS-1);
855
856   /* 
857
858   This builds a node in the graph called CAF:REPOSITORY, which can be 
859   found off the root node. All CAFs are subsequently hung from this node
860   which means the node node can be hidden using the abstraction 
861   mechanisms provided by daVinci.
862
863   */
864
865
866   /* This is the GHC file handler which reads the lines from the profile log file and */
867   /* puts the stack and cost information in the raw profile data structure */
868
869    while (fscanf(fp,"%s",lline))
870    { 
871     /* Kill the end of the logfile with the ">>" string */
872     if (strcmp(lline,ending)==0) break;
873
874     /* Deal with the cost centres */
875     if (strcmp(ccentre,lline)==0)
876     {
877       next = fgetc(fp);
878       //while (fscanf(fp," %i %[^ ] %[^ ] %s", &z, e, f, g)!=0)
879       while (fscanf(fp," %i %[^ ] %s", &z, e, f)!=0)
880       {
881         fprintf(logFile,"Declaring cost centre `%i %s %s %s' \n",z,e,f,f);
882         fflush(logFile);
883         fill_cc_matrix(cc_m,e,f,f,z);
884         next = fgetc(fp);
885       }
886     }
887     else 
888     {
889
890       /* Deal with the cost centre stacks */
891       if (strcmp(ccstack,lline)==0)
892       { 
893         next = fgetc(fp);
894         while (fscanf(fp,"%i %i %i",&a,&d,&b)!=0)
895         {
896           if (d==1) /* of size one */
897           {  
898             fprintf(logFile,"Declaring cost centre stack `%i %i %i'\n",a,d,b);
899             fill_ccs_matrix(ccs_m,b,-1,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a);
900           }
901           if (d==2) /* of size > 1 */
902           { 
903             fscanf(fp," %i",&c);
904
905             /* CAF fixing */
906             fprintf(logFile,"Declaring cost centre stack `%i %i %i %i'\n",a,d,b,c);
907             if ((c==1)&&!(strncmp((*cc_m)[b].name,"CAF",2)))
908                // fill_ccs_matrix(ccs_m,b,MAX_IDENTIFIERS-1,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a);
909                /* The line above hangs all CAFs off the CAF:REPOSITORY node
910                   in the daVinci graph. For programs which have a small 
911                   number of CAFs this works nicely. However, when the 
912                   number of CAFs become very large (eg +200) then the 
913                   daVinci graph begins to look horid and, after (say)
914                   +500 CAF nodes, becomes very slow to load. So to 
915                   fix this we replace the code with the line below.
916                */
917                  if (!(strncmp((*cc_m)[b].name,"CAF:main",7)))
918                     /* Treat CAF:main as a normal node */ 
919                     fill_ccs_matrix(ccs_m,b,c,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a); 
920                     /* merge the rest */
921                  else
922                     //add_ccs_costs(ccs_m,0,MAX_IDENTIFIERS-1,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,0);
923                     fill_ccs_matrix(ccs_m,MAX_IDENTIFIERS-1,1,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a);
924                 /* This does not even bother registering the new CAFs
925                    as daVinci nodes, but instead just merges the CAF
926                    with the CAF:REPOSITORY node. This greatly reduces
927                    the number of CAFs daVinci has to deal with, though
928                    may make the graph look a little different!
929
930                    Also note that now Simon has changed the semantics,
931                    you will want to treat adding CAF nodes in a 
932                    different way to adding normal program nodes
933                  */
934             else 
935                /* Normal mode */
936                fill_ccs_matrix(ccs_m,b,c,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a);
937           }
938           next = fgetc(fp);
939         }
940       } 
941       else
942       {
943
944         /* Deal with the scc_samples */
945         if (strcmp(sccsample,lline)==0)
946         {
947           next = fgetc(fp);
948           while (fscanf(fp,"%i %i %i %i",&a,&d,&b,&c))
949           {
950             fprintf(logFile,"Loading scc_samples `%i %i %i %i'\n",a,d,b,c);
951             add_ccs_costs(ccs_m,0,a,d,b,c,0,0);
952             next = fgetc(fp);
953           }
954         } /* end sccsample if */
955         else 
956         {
957         
958           /* Deal with the heap samples */
959           if (strcmp(heapsample,lline)==0)
960           {
961             next = fgetc(fp);
962             while (fscanf(fp,"%i %i %i",&a,&d,&b))
963             {
964               fprintf(logFile,"Loading heap_samples `%i %i %i'\n",a,d,b);
965               add_heap_sample_costs(ccs_m,0,a,0,0,0,d,b);
966               next = fgetc(fp);
967             }
968           } /* end heapsample if */
969           else 
970           {
971
972             /* Deal with the heap objects */
973             if (strcmp(heapobject,lline)==0)
974             {
975               next = fgetc(fp);
976               while (fscanf(fp,"%i %i",&a,&d)) 
977               {
978                 if (d==1) 
979                 {
980                   fscanf(fp," %s %i",e,&b);
981                   add_heap_object(ho_m,a,d,e,b);
982                 }
983                 else 
984                 {
985                   fscanf(fp," %s",e);
986                   add_heap_object(ho_m,a,d,e,-1);
987                 }
988                 next = fgetc(fp);
989               }
990             } /* end heapobject if */
991             else
992             {
993
994               /* Deal with the type constructors */ 
995               if (strcmp(typeconstr,lline)==0)
996               {
997                 next = fgetc(fp);
998                 while (fscanf(fp,"%i %s %s",&a,e,f))
999                 {
1000                   add_type_constr_object(tc_m,a,e,f);
1001                   next = fgetc(fp);
1002                 }
1003               } /* end type constructor if */
1004               else
1005               {
1006                 
1007                 /* Deal with the heap_updates */ 
1008                 if (strcmp(heapupdate,lline)==0)
1009                 {
1010                   next = fgetc(fp);
1011                   while (fscanf(fp,"%i %i %i %i %i %i",&a,&d,&b,&c,&z,&x))
1012                   {
1013                     add_to_TheHeap(th,a,b,c,z);
1014                     fprintf(logFile,"Adding heap sample %i %i %i %i\n",a,b,c,z);
1015                     while (x) /* more than one sample */
1016                     {
1017                       fscanf(fp," %i %i %i %i",&b,&c,&z,&x);
1018                       add_to_TheHeap(th,a,b,c,z);
1019                       fprintf(logFile,"Adding heap sample %i %i %i %i\n",a,b,c,z);
1020                     }  
1021                     next = fgetc(fp);
1022                   }
1023
1024                 } /* end heap update if */
1025
1026               }  /* end type constructor else */
1027
1028              } /* end heapobject else */
1029
1030            } /* end heapsample else */
1031          } /* end sccsample else */
1032        } /* end ccstack else */
1033      } /* end ccstack if */
1034    } /* end while */
1035
1036    print_cc_matrix(cc_m);
1037    print_ccs_matrix(ccs_m);
1038    fprintf(logFile,"There are %i stacks\n",CountStacks(ccs_m));
1039    print_type_constr_matrix(tc_m);
1040
1041    /* Functions for heap profile */
1042    print_TheHeap(th);
1043    fprintf(logFile,"The units for the x axis are \n");
1044    PrintXaxis(logFile,th);
1045    fprintf(logFile,"\n");
1046    fprintf(logFile,"There are %i distinct heap objects\n",number_of_heap_objects(ho_m));
1047    names_of_heap_objects(logFile,ho_m);
1048    names_and_colour_assignment(logFile,ho_m);
1049    print_heap_object_matrix(logFile,th,ho_m);
1050
1051    PrintAllStacks(ccs_m,cc_m);
1052    /* comment out line below to remove the heap profile generator */
1053    produce_HEAP_PROFILE(HEAP_PROFILE,th,ho_m);
1054    fclose(HEAP_PROFILE);
1055
1056    /* End of GHC file handler */
1057   
1058
1059   /* Now process the stack matrix */ 
1060
1061   for (newloop=0;newloop<MAX_IDENTIFIERS;newloop++) 
1062   { if ((*ccs_m)[newloop].cc != 0)
1063     {
1064          
1065     sstepline = 0;
1066     FormStack2(ccs_m,cc_m,newloop,stack);
1067
1068     syncs = 0;     
1069     comp_max = (float)(*ccs_m)[newloop].scc; 
1070     comp_avg = (float)(*ccs_m)[newloop].scc; 
1071     comp_min = (float)(*ccs_m)[newloop].scc; 
1072     comm_max = (float)(*ccs_m)[newloop].ticks; 
1073     comm_avg = (float)(*ccs_m)[newloop].ticks; 
1074     comm_min = (float)(*ccs_m)[newloop].ticks; 
1075     comp_idle_max = (float)(*ccs_m)[newloop].bytes; 
1076     comp_idle_avg = (float)(*ccs_m)[newloop].bytes; 
1077     comp_idle_min = (float)(*ccs_m)[newloop].bytes; 
1078     hmax = 0.0; havg = 0.0; hmin = 0.0; 
1079
1080       /* Dynamic memory allocation for raw_profile data structure */ 
1081
1082       if (raw_profile_next==raw_profile_size) enlargeRawProfile();
1083
1084       /* Assign data from single logfile entry to raw_profile data structure */
1085       /* this deals with the cost metrics */
1086
1087       raw_profile[raw_profile_next].active            = 1;
1088       raw_profile[raw_profile_next].cost.syncs        = syncs;
1089       raw_profile[raw_profile_next].cost.comp_max     = comp_max;
1090       raw_profile[raw_profile_next].cost.comp_avg     = comp_avg;
1091       raw_profile[raw_profile_next].cost.comp_min     = comp_min;
1092       raw_profile[raw_profile_next].cost.comm_max     = comm_max;
1093       raw_profile[raw_profile_next].cost.comm_avg     = comm_avg;
1094       raw_profile[raw_profile_next].cost.comm_min     = comm_min;
1095       raw_profile[raw_profile_next].cost.comp_idle_max= comp_idle_max;
1096       raw_profile[raw_profile_next].cost.comp_idle_avg= comp_idle_avg;
1097       raw_profile[raw_profile_next].cost.comp_idle_min= comp_idle_min;
1098       raw_profile[raw_profile_next].cost.hrel_max     = hmax;
1099       raw_profile[raw_profile_next].cost.hrel_avg     = havg;
1100       raw_profile[raw_profile_next].cost.hrel_min     = hmin;
1101
1102       /* this deals with the stack itself */
1103
1104       raw_profile[raw_profile_next].stack=calloc(MAX_STACK_DEPTH,
1105                                                  sizeof(int));
1106       if (raw_profile[raw_profile_next].stack==NULL) {
1107         fprintf(stderr,"{readRawProfile} unable to allocate stack entry");
1108         exit(1);
1109       }
1110
1111       fprintf(logFile,"STACK=\"%s\"\n",stack);
1112       raw_profile[raw_profile_next].stack_size=1;
1113       /* move the stack read frame to the first space (or comma) in the stack string */ 
1114       for(ptr=stack; ((*ptr)!=' ') && (*ptr!=',');ptr++) {}
1115       fprintf(logFile,"TOS=%d at line %d\n",*ptr,sstepline);
1116      
1117       /* to distinguish the head of the stack from the rest */
1118       /* if read frame points to space you are at the head of the stack */
1119       if (*ptr==' ') 
1120         /* raw_profile[raw_profile_next].stack[0]
1121           =lookupSymbolTable(CG_SSTEP,sstepline,(*ptr='\0',stack)); */
1122         /* This line has changed as GHC treats its cost-centres in a different     */
1123         /* way to BSP. There is no distinction between 'a cost centre at line x'   */
1124         /* and a normal cost centre. The fix is easy, just treat all cost centres, */
1125         /* even those at the head of the stack in the same way.                    */
1126            raw_profile[raw_profile_next].stack[0]
1127           =lookupSymbolTable(CG_STACK,sstepline,(*ptr='\0',stack));
1128       else
1129       /* otherwise you are looking at just another stack element */
1130         raw_profile[raw_profile_next].stack[0]
1131           =lookupSymbolTable(CG_STACK,sstepline,(*ptr='\0',stack));
1132
1133       ptr++; /* move the read frame on one */
1134       drag=ptr;
1135       for(;*ptr;ptr++) { /* find the next element in the stack */
1136         if (*ptr==',') {
1137           *ptr='\0';
1138           if (Verbose) fprintf(logFile,"NAME=\"%s\"\n",drag); /* name of the next element */
1139           if (!ignore_function(drag)) {
1140             raw_profile[raw_profile_next].stack[
1141               raw_profile[raw_profile_next].stack_size++]
1142               = lookupSymbolTable(CG_STACK,0,drag); /* add element to the raw_profile */
1143           }
1144           drag = ptr+1;
1145         }
1146       }
1147
1148       /* create cost object */
1149
1150       raw_profile[raw_profile_next].cost.proc
1151         =calloc(bsp_p,sizeof(object_cost_proc));
1152       if (raw_profile[raw_profile_next].cost.proc==NULL) {
1153         fprintf(stderr,"Unable to allocate storage");
1154         exit(0);
1155       }
1156   
1157       /* process the HREL information - one set for every BSP process */
1158
1159       for(i=0;i<bsp_p;i++) {
1160
1161          raw_profile[raw_profile_next].cost.proc[i].proc_comp     = 0.0; 
1162          raw_profile[raw_profile_next].cost.proc[i].proc_comm     = 0.0; 
1163          raw_profile[raw_profile_next].cost.proc[i].proc_comp_idle= 0.0; 
1164          raw_profile[raw_profile_next].cost.proc[i].proc_hrel_in  = 0; 
1165          raw_profile[raw_profile_next].cost.proc[i].proc_hrel_out = 0; 
1166
1167       }
1168
1169       raw_profile_next++;    /* Increase the raw profile data structure counter */
1170       nolines++;             /* Increase the number of lines read               */
1171
1172        strcpy(stack,""); /* reset the stack */
1173     } /* end of new if statement */
1174   } /* end of new for loop */
1175
1176   *nonodes = symbol_table_next;
1177   fprintf(logFile,"%s: read %d lines from profile.Graph contains %i nodes.\n",
1178           Pgm,nolines,symbol_table_next);
1179
1180   free_cc_matrix(cc_m); /* be nice and clean up the cost centre matrix */
1181 }
1182
1183 /* -----------------------------------------------------------------------------
1184  * Pretty print the raw profile data
1185  * -------------------------------------------------------------------------- */
1186
1187 void printRawProfile() {
1188   int i,j;
1189   object_cost *cost;
1190   int         *stack;
1191   
1192   fprintf(logFile,"\n\nRAW DATA:\n");
1193   for(i=0;i<raw_profile_next;i++) {
1194     cost  = &raw_profile[i].cost;
1195     stack = raw_profile[i].stack;
1196     fprintf(logFile,"Stack=[");
1197     for(j=0;j<raw_profile[i].stack_size;j++) 
1198       printSymbolTable_entry(stack[j]);
1199     fprintf(logFile,"] %d Syncs %f Comp %f Comm %f Wait\n\n",
1200             cost->syncs,cost->comp_max,cost->comm_max,cost->comp_idle_max);
1201   }
1202 }
1203
1204 /* -----------------------------------------------------------------------------
1205  * Create connectivity matrix
1206  * -------------------------------------------------------------------------- */
1207
1208 void createConnectivityMatrix(int NoNodes,Matrix *graph,
1209                               Matrix *costs,int *root, int inherit) {
1210   object_cost zero_cost,*update;
1211   int i,j,this,next;
1212
1213
1214   zero_cost.comp_max     =0.0;
1215   zero_cost.comp_avg     =0.0;
1216   zero_cost.comp_min     =0.0;
1217   zero_cost.comm_max     =0.0;
1218   zero_cost.comm_avg     =0.0;
1219   zero_cost.comm_min     =0.0;
1220   zero_cost.comp_idle_max=0.0;
1221   zero_cost.comp_idle_avg=0.0;
1222   zero_cost.comp_idle_min=0.0;
1223   zero_cost.hrel_max     =0;
1224   zero_cost.hrel_avg     =0;
1225   zero_cost.hrel_min     =0;
1226   zero_cost.syncs=0;
1227   zero_cost.proc = NULL;
1228   *graph = newMat(NoNodes,NoNodes,sizeof(int),(i=0,&i));
1229   *costs = newMat(NoNodes,1,sizeof(object_cost),&zero_cost);
1230   for(i=0;i<NoNodes;i++) {
1231     update=&Mat(object_cost,*costs,i,0);
1232     update->proc=calloc(bsp_p,sizeof(object_cost_proc));
1233     if (update->proc==NULL){
1234       fprintf(stderr,"Unable to allocate storage");
1235       exit(0);
1236     }
1237     for(j=0;j<bsp_p;j++) {
1238       update->proc[j].proc_comp      =0.0;
1239       update->proc[j].proc_comm      =0.0;
1240       update->proc[j].proc_comp_idle =0.0;
1241       update->proc[j].proc_hrel_in   =0;
1242       update->proc[j].proc_hrel_out  =0;
1243     }
1244   }
1245       
1246   for(i=0;i<raw_profile_next;i++) {
1247     if (raw_profile[i].active) {
1248       this = raw_profile[i].stack[0];
1249       next = this;
1250       Mat(int,*graph,this,next) = 1;
1251       update = &Mat(object_cost,*costs,next,0);
1252       add_costs(update,raw_profile[i].cost);
1253       for(j=1;j<raw_profile[i].stack_size;j++) {
1254         this = next;
1255         next = raw_profile[i].stack[j];
1256         Mat(int,*graph,next,this)=1;
1257         update = &Mat(object_cost,*costs,next,0);
1258         /* include this line for INHERITANCE; remove it for not! */
1259         if (inherit) add_costs(update,raw_profile[i].cost);
1260       }
1261     }
1262   }
1263   *root =  raw_profile[0].stack[raw_profile[0].stack_size-1];
1264
1265   /* Check graph isn't empty */
1266   if (!Mat_dense(*costs,*root,0)) *root=-1;
1267 }
1268
1269 void printConnectivityMatrix(Matrix graph,Matrix costs,int root) { 
1270   int i,j;
1271   object_cost cost;
1272
1273   fprintf(logFile,"Root node is %d\n",root);
1274   for(i=0;i<graph.rows;i++) {
1275     fprintf(logFile,"%4d)",i);
1276     printSymbolTable_entry(i);
1277     cost = Mat(object_cost,costs,i,0);
1278     fprintf(logFile,"%d %f %f %f\n\tBranch=[",
1279             cost.syncs,cost.comp_max,cost.comm_max,cost.comp_idle_max);
1280     for(j=0;j<graph.cols;j++) 
1281       if (Mat_dense(graph,i,j)) fprintf(logFile,"%d ",j);
1282     fprintf(logFile,"]\n\n");
1283   }
1284 }