Add ASSERTs to all calls of nameModule

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

diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 8d237c1..c9c9c1f 100644 (file)
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -35,6 +35,8 @@
 #include <stdlib.h>
 #include <string.h>
 
+#include "ffi.h"
+
 /* 
  * All these globals require sm_mutex to access in THREADED_RTS mode.
  */
@@ -46,6 +48,8 @@ bdescr *pinned_object_block;    /* allocate pinned objects into this block */
 nat alloc_blocks;              /* number of allocate()d blocks since GC */
 nat alloc_blocks_lim;          /* approximate limit on alloc_blocks */
 
+static bdescr *exec_block;
+
 generation *generations = NULL;        /* all the generations */
 generation *g0         = NULL; /* generation 0, for convenience */
 generation *oldest_gen  = NULL; /* oldest generation, for convenience */
@@ -261,6 +265,8 @@ initStorage( void )
   alloc_blocks = 0;
   alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
 
+  exec_block = NULL;
+
   /* Tell GNU multi-precision pkg about our custom alloc functions */
   mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
 
@@ -661,8 +667,8 @@ allocatedBytes( void )
     return allocated;
 }
 
-// split N blocks off the start of the given bdescr, returning the 
-// remainder as a new block group.  We treat the remainder as if it
+// split N blocks off the front of the given bdescr, returning the
+// new block group.  We treat the remainder as if it
 // had been freshly allocated in generation 0.
 bdescr *
 splitLargeBlock (bdescr *bd, nat blocks)
@@ -680,6 +686,7 @@ splitLargeBlock (bdescr *bd, nat blocks)
     new_bd->step    = g0s0;
     new_bd->flags   = BF_LARGE;
     new_bd->free    = bd->free;
+    ASSERT(new_bd->free <= new_bd->start + new_bd->blocks * BLOCK_SIZE_W);
 
     // add the new number of blocks to the counter.  Due to the gaps
     // for block descriptor, new_bd->blocks + bd->blocks might not be
@@ -687,7 +694,7 @@ splitLargeBlock (bdescr *bd, nat blocks)
     bd->step->n_large_blocks += bd->blocks;
 
     return new_bd;
-}    
+}
 
 /* -----------------------------------------------------------------------------
    allocateLocal()
@@ -1133,9 +1140,37 @@ calcNeeded(void)
          should be modified to use allocateExec instead of VirtualAlloc.
    ------------------------------------------------------------------------- */
 
-static bdescr *exec_block;
+#if defined(linux_HOST_OS)
+
+// On Linux we need to use libffi for allocating executable memory,
+// because it knows how to work around the restrictions put in place
+// by SELinux.
+
+void *allocateExec (nat bytes, void **exec_ret)
+{
+    void **ret, **exec;
+    ACQUIRE_SM_LOCK;
+    ret = ffi_closure_alloc (sizeof(void *) + (size_t)bytes, (void**)&exec);
+    RELEASE_SM_LOCK;
+    if (ret == NULL) return ret;
+    *ret = ret; // save the address of the writable mapping, for freeExec().
+    *exec_ret = exec + 1;
+    return (ret + 1);
+}
 
-void *allocateExec (nat bytes)
+// freeExec gets passed the executable address, not the writable address. 
+void freeExec (void *addr)
+{
+    void *writable;
+    writable = *((void**)addr - 1);
+    ACQUIRE_SM_LOCK;
+    ffi_closure_free (writable);
+    RELEASE_SM_LOCK
+}
+
+#else
+
+void *allocateExec (nat bytes, void **exec_ret)
 {
     void *ret;
     nat n;
@@ -1171,6 +1206,7 @@ void *allocateExec (nat bytes)
     exec_block->free += n + 1;
 
     RELEASE_SM_LOCK
+    *exec_ret = ret;
     return ret;
 }
 
@@ -1208,6 +1244,8 @@ void freeExec (void *addr)
     RELEASE_SM_LOCK
 }    
 
+#endif /* mingw32_HOST_OS */
+
 /* -----------------------------------------------------------------------------
    Debugging