[project @ 2001-01-24 15:46:19 by simonmar]

Add a CAF list for GHCI.

Retaining all looked-up symbols in a list in the interpreter was the
Wrong Thing To Do, since we can't guarantee that the transitive
closure of this list points to all the CAFs so far evaluated (the
transitive closure gets smaller as reachable CAFs are evaluated).

A Better Thing To Do is just to retain all the CAFs.  A refinement is
to only retain all CAFs in dynamically linked code, which is what this
patch implements.

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 4528180..63abd17 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.86 2001/01/16 11:59:06 simonmar Exp $
+ * $Id: Schedule.c,v 1.87 2001/01/24 15:46:19 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -2006,6 +2006,10 @@ static void GetRoots(void)
 #if defined(SMP) || defined(PAR) || defined(GRAN)
   markSparkQueue();
 #endif
+
+#if defined(GHCI)
+  markCafs();
+#endif
 }
 
 /* -----------------------------------------------------------------------------

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 8057660..1119519 100644 (file)
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.32 2001/01/16 12:02:04 simonmar Exp $
+ * $Id: Storage.c,v 1.33 2001/01/24 15:46:19 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -216,6 +216,16 @@ newCAF(StgClosure* caf)
   ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
   oldest_gen->mut_once_list = (StgMutClosure *)caf;
 
+#ifdef GHCI
+  /* For dynamically-loaded code, we retain all the CAFs.  There is no
+   * way of knowing which ones we'll need in the future.
+   */
+  if (is_dynamically_loaded_rwdata_ptr((StgPtr)caf)) {
+      caf->payload[2] = caf_list; /* IND_STATIC_LINK2() */
+      caf_list = caf;
+  }
+#endif
+
 #ifdef INTERPRETER
   /* If we're Hugs, we also have to put it in the CAF table, so that
      the CAF can be reverted.  When reverting, CAFs created by compiled
@@ -231,6 +241,18 @@ newCAF(StgClosure* caf)
   RELEASE_LOCK(&sm_mutex);
 }
 
+#ifdef GHCI
+void
+markCafs( void )
+{
+    StgClosure *p;
+
+    for (p = caf_list; p != NULL; p = STATIC_LINK2(get_itbl(p),p)) {
+       MarkRoot(p);
+    }
+}
+#endif /* GHCI */
+
 #ifdef INTERPRETER
 void
 newCAF_made_by_Hugs(StgCAF* caf)

diff --git a/ghc/rts/Storage.h b/ghc/rts/Storage.h
index 612874b..06261f3 100644 (file)
--- a/ghc/rts/Storage.h
+++ b/ghc/rts/Storage.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.21 2001/01/09 17:36:21 sewardj Exp $
+ * $Id: Storage.h,v 1.22 2001/01/24 15:46:19 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -81,6 +81,11 @@ extern void PleaseStopAllocating(void);
 extern void   GarbageCollect(void (*get_roots)(void),rtsBool force_major_gc);
 extern StgClosure *MarkRoot(StgClosure *p);
 
+/* Temporary measure to ensure we retain all the dynamically-loaded CAFs */
+#ifdef GHCI
+extern void markCafs( void );
+#endif
+
 /* -----------------------------------------------------------------------------
    Generational garbage collection support
 
@@ -98,6 +103,9 @@ extern StgClosure *MarkRoot(StgClosure *p);
 
    -------------------------------------------------------------------------- */
 
+/* ToDo: shouldn't recordMutable and recordOldToNewPtrs acquire some
+ * kind of lock in the SMP case?
+ */
 static inline void
 recordMutable(StgMutClosure *p)
 {
@@ -141,8 +149,10 @@ recordOldToNewPtrs(StgMutClosure *p)
     } else {                                                           \
       ((StgIndOldGen *)p1)->indirectee = p2;                           \
       if (info != &stg_BLACKHOLE_BQ_info) {                            \
+        ACQUIRE_LOCK(&sm_mutex);                                       \
         ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;       \
         bd->gen->mut_once_list = (StgMutClosure *)p1;                  \
+        RELEASE_LOCK(&sm_mutex);                                       \
       }                                                                        \
       SET_INFO(p1,&stg_IND_OLDGEN_info);                               \
       TICK_UPD_OLD_IND();                                              \
@@ -172,8 +182,10 @@ recordOldToNewPtrs(StgMutClosure *p)
             ((StgClosure *)p1)->payload[i] = 0;                        \
           }                                                            \
         }                                                              \
+        ACQUIRE_LOCK(&sm_mutex);                                       \
         ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;       \
         bd->gen->mut_once_list = (StgMutClosure *)p1;                  \
+        RELEASE_LOCK(&sm_mutex);                                       \
       }                                                                        \
       ((StgIndOldGen *)p1)->indirectee = p2;                           \
       SET_INFO(p1,&stg_IND_OLDGEN_info);                               \
@@ -182,6 +194,22 @@ recordOldToNewPtrs(StgMutClosure *p)
   }
 #endif
 
+/* Static objects all live in the oldest generation
+ */
+#define updateWithStaticIndirection(info, p1, p2)                      \
+  {                                                                    \
+    ASSERT( ((StgMutClosure*)p1)->mut_link == NULL );                  \
+                                                                       \
+    ACQUIRE_LOCK(&sm_mutex);                                           \
+    ((StgMutClosure *)p1)->mut_link = oldest_gen->mut_once_list;       \
+    oldest_gen->mut_once_list = (StgMutClosure *)p1;                   \
+    RELEASE_LOCK(&sm_mutex);                                           \
+                                                                       \
+    ((StgInd *)p1)->indirectee = p2;                                   \
+    SET_INFO((StgInd *)p1, &stg_IND_STATIC_info);                      \
+    TICK_UPD_STATIC_IND();                                             \
+  }
+
 #if defined(TICKY_TICKY) || defined(PROFILING)
 static inline void
 updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *p2) 
@@ -196,8 +224,10 @@ updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *
   } else {
     ((StgIndOldGen *)p1)->indirectee = p2;
     if (info != &stg_BLACKHOLE_BQ_info) {
+      ACQUIRE_LOCK(&sm_mutex);
       ((StgIndOldGen *)p1)->mut_link = bd->gen->mut_once_list;
       bd->gen->mut_once_list = (StgMutClosure *)p1;
+      RELEASE_LOCK(&sm_mutex);
     }
     SET_INFO(p1,&stg_IND_OLDGEN_PERM_info);
     TICK_UPD_OLD_PERM_IND();