/* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.23 2001/01/26 14:17:01 simonpj Exp $
+ * $Id: Storage.h,v 1.40 2002/02/04 20:21:16 sof Exp $
*
* (c) The GHC Team, 1998-1999
*
#define STORAGE_H
#include "Block.h"
+#include "MBlock.h"
#include "BlockAlloc.h"
#include "StoragePriv.h"
+#ifdef PROFILING
+#include "LdvProfile.h"
+#endif
/* -----------------------------------------------------------------------------
Initialisation / De-initialisation
/* -----------------------------------------------------------------------------
Generic allocation
- StgPtr allocate(int n) Allocates a chunk of contiguous store
+ StgPtr allocate(nat n) Allocates a chunk of contiguous store
n words long, returning a pointer to
the first word. Always succeeds.
+ StgPtr allocatePinned(nat n) Allocates a chunk of contiguous store
+ n words long, which is at a fixed
+ address (won't be moved by GC).
+ Returns a pointer to the first word.
+ Always succeeds.
+
+ NOTE: the GC can't in general handle
+ pinned objects, so allocatePinned()
+ can only be used for ByteArrays at the
+ moment.
+
Don't forget to TICK_ALLOC_XXX(...)
- after calling allocate, for the
+ after calling allocate or
+ allocatePinned, for the
benefit of the ticky-ticky profiler.
rtsBool doYouWantToGC(void) Returns True if the storage manager is
surrounded by a mutex.
-------------------------------------------------------------------------- */
-extern StgPtr allocate(nat n);
-static inline rtsBool doYouWantToGC(void)
+extern StgPtr allocate ( nat n );
+extern StgPtr allocatePinned ( nat n );
+extern lnat allocated_bytes ( void );
+
+static inline rtsBool
+doYouWantToGC( void )
{
return (alloc_blocks >= alloc_blocks_lim);
}
-extern lnat allocated_bytes(void);
/* -----------------------------------------------------------------------------
ExtendNursery(hp,hplim) When hplim is reached, try to grab
MarkRoot(StgClosure *p) Returns the new location of the root.
-------------------------------------------------------------------------- */
-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
+extern void GarbageCollect(void (*get_roots)(evac_fn),rtsBool force_major_gc);
/* -----------------------------------------------------------------------------
Generational garbage collection support
-------------------------------------------------------------------------- */
+/*
+ * Storage manager mutex
+ */
+#if defined(SMP)
+extern Mutex sm_mutex;
+#define ACQUIRE_SM_LOCK ACQUIRE_LOCK(&sm_mutex)
+#define RELEASE_SM_LOCK RELEASE_LOCK(&sm_mutex)
+#else
+#define ACQUIRE_SM_LOCK
+#define RELEASE_SM_LOCK
+#endif
+
/* ToDo: shouldn't recordMutable and recordOldToNewPtrs acquire some
* kind of lock in the SMP case?
*/
#endif
bd = Bdescr((P_)p);
- if (bd->gen->no > 0) {
- p->mut_link = bd->gen->mut_list;
- bd->gen->mut_list = p;
+ if (bd->gen_no > 0) {
+ p->mut_link = generations[bd->gen_no].mut_list;
+ generations[bd->gen_no].mut_list = p;
}
}
bdescr *bd;
bd = Bdescr((P_)p);
- if (bd->gen->no > 0) {
- p->mut_link = bd->gen->mut_once_list;
- bd->gen->mut_once_list = p;
+ if (bd->gen_no > 0) {
+ p->mut_link = generations[bd->gen_no].mut_once_list;
+ generations[bd->gen_no].mut_once_list = p;
}
}
-#ifndef DEBUG
+// @LDV profiling
+// We zero out the slop when PROFILING is on.
+// #ifndef DEBUG
+#if !defined(DEBUG) && !defined(PROFILING)
#define updateWithIndirection(info, p1, p2) \
{ \
bdescr *bd; \
\
bd = Bdescr((P_)p1); \
- if (bd->gen->no == 0) { \
+ if (bd->gen_no == 0) { \
((StgInd *)p1)->indirectee = p2; \
SET_INFO(p1,&stg_IND_info); \
TICK_UPD_NEW_IND(); \
} 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); \
+ ACQUIRE_SM_LOCK; \
+ ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \
+ generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; \
+ RELEASE_SM_LOCK; \
} \
SET_INFO(p1,&stg_IND_OLDGEN_info); \
TICK_UPD_OLD_IND(); \
} \
}
+#elif defined(PROFILING)
+// @LDV profiling
+// We call LDV_recordDead_FILL_SLOP_DYNAMIC(p1) regardless of the generation in
+// which p1 resides.
+//
+// Note:
+// After all, we do *NOT* need to call LDV_recordCreate() for both IND and
+// IND_OLDGEN closures because they are inherently used. But, it corrupts
+// the invariants that every closure keeps its creation time in the profiling
+// field. So, we call LDV_recordCreate().
+
+#define updateWithIndirection(info, p1, p2) \
+ { \
+ bdescr *bd; \
+ \
+ LDV_recordDead_FILL_SLOP_DYNAMIC((p1)); \
+ bd = Bdescr((P_)p1); \
+ if (bd->gen_no == 0) { \
+ ((StgInd *)p1)->indirectee = p2; \
+ SET_INFO(p1,&stg_IND_info); \
+ LDV_recordCreate((p1)); \
+ TICK_UPD_NEW_IND(); \
+ } else { \
+ ((StgIndOldGen *)p1)->indirectee = p2; \
+ if (info != &stg_BLACKHOLE_BQ_info) { \
+ ACQUIRE_SM_LOCK; \
+ ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \
+ generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; \
+ RELEASE_SM_LOCK; \
+ } \
+ SET_INFO(p1,&stg_IND_OLDGEN_info); \
+ LDV_recordCreate((p1)); \
+ } \
+ }
+
#else
/* In the DEBUG case, we also zero out the slop of the old closure,
* so that the sanity checker can tell where the next closure is.
+ *
+ * Two important invariants: we should never try to update a closure
+ * to point to itself, and the closure being updated should not
+ * already have been updated (the mutable list will get messed up
+ * otherwise).
*/
#define updateWithIndirection(info, p1, p2) \
{ \
bdescr *bd; \
\
+ ASSERT( p1 != p2 && !closure_IND(p1) ); \
bd = Bdescr((P_)p1); \
- if (bd->gen->no == 0) { \
+ if (bd->gen_no == 0) { \
((StgInd *)p1)->indirectee = p2; \
SET_INFO(p1,&stg_IND_info); \
TICK_UPD_NEW_IND(); \
} else { \
if (info != &stg_BLACKHOLE_BQ_info) { \
- { \
+ { \
StgInfoTable *inf = get_itbl(p1); \
nat np = inf->layout.payload.ptrs, \
nw = inf->layout.payload.nptrs, i; \
- for (i = np; i < np + nw; i++) { \
- ((StgClosure *)p1)->payload[i] = 0; \
+ if (inf->type != THUNK_SELECTOR) { \
+ for (i = np; i < np + nw; i++) { \
+ ((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); \
+ ACQUIRE_SM_LOCK; \
+ ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list; \
+ generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1; \
+ RELEASE_SM_LOCK; \
} \
((StgIndOldGen *)p1)->indirectee = p2; \
SET_INFO(p1,&stg_IND_OLDGEN_info); \
*/
#define updateWithStaticIndirection(info, p1, p2) \
{ \
+ ASSERT( p1 != p2 && !closure_IND(p1) ); \
ASSERT( ((StgMutClosure*)p1)->mut_link == NULL ); \
\
- ACQUIRE_LOCK(&sm_mutex); \
+ ACQUIRE_SM_LOCK; \
((StgMutClosure *)p1)->mut_link = oldest_gen->mut_once_list; \
oldest_gen->mut_once_list = (StgMutClosure *)p1; \
- RELEASE_LOCK(&sm_mutex); \
+ RELEASE_SM_LOCK; \
\
((StgInd *)p1)->indirectee = p2; \
SET_INFO((StgInd *)p1, &stg_IND_STATIC_info); \
{
bdescr *bd;
+ ASSERT( p1 != p2 && !closure_IND(p1) );
+
+#ifdef PROFILING
+ // @LDV profiling
+ // Destroy the old closure.
+ // Nb: LDV_* stuff cannot mix with ticky-ticky
+ LDV_recordDead_FILL_SLOP_DYNAMIC(p1);
+#endif
bd = Bdescr((P_)p1);
- if (bd->gen->no == 0) {
+ if (bd->gen_no == 0) {
((StgInd *)p1)->indirectee = p2;
SET_INFO(p1,&stg_IND_PERM_info);
+#ifdef PROFILING
+ // @LDV profiling
+ // We have just created a new closure.
+ LDV_recordCreate(p1);
+#endif
TICK_UPD_NEW_PERM_IND(p1);
} 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);
+ ACQUIRE_SM_LOCK;
+ ((StgIndOldGen *)p1)->mut_link = generations[bd->gen_no].mut_once_list;
+ generations[bd->gen_no].mut_once_list = (StgMutClosure *)p1;
+ RELEASE_SM_LOCK;
}
SET_INFO(p1,&stg_IND_OLDGEN_PERM_info);
+#ifdef PROFILING
+ // @LDV profiling
+ // We have just created a new closure.
+ LDV_recordCreate(p1);
+#endif
TICK_UPD_OLD_PERM_IND();
}
}
The CAF table - used to let us revert CAFs
-------------------------------------------------------------------------- */
-#if defined(INTERPRETER)
-typedef struct StgCAFTabEntry_ {
- StgClosure* closure;
- StgInfoTable* origItbl;
-} StgCAFTabEntry;
-
-extern void addToECafTable ( StgClosure* closure, StgInfoTable* origItbl );
-extern void clearECafTable ( void );
-
-extern StgCAF* ecafList;
-extern StgCAFTabEntry* ecafTable;
-extern StgInt usedECafTable;
-extern StgInt sizeECafTable;
-#endif
+void revertCAFs( void );
#if defined(DEBUG)
void printMutOnceList(generation *gen);
void printMutableList(generation *gen);
-#endif DEBUG
+#endif /* DEBUG */
/* --------------------------------------------------------------------------
Address space layout macros
HEAP Dynamically-allocated closures
+ USER None of the above. The only way USER things arise right
+ now is when GHCi allocates a constructor info table, which
+ it does by mallocing them.
+
Three macros identify these three areas:
- IS_CODE(p), IS_DATA(p), HEAP_ALLOCED(p)
+ IS_DATA(p), HEAP_ALLOCED(p)
HEAP_ALLOCED is called FOR EVERY SINGLE CLOSURE during GC.
It needs to be FAST.
TEXT_SECTION_END_MARKER (usually _etext)
DATA section
DATA_SECTION_END_MARKER (usually _end)
- ???
+ USER section
HEAP_BASE
HEAP section
is_dynamically_loaded_code_or_rodata_ptr
is_dynamically_loaded_code_or_rwdata_ptr
- For the [DLL] case, IS_CODE and IS_DATA are really not usable at all.
+ For the [DLL] case, IS_DATA is really not usable at all.
*/
extern void* TEXT_SECTION_END_MARKER_DECL;
extern void* DATA_SECTION_END_MARKER_DECL;
-#if defined(INTERPRETER) || defined(GHCI)
/* Take into account code sections in dynamically loaded object files. */
-#define IS_CODE_PTR(p) ( ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) \
- || is_dynamically_loaded_code_or_rodata_ptr((char *)p) )
#define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && \
(P_)(p) < (P_)&DATA_SECTION_END_MARKER) \
|| is_dynamically_loaded_rwdata_ptr((char *)p) )
#define IS_USER_PTR(p) ( ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER) \
&& is_not_dynamically_loaded_ptr((char *)p) )
-#else
-#define IS_CODE_PTR(p) ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER)
-#define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER)
-#define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
-#endif
/* The HEAP_ALLOCED test below is called FOR EVERY SINGLE CLOSURE
* during GC. It needs to be FAST.
walks over the "pending arguments" on its way to the next return address.
It is called moderately often, but not as often as HEAP_ALLOCED
+ ToDo: LOOKS_LIKE_GHC_INFO(p) does not return True when p points to a
+ constructor info table allocated by GHCi. We should really rename
+ LOOKS_LIKE_GHC_INFO to LOOKS_LIKE_GHC_RETURN_INFO.
Implementation
~~~~~~~~~~~~~~
We have three approaches:
Plan A: Address-space partitioning.
- Keep info tables in the (single, contiguous) text segment: IS_CODE_PTR(p)
- and static closures in the (single, contiguous) data segment: IS_DATA_PTR(p)
+ keep static closures in the (single, contiguous) data segment: IS_DATA_PTR(p)
Plan A can fail for two reasons:
* In many environments (eg. dynamic loading),
LOOKS_LIKE_STATIC()
- distinguishes between static and heap allocated data.
*/
-#if defined(ENABLE_WIN32_DLL_SUPPORT) && !defined(INTERPRETER)
+#if defined(ENABLE_WIN32_DLL_SUPPORT)
/* definitely do not enable for mingw DietHEP */
#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
infotables for constructors on the (writable) C heap.
-------------------------------------------------------------------------- */
-#ifdef INTERPRETER
-# ifdef USE_MINIINTERPRETER
- /* yoiks: one of the dreaded pointer equality tests */
-# define IS_HUGS_CONSTR_INFO(info) \
- (((StgInfoTable *)(info))->entry == (StgFunPtr)&Hugs_CONSTR_entry)
-# else
-# define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
-# endif
-#elif GHCI
- /* not accurate by any means, but stops the assertions failing... */
-# define IS_HUGS_CONSTR_INFO(info) IS_USER_PTR(info)
-#else
-# define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
-#endif
+/* not accurate by any means, but stops the assertions failing... */
+/* TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO TODO */
+#define IS_HUGS_CONSTR_INFO(info) IS_USER_PTR(info)
/* LOOKS_LIKE_GHC_INFO is called moderately often during GC, but
* Certainly not as often as HEAP_ALLOCED.
*/
-#ifdef TEXT_BEFORE_HEAP /* needed for mingw DietHEP */
-# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
-#else
-# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
- && !LOOKS_LIKE_STATIC_CLOSURE(info))
-#endif
-
+#define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
+ && !LOOKS_LIKE_STATIC_CLOSURE(info))
/* -----------------------------------------------------------------------------
Macros for calculating how big a closure will be (used during allocation)
-------------------------------------------------------------------------- */
-/* ToDo: replace unsigned int by nat. The only fly in the ointment is that
- * nat comes from Rts.h which many folk dont include. Sigh!
- */
-static __inline__ StgOffset AP_sizeW ( unsigned int n_args )
+static __inline__ StgOffset AP_sizeW ( nat n_args )
{ return sizeofW(StgAP_UPD) + n_args; }
-static __inline__ StgOffset PAP_sizeW ( unsigned int n_args )
+static __inline__ StgOffset PAP_sizeW ( nat n_args )
{ return sizeofW(StgPAP) + n_args; }
-static __inline__ StgOffset CONSTR_sizeW( unsigned int p, unsigned int np )
+static __inline__ StgOffset CONSTR_sizeW( nat p, nat np )
{ return sizeofW(StgHeader) + p + np; }
static __inline__ StgOffset THUNK_SELECTOR_sizeW ( void )
static __inline__ StgOffset BLACKHOLE_sizeW ( void )
{ return sizeofW(StgHeader) + MIN_UPD_SIZE; }
-static __inline__ StgOffset CAF_sizeW ( void )
-{ return sizeofW(StgCAF); }
-
/* --------------------------------------------------------------------------
* Sizes of closures
* ------------------------------------------------------------------------*/
static __inline__ StgWord tso_sizeW ( StgTSO *tso )
{ return TSO_STRUCT_SIZEW + tso->stack_size; }
-#endif STORAGE_H
+#endif /* STORAGE_H */