merged master into late-dmdlate-dmd

41 files changed, 1529 insertions, 1665 deletions

diff --git a/rts/Adjustor.c b/rts/Adjustor.c
index fbf95df936..873f3acad1 100644
--- a/rts/Adjustor.c
+++ b/rts/Adjustor.c
@@ -131,8 +131,8 @@ createAdjustor (int cconv,
         barf("createAdjustor: failed to allocate memory");
     }
 
-    r = ffi_prep_closure(cl, cif, (void*)wptr, hptr/*userdata*/);
-    if (r != FFI_OK) barf("ffi_prep_closure failed: %d", r);
+    r = ffi_prep_closure_loc(cl, cif, (void*)wptr, hptr/*userdata*/, code);
+    if (r != FFI_OK) barf("ffi_prep_closure_loc failed: %d", r);
 
     return (void*)code;
 }
@@ -335,7 +335,7 @@ createAdjustor(int cconv, StgStablePtr hptr,
               )
 {
   void *adjustor = NULL;
-  void *code;
+  void *code = NULL;
 
   switch (cconv)
   {
@@ -491,22 +491,15 @@ createAdjustor(int cconv, StgStablePtr hptr,
 
     */
     {  
-        int i = 0;
-        int fourthFloating;
-        char *c;
         StgWord8 *adj_code;
 
         // determine whether we have 4 or more integer arguments,
         // and therefore need to flush one to the stack.
-        for (c = typeString; *c != '\0'; c++) {
-            i++;
-            if (i == 4) {
-                fourthFloating = (*c == 'f' || *c == 'd');
-                break;
-            }
-        }
+        if ((typeString[0] == '\0') ||
+            (typeString[1] == '\0') ||
+            (typeString[2] == '\0') ||
+            (typeString[3] == '\0')) {
 
-        if (i < 4) {
             adjustor = allocateExec(0x38,&code);
             adj_code = (StgWord8*)adjustor;
 
@@ -525,6 +518,9 @@ createAdjustor(int cconv, StgStablePtr hptr,
         }
         else
         {
+            int fourthFloating;
+
+            fourthFloating = (typeString[3] == 'f' || typeString[3] == 'd');
             adjustor = allocateExec(0x58,&code);
             adj_code = (StgWord8*)adjustor;
             *(StgInt32 *)adj_code        = 0x08ec8348;
diff --git a/rts/CheckUnload.c b/rts/CheckUnload.c
new file mode 100644
index 0000000000..a758b06db3
--- /dev/null
+++ b/rts/CheckUnload.c
@@ -0,0 +1,303 @@
+/* ----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2013-
+ *
+ * Check whether dynamically-loaded object code can be safely
+ * unloaded, by searching for references to it from the heap and RTS
+ * data structures.
+ *
+ * --------------------------------------------------------------------------*/
+
+#include "PosixSource.h"
+#include "Rts.h"
+
+#include "RtsUtils.h"
+#include "Hash.h"
+#include "LinkerInternals.h"
+#include "CheckUnload.h"
+#include "sm/Storage.h"
+#include "sm/GCThread.h"
+
+//
+// Code that we unload may be referenced from:
+//   - info pointers in heap objects and stack frames
+//   - pointers to static objects from the heap
+//   - StablePtrs to static objects
+//
+// We can find live static objects after a major GC, so we don't have
+// to look at every closure pointer in the heap.  However, we do have
+// to look at every info pointer.  So this is like a heap census
+// traversal: we look at the header of every object, but not its
+// contents.
+//
+// On the assumption that there aren't many different info pointers in
+// a typical heap, we insert addresses into a hash table.  The
+// first time we see an address, we check it against the pending
+// unloadable objects and if it lies within any of them, we mark that
+// object as referenced so that it won't get unloaded in this round.
+//
+
+static void checkAddress (HashTable *addrs, void *addr)
+{
+    ObjectCode *oc;
+
+    if (!lookupHashTable(addrs, (W_)addr)) {
+        insertHashTable(addrs, (W_)addr, addr);
+
+        for (oc = unloaded_objects; oc; oc = oc->next) {
+            if ((W_)addr >= (W_)oc->image &&
+                (W_)addr <  (W_)oc->image + oc->fileSize) {
+                oc->referenced = 1;
+                break;
+            }
+        }
+    }
+}
+
+static void searchStackChunk (HashTable *addrs, StgPtr sp, StgPtr stack_end)
+{
+    StgPtr p;
+    const StgRetInfoTable *info;
+
+    p = sp;
+    while (p < stack_end) {
+        info = get_ret_itbl((StgClosure *)p);
+
+        switch (info->i.type) {
+        case RET_SMALL:
+        case RET_BIG:
+            checkAddress(addrs, (void*)info);
+            break;
+
+        default:
+            break;
+        }
+
+        p += stack_frame_sizeW((StgClosure*)p);
+    }
+}
+
+
+static void searchHeapBlocks (HashTable *addrs, bdescr *bd)
+{
+    StgPtr p;
+    StgInfoTable *info;
+    nat size;
+    rtsBool prim;
+
+    for (; bd != NULL; bd = bd->link) {
+
+        if (bd->flags & BF_PINNED) {
+            // Assume that objects in PINNED blocks cannot refer to
+            continue;
+        }
+
+	p = bd->start;
+	while (p < bd->free) {
+	    info = get_itbl((StgClosure *)p);
+            prim = rtsFalse;
+
+	    switch (info->type) {
+
+	    case THUNK:
+                size = thunk_sizeW_fromITBL(info);
+		break;
+
+	    case THUNK_1_1:
+	    case THUNK_0_2:
+	    case THUNK_2_0:
+		size = sizeofW(StgThunkHeader) + 2;
+		break;
+
+	    case THUNK_1_0:
+	    case THUNK_0_1:
+	    case THUNK_SELECTOR:
+		size = sizeofW(StgThunkHeader) + 1;
+		break;
+
+	    case CONSTR:
+	    case FUN:
+            case FUN_1_0:
+	    case FUN_0_1:
+	    case FUN_1_1:
+	    case FUN_0_2:
+	    case FUN_2_0:
+	    case CONSTR_1_0:
+	    case CONSTR_0_1:
+	    case CONSTR_1_1:
+	    case CONSTR_0_2:
+	    case CONSTR_2_0:
+		size = sizeW_fromITBL(info);
+		break;
+
+	    case IND_PERM:
+	    case BLACKHOLE:
+	    case BLOCKING_QUEUE:
+                prim = rtsTrue;
+                size = sizeW_fromITBL(info);
+		break;
+
+            case IND:
+		// Special case/Delicate Hack: INDs don't normally
+		// appear, since we're doing this heap census right
+		// after GC.  However, GarbageCollect() also does
+		// resurrectThreads(), which can update some
+		// blackholes when it calls raiseAsync() on the
+		// resurrected threads.  So we know that any IND will
+		// be the size of a BLACKHOLE.
+                prim = rtsTrue;
+                size = BLACKHOLE_sizeW();
+		break;
+
+	    case BCO:
+                prim = rtsTrue;
+		size = bco_sizeW((StgBCO *)p);
+		break;
+
+            case MVAR_CLEAN:
+            case MVAR_DIRTY:
+            case TVAR:
+            case WEAK:
+	    case PRIM:
+	    case MUT_PRIM:
+	    case MUT_VAR_CLEAN:
+	    case MUT_VAR_DIRTY:
+		prim = rtsTrue;
+		size = sizeW_fromITBL(info);
+		break;
+
+	    case AP:
+                prim = rtsTrue;
+                size = ap_sizeW((StgAP *)p);
+		break;
+
+	    case PAP:
+                prim = rtsTrue;
+                size = pap_sizeW((StgPAP *)p);
+		break;
+
+	    case AP_STACK:
+            {
+                StgAP_STACK *ap = (StgAP_STACK *)p;
+                prim = rtsTrue;
+                size = ap_stack_sizeW(ap);
+                searchStackChunk(addrs, (StgPtr)ap->payload,
+                                 (StgPtr)ap->payload + ap->size);
+                break;
+            }
+
+	    case ARR_WORDS:
+		prim = rtsTrue;
+		size = arr_words_sizeW((StgArrWords*)p);
+		break;
+		
+	    case MUT_ARR_PTRS_CLEAN:
+	    case MUT_ARR_PTRS_DIRTY:
+	    case MUT_ARR_PTRS_FROZEN:
+	    case MUT_ARR_PTRS_FROZEN0:
+		prim = rtsTrue;
+		size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
+		break;
+		
+	    case TSO:
+		prim = rtsTrue;
+                size = sizeofW(StgTSO);
+		break;
+
+            case STACK: {
+                StgStack *stack = (StgStack*)p;
+                prim = rtsTrue;
+                searchStackChunk(addrs, stack->sp,
+                                 stack->stack + stack->stack_size);
+                size = stack_sizeW(stack);
+		break;
+            }
+
+            case TREC_CHUNK:
+		prim = rtsTrue;
+		size = sizeofW(StgTRecChunk);
+		break;
+
+	    default:
+		barf("heapCensus, unknown object: %d", info->type);
+	    }
+	    
+            if (!prim) {
+                checkAddress(addrs,info);
+            }
+
+	    p += size;
+	}
+    }
+}
+
+//
+// Check whether we can unload any object code.  This is called at the
+// appropriate point during a GC, where all the heap data is nice and
+// packed together and we have a linked list of the static objects.
+//
+// The check involves a complete heap traversal, but you only pay for
+// this (a) when you have called unloadObj(), and (b) at a major GC,
+// which is much more expensive than the traversal we're doing here.
+//
+void checkUnload (StgClosure *static_objects)
+{
+  nat g, n;
+  HashTable *addrs;
+  StgClosure* p;
+  const StgInfoTable *info;
+  ObjectCode *oc, *prev;
+  gen_workspace *ws;
+  StgClosure* link;
+
+  if (unloaded_objects == NULL) return;
+
+  // Mark every unloadable object as unreferenced initially
+  for (oc = unloaded_objects; oc; oc = oc->next) {
+      IF_DEBUG(linker, debugBelch("Checking whether to unload %s\n",
+                                  oc->fileName));
+      oc->referenced = rtsFalse;
+  }
+
+  addrs = allocHashTable();
+
+  for (p = static_objects; p != END_OF_STATIC_LIST; p = link) {
+      checkAddress(addrs, p);
+      info = get_itbl(p);
+      link = *STATIC_LINK(info, p);
+  }
+
+  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+      searchHeapBlocks (addrs, generations[g].blocks);
+      searchHeapBlocks (addrs, generations[g].large_objects);
+
+      for (n = 0; n < n_capabilities; n++) {
+          ws = &gc_threads[n]->gens[g];
+          searchHeapBlocks(addrs, ws->todo_bd);
+          searchHeapBlocks(addrs, ws->part_list);
+          searchHeapBlocks(addrs, ws->scavd_list);
+      }
+  }
+
+  // Look through the unloadable objects, and any object that is still
+  // marked as unreferenced can be physically unloaded, because we
+  // have no references to it.
+  prev = NULL;
+  for (oc = unloaded_objects; oc; prev = oc, oc = oc->next) {
+      if (oc->referenced == 0) {
+          if (prev == NULL) {
+              unloaded_objects = oc->next;
+          } else {
+              prev->next = oc->next;
+          }
+          IF_DEBUG(linker, debugBelch("Unloading object file %s\n",
+                                      oc->fileName));
+          freeObjectCode(oc);
+      } else {
+          IF_DEBUG(linker, debugBelch("Object file still in use: %s\n",
+                                      oc->fileName));
+      }
+  }
+
+  freeHashTable(addrs, NULL);
+}
diff --git a/rts/CheckUnload.h b/rts/CheckUnload.h
new file mode 100644
index 0000000000..7d2e5b1321
--- /dev/null
+++ b/rts/CheckUnload.h
@@ -0,0 +1,20 @@
+/* ----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2013-
+ *
+ * Check whether dynamically-loaded object code can be safely
+ * unloaded, by searching for references to it from the heap and RTS
+ * data structures.
+ *
+ * --------------------------------------------------------------------------*/
+
+#ifndef CHECKUNLOAD_H
+#define CHECKUNLOAD_H
+
+#include "BeginPrivate.h"
+
+void checkUnload (StgClosure *static_objects);
+
+#include "EndPrivate.h"
+
+#endif // CHECKUNLOAD_H
diff --git a/rts/FrontPanel.c b/rts/FrontPanel.c
deleted file mode 100644
index b0b9bced4a..0000000000
--- a/rts/FrontPanel.c
+++ /dev/null
@@ -1,796 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2000
- *
- * RTS GTK Front Panel
- *
- * ---------------------------------------------------------------------------*/
-
-#ifdef RTS_GTK_FRONTPANEL
-
-/* Alas, not Posix. */
-/* #include "PosixSource.h" */
-
-#include "Rts.h"
-
-#include "RtsUtils.h"
-#include "FrontPanel.h"
-#include "Stats.h"
-#include "Schedule.h"
-
-#include <gtk/gtk.h>
-#include <unistd.h>
-#include <string.h>
-
-#include "VisSupport.h"
-#include "VisWindow.h"
-
-static GtkWidget *window, *map_drawing_area, *gen_drawing_area;
-static GtkWidget *res_drawing_area;
-static GtkWidget *continue_but, *stop_but, *quit_but;
-static GtkWidget *statusbar;
-static GtkWidget *live_label, *allocated_label;
-static GtkWidget *footprint_label, *alloc_rate_label;
-static GtkWidget *map_ruler, *gen_ruler;
-static GtkWidget *res_vruler, *res_hruler;
-static GtkWidget *running_label, *b_read_label, *b_write_label, *total_label;
-static GtkWidget *b_mvar_label, *b_bh_label, *b_throwto_label, *sleeping_label;
-
-static guint status_context_id;
-
-gboolean continue_now = FALSE, stop_now = FALSE, quit = FALSE;
-UpdateMode update_mode = Continuous;
-
-static GdkPixmap *map_pixmap = NULL;
-static GdkPixmap *gen_pixmap = NULL;
-static GdkPixmap *res_pixmap = NULL;
-
-#define N_GENS 10
-
-static GdkColor 
-    bdescr_color = { 0, 0xffff, 0, 0 },	/* red */
-    free_color   = { 0, 0, 0, 0xffff },	/* blue */
-    gen_colors[N_GENS] = {
-	{ 0, 0, 0xffff, 0 },
-	{ 0, 0, 0xf000, 0 },
-	{ 0, 0, 0xe000, 0 },
-	{ 0, 0, 0xd000, 0 },
-	{ 0, 0, 0xc000, 0 },
-	{ 0, 0, 0xb000, 0 },
-	{ 0, 0, 0xa000, 0 },
-	{ 0, 0, 0x9000, 0 },
-	{ 0, 0, 0x8000, 0 },
-	{ 0, 0, 0x7000, 0 }
-    };
-
-GdkGC *my_gc = NULL;
-
-static void *mem_start = (void *) 0x50000000;
-
-static void colorBlock( void *addr, GdkColor *color, 
-			nat block_width, nat block_height, 
-			nat blocks_per_line );
-
-static void residencyCensus( void );
-static void updateResidencyGraph( void );
-static void updateThreadsPanel( void );
-
-/* Some code pinched from examples/scribble-simple in the GTK+
- * distribution.
- */
-
-/* Create a new backing pixmap of the appropriate size */
-static gint 
-configure_event( GtkWidget *widget, GdkEventConfigure *event STG_UNUSED,
-		 GdkPixmap **pixmap )
-{
-  if (*pixmap)
-    gdk_pixmap_unref(*pixmap);
-
-  *pixmap = gdk_pixmap_new(widget->window,
-			   widget->allocation.width,
-			   widget->allocation.height,
-			   -1);
-
-  gdk_draw_rectangle (*pixmap,
-		      widget->style->white_gc,
-		      TRUE,
-		      0, 0,
-		      widget->allocation.width,
-		      widget->allocation.height);
-
-  debugBelch("configure!\n");
-  updateFrontPanel();
-  return TRUE;
-}
-
-/* Redraw the screen from the backing pixmap */
-static gint 
-expose_event( GtkWidget *widget, GdkEventExpose *event, GdkPixmap **pixmap )
-{
-  gdk_draw_pixmap(widget->window,
-		  widget->style->fg_gc[GTK_WIDGET_STATE (widget)],
-		  *pixmap,
-		  event->area.x, event->area.y,
-		  event->area.x, event->area.y,
-		  event->area.width, event->area.height);
-
-  return FALSE;
-}
-
-void
-initFrontPanel( void )
-{
-    GdkColormap *colormap;
-    GtkWidget *gen_hbox;
-
-    gtk_init( &prog_argc, &prog_argv );
-
-    window = create_GHC_Front_Panel();
-    map_drawing_area  = lookup_widget(window, "memmap");
-    gen_drawing_area  = lookup_widget(window, "generations");
-    res_drawing_area  = lookup_widget(window, "res_drawingarea");
-    stop_but          = lookup_widget(window, "stop_but");
-    continue_but      = lookup_widget(window, "continue_but");
-    quit_but          = lookup_widget(window, "quit_but");
-    statusbar         = lookup_widget(window, "statusbar");
-    live_label        = lookup_widget(window, "live_label");
-    footprint_label   = lookup_widget(window, "footprint_label");
-    allocated_label   = lookup_widget(window, "allocated_label");
-    alloc_rate_label  = lookup_widget(window, "alloc_rate_label");
-    gen_hbox          = lookup_widget(window, "gen_hbox");
-    gen_ruler         = lookup_widget(window, "gen_ruler");
-    map_ruler         = lookup_widget(window, "map_ruler");
-    res_vruler        = lookup_widget(window, "res_vruler");
-    res_hruler        = lookup_widget(window, "res_hruler");
-    running_label     = lookup_widget(window, "running_label");
-    b_read_label      = lookup_widget(window, "blockread_label");
-    b_write_label     = lookup_widget(window, "blockwrite_label");
-    b_mvar_label      = lookup_widget(window, "blockmvar_label");
-    b_bh_label        = lookup_widget(window, "blockbh_label");
-    b_throwto_label   = lookup_widget(window, "blockthrowto_label");
-    sleeping_label    = lookup_widget(window, "sleeping_label");
-    total_label       = lookup_widget(window, "total_label");
-    
-    status_context_id = 
-	gtk_statusbar_get_context_id( GTK_STATUSBAR(statusbar), "context" );
-
-    /* hook up some signals for the mem map drawing area */
-    gtk_signal_connect (GTK_OBJECT(map_drawing_area), "expose_event",
-			(GtkSignalFunc)expose_event, &map_pixmap);
-    gtk_signal_connect (GTK_OBJECT(map_drawing_area), "configure_event",
-			(GtkSignalFunc)configure_event, &map_pixmap);
-
-    gtk_widget_set_events(map_drawing_area, GDK_EXPOSURE_MASK);
-
-    /* hook up some signals for the gen drawing area */
-    gtk_signal_connect (GTK_OBJECT(gen_drawing_area), "expose_event",
-			(GtkSignalFunc)expose_event, &gen_pixmap);
-    gtk_signal_connect (GTK_OBJECT(gen_drawing_area), "configure_event",
-			(GtkSignalFunc)configure_event, &gen_pixmap);
-
-    gtk_widget_set_events(gen_drawing_area, GDK_EXPOSURE_MASK);
-    
-    /* hook up some signals for the res drawing area */
-    gtk_signal_connect (GTK_OBJECT(res_drawing_area), "expose_event",
-			(GtkSignalFunc)expose_event, &res_pixmap);
-    gtk_signal_connect (GTK_OBJECT(res_drawing_area), "configure_event",
-			(GtkSignalFunc)configure_event, &res_pixmap);
-
-    gtk_widget_set_events(res_drawing_area, GDK_EXPOSURE_MASK);
-    
-    /* allocate our colors */
-    colormap = gdk_colormap_get_system();
-    gdk_colormap_alloc_color(colormap, &bdescr_color, TRUE, TRUE);
-    gdk_colormap_alloc_color(colormap, &free_color, TRUE, TRUE);
-
-    {
-	gboolean success[N_GENS];
-	gdk_colormap_alloc_colors(colormap, gen_colors, N_GENS, TRUE,
-				  TRUE, success);
-	if (!success) { barf("can't allocate colors"); }
-    }
-
-    /* set the labels on the generation histogram */
-    {
-	char buf[64];
-	nat g, s;
-	GtkWidget *label;
-
-	for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	    for(s = 0; s < generations[g].n_steps; s++) {
-		g_snprintf( buf, 64, "%d.%d", g, s );
-		label = gtk_label_new( buf );
-		gtk_box_pack_start( GTK_BOX(gen_hbox), label,
-				    TRUE, TRUE, 5 );
-		gtk_widget_show(label);
-	    }
-	}
-    }
-
-    gtk_widget_show(window);
-
-    /* wait for the user to press "Continue" before getting going... */
-    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
-			"Program start");
-    gtk_widget_set_sensitive( stop_but, FALSE );
-    continue_now = FALSE;
-    while (continue_now == FALSE) {
-	gtk_main_iteration();
-    }
-    gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
-    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
-			"Running");
-
-    gtk_widget_set_sensitive( continue_but, FALSE );
-    gtk_widget_set_sensitive( stop_but, TRUE );
-    gtk_widget_set_sensitive( quit_but, FALSE );
-
-    while (gtk_events_pending()) {
-	gtk_main_iteration();
-    }
-}
-
-void
-stopFrontPanel( void )
-{
-    gtk_widget_set_sensitive( quit_but, TRUE );
-    gtk_widget_set_sensitive( continue_but, FALSE );
-    gtk_widget_set_sensitive( stop_but, FALSE );
-
-    updateFrontPanel();
-
-    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
-			"Program finished");
-
-    quit = FALSE;
-    while (quit == FALSE) {
-	gtk_main_iteration();
-    }
-}
-
-static void
-waitForContinue( void )
-{
-    gtk_widget_set_sensitive( continue_but, TRUE );
-    gtk_widget_set_sensitive( stop_but, FALSE );
-    stop_now = FALSE;
-    continue_now = FALSE;
-    while (continue_now == FALSE) {
-	gtk_main_iteration();
-    }
-    gtk_widget_set_sensitive( continue_but, FALSE );
-    gtk_widget_set_sensitive( stop_but, TRUE );
-}
-
-void
-updateFrontPanelBeforeGC( nat N )
-{
-    char buf[1000];
-
-    updateFrontPanel();
-
-    if (update_mode == BeforeGC 
-	|| update_mode == BeforeAfterGC
-	|| stop_now == TRUE) {
-	g_snprintf( buf, 1000, "Stopped (before GC, generation %d)", N );
-	gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf );
-	waitForContinue();
-	gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
-    }
-
-    g_snprintf( buf, 1000, "Garbage collecting (generation %d)", N );
-    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf);
-
-    while (gtk_events_pending()) {
-	gtk_main_iteration();
-    }
-}
-
-static void
-numLabel( GtkWidget *lbl, nat n )
-{
-    char buf[64];
-    g_snprintf(buf, 64, "%d", n);
-    gtk_label_set_text( GTK_LABEL(lbl), buf );
-}
-
-void
-updateFrontPanelAfterGC( nat N, W_ live )
-{
-    char buf[1000];
-
-    gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
-
-    /* is a major GC? */
-    if (N == RtsFlags.GcFlags.generations-1) {
-	residencyCensus();
-    }
-
-    updateFrontPanel();
-
-    if (update_mode == AfterGC 
-	|| update_mode == BeforeAfterGC
-	|| stop_now == TRUE) {
-	snprintf( buf, 1000, "Stopped (after GC, generation %d)", N );
-	gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf );
-	waitForContinue();
-	gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
-    }
-
-    {
-	double words_to_megs = (1024 * 1024) / sizeof(W_);
-	double time = mut_user_time();
-
-	snprintf( buf, 1000, "%.2f", (double)live / words_to_megs );
-	gtk_label_set_text( GTK_LABEL(live_label), buf );
-
-	snprintf( buf, 1000, "%.2f", (double)total_allocated / words_to_megs );
-	gtk_label_set_text( GTK_LABEL(allocated_label), buf );
-
-	snprintf( buf, 1000, "%.2f",
-		  (double)(mblocks_allocated * MBLOCK_SIZE_W) / words_to_megs );
-	gtk_label_set_text( GTK_LABEL(footprint_label), buf );
-
-	if ( time == 0.0 )
-	    snprintf( buf, 1000, "%.2f", time );
-	else
-	    snprintf( buf, 1000, "%.2f",
-		      (double)(total_allocated / words_to_megs) / time );
-	gtk_label_set_text( GTK_LABEL(alloc_rate_label), buf );
-    }
-
-    while (gtk_events_pending()) {
-	gtk_main_iteration();
-    }
-}
-
-void
-updateFrontPanel( void )
-{
-    void *m, *a;
-    bdescr *bd;
-
-    updateThreadsPanel();
-
-    if (my_gc == NULL) {
-	my_gc = gdk_gc_new( window->window );
-    }
-
-    if (map_pixmap != NULL) {
-	nat height, width, blocks_per_line, 
-	    block_height, block_width, mblock_height;
-
-	height = map_drawing_area->allocation.height;
-	width  = map_drawing_area->allocation.width;
-
-	mblock_height =  height / mblocks_allocated;
-	blocks_per_line = 16;
-	block_height  = mblock_height / 
-	    ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
-	while (block_height == 0) {
-	    blocks_per_line *= 2;
-	    block_height  = mblock_height / 
-		((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
-	}
-	block_width = width / blocks_per_line;
-
-	gdk_draw_rectangle (map_pixmap,
-			    map_drawing_area->style->bg_gc[GTK_STATE_NORMAL],
-			    TRUE,
-			    0, 0,
-			    map_drawing_area->allocation.width,
-			    map_drawing_area->allocation.height);
-	
-	for ( m = mem_start; 
-	      (char *)m < (char *)mem_start + 
-		  (mblocks_allocated * MBLOCK_SIZE); 
-	      (char *)m += MBLOCK_SIZE ) {
-	    
-	    /* color the bdescr area first */
-	    for (a = m; a < FIRST_BLOCK(m); (char *)a += BLOCK_SIZE) {
-		colorBlock( a, &bdescr_color, 
-			    block_width, block_height, blocks_per_line );
-	    }
-	    
-#if 0 /* Segfaults because bd appears to be bogus but != NULL. stolz, 2003-06-24 */
-	    /* color each block */
-	    for (; a <= LAST_BLOCK(m); (char *)a += BLOCK_SIZE) {
-		bd = Bdescr((P_)a);
-		ASSERT(bd->start == a);
-                if (bd->flags & BF_FREE) {
-		    colorBlock( a, &free_color, 
-				block_width, block_height, blocks_per_line );
-		} else {
-		    colorBlock( a, &gen_colors[bd->gen_no],
-				block_width, block_height, blocks_per_line );
-		}
-	    }
-#endif
-	}
-
-	
-	{ 
-	    nat height = map_drawing_area->allocation.height,
-		block_height, mblock_height;
-
-	    block_height = (height / mblocks_allocated) / 
-		((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
-	    if (block_height < 1) block_height = 1;
-	    mblock_height = block_height * 
-		((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
-
-	    gtk_ruler_set_range( GTK_RULER(map_ruler), 0, 
-				 (double)(height * mblocks_allocated) / 
-				 (double)((mblock_height * mblocks_allocated)),
-				 0,
-				 (double)(height * mblocks_allocated) / 
-				 (double)((mblock_height * mblocks_allocated))
-		);
-	}
-				  
-	gtk_widget_draw( map_drawing_area, NULL );
-    }
-
-    if (gen_pixmap != NULL) {
-
-	GdkRectangle rect;
-	nat g, s, columns, column, max_blocks, height_blocks,
-	    width, height;
-	
-	gdk_draw_rectangle (gen_pixmap,
-			    gen_drawing_area->style->white_gc,
-			    TRUE,
-			    0, 0,
-			    gen_drawing_area->allocation.width,
-			    gen_drawing_area->allocation.height);
-
-	height = gen_drawing_area->allocation.height;
-	width  = gen_drawing_area->allocation.width;
-
-	columns = 0; max_blocks = 0;
-	for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	    columns += generations[g].n_steps;
-	    for(s = 0; s < generations[g].n_steps; s++) {
-		if (generations[g].steps[s].n_blocks > max_blocks) {
-		    max_blocks = generations[g].steps[s].n_blocks;
-		}
-	    }
-	}
-
-	/* find a reasonable height value larger than max_blocks */
-	{ 
-	    nat n = 0;
-	    while (max_blocks != 0) {
-		max_blocks >>= 1; n++;
-	    }
-	    height_blocks = 1 << n;
-	}
-
-	column = 0;
-	for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	    for(s = 0; s < generations[g].n_steps; s++, column++) {
-		gdk_gc_set_foreground(my_gc, &gen_colors[g]);
-
-		rect.x = column * (width / columns);
-
-		if (generations[g].steps[s].n_blocks == 0)
-		    rect.y = height;
-		else
-		    rect.y = height - 
-			(height * generations[g].steps[s].n_blocks
-			 / height_blocks);
-
-		rect.width = (width / columns);
-		rect.height = height - rect.y;
-
-		gdk_draw_rectangle( gen_pixmap, my_gc, TRUE/*filled*/, 
-				    rect.x, rect.y, rect.width,
-				    rect.height );
-	    }
-	}
-
-	gtk_ruler_set_range( GTK_RULER(gen_ruler), 
-			     height_blocks * BLOCK_SIZE / (1024 * 1024),
-			     0, 0,
-			     height_blocks * BLOCK_SIZE / (1024 * 1024)
-	    );
-
-	gtk_widget_draw( gen_drawing_area, NULL );
-    }
-
-    if (res_pixmap != NULL) {
-	updateResidencyGraph();
-    }
-
-    while (gtk_events_pending()) {
-	gtk_main_iteration_do(FALSE/*don't block*/);
-    }
-}
-
-static void
-colorBlock( void *addr, GdkColor *color, 
-	    nat block_width, nat block_height, nat blocks_per_line )
-{
-    GdkRectangle rect;
-    nat block_no;
-
-    gdk_gc_set_foreground(my_gc, color);
-
-    block_no = ((char *)addr - (char *)mem_start) / BLOCK_SIZE;
-
-    rect.x = (block_no % blocks_per_line) * block_width;
-    rect.y = block_no / blocks_per_line * block_height;
-    rect.width = block_width;
-    rect.height = block_height;
-    gdk_draw_rectangle( map_pixmap, my_gc, TRUE/*filled*/, 
-			rect.x, rect.y, rect.width, rect.height );
-}
-
-static void
-updateThreadsPanel( void )
-{
-    nat running = 0,
-	b_read = 0,
-	b_write = 0,
-	b_mvar = 0,
-	b_throwto = 0,
-	b_bh = 0,
-	sleeping = 0,
-	total = 0;
-
-    StgTSO *t;
-
-    for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
-	switch (t->what_next) {
-	case ThreadKilled:	    break;
-	case ThreadComplete:	    break;
-	default:
-	    switch (t->why_blocked) {
-	    case BlockedOnRead:       b_read++;    break;
-	    case BlockedOnWrite:      b_write++;   break;
-	    case BlockedOnDelay:      sleeping++;  break;
-	    case BlockedOnMVar:       b_mvar++;    break;
-	    case BlockedOnException:  b_throwto++; break;
-	    case BlockedOnBlackHole:  b_bh++;      break;
-	    case NotBlocked:          running++;   break;
-	    }
-	}
-    }
-    total = running + b_read + b_write + b_mvar + b_throwto + b_bh + sleeping;
-    numLabel(running_label,   running);
-    numLabel(b_read_label,    b_read);
-    numLabel(b_write_label,   b_write);
-    numLabel(b_mvar_label,    b_mvar);
-    numLabel(b_bh_label,      b_bh);
-    numLabel(b_throwto_label, b_throwto);
-    numLabel(sleeping_label,  sleeping);
-    numLabel(total_label,     total);
-}
-
-typedef enum { Thunk, Fun, Constr, BlackHole,
-	       Array, Thread, Other, N_Cats } ClosureCategory;
-
-#define N_SLICES 100
-
-static nat *res_prof[N_SLICES];
-static double res_time[N_SLICES];
-static nat next_slice = 0;
-
-static void
-residencyCensus( void )
-{
-    nat slice = next_slice++, *prof;
-    bdescr *bd;
-    nat g, s, size, type;
-    StgPtr p;
-    StgInfoTable *info;
-
-    if (slice >= N_SLICES) {
-	barf("too many slices");
-    }
-    res_prof[slice] = stgMallocBytes(N_Cats * sizeof(nat), "residencyCensus");
-    prof = res_prof[slice];
-    memset(prof, 0, N_Cats * sizeof(nat));
-
-    res_time[slice] = mut_user_time();
-    
-    for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	for(s = 0; s < generations[g].n_steps; s++) {
-
-	    /* skip over g0s0 if multi-generational */
-	    if (RtsFlags.GcFlags.generations > 1 &&
-		g == 0 && s == 0) continue;
-
-	    if (RtsFlags.GcFlags.generations == 1) {
-/*		bd = generations[g].steps[s].to_blocks; FIXME to_blocks does not exist */
-	    } else {
-		bd = generations[g].steps[s].blocks;
-	    }
-
-	    for (; bd != NULL; bd = bd->link) {
-
-		p = bd->start;
-
-		while (p < bd->free) {
-		    info = get_itbl((StgClosure *)p);
-		    type = Other;
-		    
-		    switch (info->type) {
-
-		    case CONSTR:
-		    case BCO:
-			if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info) {
-			    size = sizeofW(StgWeak);
-			    type = Other;
-			    break;
-			}
-			/* else, fall through... */
-		    case CONSTR_1_0:
-		    case CONSTR_0_1:
-		    case CONSTR_1_1:
-		    case CONSTR_0_2:
-		    case CONSTR_2_0:
-			size = sizeW_fromITBL(info);
-			type = Constr;
-			break;
-			
-		    case FUN_1_0:
-		    case FUN_0_1:
-			size = sizeofW(StgHeader) + 1;
-			goto fun;
-		    case FUN_1_1:
-		    case FUN_0_2:
-		    case FUN_2_0:
-		    case FUN:
-			size = sizeW_fromITBL(info);
-		    fun:
-			type = Fun;
-			break;
-
-		    case THUNK_1_0:
-		    case THUNK_0_1:
-		    case THUNK_SELECTOR:
-			size = sizeofW(StgHeader) + 2;
-			goto thunk;
-		    case THUNK_1_1:
-		    case THUNK_0_2:
-		    case THUNK_2_0:
-		    case THUNK:
-			size = sizeW_fromITBL(info);
-		    thunk:
-			type = Thunk;
-			break;
-
-		    case BLACKHOLE:
-/*		    case BLACKHOLE_BQ: FIXME: case does not exist */
-			size = sizeW_fromITBL(info);
-			type = BlackHole;
-			break;
-
-		    case AP:
-			size = pap_sizeW((StgPAP *)p);
-			type = Thunk;
-			break;
-
-		    case PAP:
-			size = pap_sizeW((StgPAP *)p);
-			type = Fun;
-			break;
-			
-		    case ARR_WORDS:
-			size = arr_words_sizeW(stgCast(StgArrWords*,p));
-			type = Array;
-			break;
-			
-		    case MUT_ARR_PTRS:
-		    case MUT_ARR_PTRS_FROZEN:
-			size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
-			type = Array;
-			break;
-			
-		    case TSO:
-			size = tso_sizeW((StgTSO *)p);
-			type = Thread;
-			break;
-			
-		    case WEAK:
-		    case PRIM:
-		    case MVAR:
-		    case MUT_VAR:
-/*		    case MUT_CONS: FIXME: case does not exist */
-		    case IND_PERM:
-			size = sizeW_fromITBL(info);
-			type = Other;
-			break;
-
-		    default:
-			barf("updateResidencyGraph: strange closure "
-                             "%d", info->type );
-		    }
-
-		    prof[type] += size;
-		    p += size;
-		}
-	    }
-	}
-    }
-
-}
-	    
-static void
-updateResidencyGraph( void )
-{
-    nat total, prev_total, i, max_res;
-    double time;
-    double time_scale = 1;
-    nat last_slice = next_slice-1;
-    double res_scale  = 1; /* in megabytes, doubles */
-    nat *prof;
-    nat width, height;
-    GdkPoint points[4];
-
-    gdk_draw_rectangle (res_pixmap,
-			res_drawing_area->style->bg_gc[GTK_STATE_NORMAL],
-			TRUE,
-			0, 0,
-			res_drawing_area->allocation.width,
-			res_drawing_area->allocation.height);
-    
-    if (next_slice == 0) return;
-
-    time = res_time[last_slice];
-    while (time > time_scale) {
-	time_scale *= 2;
-    }
-
-    max_res = 0; 
-    for (i = 0; i < next_slice; i++) {
-	prof = res_prof[i];
-	total = prof[Thunk] + prof[Fun] + prof[Constr] +
-	    prof[BlackHole] + prof[Array] + prof[Other];
-	if (total > max_res) {
-	    max_res = total;
-	}
-    }
-    while (max_res > res_scale) {
-	res_scale *= 2;
-    }
-
-    height = res_drawing_area->allocation.height;
-    width  = res_drawing_area->allocation.width;
-
-    points[0].x = 0;
-    points[0].y = height;
-    points[1].y = height;
-    points[3].x = 0;
-    points[3].y = height;
-
-    gdk_gc_set_foreground(my_gc, &free_color);
-
-    prev_total = 0;
-    for (i = 0; i < next_slice; i++) {
-	prof = res_prof[i];
-	total = prof[Thunk] + prof[Fun] + prof[Constr] +
-	    prof[BlackHole] + prof[Array] + prof[Other];
-	points[1].x = width * res_time[i] / time_scale;
-	points[2].x = points[1].x;
-	points[2].y = height - ((height * total) / res_scale);
-	gdk_draw_polygon(res_pixmap, my_gc, TRUE/*filled*/, points, 4);
-	points[3] = points[2];
-	points[0] = points[1];
-    }
-
-    gtk_ruler_set_range( GTK_RULER(res_vruler), 
-			 res_scale / ((1024*1024)/sizeof(W_)),
-			 0, 0,
-			 res_scale / ((1024*1024)/sizeof(W_)) );
-
-    gtk_ruler_set_range( GTK_RULER(res_hruler), 
-			 0, time_scale, 0, time_scale );
-
-
-    gtk_widget_draw( res_drawing_area, NULL );
-}
-
-#endif /* RTS_GTK_FRONTPANEL */
diff --git a/rts/FrontPanel.h b/rts/FrontPanel.h
deleted file mode 100644
index 84e40d5e1b..0000000000
--- a/rts/FrontPanel.h
+++ /dev/null
@@ -1,39 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2000-2005
- *
- * RTS GTK Front Panel
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef FRONTPANEL_H
-#define FRONTPANEL_H
-
-#include "BeginPrivate.h"
-
-#ifdef RTS_GTK_FRONTPANEL
-
-#include "Rts.h"  /* needed because this file gets included by
-		   * auto-generated code */
-
-void initFrontPanel( void );
-void stopFrontPanel( void );
-void updateFrontPanelBeforeGC( nat N );
-void updateFrontPanelAfterGC( nat N, W_ live );
-void updateFrontPanel( void );
-
-
-/* --------- PRIVATE ----------------------------------------- */
-
-#include <gdk/gdktypes.h>
-
-typedef enum { BeforeGC, AfterGC, BeforeAfterGC, Continuous } UpdateMode;
-extern UpdateMode update_mode;
-extern gboolean continue_now, stop_now, quit;
-
-#endif /* RTS_GTK_FRONTPANEL */
-
-#include "EndPrivate.h"
-
-#endif /* FRONTPANEL_H */
-
diff --git a/rts/Globals.c b/rts/Globals.c
index 1aafe21879..2e4b99474f 100644
--- a/rts/Globals.c
+++ b/rts/Globals.c
@@ -7,8 +7,13 @@
  * even when multiple versions of the library are loaded.  e.g. see
  * Data.Typeable and GHC.Conc.
  *
- * If/when we switch to a dynamically-linked GHCi, this can all go
- * away, because there would be just one copy of each library.
+ * How are multiple versions of a library loaded? Examples:
+ *
+ *   base - a statically-linked ghci has its own copy, so might libraries it
+ *          dynamically loads
+ *
+ *   libHSghc - a statically-linked ghc has its own copy and so will Core
+ *              plugins it dynamically loads (cf CoreMonad.reinitializeGlobals)
  *
  * ---------------------------------------------------------------------------*/
 
@@ -27,6 +32,7 @@ typedef enum {
     SystemEventThreadIOManagerThreadStore,
     SystemTimerThreadEventManagerStore,
     SystemTimerThreadIOManagerThreadStore,
+    LibHSghcFastStringTable,
     MaxStoreKey
 } StoreKey;
 
@@ -128,3 +134,9 @@ getOrSetSystemTimerThreadIOManagerThreadStore(StgStablePtr ptr)
 {
     return getOrSetKey(SystemTimerThreadIOManagerThreadStore,ptr);
 }
+
+StgStablePtr
+getOrSetLibHSghcFastStringTable(StgStablePtr ptr)
+{
+    return getOrSetKey(LibHSghcFastStringTable,ptr);
+}
diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index fbceb7691a..e130cb3660 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -487,11 +487,11 @@ stg_block_noregs
 /* -----------------------------------------------------------------------------
  * takeMVar/putMVar-specific blocks
  *
- * Stack layout for a thread blocked in takeMVar:
+ * Stack layout for a thread blocked in takeMVar/readMVar:
  *      
  *       ret. addr
  *       ptr to MVar   (R1)
- *       stg_block_takemvar_info
+ *       stg_block_takemvar_info (or stg_block_readmvar_info)
  *
  * Stack layout for a thread blocked in putMVar:
  *      
@@ -531,6 +531,33 @@ stg_block_takemvar /* mvar passed in R1 */
     BLOCK_BUT_FIRST(stg_block_takemvar_finally);
 }
 
+INFO_TABLE_RET ( stg_block_readmvar, RET_SMALL, W_ info_ptr, P_ mvar )
+    return ()
+{
+    jump stg_readMVarzh(mvar);
+}
+
+// code fragment executed just before we return to the scheduler
+stg_block_readmvar_finally
+{
+    W_ r1, r3;
+    r1 = R1;
+    r3 = R3;
+    unlockClosure(R3, stg_MVAR_DIRTY_info);
+    R1 = r1;
+    R3 = r3;
+    jump StgReturn [R1];
+}
+
+stg_block_readmvar /* mvar passed in R1 */
+{
+    Sp_adj(-2);
+    Sp(1) = R1;
+    Sp(0) = stg_block_readmvar_info;
+    R3 = R1; // mvar communicated to stg_block_readmvar_finally in R3
+    BLOCK_BUT_FIRST(stg_block_readmvar_finally);
+}
+
 INFO_TABLE_RET( stg_block_putmvar, RET_SMALL, W_ info_ptr,
                 P_ mvar, P_ val )
     return ()
diff --git a/rts/Linker.c b/rts/Linker.c
index 585d1e8451..81a267db1b 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -156,6 +156,10 @@ static /*Str*/HashTable *stablehash;
 /* List of currently loaded objects */
 ObjectCode *objects = NULL;     /* initially empty */
 
+/* List of objects that have been unloaded via unloadObj(), but are waiting
+   to be actually freed via checkUnload() */
+ObjectCode *unloaded_objects = NULL; /* initially empty */
+
 static HsInt loadOc( ObjectCode* oc );
 static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
                          char *archiveMemberName
@@ -229,6 +233,8 @@ static void machoInitSymbolsWithoutUnderscore( void );
 #endif
 #endif
 
+static void freeProddableBlocks (ObjectCode *oc);
+
 /* on x86_64 we have a problem with relocating symbol references in
  * code that was compiled without -fPIC.  By default, the small memory
  * model is used, which assumes that symbol references can fit in a
@@ -321,7 +327,7 @@ typedef struct _RtsSymbolVal {
 
 #define Maybe_Stable_Names      SymI_HasProto(stg_mkWeakzh)                     \
                                 SymI_HasProto(stg_mkWeakNoFinalizzerzh)         \
-                                SymI_HasProto(stg_mkWeakForeignEnvzh)           \
+                                SymI_HasProto(stg_addCFinalizzerToWeakzh)       \
                                 SymI_HasProto(stg_makeStableNamezh)             \
                                 SymI_HasProto(stg_finalizzeWeakzh)
 
@@ -901,8 +907,10 @@ typedef struct _RtsSymbolVal {
       SymI_NeedsProto(top_ct)                           \
                                                         \
       SymI_HasProto(ENT_VIA_NODE_ctr)                   \
-      SymI_HasProto(ENT_STATIC_THK_ctr)                 \
-      SymI_HasProto(ENT_DYN_THK_ctr)                    \
+      SymI_HasProto(ENT_STATIC_THK_SINGLE_ctr)          \
+      SymI_HasProto(ENT_STATIC_THK_MANY_ctr)            \
+      SymI_HasProto(ENT_DYN_THK_SINGLE_ctr)             \
+      SymI_HasProto(ENT_DYN_THK_MANY_ctr)               \
       SymI_HasProto(ENT_STATIC_FUN_DIRECT_ctr)          \
       SymI_HasProto(ENT_DYN_FUN_DIRECT_ctr)             \
       SymI_HasProto(ENT_STATIC_CON_ctr)                 \
@@ -970,8 +978,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(UPD_NEW_PERM_IND_ctr)               \
       SymI_HasProto(UPD_OLD_IND_ctr)                    \
       SymI_HasProto(UPD_OLD_PERM_IND_ctr)               \
-      SymI_HasProto(UPD_BH_UPDATABLE_ctr)               \
-      SymI_HasProto(UPD_BH_SINGLE_ENTRY_ctr)            \
       SymI_HasProto(UPD_CAF_BH_UPDATABLE_ctr)           \
       SymI_HasProto(UPD_CAF_BH_SINGLE_ENTRY_ctr)        \
       SymI_HasProto(GC_SEL_ABANDONED_ctr)               \
@@ -1058,6 +1064,7 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_yield_to_interpreter)                           \
       SymI_HasProto(stg_block_noregs)                                   \
       SymI_HasProto(stg_block_takemvar)                                 \
+      SymI_HasProto(stg_block_readmvar)                           \
       SymI_HasProto(stg_block_putmvar)                                  \
       MAIN_CAP_SYM                                                      \
       SymI_HasProto(MallocFailHook)                                     \
@@ -1067,7 +1074,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(addDLL)                                             \
       SymI_HasProto(__int_encodeDouble)                                 \
       SymI_HasProto(__word_encodeDouble)                                \
-      SymI_HasProto(__2Int_encodeDouble)                                \
       SymI_HasProto(__int_encodeFloat)                                  \
       SymI_HasProto(__word_encodeFloat)                                 \
       SymI_HasProto(stg_atomicallyzh)                                   \
@@ -1106,9 +1112,9 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(getOrSetSystemEventThreadIOManagerThreadStore)      \
       SymI_HasProto(getOrSetSystemTimerThreadEventManagerStore)         \
       SymI_HasProto(getOrSetSystemTimerThreadIOManagerThreadStore)      \
+      SymI_HasProto(getOrSetLibHSghcFastStringTable)                    \
       SymI_HasProto(getGCStats)                                         \
       SymI_HasProto(getGCStatsEnabled)                                  \
-      SymI_HasProto(genSymZh)                                           \
       SymI_HasProto(genericRaise)                                       \
       SymI_HasProto(getProgArgv)                                        \
       SymI_HasProto(getFullProgArgv)                                    \
@@ -1281,12 +1287,6 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_ap_7_upd_info)                                  \
       SymI_HasProto(stg_exit)                                           \
       SymI_HasProto(stg_sel_0_upd_info)                                 \
-      SymI_HasProto(stg_sel_10_upd_info)                                \
-      SymI_HasProto(stg_sel_11_upd_info)                                \
-      SymI_HasProto(stg_sel_12_upd_info)                                \
-      SymI_HasProto(stg_sel_13_upd_info)                                \
-      SymI_HasProto(stg_sel_14_upd_info)                                \
-      SymI_HasProto(stg_sel_15_upd_info)                                \
       SymI_HasProto(stg_sel_1_upd_info)                                 \
       SymI_HasProto(stg_sel_2_upd_info)                                 \
       SymI_HasProto(stg_sel_3_upd_info)                                 \
@@ -1296,13 +1296,37 @@ typedef struct _RtsSymbolVal {
       SymI_HasProto(stg_sel_7_upd_info)                                 \
       SymI_HasProto(stg_sel_8_upd_info)                                 \
       SymI_HasProto(stg_sel_9_upd_info)                                 \
+      SymI_HasProto(stg_sel_10_upd_info)                                \
+      SymI_HasProto(stg_sel_11_upd_info)                                \
+      SymI_HasProto(stg_sel_12_upd_info)                                \
+      SymI_HasProto(stg_sel_13_upd_info)                                \
+      SymI_HasProto(stg_sel_14_upd_info)                                \
+      SymI_HasProto(stg_sel_15_upd_info)                                \
+      SymI_HasProto(stg_sel_0_noupd_info)                                 \
+      SymI_HasProto(stg_sel_1_noupd_info)                                 \
+      SymI_HasProto(stg_sel_2_noupd_info)                                 \
+      SymI_HasProto(stg_sel_3_noupd_info)                                 \
+      SymI_HasProto(stg_sel_4_noupd_info)                                 \
+      SymI_HasProto(stg_sel_5_noupd_info)                                 \
+      SymI_HasProto(stg_sel_6_noupd_info)                                 \
+      SymI_HasProto(stg_sel_7_noupd_info)                                 \
+      SymI_HasProto(stg_sel_8_noupd_info)                                 \
+      SymI_HasProto(stg_sel_9_noupd_info)                                 \
+      SymI_HasProto(stg_sel_10_noupd_info)                                \
+      SymI_HasProto(stg_sel_11_noupd_info)                                \
+      SymI_HasProto(stg_sel_12_noupd_info)                                \
+      SymI_HasProto(stg_sel_13_noupd_info)                                \
+      SymI_HasProto(stg_sel_14_noupd_info)                                \
+      SymI_HasProto(stg_sel_15_noupd_info)                                \
       SymI_HasProto(stg_upd_frame_info)                                 \
       SymI_HasProto(stg_bh_upd_frame_info)                              \
       SymI_HasProto(suspendThread)                                      \
       SymI_HasProto(stg_takeMVarzh)                                     \
+      SymI_HasProto(stg_readMVarzh)                               \
       SymI_HasProto(stg_threadStatuszh)                                 \
       SymI_HasProto(stg_tryPutMVarzh)                                   \
       SymI_HasProto(stg_tryTakeMVarzh)                                  \
+      SymI_HasProto(stg_tryReadMVarzh)                            \
       SymI_HasProto(stg_unmaskAsyncExceptionszh)                        \
       SymI_HasProto(unloadObj)                                          \
       SymI_HasProto(stg_unsafeThawArrayzh)                              \
@@ -1500,6 +1524,9 @@ initLinker( void )
         linker_init_done = 1;
     }
 
+    objects = NULL;
+    unloaded_objects = NULL;
+
 #if defined(THREADED_RTS) && (defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO))
     initMutex(&dl_mutex);
 #endif
@@ -2026,6 +2053,40 @@ mmap_again:
 }
 #endif // USE_MMAP
 
+
+void freeObjectCode (ObjectCode *oc)
+{
+    int pagesize, size, r;
+
+#ifdef USE_MMAP
+
+    pagesize = getpagesize();
+    size = ROUND_UP(oc->fileSize, pagesize);
+
+    r = munmap(oc->image, size);
+    if (r == -1) {
+        sysErrorBelch("munmap");
+    }
+
+    if (!USE_CONTIGUOUS_MMAP)
+    {
+        munmap(oc->symbol_extras,
+               ROUND_UP(sizeof(SymbolExtra) * oc->n_symbol_extras, pagesize));
+    }
+
+#else
+
+    stgFree(oc->image);
+    stgFree(oc->symbol_extras);
+
+#endif
+
+    stgFree(oc->fileName);
+    stgFree(oc->archiveMemberName);
+    stgFree(oc);
+}
+
+
 static ObjectCode*
 mkOc( pathchar *path, char *image, int imageSize,
       char *archiveMemberName
@@ -2728,7 +2789,7 @@ resolveObjs( void )
 HsInt
 unloadObj( pathchar *path )
 {
-    ObjectCode *oc, *prev;
+    ObjectCode *oc, *prev, *next;
     HsBool unloadedAnyObj = HS_BOOL_FALSE;
 
     ASSERT(symhash != NULL);
@@ -2736,8 +2797,12 @@ unloadObj( pathchar *path )
 
     initLinker();
 
+    IF_DEBUG(linker, debugBelch("unloadObj: %s\n", path));
+
     prev = NULL;
-    for (oc = objects; oc; prev = oc, oc = oc->next) {
+    for (oc = objects; oc; prev = oc, oc = next) {
+        next = oc->next;
+
         if (!pathcmp(oc->fileName,path)) {
 
             /* Remove all the mappings for the symbols within this
@@ -2757,22 +2822,27 @@ unloadObj( pathchar *path )
             } else {
                 prev->next = oc->next;
             }
+            oc->next = unloaded_objects;
+            unloaded_objects = oc;
 
-            // We're going to leave this in place, in case there are
-            // any pointers from the heap into it:
-                // #ifdef mingw32_HOST_OS
-                // If uncommenting, note that currently oc->image is
-                // not the right address to free on Win64, as we added
-                // 4 bytes of padding at the start
-                //  VirtualFree(oc->image);
-                // #else
-            //  stgFree(oc->image);
-            // #endif
-            stgFree(oc->fileName);
-            stgFree(oc->archiveMemberName);
+            // The data itself and a few other bits (oc->fileName,
+            // oc->archiveMemberName) are kept until freeObjectCode(),
+            // which is only called when it has been determined that
+            // it is safe to unload the object.
             stgFree(oc->symbols);
-            stgFree(oc->sections);
-            stgFree(oc);
+
+            {
+                Section *s, *nexts;
+
+                for (s = oc->sections; s != NULL; s = nexts) {
+                    nexts = s->next;
+                    stgFree(s);
+                }
+            }
+
+            freeProddableBlocks(oc);
+
+            oc->status = OBJECT_UNLOADED;
 
             /* This could be a member of an archive so continue
              * unloading other members. */
@@ -2822,6 +2892,17 @@ checkProddableBlock (ObjectCode *oc, void *addr, size_t size )
    barf("checkProddableBlock: invalid fixup in runtime linker: %p", addr);
 }
 
+static void freeProddableBlocks (ObjectCode *oc)
+{
+    ProddableBlock *pb, *next;
+
+    for (pb = oc->proddables; pb != NULL; pb = next) {
+        next = pb->next;
+        stgFree(pb);
+    }
+    oc->proddables = NULL;
+}
+
 /* -----------------------------------------------------------------------------
  * Section management.
  */
@@ -2910,6 +2991,7 @@ static int ocAllocateSymbolExtras( ObjectCode* oc, int count, int first )
                 memcpy(new, oc->image, oc->fileSize);
                 munmap(oc->image, n);
                 oc->image = new;
+                oc->fileSize = n + (sizeof(SymbolExtra) * count);
                 oc->symbol_extras = (SymbolExtra *) (oc->image + n);
             }
             else
@@ -4941,6 +5023,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
                // Generate veneer
                SymbolExtra *extra = makeArmSymbolExtra(oc, ELF_R_SYM(info), S+imm+4, 1, is_target_thm);
                offset = (StgWord32) &extra->jumpIsland - P - 4;
+               sign = offset >> 31;
                to_thm = 1;
             } else if (!is_target_thm && ELF_R_TYPE(info) == R_ARM_THM_CALL) {
                offset &= ~0x3;
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index 864e0d1f2f..753279d547 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -9,7 +9,11 @@
 #ifndef LINKERINTERNALS_H
 #define LINKERINTERNALS_H
 
-typedef enum { OBJECT_LOADED, OBJECT_RESOLVED } OStatus;
+typedef enum {
+    OBJECT_LOADED,
+    OBJECT_RESOLVED,
+    OBJECT_UNLOADED
+} OStatus;
 
 /* Indication of section kinds for loaded objects.  Needed by
    the GC for deciding whether or not a pointer on the stack
@@ -82,6 +86,9 @@ typedef struct _ObjectCode {
     /* ptr to malloc'd lump of memory holding the obj file */
     char*      image;
 
+    /* flag used when deciding whether to unload an object file */
+    int        referenced;
+
 #ifdef darwin_HOST_OS
     /* record by how much image has been deliberately misaligned
        after allocation, so that we can use realloc */
@@ -121,7 +128,10 @@ typedef struct _ObjectCode {
     )
 
 extern ObjectCode *objects;
+extern ObjectCode *unloaded_objects;
 
 void exitLinker( void );
 
+void freeObjectCode (ObjectCode *oc);
+
 #endif /* LINKERINTERNALS_H */
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index f4e80e9c35..ced15eec99 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -160,16 +160,16 @@ stg_newArrayzh ( W_ n /* words */, gcptr init )
     p = arr + SIZEOF_StgMutArrPtrs;
   for:
     if (p < arr + WDS(words)) {
-	W_[p] = init;
-	p = p + WDS(1);
-	goto for;
+        W_[p] = init;
+        p = p + WDS(1);
+        goto for;
     }
     // Initialise the mark bits with 0
   for2:
     if (p < arr + WDS(size)) {
-	W_[p] = 0;
-	p = p + WDS(1);
-	goto for2;
+        W_[p] = 0;
+        p = p + WDS(1);
+        goto for2;
     }
 
     return (arr);
@@ -179,11 +179,11 @@ stg_unsafeThawArrayzh ( gcptr arr )
 {
   // SUBTLETY TO DO WITH THE OLD GEN MUTABLE LIST
   //
-  // A MUT_ARR_PTRS lives on the mutable list, but a MUT_ARR_PTRS_FROZEN 
+  // A MUT_ARR_PTRS lives on the mutable list, but a MUT_ARR_PTRS_FROZEN
   // normally doesn't.  However, when we freeze a MUT_ARR_PTRS, we leave
   // it on the mutable list for the GC to remove (removing something from
   // the mutable list is not easy).
-  // 
+  //
   // So that we can tell whether a MUT_ARR_PTRS_FROZEN is on the mutable list,
   // when we freeze it we set the info ptr to be MUT_ARR_PTRS_FROZEN0
   // to indicate that it is still on the mutable list.
@@ -198,11 +198,11 @@ stg_unsafeThawArrayzh ( gcptr arr )
   if (StgHeader_info(arr) != stg_MUT_ARR_PTRS_FROZEN0_info) {
         SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info);
         recordMutable(arr);
-	// must be done after SET_INFO, because it ASSERTs closure_MUTABLE()
-	return (arr);
+        // must be done after SET_INFO, because it ASSERTs closure_MUTABLE()
+        return (arr);
   } else {
-	SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info);
-	return (arr);
+        SET_INFO(arr,stg_MUT_ARR_PTRS_DIRTY_info);
+        return (arr);
   }
 }
 
@@ -229,16 +229,16 @@ stg_newArrayArrayzh ( W_ n /* words */ )
     p = arr + SIZEOF_StgMutArrPtrs;
   for:
     if (p < arr + WDS(words)) {
-	W_[p] = arr;
-	p = p + WDS(1);
-	goto for;
+        W_[p] = arr;
+        p = p + WDS(1);
+        goto for;
     }
     // Initialise the mark bits with 0
   for2:
     if (p < arr + WDS(size)) {
-	W_[p] = 0;
-	p = p + WDS(1);
-	goto for2;
+        W_[p] = 0;
+        p = p + WDS(1);
+        goto for2;
     }
 
     return (arr);
@@ -258,7 +258,7 @@ stg_newMutVarzh ( gcptr init )
     mv = Hp - SIZEOF_StgMutVar + WDS(1);
     SET_HDR(mv,stg_MUT_VAR_DIRTY_info,CCCS);
     StgMutVar_var(mv) = init;
-    
+
     return (mv);
 }
 
@@ -283,19 +283,19 @@ stg_atomicModifyMutVarzh ( gcptr mv, gcptr f )
 {
     W_ z, x, y, r, h;
 
-    /* If x is the current contents of the MutVar#, then 
+    /* If x is the current contents of the MutVar#, then
        We want to make the new contents point to
 
          (sel_0 (f x))
- 
+
        and the return value is
-	 
-	 (sel_1 (f x))
+
+         (sel_1 (f x))
 
         obviously we can share (f x).
 
          z = [stg_ap_2 f x]  (max (HS + 2) MIN_UPD_SIZE)
-	 y = [stg_sel_0 z]   (max (HS + 1) MIN_UPD_SIZE)
+         y = [stg_sel_0 z]   (max (HS + 1) MIN_UPD_SIZE)
          r = [stg_sel_1 z]   (max (HS + 1) MIN_UPD_SIZE)
     */
 
@@ -374,18 +374,14 @@ stg_mkWeakzh ( gcptr key,
   w = Hp - SIZEOF_StgWeak + WDS(1);
   SET_HDR(w, stg_WEAK_info, CCCS);
 
-  // We don't care about cfinalizer here.
-  // Should StgWeak_cfinalizer(w) be stg_NO_FINALIZER_closure or
-  // something else?
-
-  StgWeak_key(w)        = key;
-  StgWeak_value(w)      = value;
-  StgWeak_finalizer(w)  = finalizer;
-  StgWeak_cfinalizer(w) = stg_NO_FINALIZER_closure;
+  StgWeak_key(w)         = key;
+  StgWeak_value(w)       = value;
+  StgWeak_finalizer(w)   = finalizer;
+  StgWeak_cfinalizers(w) = stg_NO_FINALIZER_closure;
 
   ACQUIRE_LOCK(sm_mutex);
-  StgWeak_link(w)	= W_[weak_ptr_list];
-  W_[weak_ptr_list] 	= w;
+  StgWeak_link(w) = generation_weak_ptr_list(W_[g0]);
+  generation_weak_ptr_list(W_[g0]) = w;
   RELEASE_LOCK(sm_mutex);
 
   IF_DEBUG(weak, ccall debugBelch(stg_weak_msg,w));
@@ -398,61 +394,62 @@ stg_mkWeakNoFinalizzerzh ( gcptr key, gcptr value )
   jump stg_mkWeakzh (key, value, stg_NO_FINALIZER_closure);
 }
 
-stg_mkWeakForeignEnvzh ( gcptr key,
-                         gcptr val,
-                         W_ fptr,   // finalizer
-                         W_ ptr,
-                         W_ flag,   // has environment (0 or 1)
-                         W_ eptr )
+STRING(stg_cfinalizer_msg,"Adding a finalizer to %p\n")
+
+stg_addCFinalizzerToWeakzh ( W_ fptr,   // finalizer
+                             W_ ptr,
+                             W_ flag,   // has environment (0 or 1)
+                             W_ eptr,
+                             gcptr w )
 {
-  W_ payload_words, words;
-  gcptr w, p;
+  W_ c, info;
 
-  ALLOC_PRIM (SIZEOF_StgWeak);
+  LOCK_CLOSURE(w, info);
 
-  w = Hp - SIZEOF_StgWeak + WDS(1);
-  SET_HDR(w, stg_WEAK_info, CCCS);
+  if (info == stg_DEAD_WEAK_info) {
+    // Already dead.
+    unlockClosure(w, info);
+    return (0);
+  }
 
-  payload_words = 4;
-  words         = BYTES_TO_WDS(SIZEOF_StgArrWords) + payload_words;
-  ("ptr" p)     = ccall allocate(MyCapability() "ptr", words);
+  ALLOC_PRIM (SIZEOF_StgCFinalizerList)
 
-  TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
-  SET_HDR(p, stg_ARR_WORDS_info, CCCS);
+  c = Hp - SIZEOF_StgCFinalizerList + WDS(1);
+  SET_HDR(c, stg_C_FINALIZER_LIST_info, CCCS);
 
-  StgArrWords_bytes(p)     = WDS(payload_words);
-  StgArrWords_payload(p,0) = fptr;
-  StgArrWords_payload(p,1) = ptr;
-  StgArrWords_payload(p,2) = eptr;
-  StgArrWords_payload(p,3) = flag;
+  StgCFinalizerList_fptr(c) = fptr;
+  StgCFinalizerList_ptr(c) = ptr;
+  StgCFinalizerList_eptr(c) = eptr;
+  StgCFinalizerList_flag(c) = flag;
 
-  // We don't care about the value here.
-  // Should StgWeak_value(w) be stg_NO_FINALIZER_closure or something else?
+  StgCFinalizerList_link(c) = StgWeak_cfinalizers(w);
+  StgWeak_cfinalizers(w) = c;
 
-  StgWeak_key(w)        = key;
-  StgWeak_value(w)      = val;
-  StgWeak_finalizer(w)  = stg_NO_FINALIZER_closure;
-  StgWeak_cfinalizer(w) = p;
+  unlockClosure(w, info);
 
-  ACQUIRE_LOCK(sm_mutex);
-  StgWeak_link(w)   = W_[weak_ptr_list];
-  W_[weak_ptr_list] = w;
-  RELEASE_LOCK(sm_mutex);
+  recordMutable(w);
 
-  IF_DEBUG(weak, ccall debugBelch(stg_weak_msg,w));
+  IF_DEBUG(weak, ccall debugBelch(stg_cfinalizer_msg,w));
 
-  return (w);
+  return (1);
 }
 
 stg_finalizzeWeakzh ( gcptr w )
 {
-  gcptr f, arr;
+  gcptr f, list;
+  W_ info;
+
+  LOCK_CLOSURE(w, info);
 
   // already dead?
-  if (GET_INFO(w) == stg_DEAD_WEAK_info) {
+  if (info == stg_DEAD_WEAK_info) {
+      unlockClosure(w, info);
       return (0,stg_NO_FINALIZER_closure);
   }
 
+  f    = StgWeak_finalizer(w);
+  list = StgWeak_cfinalizers(w);
+
   // kill it
 #ifdef PROFILING
   // @LDV profiling
@@ -461,7 +458,7 @@ stg_finalizzeWeakzh ( gcptr w )
   //    LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)w);
   // or, LDV_recordDead():
   //    LDV_recordDead((StgClosure *)w, sizeofW(StgWeak) - sizeofW(StgProfHeader));
-  // Furthermore, when PROFILING is turned on, dead weak pointers are exactly as 
+  // Furthermore, when PROFILING is turned on, dead weak pointers are exactly as
   // large as weak pointers, so there is no need to fill the slop, either.
   // See stg_DEAD_WEAK_info in StgMiscClosures.hc.
 #endif
@@ -469,19 +466,12 @@ stg_finalizzeWeakzh ( gcptr w )
   //
   // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
   //
-  SET_INFO(w,stg_DEAD_WEAK_info);
-  LDV_RECORD_CREATE(w);
-
-  f   = StgWeak_finalizer(w);
-  arr = StgWeak_cfinalizer(w);
+  unlockClosure(w, stg_DEAD_WEAK_info);
 
-  StgDeadWeak_link(w) = StgWeak_link(w);
+  LDV_RECORD_CREATE(w);
 
-  if (arr != stg_NO_FINALIZER_closure) {
-    ccall runCFinalizer(StgArrWords_payload(arr,0),
-                              StgArrWords_payload(arr,1),
-                              StgArrWords_payload(arr,2),
-                              StgArrWords_payload(arr,3));
+  if (list != stg_NO_FINALIZER_closure) {
+    ccall runCFinalizers(list);
   }
 
   /* return the finalizer */
@@ -494,10 +484,21 @@ stg_finalizzeWeakzh ( gcptr w )
 
 stg_deRefWeakzh ( gcptr w )
 {
-  W_ code;
+  W_ code, info;
   gcptr val;
 
-  if (GET_INFO(w) == stg_WEAK_info) {
+  info = GET_INFO(w);
+
+  if (info == stg_WHITEHOLE_info) {
+    // w is locked by another thread. Now it's not immediately clear if w is
+    // alive or not. We use lockClosure to wait for the info pointer to become
+    // something other than stg_WHITEHOLE_info.
+
+    LOCK_CLOSURE(w, info);
+    unlockClosure(w, info);
+  }
+
+  if (info == stg_WEAK_info) {
     code = 1;
     val = StgWeak_value(w);
   } else {
@@ -512,7 +513,7 @@ stg_deRefWeakzh ( gcptr w )
    -------------------------------------------------------------------------- */
 
 stg_decodeFloatzuIntzh ( F_ arg )
-{ 
+{
     W_ p;
     W_ mp_tmp1;
     W_ mp_tmp_w;
@@ -521,16 +522,16 @@ stg_decodeFloatzuIntzh ( F_ arg )
 
     mp_tmp1  = Sp - WDS(1);
     mp_tmp_w = Sp - WDS(2);
-    
+
     /* Perform the operation */
     ccall __decodeFloat_Int(mp_tmp1 "ptr", mp_tmp_w "ptr", arg);
-    
+
     /* returns: (Int# (mantissa), Int# (exponent)) */
     return (W_[mp_tmp1], W_[mp_tmp_w]);
 }
 
 stg_decodeDoublezu2Intzh ( D_ arg )
-{ 
+{
     W_ p;
     W_ mp_tmp1;
     W_ mp_tmp2;
@@ -564,13 +565,13 @@ stg_forkzh ( gcptr closure )
 
   gcptr threadid;
 
-  ("ptr" threadid) = ccall createIOThread( MyCapability() "ptr", 
-				RtsFlags_GcFlags_initialStkSize(RtsFlags), 
+  ("ptr" threadid) = ccall createIOThread( MyCapability() "ptr",
+                                RtsFlags_GcFlags_initialStkSize(RtsFlags),
                                 closure "ptr");
 
   /* start blocked if the current thread is blocked */
   StgTSO_flags(threadid) = %lobits16(
-     TO_W_(StgTSO_flags(threadid)) | 
+     TO_W_(StgTSO_flags(threadid)) |
      TO_W_(StgTSO_flags(CurrentTSO)) & (TSO_BLOCKEX | TSO_INTERRUPTIBLE));
 
   ccall scheduleThread(MyCapability() "ptr", threadid "ptr");
@@ -578,7 +579,7 @@ stg_forkzh ( gcptr closure )
   // context switch soon, but not immediately: we don't want every
   // forkIO to force a context-switch.
   Capability_context_switch(MyCapability()) = 1 :: CInt;
-  
+
   return (threadid);
 }
 
@@ -588,13 +589,13 @@ again: MAYBE_GC(again);
 
   gcptr threadid;
 
-  ("ptr" threadid) = ccall createIOThread( MyCapability() "ptr", 
-				RtsFlags_GcFlags_initialStkSize(RtsFlags), 
+  ("ptr" threadid) = ccall createIOThread( MyCapability() "ptr",
+                                RtsFlags_GcFlags_initialStkSize(RtsFlags),
                                 closure "ptr");
 
   /* start blocked if the current thread is blocked */
   StgTSO_flags(threadid) = %lobits16(
-     TO_W_(StgTSO_flags(threadid)) | 
+     TO_W_(StgTSO_flags(threadid)) |
      TO_W_(StgTSO_flags(CurrentTSO)) & (TSO_BLOCKEX | TSO_INTERRUPTIBLE));
 
   ccall scheduleThreadOn(MyCapability() "ptr", cpu, threadid "ptr");
@@ -602,7 +603,7 @@ again: MAYBE_GC(again);
   // context switch soon, but not immediately: we don't want every
   // forkIO to force a context-switch.
   Capability_context_switch(MyCapability()) = 1 :: CInt;
-  
+
   return (threadid);
 }
 
@@ -1014,7 +1015,7 @@ retry_pop_stack:
     }
   }
 
-  // We've reached the ATOMICALLY_FRAME: attempt to wait 
+  // We've reached the ATOMICALLY_FRAME: attempt to wait
   ASSERT(frame_type == ATOMICALLY_FRAME);
   if (outer != NO_TREC) {
     // We called retry while checking invariants, so abort the current
@@ -1152,9 +1153,9 @@ stg_writeTVarzh (P_ tvar,     /* :: TVar a */
 stg_isEmptyMVarzh ( P_ mvar /* :: MVar a */ )
 {
     if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
-	return (1);
+        return (1);
     } else {
-	return (0);
+        return (0);
     }
 }
 
@@ -1163,7 +1164,7 @@ stg_newMVarzh ()
     W_ mvar;
 
     ALLOC_PRIM_ (SIZEOF_StgMVar, stg_newMVarzh);
-  
+
     mvar = Hp - SIZEOF_StgMVar + WDS(1);
     SET_HDR(mvar,stg_MVAR_DIRTY_info,CCCS);
         // MVARs start dirty: generation 0 has no mutable list
@@ -1191,21 +1192,16 @@ stg_takeMVarzh ( P_ mvar /* :: MVar a */ )
 {
     W_ val, info, tso, q;
 
-#if defined(THREADED_RTS)
-    ("ptr" info) = ccall lockClosure(mvar "ptr");
-#else
-    info = GET_INFO(mvar);
-#endif
-        
-    if (info == stg_MVAR_CLEAN_info) {
-        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
-    }
+    LOCK_CLOSURE(mvar, info);
 
     /* If the MVar is empty, put ourselves on its blocking queue,
      * and wait until we're woken up.
      */
     if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
-        
+        if (info == stg_MVAR_CLEAN_info) {
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        }
+
         // We want to put the heap check down here in the slow path,
         // but be careful to unlock the closure before returning to
         // the RTS if the check fails.
@@ -1220,30 +1216,32 @@ stg_takeMVarzh ( P_ mvar /* :: MVar a */ )
         StgMVarTSOQueue_link(q) = END_TSO_QUEUE;
         StgMVarTSOQueue_tso(q)  = CurrentTSO;
 
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_head(mvar) = q;
-	} else {
+        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+            StgMVar_head(mvar) = q;
+        } else {
             StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q;
             ccall recordClosureMutated(MyCapability() "ptr",
                                              StgMVar_tail(mvar));
-	}
-	StgTSO__link(CurrentTSO)       = q;
-	StgTSO_block_info(CurrentTSO)  = mvar;
-	StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
-	StgMVar_tail(mvar)             = q;
-	
+        }
+        StgTSO__link(CurrentTSO)       = q;
+        StgTSO_block_info(CurrentTSO)  = mvar;
+        StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
+        StgMVar_tail(mvar)             = q;
+
         jump stg_block_takemvar(mvar);
     }
-    
+
     /* we got the value... */
     val = StgMVar_value(mvar);
-    
+
     q = StgMVar_head(mvar);
 loop:
     if (q == stg_END_TSO_QUEUE_closure) {
         /* No further putMVars, MVar is now empty */
         StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-        unlockClosure(mvar, stg_MVAR_DIRTY_info);
+        // If the MVar is not already dirty, then we don't need to make
+        // it dirty, as it is empty with nothing blocking on it.
+        unlockClosure(mvar, info);
         return (val);
     }
     if (StgHeader_info(q) == stg_IND_info ||
@@ -1251,9 +1249,13 @@ loop:
         q = StgInd_indirectee(q);
         goto loop;
     }
-  
+
     // There are putMVar(s) waiting... wake up the first thread on the queue
-    
+
+    if (info == stg_MVAR_CLEAN_info) {
+        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+    }
+
     tso = StgMVarTSOQueue_tso(q);
     StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
     if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
@@ -1270,11 +1272,11 @@ loop:
 
     // indicate that the MVar operation has now completed.
     StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
-    
+
     // no need to mark the TSO dirty, we have only written END_TSO_QUEUE.
 
     ccall tryWakeupThread(MyCapability() "ptr", tso);
-    
+
     unlockClosure(mvar, stg_MVAR_DIRTY_info);
     return (val);
 }
@@ -1283,48 +1285,43 @@ stg_tryTakeMVarzh ( P_ mvar /* :: MVar a */ )
 {
     W_ val, info, tso, q;
 
-#if defined(THREADED_RTS)
-    ("ptr" info) = ccall lockClosure(mvar "ptr");
-#else
-    info = GET_INFO(mvar);
-#endif
-        
-    /* If the MVar is empty, put ourselves on its blocking queue,
-     * and wait until we're woken up.
-     */
+    LOCK_CLOSURE(mvar, info);
+
+    /* If the MVar is empty, return 0. */
     if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
 #if defined(THREADED_RTS)
         unlockClosure(mvar, info);
 #endif
-	/* HACK: we need a pointer to pass back, 
-	 * so we abuse NO_FINALIZER_closure
-	 */
-	return (0, stg_NO_FINALIZER_closure);
-    }
-    
-    if (info == stg_MVAR_CLEAN_info) {
-        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        /* HACK: we need a pointer to pass back,
+         * so we abuse NO_FINALIZER_closure
+         */
+        return (0, stg_NO_FINALIZER_closure);
     }
 
     /* we got the value... */
     val = StgMVar_value(mvar);
-    
+
     q = StgMVar_head(mvar);
 loop:
     if (q == stg_END_TSO_QUEUE_closure) {
         /* No further putMVars, MVar is now empty */
         StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-        unlockClosure(mvar, stg_MVAR_DIRTY_info);
+        unlockClosure(mvar, info);
         return (1, val);
     }
+
     if (StgHeader_info(q) == stg_IND_info ||
         StgHeader_info(q) == stg_MSG_NULL_info) {
         q = StgInd_indirectee(q);
         goto loop;
     }
-    
+
     // There are putMVar(s) waiting... wake up the first thread on the queue
-    
+
+    if (info == stg_MVAR_CLEAN_info) {
+        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+    }
+
     tso = StgMVarTSOQueue_tso(q);
     StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
     if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
@@ -1341,11 +1338,11 @@ loop:
 
     // indicate that the MVar operation has now completed.
     StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
-    
+
     // no need to mark the TSO dirty, we have only written END_TSO_QUEUE.
 
     ccall tryWakeupThread(MyCapability() "ptr", tso);
-    
+
     unlockClosure(mvar, stg_MVAR_DIRTY_info);
     return (1,val);
 }
@@ -1355,18 +1352,14 @@ stg_putMVarzh ( P_ mvar, /* :: MVar a */
 {
     W_ info, tso, q;
 
-#if defined(THREADED_RTS)
-    ("ptr" info) = ccall lockClosure(mvar "ptr");
-#else
-    info = GET_INFO(mvar);
-#endif
-
-    if (info == stg_MVAR_CLEAN_info) {
-        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
-    }
+    LOCK_CLOSURE(mvar, info);
 
     if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
 
+        if (info == stg_MVAR_CLEAN_info) {
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        }
+
         // We want to put the heap check down here in the slow path,
         // but be careful to unlock the closure before returning to
         // the RTS if the check fails.
@@ -1381,27 +1374,30 @@ stg_putMVarzh ( P_ mvar, /* :: MVar a */
         StgMVarTSOQueue_link(q) = END_TSO_QUEUE;
         StgMVarTSOQueue_tso(q)  = CurrentTSO;
 
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_head(mvar) = q;
-	} else {
+        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+            StgMVar_head(mvar) = q;
+        } else {
             StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q;
             ccall recordClosureMutated(MyCapability() "ptr",
                                              StgMVar_tail(mvar));
-	}
-	StgTSO__link(CurrentTSO)       = q;
-	StgTSO_block_info(CurrentTSO)  = mvar;
-	StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
-	StgMVar_tail(mvar)             = q;
+        }
+        StgTSO__link(CurrentTSO)       = q;
+        StgTSO_block_info(CurrentTSO)  = mvar;
+        StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
+        StgMVar_tail(mvar)             = q;
 
         jump stg_block_putmvar(mvar,val);
     }
-  
+
     q = StgMVar_head(mvar);
 loop:
     if (q == stg_END_TSO_QUEUE_closure) {
-	/* No further takes, the MVar is now full. */
-	StgMVar_value(mvar) = val;
-    	unlockClosure(mvar, stg_MVAR_DIRTY_info);
+        /* No further takes, the MVar is now full. */
+        if (info == stg_MVAR_CLEAN_info) {
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        }
+        StgMVar_value(mvar) = val;
+        unlockClosure(mvar, stg_MVAR_DIRTY_info);
         return ();
     }
     if (StgHeader_info(q) == stg_IND_info ||
@@ -1410,16 +1406,19 @@ loop:
         goto loop;
     }
 
-    // There are takeMVar(s) waiting: wake up the first one
-    
+    // There are readMVar/takeMVar(s) waiting: wake up the first one
+
     tso = StgMVarTSOQueue_tso(q);
     StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
     if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
         StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
     }
 
-    ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
     ASSERT(StgTSO_block_info(tso) == mvar);
+    // save why_blocked here, because waking up the thread destroys
+    // this information
+    W_ why_blocked;
+    why_blocked = TO_W_(StgTSO_why_blocked(tso));
 
     // actually perform the takeMVar
     W_ stack;
@@ -1432,10 +1431,19 @@ loop:
     if (TO_W_(StgStack_dirty(stack)) == 0) {
         ccall dirty_STACK(MyCapability() "ptr", stack "ptr");
     }
-    
+
     ccall tryWakeupThread(MyCapability() "ptr", tso);
 
-    unlockClosure(mvar, stg_MVAR_DIRTY_info);
+    // If it was an readMVar, then we can still do work,
+    // so loop back. (XXX: This could take a while)
+    if (why_blocked == BlockedOnMVarRead) {
+        q = StgMVarTSOQueue_link(q);
+        goto loop;
+    }
+
+    ASSERT(why_blocked == BlockedOnMVar);
+
+    unlockClosure(mvar, info);
     return ();
 }
 
@@ -1445,29 +1453,25 @@ stg_tryPutMVarzh ( P_ mvar, /* :: MVar a */
 {
     W_ info, tso, q;
 
-#if defined(THREADED_RTS)
-    ("ptr" info) = ccall lockClosure(mvar "ptr");
-#else
-    info = GET_INFO(mvar);
-#endif
+    LOCK_CLOSURE(mvar, info);
 
     if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
 #if defined(THREADED_RTS)
-    	unlockClosure(mvar, info);
+        unlockClosure(mvar, info);
 #endif
-	return (0);
-    }
-  
-    if (info == stg_MVAR_CLEAN_info) {
-        ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        return (0);
     }
 
     q = StgMVar_head(mvar);
 loop:
     if (q == stg_END_TSO_QUEUE_closure) {
-	/* No further takes, the MVar is now full. */
-	StgMVar_value(mvar) = val;
-    	unlockClosure(mvar, stg_MVAR_DIRTY_info);
+        /* No further takes, the MVar is now full. */
+        if (info == stg_MVAR_CLEAN_info) {
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        }
+
+        StgMVar_value(mvar) = val;
+        unlockClosure(mvar, stg_MVAR_DIRTY_info);
         return (1);
     }
     if (StgHeader_info(q) == stg_IND_info ||
@@ -1477,15 +1481,18 @@ loop:
     }
 
     // There are takeMVar(s) waiting: wake up the first one
-    
+
     tso = StgMVarTSOQueue_tso(q);
     StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
     if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
         StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
     }
 
-    ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
     ASSERT(StgTSO_block_info(tso) == mvar);
+    // save why_blocked here, because waking up the thread destroys
+    // this information
+    W_ why_blocked;
+    why_blocked = TO_W_(StgTSO_why_blocked(tso));
 
     // actually perform the takeMVar
     W_ stack;
@@ -1494,17 +1501,87 @@ loop:
 
     // indicate that the MVar operation has now completed.
     StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
-    
+
     if (TO_W_(StgStack_dirty(stack)) == 0) {
         ccall dirty_STACK(MyCapability() "ptr", stack "ptr");
     }
-    
+
     ccall tryWakeupThread(MyCapability() "ptr", tso);
 
-    unlockClosure(mvar, stg_MVAR_DIRTY_info);
+    // If it was an readMVar, then we can still do work,
+    // so loop back. (XXX: This could take a while)
+    if (why_blocked == BlockedOnMVarRead) {
+        q = StgMVarTSOQueue_link(q);
+        goto loop;
+    }
+
+    ASSERT(why_blocked == BlockedOnMVar);
+
+    unlockClosure(mvar, info);
     return (1);
 }
 
+stg_readMVarzh ( P_ mvar, /* :: MVar a */ )
+{
+    W_ val, info, tso, q;
+
+    LOCK_CLOSURE(mvar, info);
+
+    /* If the MVar is empty, put ourselves on the blocked readers
+     * list and wait until we're woken up.
+     */
+    if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
+
+        if (info == stg_MVAR_CLEAN_info) {
+            ccall dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        }
+
+        ALLOC_PRIM_WITH_CUSTOM_FAILURE
+            (SIZEOF_StgMVarTSOQueue,
+             unlockClosure(mvar, stg_MVAR_DIRTY_info);
+             GC_PRIM_P(stg_readMVarzh, mvar));
+
+        q = Hp - SIZEOF_StgMVarTSOQueue + WDS(1);
+
+        // readMVars are pushed to the front of the queue, so
+        // they get handled immediately
+        SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM);
+        StgMVarTSOQueue_link(q) = StgMVar_head(mvar);
+        StgMVarTSOQueue_tso(q)  = CurrentTSO;
+
+        StgTSO__link(CurrentTSO)       = q;
+        StgTSO_block_info(CurrentTSO)  = mvar;
+        StgTSO_why_blocked(CurrentTSO) = BlockedOnMVarRead::I16;
+        StgMVar_head(mvar) = q;
+
+        if (StgMVar_tail(mvar) == stg_END_TSO_QUEUE_closure) {
+            StgMVar_tail(mvar) = q;
+        }
+
+        jump stg_block_readmvar(mvar);
+    }
+
+    val = StgMVar_value(mvar);
+
+    unlockClosure(mvar, info);
+    return (val);
+}
+
+stg_tryReadMVarzh ( P_ mvar, /* :: MVar a */ )
+{
+    W_ val, info, tso, q;
+
+    LOCK_CLOSURE(mvar, info);
+
+    if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
+        return (0, stg_NO_FINALIZER_closure);
+    }
+
+    val = StgMVar_value(mvar);
+
+    unlockClosure(mvar, info);
+    return (1, val);
+}
 
 /* -----------------------------------------------------------------------------
    Stable pointer primitives
@@ -1566,23 +1643,23 @@ stg_newBCOzh ( P_ instrs,
 
     bco = Hp - bytes + WDS(1);
     SET_HDR(bco, stg_BCO_info, CCCS);
-    
+
     StgBCO_instrs(bco)     = instrs;
     StgBCO_literals(bco)   = literals;
     StgBCO_ptrs(bco)       = ptrs;
     StgBCO_arity(bco)      = HALF_W_(arity);
     StgBCO_size(bco)       = HALF_W_(words);
-    
+
     // Copy the arity/bitmap info into the BCO
     W_ i;
     i = 0;
 for:
     if (i < BYTE_ARR_WDS(bitmap_arr)) {
-	StgBCO_bitmap(bco,i) = StgArrWords_payload(bitmap_arr,i);
-	i = i + 1;
-	goto for;
+        StgBCO_bitmap(bco,i) = StgArrWords_payload(bitmap_arr,i);
+        i = i + 1;
+        goto for;
     }
-    
+
     return (bco);
 }
 
@@ -1602,10 +1679,10 @@ stg_mkApUpd0zh ( P_ bco )
 
     ap = Hp - SIZEOF_StgAP + WDS(1);
     SET_HDR(ap, stg_AP_info, CCCS);
-    
+
     StgAP_n_args(ap) = HALF_W_(0);
     StgAP_fun(ap) = bco;
-    
+
     return (ap);
 }
 
@@ -1625,14 +1702,14 @@ stg_unpackClosurezh ( P_ closure )
         nptrs = 0;
         goto out;
     }
-    case THUNK, THUNK_1_0, THUNK_0_1, THUNK_2_0, THUNK_1_1, 
+    case THUNK, THUNK_1_0, THUNK_0_1, THUNK_2_0, THUNK_1_1,
          THUNK_0_2, THUNK_STATIC, AP, PAP, AP_STACK, BCO : {
         ptrs = 0;
         nptrs = 0;
         goto out;
     }
     default: {
-        ptrs  = TO_W_(%INFO_PTRS(info)); 
+        ptrs  = TO_W_(%INFO_PTRS(info));
         nptrs = TO_W_(%INFO_NPTRS(info));
         goto out;
     }}
@@ -1658,22 +1735,22 @@ out:
     p = 0;
 for:
     if(p < ptrs) {
-    	 W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(clos,p);
-	 p = p + 1;
-	 goto for;
+         W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(clos,p);
+         p = p + 1;
+         goto for;
     }
     /* We can leave the card table uninitialised, since the array is
        allocated in the nursery.  The GC will fill it in if/when the array
        is promoted. */
-    
+
     SET_HDR(nptrs_arr, stg_ARR_WORDS_info, CCCS);
     StgArrWords_bytes(nptrs_arr) = WDS(nptrs);
     p = 0;
 for2:
     if(p < nptrs) {
-    	 W_[BYTE_ARR_CTS(nptrs_arr) + WDS(p)] = StgClosure_payload(clos, p+ptrs);
-    	 p = p + 1;
-	 goto for2;
+         W_[BYTE_ARR_CTS(nptrs_arr) + WDS(p)] = StgClosure_payload(clos, p+ptrs);
+         p = p + 1;
+         goto for2;
     }
     return (info, ptrs_arr, nptrs_arr);
 }
@@ -1685,13 +1762,13 @@ for2:
 /* Add a thread to the end of the blocked queue. (C-- version of the C
  * macro in Schedule.h).
  */
-#define APPEND_TO_BLOCKED_QUEUE(tso)			\
-    ASSERT(StgTSO__link(tso) == END_TSO_QUEUE);		\
-    if (W_[blocked_queue_hd] == END_TSO_QUEUE) {	\
-      W_[blocked_queue_hd] = tso;			\
-    } else {						\
+#define APPEND_TO_BLOCKED_QUEUE(tso)                    \
+    ASSERT(StgTSO__link(tso) == END_TSO_QUEUE);         \
+    if (W_[blocked_queue_hd] == END_TSO_QUEUE) {        \
+      W_[blocked_queue_hd] = tso;                       \
+    } else {                                            \
       ccall setTSOLink(MyCapability() "ptr", W_[blocked_queue_tl] "ptr", tso); \
-    }							\
+    }                                                   \
     W_[blocked_queue_tl] = tso;
 
 stg_waitReadzh ( W_ fd )
@@ -1748,7 +1825,7 @@ stg_delayzh ( W_ us_delay )
 
     /* could probably allocate this on the heap instead */
     ("ptr" ares) = ccall stgMallocBytes(SIZEOF_StgAsyncIOResult,
-					    stg_delayzh_malloc_str);
+                                        stg_delayzh_malloc_str);
     (reqID) = ccall addDelayRequest(us_delay);
     StgAsyncIOResult_reqID(ares)   = reqID;
     StgAsyncIOResult_len(ares)     = 0;
@@ -1775,14 +1852,14 @@ stg_delayzh ( W_ us_delay )
     t = W_[sleeping_queue];
 while:
     if (t != END_TSO_QUEUE && StgTSO_block_info(t) < target) {
-	prev = t;
-	t = StgTSO__link(t);
-	goto while;
+        prev = t;
+        t = StgTSO__link(t);
+        goto while;
     }
 
     StgTSO__link(CurrentTSO) = t;
     if (prev == NULL) {
-	W_[sleeping_queue] = CurrentTSO;
+        W_[sleeping_queue] = CurrentTSO;
     } else {
         ccall setTSOLink(MyCapability() "ptr", prev "ptr", CurrentTSO);
     }
@@ -1896,7 +1973,7 @@ stg_asyncDoProczh ( W_ proc, W_ param )
  *   |    -------+-----> A <-------+-------        |
  *   |  update   |   BLACKHOLE     | marked_update |
  *   +-----------+                 +---------------+
- *   |           |                 |               | 
+ *   |           |                 |               |
  *        ...                             ...
  *   |           |                 +---------------+
  *   +-----------+
@@ -1941,7 +2018,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */
     SAVE_THREAD_STATE();
     ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
     ccall threadPaused (MyCapability() "ptr", CurrentTSO "ptr");
-    
+
     if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
         jump stg_threadFinished [];
     } else {
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 11f518a87d..edc4a91193 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -294,6 +294,7 @@ check_target:
     }
 
     case BlockedOnMVar:
+    case BlockedOnMVarRead:
     {
 	/*
 	  To establish ownership of this TSO, we need to acquire a
@@ -318,7 +319,7 @@ check_target:
 
         // we have the MVar, let's check whether the thread
 	// is still blocked on the same MVar.
-	if (target->why_blocked != BlockedOnMVar
+	if ((target->why_blocked != BlockedOnMVar && target->why_blocked != BlockedOnMVarRead)
 	    || (StgMVar *)target->block_info.closure != mvar) {
 	    unlockClosure((StgClosure *)mvar, info);
 	    goto retry;
@@ -637,6 +638,7 @@ removeFromQueues(Capability *cap, StgTSO *tso)
     goto done;
 
   case BlockedOnMVar:
+  case BlockedOnMVarRead:
       removeFromMVarBlockedQueue(tso);
       goto done;
 
diff --git a/rts/RaiseAsync.h b/rts/RaiseAsync.h
index 336ab30e33..d804f6bc64 100644
--- a/rts/RaiseAsync.h
+++ b/rts/RaiseAsync.h
@@ -49,6 +49,7 @@ interruptible(StgTSO *t)
 {
   switch (t->why_blocked) {
   case BlockedOnMVar:
+  case BlockedOnMVarRead:
   case BlockedOnMsgThrowTo:
   case BlockedOnRead:
   case BlockedOnWrite:
diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 4e7ed3e222..dc21149d98 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -1672,6 +1672,7 @@ inner_loop:
         retainClosure(tso->bq,                 c, c_child_r);
         retainClosure(tso->trec,               c, c_child_r);
         if (   tso->why_blocked == BlockedOnMVar
+               || tso->why_blocked == BlockedOnMVarRead
                || tso->why_blocked == BlockedOnBlackHole
                || tso->why_blocked == BlockedOnMsgThrowTo
             ) {
@@ -1767,9 +1768,12 @@ computeRetainerSet( void )
     //
     // The following code assumes that WEAK objects are considered to be roots
     // for retainer profilng.
-    for (weak = weak_ptr_list; weak != NULL; weak = weak->link)
-	// retainRoot((StgClosure *)weak);
-	retainRoot(NULL, (StgClosure **)&weak);
+    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+        for (weak = generations[g].weak_ptr_list; weak != NULL; weak = weak->link) {
+            // retainRoot((StgClosure *)weak);
+            retainRoot(NULL, (StgClosure **)&weak);
+        }
+    }
 
     // Consider roots from the stable ptr table.
     markStableTables(retainRoot, NULL);
diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index ec19b169b6..720b732323 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -522,7 +522,16 @@ rts_checkSchedStatus (char* site, Capability *cap)
 	stg_exit(EXIT_FAILURE);
     case Interrupted:
 	errorBelch("%s: interrupted", site);
-	stg_exit(EXIT_FAILURE);
+#ifdef THREADED_RTS
+        // The RTS is shutting down, and the process will probably
+        // soon exit.  We don't want to preempt the shutdown
+        // by exiting the whole process here, so we just terminate the
+        // current thread.  Don't forget to release the cap first though.
+        rts_unlock(cap);
+        shutdownThread();
+#else
+        stg_exit(EXIT_FAILURE);
+#endif
     default:
 	errorBelch("%s: Return code (%d) not ok",(site),(rc));	
 	stg_exit(EXIT_FAILURE);
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 3f38c8ac1f..1e541a0201 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -52,7 +52,7 @@ wchar_t **win32_prog_argv = NULL;
 #endif
 
 /*
- * constants, used later 
+ * constants, used later
  */
 #define RTS 1
 #define PGM 0
@@ -111,9 +111,6 @@ void initRtsFlagsDefaults(void)
     RtsFlags.GcFlags.compact            = rtsFalse;
     RtsFlags.GcFlags.compactThreshold   = 30.0;
     RtsFlags.GcFlags.sweep              = rtsFalse;
-#ifdef RTS_GTK_FRONTPANEL
-    RtsFlags.GcFlags.frontpanel         = rtsFalse;
-#endif
     RtsFlags.GcFlags.idleGCDelayTime    = USToTime(300000); // 300ms
 #ifdef THREADED_RTS
     RtsFlags.GcFlags.doIdleGC           = rtsTrue;
@@ -260,9 +257,6 @@ usage_text[] = {
 "  -t[<file>] One-line GC statistics (if <file> omitted, uses stderr)",
 "  -s[<file>] Summary  GC statistics (if <file> omitted, uses stderr)",
 "  -S[<file>] Detailed GC statistics (if <file> omitted, uses stderr)",
-#ifdef RTS_GTK_FRONTPANEL
-"  -f       Display front panel (requires X11 & GTK+)",
-#endif
 "",
 "",
 "  -Z       Don't squeeze out update frames on stack overflow",
@@ -292,7 +286,7 @@ usage_text[] = {
 "    -hb<bio>...  closures with specified biographies (lag,drag,void,use)",
 "",
 "  -R<size>       Set the maximum retainer set size (default: 8)",
-"", 
+"",
 "  -L<chars>      Maximum length of a cost-centre stack in a heap profile",
 "                 (default: 25)",
 "",
@@ -438,9 +432,9 @@ static void splitRtsFlags(const char *s)
 	while (isspace(*c1)) { c1++; };
 	c2 = c1;
 	while (!isspace(*c2) && *c2 != '\0') { c2++; };
-	
+
 	if (c1 == c2) { break; }
-	
+
         t = stgMallocBytes(c2-c1+1, "RtsFlags.c:splitRtsFlags()");
         strncpy(t, c1, c2-c1);
         t[c2-c1] = '\0';
@@ -449,7 +443,7 @@ static void splitRtsFlags(const char *s)
 	c1 = c2;
     } while (*c1 != '\0');
 }
-    
+
 /* -----------------------------------------------------------------------------
    Parse the command line arguments, collecting options for the RTS.
 
@@ -780,15 +774,15 @@ error = rtsTrue;
 	      case 'F':
         	OPTION_UNSAFE;
 	        RtsFlags.GcFlags.oldGenFactor = atof(rts_argv[arg]+2);
-	      
+
 		if (RtsFlags.GcFlags.oldGenFactor < 0)
 		  bad_option( rts_argv[arg] );
 		break;
-	      
+
 	      case 'D':
               OPTION_SAFE;
               DEBUG_BUILD_ONLY(
-	      { 
+	      {
 		  char *c;
 
 		  for (c  = rts_argv[arg] + 2; *c != '\0'; c++) {
@@ -908,13 +902,6 @@ error = rtsTrue;
                   }
                   break;
 
-#ifdef RTS_GTK_FRONTPANEL
-	      case 'f':
-        	  OPTION_UNSAFE;
-		  RtsFlags.GcFlags.frontpanel = rtsTrue;
-		  break;
-#endif
-
     	      case 'I':	/* idle GC delay */
         	OPTION_UNSAFE;
 		if (rts_argv[arg][2] == '\0') {
@@ -951,7 +938,7 @@ error = rtsTrue;
 		  goto stats;
 
 	    stats:
-		{ 
+		{
 		    int r;
 		    if (rts_argv[arg][2] != '\0') {
 		      OPTION_UNSAFE;
@@ -1060,7 +1047,7 @@ error = rtsTrue;
 				RtsFlags.ProfFlags.modSelector = left;
 				break;
 			    case 'D':
-			    case 'd': // closure descr select 
+			    case 'd': // closure descr select
 				RtsFlags.ProfFlags.descrSelector = left;
 				break;
 			    case 'Y':
@@ -1114,12 +1101,12 @@ error = rtsTrue;
 			  break;
 		    }
 		    break;
-		      
+
 		default:
 		    errorBelch("invalid heap profile option: %s",rts_argv[arg]);
 		    error = rtsTrue;
 		}
-		) 
+		)
 #endif /* PROFILING */
     	    	break;
 
@@ -1266,7 +1253,7 @@ error = rtsTrue;
 
 		RtsFlags.TickyFlags.showTickyStats = rtsTrue;
 
-		{ 
+		{
 		    int r;
 		    if (rts_argv[arg][2] != '\0') {
 		      OPTION_UNSAFE;
@@ -1426,7 +1413,7 @@ static void normaliseRtsOpts (void)
 
     if (RtsFlags.ProfFlags.heapProfileInterval > 0) {
         RtsFlags.ProfFlags.heapProfileIntervalTicks =
-            RtsFlags.ProfFlags.heapProfileInterval / 
+            RtsFlags.ProfFlags.heapProfileInterval /
             RtsFlags.MiscFlags.tickInterval;
     } else {
         RtsFlags.ProfFlags.heapProfileIntervalTicks = 0;
@@ -1538,7 +1525,7 @@ decodeSize(const char *flag, nat offset, StgWord64 min, StgWord64 max)
         m = atof(s);
         c = s[strlen(s)-1];
 
-        if (c == 'g' || c == 'G') 
+        if (c == 'g' || c == 'G')
             m *= 1024*1024*1024;
         else if (c == 'm' || c == 'M')
             m *= 1024*1024;
@@ -1801,7 +1788,7 @@ void
 setWin32ProgArgv(int argc, wchar_t *argv[])
 {
 	int i;
-    
+
 	freeWin32ProgArgv();
 
     win32_prog_argc = argc;
@@ -1809,7 +1796,7 @@ setWin32ProgArgv(int argc, wchar_t *argv[])
 		win32_prog_argv = NULL;
 		return;
 	}
-	
+
     win32_prog_argv = stgCallocBytes(argc + 1, sizeof (wchar_t *),
                                     "setWin32ProgArgv 1");
     for (i = 0; i < argc; i++) {
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 7b7d488e2b..39c5ef1f94 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -38,10 +38,6 @@
 #include "FileLock.h"
 void exitLinker( void );	// there is no Linker.h file to include
 
-#if defined(RTS_GTK_FRONTPANEL)
-#include "FrontPanel.h"
-#endif
-
 #if defined(PROFILING)
 # include "ProfHeap.h"
 # include "RetainerProfile.h"
@@ -237,17 +233,11 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
         initDefaultHandlers();
     }
 #endif
- 
+
 #if defined(mingw32_HOST_OS) && !defined(THREADED_RTS)
     startupAsyncIO();
 #endif
 
-#ifdef RTS_GTK_FRONTPANEL
-    if (RtsFlags.GcFlags.frontpanel) {
-	initFrontPanel();
-    }
-#endif
-
 #if X86_INIT_FPU
     x86_init_fpu();
 #endif
@@ -293,7 +283,7 @@ hs_add_root(void (*init_root)(void) STG_UNUSED)
  *       False ==> threads doing foreign calls may return in the
  *                 future, but will immediately block on a mutex.
  *                 (capability->lock).
- * 
+ *
  * If this RTS is a DLL that we're about to unload, then you want
  * safe=True, otherwise the thread might return to code that has been
  * unloaded.  If this is a standalone program that is about to exit,
@@ -305,6 +295,8 @@ hs_add_root(void (*init_root)(void) STG_UNUSED)
 static void
 hs_exit_(rtsBool wait_foreign)
 {
+    nat g;
+
     if (hs_init_count <= 0) {
 	errorBelch("warning: too many hs_exit()s");
 	return;
@@ -317,7 +309,7 @@ hs_exit_(rtsBool wait_foreign)
 
     /* start timing the shutdown */
     stat_startExit();
-    
+
     OnExitHook();
 
     flushStdHandles();
@@ -335,8 +327,10 @@ hs_exit_(rtsBool wait_foreign)
     exitScheduler(wait_foreign);
 
     /* run C finalizers for all active weak pointers */
-    runAllCFinalizers(weak_ptr_list);
-    
+    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+        runAllCFinalizers(generations[g].weak_ptr_list);
+    }
+
 #if defined(RTS_USER_SIGNALS)
     if (RtsFlags.MiscFlags.install_signal_handlers) {
         freeSignalHandlers();
@@ -348,7 +342,7 @@ hs_exit_(rtsBool wait_foreign)
     exitTimer(wait_foreign);
 
     // set the terminal settings back to what they were
-#if !defined(mingw32_HOST_OS)    
+#if !defined(mingw32_HOST_OS)
     resetTerminalSettings();
 #endif
 
@@ -357,14 +351,14 @@ hs_exit_(rtsBool wait_foreign)
 
     /* stop timing the shutdown, we're about to print stats */
     stat_endExit();
-    
+
     /* shutdown the hpc support (if needed) */
     exitHpc();
 
     // clean up things from the storage manager's point of view.
     // also outputs the stats (+RTS -s) info.
     exitStorage();
-    
+
     /* free the tasks */
     freeScheduler();
 
@@ -385,13 +379,7 @@ hs_exit_(rtsBool wait_foreign)
     freeThreadLabelTable();
 #endif
 
-#ifdef RTS_GTK_FRONTPANEL
-    if (RtsFlags.GcFlags.frontpanel) {
-	stopFrontPanel();
-    }
-#endif
-
-#if defined(PROFILING) 
+#if defined(PROFILING)
     reportCCSProfiling();
 #endif
 
@@ -479,15 +467,15 @@ shutdownHaskellAndSignal(int sig)
 }
 #endif
 
-/* 
+/*
  * called from STG-land to exit the program
  */
 
 void (*exitFn)(int) = 0;
 
-void  
+void
 stg_exit(int n)
-{ 
+{
   if (exitFn)
     (*exitFn)(n);
   exit(n);
diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c
index fcbb757c05..cb9002c361 100644
--- a/rts/RtsUtils.c
+++ b/rts/RtsUtils.c
@@ -137,26 +137,6 @@ heapOverflow(void)
 }
 
 /* -----------------------------------------------------------------------------
-   genSym stuff, used by GHC itself for its splitting unique supply.
-
-   ToDo: put this somewhere sensible.
-   -------------------------------------------------------------------------  */
-
-static HsInt __GenSymCounter = 0;
-
-HsInt
-genSymZh(void)
-{
-    return(__GenSymCounter++);
-}
-HsInt
-resetGenSymZh(void) /* it's your funeral */
-{
-    __GenSymCounter=0;
-    return(__GenSymCounter);
-}
-
-/* -----------------------------------------------------------------------------
    Get the current time as a string.  Used in profiling reports.
    -------------------------------------------------------------------------- */
 
diff --git a/rts/STM.c b/rts/STM.c
index eee0f46bbc..8f4bdfbecb 100644
--- a/rts/STM.c
+++ b/rts/STM.c
@@ -905,8 +905,12 @@ static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
       s = e -> tvar;
       if (entry_is_read_only(e)) {
         TRACE("%p : check_read_only for TVar %p, saw %ld", trec, s, e -> num_updates);
-        if (s -> num_updates != e -> num_updates) {
-          // ||s -> current_value != e -> expected_value) {
+        
+        // Note we need both checks and in this order as the TVar could be
+        // locked by another transaction that is committing but has not yet
+        // incremented `num_updates` (See #7815).
+        if (s -> current_value != e -> expected_value ||
+            s -> num_updates != e -> num_updates) {
           TRACE("%p : mismatch", trec);
           result = FALSE;
           BREAK_FOR_EACH;
diff --git a/rts/Schedule.c b/rts/Schedule.c
index abd317cc62..408146f195 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -947,6 +947,7 @@ scheduleDetectDeadlock (Capability **pcap, Task *task)
 	    case BlockedOnBlackHole:
 	    case BlockedOnMsgThrowTo:
 	    case BlockedOnMVar:
+	    case BlockedOnMVarRead:
 		throwToSingleThreaded(cap, task->incall->tso, 
 				      (StgClosure *)nonTermination_closure);
 		return;
@@ -1437,7 +1438,7 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS,
     rtsBool heap_census;
     nat collect_gen;
 #ifdef THREADED_RTS
-    rtsBool gc_type;
+    StgWord8 gc_type;
     nat i, sync;
     StgTSO *tso;
 #endif
@@ -2722,7 +2723,19 @@ raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception)
             tso->stackobj->sp = p;
 	    return STOP_FRAME;
 
-        case CATCH_RETRY_FRAME:
+        case CATCH_RETRY_FRAME: {
+            StgTRecHeader *trec = tso -> trec;
+            StgTRecHeader *outer = trec -> enclosing_trec;
+            debugTrace(DEBUG_stm,
+                       "found CATCH_RETRY_FRAME at %p during raise", p);
+            debugTrace(DEBUG_stm, "trec=%p outer=%p", trec, outer);
+            stmAbortTransaction(cap, trec);
+            stmFreeAbortedTRec(cap, trec);
+            tso -> trec = outer;
+            p = next;
+            continue;
+        }
+
 	default:
 	    p = next; 
 	    continue;
@@ -2831,6 +2844,7 @@ resurrectThreads (StgTSO *threads)
 	
 	switch (tso->why_blocked) {
 	case BlockedOnMVar:
+	case BlockedOnMVarRead:
 	    /* Called by GC - sched_mutex lock is currently held. */
 	    throwToSingleThreaded(cap, tso,
 				  (StgClosure *)blockedIndefinitelyOnMVar_closure);
diff --git a/rts/StgCRun.c b/rts/StgCRun.c
index f0fa6c7c5e..a45c52fd02 100644
--- a/rts/StgCRun.c
+++ b/rts/StgCRun.c
@@ -118,8 +118,10 @@ StgWord8 *win32AllocStack(void)
 
 #ifdef darwin_HOST_OS
 #define STG_GLOBAL ".globl "
+#define STG_HIDDEN ".private_extern "
 #else
 #define STG_GLOBAL ".global "
+#define STG_HIDDEN ".hidden "
 #endif
 
 /*
@@ -164,6 +166,9 @@ StgRunIsImplementedInAssembler(void)
 {
     __asm__ volatile (
         STG_GLOBAL STG_RUN "\n"
+#if !defined(mingw32_HOST_OS)
+        STG_HIDDEN STG_RUN "\n"
+#endif
         STG_RUN ":\n\t"
 
         /*
@@ -236,7 +241,13 @@ StgRunIsImplementedInAssembler(void)
 
 #ifdef x86_64_HOST_ARCH
 
-extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
+#define STG_GLOBAL ".globl "
+
+#ifdef darwin_HOST_OS
+#define STG_HIDDEN ".private_extern "
+#else
+#define STG_HIDDEN ".hidden "
+#endif
 
 static void GNUC3_ATTRIBUTE(used)
 StgRunIsImplementedInAssembler(void)
@@ -245,7 +256,10 @@ StgRunIsImplementedInAssembler(void)
         /*
          * save callee-saves registers on behalf of the STG code.
          */
-        ".globl " STG_RUN "\n"
+        STG_GLOBAL STG_RUN "\n"
+#if !defined(mingw32_HOST_OS)
+        STG_HIDDEN STG_RUN "\n"
+#endif
         STG_RUN ":\n\t"
         "subq %1, %%rsp\n\t"
         "movq %%rsp, %%rax\n\t"
@@ -400,7 +414,13 @@ StgRun(StgFunPtr f, StgRegTable *basereg) {
 
 #ifdef powerpc_HOST_ARCH
 
-extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
+#define STG_GLOBAL ".globl "
+
+#ifdef darwin_HOST_OS
+#define STG_HIDDEN ".private_extern "
+#else
+#define STG_HIDDEN ".hidden "
+#endif
 
 #ifdef darwin_HOST_OS
 void StgRunIsImplementedInAssembler(void)
@@ -408,11 +428,12 @@ void StgRunIsImplementedInAssembler(void)
 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
             // if the toolchain supports deadstripping, we have to
             // prevent it here (it tends to get confused here).
-        __asm__ volatile (".no_dead_strip _StgRunIsImplementedInAssembler");
+        __asm__ volatile (".no_dead_strip _StgRunIsImplementedInAssembler\n");
 #endif
         __asm__ volatile (
-                "\n.globl _StgRun\n"
-                "_StgRun:\n"
+                STG_GLOBAL STG_RUN "\n"
+                STG_HIDDEN STG_RUN "\n"
+                STG_RUN ":\n"
                 "\tmflr r0\n"
                 "\tbl saveFP # f14\n"
                 "\tstmw r13,-220(r1)\n"
@@ -446,6 +467,7 @@ StgRunIsImplementedInAssembler(void)
 {
         __asm__ volatile (
                 "\t.globl StgRun\n"
+                "\t.hidden StgRun\n"
                 "\t.type StgRun,@function\n"
                 "StgRun:\n"
                 "\tmflr 0\n"
@@ -518,8 +540,6 @@ StgRunIsImplementedInAssembler(void)
 #ifdef powerpc64_HOST_ARCH
 
 #ifdef linux_HOST_OS
-extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
-
 static void GNUC3_ATTRIBUTE(used)
 StgRunIsImplementedInAssembler(void)
 {
@@ -534,6 +554,7 @@ StgRunIsImplementedInAssembler(void)
                 ".section \".opd\",\"aw\"\n"
                 ".align 3\n"
                 ".globl StgRun\n"
+                ".hidden StgRun\n"
                 "StgRun:\n"
                 "\t.quad\t.StgRun,.TOC.@tocbase,0\n"
                 "\t.size StgRun,24\n"
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 28a41ad681..9484031832 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -439,6 +439,15 @@ INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,5,0,CONSTR,"DEAD_WEAK","DEAD_WEAK")
 { foreign "C" barf("DEAD_WEAK object entered!") never returns; }
 
 /* ----------------------------------------------------------------------------
+   C finalizer lists
+
+   Singly linked lists that chain multiple C finalizers on a weak pointer.
+   ------------------------------------------------------------------------- */
+
+INFO_TABLE_CONSTR(stg_C_FINALIZER_LIST,1,4,0,CONSTR,"C_FINALIZER_LIST","C_FINALIZER_LIST")
+{ foreign "C" barf("C_FINALIZER_LIST object entered!") never returns; }
+
+/* ----------------------------------------------------------------------------
    NO_FINALIZER
 
    This is a static nullary constructor (like []) that we use to mark an empty
diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c
index e523f328c3..3b80d6f388 100644
--- a/rts/StgPrimFloat.c
+++ b/rts/StgPrimFloat.c
@@ -43,29 +43,6 @@
 
 #define __abs(a)		(( (a) >= 0 ) ? (a) : (-(a)))
 
-StgDouble
-__2Int_encodeDouble (I_ j_high, I_ j_low, I_ e)
-{
-  StgDouble r;
-  
-  /* assuming 32 bit ints */
-  ASSERT(sizeof(int          ) == 4            );
-
-  r = (StgDouble)((unsigned int)j_high);
-  r *= 4294967296.0; /* exp2f(32); */
-  r += (StgDouble)((unsigned int)j_low);
-  
-  /* Now raise to the exponent */
-  if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
-    r = ldexp(r, e);
-  
-  /* sign is encoded in the size */
-  if (j_high < 0)
-    r = -r;
-  
-  return r;
-}
-
 /* Special version for words */
 StgDouble
 __word_encodeDouble (W_ j, I_ e)
diff --git a/rts/StgPrimFloat.h b/rts/StgPrimFloat.h
index cd5da46326..edd7b472b7 100644
--- a/rts/StgPrimFloat.h
+++ b/rts/StgPrimFloat.h
@@ -14,11 +14,8 @@
 /* grimy low-level support functions defined in StgPrimFloat.c */
 void      __decodeDouble_2Int (I_ *man_sign, W_ *man_high, W_ *man_low, I_ *exp, StgDouble dbl);
 void      __decodeFloat_Int (I_ *man, I_ *exp, StgFloat flt);
-StgDouble __2Int_encodeDouble (I_ j_high, I_ j_low, I_ e);
-StgDouble __word_encodeDouble (W_ j, I_ e);
-StgFloat  __word_encodeFloat (W_ j, I_ e);
 
-// __int_encodeDouble and __int_encodeFloat are public, declared in 
+// __{int,word}_encode{Float,Double} are public, declared in 
 // includes/rts/PrimFloat.h.
 
 #include "EndPrivate.h"
diff --git a/rts/StgStdThunks.cmm b/rts/StgStdThunks.cmm
index 53e4cb1d23..979f7498ca 100644
--- a/rts/StgStdThunks.cmm
+++ b/rts/StgStdThunks.cmm
@@ -111,10 +111,10 @@ SELECTOR_CODE_UPD(15)
       UPD_BH_UPDATABLE(node);                                           \
       LDV_ENTER(node);                                                  \
       selectee = StgThunk_payload(node,0);                              \
+      ENTER_CCS_THUNK(node);                                            \
       if (NEED_EVAL(selectee)) {                                        \
-          ENTER_CCS_THUNK(node);                                        \
           SAVE_CCS;                                                     \
-          (P_ constr) = call %GET_ENTRY(selectee) (selectee);           \
+          (P_ constr) = call %GET_ENTRY(UNTAG_IF_PROF(selectee)) (selectee);           \
           RESTORE_CCS;                                                  \
           selectee = constr;                                            \
       }                                                                 \
diff --git a/rts/Threads.c b/rts/Threads.c
index b6176163ad..f2b800512e 100644
--- a/rts/Threads.c
+++ b/rts/Threads.c
@@ -84,7 +84,7 @@ createThread(Capability *cap, W_ size)
     stack_size = round_to_mblocks(size - sizeofW(StgTSO));
     stack = (StgStack *)allocate(cap, stack_size);
     TICK_ALLOC_STACK(stack_size);
-    SET_HDR(stack, &stg_STACK_info, CCS_SYSTEM);
+    SET_HDR(stack, &stg_STACK_info, cap->r.rCCCS);
     stack->stack_size   = stack_size - sizeofW(StgStack);
     stack->sp           = stack->stack + stack->stack_size;
     stack->dirty        = 1;
@@ -255,6 +255,7 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
     switch (tso->why_blocked)
     {
     case BlockedOnMVar:
+    case BlockedOnMVarRead:
     {
         if (tso->_link == END_TSO_QUEUE) {
             tso->block_info.closure = (StgClosure*)END_TSO_QUEUE;
@@ -575,7 +576,7 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
                   chunk_size * sizeof(W_));
 
     new_stack = (StgStack*) allocate(cap, chunk_size);
-    SET_HDR(new_stack, &stg_STACK_info, CCS_SYSTEM);
+    SET_HDR(new_stack, &stg_STACK_info, old_stack->header.prof.ccs);
     TICK_ALLOC_STACK(chunk_size);
 
     new_stack->dirty = 0; // begin clean, we'll mark it dirty below
@@ -734,6 +735,9 @@ printThreadBlockage(StgTSO *tso)
   case BlockedOnMVar:
     debugBelch("is blocked on an MVar @ %p", tso->block_info.closure);
     break;
+  case BlockedOnMVarRead:
+    debugBelch("is blocked on atomic MVar read @ %p", tso->block_info.closure);
+    break;
   case BlockedOnBlackHole:
       debugBelch("is blocked on a black hole %p", 
                  ((StgBlockingQueue*)tso->block_info.bh->bh));
diff --git a/rts/Ticky.c b/rts/Ticky.c
index 0d33c43d79..e1e981b6df 100644
--- a/rts/Ticky.c
+++ b/rts/Ticky.c
@@ -75,7 +75,8 @@ PrintTickyInfo(void)
 	tot_adm_wds + tot_gds_wds + tot_slp_wds;
 #endif
 
-  unsigned long tot_thk_enters = ENT_STATIC_THK_ctr + ENT_DYN_THK_ctr;
+  unsigned long tot_thk_enters = ENT_STATIC_THK_MANY_ctr + ENT_DYN_THK_MANY_ctr
+                               + ENT_STATIC_THK_SINGLE_ctr + ENT_DYN_THK_SINGLE_ctr;
   unsigned long tot_con_enters = ENT_STATIC_CON_ctr + ENT_DYN_CON_ctr;
 
   unsigned long tot_fun_direct_enters = ENT_STATIC_FUN_DIRECT_ctr + ENT_DYN_FUN_DIRECT_ctr;
@@ -452,8 +453,12 @@ PrintTickyInfo(void)
   PR_CTR(ENT_PAP_ctr);
   PR_CTR(ENT_AP_STACK_ctr);
   PR_CTR(ENT_BH_ctr);
-  PR_CTR(ENT_STATIC_THK_ctr);
-  PR_CTR(ENT_DYN_THK_ctr);
+  PR_CTR(ENT_STATIC_THK_SINGLE_ctr);
+  PR_CTR(ENT_STATIC_THK_MANY_ctr);
+  PR_CTR(ENT_DYN_THK_SINGLE_ctr);
+  PR_CTR(ENT_DYN_THK_MANY_ctr);
+  PR_CTR(UPD_CAF_BH_UPDATABLE_ctr);
+  PR_CTR(UPD_CAF_BH_SINGLE_ENTRY_ctr);
 
   PR_CTR(SLOW_CALL_fast_v16_ctr);
   PR_CTR(SLOW_CALL_fast_v_ctr);
@@ -547,10 +552,6 @@ PrintTickyInfo(void)
   PR_CTR(UPD_PAP_IN_NEW_ctr);
   PR_CTR(UPD_PAP_IN_PLACE_ctr);
 
-  PR_CTR(UPD_BH_UPDATABLE_ctr);
-  PR_CTR(UPD_BH_SINGLE_ENTRY_ctr);
-  PR_CTR(UPD_CAF_BH_UPDATABLE_ctr);
-  PR_CTR(UPD_CAF_BH_SINGLE_ENTRY_ctr);
 
   /* krc: put off till later...*/
 #if FALSE
diff --git a/rts/Trace.c b/rts/Trace.c
index 78dfead450..21901891cb 100644
--- a/rts/Trace.c
+++ b/rts/Trace.c
@@ -179,6 +179,7 @@ static char *thread_stop_reasons[] = {
     [ThreadFinished] = "finished",
     [THREAD_SUSPENDED_FOREIGN_CALL] = "suspended while making a foreign call",
     [6 + BlockedOnMVar]         = "blocked on an MVar",
+    [6 + BlockedOnMVarRead]     = "blocked on an atomic MVar read",
     [6 + BlockedOnBlackHole]    = "blocked on a black hole",
     [6 + BlockedOnRead]         = "blocked on a read operation",
     [6 + BlockedOnWrite]        = "blocked on a write operation",
diff --git a/rts/Weak.c b/rts/Weak.c
index 5546514243..98ac7603b7 100644
--- a/rts/Weak.c
+++ b/rts/Weak.c
@@ -16,18 +16,19 @@
 #include "Prelude.h"
 #include "Trace.h"
 
-// ForeignPtrs with C finalizers rely on weak pointers inside weak_ptr_list
-// to always be in the same order.
-
-StgWeak *weak_ptr_list;
-
 void
-runCFinalizer(void *fn, void *ptr, void *env, StgWord flag)
+runCFinalizers(StgCFinalizerList *list)
 {
-    if (flag)
-	((void (*)(void *, void *))fn)(env, ptr);
-    else
-	((void (*)(void *))fn)(ptr);
+    StgCFinalizerList *head;
+    for (head = list;
+        (StgClosure *)head != &stg_NO_FINALIZER_closure;
+        head = (StgCFinalizerList *)head->link)
+    {
+        if (head->flag)
+            ((void (*)(void *, void *))head->fptr)(head->eptr, head->ptr);
+        else
+            ((void (*)(void *))head->fptr)(head->ptr);
+    }
 }
 
 void
@@ -42,15 +43,7 @@ runAllCFinalizers(StgWeak *list)
     }
 
     for (w = list; w; w = w->link) {
-	StgArrWords *farr;
-
-	farr = (StgArrWords *)UNTAG_CLOSURE(w->cfinalizer);
-
-	if ((StgClosure *)farr != &stg_NO_FINALIZER_closure)
-	    runCFinalizer((void *)farr->payload[0],
-	                  (void *)farr->payload[1],
-	                  (void *)farr->payload[2],
-	                  farr->payload[3]);
+	runCFinalizers((StgCFinalizerList *)w->cfinalizers);
     }
 
     if (task != NULL) {
@@ -91,8 +84,6 @@ scheduleFinalizers(Capability *cap, StgWeak *list)
     // count number of finalizers, and kill all the weak pointers first...
     n = 0;
     for (w = list; w; w = w->link) { 
-	StgArrWords *farr;
-
 	// Better not be a DEAD_WEAK at this stage; the garbage
 	// collector removes DEAD_WEAKs from the weak pointer list.
 	ASSERT(w->header.info != &stg_DEAD_WEAK_info);
@@ -101,13 +92,7 @@ scheduleFinalizers(Capability *cap, StgWeak *list)
 	    n++;
 	}
 
-	farr = (StgArrWords *)UNTAG_CLOSURE(w->cfinalizer);
-
-	if ((StgClosure *)farr != &stg_NO_FINALIZER_closure)
-	    runCFinalizer((void *)farr->payload[0],
-	                  (void *)farr->payload[1],
-	                  (void *)farr->payload[2],
-	                  farr->payload[3]);
+	runCFinalizers((StgCFinalizerList *)w->cfinalizers);
 
 #ifdef PROFILING
         // A weak pointer is inherently used, so we do not need to call
diff --git a/rts/Weak.h b/rts/Weak.h
index 9b230f94de..fbdf18a861 100644
--- a/rts/Weak.h
+++ b/rts/Weak.h
@@ -14,9 +14,9 @@
 #include "BeginPrivate.h"
 
 extern rtsBool running_finalizers;
-extern StgWeak * weak_ptr_list;
+extern StgWeak * dead_weak_ptr_list;
 
-void runCFinalizer(void *fn, void *ptr, void *env, StgWord flag);
+void runCFinalizers(StgCFinalizerList *list);
 void runAllCFinalizers(StgWeak *w);
 void scheduleFinalizers(Capability *cap, StgWeak *w);
 void markWeakList(void);
diff --git a/rts/ghc.mk b/rts/ghc.mk
index b7651b09cf..4cc8e8de34 100644
--- a/rts/ghc.mk
+++ b/rts/ghc.mk
@@ -24,7 +24,7 @@ rts_WAYS = $(GhcLibWays) $(filter-out $(GhcLibWays),$(GhcRTSWays))
 rts_dist_WAYS = $(rts_WAYS)
 
 ALL_RTS_LIBS = $(foreach way,$(rts_WAYS),rts/dist/build/libHSrts$($(way)_libsuf))
-all_rts : $(ALL_RTS_LIBS)
+$(eval $(call all-target,rts,$(ALL_RTS_LIBS)))
 
 # -----------------------------------------------------------------------------
 # Defining the sources
@@ -68,10 +68,14 @@ DTRACEPROBES_H = rts/dist/build/RtsProbes.h
 rts_H_FILES += $(DTRACEPROBES_H)
 endif
 
-# collect the -l flags that we need to link the rts dyn lib.
-rts/libs.depend : $$(ghc-pkg_INPLACE)
-	"$(ghc-pkg_INPLACE)" field rts extra-libraries \
-	  | sed -e 's/^extra-libraries: //' -e 's/\([a-z0-9]*\)[ ]*/-l\1 /g' > $@
+# collect the -l and -L flags that we need to link the rts dyn lib.
+# Note that, as sed on OS X doesn't handle \+, we use [^ ][^ ]* rather
+# than [^ ]\+
+rts/dist/libs.depend : $$(ghc-pkg_INPLACE) | $$(dir $$@)/.
+	"$(ghc-pkg_INPLACE)" --simple-output field rts extra-libraries \
+	  | sed -e 's/\([^ ][^ ]*\)/-l\1/g' > $@
+	"$(ghc-pkg_INPLACE)" --simple-output field rts library-dirs \
+	  | sed -e 's/\([^ ][^ ]*\)/-L\1/g' >> $@
 
 
 # ----------------------------------------------------------------------------
@@ -105,13 +109,13 @@ endif
 ifneq "$(BINDIST)" "YES"
 ifneq "$(UseSystemLibFFI)" "YES"
 ifeq "$(HostOS_CPP)" "mingw32" 
-rts/dist/build/libffi.dll: libffi/build/inst/bin/$(LIBFFI_DLL)
+rts/dist/build/$(LIBFFI_DLL): libffi/build/inst/bin/$(LIBFFI_DLL)
 	cp $< $@
 else
 # This is a little hacky. We don't know the SO version, so we only
 # depend on libffi.so, but copy libffi.so*
-rts/dist/build/libffi$(soext): libffi/build/inst/lib/libffi$(soext)
-	cp libffi/build/inst/lib/libffi$(soext)* rts/dist/build
+rts/dist/build/lib$(LIBFFI_NAME)$(soext): libffi/build/inst/lib/lib$(LIBFFI_NAME)$(soext)
+	cp libffi/build/inst/lib/lib$(LIBFFI_NAME)$(soext)* rts/dist/build
 endif
 endif
 endif
@@ -170,7 +174,7 @@ endif
 rts_dist_$1_CC_OPTS += -DRtsWay=\"rts_$1\"
 
 ifneq "$$(UseSystemLibFFI)" "YES"
-rts_dist_FFI_SO = rts/dist/build/libffi$$(soext)
+rts_dist_FFI_SO = rts/dist/build/lib$$(LIBFFI_NAME)$$(soext)
 else
 rts_dist_FFI_SO =
 endif
@@ -178,26 +182,28 @@ endif
 # Making a shared library for the RTS.
 ifneq "$$(findstring dyn, $1)" ""
 ifeq "$$(HostOS_CPP)" "mingw32" 
-$$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) rts/libs.depend rts/dist/build/libffi.dll
+$$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) rts/dist/libs.depend rts/dist/build/$$(LIBFFI_DLL)
 	"$$(RM)" $$(RM_OPTS) $$@
 	"$$(rts_dist_HC)" -package-name rts -shared -dynamic -dynload deploy \
-	  -no-auto-link-packages -Lrts/dist/build -lffi `cat rts/libs.depend` $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) -o $$@
+	  -no-auto-link-packages -Lrts/dist/build -l$$(LIBFFI_NAME) \
+	  `cat rts/dist/libs.depend` $$(rts_$1_OBJS) $$(ALL_RTS_DEF_LIBS) -o $$@
 else
 ifneq "$$(UseSystemLibFFI)" "YES"
-LIBFFI_LIBS = -Lrts/dist/build -lffi 
+LIBFFI_LIBS = -Lrts/dist/build -l$$(LIBFFI_NAME)
 ifeq "$$(TargetElf)" "YES"
-LIBFFI_LIBS += -optl-Wl,-rpath -optl-Wl,'$$$$ORIGIN'
+LIBFFI_LIBS += -optl-Wl,-rpath -optl-Wl,'$$$$ORIGIN' -optl-Wl,-z -optl-Wl,origin
 endif
 
 else
-# flags will be taken care of in rts/libs.depend
+# flags will be taken care of in rts/dist/libs.depend
 LIBFFI_LIBS =
 endif
-$$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) rts/libs.depend $$(rts_dist_FFI_SO)
+$$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS) rts/dist/libs.depend $$(rts_dist_FFI_SO)
 	"$$(RM)" $$(RM_OPTS) $$@
 	"$$(rts_dist_HC)" -package-name rts -shared -dynamic -dynload deploy \
-	  -no-auto-link-packages $$(LIBFFI_LIBS) `cat rts/libs.depend` $$(rts_$1_OBJS) \
+	  -no-auto-link-packages $$(LIBFFI_LIBS) `cat rts/dist/libs.depend` $$(rts_$1_OBJS) \
 	  $$(rts_$1_DTRACE_OBJS) -o $$@
+	$(call relative-dynlib-references,rts,dist,1)
 endif
 else
 $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS)
@@ -206,8 +212,8 @@ $$(rts_$1_LIB) : $$(rts_$1_OBJS) $$(rts_$1_DTRACE_OBJS)
 		$$(AR_OPTS_STAGE1) $$(EXTRA_AR_ARGS_STAGE1) $$@
 
 ifneq "$$(UseSystemLibFFI)" "YES"
-$$(rts_$1_LIB) : rts/dist/build/libCffi$$($1_libsuf)
-rts/dist/build/libCffi$$($1_libsuf): libffi/build/inst/lib/libffi.a
+$$(rts_$1_LIB) : rts/dist/build/libC$$(LIBFFI_NAME)$$($1_libsuf)
+rts/dist/build/libC$$(LIBFFI_NAME)$$($1_libsuf): libffi/build/inst/lib/libffi.a
 	cp $$< $$@
 endif
 
@@ -220,7 +226,7 @@ endef
 # And expand the above for each way:
 $(foreach way,$(rts_WAYS),$(eval $(call build-rts-way,$(way))))
 
-$(eval $(call distdir-opts,rts,dist))
+$(eval $(call distdir-opts,rts,dist,1))
 
 #-----------------------------------------------------------------------------
 # Flags for compiling every file
@@ -418,7 +424,9 @@ rts/win32/ThrIOManager_CC_OPTS += -w
 # for details
 
 # Without this, thread_obj will not be inlined (at least on x86 with GCC 4.1.0)
+ifneq "$(CC_CLANG_BACKEND)" "1"
 rts/sm/Compact_CC_OPTS += -finline-limit=2500
+endif
 
 # -O3 helps unroll some loops (especially in copy() with a constant argument).
 rts/sm/Evac_CC_OPTS += -funroll-loops
@@ -469,7 +477,7 @@ else # UseSystemLibFFI==YES
 
 rts_PACKAGE_CPP_OPTS += -DFFI_INCLUDE_DIR=
 rts_PACKAGE_CPP_OPTS += -DFFI_LIB_DIR=
-rts_PACKAGE_CPP_OPTS += '-DFFI_LIB="Cffi"'
+rts_PACKAGE_CPP_OPTS += '-DFFI_LIB="C$(LIBFFI_NAME)"'
 
 endif
 
@@ -479,9 +487,12 @@ endif
 rts_WAYS_DASHED = $(subst $(space),,$(patsubst %,-%,$(strip $(rts_WAYS))))
 rts_dist_depfile_base = rts/dist/build/.depend$(rts_WAYS_DASHED)
 
-rts_dist_C_SRCS  = $(rts_C_SRCS) $(rts_thr_EXTRA_C_SRCS)
-rts_dist_S_SRCS =  $(rts_S_SRCS)
-rts_dist_C_FILES = $(rts_C_SRCS) $(rts_thr_EXTRA_C_SRCS) $(rts_S_SRCS)
+rts_dist_C_SRCS    = $(rts_C_SRCS) $(rts_thr_EXTRA_C_SRCS)
+rts_dist_S_SRCS    = $(rts_S_SRCS)
+rts_dist_CMM_SRCS  = $(rts_CMM_SRCS)
+rts_dist_C_FILES   = $(rts_dist_C_SRCS)
+rts_dist_S_FILES   = $(rts_dist_S_SRCS)
+rts_dist_CMM_FILES = $(rts_dist_CMM_SRCS)
 
 # Hack: we define every way-related option here, so that we get (hopefully)
 # a superset of the dependencies.  To do this properly, we should generate
@@ -549,8 +560,8 @@ rts/package.conf.inplace : $(includes_H_CONFIG) $(includes_H_PLATFORM)
 
 RTS_INSTALL_LIBS += $(ALL_RTS_LIBS)
 ifneq "$(UseSystemLibFFI)" "YES"
-RTS_INSTALL_LIBS += $(wildcard rts/dist/build/libffi*$(soext)*)
-RTS_INSTALL_LIBS += $(foreach w,$(filter-out %dyn,$(rts_WAYS)),rts/dist/build/libCffi$($w_libsuf))
+RTS_INSTALL_LIBS += $(wildcard rts/dist/build/lib$(LIBFFI_NAME)*$(soext)*)
+RTS_INSTALL_LIBS += $(foreach w,$(filter-out %dyn,$(rts_WAYS)),rts/dist/build/libC$(LIBFFI_NAME)$($w_libsuf))
 endif
 
 ifneq "$(UseSystemLibFFI)" "YES"
diff --git a/rts/package.conf.in b/rts/package.conf.in
index 9aef05dbb5..010305f83d 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -3,12 +3,12 @@
 #include "ghcconfig.h"
 #include "rts/Config.h"
 
-name:		rts
-version:	1.0
+name:           rts
+version:        1.0
 id:             builtin_rts
-license:	BSD3
-maintainer:	glasgow-haskell-users@haskell.org
-exposed:	True
+license:        BSD3
+maintainer:     glasgow-haskell-users@haskell.org
+exposed:        True
 
 exposed-modules:
 hidden-modules:
@@ -16,33 +16,36 @@ hidden-modules:
 import-dirs:
 
 #ifdef INSTALLING
-library-dirs:		LIB_DIR"/rts-1.0" PAPI_LIB_DIR
+library-dirs:           LIB_DIR"/rts-1.0" PAPI_LIB_DIR FFI_LIB_DIR
 #else /* !INSTALLING */
-library-dirs:		TOP"/rts/dist/build" PAPI_LIB_DIR
+library-dirs:           TOP"/rts/dist/build" PAPI_LIB_DIR FFI_LIB_DIR
 #endif
 
 hs-libraries:   "HSrts" FFI_LIB
 
 extra-libraries:
 #ifdef HAVE_LIBM
-                		"m"		/* for ldexp() */
+                                "m"             /* for ldexp() */
 #endif
 #ifdef HAVE_LIBRT
-			      , "rt"
+                              , "rt"
 #endif
 #ifdef HAVE_LIBDL
-			      , "dl"
+                              , "dl"
 #endif
 #ifdef HAVE_LIBFFI
                               , "ffi"
 #endif
 #ifdef mingw32_HOST_OS
-			      ,"wsock32"    /* for the linker */
-			      ,"gdi32"      /* for the linker */
-			      ,"winmm"      /* for the linker */
+                              ,"wsock32"    /* for the linker */
+                              ,"gdi32"      /* for the linker */
+                              ,"winmm"      /* for the linker */
+#endif
+#ifdef freebsd_HOST_OS
+                              , "pthread" /* for pthread_getthreadid_np() */
 #endif
 #if defined(DEBUG) && defined(HAVE_LIBBFD)
-			      ,"bfd", "iberty"	/* for debugging */
+                              ,"bfd", "iberty"  /* for debugging */
 #endif
 #ifdef HAVE_LIBMINGWEX
 # ifndef INSTALLING                             /* Bundled Mingw is behind */
@@ -50,100 +53,100 @@ extra-libraries:
 # endif
 #endif
 #if USE_PAPI
-			     , "papi"
+                             , "papi"
 #endif
 
 #ifdef INSTALLING
-include-dirs:		INCLUDE_DIR PAPI_INCLUDE_DIR
+include-dirs:           INCLUDE_DIR PAPI_INCLUDE_DIR
 #else /* !INSTALLING */
 include-dirs:           TOP"/rts/dist/build" TOP"/includes" TOP"/includes/dist-derivedconstants/header"
 #endif
 
-includes:		Stg.h
+includes:               Stg.h
 hugs-options:
 cc-options:
 
 ld-options:
 #ifdef LEADING_UNDERSCORE
-           "-u", "_ghczmprim_GHCziTypes_Izh_static_info"
-         , "-u", "_ghczmprim_GHCziTypes_Czh_static_info"
-         , "-u", "_ghczmprim_GHCziTypes_Fzh_static_info"
-         , "-u", "_ghczmprim_GHCziTypes_Dzh_static_info"
-         , "-u", "_base_GHCziPtr_Ptr_static_info"
-         , "-u", "_ghczmprim_GHCziTypes_Wzh_static_info"
-         , "-u", "_base_GHCziInt_I8zh_static_info"
-         , "-u", "_base_GHCziInt_I16zh_static_info"
-         , "-u", "_base_GHCziInt_I32zh_static_info"
-         , "-u", "_base_GHCziInt_I64zh_static_info"
-         , "-u", "_base_GHCziWord_W8zh_static_info"
-         , "-u", "_base_GHCziWord_W16zh_static_info"
-         , "-u", "_base_GHCziWord_W32zh_static_info"
-         , "-u", "_base_GHCziWord_W64zh_static_info"
-         , "-u", "_base_GHCziStable_StablePtr_static_info"
-         , "-u", "_ghczmprim_GHCziTypes_Izh_con_info"
-         , "-u", "_ghczmprim_GHCziTypes_Czh_con_info"
-         , "-u", "_ghczmprim_GHCziTypes_Fzh_con_info"
-         , "-u", "_ghczmprim_GHCziTypes_Dzh_con_info"
-         , "-u", "_base_GHCziPtr_Ptr_con_info"
-         , "-u", "_base_GHCziPtr_FunPtr_con_info"
-         , "-u", "_base_GHCziStable_StablePtr_con_info"
-         , "-u", "_ghczmprim_GHCziTypes_False_closure"
-         , "-u", "_ghczmprim_GHCziTypes_True_closure"
-         , "-u", "_base_GHCziPack_unpackCString_closure"
-         , "-u", "_base_GHCziIOziException_stackOverflow_closure"
-         , "-u", "_base_GHCziIOziException_heapOverflow_closure"
-         , "-u", "_base_ControlziExceptionziBase_nonTermination_closure"
-         , "-u", "_base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
-         , "-u", "_base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
-         , "-u", "_base_ControlziExceptionziBase_nestedAtomically_closure"
-         , "-u", "_base_GHCziWeak_runFinalizzerBatch_closure"
-         , "-u", "_base_GHCziTopHandler_flushStdHandles_closure"
-         , "-u", "_base_GHCziTopHandler_runIO_closure"
-         , "-u", "_base_GHCziTopHandler_runNonIO_closure"
-	 , "-u", "_base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
-         , "-u", "_base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
-	 , "-u", "_base_GHCziConcziSync_runSparks_closure"
-	 , "-u", "_base_GHCziConcziSignal_runHandlers_closure"
+           "-Wl,-u,_ghczmprim_GHCziTypes_Izh_static_info"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_Czh_static_info"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_Fzh_static_info"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_Dzh_static_info"
+         , "-Wl,-u,_base_GHCziPtr_Ptr_static_info"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_Wzh_static_info"
+         , "-Wl,-u,_base_GHCziInt_I8zh_static_info"
+         , "-Wl,-u,_base_GHCziInt_I16zh_static_info"
+         , "-Wl,-u,_base_GHCziInt_I32zh_static_info"
+         , "-Wl,-u,_base_GHCziInt_I64zh_static_info"
+         , "-Wl,-u,_base_GHCziWord_W8zh_static_info"
+         , "-Wl,-u,_base_GHCziWord_W16zh_static_info"
+         , "-Wl,-u,_base_GHCziWord_W32zh_static_info"
+         , "-Wl,-u,_base_GHCziWord_W64zh_static_info"
+         , "-Wl,-u,_base_GHCziStable_StablePtr_static_info"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_Izh_con_info"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_Czh_con_info"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_Fzh_con_info"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_Dzh_con_info"
+         , "-Wl,-u,_base_GHCziPtr_Ptr_con_info"
+         , "-Wl,-u,_base_GHCziPtr_FunPtr_con_info"
+         , "-Wl,-u,_base_GHCziStable_StablePtr_con_info"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_False_closure"
+         , "-Wl,-u,_ghczmprim_GHCziTypes_True_closure"
+         , "-Wl,-u,_base_GHCziPack_unpackCString_closure"
+         , "-Wl,-u,_base_GHCziIOziException_stackOverflow_closure"
+         , "-Wl,-u,_base_GHCziIOziException_heapOverflow_closure"
+         , "-Wl,-u,_base_ControlziExceptionziBase_nonTermination_closure"
+         , "-Wl,-u,_base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
+         , "-Wl,-u,_base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
+         , "-Wl,-u,_base_ControlziExceptionziBase_nestedAtomically_closure"
+         , "-Wl,-u,_base_GHCziWeak_runFinalizzerBatch_closure"
+         , "-Wl,-u,_base_GHCziTopHandler_flushStdHandles_closure"
+         , "-Wl,-u,_base_GHCziTopHandler_runIO_closure"
+         , "-Wl,-u,_base_GHCziTopHandler_runNonIO_closure"
+         , "-Wl,-u,_base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
+         , "-Wl,-u,_base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
+         , "-Wl,-u,_base_GHCziConcziSync_runSparks_closure"
+         , "-Wl,-u,_base_GHCziConcziSignal_runHandlers_closure"
 #else
-           "-u", "ghczmprim_GHCziTypes_Izh_static_info"
-         , "-u", "ghczmprim_GHCziTypes_Czh_static_info"
-         , "-u", "ghczmprim_GHCziTypes_Fzh_static_info"
-         , "-u", "ghczmprim_GHCziTypes_Dzh_static_info"
-         , "-u", "base_GHCziPtr_Ptr_static_info"
-         , "-u", "ghczmprim_GHCziTypes_Wzh_static_info"
-         , "-u", "base_GHCziInt_I8zh_static_info"
-         , "-u", "base_GHCziInt_I16zh_static_info"
-         , "-u", "base_GHCziInt_I32zh_static_info"
-         , "-u", "base_GHCziInt_I64zh_static_info"
-         , "-u", "base_GHCziWord_W8zh_static_info"
-         , "-u", "base_GHCziWord_W16zh_static_info"
-         , "-u", "base_GHCziWord_W32zh_static_info"
-         , "-u", "base_GHCziWord_W64zh_static_info"
-         , "-u", "base_GHCziStable_StablePtr_static_info"
-         , "-u", "ghczmprim_GHCziTypes_Izh_con_info"
-         , "-u", "ghczmprim_GHCziTypes_Czh_con_info"
-         , "-u", "ghczmprim_GHCziTypes_Fzh_con_info"
-         , "-u", "ghczmprim_GHCziTypes_Dzh_con_info"
-         , "-u", "base_GHCziPtr_Ptr_con_info"
-         , "-u", "base_GHCziPtr_FunPtr_con_info"
-         , "-u", "base_GHCziStable_StablePtr_con_info"
-         , "-u", "ghczmprim_GHCziTypes_False_closure"
-         , "-u", "ghczmprim_GHCziTypes_True_closure"
-         , "-u", "base_GHCziPack_unpackCString_closure"
-         , "-u", "base_GHCziIOziException_stackOverflow_closure"
-         , "-u", "base_GHCziIOziException_heapOverflow_closure"
-         , "-u", "base_ControlziExceptionziBase_nonTermination_closure"
-         , "-u", "base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
-         , "-u", "base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
-         , "-u", "base_ControlziExceptionziBase_nestedAtomically_closure"
-         , "-u", "base_GHCziWeak_runFinalizzerBatch_closure"
-         , "-u", "base_GHCziTopHandler_flushStdHandles_closure"
-         , "-u", "base_GHCziTopHandler_runIO_closure"
-         , "-u", "base_GHCziTopHandler_runNonIO_closure"
-	 , "-u", "base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
-         , "-u", "base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
-	 , "-u", "base_GHCziConcziSync_runSparks_closure"
-	 , "-u", "base_GHCziConcziSignal_runHandlers_closure"
+           "-Wl,-u,ghczmprim_GHCziTypes_Izh_static_info"
+         , "-Wl,-u,ghczmprim_GHCziTypes_Czh_static_info"
+         , "-Wl,-u,ghczmprim_GHCziTypes_Fzh_static_info"
+         , "-Wl,-u,ghczmprim_GHCziTypes_Dzh_static_info"
+         , "-Wl,-u,base_GHCziPtr_Ptr_static_info"
+         , "-Wl,-u,ghczmprim_GHCziTypes_Wzh_static_info"
+         , "-Wl,-u,base_GHCziInt_I8zh_static_info"
+         , "-Wl,-u,base_GHCziInt_I16zh_static_info"
+         , "-Wl,-u,base_GHCziInt_I32zh_static_info"
+         , "-Wl,-u,base_GHCziInt_I64zh_static_info"
+         , "-Wl,-u,base_GHCziWord_W8zh_static_info"
+         , "-Wl,-u,base_GHCziWord_W16zh_static_info"
+         , "-Wl,-u,base_GHCziWord_W32zh_static_info"
+         , "-Wl,-u,base_GHCziWord_W64zh_static_info"
+         , "-Wl,-u,base_GHCziStable_StablePtr_static_info"
+         , "-Wl,-u,ghczmprim_GHCziTypes_Izh_con_info"
+         , "-Wl,-u,ghczmprim_GHCziTypes_Czh_con_info"
+         , "-Wl,-u,ghczmprim_GHCziTypes_Fzh_con_info"
+         , "-Wl,-u,ghczmprim_GHCziTypes_Dzh_con_info"
+         , "-Wl,-u,base_GHCziPtr_Ptr_con_info"
+         , "-Wl,-u,base_GHCziPtr_FunPtr_con_info"
+         , "-Wl,-u,base_GHCziStable_StablePtr_con_info"
+         , "-Wl,-u,ghczmprim_GHCziTypes_False_closure"
+         , "-Wl,-u,ghczmprim_GHCziTypes_True_closure"
+         , "-Wl,-u,base_GHCziPack_unpackCString_closure"
+         , "-Wl,-u,base_GHCziIOziException_stackOverflow_closure"
+         , "-Wl,-u,base_GHCziIOziException_heapOverflow_closure"
+         , "-Wl,-u,base_ControlziExceptionziBase_nonTermination_closure"
+         , "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
+         , "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
+         , "-Wl,-u,base_ControlziExceptionziBase_nestedAtomically_closure"
+         , "-Wl,-u,base_GHCziWeak_runFinalizzerBatch_closure"
+         , "-Wl,-u,base_GHCziTopHandler_flushStdHandles_closure"
+         , "-Wl,-u,base_GHCziTopHandler_runIO_closure"
+         , "-Wl,-u,base_GHCziTopHandler_runNonIO_closure"
+         , "-Wl,-u,base_GHCziConcziIO_ensureIOManagerIsRunning_closure"
+         , "-Wl,-u,base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure"
+         , "-Wl,-u,base_GHCziConcziSync_runSparks_closure"
+         , "-Wl,-u,base_GHCziConcziSignal_runHandlers_closure"
 #endif
 
 /*  Pick up static libraries in preference over dynamic if in earlier search
@@ -151,7 +154,7 @@ ld-options:
  *  The used option is specific to the Darwin linker.
  */
 #ifdef darwin_HOST_OS
-	 , "-Wl,-search_paths_first"
+         , "-Wl,-search_paths_first"
 #endif
 
 #if defined(darwin_HOST_OS) && !defined(x86_64_HOST_ARCH)
diff --git a/rts/posix/Itimer.c b/rts/posix/Itimer.c
index b99ff8970b..4bcc3a1c2e 100644
--- a/rts/posix/Itimer.c
+++ b/rts/posix/Itimer.c
@@ -45,6 +45,20 @@
 #include <string.h>
 
 /*
+ * timer_create doesn't exist and setitimer doesn't fire on iOS, so we're using
+ * a pthreads-based implementation. It may be to do with interference with the
+ * signals of the debugger. Revisit. See #7723.
+ */
+#if defined(ios_HOST_OS)
+#define USE_PTHREAD_FOR_ITIMER
+#endif
+
+#if defined(USE_PTHREAD_FOR_ITIMER)
+#include <pthread.h>
+#include <unistd.h>
+#endif
+
+/*
  * We use a realtime timer by default.  I found this much more
  * reliable than a CPU timer:
  *
@@ -107,6 +121,7 @@ static timer_t timer;
 
 static Time itimer_interval = DEFAULT_TICK_INTERVAL;
 
+#if !defined(USE_PTHREAD_FOR_ITIMER)
 static void install_vtalrm_handler(TickProc handle_tick)
 {
     struct sigaction action;
@@ -132,13 +147,33 @@ static void install_vtalrm_handler(TickProc handle_tick)
         stg_exit(EXIT_FAILURE);
     }
 }
+#endif
+
+#if defined(USE_PTHREAD_FOR_ITIMER)
+static volatile int itimer_enabled;
+static void *itimer_thread_func(void *_handle_tick)
+{
+    TickProc handle_tick = _handle_tick;
+    while (1) {
+        usleep(TimeToUS(itimer_interval));
+        switch (itimer_enabled) {
+            case 1: handle_tick(0); break;
+            case 2: itimer_enabled = 0;
+        }
+    }
+    return NULL;
+}
+#endif
 
 void
 initTicker (Time interval, TickProc handle_tick)
 {
     itimer_interval = interval;
 
-#if defined(USE_TIMER_CREATE)
+#if defined(USE_PTHREAD_FOR_ITIMER)
+    pthread_t tid;
+    pthread_create(&tid, NULL, itimer_thread_func, (void*)handle_tick);
+#elif defined(USE_TIMER_CREATE)
     {
         struct sigevent ev;
 
@@ -153,15 +188,18 @@ initTicker (Time interval, TickProc handle_tick)
             stg_exit(EXIT_FAILURE);
         }
     }
-#endif
-
     install_vtalrm_handler(handle_tick);
+#else
+    install_vtalrm_handler(handle_tick);
+#endif
 }
 
 void
 startTicker(void)
 {
-#if defined(USE_TIMER_CREATE)
+#if defined(USE_PTHREAD_FOR_ITIMER)
+    itimer_enabled = 1;
+#elif defined(USE_TIMER_CREATE)
     {
         struct itimerspec it;
         
@@ -193,7 +231,14 @@ startTicker(void)
 void
 stopTicker(void)
 {
-#if defined(USE_TIMER_CREATE)
+#if defined(USE_PTHREAD_FOR_ITIMER)
+    if (itimer_enabled == 1) {
+        itimer_enabled = 2;
+        /* Wait for the thread to confirm it won't generate another tick. */
+        while (itimer_enabled != 0)
+            sched_yield();
+    }
+#elif defined(USE_TIMER_CREATE)
     struct itimerspec it;
 
     it.it_value.tv_sec = 0;
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index 7c89418ab9..247f1a01c6 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -442,6 +442,7 @@ thread_TSO (StgTSO *tso)
     thread_(&tso->global_link);
 
     if (   tso->why_blocked == BlockedOnMVar
+        || tso->why_blocked == BlockedOnMVarRead
 	|| tso->why_blocked == BlockedOnBlackHole
 	|| tso->why_blocked == BlockedOnMsgThrowTo
         || tso->why_blocked == NotBlocked
@@ -620,7 +621,7 @@ thread_obj (StgInfoTable *info, StgPtr p)
     case WEAK:
     {
 	StgWeak *w = (StgWeak *)p;
-	thread(&w->cfinalizer);
+	thread(&w->cfinalizers);
 	thread(&w->key);
 	thread(&w->value);
 	thread(&w->finalizer);
@@ -917,17 +918,20 @@ compact(StgClosure *static_objects)
     markScheduler((evac_fn)thread_root, NULL);
 
     // the weak pointer lists...
-    if (weak_ptr_list != NULL) {
-	thread((void *)&weak_ptr_list);
+    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+        if (generations[g].weak_ptr_list != NULL) {
+            thread((void *)&generations[g].weak_ptr_list);
+        }
     }
-    if (old_weak_ptr_list != NULL) {
-	thread((void *)&old_weak_ptr_list); // tmp
+
+    if (dead_weak_ptr_list != NULL) {
+        thread((void *)&dead_weak_ptr_list); // tmp
     }
 
     // mutable lists
     for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
-	bdescr *bd;
-	StgPtr p;
+        bdescr *bd;
+        StgPtr p;
         for (n = 0; n < n_capabilities; n++) {
             for (bd = capabilities[n].mut_lists[g]; 
                  bd != NULL; bd = bd->link) {
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index dfebd55334..1b2cb12212 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -6,7 +6,7 @@
  *
  * Documentation on the architecture of the Garbage Collector can be
  * found in the online commentary:
- * 
+ *
  *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
  *
  * ---------------------------------------------------------------------------*/
@@ -41,15 +41,13 @@
 #include "Prelude.h"
 #include "RtsSignals.h"
 #include "STM.h"
-#if defined(RTS_GTK_FRONTPANEL)
-#include "FrontPanel.h"
-#endif
 #include "Trace.h"
 #include "RetainerProfile.h"
 #include "LdvProfile.h"
 #include "RaiseAsync.h"
 #include "Papi.h"
 #include "Stable.h"
+#include "CheckUnload.h"
 
 #include <string.h> // for memset()
 #include <unistd.h>
@@ -75,13 +73,13 @@
  * linking objects on to the list.  We use a stack-type list, consing
  * objects on the front as they are added (this means that the
  * scavenge phase is depth-first, not breadth-first, but that
- * shouldn't matter).  
+ * shouldn't matter).
  *
  * A separate list is kept for objects that have been scavenged
  * already - this is so that we can zero all the marks afterwards.
  *
  * An object is on the list if its static link field is non-zero; this
- * means that we have to mark the end of the list with '1', not NULL.  
+ * means that we have to mark the end of the list with '1', not NULL.
  *
  * Extra notes for generational GC:
  *
@@ -103,7 +101,7 @@ rtsBool major_gc;
 
 /* Data used for allocation area sizing.
  */
-static W_ g0_pcnt_kept = 30; // percentage of g0 live at last minor GC 
+static W_ g0_pcnt_kept = 30; // percentage of g0 live at last minor GC
 
 /* Mut-list stats */
 #ifdef DEBUG
@@ -216,7 +214,7 @@ GarbageCollect (nat collect_gen,
   // this is the main thread
   SET_GCT(gc_threads[cap->no]);
 
-  // tell the stats department that we've started a GC 
+  // tell the stats department that we've started a GC
   stat_startGC(cap, gct);
 
   // lock the StablePtr table
@@ -235,7 +233,7 @@ GarbageCollect (nat collect_gen,
   mutlist_OTHERS = 0;
 #endif
 
-  // attribute any costs to CCS_GC 
+  // attribute any costs to CCS_GC
 #ifdef PROFILING
   for (n = 0; n < n_capabilities; n++) {
       save_CCS[n] = capabilities[n].r.rCCCS;
@@ -254,7 +252,7 @@ GarbageCollect (nat collect_gen,
       // It's not always a good idea to do load balancing in parallel
       // GC.  In particular, for a parallel program we don't want to
       // lose locality by moving cached data into another CPU's cache
-      // (this effect can be quite significant). 
+      // (this effect can be quite significant).
       //
       // We could have a more complex way to deterimine whether to do
       // work stealing or not, e.g. it might be a good idea to do it
@@ -283,14 +281,8 @@ GarbageCollect (nat collect_gen,
   debugTrace(DEBUG_gc, "GC (gen %d, using %d thread(s))",
              N, n_gc_threads);
 
-#ifdef RTS_GTK_FRONTPANEL
-  if (RtsFlags.GcFlags.frontpanel) {
-      updateFrontPanelBeforeGC(N);
-  }
-#endif
-
 #ifdef DEBUG
-  // check for memory leaks if DEBUG is on 
+  // check for memory leaks if DEBUG is on
   memInventory(DEBUG_gc);
 #endif
 
@@ -401,10 +393,10 @@ GarbageCollect (nat collect_gen,
       scavenge_until_all_done();
       // The other threads are now stopped.  We might recurse back to
       // here, but from now on this is the only thread.
-      
+
       // must be last...  invariant is that everything is fully
       // scavenged at this point.
-      if (traverseWeakPtrList()) { // returns rtsTrue if evaced something 
+      if (traverseWeakPtrList()) { // returns rtsTrue if evaced something
 	  inc_running();
 	  continue;
       }
@@ -451,7 +443,7 @@ GarbageCollect (nat collect_gen,
 
   // Finally: compact or sweep the oldest generation.
   if (major_gc && oldest_gen->mark) {
-      if (oldest_gen->compact) 
+      if (oldest_gen->compact)
           compact(gct->scavenged_static_objects);
       else
           sweep(oldest_gen);
@@ -460,7 +452,7 @@ GarbageCollect (nat collect_gen,
   copied = 0;
   par_max_copied = 0;
   par_tot_copied = 0;
-  { 
+  {
       nat i;
       for (i=0; i < n_gc_threads; i++) {
           if (n_gc_threads > 1) {
@@ -494,7 +486,7 @@ GarbageCollect (nat collect_gen,
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 
     if (g == N) {
-      generations[g].collections++; // for stats 
+      generations[g].collections++; // for stats
       if (n_gc_threads > 1) generations[g].par_collections++;
     }
 
@@ -521,7 +513,7 @@ GarbageCollect (nat collect_gen,
     bdescr *next, *prev;
     gen = &generations[g];
 
-    // for generations we collected... 
+    // for generations we collected...
     if (g <= N) {
 
 	/* free old memory and shift to-space into from-space for all
@@ -532,12 +524,12 @@ GarbageCollect (nat collect_gen,
         {
             // tack the new blocks on the end of the existing blocks
             if (gen->old_blocks != NULL) {
-                
+
                 prev = NULL;
                 for (bd = gen->old_blocks; bd != NULL; bd = next) {
-                    
+
                     next = bd->link;
-                    
+
                     if (!(bd->flags & BF_MARKED))
                     {
                         if (prev == NULL) {
@@ -551,17 +543,17 @@ GarbageCollect (nat collect_gen,
                     else
                     {
                         gen->n_words += bd->free - bd->start;
-                        
+
                         // NB. this step might not be compacted next
                         // time, so reset the BF_MARKED flags.
                         // They are set before GC if we're going to
                         // compact.  (search for BF_MARKED above).
                         bd->flags &= ~BF_MARKED;
-                        
+
                         // between GCs, all blocks in the heap except
                         // for the nursery have the BF_EVACUATED flag set.
                         bd->flags |= BF_EVACUATED;
-                        
+
                         prev = bd;
                     }
                 }
@@ -606,8 +598,8 @@ GarbageCollect (nat collect_gen,
             dbl_link_onto(bd, &gen->large_objects);
             gen->n_large_words += bd->free - bd->start;
         }
-        
-	// add the new blocks we promoted during this GC 
+
+	// add the new blocks we promoted during this GC
 	gen->n_large_blocks += gen->n_scavenged_large_blocks;
     }
 
@@ -634,7 +626,7 @@ GarbageCollect (nat collect_gen,
 
   // update the max size of older generations after a major GC
   resize_generations();
-  
+
   // Free the mark stack.
   if (mark_stack_top_bd != NULL) {
       debugTrace(DEBUG_gc, "mark stack: %d blocks",
@@ -670,11 +662,15 @@ GarbageCollect (nat collect_gen,
 
   resetNurseries();
 
+  if (major_gc) {
+      checkUnload (gct->scavenged_static_objects);
+  }
+
  // mark the garbage collected CAFs as dead
-#if 0 && defined(DEBUG) // doesn't work at the moment 
+#if 0 && defined(DEBUG) // doesn't work at the moment
   if (major_gc) { gcCAFs(); }
 #endif
-  
+
 #ifdef PROFILING
   // resetStaticObjectForRetainerProfiling() must be called before
   // zeroing below.
@@ -683,7 +679,7 @@ GarbageCollect (nat collect_gen,
   resetStaticObjectForRetainerProfiling(gct->scavenged_static_objects);
 #endif
 
-  // zero the scavenged static object list 
+  // zero the scavenged static object list
   if (major_gc) {
       nat i;
       if (n_gc_threads == 1) {
@@ -708,7 +704,7 @@ GarbageCollect (nat collect_gen,
   // Start any pending finalizers.  Must be after
   // updateStableTables() and stableUnlock() (see #4221).
   RELEASE_SM_LOCK;
-  scheduleFinalizers(cap, old_weak_ptr_list);
+  scheduleFinalizers(cap, dead_weak_ptr_list);
   ACQUIRE_SM_LOCK;
 
   // check sanity after GC
@@ -750,11 +746,11 @@ GarbageCollect (nat collect_gen,
   IF_DEBUG(gc, statDescribeGens());
 
 #ifdef DEBUG
-  // symbol-table based profiling 
+  // symbol-table based profiling
   /*  heapCensus(to_blocks); */ /* ToDo */
 #endif
 
-  // restore enclosing cost centre 
+  // restore enclosing cost centre
 #ifdef PROFILING
   for (n = 0; n < n_capabilities; n++) {
       capabilities[n].r.rCCCS = save_CCS[n];
@@ -762,17 +758,11 @@ GarbageCollect (nat collect_gen,
 #endif
 
 #ifdef DEBUG
-  // check for memory leaks if DEBUG is on 
+  // check for memory leaks if DEBUG is on
   memInventory(DEBUG_gc);
 #endif
 
-#ifdef RTS_GTK_FRONTPANEL
-  if (RtsFlags.GcFlags.frontpanel) {
-      updateFrontPanelAfterGC( N, live );
-  }
-#endif
-
-  // ok, GC over: tell the stats department what happened. 
+  // ok, GC over: tell the stats department what happened.
   stat_endGC(cap, gct, live_words, copied,
              live_blocks * BLOCK_SIZE_W - live_words /* slop */,
              N, n_gc_threads, par_max_copied, par_tot_copied);
@@ -821,7 +811,7 @@ new_gc_thread (nat n, gc_thread *t)
     t->gc_count = 0;
 
     init_gc_thread(t);
-    
+
 #ifdef USE_PAPI
     t->papi_events = -1;
 #endif
@@ -832,7 +822,7 @@ new_gc_thread (nat n, gc_thread *t)
         ws->gen = &generations[g];
         ASSERT(g == ws->gen->no);
         ws->my_gct = t;
-        
+
         // We want to call
         //   alloc_todo_block(ws,0);
         // but can't, because it uses gct which isn't set up at this point.
@@ -960,7 +950,7 @@ any_work (void)
     if (mark_stack_bd != NULL && !mark_stack_empty()) {
 	return rtsTrue;
     }
-    
+
     // Check for global work in any step.  We don't need to check for
     // local work, because we have already exited scavenge_loop(),
     // which means there is no local work for this thread.
@@ -991,13 +981,13 @@ any_work (void)
 #endif
 
     return rtsFalse;
-}    
+}
 
 static void
 scavenge_until_all_done (void)
 {
     DEBUG_ONLY( nat r );
-	
+
 
 loop:
 #if defined(THREADED_RTS)
@@ -1023,7 +1013,7 @@ loop:
     traceEventGcIdle(gct->cap);
 
     debugTrace(DEBUG_gc, "%d GC threads still running", r);
-    
+
     while (gc_running_threads != 0) {
         // usleep(1);
         if (any_work()) {
@@ -1033,10 +1023,10 @@ loop:
         }
         // any_work() does not remove the work from the queue, it
         // just checks for the presence of work.  If we find any,
-        // then we increment gc_running_threads and go back to 
+        // then we increment gc_running_threads and go back to
         // scavenge_loop() to perform any pending work.
     }
-    
+
     traceEventGcDone(gct->cap);
 }
 
@@ -1065,7 +1055,7 @@ gcWorkerThread (Capability *cap)
     gct->wakeup = GC_THREAD_STANDING_BY;
     debugTrace(DEBUG_gc, "GC thread %d standing by...", gct->thread_index);
     ACQUIRE_SPIN_LOCK(&gct->gc_spin);
-    
+
 #ifdef USE_PAPI
     // start performance counters in this thread...
     if (gct->papi_events == -1) {
@@ -1084,7 +1074,7 @@ gcWorkerThread (Capability *cap)
     scavenge_capability_mut_lists(cap);
 
     scavenge_until_all_done();
-    
+
     if (!DEBUG_IS_ON) {
         clearNursery(cap);
     }
@@ -1107,7 +1097,7 @@ gcWorkerThread (Capability *cap)
     // Wait until we're told to continue
     RELEASE_SPIN_LOCK(&gct->gc_spin);
     gct->wakeup = GC_THREAD_WAITING_TO_CONTINUE;
-    debugTrace(DEBUG_gc, "GC thread %d waiting to continue...", 
+    debugTrace(DEBUG_gc, "GC thread %d waiting to continue...",
                gct->thread_index);
     ACQUIRE_SPIN_LOCK(&gct->mut_spin);
     debugTrace(DEBUG_gc, "GC thread %d on my way...", gct->thread_index);
@@ -1213,7 +1203,7 @@ releaseGCThreads (Capability *cap USED_IF_THREADS)
         if (i == me || gc_threads[i]->idle) continue;
         if (gc_threads[i]->wakeup != GC_THREAD_WAITING_TO_CONTINUE)
             barf("releaseGCThreads");
-        
+
         gc_threads[i]->wakeup = GC_THREAD_INACTIVE;
         ACQUIRE_SPIN_LOCK(&gc_threads[i]->gc_spin);
         RELEASE_SPIN_LOCK(&gc_threads[i]->mut_spin);
@@ -1222,7 +1212,7 @@ releaseGCThreads (Capability *cap USED_IF_THREADS)
 #endif
 
 /* ----------------------------------------------------------------------------
-   Initialise a generation that is to be collected 
+   Initialise a generation that is to be collected
    ------------------------------------------------------------------------- */
 
 static void
@@ -1293,7 +1283,7 @@ prepare_collected_gen (generation *gen)
     for (bd = gen->old_blocks; bd; bd = bd->link) {
         bd->flags &= ~BF_EVACUATED;
     }
-    
+
     // mark the large objects as from-space
     for (bd = gen->large_objects; bd; bd = bd->link) {
         bd->flags &= ~BF_EVACUATED;
@@ -1304,7 +1294,7 @@ prepare_collected_gen (generation *gen)
         StgWord bitmap_size; // in bytes
         bdescr *bitmap_bdescr;
         StgWord *bitmap;
-	
+
         bitmap_size = gen->n_old_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
 
         if (bitmap_size > 0) {
@@ -1312,19 +1302,19 @@ prepare_collected_gen (generation *gen)
                                        / BLOCK_SIZE);
             gen->bitmap = bitmap_bdescr;
             bitmap = bitmap_bdescr->start;
-            
+
             debugTrace(DEBUG_gc, "bitmap_size: %d, bitmap: %p",
                        bitmap_size, bitmap);
-            
+
             // don't forget to fill it with zeros!
             memset(bitmap, 0, bitmap_size);
-            
+
             // For each block in this step, point to its bitmap from the
             // block descriptor.
             for (bd=gen->old_blocks; bd != NULL; bd = bd->link) {
                 bd->u.bitmap = bitmap;
                 bitmap += BLOCK_SIZE_W / (sizeof(W_)*BITS_PER_BYTE);
-		
+
                 // Also at this point we set the BF_MARKED flag
                 // for this block.  The invariant is that
                 // BF_MARKED is always unset, except during GC
@@ -1355,7 +1345,7 @@ stash_mut_list (Capability *cap, nat gen_no)
 }
 
 /* ----------------------------------------------------------------------------
-   Initialise a generation that is *not* to be collected 
+   Initialise a generation that is *not* to be collected
    ------------------------------------------------------------------------- */
 
 static void
@@ -1388,10 +1378,10 @@ collect_gct_blocks (void)
     nat g;
     gen_workspace *ws;
     bdescr *bd, *prev;
-    
+
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
         ws = &gct->gens[g];
-        
+
         // there may still be a block attached to ws->todo_bd;
         // leave it there to use next time.
 
@@ -1400,7 +1390,7 @@ collect_gct_blocks (void)
 
             ASSERT(gct->scan_bd == NULL);
             ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks);
-        
+
             prev = NULL;
             for (bd = ws->scavd_list; bd != NULL; bd = bd->link) {
                 ws->gen->n_words += bd->free - bd->start;
@@ -1409,7 +1399,7 @@ collect_gct_blocks (void)
             if (prev != NULL) {
                 prev->link = ws->gen->blocks;
                 ws->gen->blocks = ws->scavd_list;
-            } 
+            }
             ws->gen->n_blocks += ws->n_scavd_blocks;
 
             ws->scavd_list = NULL;
@@ -1492,9 +1482,9 @@ mark_root(void *user USED_IF_THREADS, StgClosure **root)
     saved_gct = gct;
 #endif
     SET_GCT(user);
-    
+
     evacuate(root);
-    
+
     SET_GCT(saved_gct);
 }
 
@@ -1519,7 +1509,7 @@ zero_static_object_list(StgClosure* first_static)
 /* ----------------------------------------------------------------------------
    Reset the sizes of the older generations when we do a major
    collection.
-  
+
    CURRENT STRATEGY: make all generations except zero the same size.
    We have to stay within the maximum heap size, and leave a certain
    percentage of the maximum heap size available to allocate into.
@@ -1534,7 +1524,7 @@ resize_generations (void)
         W_ live, size, min_alloc, words;
         const W_ max  = RtsFlags.GcFlags.maxHeapSize;
         const W_ gens = RtsFlags.GcFlags.generations;
-	
+
 	// live in the oldest generations
         if (oldest_gen->live_estimate != 0) {
             words = oldest_gen->live_estimate;
@@ -1543,11 +1533,11 @@ resize_generations (void)
         }
         live = (words + BLOCK_SIZE_W - 1) / BLOCK_SIZE_W +
             oldest_gen->n_large_blocks;
-	
+
 	// default max size for all generations except zero
 	size = stg_max(live * RtsFlags.GcFlags.oldGenFactor,
 		       RtsFlags.GcFlags.minOldGenSize);
-	
+
         if (RtsFlags.GcFlags.heapSizeSuggestionAuto) {
             if (max > 0) {
                 RtsFlags.GcFlags.heapSizeSuggestion = stg_min(max, size);
@@ -1564,7 +1554,7 @@ resize_generations (void)
 	// certain percentage of the maximum heap size (default: 30%).
 	if (RtsFlags.GcFlags.compact ||
             (max > 0 &&
-             oldest_gen->n_blocks > 
+             oldest_gen->n_blocks >
              (RtsFlags.GcFlags.compactThreshold * max) / 100)) {
 	    oldest_gen->mark = 1;
 	    oldest_gen->compact = 1;
@@ -1584,14 +1574,14 @@ resize_generations (void)
 	// different if compaction is turned on, because we don't need
 	// to double the space required to collect the old generation.
 	if (max != 0) {
-	    
+
 	    // this test is necessary to ensure that the calculations
 	    // below don't have any negative results - we're working
 	    // with unsigned values here.
 	    if (max < min_alloc) {
 		heapOverflow();
 	    }
-	    
+
 	    if (oldest_gen->compact) {
 		if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
 		    size = (max - min_alloc) / ((gens - 1) * 2 - 1);
@@ -1601,17 +1591,17 @@ resize_generations (void)
 		    size = (max - min_alloc) / ((gens - 1) * 2);
 		}
 	    }
-	    
+
 	    if (size < live) {
 		heapOverflow();
 	    }
 	}
-	
+
 #if 0
 	debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live,
 		   min_alloc, size, max);
 #endif
-	
+
 	for (g = 0; g < gens; g++) {
 	    generations[g].max_blocks = size;
 	}
@@ -1630,7 +1620,7 @@ resize_nursery (void)
     if (RtsFlags.GcFlags.generations == 1)
     {   // Two-space collector:
         W_ blocks;
-    
+
 	/* set up a new nursery.  Allocate a nursery size based on a
 	 * function of the amount of live data (by default a factor of 2)
 	 * Use the blocks from the old nursery if possible, freeing up any
@@ -1640,25 +1630,25 @@ resize_nursery (void)
 	 * size accordingly.  If the nursery is the same size as the live
 	 * data (L), then we need 3L bytes.  We can reduce the size of the
 	 * nursery to bring the required memory down near 2L bytes.
-	 * 
+	 *
 	 * A normal 2-space collector would need 4L bytes to give the same
 	 * performance we get from 3L bytes, reducing to the same
 	 * performance at 2L bytes.
 	 */
 	blocks = generations[0].n_blocks;
-	
+
 	if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
-	     blocks * RtsFlags.GcFlags.oldGenFactor * 2 > 
+	     blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
 	     RtsFlags.GcFlags.maxHeapSize )
 	{
-	    long adjusted_blocks;  // signed on purpose 
-	    int pc_free; 
-	    
+	    long adjusted_blocks;  // signed on purpose
+	    int pc_free;
+
 	    adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
-	    
-	    debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", 
+
+	    debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld",
 		       RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks);
-	    
+
 	    pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
 	    if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even * be < 0 */
 	    {
@@ -1678,7 +1668,7 @@ resize_nursery (void)
     }
     else  // Generational collector
     {
-	/* 
+	/*
 	 * If the user has given us a suggested heap size, adjust our
 	 * allocation area to make best use of the memory available.
 	 */
@@ -1688,7 +1678,7 @@ resize_nursery (void)
             StgWord needed;
 
             calcNeeded(rtsFalse, &needed); // approx blocks needed at next GC
-	    
+
 	    /* Guess how much will be live in generation 0 step 0 next time.
 	     * A good approximation is obtained by finding the
 	     * percentage of g0 that was live at the last minor GC.
@@ -1703,7 +1693,7 @@ resize_nursery (void)
 		g0_pcnt_kept = ((copied / (BLOCK_SIZE_W - 10)) * 100)
 		    / countNurseryBlocks();
 	    }
-	    
+
 	    /* Estimate a size for the allocation area based on the
 	     * information available.  We might end up going slightly under
 	     * or over the suggested heap size, but we should be pretty
@@ -1716,14 +1706,14 @@ resize_nursery (void)
 	     * where 'needed' is the amount of memory needed at the next
 	     * collection for collecting all gens except g0.
 	     */
-	    blocks = 
+	    blocks =
 		(((long)RtsFlags.GcFlags.heapSizeSuggestion - (long)needed) * 100) /
 		(100 + (long)g0_pcnt_kept);
-	    
+
 	    if (blocks < (long)min_nursery) {
 		blocks = min_nursery;
 	    }
-	    
+
             resizeNurseries((W_)blocks);
 	}
 	else
@@ -1744,7 +1734,7 @@ resize_nursery (void)
    whenever the program tries to enter a garbage collected CAF.
 
    Any garbage collected CAFs are taken off the CAF list at the same
-   time. 
+   time.
    -------------------------------------------------------------------------- */
 
 #if 0 && defined(DEBUG)
@@ -1762,14 +1752,14 @@ gcCAFs(void)
   pp = &caf_list;
 
   while (p != NULL) {
-    
+
     info = get_itbl(p);
 
     ASSERT(info->type == IND_STATIC);
 
     if (STATIC_LINK(info,p) == NULL) {
 	debugTrace(DEBUG_gccafs, "CAF gc'd at 0x%04lx", (long)p);
-	// black hole it 
+	// black hole it
 	SET_INFO(p,&stg_BLACKHOLE_info);
 	p = STATIC_LINK2(info,p);
 	*pp = p;
@@ -1782,6 +1772,6 @@ gcCAFs(void)
 
   }
 
-  debugTrace(DEBUG_gccafs, "%d CAFs live", i); 
+  debugTrace(DEBUG_gccafs, "%d CAFs live", i);
 }
 #endif
diff --git a/rts/sm/GCThread.h b/rts/sm/GCThread.h
index 7aacb4eb51..748b0687fa 100644
--- a/rts/sm/GCThread.h
+++ b/rts/sm/GCThread.h
@@ -122,7 +122,7 @@ typedef struct gc_thread_ {
     OSThreadId id;                 // The OS thread that this struct belongs to
     SpinLock   gc_spin;
     SpinLock   mut_spin;
-    volatile rtsBool wakeup;
+    volatile StgWord8 wakeup;
 #endif
     nat thread_index;              // a zero based index identifying the thread
     rtsBool idle;                  // sitting out of this GC cycle
diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c
index 996b5f6280..d8633f98ea 100644
--- a/rts/sm/GCUtils.c
+++ b/rts/sm/GCUtils.c
@@ -161,6 +161,7 @@ push_scanned_block (bdescr *bd, gen_workspace *ws)
 StgPtr
 todo_block_full (nat size, gen_workspace *ws)
 {
+    rtsBool urgent_to_push, can_extend;
     StgPtr p;
     bdescr *bd;
 
@@ -174,20 +175,49 @@ todo_block_full (nat size, gen_workspace *ws)
     ASSERT(bd->link == NULL);
     ASSERT(bd->gen == ws->gen);
 
-    // If the global list is not empty, or there's not much work in
-    // this block to push, and there's enough room in
-    // this block to evacuate the current object, then just increase
-    // the limit.
-    if (!looksEmptyWSDeque(ws->todo_q) || 
-        (ws->todo_free - bd->u.scan < WORK_UNIT_WORDS / 2)) {
-        if (ws->todo_free + size < bd->start + bd->blocks * BLOCK_SIZE_W) {
-            ws->todo_lim = stg_min(bd->start + bd->blocks * BLOCK_SIZE_W,
-                                   ws->todo_lim + stg_max(WORK_UNIT_WORDS,size));
-            debugTrace(DEBUG_gc, "increasing limit for %p to %p", bd->start, ws->todo_lim);
-            p = ws->todo_free;
-            ws->todo_free += size;
-            return p;
-        }
+    // We intentionally set ws->todo_lim lower than the full size of
+    // the block, so that we can push out some work to the global list
+    // and get the parallel threads working as soon as possible.
+    //
+    // So when ws->todo_lim is reached, we end up here and have to
+    // decide whether it's worth pushing out the work we have or not.
+    // If we have enough room in the block to evacuate the current
+    // object, and it's not urgent to push this work, then we just
+    // extend the limit and keep going.  Where "urgent" is defined as:
+    // the global pool is empty, and there's enough work in this block
+    // to make it worth pushing.
+    //
+    urgent_to_push =
+        looksEmptyWSDeque(ws->todo_q) &&
+        (ws->todo_free - bd->u.scan >= WORK_UNIT_WORDS / 2);
+
+    // We can extend the limit for the current block if there's enough
+    // room for the current object, *and* we're not into the second or
+    // subsequent block of a large block.  The second condition occurs
+    // when we evacuate an object that is larger than a block.  In
+    // that case, alloc_todo_block() sets todo_lim to be exactly the
+    // size of the large object, and we don't evacuate any more
+    // objects into this block.  The reason is that the rest of the GC
+    // is not set up to handle objects that start in the second or
+    // later blocks of a group.  We just about manage this in the
+    // nursery (see scheduleHandleHeapOverflow()) so evacuate() can
+    // handle this, but other parts of the GC can't.  We could
+    // probably fix this, but it's a rare case anyway.
+    //
+    can_extend =
+        ws->todo_free + size <= bd->start + bd->blocks * BLOCK_SIZE_W
+        && ws->todo_free < ws->todo_bd->start + BLOCK_SIZE_W;
+
+    if (!urgent_to_push && can_extend)
+    {
+        ws->todo_lim = stg_min(bd->start + bd->blocks * BLOCK_SIZE_W,
+                               ws->todo_lim + stg_max(WORK_UNIT_WORDS,size));
+        debugTrace(DEBUG_gc, "increasing limit for %p to %p",
+                   bd->start, ws->todo_lim);
+        p = ws->todo_free;
+        ws->todo_free += size;
+
+        return p;
     }
     
     gct->copied += ws->todo_free - bd->free;
@@ -201,12 +231,19 @@ todo_block_full (nat size, gen_workspace *ws)
     {
         // If this block does not have enough space to allocate the
         // current object, but it also doesn't have any work to push, then 
-        // push it on to the scanned list.  It cannot be empty, because
-        // then there would be enough room to copy the current object.
+        // push it on to the scanned list.
         if (bd->u.scan == bd->free)
         {
-            ASSERT(bd->free != bd->start);
-            push_scanned_block(bd, ws);
+            if (bd->free == bd->start) {
+                // Normally the block would not be empty, because then
+                // there would be enough room to copy the current
+                // object.  However, if the object we're copying is
+                // larger than a block, then we might have an empty
+                // block here.
+                freeGroup(bd);
+            } else {
+                push_scanned_block(bd, ws);
+            }
         }
         // Otherwise, push this block out to the global list.
         else 
diff --git a/rts/sm/MarkStack.h b/rts/sm/MarkStack.h
index db79ca4520..e2319a544d 100644
--- a/rts/sm/MarkStack.h
+++ b/rts/sm/MarkStack.h
@@ -12,7 +12,7 @@
  * ---------------------------------------------------------------------------*/
 
 #ifndef SM_MARKSTACK_H
-#define SM_MARKSTACk_H
+#define SM_MARKSTACK_H
 
 #include "BeginPrivate.h"
 
diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index d57f7a094b..f0ab5d19d7 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -75,164 +75,133 @@
 typedef enum { WeakPtrs, WeakThreads, WeakDone } WeakStage;
 static WeakStage weak_stage;
 
-/* Weak pointers
- */
-StgWeak *old_weak_ptr_list; // also pending finaliser list
-StgWeak *weak_ptr_list_tail;
+// List of weak pointers whose key is dead
+StgWeak *dead_weak_ptr_list;
 
 // List of threads found to be unreachable
 StgTSO *resurrected_threads;
 
-static void resurrectUnreachableThreads (generation *gen);
-static rtsBool tidyThreadList (generation *gen);
+static void    collectDeadWeakPtrs (generation *gen);
+static rtsBool tidyWeakList (generation *gen);
+static rtsBool resurrectUnreachableThreads (generation *gen);
+static void    tidyThreadList (generation *gen);
 
 void
 initWeakForGC(void)
 {
-    old_weak_ptr_list = weak_ptr_list;
-    weak_ptr_list = NULL;
-    weak_ptr_list_tail = NULL;
-    weak_stage = WeakPtrs;
+    nat g;
+
+    for (g = 0; g <= N; g++) {
+        generation *gen = &generations[g];
+        gen->old_weak_ptr_list = gen->weak_ptr_list;
+        gen->weak_ptr_list = NULL;
+    }
+
+    weak_stage = WeakThreads;
+    dead_weak_ptr_list = NULL;
     resurrected_threads = END_TSO_QUEUE;
 }
 
 rtsBool 
 traverseWeakPtrList(void)
 {
-  StgWeak *w, **last_w, *next_w;
-  StgClosure *new;
   rtsBool flag = rtsFalse;
-  const StgInfoTable *info;
 
   switch (weak_stage) {
 
   case WeakDone:
       return rtsFalse;
 
-  case WeakPtrs:
-      /* doesn't matter where we evacuate values/finalizers to, since
-       * these pointers are treated as roots (iff the keys are alive).
-       */
-      gct->evac_gen_no = 0;
-      
-      last_w = &old_weak_ptr_list;
-      for (w = old_weak_ptr_list; w != NULL; w = next_w) {
-	  
-	  /* There might be a DEAD_WEAK on the list if finalizeWeak# was
-	   * called on a live weak pointer object.  Just remove it.
-	   */
-	  if (w->header.info == &stg_DEAD_WEAK_info) {
-	      next_w = ((StgDeadWeak *)w)->link;
-	      *last_w = next_w;
-	      continue;
-	  }
-	  
-          info = get_itbl((StgClosure *)w);
-	  switch (info->type) {
-
-	  case WEAK:
-	      /* Now, check whether the key is reachable.
-	       */
-	      new = isAlive(w->key);
-	      if (new != NULL) {
-		  w->key = new;
-		  // evacuate the value and finalizer 
-		  evacuate(&w->value);
-		  evacuate(&w->finalizer);
-		  // remove this weak ptr from the old_weak_ptr list 
-		  *last_w = w->link;
-                  next_w  = w->link;
-
-                  // and put it on the new weak ptr list.
-                  // NB. we must retain the order of the weak_ptr_list (#7160)
-                  if (weak_ptr_list == NULL) {
-                      weak_ptr_list = w;
-                  } else {
-                      weak_ptr_list_tail->link = w;
-                  }
-                  weak_ptr_list_tail = w;
-                  w->link = NULL;
-                  flag = rtsTrue;
-
-		  debugTrace(DEBUG_weak, 
-			     "weak pointer still alive at %p -> %p",
-			     w, w->key);
-		  continue;
-	      }
-	      else {
-		  last_w = &(w->link);
-		  next_w = w->link;
-		  continue;
-	      }
-
-	  default:
-	      barf("traverseWeakPtrList: not WEAK");
-	  }
-      }
-      
-      /* If we didn't make any changes, then we can go round and kill all
-       * the dead weak pointers.  The old_weak_ptr list is used as a list
-       * of pending finalizers later on.
-       */
-      if (flag == rtsFalse) {
-	  for (w = old_weak_ptr_list; w; w = w->link) {
-	      evacuate(&w->finalizer);
-	  }
-
-	  // Next, move to the WeakThreads stage after fully
-	  // scavenging the finalizers we've just evacuated.
-	  weak_stage = WeakThreads;
-      }
-
-      return rtsTrue;
-
   case WeakThreads:
-      /* Now deal with the step->threads lists, which behave somewhat like
+      /* Now deal with the gen->threads lists, which behave somewhat like
        * the weak ptr list.  If we discover any threads that are about to
        * become garbage, we wake them up and administer an exception.
        */
   {
       nat g;
 	  
-      // Traverse thread lists for generations we collected...
-//      ToDo when we have one gen per capability:
-//      for (n = 0; n < n_capabilities; n++) {
-//          if (tidyThreadList(&nurseries[n])) {
-//              flag = rtsTrue;
-//          }
-//      }              
       for (g = 0; g <= N; g++) {
-          if (tidyThreadList(&generations[g])) {
+          tidyThreadList(&generations[g]);
+      }
+
+      // Use weak pointer relationships (value is reachable if
+      // key is reachable):
+      for (g = 0; g <= N; g++) {
+          if (tidyWeakList(&generations[g])) {
               flag = rtsTrue;
           }
       }
+      
+      // if we evacuated anything new, we must scavenge thoroughly
+      // before we can determine which threads are unreachable.
+      if (flag) return rtsTrue;
 
-      /* If we evacuated any threads, we need to go back to the scavenger.
-       */
+      // Resurrect any threads which were unreachable
+      for (g = 0; g <= N; g++) {
+          if (resurrectUnreachableThreads(&generations[g])) {
+              flag = rtsTrue;
+          }
+      }
+
+      // Next, move to the WeakPtrs stage after fully
+      // scavenging the finalizers we've just evacuated.
+      weak_stage = WeakPtrs;
+
+      // if we evacuated anything new, we must scavenge thoroughly
+      // before entering the WeakPtrs stage.
       if (flag) return rtsTrue;
 
-      /* And resurrect any threads which were about to become garbage.
+      // otherwise, fall through...
+  }
+
+  case WeakPtrs:
+  {
+      nat g;
+
+      // resurrecting threads might have made more weak pointers
+      // alive, so traverse those lists again:
+      for (g = 0; g <= N; g++) {
+          if (tidyWeakList(&generations[g])) {
+              flag = rtsTrue;
+          }
+      }
+      
+      /* If we didn't make any changes, then we can go round and kill all
+       * the dead weak pointers.  The dead_weak_ptr list is used as a list
+       * of pending finalizers later on.
        */
-      {
-          nat g;
+      if (flag == rtsFalse) {
           for (g = 0; g <= N; g++) {
-              resurrectUnreachableThreads(&generations[g]);
+              collectDeadWeakPtrs(&generations[g]);
           }
+
+          weak_stage = WeakDone;  // *now* we're done,
       }
-        
-      weak_stage = WeakDone;  // *now* we're done,
+
       return rtsTrue;         // but one more round of scavenging, please
   }
-      
+
   default:
       barf("traverse_weak_ptr_list");
       return rtsTrue;
   }
 }
   
-  static void resurrectUnreachableThreads (generation *gen)
+static void collectDeadWeakPtrs (generation *gen)
+{
+    StgWeak *w, *next_w;
+    for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) {
+        evacuate(&w->finalizer);
+        next_w = w->link;
+        w->link = dead_weak_ptr_list;
+        dead_weak_ptr_list = w;
+    }
+}
+
+static rtsBool resurrectUnreachableThreads (generation *gen)
 {
     StgTSO *t, *tmp, *next;
+    rtsBool flag = rtsFalse;
 
     for (t = gen->old_threads; t != END_TSO_QUEUE; t = next) {
         next = t->global_link;
@@ -250,14 +219,89 @@ traverseWeakPtrList(void)
             evacuate((StgClosure **)&tmp);
             tmp->global_link = resurrected_threads;
             resurrected_threads = tmp;
+            flag = rtsTrue;
         }
     }
+    return flag;
 }
 
-static rtsBool tidyThreadList (generation *gen)
+static rtsBool tidyWeakList(generation *gen)
 {
-    StgTSO *t, *tmp, *next, **prev;
+    StgWeak *w, **last_w, *next_w;
+    const StgInfoTable *info;
+    StgClosure *new;
     rtsBool flag = rtsFalse;
+    last_w = &gen->old_weak_ptr_list;
+    for (w = gen->old_weak_ptr_list; w != NULL; w = next_w) {
+
+        /* There might be a DEAD_WEAK on the list if finalizeWeak# was
+         * called on a live weak pointer object.  Just remove it.
+         */
+        if (w->header.info == &stg_DEAD_WEAK_info) {
+            next_w = w->link;
+            *last_w = next_w;
+            continue;
+        }
+
+        info = get_itbl((StgClosure *)w);
+        switch (info->type) {
+
+        case WEAK:
+            /* Now, check whether the key is reachable.
+             */
+            new = isAlive(w->key);
+            if (new != NULL) {
+                generation *new_gen;
+
+                w->key = new;
+
+                // Find out which generation this weak ptr is in, and
+                // move it onto the weak ptr list of that generation.
+
+                new_gen = Bdescr((P_)w)->gen;
+                gct->evac_gen_no = new_gen->no;
+
+                // evacuate the value and finalizer
+                evacuate(&w->value);
+                evacuate(&w->finalizer);
+                // remove this weak ptr from the old_weak_ptr list
+                *last_w = w->link;
+                next_w  = w->link;
+
+                // and put it on the correct weak ptr list.
+                w->link = new_gen->weak_ptr_list;
+                new_gen->weak_ptr_list = w;
+                flag = rtsTrue;
+
+                if (gen->no != new_gen->no) {
+                    debugTrace(DEBUG_weak,
+                      "moving weak pointer %p from %d to %d",
+                      w, gen->no, new_gen->no);
+                }
+
+
+                debugTrace(DEBUG_weak,
+                           "weak pointer still alive at %p -> %p",
+                           w, w->key);
+                continue;
+            }
+            else {
+                last_w = &(w->link);
+                next_w = w->link;
+                continue;
+            }
+
+        default:
+            barf("tidyWeakList: not WEAK: %d, %p", info->type, w);
+        }
+    }
+
+    return flag;
+}
+
+static void tidyThreadList (generation *gen)
+{
+    StgTSO *t, *tmp, *next, **prev;
 
     prev = &gen->old_threads;
 
@@ -297,45 +341,45 @@ static rtsBool tidyThreadList (generation *gen)
             new_gen->threads  = t;
         }
     }
-
-    return flag;
 }
 
 /* -----------------------------------------------------------------------------
    Evacuate every weak pointer object on the weak_ptr_list, and update
    the link fields.
-
-   ToDo: with a lot of weak pointers, this will be expensive.  We
-   should have a per-GC weak pointer list, just like threads.
    -------------------------------------------------------------------------- */
 
 void
 markWeakPtrList ( void )
 {
-  StgWeak *w, **last_w;
+    nat g;
+
+    for (g = 0; g <= N; g++) {
+        generation *gen = &generations[g];
+        StgWeak *w, **last_w;
 
-  last_w = &weak_ptr_list;
-  for (w = weak_ptr_list; w; w = w->link) {
-      // w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here
+        last_w = &gen->weak_ptr_list;
+        for (w = gen->weak_ptr_list; w != NULL; w = w->link) {
+            // w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here
 
 #ifdef DEBUG
-      {   // careful to do this assertion only reading the info ptr
-          // once, because during parallel GC it might change under our feet.
-          const StgInfoTable *info;
-          info = w->header.info;
-          ASSERT(IS_FORWARDING_PTR(info)
-                 || info == &stg_DEAD_WEAK_info 
-                 || INFO_PTR_TO_STRUCT(info)->type == WEAK);
-      }
+            {   // careful to do this assertion only reading the info ptr
+                // once, because during parallel GC it might change under our feet.
+                const StgInfoTable *info;
+                info = w->header.info;
+                ASSERT(IS_FORWARDING_PTR(info)
+                       || info == &stg_DEAD_WEAK_info
+                       || INFO_PTR_TO_STRUCT(info)->type == WEAK);
+            }
 #endif
 
-      evacuate((StgClosure **)last_w);
-      w = *last_w;
-      if (w->header.info == &stg_DEAD_WEAK_info) {
-          last_w = &(((StgDeadWeak*)w)->link);
-      } else {
-          last_w = &(w->link);
-      }
-  }
+            evacuate((StgClosure **)last_w);
+            w = *last_w;
+            if (w->header.info == &stg_DEAD_WEAK_info) {
+                last_w = &(w->link);
+            } else {
+                last_w = &(w->link);
+            }
+        }
+    }
 }
 
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index f0e1659e12..9b579abbbc 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -519,6 +519,7 @@ checkTSO(StgTSO *tso)
            info == &stg_WHITEHOLE_info); // happens due to STM doing lockTSO()
 
     if (   tso->why_blocked == BlockedOnMVar
+        || tso->why_blocked == BlockedOnMVarRead
 	|| tso->why_blocked == BlockedOnBlackHole
 	|| tso->why_blocked == BlockedOnMsgThrowTo
         || tso->why_blocked == NotBlocked
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 6137f6d862..e0cc688b95 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -71,6 +71,7 @@ scavengeTSO (StgTSO *tso)
 
     evacuate((StgClosure **)&tso->_link);
     if (   tso->why_blocked == BlockedOnMVar
+        || tso->why_blocked == BlockedOnMVarRead
 	|| tso->why_blocked == BlockedOnBlackHole
 	|| tso->why_blocked == BlockedOnMsgThrowTo
         || tso->why_blocked == NotBlocked
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 5c4e54f98d..a5337bc5b2 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -29,6 +29,9 @@
 #include "Trace.h"
 #include "GC.h"
 #include "Evac.h"
+#if defined(ios_HOST_OS)
+#include "Hash.h"
+#endif
 
 #include <string.h>
 
@@ -90,6 +93,8 @@ initGeneration (generation *gen, int g)
 #endif
     gen->threads = END_TSO_QUEUE;
     gen->old_threads = END_TSO_QUEUE;
+    gen->weak_ptr_list = NULL;
+    gen->old_weak_ptr_list = NULL;
 }
 
 void
@@ -166,7 +171,6 @@ initStorage (void)
 
   generations[0].max_blocks = 0;
 
-  weak_ptr_list = NULL;
   caf_list = END_OF_STATIC_LIST;
   revertible_caf_list = END_OF_STATIC_LIST;
    
@@ -1094,7 +1098,7 @@ calcNeeded (rtsBool force_major, memcount *blocks_needed)
 // because it knows how to work around the restrictions put in place
 // by SELinux.
 
-void *allocateExec (W_ bytes, void **exec_ret)
+AdjustorWritable allocateExec (W_ bytes, AdjustorExecutable *exec_ret)
 {
     void **ret, **exec;
     ACQUIRE_SM_LOCK;
@@ -1107,18 +1111,65 @@ void *allocateExec (W_ bytes, void **exec_ret)
 }
 
 // freeExec gets passed the executable address, not the writable address. 
-void freeExec (void *addr)
+void freeExec (AdjustorExecutable addr)
 {
-    void *writable;
+    AdjustorWritable writable;
     writable = *((void**)addr - 1);
     ACQUIRE_SM_LOCK;
     ffi_closure_free (writable);
     RELEASE_SM_LOCK
 }
 
+#elif defined(ios_HOST_OS)
+
+static HashTable* allocatedExecs;
+
+AdjustorWritable allocateExec(W_ bytes, AdjustorExecutable *exec_ret)
+{
+    AdjustorWritable writ;
+    ffi_closure* cl;
+    if (bytes != sizeof(ffi_closure)) {
+        barf("allocateExec: for ffi_closure only");
+    }
+    ACQUIRE_SM_LOCK;
+    cl = writ = ffi_closure_alloc((size_t)bytes, exec_ret);
+    if (cl != NULL) {
+        if (allocatedExecs == NULL) {
+            allocatedExecs = allocHashTable();
+        }
+        insertHashTable(allocatedExecs, (StgWord)*exec_ret, writ);
+    }
+    RELEASE_SM_LOCK;
+    return writ;
+}
+
+AdjustorWritable execToWritable(AdjustorExecutable exec)
+{
+    AdjustorWritable writ;
+    ACQUIRE_SM_LOCK;
+    if (allocatedExecs == NULL ||
+       (writ = lookupHashTable(allocatedExecs, (StgWord)exec)) == NULL) {
+        RELEASE_SM_LOCK;
+        barf("execToWritable: not found");
+    }
+    RELEASE_SM_LOCK;
+    return writ;
+}
+
+void freeExec(AdjustorExecutable exec)
+{
+    AdjustorWritable writ;
+    ffi_closure* cl;
+    cl = writ = execToWritable(exec);
+    ACQUIRE_SM_LOCK;
+    removeHashTable(allocatedExecs, (StgWord)exec, writ);
+    ffi_closure_free(cl);
+    RELEASE_SM_LOCK
+}
+
 #else
 
-void *allocateExec (W_ bytes, void **exec_ret)
+AdjustorWritable allocateExec (W_ bytes, AdjustorExecutable *exec_ret)
 {
     void *ret;
     W_ n;