[project @ 2005-04-05 12:19:54 by simonmar]

[ghc-hetmet.git] / ghc / rts / Storage.c

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 974c075..0e25b42 100644 (file)
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -17,17 +17,18 @@
 #include "Weak.h"
 #include "Sanity.h"
 #include "Arena.h"
-
+#include "OSThreads.h"
+#include "Capability.h"
 #include "Storage.h"
 #include "Schedule.h"
-#include "OSThreads.h"
-
 #include "RetainerProfile.h"   // for counting memory blocks (memInventory)
 
 #include <stdlib.h>
 #include <string.h>
 
 StgClosure    *caf_list         = NULL;
+StgClosure    *revertible_caf_list = NULL;
+rtsBool       keepCAFs;
 
 bdescr *small_alloc_list;      /* allocate()d small objects */
 bdescr *pinned_object_block;    /* allocate pinned objects into this block */
@@ -59,6 +60,18 @@ static void *stgAllocForGMP   (size_t size_in_bytes);
 static void *stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
 static void  stgDeallocForGMP (void *ptr, size_t size);
 
+/*
+ * 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
+
 void
 initStorage( void )
 {
@@ -197,6 +210,7 @@ initStorage( void )
 
   weak_ptr_list = NULL;
   caf_list = NULL;
+  revertible_caf_list = NULL;
    
   /* initialise the allocate() interface */
   small_alloc_list = NULL;
@@ -259,19 +273,37 @@ exitStorage (void)
 void
 newCAF(StgClosure* caf)
 {
-  /* Put this CAF on the mutable list for the old generation.
-   * This is a HACK - the IND_STATIC closure doesn't really have
-   * a mut_link field, but we pretend it has - in fact we re-use
-   * the STATIC_LINK field for the time being, because when we
-   * come to do a major GC we won't need the mut_link field
-   * any more and can use it as a STATIC_LINK.
-   */
   ACQUIRE_SM_LOCK;
 
-  ((StgIndStatic *)caf)->saved_info = NULL;
-
-  recordMutableGen(caf, oldest_gen);
-
+  if(keepCAFs)
+  {
+    // HACK:
+    // If we are in GHCi _and_ we are using dynamic libraries,
+    // then we can't redirect newCAF calls to newDynCAF (see below),
+    // so we make newCAF behave almost like newDynCAF.
+    // The dynamic libraries might be used by both the interpreted
+    // program and GHCi itself, so they must not be reverted.
+    // This also means that in GHCi with dynamic libraries, CAFs are not
+    // garbage collected. If this turns out to be a problem, we could
+    // do another hack here and do an address range test on caf to figure
+    // out whether it is from a dynamic library.
+    ((StgIndStatic *)caf)->saved_info  = (StgInfoTable *)caf->header.info;
+    ((StgIndStatic *)caf)->static_link = caf_list;
+    caf_list = caf;
+  }
+  else
+  {
+    /* Put this CAF on the mutable list for the old generation.
+    * This is a HACK - the IND_STATIC closure doesn't really have
+    * a mut_link field, but we pretend it has - in fact we re-use
+    * the STATIC_LINK field for the time being, because when we
+    * come to do a major GC we won't need the mut_link field
+    * any more and can use it as a STATIC_LINK.
+    */
+    ((StgIndStatic *)caf)->saved_info = NULL;
+    recordMutableGen(caf, oldest_gen);
+  }
+  
   RELEASE_SM_LOCK;
 
 #ifdef PAR
@@ -288,6 +320,8 @@ newCAF(StgClosure* caf)
 // object code in GHCi.  In this case we want to retain *all* CAFs in
 // the object code, because they might be demanded at any time from an
 // expression evaluated on the command line.
+// Also, GHCi might want to revert CAFs, so we add these to the
+// revertible_caf_list.
 //
 // The linker hackily arranges that references to newCaf from dynamic
 // code end up pointing to newDynCAF.
@@ -297,8 +331,8 @@ newDynCAF(StgClosure *caf)
     ACQUIRE_SM_LOCK;
 
     ((StgIndStatic *)caf)->saved_info  = (StgInfoTable *)caf->header.info;
-    ((StgIndStatic *)caf)->static_link = caf_list;
-    caf_list = caf;
+    ((StgIndStatic *)caf)->static_link = revertible_caf_list;
+    revertible_caf_list = caf;
 
     RELEASE_SM_LOCK;
 }
@@ -312,19 +346,12 @@ allocNurseries( void )
 { 
 #ifdef SMP
   Capability *cap;
-  bdescr *bd;
 
   g0s0->blocks = NULL;
   g0s0->n_blocks = 0;
   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
     cap->r.rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
     cap->r.rCurrentNursery = cap->r.rNursery;
-    /* Set the back links to be equal to the Capability,
-     * so we can do slightly better informed locking.
-     */
-    for (bd = cap->r.rNursery; bd != NULL; bd = bd->link) {
-      bd->u.back = (bdescr *)cap;
-    }
   }
 #else /* SMP */
   g0s0->blocks      = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
@@ -345,7 +372,7 @@ resetNurseries( void )
   Capability *cap;
   
   /* All tasks must be stopped */
-  ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes);
+  ASSERT(rts_n_free_capabilities == RtsFlags.ParFlags.nNodes);
 
   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
     for (bd = cap->r.rNursery; bd; bd = bd->link) {
@@ -672,7 +699,7 @@ calcAllocated( void )
   /*  ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes); */
 
   allocated = 
-    n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W
+    rts_n_free_capabilities * RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W
     + allocated_bytes();
 
   for (cap = free_capabilities; cap != NULL; cap = cap->link) {