rts: More const correct-ness fixes
[ghc.git] / rts / Profiling.c
index ec38c92..a4fc281 100644 (file)
 /*
  * Profiling allocation arena.
  */
-Arena *prof_arena;
+static Arena *prof_arena;
 
 /*
- * Global variables used to assign unique IDs to cc's, ccs's, and 
+ * Global variables used to assign unique IDs to cc's, ccs's, and
  * closure_cats
  */
 
@@ -49,7 +49,7 @@ static W_      total_prof_ticks;
 static char *prof_filename; /* prof report file name = <program>.prof */
 FILE *prof_file;
 
-static char *hp_filename;      /* heap profile (hp2ps style) log file */
+static char *hp_filename;       /* heap profile (hp2ps style) log file */
 FILE *hp_file;
 
 /* Linked lists to keep track of CCs and CCSs that haven't
@@ -59,14 +59,14 @@ CostCentre      *CC_LIST  = NULL;
 CostCentreStack *CCS_LIST = NULL;
 
 #ifdef THREADED_RTS
-Mutex ccs_mutex;
+static Mutex ccs_mutex;
 #endif
 
 /*
  * Built-in cost centres and cost-centre stacks:
  *
  *    MAIN   is the root of the cost-centre stack tree.  If there are
- *           no _scc_s in the program, all costs will be attributed
+ *           no {-# SCC #-}s in the program, all costs will be attributed
  *           to MAIN.
  *
  *    SYSTEM is the RTS in general (scheduler, etc.).  All costs for
@@ -95,8 +95,8 @@ CC_DECLARE(CC_DONT_CARE, "DONT_CARE",   "MAIN",      "<built-in>", CC_NOT_CAF, )
 CC_DECLARE(CC_PINNED,    "PINNED",      "SYSTEM",    "<built-in>", CC_NOT_CAF, );
 CC_DECLARE(CC_IDLE,      "IDLE",        "IDLE",      "<built-in>", CC_NOT_CAF, );
 
-CCS_DECLARE(CCS_MAIN,      CC_MAIN,       );
-CCS_DECLARE(CCS_SYSTEM,            CC_SYSTEM,     );
+CCS_DECLARE(CCS_MAIN,       CC_MAIN,       );
+CCS_DECLARE(CCS_SYSTEM,     CC_SYSTEM,     );
 CCS_DECLARE(CCS_GC,         CC_GC,         );
 CCS_DECLARE(CCS_OVERHEAD,   CC_OVERHEAD,   );
 CCS_DECLARE(CCS_DONT_CARE,  CC_DONT_CARE,  );
@@ -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 );
@@ -129,7 +132,7 @@ static  CostCentreStack * pruneCCSTree    ( CostCentreStack *ccs );
 static  CostCentreStack * actualPush      ( CostCentreStack *, CostCentre * );
 static  CostCentreStack * isInIndexTable  ( IndexTable *, CostCentre * );
 static  IndexTable *      addToIndexTable ( IndexTable *, CostCentreStack *,
-                                           CostCentre *, unsigned int );
+                                            CostCentre *, unsigned int );
 static  void              ccsSetSelected  ( CostCentreStack *ccs );
 
 static  void              initTimeProfiling    ( void );
@@ -139,35 +142,22 @@ 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;
+            capabilities[n]->r.rCCCS = CCS_SYSTEM;
         }
     }
 
 #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,26 +270,25 @@ 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;
+            }
         }
     }
-    
+
     if (RtsFlags.ProfFlags.doHeapProfile) {
-       /* Initialise the log file name */
-       hp_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
-       sprintf(hp_filename, "%s.hp", prog);
-
-       /* open the log file */
-       if ((hp_file = fopen(hp_filename, "w")) == NULL) {
-           debugBelch("Can't open profiling report file %s\n", 
-                   hp_filename);
-           RtsFlags.ProfFlags.doHeapProfile = 0;
-           return;
-       }
+        /* Initialise the log file name */
+        hp_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
+        sprintf(hp_filename, "%s.hp", prog);
+
+        /* open the log file */
+        if ((hp_file = fopen(hp_filename, "w")) == NULL) {
+            debugBelch("Can't open profiling report file %s\n",
+                    hp_filename);
+            RtsFlags.ProfFlags.doHeapProfile = 0;
+        }
     }
 }
 
@@ -287,7 +299,7 @@ initTimeProfiling(void)
     startProfTimer();
 };
 
-void 
+void
 endProfiling ( void )
 {
     if (RtsFlags.CcFlags.doCostCentres) {
@@ -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++) {
@@ -413,26 +425,26 @@ ccsSetSelected (CostCentreStack *ccs)
     if (RtsFlags.ProfFlags.modSelector) {
         if (! strMatchesSelector (ccs->cc->module,
                                   RtsFlags.ProfFlags.modSelector) ) {
-           ccs->selected = 0;
+            ccs->selected = 0;
             return;
         }
     }
     if (RtsFlags.ProfFlags.ccSelector) {
         if (! strMatchesSelector (ccs->cc->label,
                                   RtsFlags.ProfFlags.ccSelector) ) {
-           ccs->selected = 0;
+            ccs->selected = 0;
             return;
         }
     }
     if (RtsFlags.ProfFlags.ccsSelector) {
-       CostCentreStack *c;
+        CostCentreStack *c;
         for (c = ccs; c != NULL; c = c->prevStack)
         {
             if ( strMatchesSelector (c->cc->label,
                                      RtsFlags.ProfFlags.ccsSelector) ) {
-               break; 
-           }
-       }
+                break;
+            }
+        }
         if (c == NULL) {
             ccs->selected = 0;
             return;
@@ -454,10 +466,10 @@ pushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 #define pushCostCentre _pushCostCentre
 {
     IF_DEBUG(prof,
-            traceBegin("pushing %s on ", cc->label);
-            debugCCS(ccs);
-            traceEnd(););
-            
+             traceBegin("pushing %s on ", cc->label);
+             debugCCS(ccs);
+             traceEnd(););
+
     return pushCostCentre(ccs,cc);
 }
 #endif
@@ -518,7 +530,7 @@ pushCostCentre (CostCentreStack *ccs, CostCentre *cc)
             // check if we've already memoized this stack
             ixtable = ccs->indexTable;
             temp_ccs = isInIndexTable(ixtable,cc);
-      
+
             if (temp_ccs != EMPTY_STACK) {
                 return temp_ccs;
             } else {
@@ -619,10 +631,8 @@ actualPush_ (CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs)
     ccsSetSelected(new_ccs);
 
     /* update the memoization table for the parent stack */
-    if (ccs != EMPTY_STACK) {
-        ccs->indexTable = addToIndexTable(ccs->indexTable, new_ccs, cc,
-                                          0/*not a back edge*/);
-    }
+    ccs->indexTable = addToIndexTable(ccs->indexTable, new_ccs, cc,
+                                      0/*not a back edge*/);
 
     /* return a pointer to the new stack */
     return new_ccs;
@@ -639,7 +649,7 @@ isInIndexTable(IndexTable *it, CostCentre *cc)
         else
             it = it->next;
     }
-  
+
     /* otherwise we never found it so return EMPTY_TABLE */
     return EMPTY_TABLE;
 }
@@ -672,13 +682,13 @@ ignoreCC (CostCentre *cc)
 {
     if (RtsFlags.CcFlags.doCostCentres < COST_CENTRES_ALL &&
         (   cc == CC_OVERHEAD
-        || cc == CC_DONT_CARE
-        || cc == CC_GC 
+         || cc == CC_DONT_CARE
+         || cc == CC_GC
          || cc == CC_SYSTEM
          || cc == CC_IDLE)) {
-       return rtsTrue;
+        return rtsTrue;
     } else {
-       return rtsFalse;
+        return rtsFalse;
     }
 }
 
@@ -693,7 +703,7 @@ ignoreCCS (CostCentreStack *ccs)
          || ccs == CCS_IDLE)) {
         return rtsTrue;
     } else {
-       return rtsFalse;
+        return rtsFalse;
     }
 }
 
@@ -737,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++) {
@@ -754,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;
@@ -775,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");
     }
@@ -791,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)
@@ -811,13 +821,23 @@ reportPerCCCosts( void )
    Generate the cost-centre-stack time/alloc report
    -------------------------------------------------------------------------- */
 
-static void 
-fprintHeader( nat max_label_len, nat max_module_len )
+static void
+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");
@@ -829,40 +849,40 @@ fprintHeader( nat max_label_len, nat max_module_len )
 void
 reportCCSProfiling( void )
 {
-    nat count;
+    uint32_t count;
     char temp[128]; /* sigh: magic constant */
-    
+
     stopProfTimer();
 
     total_prof_ticks = 0;
     total_alloc = 0;
     countTickss(CCS_MAIN);
-    
+
     if (RtsFlags.CcFlags.doCostCentres == 0) return;
 
-    fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n", 
-           time_str(), "Final");
+    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_name);
     fprintf(prof_file, " +RTS");
     for (count = 0; rts_argv[count]; count++)
-       fprintf(prof_file, " %s", rts_argv[count]);
+        fprintf(prof_file, " %s", rts_argv[count]);
     fprintf(prof_file, " -RTS");
     for (count = 1; prog_argv[count]; count++)
-       fprintf(prof_file, " %s", prog_argv[count]);
+        fprintf(prof_file, " %s", prog_argv[count]);
     fprintf(prof_file, "\n\n");
 
     fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d us, %d processor%s)\n",
             ((double) total_prof_ticks *
              (double) RtsFlags.MiscFlags.tickInterval) / (TIME_RESOLUTION * n_capabilities),
-           (unsigned long) total_prof_ticks,
+            (unsigned long) total_prof_ticks,
             (int) TimeToUS(RtsFlags.MiscFlags.tickInterval),
             n_capabilities, n_capabilities > 1 ? "s" : "");
 
     fprintf(prof_file, "\ttotal alloc = %11s bytes",
-           showStgWord64(total_alloc * sizeof(W_),
-                                temp, rtsTrue/*commas*/));
+            showStgWord64(total_alloc * sizeof(W_),
+                                 temp, rtsTrue/*commas*/));
 
     fprintf(prof_file, "  (excludes profiling overheads)\n\n");
 
@@ -873,8 +893,25 @@ reportCCSProfiling( void )
     reportCCS(pruneCCSTree(CCS_MAIN));
 }
 
-static void 
-findCCSMaxLens(CostCentreStack *ccs, nat indent, nat *max_label_len, nat *max_module_len) {
+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, uint32_t indent, uint32_t *max_label_len,
+        uint32_t *max_module_len, uint32_t *max_id_len) {
     CostCentre *cc;
     IndexTable *i;
 
@@ -882,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)
+static void
+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;
@@ -911,13 +951,14 @@ 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),
                 total_alloc == 0 ? 0.0 : ((double)ccs->inherited_alloc / (double)total_alloc * 100.0)
-           );
+            );
 
         if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
             fprintf(prof_file, "  %5" FMT_Word64 " %9" FMT_Word64,
@@ -928,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);
         }
     }
 }
@@ -936,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);
 }
 
 
@@ -1061,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: