[project @ 2001-12-12 14:31:42 by simonmar]

- Add a new type of restriction: -hC, which restricts to closures
  whose CCS contains the specified CCs *anywhere* (not just at the
  top).

- Complain if the user tries to request both retainer and biographical
  profiling.  We don't support both simultaneously, because they use
  the same header word in the closure.

- Allow for the fact that the heap might contain some closures which
  don't have a valid retainer set during the heap census.  The only
  known closures of this kind so far are DEAD_WEAK closures.

- Some cruft-removal and renaming of functions to follow conventions.

diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index b8dfcf9..73ca19d 100644 (file)
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.32 2001/11/29 16:38:13 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.33 2001/12/12 14:31:42 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -37,7 +37,7 @@
  * RESTRICTION:
  *   era must be no longer than LDV_SHIFT (15 or 30) bits.
  * Invariants:
- *   era is initialized to 0 in initHeapProfiling().
+ *   era is initialized to 1 in initHeapProfiling().
  *
  * max_era is initialized to 2^LDV_SHIFT in initHeapProfiling().
  * When era reaches max_era, the profiling stops because a closure can
@@ -181,20 +181,27 @@ closureIdentity( StgClosure *p )
 
 #ifdef PROFILING
     case HEAP_BY_CCS:
-       return ((StgClosure *)p)->header.prof.ccs;
+       return p->header.prof.ccs;
     case HEAP_BY_MOD:
-       return ((StgClosure *)p)->header.prof.ccs->cc->module;
+       return p->header.prof.ccs->cc->module;
     case HEAP_BY_DESCR:
-       return (get_itbl((StgClosure *)p))->prof.closure_desc;
+       return get_itbl(p)->prof.closure_desc;
     case HEAP_BY_TYPE:
-       return (get_itbl((StgClosure *)p))->prof.closure_type;
+       return get_itbl(p)->prof.closure_type;
     case HEAP_BY_RETAINER:
-       return retainerSetOf((StgClosure *)p);
+       // AFAIK, the only closures in the heap which might not have a
+       // valid retainer set are DEAD_WEAK closures.
+       if (isRetainerSetFieldValid(p))
+           return retainerSetOf(p);
+       else
+           return NULL;
+
 #else // DEBUG
     case HEAP_BY_INFOPTR:
        return (void *)((StgClosure *)p)->header.info; 
     case HEAP_BY_CLOSURE_TYPE:
        return type_names[get_itbl(p)->type];
+
 #endif
     default:
        barf("closureIdentity");
@@ -366,6 +373,13 @@ initHeapProfiling(void)
         return 0;
     }
 
+#ifdef PROFILING
+    if (doingLDVProfiling() && doingRetainerProfiling()) {
+       prog_belch("cannot mix -hb and -hr");
+       stg_exit(1);
+    }
+#endif
+
     // we only count eras if we're doing LDV profiling.  Otherwise era
     // is fixed at zero.
 #ifdef PROFILING
@@ -505,9 +519,10 @@ fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
     }
     fprintf(fp, "%s", buf);
 }
+#endif // PROFILING
 
-static rtsBool
-str_matches_selector( char* str, char* sel )
+rtsBool
+strMatchesSelector( char* str, char* sel )
 {
    char* p;
    // fprintf(stderr, "str_matches_selector %s %s\n", str, sel);
@@ -529,7 +544,6 @@ str_matches_selector( char* str, char* sel )
        if (*sel == '\0') return rtsFalse;
    }
 }
-#endif // PROFILING
 
 /* -----------------------------------------------------------------------------
  * Figure out whether a closure should be counted in this census, by
@@ -542,33 +556,31 @@ closureSatisfiesConstraints( StgClosure* p )
     return rtsTrue;
 #else
    rtsBool b;
-   if (RtsFlags.ProfFlags.modSelector) {
-       b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->module,
-                                RtsFlags.ProfFlags.modSelector );
-       if (!b) return rtsFalse;
+
+   // The CCS has a selected field to indicate whether this closure is
+   // deselected by not being mentioned in the module, CC, or CCS
+   // selectors.
+   if (!p->header.prof.ccs->selected) {
+       return rtsFalse;
    }
+
    if (RtsFlags.ProfFlags.descrSelector) {
-       b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_desc,
+       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
                                 RtsFlags.ProfFlags.descrSelector );
        if (!b) return rtsFalse;
    }
    if (RtsFlags.ProfFlags.typeSelector) {
-       b = str_matches_selector( (get_itbl((StgClosure *)p))->prof.closure_type,
+       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
                                 RtsFlags.ProfFlags.typeSelector );
        if (!b) return rtsFalse;
    }
-   if (RtsFlags.ProfFlags.ccSelector) {
-       b = str_matches_selector( ((StgClosure *)p)->header.prof.ccs->cc->label,
-                                RtsFlags.ProfFlags.ccSelector );
-       if (!b) return rtsFalse;
-   }
    if (RtsFlags.ProfFlags.retainerSelector) {
        RetainerSet *rs;
        nat i;
        rs = retainerSetOf((StgClosure *)p);
        if (rs != NULL) {
           for (i = 0; i < rs->num; i++) {
-              b = str_matches_selector( rs->element[i]->cc->label,
+              b = strMatchesSelector( rs->element[i]->cc->label,
                                         RtsFlags.ProfFlags.retainerSelector );
               if (b) return rtsTrue;
           }
@@ -704,13 +716,13 @@ dumpCensus( Census *census )
 #ifdef PROFILING
        if (RtsFlags.ProfFlags.bioSelector != NULL) {
            count = 0;
-           if (str_matches_selector("lag", RtsFlags.ProfFlags.bioSelector))
+           if (strMatchesSelector("lag", RtsFlags.ProfFlags.bioSelector))
                count += ctr->c.ldv.not_used - ctr->c.ldv.void_total;
-           if (str_matches_selector("drag", RtsFlags.ProfFlags.bioSelector))
+           if (strMatchesSelector("drag", RtsFlags.ProfFlags.bioSelector))
                count += ctr->c.ldv.drag_total;
-           if (str_matches_selector("void", RtsFlags.ProfFlags.bioSelector))
+           if (strMatchesSelector("void", RtsFlags.ProfFlags.bioSelector))
                count += ctr->c.ldv.void_total;
-           if (str_matches_selector("use", RtsFlags.ProfFlags.bioSelector))
+           if (strMatchesSelector("use", RtsFlags.ProfFlags.bioSelector))
                count += ctr->c.ldv.used - ctr->c.ldv.drag_total;
        } else
 #endif

diff --git a/ghc/rts/ProfHeap.h b/ghc/rts/ProfHeap.h
index 70d5ea0..82f0923 100644 (file)
--- a/ghc/rts/ProfHeap.h
+++ b/ghc/rts/ProfHeap.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.h,v 1.3 2001/11/26 16:54:21 simonmar Exp $
+ * $Id: ProfHeap.h,v 1.4 2001/12/12 14:31:43 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -15,5 +15,6 @@ extern nat     initHeapProfiling( void );
 extern void    endHeapProfiling( void );
 extern rtsBool closureSatisfiesConstraints( StgClosure* p );
 extern void    LDV_recordDead( StgClosure *c, nat size );
+extern rtsBool strMatchesSelector( char* str, char* sel );
 
 #endif

diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c
index e8db830..c99de34 100644 (file)
--- a/ghc/rts/Profiling.c
+++ b/ghc/rts/Profiling.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.28 2001/11/28 15:42:26 simonmar Exp $
+ * $Id: Profiling.c,v 1.29 2001/12/12 14:31:43 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -36,21 +36,6 @@ unsigned int CC_ID;
 unsigned int CCS_ID;
 unsigned int HP_ID;
 
-/* Table sizes from old profiling system.  Not sure if we'll need
- * these.
- */
-nat time_intervals = 0;
-nat earlier_ticks  = 0;
-nat max_cc_no      = 0;
-nat max_mod_no     = 0;
-nat max_grp_no     = 0;
-nat max_descr_no   = 0;
-nat max_type_no    = 0;
-
-/* Are we time-profiling?
- */
-rtsBool time_profiling = rtsFalse;
-
 /* figures for the profiling report.
  */
 static lnat total_alloc, total_prof_ticks;
@@ -143,13 +128,12 @@ static  CostCentreStack * ActualPush      ( CostCentreStack *, CostCentre * );
 static  CostCentreStack * IsInIndexTable  ( IndexTable *, CostCentre * );
 static  IndexTable *      AddToIndexTable ( IndexTable *, CostCentreStack *, 
                                            CostCentre *, unsigned int );
+static  void              ccsSetSelected  ( CostCentreStack *ccs );
 
+static  void              initTimeProfiling   ( void );
+static  void              initProfilingLogFile( void );
 
-
-static    void initTimeProfiling   ( void );
-static    void initProfilingLogFile( void );
-
-static    void reportCCS_XML       ( CostCentreStack *ccs );
+static  void              reportCCS_XML       ( CostCentreStack *ccs );
 
 /* -----------------------------------------------------------------------------
    Initialise the profiling environment
@@ -212,7 +196,9 @@ initProfiling2 (void)
    */
   ASSERT(CCS_MAIN->prevStack == 0);
   CCS_MAIN->root = CC_MAIN;
+  ccsSetSelected(CCS_MAIN);
   DecCCS(CCS_MAIN);
+
   for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
     next = ccs->prevStack;
     ccs->prevStack = 0;
@@ -229,7 +215,45 @@ initProfiling2 (void)
     initHeapProfiling();
   }
 }
-  
+
+// Decide whether closures with this CCS should contribute to the heap
+// profile.
+static void 
+ccsSetSelected( CostCentreStack *ccs )
+{
+    if (RtsFlags.ProfFlags.modSelector) {
+       if (! strMatchesSelector( ccs->cc->module,
+                                 RtsFlags.ProfFlags.modSelector ) ) {
+           ccs->selected = 0;
+           return;
+       }
+    }
+    if (RtsFlags.ProfFlags.ccSelector) {
+       if (! strMatchesSelector( ccs->cc->label,
+                                 RtsFlags.ProfFlags.ccSelector ) ) {
+           ccs->selected = 0;
+           return;
+       }
+    }
+    if (RtsFlags.ProfFlags.ccsSelector) {
+       CostCentreStack *c;
+       for (c = ccs; c != NULL; c = c->prevStack) {
+           if ( strMatchesSelector( c->cc->label,
+                                    RtsFlags.ProfFlags.ccsSelector )) {
+               break; 
+           }
+       }
+       if (c == NULL) {
+           ccs->selected = 0;
+           return;
+       }
+    }
+
+    ccs->selected = 1;
+    return;
+}
+
+
 static void
 initProfilingLogFile(void)
 {
@@ -281,8 +305,6 @@ initProfilingLogFile(void)
 void
 initTimeProfiling(void)
 {
-  time_profiling = rtsTrue;
-
   /* Start ticking */
   startProfTimer();
 };
@@ -457,6 +479,9 @@ ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
   
   new_ccs->root = ccs->root;
 
+  // Set the selected field.
+  ccsSetSelected(new_ccs);
+
   /* update the memoization table for the parent stack */
   if (ccs != EMPTY_STACK)
     ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc, 
@@ -669,7 +694,7 @@ fprint_header( void )
 }
 
 void
-report_ccs_profiling( void )
+reportCCSProfiling( void )
 {
     nat count;
     char temp[128]; /* sigh: magic constant */
@@ -722,12 +747,6 @@ report_ccs_profiling( void )
 
     fprint_header();
     reportCCS(pruneCCSTree(CCS_MAIN), 0);
-
-    // @retainer profiling
-    // @LDV profiling
-    // Now, prof_file is closed in shutdownHaskell() because this file
-    // is also used for retainer/LDV profiling. See shutdownHaskell().
-    // fclose(prof_file);
 }
 
 static void 
@@ -745,8 +764,8 @@ reportCCS(CostCentreStack *ccs, nat indent)
        /* force printing of *all* cost centres if -P -P */ 
     {
 
-    fprintf(prof_file, "%-*s%-*s %-10s", 
-           indent, "", 24-indent, cc->label, cc->module);
+    fprintf(prof_file, "%6d %-*s%-*s %-10s", 
+           ccs->ccsID, indent, "", 24-indent, cc->label, cc->module);
 
     fprintf(prof_file, "%8lld  %5.1f %5.1f    %5.1f %5.1f",
            ccs->scc_count, 

diff --git a/ghc/rts/Profiling.h b/ghc/rts/Profiling.h
index 52db2da..dccf444 100644 (file)
--- a/ghc/rts/Profiling.h
+++ b/ghc/rts/Profiling.h
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
 
- * $Id: Profiling.h,v 1.3 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: Profiling.h,v 1.4 2001/12/12 14:31:43 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -20,17 +20,10 @@ extern FILE *hp_file;
 #ifdef PROFILING
 
 void gen_XML_logfile     ( void );
-void report_ccs_profiling ( void );
-void heap_profile_finish (void);
+void reportCCSProfiling ( void );
 
 void PrintNewStackDecls ( void );
 
-void print_ccs (FILE *, CostCentreStack *);
-
-# define DEFAULT_INTERVAL TICK_FREQUENCY
-
-extern rtsBool time_profiling;
-
 extern lnat total_prof_ticks;
 
 extern void fprintCCS( FILE *f, CostCentreStack *ccs );

diff --git a/ghc/rts/Proftimer.c b/ghc/rts/Proftimer.c
index 390dd69..a34752e 100644 (file)
--- a/ghc/rts/Proftimer.c
+++ b/ghc/rts/Proftimer.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Proftimer.c,v 1.8 2001/11/22 14:25:12 simonmar Exp $
+ * $Id: Proftimer.c,v 1.9 2001/12/12 14:31:43 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -29,17 +29,13 @@ rtsBool performHeapProfile;
 void
 stopProfTimer( void )
 {
-    if (time_profiling) {
-       do_prof_ticks = rtsFalse;
-    }
+    do_prof_ticks = rtsFalse;
 }
 
 void
 startProfTimer( void )
 {
-    if (time_profiling) {
-       do_prof_ticks = rtsTrue;
-    }
+    do_prof_ticks = rtsTrue;
 }
 
 void
@@ -68,13 +64,13 @@ initProfTimer( void )
 
     startHeapProfTimer();
 }
-    
+
 
 void
 handleProfTick(void)
 {
     if (do_prof_ticks) {
-       CCS_TICK(CCCS);
+       CCCS->time_ticks++;
     }
 
     if (do_heap_prof_ticks) {

diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c
index 24a4433..f9ddc83 100644 (file)
--- a/ghc/rts/RtsFlags.c
+++ b/ghc/rts/RtsFlags.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.55 2001/12/03 14:34:45 simonmar Exp $
+ * $Id: RtsFlags.c,v 1.56 2001/12/12 14:31:43 simonmar Exp $
  *
  * (c) The AQUA Project, Glasgow University, 1994-1997
  * (c) The GHC Team, 1998-1999
@@ -257,6 +257,7 @@ void initRtsFlagsDefaults(void)
     RtsFlags.ProfFlags.descrSelector      = NULL;
     RtsFlags.ProfFlags.typeSelector       = NULL;
     RtsFlags.ProfFlags.ccSelector         = NULL;
+    RtsFlags.ProfFlags.ccsSelector        = NULL;
     RtsFlags.ProfFlags.retainerSelector   = NULL;
     RtsFlags.ProfFlags.bioSelector        = NULL;
 
@@ -426,7 +427,8 @@ usage_text[] = {
 "                 r = retainer",
 "                 b = biography (LAG,DRAG,VOID,USE)",
 "  A subset of closures may be selected thusly:",
-"    -hc<cc>,...  specific cost centre(s) (NOT STACKS!)",
+"    -hc<cc>,...  specific cost centre(s) (top of stack only)",
+"    -hC<cc>,...  specific cost centre(s) (anywhere in stack)",
 "    -hm<mod>...  all cost centres from the specified modules(s)",
 "    -hd<des>,... closures with specified closure descriptions",
 "    -hy<typ>...  closures with specified type descriptions",
@@ -889,10 +891,12 @@ error = rtsTrue;
                            *right = '\0';
 
                            switch (rts_argv[arg][2]) {
-                           case 'C':
                            case 'c': // cost centre label select
                                RtsFlags.ProfFlags.ccSelector = left;
                                break;
+                           case 'C':
+                               RtsFlags.ProfFlags.ccsSelector = left;
+                               break;
                            case 'M':
                            case 'm': // cost centre module select
                                RtsFlags.ProfFlags.modSelector = left;

diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
index ce133dc..3bd4e0c 100644 (file)
--- a/ghc/rts/RtsStartup.c
+++ b/ghc/rts/RtsStartup.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.59 2001/12/06 07:07:12 sof Exp $
+ * $Id: RtsStartup.c,v 1.60 2001/12/12 14:31:43 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -326,7 +326,7 @@ shutdownHaskell(void)
 #endif
 
 #if defined(PROFILING) 
-  report_ccs_profiling();
+  reportCCSProfiling();
 #endif
 
 #if defined(PROFILING) || defined(DEBUG)