From 1e87b41b945600dc1f4bb977921f89cb97a001d7 Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Thu, 18 Mar 1999 17:57:24 +0000
Subject: [PATCH] [project @ 1999-03-18 17:57:19 by simonm] Some fixes to
 profiling stuff.

---
 ghc/includes/InfoTables.h  |    4 ++--
 ghc/includes/StgProf.h     |    4 ++--
 ghc/includes/Updates.h     |    9 ++++++++-
 ghc/rts/GC.c               |   22 ++++++++++++++++++----
 ghc/rts/StgMiscClosures.hc |    4 ++--
 ghc/rts/Storage.h          |   23 ++++++++++++++++++++++-
 ghc/rts/Updates.hc         |   30 +++++++++++++++++-------------
 7 files changed, 71 insertions(+), 25 deletions(-)

diff --git a/ghc/includes/InfoTables.h b/ghc/includes/InfoTables.h
index c1e28d6..9873302 100644
--- a/ghc/includes/InfoTables.h
+++ b/ghc/includes/InfoTables.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: InfoTables.h,v 1.13 1999/03/15 16:30:25 simonm Exp $
+ * $Id: InfoTables.h,v 1.14 1999/03/18 17:57:19 simonm Exp $
  * 
  * (c) The GHC Team, 1998-1999
  *
@@ -160,7 +160,7 @@ typedef struct _StgInfoTable {
     StgParInfo	    par;
 #endif
 #ifdef PROFILING
-    StgProfInfo     prof;
+  /* StgProfInfo     prof; */
 #endif
 #ifdef DEBUG_CLOSURE
     StgDebugInfo    debug;
diff --git a/ghc/includes/StgProf.h b/ghc/includes/StgProf.h
index e0a0055..6cebb33 100644
--- a/ghc/includes/StgProf.h
+++ b/ghc/includes/StgProf.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgProf.h,v 1.2 1998/12/02 13:21:39 simonm Exp $
+ * $Id: StgProf.h,v 1.3 1999/03/18 17:57:19 simonm Exp $
  *
  * (c) The GHC Team, 1998
  *
@@ -123,7 +123,7 @@ extern CostCentreStack *CCS_LIST;         /* registered CCS list */
 /* For grabbing the cost centre from a closure */
 #define CCS_HDR(closure)   ((StgClosure *)(closure))->header.prof.ccs
 
-/* Restore the CCCS from a stack fram.
+/* Restore the CCCS from a stack frame.
  * (addr should always be Sp->header.prof.ccs) 
  */
 #define RESTORE_CCCS(addr)   (CCCS = (CostCentreStack *)(addr))
diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h
index 12a48f4..08a517a 100644
--- a/ghc/includes/Updates.h
+++ b/ghc/includes/Updates.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.8 1999/03/02 19:44:23 sof Exp $
+ * $Id: Updates.h,v 1.9 1999/03/18 17:57:20 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -31,6 +31,13 @@
 	updateWithIndirection((StgClosure *)updclosure,         \
 			      (StgClosure *)heapptr);
 
+#ifdef PROFILING
+#define UPD_PERM_IND(updclosure, heapptr)                       \
+        AWAKEN_BQ(updclosure);                                  \
+	updateWithPermIndirection((StgClosure *)updclosure,     \
+			          (StgClosure *)heapptr);
+#endif
+
 /* -----------------------------------------------------------------------------
    Awaken any threads waiting on this computation
    -------------------------------------------------------------------------- */
diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 8116700..f44b4fc 100644
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.54 1999/03/17 16:28:34 sewardj Exp $
+ * $Id: GC.c,v 1.55 1999/03/18 17:57:21 simonm Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -1654,8 +1654,6 @@ scavenge(step *step)
     case WEAK:
     case FOREIGN:
     case STABLE_NAME:
-    case IND_PERM:
-    case IND_OLDGEN_PERM:
       {
 	StgPtr end;
 
@@ -1667,6 +1665,21 @@ scavenge(step *step)
 	break;
       }
 
+    case IND_PERM:
+      if (step->gen->no != 0) {
+	SET_INFO(((StgClosure *)p), &IND_OLDGEN_PERM_info);
+      }
+      /* fall through */
+    case IND_OLDGEN_PERM:
+      ((StgIndOldGen *)p)->indirectee = 
+	evacuate(((StgIndOldGen *)p)->indirectee);
+      if (failed_to_evac) {
+	failed_to_evac = rtsFalse;
+	recordOldToNewPtrs((StgMutClosure *)p);
+      }
+      p += sizeofW(StgIndOldGen);
+      break;
+
     case CAF_UNENTERED:
       {
 	StgCAF *caf = (StgCAF *)p;
@@ -2776,7 +2789,8 @@ threadSqueezeStack(StgTSO *tso)
    */
   
   next_frame = NULL;
-  while ((P_)frame < bottom - 1) {  /* bottom - 1 is the STOP_FRAME */
+  /* bottom - sizeof(StgStopFrame) is the STOP_FRAME */
+  while ((P_)frame < bottom - sizeofW(StgStopFrame)) {  
     prev_frame = frame->link;
     frame->link = next_frame;
     next_frame = frame;
diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 0b6432a..67dadf0 100644
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.18 1999/03/16 13:20:17 simonm Exp $
+ * $Id: StgMiscClosures.hc,v 1.19 1999/03/18 17:57:23 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -48,7 +48,7 @@ STGFUN(IND_STATIC_entry)
     FE_
 }
 
-INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,0,IND_PERM,const,EF_,0,0);
+INFO_TABLE(IND_PERM_info,IND_PERM_entry,1,1,IND_PERM,const,EF_,0,0);
 STGFUN(IND_PERM_entry)
 {
     FB_
diff --git a/ghc/rts/Storage.h b/ghc/rts/Storage.h
index fc93e01..9c9b270 100644
--- a/ghc/rts/Storage.h
+++ b/ghc/rts/Storage.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.7 1999/02/05 16:03:01 simonm Exp $
+ * $Id: Storage.h,v 1.8 1999/03/18 17:57:23 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -138,6 +138,27 @@ updateWithIndirection(StgClosure *p1, StgClosure *p2)
   }
 }
 
+#ifdef PROFILING
+static inline void
+updateWithPermIndirection(StgClosure *p1, StgClosure *p2) 
+{
+  bdescr *bd;
+
+  bd = Bdescr((P_)p1);
+  if (bd->gen->no == 0) {
+    SET_INFO(p1,&IND_PERM_info);
+    ((StgInd *)p1)->indirectee = p2;
+    TICK_UPD_NEW_IND();
+  } else {
+    SET_INFO(p1,&IND_OLDGEN_PERM_info);
+    ((StgIndOldGen *)p1)->indirectee = p2;
+    ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;
+    bd->gen->mut_once_list = (StgMutClosure *)p1;
+    TICK_UPD_OLD_IND();
+  }
+}
+#endif
+
 /* -----------------------------------------------------------------------------
    The CAF list - used to let us revert CAFs
 
diff --git a/ghc/rts/Updates.hc b/ghc/rts/Updates.hc
index d3b5ba6..daecd28 100644
--- a/ghc/rts/Updates.hc
+++ b/ghc/rts/Updates.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Updates.hc,v 1.9 1999/02/05 16:03:03 simonm Exp $
+ * $Id: Updates.hc,v 1.10 1999/03/18 17:57:24 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -333,25 +333,29 @@ EXTFUN(stg_update_PAP)
        * either the new PAP or Node.
        */
       
-      Updatee = Su->updatee; 
-      UPD_IND(Updatee,PapClosure);
-      
+      Updatee = Su->updatee;
+
+#if defined(PROFILING)
       if (Words != 0) {
+        UPD_IND(Updatee,PapClosure);
 	TICK_UPD_PAP_IN_NEW(Words+1);
-	
       } else {
-	TICK_UPD_PAP_IN_PLACE();
-	
-#if defined(PROFILING)
-	/* 
-	 * Lexical scoping requires a *permanent* indirection, and we
+	/* Lexical scoping requires a *permanent* indirection, and we
 	 * also have to set the cost centre for the indirection.
 	 */
-	SET_INFO(Updatee, &IND_PERM_info);
+	UPD_PERM_IND(Updatee,PapClosure);
+	TICK_UPD_PAP_IN_PLACE();
 	Updatee->header.prof.ccs = CCS_pap;
-#endif /* PROFILING */
       }
-      
+#else
+      UPD_IND(Updatee,PapClosure);
+      if (Words != 0) {
+	TICK_UPD_PAP_IN_NEW(Words+1);
+      } else {
+	TICK_UPD_PAP_IN_PLACE();
+      }
+#endif	
+
 #if defined(PROFILING)
       /* 
        * Restore the Cost Centre too (if required); again see Sansom
-- 
1.7.10.4