X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FProfiling.c;h=028dc5a5091bf04fa8cdde31cf382ddf102f5b67;hb=7f24ae51ed36c5c0308a2d0de23e243f32a0043c;hp=abe319ddf3f8467a672f12beb1875153e46caa48;hpb=423d477bfecd490de1449c59325c8776f91d7aac;p=ghc-hetmet.git

diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c
index abe319d..028dc5a 100644
--- a/ghc/rts/Profiling.c
+++ b/ghc/rts/Profiling.c
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.38 2004/08/13 13:10:26 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -266,7 +265,7 @@ initProfilingLogFile(void)
 
     /* open the log file */
     if ((prof_file = fopen(prof_filename, "w")) == NULL) {
-	fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
+	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.
@@ -297,7 +296,7 @@ initProfilingLogFile(void)
 	
 	/* open the log file */
 	if ((hp_file = fopen(hp_filename, "w")) == NULL) {
-	    fprintf(stderr, "Can't open profiling report file %s\n", 
+	    debugBelch("Can't open profiling report file %s\n", 
 		    hp_filename);
 	    RtsFlags.ProfFlags.doHeapProfile = 0;
 	    return;
@@ -355,9 +354,9 @@ PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
 #define PushCostCentre _PushCostCentre
 {
   IF_DEBUG(prof, 
-	   fprintf(stderr,"Pushing %s on ", cc->label);
-	   fprintCCS(stderr,ccs);
-	   fprintf(stderr,"\n"));
+	   debugBelch("Pushing %s on ", cc->label);
+	   debugCCS(ccs);
+	   debugBelch("\n"));
   return PushCostCentre(ccs,cc);
 }
 #endif
@@ -417,11 +416,11 @@ AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
 {
   IF_DEBUG(prof, 
 	   if (ccs1 != ccs2) {
-	     fprintf(stderr,"Appending ");
-	     fprintCCS(stderr,ccs1);
-	     fprintf(stderr," to ");
-	     fprintCCS(stderr,ccs2);
-	     fprintf(stderr,"\n");});
+	     debugBelch("Appending ");
+	     debugCCS(ccs1);
+	     debugBelch(" to ");
+	     debugCCS(ccs2);
+	     debugBelch("\n");});
   return AppendCCS(ccs1,ccs2);
 }
 #endif
@@ -461,8 +460,7 @@ static CostCentreStack *
 ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
 {
   /* assign values to each member of the structure */
-  ASSIGN_CCS_ID(new_ccs->ccsID);
-  
+  new_ccs->ccsID = CCS_ID++;
   new_ccs->cc = cc;
   new_ccs->prevStack = ccs;
   
@@ -665,7 +663,7 @@ report_per_cc_costs( void )
 	  );
       
       if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-	  fprintf(prof_file, "  %5ld %9lld", cc->time_ticks, cc->mem_alloc);
+	fprintf(prof_file, "  %5llu %9llu", (StgWord64)(cc->time_ticks), cc->mem_alloc);
       }
       fprintf(prof_file, "\n");
   }
@@ -779,7 +777,7 @@ reportCCS(CostCentreStack *ccs, nat indent)
 	    );
 
     if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-      fprintf(prof_file, "  %5ld %9lld", ccs->time_ticks, ccs->mem_alloc*sizeof(W_));
+      fprintf(prof_file, "  %5llu %9llu", (StgWord64)(ccs->time_ticks), ccs->mem_alloc*sizeof(W_));
 #if defined(PROFILING_DETAIL_COUNTS)
       fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
 	      ccs->mem_allocs, ccs->thunk_count,
@@ -895,8 +893,8 @@ reportCCS_XML(CostCentreStack *ccs)
 
   cc = ccs->cc;
   
-  fprintf(prof_file, " 1 %d %llu %lu %llu", 
-	  ccs->ccsID, ccs->scc_count, ccs->time_ticks, ccs->mem_alloc);
+  fprintf(prof_file, " 1 %d %llu %llu %llu", 
+	  ccs->ccsID, ccs->scc_count, (StgWord64)(ccs->time_ticks), ccs->mem_alloc);
 
   for (i = ccs->indexTable; i != 0; i = i->next) {
     if (!i->back_edge) {
@@ -918,4 +916,26 @@ fprintCCS( FILE *f, CostCentreStack *ccs )
   fprintf(f,">");
 }
 
+/* For calling from .cmm code, where we can't reliably refer to stderr */
+void
+fprintCCS_stderr( CostCentreStack *ccs )
+{
+    fprintCCS(stderr, ccs);
+}
+
+#ifdef DEBUG
+void
+debugCCS( CostCentreStack *ccs )
+{
+  debugBelch("<");
+  for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
+      debugBelch("%s.%s", ccs->cc->module, ccs->cc->label);
+      if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
+	  debugBelch(",");
+      }
+  }
+  debugBelch(">");
+}
+#endif /* DEBUG */
+
 #endif /* PROFILING */