[project @ 1999-09-15 13:46:28 by simonmar]

Cost-centre heap profiling and symbol table heap profiling are now
merged into one file: ProfHeap.c.

ghc/rts/DebugProf.c

-/* -----------------------------------------------------------------------------
- * $Id: DebugProf.c,v 1.7 1999/09/15 13:45:16 simonmar Exp $
- *
- * (c) The GHC Team 1998-1999
- *
- * Simple Heap Profiling
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-#include "Printer.h"
-#include "BlockAlloc.h"
-#include "DebugProf.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Stats.h"
-
-#if defined(DEBUG) && ! defined(PROFILING)
-
-char prof_filename[128];
-FILE *prof_file;
-
-static void clear_table_data(void);
-static void fprint_data(FILE *fp);
-
-/* -----------------------------------------------------------------------------
-   The profiler itself
-   -------------------------------------------------------------------------- */
-
-void
-heapCensus(bdescr *bd)
-{
-    StgPtr p;
-    const StgInfoTable *info;
-    StgDouble time;
-    nat size;
-    
-    /* usertime() isn't very accurate, since it includes garbage
-     * collection time.  We really want elapsed_mutator_time or
-     * something.  ToDo.
-     */
-    time = usertime();
-    fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
-
-    while (bd != NULL) {
-	p = bd->start;
-	while (p < bd->free) {
-	    info = get_itbl((StgClosure *)p);
-
-	    switch (info->type) {
-	    case BCO:
-		size = bco_sizeW((StgBCO *)p);
-		break;
-
-	    case FUN:
-	    case THUNK:
-	    case CONSTR:
-	    case IND_PERM:
-	    case IND_OLDGEN_PERM:
-	    case BLACKHOLE:
-	    case BLACKHOLE_BQ:
-	    case WEAK:
-	    case FOREIGN:
-	    case MVAR:
-	    case MUT_VAR:
-	    case CONSTR_INTLIKE:
-	    case CONSTR_CHARLIKE:
-	    case CONSTR_STATIC:
-	    case CONSTR_NOCAF_STATIC:
-	    case THUNK_STATIC:
-	    case FUN_STATIC:
-	    case IND_STATIC:
-		size = sizeW_fromITBL(info);
-		break;
-
-	    case THUNK_SELECTOR:
-		size = sizeofW(StgHeader) + MIN_UPD_SIZE;
-		break;
-
-	    case IND:
-	    case IND_OLDGEN:
-		size = sizeofW(StgInd);
-		break;
-
-	    case AP_UPD: /* we can treat this as being the same as a PAP */
-	    case PAP:
-		size = pap_sizeW((StgPAP *)p);
-		break;
-
-	    case ARR_WORDS:
-		size = arr_words_sizeW(stgCast(StgArrWords*,p));
-		break;
-
-	    case MUT_ARR_PTRS:
-	    case MUT_ARR_PTRS_FROZEN:
-		size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
-		break;
-
-	    case TSO:
-		size = tso_sizeW((StgTSO *)p);
-		break;
-
-	    default:
-		barf("heapCensus");
-	    }
-	    switch (RtsFlags.ProfFlags.doHeapProfile) {
-	    case HEAP_BY_INFOPTR:
-	      add_data((void *)(*p), size * sizeof(W_));
-	      break;
-	    case HEAP_BY_CLOSURE_TYPE:
-	      closure_types[info->type] += size * sizeof(W_);
-	      break;
-	    }
-	    p += size;
-	}
-	bd = bd->link;
-    }
-
-    switch (RtsFlags.ProfFlags.doHeapProfile) {
-    case HEAP_BY_INFOPTR:
-      fprint_data(prof_file);
-      break;
-    case HEAP_BY_CLOSURE_TYPE:
-      fprint_closure_types(prof_file);
-      break;
-    }
-    
-    fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
-}    
-
-#endif
-

ghc/rts/ProfHeap.c

+/* -----------------------------------------------------------------------------
+ * $Id: ProfHeap.c,v 1.1 1999/09/15 13:46:28 simonmar Exp $
+ *
+ * (c) The GHC Team, 1998-1999
+ *
+ * Support for heap profiling
+ *
+ * ---------------------------------------------------------------------------*/
+
+#if defined(DEBUG) && !defined(PROFILING)
+#define DEBUG_HEAP_PROF
+#else
+#undef DEBUG_HEAP_PROF
+#endif
+
+#if defined(PROFILING) || defined(DEBUG_HEAP_PROF)
+
+#include "Rts.h"
+#include "RtsUtils.h"
+#include "RtsFlags.h"
+#include "ProfRts.h"
+#include "Storage.h"
+#include "ProfHeap.h"
+#include "Stats.h"
+#include "ProfRts.h"
+#ifdef DEBUG_HEAP_PROF
+#include "Printer.h"
+static void initSymbolHash(void);
+static void clear_table_data(void);
+static void fprint_data(FILE *fp);
+#endif
+
+char prof_filename[128];	/* urk */
+FILE *prof_file;
+
+nat
+initHeapProfiling(void)
+{
+    if (! RtsFlags.ProfFlags.doHeapProfile) {
+        return 0;
+    }
+
+    sprintf(prof_filename, "%.124s.hp", prog_argv[0]);
+
+    prof_file = fopen(prof_filename, "w");
+    if (prof_file == NULL) {
+	fprintf(stderr, "Can't open heap profiling log file %s\n",
+		prof_filename);
+	return 1;
+    }
+
+    fprintf(prof_file, "JOB \"%s\"\n", prog_argv[0]);
+    fprintf(prof_file, "DATE \"%s\"\n", time_str());
+
+    fprintf(prof_file, "SAMPLE_UNIT \"seconds\"\n");
+    fprintf(prof_file, "VALUE_UNIT \"bytes\"\n");
+
+    fprintf(prof_file, "BEGIN_SAMPLE 0.00\n");
+    fprintf(prof_file, "END_SAMPLE 0.00\n");
+
+#ifdef DEBUG_HEAP_PROF
+    DEBUG_LoadSymbols(prog_argv[0]);
+    initSymbolHash();
+#endif
+
+    return 0;
+}
+
+void
+endHeapProfiling(void)
+{
+    StgDouble seconds;
+
+    if (! RtsFlags.ProfFlags.doHeapProfile) {
+        return;
+    }
+
+    seconds = mut_user_time();
+    fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", seconds);
+    fprintf(prof_file, "END_SAMPLE %0.2f\n", seconds);
+    fclose(prof_file);
+}
+
+#ifdef DEBUG_HEAP_PROF
+/* -----------------------------------------------------------------------------
+   Hash table for symbols.
+   -------------------------------------------------------------------------- */
+
+typedef struct {
+    const char *name;
+    void *ptr;
+    nat data;
+} symbol_info;
+
+#define SYMBOL_HASH_SIZE 0x3fff
+
+symbol_info symbol_hash[SYMBOL_HASH_SIZE];
+
+static inline nat
+hash(void *ptr)
+{
+    return ((W_)ptr)>>4 & 0x3fff;
+}
+
+static void
+initSymbolHash(void)
+{
+    nat i;
+
+    for (i=0; i < SYMBOL_HASH_SIZE; i++) {
+	symbol_hash[i].ptr = NULL;
+    }
+}
+
+static nat
+lookup_symbol(void *addr)
+{
+    nat orig_bucket = hash(addr);
+    nat bucket;
+
+    bucket = orig_bucket;
+    while (bucket < SYMBOL_HASH_SIZE && symbol_hash[bucket].ptr != NULL) {
+	if (symbol_hash[bucket].ptr == addr) {
+	    return bucket;
+	}
+	bucket++;
+    }
+    if (bucket == SYMBOL_HASH_SIZE) {
+	bucket = 0;
+	while (bucket < orig_bucket && symbol_hash[bucket].ptr != NULL) {
+	    if (symbol_hash[bucket].ptr == addr) {
+		return bucket;
+	    }
+	    bucket++;
+	}
+	if (bucket == orig_bucket) {
+	    barf("out of symbol table space");
+	}
+    }
+    
+    symbol_hash[bucket].ptr  = addr;
+    lookupGHCName(addr,&symbol_hash[bucket].name);
+    symbol_hash[bucket].data = 0;
+    return bucket;
+}
+
+static void
+clear_table_data(void)
+{
+    nat i;
+
+    for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
+	symbol_hash[i].data = 0;
+    }
+}
+
+static void
+fprint_data(FILE *fp)
+{
+    nat i;
+    
+    for (i = 0; i < SYMBOL_HASH_SIZE; i++) {
+	if (symbol_hash[i].data) {
+	    fprintf(fp, "   %s %d\n", symbol_hash[i].name, symbol_hash[i].data);
+	}
+    }
+}
+
+static inline void
+add_data(void *addr, nat data)
+{
+    symbol_hash[lookup_symbol(addr)].data += data;
+}
+
+/* -----------------------------------------------------------------------------
+   Closure Type Profiling;
+
+   PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
+   -------------------------------------------------------------------------- */
+
+static nat closure_types[N_CLOSURE_TYPES];
+
+static char *type_names[] = {
+      "INVALID_OBJECT"
+    , "CONSTR"
+    , "CONSTR_INTLIKE"
+    , "CONSTR_CHARLIKE"
+    , "CONSTR_STATIC"
+    , "CONSTR_NOCAF_STATIC"
+
+    , "FUN"
+    , "FUN_STATIC"
+
+    , "THUNK"
+    , "THUNK_STATIC"
+    , "THUNK_SELECTOR"
+
+    , "BCO"
+    , "AP_UPD"
+
+    , "PAP"
+
+    , "IND"
+    , "IND_OLDGEN"
+    , "IND_PERM"
+    , "IND_OLDGEN_PERM"
+    , "IND_STATIC"
+
+    , "RET_BCO"
+    , "RET_SMALL"
+    , "RET_VEC_SMALL"
+    , "RET_BIG"
+    , "RET_VEC_BIG"
+    , "RET_DYN"
+    , "UPDATE_FRAME"
+    , "CATCH_FRAME"
+    , "STOP_FRAME"
+    , "SEQ_FRAME"
+
+    , "BLACKHOLE"
+    , "BLACKHOLE_BQ"
+    , "MVAR"
+
+    , "ARR_WORDS"
+
+    , "MUT_ARR_PTRS"
+    , "MUT_ARR_PTRS_FROZEN"
+    , "MUT_VAR"
+
+    , "WEAK"
+    , "FOREIGN"
+  
+    , "TSO"
+
+    , "BLOCKED_FETCH"
+    , "FETCH_ME"
+
+    , "EVACUATED"
+};
+
+static void 
+fprint_closure_types(FILE *fp)
+{
+  nat i;
+
+  for (i = 0; i < N_CLOSURE_TYPES; i++) {
+    if (closure_types[i]) {
+      fprintf(fp, "   %s %d\n", type_names[i], closure_types[i]);
+    }
+  }
+}
+
+#endif /* DEBUG_HEAP_PROF */
+
+
+#ifdef PROFILING
+static void
+clearCCSResid(CostCentreStack *ccs)
+{
+  IndexTable *i;
+
+  ccs->mem_resid = 0;
+
+  for (i = ccs->indexTable; i != 0; i = i->next) {
+    clearCCSResid(i->ccs);
+  }
+}
+
+static void
+fprint_ccs(FILE *fp, CostCentreStack *ccs, nat components)
+{
+  CostCentre *cc;
+  CostCentreStack *prev;
+
+  cc = ccs->cc;
+  prev = ccs->prevStack;
+
+  if (prev == NULL
+      || prev->cc->is_subsumed != CC_IS_BORING
+      || components == 1) { 
+    fprintf(fp,"%s",cc->label);
+    return; 
+
+  } else {
+    fprint_ccs(fp, ccs->prevStack,components-1);
+    fprintf(fp,"/%s",cc->label);
+  }
+}
+
+static void
+reportCCSResid(FILE *fp, CostCentreStack *ccs)
+{
+  IndexTable *i;
+
+  if (ccs->mem_resid != 0) {
+    fprintf(fp,"   ");
+    fprint_ccs(fp,ccs,2/*print 2 components only*/);
+    fprintf(fp," %ld\n", ccs->mem_resid * sizeof(W_));
+  }
+
+  for (i = ccs->indexTable; i != 0; i = i->next) {
+    reportCCSResid(fp,i->ccs);
+  }
+}
+#endif
+
+void
+heapCensus(void)
+{
+  bdescr *bd;
+  const StgInfoTable *info;
+  StgDouble time;
+  nat size;
+  StgPtr p;
+  
+#ifdef DEBUG_HEAP_PROF
+  switch (RtsFlags.ProfFlags.doHeapProfile) {
+  case HEAP_BY_INFOPTR:
+    clear_table_data();
+    break;
+  case HEAP_BY_CLOSURE_TYPE:
+    memset(closure_types, 0, N_CLOSURE_TYPES * sizeof(nat));
+    break;
+  default:
+    return;
+  }
+#endif
+
+#ifdef PROFILING
+  switch (RtsFlags.ProfFlags.doHeapProfile) {
+  case NO_HEAP_PROFILING:
+    return;
+  case HEAP_BY_CCS:
+    break;
+  default:
+    barf("heapCensus; doHeapProfile");
+  }
+  /* zero all the residency counters */
+  clearCCSResid(CCS_MAIN);
+#endif
+
+  /* Only do heap profiling in a two-space heap */
+  ASSERT(RtsFlags.GcFlags.generations == 1);
+  bd = g0s0->to_space;
+
+  time = mut_user_time_during_GC();
+  fprintf(prof_file, "BEGIN_SAMPLE %0.2f\n", time);
+  
+  while (bd != NULL) {
+    p = bd->start;
+    while (p < bd->free) {
+      info = get_itbl((StgClosure *)p);
+
+      switch (info->type) {
+      case BCO:
+	size = bco_sizeW((StgBCO *)p);
+	break;
+	
+      case CONSTR:
+	if (((StgClosure *)p)->header.info == &DEAD_WEAK_info) {
+	  size = sizeofW(StgWeak);
+	  break;
+	}
+	/* else, fall through... */
+
+      case FUN:
+      case THUNK:
+      case IND_PERM:
+      case IND_OLDGEN_PERM:
+      case CAF_BLACKHOLE:
+      case SE_CAF_BLACKHOLE:
+      case SE_BLACKHOLE:
+      case BLACKHOLE:
+      case BLACKHOLE_BQ:
+      case WEAK:
+      case FOREIGN:
+      case STABLE_NAME:
+      case MVAR:
+      case MUT_VAR:
+      case CONSTR_INTLIKE:
+      case CONSTR_CHARLIKE:
+      case FUN_1_0:
+      case FUN_0_1:
+      case FUN_1_1:
+      case FUN_0_2:
+      case FUN_2_0:
+      case THUNK_1_0:
+      case THUNK_0_1:
+      case THUNK_1_1:
+      case THUNK_0_2:
+      case THUNK_2_0:
+      case CONSTR_1_0:
+      case CONSTR_0_1:
+      case CONSTR_1_1:
+      case CONSTR_0_2:
+      case CONSTR_2_0:
+	size = sizeW_fromITBL(info);
+	break;
+	
+      case THUNK_SELECTOR:
+	size = sizeofW(StgHeader) + MIN_UPD_SIZE;
+	break;
+	
+      case AP_UPD: /* we can treat this as being the same as a PAP */
+      case PAP:
+	size = pap_sizeW((StgPAP *)p);
+	break;
+	
+      case ARR_WORDS:
+	size = arr_words_sizeW(stgCast(StgArrWords*,p));
+	break;
+	
+      case MUT_ARR_PTRS:
+      case MUT_ARR_PTRS_FROZEN:
+	size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
+	break;
+	
+      case TSO:
+	size = tso_sizeW((StgTSO *)p);
+	break;
+	
+      default:
+	barf("heapCensus");
+      }
+
+#ifdef DEBUG_HEAP_PROF
+      switch (RtsFlags.ProfFlags.doHeapProfile) {
+      case HEAP_BY_INFOPTR:
+	add_data((void *)(*p), size * sizeof(W_));
+	break;
+      case HEAP_BY_CLOSURE_TYPE:
+	closure_types[info->type] += size * sizeof(W_);
+	break;
+      }
+#endif
+
+#ifdef PROFILING      
+      ((StgClosure *)p)->header.prof.ccs->mem_resid += size;
+#endif
+      p += size;
+    }
+    bd = bd->link;
+  }
+
+#ifdef DEBUG_HEAP_PROF
+  switch (RtsFlags.ProfFlags.doHeapProfile) {
+  case HEAP_BY_INFOPTR:
+    fprint_data(prof_file);
+    break;
+  case HEAP_BY_CLOSURE_TYPE:
+    fprint_closure_types(prof_file);
+    break;
+  }
+#endif
+    
+#ifdef PROFILING
+  reportCCSResid(prof_file,CCS_MAIN);
+#endif
+
+  fprintf(prof_file, "END_SAMPLE %0.2f\n", time);
+}    
+
+#endif /* PROFILING || DEBUG_HEAP_PROF */
+

ghc/rts/DebugProf.h → ghc/rts/ProfHeap.h

 /* -----------------------------------------------------------------------------
- * $Id: DebugProf.h,v 1.3 1999/09/15 13:45:16 simonmar Exp $
+ * $Id: ProfHeap.h,v 1.1 1999/09/15 13:46:29 simonmar Exp $
  *
- * (c) The GHC Team 1998
+ * (c) The GHC Team, 1998-1999
  *
- * Simple Heap Profiling
+ * Support for heap profiling
  *
  * ---------------------------------------------------------------------------*/
 
-#if !defined(PROFILING) && defined(DEBUG)
 
-extern void heapCensus(bdescr *bd);
-
-#endif
+void heapCensus(void);
+extern nat initHeapProfiling(void);
+void endHeapProfiling(void);