[project @ 1999-03-18 17:57:19 by simonm]

Some fixes to profiling stuff.

diff --git a/ghc/includes/InfoTables.h b/ghc/includes/InfoTables.h
index c1e28d6..9873302 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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