[project @ 2004-09-12 12:12:18 by panne]

[ghc-hetmet.git] / ghc / rts / Profiling.c

diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c
index 902c391..bec04fe 100644 (file)
--- a/ghc/rts/Profiling.c
+++ b/ghc/rts/Profiling.c
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.32 2002/07/05 01:23:45 mthomas Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -16,12 +15,14 @@
 #include "Profiling.h"
 #include "Storage.h"
 #include "Proftimer.h"
-#include "Itimer.h"
+#include "Timer.h"
 #include "ProfHeap.h"
 #include "Arena.h"
 #include "RetainerProfile.h"
 #include "LdvProfile.h"
 
+#include <string.h>
+
 /*
  * Profiling allocation arena.
  */
@@ -38,7 +39,8 @@ unsigned int HP_ID;
 
 /* figures for the profiling report.
  */
-static lnat total_alloc, total_prof_ticks;
+static ullong total_alloc;
+static lnat   total_prof_ticks;
 
 /* Globals for opening the profiling log file(s)
  */
@@ -258,12 +260,12 @@ static void
 initProfilingLogFile(void)
 {
     /* Initialise the log file name */
-    prof_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
-    sprintf(prof_filename, "%s.prof", prog_argv[0]);
+    prof_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
+    sprintf(prof_filename, "%s.prof", prog_name);
 
     /* open the log file */
     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
-       fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
+       debugBelch("Can't open profiling report file %s\n", prof_filename);
        RtsFlags.CcFlags.doCostCentres = 0;
         // The following line was added by Sung; retainer/LDV profiling may need
         // two output files, i.e., <program>.prof/hp.
@@ -289,12 +291,12 @@ initProfilingLogFile(void)
     
     if (RtsFlags.ProfFlags.doHeapProfile) {
        /* Initialise the log file name */
-       hp_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6);
-       sprintf(hp_filename, "%s.hp", prog_argv[0]);
+       hp_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
+       sprintf(hp_filename, "%s.hp", prog_name);
        
        /* open the log file */
        if ((hp_file = fopen(hp_filename, "w")) == NULL) {
-           fprintf(stderr, "Can't open profiling report file %s\n", 
+           debugBelch("Can't open profiling report file %s\n", 
                    hp_filename);
            RtsFlags.ProfFlags.doHeapProfile = 0;
            return;
@@ -325,19 +327,19 @@ endProfiling ( void )
    -------------------------------------------------------------------------- */
 rtsBool entering_PAP;
 
-CostCentreStack *
-EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn )
+void
+EnterFunCCS ( CostCentreStack *ccsfn )
 {
   /* PAP_entry has already set CCCS for us */
   if (entering_PAP) {
     entering_PAP = rtsFalse;
-    return CCCS;
+    return;
   }
 
   if (ccsfn->root->is_caf == CC_IS_CAF) {
-    return AppendCCS(cccs,ccsfn);
+    CCCS = AppendCCS(CCCS,ccsfn);
   } else {
-    return ccsfn;
+    CCCS = ccsfn;
   }
 }
 
@@ -352,9 +354,9 @@ PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 #define PushCostCentre _PushCostCentre
 {
   IF_DEBUG(prof, 
-          fprintf(stderr,"Pushing %s on ", cc->label);
-          fprintCCS(stderr,ccs);
-          fprintf(stderr,"\n"));
+          debugBelch("Pushing %s on ", cc->label);
+          debugCCS(ccs);
+          debugBelch("\n"));
   return PushCostCentre(ccs,cc);
 }
 #endif
@@ -414,11 +416,11 @@ AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 {
   IF_DEBUG(prof, 
           if (ccs1 != ccs2) {
-            fprintf(stderr,"Appending ");
-            fprintCCS(stderr,ccs1);
-            fprintf(stderr," to ");
-            fprintCCS(stderr,ccs2);
-            fprintf(stderr,"\n");});
+            debugBelch("Appending ");
+            debugCCS(ccs1);
+            debugBelch(" to ");
+            debugCCS(ccs2);
+            debugBelch("\n");});
   return AppendCCS(ccs1,ccs2);
 }
 #endif
@@ -458,8 +460,7 @@ static CostCentreStack *
 ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
 {
   /* assign values to each member of the structure */
-  ASSIGN_CCS_ID(new_ccs->ccsID);
-  
+  new_ccs->ccsID = CCS_ID++;
   new_ccs->cc = cc;
   new_ccs->prevStack = ccs;
   
@@ -662,7 +663,7 @@ report_per_cc_costs( void )
          );
       
       if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-         fprintf(prof_file, "  %5ld %9lld", cc->time_ticks, cc->mem_alloc);
+       fprintf(prof_file, "  %5llu %9llu", (StgWord64)(cc->time_ticks), cc->mem_alloc);
       }
       fprintf(prof_file, "\n");
   }
@@ -712,13 +713,14 @@ reportCCSProfiling( void )
       gen_XML_logfile();
       return;
     default:
+      break;
     }
 
     fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n", 
            time_str(), "Final");
 
     fprintf(prof_file, "\n\t  ");
-    fprintf(prof_file, " %s", prog_argv[0]);
+    fprintf(prof_file, " %s", prog_name);
     fprintf(prof_file, " +RTS");
     for (count = 0; rts_argv[count]; count++)
        fprintf(prof_file, " %s", rts_argv[count]);
@@ -732,9 +734,8 @@ reportCCSProfiling( void )
            total_prof_ticks, TICK_MILLISECS);
 
     fprintf(prof_file, "\ttotal alloc = %11s bytes",
-           ullong_format_string((ullong) total_alloc * sizeof(W_),
+           ullong_format_string(total_alloc * sizeof(W_),
                                 temp, rtsTrue/*commas*/));
-    /* ToDo: 64-bit error! */
 
 #if defined(PROFILING_DETAIL_COUNTS)
     fprintf(prof_file, "  (%lu closures)", total_allocs);
@@ -776,7 +777,7 @@ reportCCS(CostCentreStack *ccs, nat indent)
            );
 
     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-      fprintf(prof_file, "  %5ld %9lld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
+      fprintf(prof_file, "  %5llu %9llu", (StgWord64)(ccs->time_ticks), ccs->mem_alloc*sizeof(W_));
 #if defined(PROFILING_DETAIL_COUNTS)
       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
              ccs->mem_allocs, ccs->thunk_count,
@@ -892,8 +893,8 @@ reportCCS_XML(CostCentreStack *ccs)
 
   cc = ccs->cc;
   
-  fprintf(prof_file, " 1 %d %llu %lu %llu", 
-         ccs->ccsID, ccs->scc_count, ccs->time_ticks, ccs->mem_alloc);
+  fprintf(prof_file, " 1 %d %llu %llu %llu", 
+         ccs->ccsID, ccs->scc_count, (StgWord64)(ccs->time_ticks), ccs->mem_alloc);
 
   for (i = ccs->indexTable; i != 0; i = i->next) {
     if (!i->back_edge) {
@@ -915,4 +916,19 @@ fprintCCS( FILE *f, CostCentreStack *ccs )
   fprintf(f,">");
 }
 
+#ifdef DEBUG
+void
+debugCCS( CostCentreStack *ccs )
+{
+  debugBelch("<");
+  for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
+      debugBelch("%s.%s", ccs->cc->module, ccs->cc->label);
+      if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
+         debugBelch(",");
+      }
+  }
+  debugBelch(">");
+}
+#endif // DEBUG
+
 #endif /* PROFILING */