[project @ 1999-04-23 09:47:30 by simonm]

More profiling fixes.  Profiles looking more reasonable, but for best
results add the -caf-all switch to GHC.

5 files changed, 92 insertions, 82 deletions

diff --git a/ghc/includes/Profiling.h b/ghc/includes/Profiling.h
index a29759e08b..85e815c915 100644
--- a/ghc/includes/Profiling.h
+++ b/ghc/includes/Profiling.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Profiling.h,v 1.4 1999/03/25 13:14:03 simonm Exp $
+ * $Id: Profiling.h,v 1.5 1999/04/23 09:47:30 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -84,7 +84,7 @@ typedef struct _CostCentreStack {
   unsigned long time_ticks;
   unsigned long mem_alloc;
 
-  char is_subsumed; /* inherits value from is_subsumed flag of top CostCentre */
+  CostCentre *root;
 } CostCentreStack;
 
 
@@ -157,6 +157,7 @@ extern hash_t max_type_no;                      /* Hash on type description */
  * Functions 
  * ---------------------------------------------------------------------------*/
 
+CostCentreStack *EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn );
 CostCentreStack *PushCostCentre ( CostCentreStack *, CostCentre * );
 CostCentreStack *AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
 CostCentreStack *ActualPush ( CostCentreStack *, CostCentre * );
@@ -165,6 +166,8 @@ CostCentreStack *RemoveCC ( CostCentreStack *, CostCentre * );
 CostCentreStack *IsInIndexTable ( IndexTable *, CostCentre * );
 IndexTable *AddToIndexTable ( IndexTable *, CostCentreStack *, CostCentre * );
 
+extern unsigned int entering_PAP;
+
 #endif /* PROFILING */
 
 #endif PROFILING_H
diff --git a/ghc/includes/StgProf.h b/ghc/includes/StgProf.h
index 76fcdc3e16..ebd1735b40 100644
--- a/ghc/includes/StgProf.h
+++ b/ghc/includes/StgProf.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgProf.h,v 1.5 1999/04/08 15:43:44 simonm Exp $
+ * $Id: StgProf.h,v 1.6 1999/04/23 09:47:31 simonm Exp $
  *
  * (c) The GHC Team, 1998
  *
@@ -104,7 +104,7 @@ extern CostCentreStack *CCS_LIST;         /* registered CCS list */
 	    sub_cafcc_count 	: 0,				\
 	    time_ticks 		: 0,				\
 	    mem_alloc 		: 0,				\
-	    is_subsumed 	: subsumed,			\
+	    root 		: 0,				\
        }};
 
 # define CC_EXTERN(cc_ident) \
@@ -215,10 +215,10 @@ extern CostCentreStack *CCS_LIST;         /* registered CCS list */
  * On entering a closure we only count the enter to thunks ...
  * ------------------------------------------------------------------------- */
 
-#define ENTER_CCS_T(ccs)                                    \
-        do {                                                \
-        CCCS = (CostCentreStack *)(ccs);                    \
-        CCCS_DETAIL_COUNT(CCCS->thunk_count);               \
+#define ENTER_CCS_T(ccs)				\
+        do {						\
+        CCCS = (CostCentreStack *)(ccs);		\
+        CCCS_DETAIL_COUNT(CCCS->thunk_count);		\
         } while(0)      
  
 #define ENTER_CCS_TCL(closure)  ENTER_CCS_T(CCS_HDR(closure))
@@ -231,35 +231,31 @@ extern CostCentreStack *CCS_LIST;         /* registered CCS list */
  *  (b) The CCS is CAF-ish.
  * -------------------------------------------------------------------------- */
 
-#define ENTER_CCS_F(stack)					\
-        do {							\
-        CostCentreStack *ccs = (CostCentreStack *) (stack);	\
-        if ( ! IS_CAF_OR_SUB_CCS(ccs) ) {			\
-           CCCS = ccs;						\
-        } else {						\
-          CCCS = AppendCCS(CCCS,ccs);				\
-          CCCS_DETAIL_COUNT(ccs->caffun_subsumed);		\
-          CCCS_DETAIL_COUNT(CCCS->subsumed_caf_count);		\
-        }							\
-        CCCS_DETAIL_COUNT(CCCS->function_count);		\
+#define ENTER_CCS_F(stack)						\
+        do {								\
+        CostCentreStack *ccs = (CostCentreStack *) (stack);		\
+        CCCS_DETAIL_COUNT(CCCS->function_count);			\
+        CCCS = EnterFunCCS(CCCS,ccs);				  	\
         } while(0)
  
 #define ENTER_CCS_FCL(closure)  ENTER_CCS_F(CCS_HDR(closure))
 
 /* Entering a top-level function: costs are subsumed by the caller 
  */
-#define ENTER_CCS_FSUB()                                    \
-        do {                                                \
-        CCCS_DETAIL_COUNT(CCCS->subsumed_fun_count);        \
-        CCCS_DETAIL_COUNT(CCCS->function_count);            \
+#define ENTER_CCS_FSUB()				\
+        do {						\
+        CCCS_DETAIL_COUNT(CCCS->subsumed_fun_count);	\
+        CCCS_DETAIL_COUNT(CCCS->function_count);	\
+	entering_PAP = 0;				\
         } while(0)
  
-#define ENTER_CCS_FCAF(stack)                               \
-        do {                                                \
-        CostCentreStack *ccs = (CostCentreStack *) (stack); \
-        CCCS_DETAIL_COUNT(ccs->caffun_subsumed);            \
-        CCCS_DETAIL_COUNT(CCCS->subsumed_caf_count);        \
-        CCCS_DETAIL_COUNT(CCCS->function_count);            \
+#define ENTER_CCS_FCAF(stack)					\
+        do {							\
+        CostCentreStack *ccs = (CostCentreStack *) (stack);	\
+        CCCS_DETAIL_COUNT(ccs->caffun_subsumed);		\
+        CCCS_DETAIL_COUNT(CCCS->subsumed_caf_count);		\
+        CCCS_DETAIL_COUNT(CCCS->function_count);		\
+	entering_PAP = 0;					\
         } while(0)
  
 #define ENTER_CCS_FLOAD(ccs)                                \
@@ -270,20 +266,11 @@ extern CostCentreStack *CCS_LIST;         /* registered CCS list */
  
 /* These ENTER_CC_PAP things are only used in the RTS */
  
-#define ENTER_CCS_PAP(stack) /* nothing */
-#if 0 /* old version */
-        do {							\
-        CostCentreStack *ccs = (CostCentreStack *) (stack);	\
-        if ( ! IS_CAF_OR_SUB_CCS(ccs) ) {			\
-            CCCS = ccs;						\
-        } else {						\
-          CCCS = AppendCCS(CCCS,ccs);				\
-          CCCS_DETAIL_COUNT(ccs->caffun_subsumed);		\
-          CCCS_DETAIL_COUNT(CCCS->subsumed_caf_count);		\
-        }							\
-        CCCS_DETAIL_COUNT(CCCS->pap_count);			\
-        } while(0)                      
-#endif
+#define ENTER_CCS_PAP(stack) 			\
+        do {					\
+	ENTER_CCS_F(stack);			\
+	entering_PAP = rtsTrue;			\
+	} while(0)
 
 #define ENTER_CCS_PAP_CL(closure)  \
         ENTER_CCS_PAP((closure)->header.prof.ccs)
diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c
index 69b0881157..2dc0b617f6 100644
--- a/ghc/rts/Profiling.c
+++ b/ghc/rts/Profiling.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.5 1999/04/08 15:43:45 simonm Exp $
+ * $Id: Profiling.c,v 1.6 1999/04/23 09:47:32 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -132,15 +132,6 @@ initProfiling (void)
   /* for the benefit of allocate()... */
   CCCS = CCS_SYSTEM;
 
-  if (!RtsFlags.CcFlags.doCostCentres)
-    return;
-  
-  time_profiling = rtsTrue;
-
-  /* Initialise the log file name */
-  prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
-  sprintf(prof_filename, "%s.prof", prog_argv[0]);
-
   /* Initialize counters for IDs */
   CC_ID  = 0;
   CCS_ID = 0;
@@ -168,15 +159,27 @@ initProfiling (void)
 
   CCCS = CCS_OVERHEAD;
   registerCostCentres();
+  CCCS = CCS_SYSTEM;
+
+  if (!RtsFlags.CcFlags.doCostCentres)
+    return;
+  
+  time_profiling = rtsTrue;
+
+  /* Initialise the log file name */
+  prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling");
+  sprintf(prof_filename, "%s.prof", prog_argv[0]);
 
   /* find all the "special" cost centre stacks, and make them children
    * of CCS_MAIN.
    */
   ASSERT(CCS_MAIN->prevStack == 0);
+  CCS_MAIN->root = CC_MAIN;
   for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
     next = ccs->prevStack;
     ccs->prevStack = 0;
     ActualPush_(CCS_MAIN,ccs->cc,ccs);
+    ccs->root = ccs->cc;
     ccs = next;
   }
   
@@ -193,7 +196,7 @@ endProfiling ( void )
 }
 
 void
-heapCensus ( bdescr *bd )
+heapCensus ( bdescr *bd UNUSED )
 {
   /* nothing yet */
 }
@@ -234,6 +237,32 @@ registerCostCentres ( void )
 
 
 /* -----------------------------------------------------------------------------
+   Set cost centre stack when entering a function.  Here we implement
+   the rule
+
+      "if CCSfn is an initial segment of CCCS, 
+          then set CCCS to CCSfn,
+	  else append CCSfn to CCCS"
+   -------------------------------------------------------------------------- */
+rtsBool entering_PAP;
+
+CostCentreStack *
+EnterFunCCS ( CostCentreStack *cccs, CostCentreStack *ccsfn )
+{
+  /* PAP_entry has already set CCCS for us */
+  if (entering_PAP) {
+    entering_PAP = rtsFalse;
+    return CCCS;
+  }
+
+  if (cccs->root == ccsfn->root) {
+    return ccsfn;
+  } else {
+    return AppendCCS(cccs,ccsfn);
+  }
+}
+
+/* -----------------------------------------------------------------------------
    Cost-centre stack manipulation
    -------------------------------------------------------------------------- */
 
@@ -289,7 +318,6 @@ CostCentreStack *
 AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 #define AppendCCS _AppendCCS
 {
-  CostCentreStack *ccs;
   IF_DEBUG(prof, 
 	   if (ccs1 != ccs2) {
 	     fprintf(stderr,"Appending ");
@@ -359,16 +387,8 @@ ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
   new_ccs->time_ticks = 0;
   new_ccs->mem_alloc = 0;
   
-  /* stacks are subsumed if either:
-       - the top cost centre is boring, and the rest of the CCS is subsumed
-       - the top cost centre is subsumed.
-  */
-  if (cc->is_subsumed == CC_IS_BORING) {
-    new_ccs->is_subsumed = ccs->is_subsumed;
-  } else {
-    new_ccs->is_subsumed = cc->is_subsumed;
-  }
-  
+  new_ccs->root = ccs->root;
+
   /* update the memoization table for the parent stack */
   if (ccs != EMPTY_STACK)
     ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc);
diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 67dadf0d1f..3b83f5bd63 100644
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.19 1999/03/18 17:57:23 simonm Exp $
+ * $Id: StgMiscClosures.hc,v 1.20 1999/04/23 09:47:33 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -13,6 +13,7 @@
 #include "HeapStackCheck.h"   /* for stg_gen_yield */
 #include "Storage.h"
 #include "StoragePriv.h"
+#include "ProfRts.h"
 
 #ifdef HAVE_STDIO_H
 #include <stdio.h>
@@ -54,7 +55,7 @@ STGFUN(IND_PERM_entry)
     FB_
     /* Don't add INDs to granularity cost */
 
-    /* Dont: ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
+    /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
 ling */
 
     /* Enter PAP cost centre -- lexical scoping only */
@@ -86,6 +87,12 @@ STGFUN(IND_OLDGEN_PERM_entry)
     FB_
     TICK_ENT_IND(Node);	/* tick */
   
+    /* Dont: TICK_ENT_IND(Node); for ticky-ticky; this ind is here only to help profi
+ling */
+
+    /* Enter PAP cost centre -- lexical scoping only */
+    ENTER_CCS_PAP_CL(R1.cl);
+
     R1.p = (P_) ((StgInd*)R1.p)->indirectee;
     TICK_ENT_VIA_NODE();
     JMP_(*R1.p);
diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc
index adc9a6ca8c..f4aa7eb0c1 100644
--- a/ghc/rts/Updates.hc
+++ b/ghc/rts/Updates.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.14 1999/04/08 15:43:46 simonm Exp $
+ * $Id: Updates.hc,v 1.15 1999/04/23 09:47:33 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -11,6 +11,7 @@
 #include "RtsUtils.h"
 #include "HeapStackCheck.h"
 #include "Storage.h"
+#include "ProfRts.h"
 
 /*
   The update frame return address must be *polymorphic*, that means
@@ -140,7 +141,6 @@ STGFUN(PAP_entry)
        */
       
       CCCS = Su->header.prof.ccs;
-      ENTER_CCS_PAP(pap->header.prof.ccs);
 #endif /* PROFILING */
       
       Su = Su->link;
@@ -200,7 +200,7 @@ EXTFUN(stg_update_PAP)
 {
   nat Words, PapSize;
 #ifdef PROFILING
-  CostCentreStack *CCS_pap, *CCS_blame;
+  CostCentreStack *CCS_pap;
 #endif
   StgPAP* PapClosure;
   StgClosure *Fun, *Updatee;
@@ -226,12 +226,9 @@ EXTFUN(stg_update_PAP)
     ASSERT((int)Words >= 0);
 
 #if defined(PROFILING)
-    /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */
-    CCS_pap = Fun->header.prof.ccs;
-    CCS_blame = Fun->header.prof.ccs;
-    if (IS_CAF_OR_SUB_CCS(CCS_pap)) {
-      CCS_blame = CCCS;
-    }
+    /* pretend we just entered the function closure */
+    ENTER_CCS_FCL(Fun);
+    CCS_pap = CCCS;
 #endif
 
     if (Words == 0) { 
@@ -268,7 +265,7 @@ EXTFUN(stg_update_PAP)
 
 	TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
 #ifdef PROFILING
-	CCS_ALLOC(CCS_blame, PapSize);
+	CCS_ALLOC(CCS_pap, PapSize);
 #endif
 
 	PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
@@ -348,10 +345,6 @@ EXTFUN(stg_update_PAP)
 #endif	
 
 #if defined(PROFILING)
-      /* 
-       * Restore the Cost Centre too (if required); again see Sansom
-       * thesis p 183.  Take the CC out of the update frame if a CAF/DICT.
-       */
       CCCS = Su->header.prof.ccs;
       ENTER_CCS_PAP(CCS_pap);
 #endif /* PROFILING */
@@ -378,7 +371,7 @@ EXTFUN(stg_update_PAP)
      */
     JMP_(GET_ENTRY(R1.cl));
     FE_
-} 
+}
 
 
 /* -----------------------------------------------------------------------------