[project @ 2002-12-02 14:33:10 by simonmar]
[ghc-hetmet.git] / ghc / rts / Storage.h
index 6bd9be2..6a7c738 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.h,v 1.32 2001/05/03 16:33:27 simonmar Exp $
+ * $Id: Storage.h,v 1.45 2002/10/21 11:38:54 simonmar 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
@@ -24,12 +28,24 @@ extern void exitStorage(void);
 /* -----------------------------------------------------------------------------
    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
@@ -43,12 +59,15 @@ extern void exitStorage(void);
    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
@@ -78,8 +97,7 @@ extern void PleaseStopAllocating(void);
    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);
+extern void GarbageCollect(void (*get_roots)(evac_fn),rtsBool force_major_gc);
 
 /* -----------------------------------------------------------------------------
    Generational garbage collection support
@@ -101,8 +119,13 @@ extern StgClosure *MarkRoot(StgClosure *p);
 /*
  * Storage manager mutex
  */
-#ifdef SMP
-extern pthread_mutex_t sm_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
@@ -120,9 +143,9 @@ recordMutable(StgMutClosure *p)
 #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;
   }
 }
 
@@ -132,34 +155,72 @@ recordOldToNewPtrs(StgMutClosure *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,
@@ -176,7 +237,7 @@ recordOldToNewPtrs(StgMutClosure *p)
                                                                        \
     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();                                              \
@@ -192,10 +253,10 @@ recordOldToNewPtrs(StgMutClosure *p)
              }                                                         \
           }                                                            \
         }                                                              \
-        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);                               \
@@ -211,10 +272,10 @@ recordOldToNewPtrs(StgMutClosure *p)
     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);                      \
@@ -228,20 +289,37 @@ updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *
   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();
   }
 }
@@ -251,6 +329,8 @@ updateWithPermIndirection(const StgInfoTable *info, StgClosure *p1, StgClosure *
    The CAF table - used to let us revert CAFs
    -------------------------------------------------------------------------- */
 
+void revertCAFs( void );
+
 #if defined(DEBUG)
 void printMutOnceList(generation *gen);
 void printMutableList(generation *gen);
@@ -277,7 +357,7 @@ void printMutableList(generation *gen);
             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.
@@ -327,41 +407,37 @@ void printMutableList(generation *gen);
          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.
  */
 
 
 #undef TEXT_BEFORE_HEAP
-#ifndef mingw32_TARGET_OS
+#if !defined(mingw32_TARGET_OS) && !defined(cygwin32_TARGET_OS)
 #define TEXT_BEFORE_HEAP 1
 #endif
 
 extern void* TEXT_SECTION_END_MARKER_DECL;
 extern void* DATA_SECTION_END_MARKER_DECL;
 
-/* Take into account code sections in dynamically loaded object files. */
-#define IS_CODE_PTR(p) (  ((P_)(p) < (P_)&TEXT_SECTION_END_MARKER) \
+#ifdef darwin_TARGET_OS
+extern unsigned long macho_etext;
+extern unsigned long macho_edata;
+#define IS_CODE_PTR(p) (  ((P_)(p) < (P_)macho_etext) \
                        || is_dynamically_loaded_code_or_rodata_ptr((char *)p) )
+#define IS_DATA_PTR(p) ( ((P_)(p) >= (P_)macho_etext && \
+                          (P_)(p) < (P_)macho_edata) \
+                       || is_dynamically_loaded_rwdata_ptr((char *)p) )
+#define IS_USER_PTR(p) ( ((P_)(p) >= (P_)macho_edata) \
+                       && is_not_dynamically_loaded_ptr((char *)p) )
+#else
+/* Take into account code sections in dynamically loaded object files. */
 #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) )
-
-/* The HEAP_ALLOCED test below is called FOR EVERY SINGLE CLOSURE
- * during GC.  It needs to be FAST.
- *
- * BEWARE: when we're dynamically loading code (for GHCi), make sure
- * that we don't load any code above HEAP_BASE, or this test won't work.
- */
-#ifdef TEXT_BEFORE_HEAP
-# define HEAP_ALLOCED(x)  ((StgPtr)(x) >= (StgPtr)(HEAP_BASE))
-#else
-extern int is_heap_alloced(const void* x);
-# define HEAP_ALLOCED(x)  (is_heap_alloced(x))
 #endif
 
-
 /* --------------------------------------------------------------------------
    Macros for distinguishing data pointers from code pointers
    --------------------------------------------------------------------------
@@ -395,8 +471,7 @@ extern int is_heap_alloced(const void* x);
   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),
@@ -462,9 +537,17 @@ extern int is_heap_alloced(const void* x);
                      (MAX_INTLIKE-MIN_INTLIKE) * sizeof(StgIntCharlikeClosure)) )
 
 #define LOOKS_LIKE_STATIC_CLOSURE(r) (((*(((unsigned long *)(r))-1)) == 0) || IS_CHARLIKE_CLOSURE(r) || IS_INTLIKE_CLOSURE(r))
+
+#elif defined(darwin_TARGET_OS) && !defined(TABLES_NEXT_TO_CODE)
+
+#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
+#define LOOKS_LIKE_STATIC_CLOSURE(r) (IS_DATA_PTR(r) && !LOOKS_LIKE_GHC_INFO(r))
+
 #else
+
 #define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
 #define LOOKS_LIKE_STATIC_CLOSURE(r) IS_DATA_PTR(r)
+
 #endif
 
 
@@ -484,28 +567,25 @@ extern int is_heap_alloced(const void* x);
 /* 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)
+#if defined(darwin_TARGET_OS) && !defined(TABLES_NEXT_TO_CODE)
+       /* Plan C, see above */
+#define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(((StgInfoTable *)info).entry)
 #else
-# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
-                                    && !LOOKS_LIKE_STATIC_CLOSURE(info))
+#define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
+                                   && !LOOKS_LIKE_STATIC_CLOSURE(info))
 #endif
 
-
 /* -----------------------------------------------------------------------------
    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 )