Massive patch for the first months work adding System FC to GHC #35

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

diff --git a/rts/Storage.c b/rts/Storage.c
index 974be45..0c9c60e 100644 (file)
--- a/rts/Storage.c
+++ b/rts/Storage.c
@@ -22,6 +22,8 @@
 #include "Storage.h"
 #include "Schedule.h"
 #include "RetainerProfile.h"   // for counting memory blocks (memInventory)
+#include "OSMem.h"
+#include "Trace.h"
 
 #include <stdlib.h>
 #include <string.h>
@@ -125,7 +127,7 @@ initStorage( void )
       RtsFlags.GcFlags.minAllocAreaSize > 
       RtsFlags.GcFlags.maxHeapSize) {
       errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
-      exit(1);
+      RtsFlags.GcFlags.minAllocAreaSize = RtsFlags.GcFlags.maxHeapSize;
   }
 
   initBlockAllocator();
@@ -271,7 +273,16 @@ exitStorage (void)
 void
 freeStorage (void)
 {
+    nat g;
+
+    for(g = 0; g < RtsFlags.GcFlags.generations; g++)
+      stgFree(generations[g].steps);
+    stgFree(generations);
     freeAllMBlocks();
+#if defined(THREADED_RTS)
+    closeMutex(&sm_mutex);
+    closeMutex(&atomic_modify_mutvar_mutex);
+#endif
 }
 
 /* -----------------------------------------------------------------------------
@@ -494,15 +505,15 @@ resizeNursery ( step *stp, nat blocks )
   if (nursery_blocks == blocks) return;
 
   if (nursery_blocks < blocks) {
-    IF_DEBUG(gc, debugBelch("Increasing size of nursery to %d blocks\n", 
-                        blocks));
+      debugTrace(DEBUG_gc, "increasing size of nursery to %d blocks", 
+                blocks);
     stp->blocks = allocNursery(stp, stp->blocks, blocks-nursery_blocks);
   } 
   else {
     bdescr *next_bd;
     
-    IF_DEBUG(gc, debugBelch("Decreasing size of nursery to %d blocks\n", 
-                        blocks));
+    debugTrace(DEBUG_gc, "decreasing size of nursery to %d blocks", 
+              blocks);
 
     bd = stp->blocks;
     while (nursery_blocks > blocks) {
@@ -968,6 +979,99 @@ calcNeeded(void)
     return needed;
 }
 
+/* ----------------------------------------------------------------------------
+   Executable memory
+
+   Executable memory must be managed separately from non-executable
+   memory.  Most OSs these days require you to jump through hoops to
+   dynamically allocate executable memory, due to various security
+   measures.
+
+   Here we provide a small memory allocator for executable memory.
+   Memory is managed with a page granularity; we allocate linearly
+   in the page, and when the page is emptied (all objects on the page
+   are free) we free the page again, not forgetting to make it
+   non-executable.
+   ------------------------------------------------------------------------- */
+
+static bdescr *exec_block;
+
+void *allocateExec (nat bytes)
+{
+    void *ret;
+    nat n;
+
+    ACQUIRE_SM_LOCK;
+
+    // round up to words.
+    n  = (bytes + sizeof(W_) + 1) / sizeof(W_);
+
+    if (n+1 > BLOCK_SIZE_W) {
+       barf("allocateExec: can't handle large objects");
+    }
+
+    if (exec_block == NULL || 
+       exec_block->free + n + 1 > exec_block->start + BLOCK_SIZE_W) {
+       bdescr *bd;
+       lnat pagesize = getPageSize();
+       bd = allocGroup(stg_max(1, pagesize / BLOCK_SIZE));
+       debugTrace(DEBUG_gc, "allocate exec block %p", bd->start);
+       bd->gen_no = 0;
+       bd->flags = BF_EXEC;
+       bd->link = exec_block;
+       if (exec_block != NULL) {
+           exec_block->u.back = bd;
+       }
+       bd->u.back = NULL;
+       setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsTrue);
+       exec_block = bd;
+    }
+    *(exec_block->free) = n;  // store the size of this chunk
+    exec_block->gen_no += n;  // gen_no stores the number of words allocated
+    ret = exec_block->free + 1;
+    exec_block->free += n + 1;
+
+    RELEASE_SM_LOCK
+    return ret;
+}
+
+void freeExec (void *addr)
+{
+    StgPtr p = (StgPtr)addr - 1;
+    bdescr *bd = Bdescr((StgPtr)p);
+
+    if ((bd->flags & BF_EXEC) == 0) {
+       barf("freeExec: not executable");
+    }
+
+    if (*(StgPtr)p == 0) {
+       barf("freeExec: already free?");
+    }
+
+    ACQUIRE_SM_LOCK;
+
+    bd->gen_no -= *(StgPtr)p;
+    *(StgPtr)p = 0;
+
+    // Free the block if it is empty, but not if it is the block at
+    // the head of the queue.
+    if (bd->gen_no == 0 && bd != exec_block) {
+       debugTrace(DEBUG_gc, "free exec block %p", bd->start);
+       if (bd->u.back) {
+           bd->u.back->link = bd->link;
+       } else {
+           exec_block = bd->link;
+       }
+       if (bd->link) {
+           bd->link->u.back = bd->u.back;
+       }
+       setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse);
+       freeGroup(bd);
+    }
+
+    RELEASE_SM_LOCK
+}    
+
 /* -----------------------------------------------------------------------------
    Debugging
 
@@ -1048,6 +1152,11 @@ memInventory(void)
   // count the blocks allocated by the arena allocator
   total_blocks += arenaBlocks();
 
+  // count the blocks containing executable memory
+  for (bd = exec_block; bd; bd = bd->link) {
+    total_blocks += bd->blocks;
+  }
+
   /* count the blocks on the free list */
   free_blocks = countFreeList();