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.
/* ---------------------------------------------------------------------------
/* ---------------------------------------------------------------------------
- * $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
*
*
* (c) The GHC Team, 1998-2000
*
#if defined(SMP) || defined(PAR) || defined(GRAN)
markSparkQueue();
#endif
#if defined(SMP) || defined(PAR) || defined(GRAN)
markSparkQueue();
#endif
+
+#if defined(GHCI)
+ markCafs();
+#endif
}
/* -----------------------------------------------------------------------------
}
/* -----------------------------------------------------------------------------
/* -----------------------------------------------------------------------------
/* -----------------------------------------------------------------------------
- * $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
*
*
* (c) The GHC Team, 1998-1999
*
((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
oldest_gen->mut_once_list = (StgMutClosure *)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
#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
RELEASE_LOCK(&sm_mutex);
}
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)
#ifdef INTERPRETER
void
newCAF_made_by_Hugs(StgCAF* caf)
/* -----------------------------------------------------------------------------
/* -----------------------------------------------------------------------------
- * $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
*
*
* (c) The GHC Team, 1998-1999
*
extern void GarbageCollect(void (*get_roots)(void),rtsBool force_major_gc);
extern StgClosure *MarkRoot(StgClosure *p);
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
/* -----------------------------------------------------------------------------
Generational garbage collection support
-------------------------------------------------------------------------- */
-------------------------------------------------------------------------- */
+/* ToDo: shouldn't recordMutable and recordOldToNewPtrs acquire some
+ * kind of lock in the SMP case?
+ */
static inline void
recordMutable(StgMutClosure *p)
{
static inline void
recordMutable(StgMutClosure *p)
{
} else { \
((StgIndOldGen *)p1)->indirectee = p2; \
if (info != &stg_BLACKHOLE_BQ_info) { \
} 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; \
((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(); \
} \
SET_INFO(p1,&stg_IND_OLDGEN_info); \
TICK_UPD_OLD_IND(); \
((StgClosure *)p1)->payload[i] = 0; \
} \
} \
((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; \
((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); \
} \
((StgIndOldGen *)p1)->indirectee = p2; \
SET_INFO(p1,&stg_IND_OLDGEN_info); \
+/* 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)
#if defined(TICKY_TICKY) || defined(PROFILING)
static inline void
updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *p2)
} else {
((StgIndOldGen *)p1)->indirectee = p2;
if (info != &stg_BLACKHOLE_BQ_info) {
} 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;
((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();
}
SET_INFO(p1,&stg_IND_OLDGEN_PERM_info);
TICK_UPD_OLD_PERM_IND();