Have configure take arguments telling it where gmp is; fixes trac #957

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

diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 31af78f..097c727 100644 (file)
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -287,6 +287,7 @@ freeStorage (void)
 #if defined(THREADED_RTS)
     closeMutex(&sm_mutex);
     closeMutex(&atomic_modify_mutvar_mutex);
+    stgFree(nurseries);
 #endif
 }
 
@@ -578,7 +579,7 @@ allocate( nat n )
        nat req_blocks =  (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
        bd = allocGroup(req_blocks);
        dbl_link_onto(bd, &g0s0->large_objects);
-       g0s0->n_large_blocks += req_blocks;
+       g0s0->n_large_blocks += bd->blocks; // might be larger than req_blocks
        bd->gen_no  = 0;
        bd->step = g0s0;
        bd->flags = BF_LARGE;
@@ -662,7 +663,7 @@ allocateLocal (Capability *cap, nat n)
        ACQUIRE_SM_LOCK;
        bd = allocGroup(req_blocks);
        dbl_link_onto(bd, &g0s0->large_objects);
-       g0s0->n_large_blocks += req_blocks;
+       g0s0->n_large_blocks += bd->blocks; // might be larger than req_blocks
        bd->gen_no  = 0;
        bd->step = g0s0;
        bd->flags = BF_LARGE;
@@ -979,6 +980,11 @@ calcNeeded(void)
    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.
+
+   TODO: The inability to handle objects bigger than BLOCK_SIZE_W means that
+         the linker cannot use allocateExec for loading object code files
+         on Windows. Once allocateExec can handle larger objects, the linker
+         should be modified to use allocateExec instead of VirtualAlloc.
    ------------------------------------------------------------------------- */
 
 static bdescr *exec_block;
@@ -1040,20 +1046,17 @@ void freeExec (void *addr)
     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);
+    if (bd->gen_no == 0) {
+        // Free the block if it is empty, but not if it is the block at
+        // the head of the queue.
+        if (bd != exec_block) {
+            debugTrace(DEBUG_gc, "free exec block %p", bd->start);
+            dbl_link_remove(bd, &exec_block);
+            setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse);
+            freeGroup(bd);
+        } else {
+            bd->free = bd->start;
+        }
     }
 
     RELEASE_SM_LOCK
@@ -1181,7 +1184,7 @@ memInventory(void)
       debugBelch("  exec         : %4lu\n", exec_blocks);
       debugBelch("  free         : %4lu\n", free_blocks);
       debugBelch("  total        : %4lu\n\n", live_blocks + free_blocks);
-      debugBelch("  in system    : %4lu\n", mblocks_allocated + BLOCKS_PER_MBLOCK);
+      debugBelch("  in system    : %4lu\n", mblocks_allocated * BLOCKS_PER_MBLOCK);
       ASSERT(0);
   }
 }