rts: More const correct-ness fixes
[ghc.git] / rts / Profiling.c
index a299189..a4fc281 100644 (file)
@@ -29,7 +29,7 @@
 /*
  * Profiling allocation arena.
  */
-Arena *prof_arena;
+static Arena *prof_arena;
 
 /*
  * Global variables used to assign unique IDs to cc's, ccs's, and
@@ -59,7 +59,7 @@ CostCentre      *CC_LIST  = NULL;
 CostCentreStack *CCS_LIST = NULL;
 
 #ifdef THREADED_RTS
-Mutex ccs_mutex;
+static Mutex ccs_mutex;
 #endif
 
 /*
@@ -114,14 +114,17 @@ static  CostCentreStack * actualPush_     ( CostCentreStack *ccs, CostCentre *cc
 static  rtsBool           ignoreCCS       ( CostCentreStack *ccs );
 static  void              countTickss     ( CostCentreStack *ccs );
 static  void              inheritCosts    ( CostCentreStack *ccs );
+static  uint32_t           numDigits       ( StgInt i );
 static  void              findCCSMaxLens  ( CostCentreStack *ccs,
-                                            nat indent,
-                                            nat *max_label_len,
-                                            nat *max_module_len );
+                                            uint32_t indent,
+                                            uint32_t *max_label_len,
+                                            uint32_t *max_module_len,
+                                            uint32_t *max_id_len );
 static  void              logCCS          ( CostCentreStack *ccs,
-                                            nat indent,
-                                            nat max_label_len,
-                                            nat max_module_len );
+                                            uint32_t indent,
+                                            uint32_t max_label_len,
+                                            uint32_t max_module_len,
+                                            uint32_t max_id_len );
 static  void              reportCCS       ( CostCentreStack *ccs );
 static  CostCentreStack * checkLoop       ( CostCentreStack *ccs,
                                             CostCentre *cc );
@@ -139,15 +142,14 @@ static  void              initProfilingLogFile ( void );
    Initialise the profiling environment
    -------------------------------------------------------------------------- */
 
-void
-initProfiling1 (void)
+void initProfiling (void)
 {
     // initialise our arena
     prof_arena = newArena();
 
     /* for the benefit of allocate()... */
     {
-        nat n;
+        uint32_t n;
         for (n=0; n < n_capabilities; n++) {
             capabilities[n]->r.rCCCS = CCS_SYSTEM;
         }
@@ -156,18 +158,6 @@ initProfiling1 (void)
 #ifdef THREADED_RTS
     initMutex(&ccs_mutex);
 #endif
-}
-
-void
-freeProfiling (void)
-{
-    arenaFree(prof_arena);
-}
-
-void
-initProfiling2 (void)
-{
-    CostCentreStack *ccs, *next;
 
     /* Set up the log file, and dump the header and cost centre
      * information into it.
@@ -202,6 +192,24 @@ initProfiling2 (void)
     CCS_MAIN->root = CCS_MAIN;
     ccsSetSelected(CCS_MAIN);
 
+    initProfiling2();
+
+    if (RtsFlags.CcFlags.doCostCentres) {
+        initTimeProfiling();
+    }
+
+    if (RtsFlags.ProfFlags.doHeapProfile) {
+        initHeapProfiling();
+    }
+}
+
+//
+// Should be called after loading any new Haskell code.
+//
+void initProfiling2 (void)
+{
+    CostCentreStack *ccs, *next;
+
     // make CCS_MAIN the parent of all the pre-defined CCSs.
     for (ccs = CCS_LIST; ccs != NULL; ) {
         next = ccs->prevStack;
@@ -210,16 +218,23 @@ initProfiling2 (void)
         ccs->root = ccs;
         ccs = next;
     }
+    CCS_LIST = NULL;
+}
 
-    if (RtsFlags.CcFlags.doCostCentres) {
-        initTimeProfiling();
-    }
-
-    if (RtsFlags.ProfFlags.doHeapProfile) {
-        initHeapProfiling();
-    }
+void
+freeProfiling (void)
+{
+    arenaFree(prof_arena);
 }
 
+CostCentre *mkCostCentre (char *label, char *module, char *srcloc)
+{
+    CostCentre *cc = stgMallocBytes (sizeof(CostCentre), "mkCostCentre");
+    cc->label = label;
+    cc->module = module;
+    cc->srcloc = srcloc;
+    return cc;
+}
 
 static void
 initProfilingLogFile(void)
@@ -239,9 +254,7 @@ initProfilingLogFile(void)
     }
 #endif
 
-    if (RtsFlags.CcFlags.doCostCentres == 0 &&
-        RtsFlags.ProfFlags.doHeapProfile != HEAP_BY_RETAINER &&
-        RtsFlags.ProfFlags.retainerSelector == NULL)
+    if (RtsFlags.CcFlags.doCostCentres == 0 && !doingRetainerProfiling())
     {
         /* No need for the <prog>.prof file */
         prof_filename = NULL;
@@ -257,11 +270,11 @@ initProfilingLogFile(void)
         if ((prof_file = fopen(prof_filename, "w")) == NULL) {
             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.
-            if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
+            // Retainer profiling (`-hr` or `-hr<cc> -h<x>`) writes to
+            // both <program>.hp as <program>.prof.
+            if (doingRetainerProfiling()) {
                 RtsFlags.ProfFlags.doHeapProfile = 0;
-            return;
+            }
         }
     }
 
@@ -275,7 +288,6 @@ initProfilingLogFile(void)
             debugBelch("Can't open profiling report file %s\n",
                     hp_filename);
             RtsFlags.ProfFlags.doHeapProfile = 0;
-            return;
         }
     }
 }
@@ -381,7 +393,7 @@ void enterFunCCS (StgRegTable *reg, CostCentreStack *ccsfn)
 
     // uncommon case 4: ccsapp is deeper than ccsfn
     if (ccsapp->depth > ccsfn->depth) {
-        nat i, n;
+        uint32_t i, n;
         CostCentreStack *tmp = ccsapp;
         n = ccsapp->depth - ccsfn->depth;
         for (i = 0; i < n; i++) {
@@ -735,10 +747,10 @@ insertCCInSortedList( CostCentre *new_cc )
     *prev = new_cc;
 }
 
-static nat
+static uint32_t
 strlen_utf8 (char *s)
 {
-    nat n = 0;
+    uint32_t n = 0;
     unsigned char c;
 
     for (; *s != '\0'; s++) {
@@ -752,13 +764,13 @@ static void
 reportPerCCCosts( void )
 {
     CostCentre *cc, *next;
-    nat max_label_len, max_module_len;
+    uint32_t max_label_len, max_module_len;
 
     aggregateCCCosts(CCS_MAIN);
     sorted_cc_list = NULL;
 
     max_label_len  = 11; // no shorter than the "COST CENTRE" header
-    max_module_len = 7;  // no shorter than the "MODULE" header
+    max_module_len = 6;  // no shorter than the "MODULE" header
 
     for (cc = CC_LIST; cc != NULL; cc = next) {
         next = cc->link;
@@ -773,7 +785,7 @@ reportPerCCCosts( void )
     }
 
     fprintf(prof_file, "%-*s %-*s", max_label_len, "COST CENTRE", max_module_len, "MODULE");
-    fprintf(prof_file, "%6s %6s", "%time", "%alloc");
+    fprintf(prof_file, " %6s %6s", "%time", "%alloc");
     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
         fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
     }
@@ -789,7 +801,7 @@ reportPerCCCosts( void )
                 cc->module,
                 max_module_len - strlen_utf8(cc->module), "");
 
-        fprintf(prof_file, "%6.1f %6.1f",
+        fprintf(prof_file, " %6.1f %6.1f",
                 total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
                 total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
                                           total_alloc * 100)
@@ -810,12 +822,22 @@ reportPerCCCosts( void )
    -------------------------------------------------------------------------- */
 
 static void
-fprintHeader( nat max_label_len, nat max_module_len )
+fprintHeader( uint32_t max_label_len, uint32_t max_module_len,
+                uint32_t max_id_len )
 {
-    fprintf(prof_file, "%-*s %-*s%6s %11s  %11s   %11s\n", max_label_len, "", max_module_len, "", "", "", "individual", "inherited");
+    fprintf(prof_file, "%-*s %-*s %-*s %11s  %12s   %12s\n",
+            max_label_len, "",
+            max_module_len, "",
+            max_id_len, "",
+            "", "individual", "inherited");
 
-    fprintf(prof_file, "%-*s %-*s", max_label_len, "COST CENTRE", max_module_len, "MODULE");
-    fprintf(prof_file, "%6s %11s  %5s %5s   %5s %5s", "no.", "entries", "%time", "%alloc", "%time", "%alloc");
+    fprintf(prof_file, "%-*s %-*s %-*s",
+            max_label_len, "COST CENTRE",
+            max_module_len, "MODULE",
+            max_id_len, "no.");
+
+    fprintf(prof_file, " %11s  %5s %6s   %5s %6s",
+            "entries", "%time", "%alloc", "%time", "%alloc");
 
     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
         fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
@@ -827,7 +849,7 @@ fprintHeader( nat max_label_len, nat max_module_len )
 void
 reportCCSProfiling( void )
 {
-    nat count;
+    uint32_t count;
     char temp[128]; /* sigh: magic constant */
 
     stopProfTimer();
@@ -871,8 +893,25 @@ reportCCSProfiling( void )
     reportCCS(pruneCCSTree(CCS_MAIN));
 }
 
+static uint32_t
+numDigits(StgInt i) {
+    uint32_t result;
+
+    result = 1;
+
+    if (i < 0) i = 0;
+
+    while (i > 9) {
+        i /= 10;
+        result++;
+    }
+
+    return result;
+}
+
 static void
-findCCSMaxLens(CostCentreStack *ccs, nat indent, nat *max_label_len, nat *max_module_len) {
+findCCSMaxLens(CostCentreStack *ccs, uint32_t indent, uint32_t *max_label_len,
+        uint32_t *max_module_len, uint32_t *max_id_len) {
     CostCentre *cc;
     IndexTable *i;
 
@@ -880,16 +919,19 @@ findCCSMaxLens(CostCentreStack *ccs, nat indent, nat *max_label_len, nat *max_mo
 
     *max_label_len = stg_max(*max_label_len, indent + strlen_utf8(cc->label));
     *max_module_len = stg_max(*max_module_len, strlen_utf8(cc->module));
+    *max_id_len = stg_max(*max_id_len, numDigits(ccs->ccsID));
 
     for (i = ccs->indexTable; i != 0; i = i->next) {
         if (!i->back_edge) {
-            findCCSMaxLens(i->ccs, indent+1, max_label_len, max_module_len);
+            findCCSMaxLens(i->ccs, indent+1,
+                    max_label_len, max_module_len, max_id_len);
         }
     }
 }
 
 static void
-logCCS(CostCentreStack *ccs, nat indent, nat max_label_len, nat max_module_len)
+logCCS(CostCentreStack *ccs, uint32_t indent,
+        uint32_t max_label_len, uint32_t max_module_len, uint32_t max_id_len)
 {
     CostCentre *cc;
     IndexTable *i;
@@ -909,8 +951,9 @@ logCCS(CostCentreStack *ccs, nat indent, nat max_label_len, nat max_module_len)
                 cc->module,
                 max_module_len - strlen_utf8(cc->module), "");
 
-        fprintf(prof_file, "%6ld %11" FMT_Word64 "  %5.1f  %5.1f   %5.1f  %5.1f",
-            ccs->ccsID, ccs->scc_count,
+        fprintf(prof_file,
+                " %*" FMT_Int "%11" FMT_Word64 "  %5.1f  %5.1f   %5.1f  %5.1f",
+                max_id_len, ccs->ccsID, ccs->scc_count,
                 total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)total_prof_ticks * 100.0),
                 total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)total_alloc * 100.0),
                 total_prof_ticks == 0 ? 0.0 : ((double)ccs->inherited_ticks / (double)total_prof_ticks * 100.0),
@@ -926,7 +969,7 @@ logCCS(CostCentreStack *ccs, nat indent, nat max_label_len, nat max_module_len)
 
     for (i = ccs->indexTable; i != 0; i = i->next) {
         if (!i->back_edge) {
-            logCCS(i->ccs, indent+1, max_label_len, max_module_len);
+            logCCS(i->ccs, indent+1, max_label_len, max_module_len, max_id_len);
         }
     }
 }
@@ -934,15 +977,16 @@ logCCS(CostCentreStack *ccs, nat indent, nat max_label_len, nat max_module_len)
 static void
 reportCCS(CostCentreStack *ccs)
 {
-    nat max_label_len, max_module_len;
+    uint32_t max_label_len, max_module_len, max_id_len;
 
     max_label_len = 11; // no shorter than "COST CENTRE" header
-    max_module_len = 7; // no shorter than "MODULE" header
+    max_module_len = 6; // no shorter than "MODULE" header
+    max_id_len = 3; // no shorter than "no." header
 
-    findCCSMaxLens(ccs, 0, &max_label_len, &max_module_len);
+    findCCSMaxLens(ccs, 0, &max_label_len, &max_module_len, &max_id_len);
 
-    fprintHeader(max_label_len, max_module_len);
-    logCCS(ccs, 0, max_label_len, max_module_len);
+    fprintHeader(max_label_len, max_module_len, max_id_len);
+    logCCS(ccs, 0, max_label_len, max_module_len, max_id_len);
 }
 
 
@@ -1059,13 +1103,13 @@ fprintCCS_stderr (CostCentreStack *ccs, StgClosure *exception, StgTSO *tso)
     StgPtr frame;
     StgStack *stack;
     CostCentreStack *prev_ccs;
-    nat depth = 0;
-    const nat MAX_DEPTH = 10; // don't print gigantic chains of stacks
+    uint32_t depth = 0;
+    const uint32_t MAX_DEPTH = 10; // don't print gigantic chains of stacks
 
     {
-        char *desc;
-        StgInfoTable *info;
-        info = get_itbl(UNTAG_CLOSURE(exception));
+        const char *desc;
+        const StgInfoTable *info;
+        info = get_itbl(UNTAG_CONST_CLOSURE(exception));
         switch (info->type) {
         case CONSTR:
         case CONSTR_1_0: