RTS tidyup sweep, first phase

The first phase of this tidyup is focussed on the header files, and in
particular making sure we are exposinng publicly exactly what we need
to, and no more.

 - Rts.h now includes everything that the RTS exposes publicly,
   rather than a random subset of it.

 - Most of the public header files have moved into subdirectories, and
   many of them have been renamed.  But clients should not need to
   include any of the other headers directly, just #include the main
   public headers: Rts.h, HsFFI.h, RtsAPI.h.

 - All the headers needed for via-C compilation have moved into the
   stg subdirectory, which is self-contained.  Most of the headers for
   the rest of the RTS APIs have moved into the rts subdirectory.

 - I left MachDeps.h where it is, because it is so widely used in
   Haskell code.
 
 - I left a deprecated stub for RtsFlags.h in place.  The flag
   structures are now exposed by Rts.h.

 - Various internal APIs are no longer exposed by public header files.

 - Various bits of dead code and declarations have been removed

 - More gcc warnings are turned on, and the RTS code is more
   warning-clean.

 - More source files #include "PosixSource.h", and hence only use
   standard POSIX (1003.1c-1995) interfaces.

There is a lot more tidying up still to do, this is just the first
pass.  I also intend to standardise the names for external RTS APIs
(e.g use the rts_ prefix consistently), and declare the internal APIs
as hidden for shared libraries.

11 files changed, 2371 insertions, 0 deletions

diff --git a/includes/rts/storage/Block.h b/includes/rts/storage/Block.h
new file mode 100644
index 0000000000..849f99f430
--- /dev/null
+++ b/includes/rts/storage/Block.h
@@ -0,0 +1,271 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-1999
+ *
+ * Block structure for the storage manager
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef RTS_STORAGE_BLOCK_H
+#define RTS_STORAGE_BLOCK_H
+
+/* The actual block and megablock-size constants are defined in
+ * includes/Constants.h, all constants here are derived from these.
+ */
+
+/* Block related constants (BLOCK_SHIFT is defined in Constants.h) */
+
+#define BLOCK_SIZE   (1<<BLOCK_SHIFT)
+#define BLOCK_SIZE_W (BLOCK_SIZE/sizeof(W_))
+#define BLOCK_MASK   (BLOCK_SIZE-1)
+
+#define BLOCK_ROUND_UP(p)   ((void *) (((W_)(p)+BLOCK_SIZE-1) & ~BLOCK_MASK))
+#define BLOCK_ROUND_DOWN(p) ((void *) ((W_)(p) & ~BLOCK_MASK))
+
+/* Megablock related constants (MBLOCK_SHIFT is defined in Constants.h) */
+
+#define MBLOCK_SIZE    (1<<MBLOCK_SHIFT)
+#define MBLOCK_SIZE_W  (MBLOCK_SIZE/sizeof(W_))
+#define MBLOCK_MASK    (MBLOCK_SIZE-1)
+
+#define MBLOCK_ROUND_UP(p)   ((void *)(((W_)(p)+MBLOCK_SIZE-1) & ~MBLOCK_MASK))
+#define MBLOCK_ROUND_DOWN(p) ((void *)((W_)(p) & ~MBLOCK_MASK ))
+
+/* The largest size an object can be before we give it a block of its
+ * own and treat it as an immovable object during GC, expressed as a
+ * fraction of BLOCK_SIZE.
+ */
+#define LARGE_OBJECT_THRESHOLD ((nat)(BLOCK_SIZE * 8 / 10))
+
+/* -----------------------------------------------------------------------------
+ * Block descriptor.  This structure *must* be the right length, so we
+ * can do pointer arithmetic on pointers to it.
+ */
+
+/* The block descriptor is 64 bytes on a 64-bit machine, and 32-bytes
+ * on a 32-bit machine.
+ */
+
+#ifndef CMINUSMINUS
+typedef struct bdescr_ {
+  StgPtr start;			/* start addr of memory */
+  StgPtr free;			/* first free byte of memory */
+  struct bdescr_ *link;		/* used for chaining blocks together */
+  union { 
+      struct bdescr_ *back;	/* used (occasionally) for doubly-linked lists*/
+      StgWord *bitmap;
+      StgPtr  scan;             /* scan pointer for copying GC */
+  } u;
+  unsigned int gen_no;		/* generation */
+  struct step_ *step;		/* step */
+  StgWord32 blocks;		/* no. of blocks (if grp head, 0 otherwise) */
+  StgWord32 flags;              /* block is in to-space */
+#if SIZEOF_VOID_P == 8
+  StgWord32 _padding[2];
+#else
+  StgWord32 _padding[0];
+#endif
+} bdescr;
+#endif
+
+#if SIZEOF_VOID_P == 8
+#define BDESCR_SIZE  0x40
+#define BDESCR_MASK  0x3f
+#define BDESCR_SHIFT 6
+#else
+#define BDESCR_SIZE  0x20
+#define BDESCR_MASK  0x1f
+#define BDESCR_SHIFT 5
+#endif
+
+/* Block contains objects evacuated during this GC */
+#define BF_EVACUATED 1
+/* Block is a large object */
+#define BF_LARGE     2
+/* Block is pinned */
+#define BF_PINNED    4
+/* Block is to be marked, not copied */
+#define BF_MARKED    8
+/* Block is free, and on the free list  (TODO: is this used?) */
+#define BF_FREE      16
+/* Block is executable */
+#define BF_EXEC	     32
+/* Block contains only a small amount of live data */
+#define BF_FRAGMENTED 64
+/* we know about this block (for finding leaks) */
+#define BF_KNOWN     128
+
+/* Finding the block descriptor for a given block -------------------------- */
+
+#ifdef CMINUSMINUS
+
+#define Bdescr(p) \
+    ((((p) &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) \
+     | ((p) & ~MBLOCK_MASK))
+
+#else
+
+INLINE_HEADER bdescr *Bdescr(StgPtr p)
+{
+  return (bdescr *)
+    ((((W_)p &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) 
+     | ((W_)p & ~MBLOCK_MASK)
+     );
+}
+
+#endif
+
+/* Useful Macros ------------------------------------------------------------ */
+
+/* Offset of first real data block in a megablock */
+
+#define FIRST_BLOCK_OFF \
+   ((W_)BLOCK_ROUND_UP(BDESCR_SIZE * (MBLOCK_SIZE / BLOCK_SIZE)))
+
+/* First data block in a given megablock */
+
+#define FIRST_BLOCK(m) ((void *)(FIRST_BLOCK_OFF + (W_)(m)))
+   
+/* Last data block in a given megablock */
+
+#define LAST_BLOCK(m)  ((void *)(MBLOCK_SIZE-BLOCK_SIZE + (W_)(m)))
+
+/* First real block descriptor in a megablock */
+
+#define FIRST_BDESCR(m) \
+   ((bdescr *)((FIRST_BLOCK_OFF>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m)))
+
+/* Last real block descriptor in a megablock */
+
+#define LAST_BDESCR(m) \
+  ((bdescr *)(((MBLOCK_SIZE-BLOCK_SIZE)>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m)))
+
+/* Number of usable blocks in a megablock */
+
+#define BLOCKS_PER_MBLOCK ((MBLOCK_SIZE - FIRST_BLOCK_OFF) / BLOCK_SIZE)
+
+/* How many blocks in this megablock group */
+
+#define MBLOCK_GROUP_BLOCKS(n) \
+   (BLOCKS_PER_MBLOCK + (n-1) * (MBLOCK_SIZE / BLOCK_SIZE))
+
+/* Compute the required size of a megablock group */
+
+#define BLOCKS_TO_MBLOCKS(n) \
+   (1 + (W_)MBLOCK_ROUND_UP((n-BLOCKS_PER_MBLOCK) * BLOCK_SIZE) / MBLOCK_SIZE)
+
+
+#ifndef CMINUSMINUS 
+/* to the end... */
+
+/* Double-linked block lists: --------------------------------------------- */
+
+INLINE_HEADER void
+dbl_link_onto(bdescr *bd, bdescr **list)
+{
+  bd->link = *list;
+  bd->u.back = NULL;
+  if (*list) {
+    (*list)->u.back = bd; /* double-link the list */
+  }
+  *list = bd;
+}
+
+INLINE_HEADER void
+dbl_link_remove(bdescr *bd, bdescr **list)
+{
+    if (bd->u.back) {
+        bd->u.back->link = bd->link;
+    } else {
+        *list = bd->link;
+    }
+    if (bd->link) {
+        bd->link->u.back = bd->u.back;
+    }
+}
+
+INLINE_HEADER void
+dbl_link_insert_after(bdescr *bd, bdescr *after)
+{
+    bd->link = after->link;
+    bd->u.back = after;
+    if (after->link) {
+        after->link->u.back = bd;
+    }
+    after->link = bd;
+}
+
+INLINE_HEADER void
+dbl_link_replace(bdescr *new, bdescr *old, bdescr **list)
+{
+    new->link = old->link;
+    new->u.back = old->u.back;
+    if (old->link) {
+        old->link->u.back = new;
+    }
+    if (old->u.back) {
+        old->u.back->link = new;
+    } else {
+        *list = new;
+    }
+}
+
+/* Initialisation ---------------------------------------------------------- */
+
+extern void initBlockAllocator(void);
+
+/* Allocation -------------------------------------------------------------- */
+
+bdescr *allocGroup(nat n);
+bdescr *allocBlock(void);
+
+// versions that take the storage manager lock for you:
+bdescr *allocGroup_lock(nat n);
+bdescr *allocBlock_lock(void);
+
+/* De-Allocation ----------------------------------------------------------- */
+
+void freeGroup(bdescr *p);
+void freeChain(bdescr *p);
+
+// versions that take the storage manager lock for you:
+void freeGroup_lock(bdescr *p);
+void freeChain_lock(bdescr *p);
+
+bdescr * splitBlockGroup (bdescr *bd, nat blocks);
+
+/* Round a value to megablocks --------------------------------------------- */
+
+// We want to allocate an object around a given size, round it up or
+// down to the nearest size that will fit in an mblock group.
+INLINE_HEADER StgWord
+round_to_mblocks(StgWord words)
+{
+    if (words > BLOCKS_PER_MBLOCK * BLOCK_SIZE_W) {
+        // first, ignore the gap at the beginning of the first mblock by
+        // adding it to the total words.  Then we can pretend we're
+        // dealing in a uniform unit of megablocks.
+        words += FIRST_BLOCK_OFF/sizeof(W_);
+
+        if ((words % MBLOCK_SIZE_W) < (MBLOCK_SIZE_W / 2)) {
+            words = (words / MBLOCK_SIZE_W) * MBLOCK_SIZE_W;
+        } else {
+            words = ((words / MBLOCK_SIZE_W) + 1) * MBLOCK_SIZE_W;
+        }
+
+        words -= FIRST_BLOCK_OFF/sizeof(W_);
+    }
+    return words;
+}
+
+INLINE_HEADER StgWord
+round_up_to_mblocks(StgWord words)
+{
+    words += FIRST_BLOCK_OFF/sizeof(W_);
+    words = ((words / MBLOCK_SIZE_W) + 1) * MBLOCK_SIZE_W;
+    words -= FIRST_BLOCK_OFF/sizeof(W_);
+    return words;
+}
+
+#endif /* !CMINUSMINUS */
+#endif /* RTS_STORAGE_BLOCK_H */
diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h
new file mode 100644
index 0000000000..458960f3f7
--- /dev/null
+++ b/includes/rts/storage/ClosureMacros.h
@@ -0,0 +1,395 @@
+/* ----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2004
+ *
+ * Macros for building and manipulating closures
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifndef RTS_STORAGE_CLOSUREMACROS_H
+#define RTS_STORAGE_CLOSUREMACROS_H
+
+/* -----------------------------------------------------------------------------
+   Info tables are slammed up against the entry code, and the label
+   for the info table is at the *end* of the table itself.  This
+   inline function adjusts an info pointer to point to the beginning
+   of the table, so we can use standard C structure indexing on it.
+
+   Note: this works for SRT info tables as long as you don't want to
+   access the SRT, since they are laid out the same with the SRT
+   pointer as the first word in the table.
+
+   NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
+
+   A couple of definitions:
+
+       "info pointer"    The first word of the closure.  Might point
+                         to either the end or the beginning of the
+			 info table, depending on whether we're using
+			 the mini interpretter or not.  GET_INFO(c)
+			 retrieves the info pointer of a closure.
+
+       "info table"      The info table structure associated with a
+                         closure.  This is always a pointer to the
+			 beginning of the structure, so we can
+			 use standard C structure indexing to pull out
+			 the fields.  get_itbl(c) returns a pointer to
+			 the info table for closure c.
+
+   An address of the form xxxx_info points to the end of the info
+   table or the beginning of the info table depending on whether we're
+   mangling or not respectively.  So, 
+
+         c->header.info = xxx_info 
+
+   makes absolute sense, whether mangling or not.
+ 
+   -------------------------------------------------------------------------- */
+
+#define SET_INFO(c,i) ((c)->header.info = (i))
+#define GET_INFO(c)   ((c)->header.info)
+#define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
+
+#define get_itbl(c)   (INFO_PTR_TO_STRUCT((c)->header.info))
+#define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
+#define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
+#define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
+#define get_con_itbl(c) (CON_INFO_PTR_TO_STRUCT((c)->header.info))
+
+#define GET_TAG(con) (get_itbl(con)->srt_bitmap)
+
+#ifdef TABLES_NEXT_TO_CODE
+#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
+#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
+#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
+#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
+#define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)(info) - 1)
+#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
+#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
+#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
+#define itbl_to_con_itbl(i) ((StgConInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
+#else
+#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
+#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
+#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
+#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
+#define CON_INFO_PTR_TO_STRUCT(info) ((StgConInfoTable *)info)
+#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
+#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
+#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
+#define itbl_to_con_itbl(i) ((StgConInfoTable *)(i))
+#endif
+
+/* -----------------------------------------------------------------------------
+   Macros for building closures
+   -------------------------------------------------------------------------- */
+
+#ifdef PROFILING
+#ifdef DEBUG_RETAINER
+/* 
+  For the sake of debugging, we take the safest way for the moment. Actually, this 
+  is useful to check the sanity of heap before beginning retainer profiling.
+  flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
+  Note: change those functions building Haskell objects from C datatypes, i.e.,
+  all rts_mk???() functions in RtsAPI.c, as well.
+ */
+#define SET_PROF_HDR(c,ccs_)            \
+        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
+#else
+/*
+  For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
+  NULL | flip (flip is defined in RetainerProfile.c) because even when flip
+  is 1, rs is invalid and will be initialized to NULL | flip later when 
+  the closure *c is visited.
+ */
+/*
+#define SET_PROF_HDR(c,ccs_)            \
+        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
+ */
+/*
+  The following macro works for both retainer profiling and LDV profiling:
+  for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
+  See the invariants on ldvTime.
+ */
+#define SET_PROF_HDR(c,ccs_)            \
+        ((c)->header.prof.ccs = ccs_,   \
+        LDV_RECORD_CREATE((c)))
+#endif /* DEBUG_RETAINER */
+#else
+#define SET_PROF_HDR(c,ccs)
+#endif
+
+#define SET_HDR(c,_info,ccs)				\
+   {							\
+	(c)->header.info = _info;			\
+	SET_PROF_HDR((StgClosure *)(c),ccs);		\
+   }
+
+#define SET_ARR_HDR(c,info,costCentreStack,n_words)	\
+   SET_HDR(c,info,costCentreStack);			\
+   (c)->words = n_words;
+
+/* -----------------------------------------------------------------------------
+   How to get hold of the static link field for a static closure.
+   -------------------------------------------------------------------------- */
+
+/* These are hard-coded. */
+#define FUN_STATIC_LINK(p)   (&(p)->payload[0])
+#define THUNK_STATIC_LINK(p) (&(p)->payload[1])
+#define IND_STATIC_LINK(p)   (&(p)->payload[1])
+
+INLINE_HEADER StgClosure **
+STATIC_LINK(const StgInfoTable *info, StgClosure *p)
+{ 
+    switch (info->type) {
+    case THUNK_STATIC:
+	return THUNK_STATIC_LINK(p);
+    case FUN_STATIC:
+	return FUN_STATIC_LINK(p);
+    case IND_STATIC:
+	return IND_STATIC_LINK(p);
+    default:
+	return &(p)->payload[info->layout.payload.ptrs +
+			     info->layout.payload.nptrs];
+    }
+}
+
+#define STATIC_LINK2(info,p)							\
+   (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +			\
+					info->layout.payload.nptrs + 1])))
+
+/* -----------------------------------------------------------------------------
+   INTLIKE and CHARLIKE closures.
+   -------------------------------------------------------------------------- */
+
+#define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
+#define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
+
+/* ----------------------------------------------------------------------------
+   Macros for untagging and retagging closure pointers
+   For more information look at the comments in Cmm.h
+   ------------------------------------------------------------------------- */
+
+static inline StgWord
+GET_CLOSURE_TAG(StgClosure * p)
+{
+    return (StgWord)p & TAG_MASK;
+}
+
+static inline StgClosure *
+UNTAG_CLOSURE(StgClosure * p)
+{
+    return (StgClosure*)((StgWord)p & ~TAG_MASK);
+}
+
+static inline StgClosure *
+TAG_CLOSURE(StgWord tag,StgClosure * p)
+{
+    return (StgClosure*)((StgWord)p | tag);
+}
+
+/* -----------------------------------------------------------------------------
+   Forwarding pointers
+   -------------------------------------------------------------------------- */
+
+#define IS_FORWARDING_PTR(p) ((((StgWord)p) & 1) != 0)
+#define MK_FORWARDING_PTR(p) (((StgWord)p) | 1)
+#define UN_FORWARDING_PTR(p) (((StgWord)p) - 1)
+
+/* -----------------------------------------------------------------------------
+   DEBUGGING predicates for pointers
+
+   LOOKS_LIKE_INFO_PTR(p)    returns False if p is definitely not an info ptr
+   LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr
+
+   These macros are complete but not sound.  That is, they might
+   return false positives.  Do not rely on them to distinguish info
+   pointers from closure pointers, for example.
+
+   We don't use address-space predicates these days, for portability
+   reasons, and the fact that code/data can be scattered about the
+   address space in a dynamically-linked environment.  Our best option
+   is to look at the alleged info table and see whether it seems to
+   make sense...
+   -------------------------------------------------------------------------- */
+
+INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR_NOT_NULL (StgWord p)
+{
+    StgInfoTable *info = INFO_PTR_TO_STRUCT(p);
+    return info->type != INVALID_OBJECT && info->type < N_CLOSURE_TYPES;
+}
+
+INLINE_HEADER rtsBool LOOKS_LIKE_INFO_PTR (StgWord p)
+{
+    return p && (IS_FORWARDING_PTR(p) || LOOKS_LIKE_INFO_PTR_NOT_NULL(p));
+}
+
+INLINE_HEADER rtsBool LOOKS_LIKE_CLOSURE_PTR (void *p)
+{
+    return LOOKS_LIKE_INFO_PTR((StgWord)(UNTAG_CLOSURE((StgClosure *)(p)))->header.info);
+}
+
+/* -----------------------------------------------------------------------------
+   Macros for calculating the size of a closure
+   -------------------------------------------------------------------------- */
+
+INLINE_HEADER StgOffset PAP_sizeW   ( nat n_args )
+{ return sizeofW(StgPAP) + n_args; }
+
+INLINE_HEADER StgOffset AP_sizeW   ( nat n_args )
+{ return sizeofW(StgAP) + n_args; }
+
+INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size )
+{ return sizeofW(StgAP_STACK) + size; }
+
+INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np )
+{ return sizeofW(StgHeader) + p + np; }
+
+INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void )
+{ return sizeofW(StgSelector); }
+
+INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void )
+{ return sizeofW(StgHeader)+MIN_PAYLOAD_SIZE; }
+
+/* --------------------------------------------------------------------------
+   Sizes of closures
+   ------------------------------------------------------------------------*/
+
+INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl )
+{ return sizeofW(StgClosure)
+       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
+       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
+
+INLINE_HEADER StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl )
+{ return sizeofW(StgThunk)
+       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs
+       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
+
+INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x )
+{ return AP_STACK_sizeW(x->size); }
+
+INLINE_HEADER StgOffset ap_sizeW( StgAP* x )
+{ return AP_sizeW(x->n_args); }
+
+INLINE_HEADER StgOffset pap_sizeW( StgPAP* x )
+{ return PAP_sizeW(x->n_args); }
+
+INLINE_HEADER StgOffset arr_words_sizeW( StgArrWords* x )
+{ return sizeofW(StgArrWords) + x->words; }
+
+INLINE_HEADER StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
+{ return sizeofW(StgMutArrPtrs) + x->ptrs; }
+
+INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso )
+{ return TSO_STRUCT_SIZEW + tso->stack_size; }
+
+INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco )
+{ return bco->size; }
+
+INLINE_HEADER nat
+closure_sizeW_ (StgClosure *p, StgInfoTable *info)
+{
+    switch (info->type) {
+    case THUNK_0_1:
+    case THUNK_1_0:
+	return sizeofW(StgThunk) + 1;
+    case FUN_0_1:
+    case CONSTR_0_1:
+    case FUN_1_0:
+    case CONSTR_1_0:
+	return sizeofW(StgHeader) + 1;
+    case THUNK_0_2:
+    case THUNK_1_1:
+    case THUNK_2_0:
+	return sizeofW(StgThunk) + 2;
+    case FUN_0_2:
+    case CONSTR_0_2:
+    case FUN_1_1:
+    case CONSTR_1_1:
+    case FUN_2_0:
+    case CONSTR_2_0:
+	return sizeofW(StgHeader) + 2;
+    case THUNK:
+	return thunk_sizeW_fromITBL(info);
+    case THUNK_SELECTOR:
+	return THUNK_SELECTOR_sizeW();
+    case AP_STACK:
+	return ap_stack_sizeW((StgAP_STACK *)p);
+    case AP:
+	return ap_sizeW((StgAP *)p);
+    case PAP:
+	return pap_sizeW((StgPAP *)p);
+    case IND:
+    case IND_PERM:
+    case IND_OLDGEN:
+    case IND_OLDGEN_PERM:
+	return sizeofW(StgInd);
+    case ARR_WORDS:
+	return arr_words_sizeW((StgArrWords *)p);
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
+    case MUT_ARR_PTRS_FROZEN:
+    case MUT_ARR_PTRS_FROZEN0:
+	return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
+    case TSO:
+	return tso_sizeW((StgTSO *)p);
+    case BCO:
+	return bco_sizeW((StgBCO *)p);
+    case TVAR_WATCH_QUEUE:
+        return sizeofW(StgTVarWatchQueue);
+    case TVAR:
+        return sizeofW(StgTVar);
+    case TREC_CHUNK:
+        return sizeofW(StgTRecChunk);
+    case TREC_HEADER:
+        return sizeofW(StgTRecHeader);
+    case ATOMIC_INVARIANT:
+        return sizeofW(StgAtomicInvariant);
+    case INVARIANT_CHECK_QUEUE:
+        return sizeofW(StgInvariantCheckQueue);
+    default:
+	return sizeW_fromITBL(info);
+    }
+}
+
+// The definitive way to find the size, in words, of a heap-allocated closure
+INLINE_HEADER nat
+closure_sizeW (StgClosure *p)
+{
+    return closure_sizeW_(p, get_itbl(p));
+}
+
+/* -----------------------------------------------------------------------------
+   Sizes of stack frames
+   -------------------------------------------------------------------------- */
+
+INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame )
+{
+    StgRetInfoTable *info;
+
+    info = get_ret_itbl(frame);
+    switch (info->i.type) {
+
+    case RET_DYN:
+    {
+	StgRetDyn *dyn = (StgRetDyn *)frame;
+	return  sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + 
+	    RET_DYN_NONPTR_REGS_SIZE +
+	    RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness);
+    }
+	    
+    case RET_FUN:
+	return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
+
+    case RET_BIG:
+	return 1 + GET_LARGE_BITMAP(&info->i)->size;
+
+    case RET_BCO:
+	return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
+
+    default:
+	return 1 + BITMAP_SIZE(info->i.layout.bitmap);
+    }
+}
+
+#endif /* RTS_STORAGE_CLOSUREMACROS_H */
diff --git a/includes/rts/storage/ClosureTypes.h b/includes/rts/storage/ClosureTypes.h
new file mode 100644
index 0000000000..3415d423a3
--- /dev/null
+++ b/includes/rts/storage/ClosureTypes.h
@@ -0,0 +1,96 @@
+/* ----------------------------------------------------------------------------
+ * 
+ * (c) The GHC Team, 1998-2005
+ *
+ * Closure Type Constants: out here because the native code generator
+ * needs to get at them.
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifndef RTS_STORAGE_CLOSURETYPES_H
+#define RTS_STORAGE_CLOSURETYPES_H
+
+/* 
+ * WARNING WARNING WARNING
+ *
+ * Keep the closure tags contiguous: rts/ClosureFlags.c relies on
+ * this.
+ *
+ * If you add or delete any closure types, don't forget to update
+ * the closure flags table in rts/ClosureFlags.c.
+ */
+
+/* Object tag 0 raises an internal error */
+#define INVALID_OBJECT          0
+#define CONSTR                  1
+#define	CONSTR_1_0		2
+#define	CONSTR_0_1		3
+#define	CONSTR_2_0		4
+#define	CONSTR_1_1		5
+#define	CONSTR_0_2		6
+#define CONSTR_STATIC	        7
+#define CONSTR_NOCAF_STATIC     8
+#define FUN		        9 
+#define	FUN_1_0		  	10
+#define	FUN_0_1		  	11
+#define	FUN_2_0		  	12
+#define	FUN_1_1		  	13
+#define	FUN_0_2			14
+#define FUN_STATIC	        15
+#define THUNK		        16
+#define	THUNK_1_0	  	17
+#define	THUNK_0_1	  	18
+#define	THUNK_2_0	  	19
+#define	THUNK_1_1	  	20
+#define	THUNK_0_2		21
+#define THUNK_STATIC	        22
+#define THUNK_SELECTOR	        23
+#define BCO		        24
+#define AP		        25
+#define PAP			26
+#define AP_STACK                27
+#define IND		        28
+#define IND_OLDGEN	        29
+#define IND_PERM	        30
+#define IND_OLDGEN_PERM	        31
+#define IND_STATIC	        32
+#define RET_BCO                 33
+#define RET_SMALL	        34
+#define RET_BIG		        35
+#define RET_DYN		        36
+#define RET_FUN                 37
+#define UPDATE_FRAME	        38
+#define CATCH_FRAME	        39
+#define STOP_FRAME	        40
+#define CAF_BLACKHOLE		41
+#define BLACKHOLE	        42
+#define MVAR_CLEAN	        43
+#define MVAR_DIRTY	        44
+#define ARR_WORDS	        45
+#define MUT_ARR_PTRS_CLEAN      46
+#define MUT_ARR_PTRS_DIRTY      47
+#define MUT_ARR_PTRS_FROZEN0    48
+#define MUT_ARR_PTRS_FROZEN     49
+#define MUT_VAR_CLEAN	        50
+#define MUT_VAR_DIRTY	        51
+#define WEAK		        52
+#define STABLE_NAME	        53
+#define TSO		        54
+#define BLOCKED_FETCH	        55
+#define FETCH_ME                56
+#define FETCH_ME_BQ             57
+#define RBH                     58
+#define REMOTE_REF              59
+#define TVAR_WATCH_QUEUE        60
+#define INVARIANT_CHECK_QUEUE   61
+#define ATOMIC_INVARIANT        62
+#define TVAR                    63
+#define TREC_CHUNK              64
+#define TREC_HEADER             65
+#define ATOMICALLY_FRAME        66
+#define CATCH_RETRY_FRAME       67
+#define CATCH_STM_FRAME         68
+#define WHITEHOLE               69
+#define N_CLOSURE_TYPES         70
+
+#endif /* RTS_STORAGE_CLOSURETYPES_H */
diff --git a/includes/rts/storage/Closures.h b/includes/rts/storage/Closures.h
new file mode 100644
index 0000000000..6e06e57f3c
--- /dev/null
+++ b/includes/rts/storage/Closures.h
@@ -0,0 +1,417 @@
+/* ----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2004
+ *
+ * Closures
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifndef RTS_STORAGE_CLOSURES_H
+#define RTS_STORAGE_CLOSURES_H
+
+/*
+ * The Layout of a closure header depends on which kind of system we're
+ * compiling for: profiling, parallel, ticky, etc.
+ */
+
+/* -----------------------------------------------------------------------------
+   The profiling header
+   -------------------------------------------------------------------------- */
+
+typedef struct {
+  CostCentreStack *ccs;
+  union {
+    struct _RetainerSet *rs;  /* Retainer Set */
+    StgWord ldvw;             /* Lag/Drag/Void Word */
+  } hp;
+} StgProfHeader;
+
+/* -----------------------------------------------------------------------------
+   The SMP header
+   
+   A thunk has a padding word to take the updated value.  This is so
+   that the update doesn't overwrite the payload, so we can avoid
+   needing to lock the thunk during entry and update.
+   
+   Note: this doesn't apply to THUNK_STATICs, which have no payload.
+
+   Note: we leave this padding word in all ways, rather than just SMP,
+   so that we don't have to recompile all our libraries for SMP.
+   -------------------------------------------------------------------------- */
+
+typedef struct {
+    StgWord pad;
+} StgSMPThunkHeader;
+
+/* -----------------------------------------------------------------------------
+   The full fixed-size closure header
+
+   The size of the fixed header is the sum of the optional parts plus a single
+   word for the entry code pointer.
+   -------------------------------------------------------------------------- */
+
+typedef struct {
+    const StgInfoTable* info;
+#ifdef PROFILING
+    StgProfHeader         prof;
+#endif
+} StgHeader;
+
+typedef struct {
+    const StgInfoTable* info;
+#ifdef PROFILING
+    StgProfHeader         prof;
+#endif
+    StgSMPThunkHeader     smp;
+} StgThunkHeader;
+
+#define THUNK_EXTRA_HEADER_W (sizeofW(StgThunkHeader)-sizeofW(StgHeader))
+
+/* -----------------------------------------------------------------------------
+   Closure Types
+
+   For any given closure type (defined in InfoTables.h), there is a
+   corresponding structure defined below.  The name of the structure
+   is obtained by concatenating the closure type with '_closure'
+   -------------------------------------------------------------------------- */
+
+/* All closures follow the generic format */
+
+typedef struct StgClosure_ {
+    StgHeader   header;
+    struct StgClosure_ *payload[FLEXIBLE_ARRAY];
+} *StgClosurePtr; // StgClosure defined in Rts.h
+
+typedef struct {
+    StgThunkHeader  header;
+    struct StgClosure_ *payload[FLEXIBLE_ARRAY];
+} StgThunk;
+
+typedef struct {
+    StgThunkHeader   header;
+    StgClosure *selectee;
+} StgSelector;
+
+typedef struct {
+    StgHeader   header;
+    StgHalfWord arity;		/* zero if it is an AP */
+    StgHalfWord n_args;
+    StgClosure *fun;		/* really points to a fun */
+    StgClosure *payload[FLEXIBLE_ARRAY];
+} StgPAP;
+
+typedef struct {
+    StgThunkHeader   header;
+    StgHalfWord arity;		/* zero if it is an AP */
+    StgHalfWord n_args;
+    StgClosure *fun;		/* really points to a fun */
+    StgClosure *payload[FLEXIBLE_ARRAY];
+} StgAP;
+
+typedef struct {
+    StgThunkHeader   header;
+    StgWord     size;                    /* number of words in payload */
+    StgClosure *fun;
+    StgClosure *payload[FLEXIBLE_ARRAY]; /* contains a chunk of *stack* */
+} StgAP_STACK;
+
+typedef struct {
+    StgHeader   header;
+    StgClosure *indirectee;
+} StgInd;
+
+typedef struct {
+    StgHeader     header;
+    StgClosure   *indirectee;
+    StgClosure   *static_link;
+    StgInfoTable *saved_info;
+} StgIndStatic;
+
+typedef struct {
+    StgHeader  header;
+    StgWord    words;
+    StgWord    payload[FLEXIBLE_ARRAY];
+} StgArrWords;
+
+typedef struct {
+    StgHeader   header;
+    StgWord     ptrs;
+    StgClosure *payload[FLEXIBLE_ARRAY];
+} StgMutArrPtrs;
+
+typedef struct {
+    StgHeader   header;
+    StgClosure *var;
+} StgMutVar;
+
+typedef struct _StgUpdateFrame {
+    StgHeader  header;
+    StgClosure *updatee;
+} StgUpdateFrame;
+
+typedef struct {
+    StgHeader  header;
+    StgInt      exceptions_blocked;
+    StgClosure *handler;
+} StgCatchFrame;
+
+typedef struct {
+    StgHeader  header;
+} StgStopFrame;  
+
+typedef struct {
+  StgHeader header;
+  StgWord data;
+} StgIntCharlikeClosure;
+
+/* statically allocated */
+typedef struct {
+  StgHeader  header;
+} StgRetry;
+
+typedef struct _StgStableName {
+  StgHeader      header;
+  StgWord        sn;
+} StgStableName;
+
+typedef struct _StgWeak {	/* Weak v */
+  StgHeader header;
+  StgClosure *cfinalizer;
+  StgClosure *key;
+  StgClosure *value;		/* v */
+  StgClosure *finalizer;
+  struct _StgWeak *link;
+} StgWeak;
+
+typedef struct _StgDeadWeak {	/* Weak v */
+  StgHeader header;
+  struct _StgWeak *link;
+} StgDeadWeak;
+
+/* Byte code objects.  These are fixed size objects with pointers to
+ * four arrays, designed so that a BCO can be easily "re-linked" to
+ * other BCOs, to facilitate GHC's intelligent recompilation.  The
+ * array of instructions is static and not re-generated when the BCO
+ * is re-linked, but the other 3 arrays will be regenerated.
+ *
+ * A BCO represents either a function or a stack frame.  In each case,
+ * it needs a bitmap to describe to the garbage collector the
+ * pointerhood of its arguments/free variables respectively, and in
+ * the case of a function it also needs an arity.  These are stored
+ * directly in the BCO, rather than in the instrs array, for two
+ * reasons:
+ * (a) speed: we need to get at the bitmap info quickly when
+ *     the GC is examining APs and PAPs that point to this BCO
+ * (b) a subtle interaction with the compacting GC.  In compacting
+ *     GC, the info that describes the size/layout of a closure
+ *     cannot be in an object more than one level of indirection
+ *     away from the current object, because of the order in
+ *     which pointers are updated to point to their new locations.
+ */
+
+typedef struct {
+    StgHeader      header;
+    StgArrWords   *instrs;	/* a pointer to an ArrWords */
+    StgArrWords   *literals;	/* a pointer to an ArrWords */
+    StgMutArrPtrs *ptrs;	/* a pointer to a  MutArrPtrs */
+    StgHalfWord   arity;        /* arity of this BCO */
+    StgHalfWord   size;         /* size of this BCO (in words) */
+    StgWord       bitmap[FLEXIBLE_ARRAY];  /* an StgLargeBitmap */
+} StgBCO;
+
+#define BCO_BITMAP(bco)      ((StgLargeBitmap *)((StgBCO *)(bco))->bitmap)
+#define BCO_BITMAP_SIZE(bco) (BCO_BITMAP(bco)->size)
+#define BCO_BITMAP_BITS(bco) (BCO_BITMAP(bco)->bitmap)
+#define BCO_BITMAP_SIZEW(bco) ((BCO_BITMAP_SIZE(bco) + BITS_IN(StgWord) - 1) \
+			        / BITS_IN(StgWord))
+
+/* -----------------------------------------------------------------------------
+   Dynamic stack frames for generic heap checks.
+
+   These generic heap checks are slow, but have the advantage of being
+   usable in a variety of situations.
+
+   The one restriction is that any relevant SRTs must already be pointed
+   to from the stack.  The return address doesn't need to have an info
+   table attached: hence it can be any old code pointer.
+
+   The liveness mask contains a 1 at bit n, if register Rn contains a
+   non-pointer.  The contents of all 8 vanilla registers are always saved
+   on the stack; the liveness mask tells the GC which ones contain
+   pointers.
+
+   Good places to use a generic heap check: 
+
+        - case alternatives (the return address with an SRT is already
+	  on the stack).
+
+	- primitives (no SRT required).
+
+   The stack frame layout for a RET_DYN is like this:
+
+          some pointers         |-- RET_DYN_PTRS(liveness) words
+          some nonpointers      |-- RET_DYN_NONPTRS(liveness) words
+			       
+	  L1                    \
+          D1-2                  |-- RET_DYN_NONPTR_REGS_SIZE words
+	  F1-4                  /
+			       
+	  R1-8                  |-- RET_DYN_BITMAP_SIZE words
+			       
+	  return address        \
+	  liveness mask         |-- StgRetDyn structure
+	  stg_gen_chk_info      /
+
+   we assume that the size of a double is always 2 pointers (wasting a
+   word when it is only one pointer, but avoiding lots of #ifdefs).
+
+   See Liveness.h for the macros (RET_DYN_PTRS() etc.).
+
+   NOTE: if you change the layout of RET_DYN stack frames, then you
+   might also need to adjust the value of RESERVED_STACK_WORDS in
+   Constants.h.
+   -------------------------------------------------------------------------- */
+
+typedef struct {
+    const StgInfoTable* info;
+    StgWord        liveness;
+    StgWord        ret_addr;
+    StgClosure *   payload[FLEXIBLE_ARRAY];
+} StgRetDyn;
+
+/* A function return stack frame: used when saving the state for a
+ * garbage collection at a function entry point.  The function
+ * arguments are on the stack, and we also save the function (its
+ * info table describes the pointerhood of the arguments).
+ *
+ * The stack frame size is also cached in the frame for convenience.
+ */
+typedef struct {
+    const StgInfoTable* info;
+    StgWord        size;
+    StgClosure *   fun;
+    StgClosure *   payload[FLEXIBLE_ARRAY];
+} StgRetFun;
+
+/* Concurrent communication objects */
+
+typedef struct {
+  StgHeader       header;
+  struct StgTSO_ *head;
+  struct StgTSO_ *tail;
+  StgClosure*     value;
+} StgMVar;
+
+
+/* STM data structures
+ *
+ *  StgTVar defines the only type that can be updated through the STM
+ *  interface.
+ * 
+ *  Note that various optimisations may be possible in order to use less
+ *  space for these data structures at the cost of more complexity in the
+ *  implementation:
+ *
+ *   - In StgTVar, current_value and first_watch_queue_entry could be held in
+ *     the same field: if any thread is waiting then its expected_value for
+ *     the tvar is the current value.  
+ *
+ *   - In StgTRecHeader, it might be worthwhile having separate chunks
+ *     of read-only and read-write locations.  This would save a
+ *     new_value field in the read-only locations.
+ *
+ *   - In StgAtomicallyFrame, we could combine the waiting bit into
+ *     the header (maybe a different info tbl for a waiting transaction).
+ *     This means we can specialise the code for the atomically frame
+ *     (it immediately switches on frame->waiting anyway).
+ */
+
+typedef struct StgTRecHeader_ StgTRecHeader;
+
+typedef struct StgTVarWatchQueue_ {
+  StgHeader                  header;
+  StgClosure                *closure; // StgTSO or StgAtomicInvariant
+  struct StgTVarWatchQueue_ *next_queue_entry;
+  struct StgTVarWatchQueue_ *prev_queue_entry;
+} StgTVarWatchQueue;
+
+typedef struct {
+  StgHeader                  header;
+  StgClosure                *volatile current_value;
+  StgTVarWatchQueue         *volatile first_watch_queue_entry;
+#if defined(THREADED_RTS)
+  StgInt                     volatile num_updates;
+#endif
+} StgTVar;
+
+typedef struct {
+  StgHeader      header;
+  StgClosure    *code;
+  StgTRecHeader *last_execution;
+  StgWord        lock;
+} StgAtomicInvariant;
+
+/* new_value == expected_value for read-only accesses */
+/* new_value is a StgTVarWatchQueue entry when trec in state TREC_WAITING */
+typedef struct {
+  StgTVar                   *tvar;
+  StgClosure                *expected_value;
+  StgClosure                *new_value; 
+#if defined(THREADED_RTS)
+  StgInt                     num_updates;
+#endif
+} TRecEntry;
+
+#define TREC_CHUNK_NUM_ENTRIES 16
+
+typedef struct StgTRecChunk_ {
+  StgHeader                  header;
+  struct StgTRecChunk_      *prev_chunk;
+  StgWord                    next_entry_idx;
+  TRecEntry                  entries[TREC_CHUNK_NUM_ENTRIES];
+} StgTRecChunk;
+
+typedef enum { 
+  TREC_ACTIVE,        /* Transaction in progress, outcome undecided */
+  TREC_CONDEMNED,     /* Transaction in progress, inconsistent / out of date reads */
+  TREC_COMMITTED,     /* Transaction has committed, now updating tvars */
+  TREC_ABORTED,       /* Transaction has aborted, now reverting tvars */
+  TREC_WAITING,       /* Transaction currently waiting */
+} TRecState;
+
+typedef struct StgInvariantCheckQueue_ {
+  StgHeader                       header;
+  StgAtomicInvariant             *invariant;
+  StgTRecHeader                  *my_execution;
+  struct StgInvariantCheckQueue_ *next_queue_entry;
+} StgInvariantCheckQueue;
+
+struct StgTRecHeader_ {
+  StgHeader                  header;
+  TRecState                  state;
+  struct StgTRecHeader_     *enclosing_trec;
+  StgTRecChunk              *current_chunk;
+  StgInvariantCheckQueue    *invariants_to_check;
+};
+
+typedef struct {
+  StgHeader   header;
+  StgClosure *code;
+  StgTVarWatchQueue *next_invariant_to_check;
+  StgClosure *result;
+} StgAtomicallyFrame;
+
+typedef struct {
+  StgHeader   header;
+  StgClosure *code;
+  StgClosure *handler;
+} StgCatchSTMFrame;
+
+typedef struct {
+  StgHeader      header;
+  StgBool        running_alt_code;
+  StgClosure    *first_code;
+  StgClosure    *alt_code;
+} StgCatchRetryFrame;
+
+#endif /* RTS_STORAGE_CLOSURES_H */
diff --git a/includes/rts/storage/FunTypes.h b/includes/rts/storage/FunTypes.h
new file mode 100644
index 0000000000..402c913bcd
--- /dev/null
+++ b/includes/rts/storage/FunTypes.h
@@ -0,0 +1,54 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2002
+ *
+ * Things for functions.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef RTS_STORAGE_FUNTYPES_H
+#define RTS_STORAGE_FUNTYPES_
+
+/* generic - function comes with a small bitmap */
+#define ARG_GEN      0   
+
+/* generic - function comes with a large bitmap */
+#define ARG_GEN_BIG  1
+
+/* BCO - function is really a BCO */
+#define ARG_BCO      2
+
+/*
+ * Specialised function types: bitmaps and calling sequences
+ * for these functions are pre-generated: see ghc/utils/genapply and
+ * generated code in ghc/rts/AutoApply.cmm.
+ *
+ *  NOTE: other places to change if you change this table:
+ *       - utils/genapply/GenApply.hs: stackApplyTypes
+ *       - compiler/codeGen/CgCallConv.lhs: stdPattern
+ */
+#define ARG_NONE     3 
+#define ARG_N        4  
+#define ARG_P        5 
+#define ARG_F        6 
+#define ARG_D        7 
+#define ARG_L        8 
+#define ARG_NN       9 
+#define ARG_NP       10
+#define ARG_PN       11
+#define ARG_PP       12
+#define ARG_NNN      13
+#define ARG_NNP      14
+#define ARG_NPN      15
+#define ARG_NPP      16
+#define ARG_PNN      17
+#define ARG_PNP      18
+#define ARG_PPN      19
+#define ARG_PPP      20
+#define ARG_PPPP     21
+#define ARG_PPPPP    22
+#define ARG_PPPPPP   23
+#define ARG_PPPPPPP  24
+#define ARG_PPPPPPPP 25
+
+#endif /* RTS_STORAGE_FUNTYPES_H */
diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h
new file mode 100644
index 0000000000..df4ba9d153
--- /dev/null
+++ b/includes/rts/storage/GC.h
@@ -0,0 +1,204 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2004
+ *
+ * External Storage Manger Interface
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef RTS_STORAGE_GC_H
+#define RTS_STORAGE_GC_H
+
+#include <stddef.h>
+#include "rts/OSThreads.h"
+
+/* -----------------------------------------------------------------------------
+ * Generational GC
+ *
+ * We support an arbitrary number of generations, with an arbitrary number
+ * of steps per generation.  Notes (in no particular order):
+ *
+ *       - all generations except the oldest should have the same
+ *         number of steps.  Multiple steps gives objects a decent
+ *         chance to age before being promoted, and helps ensure that
+ *         we don't end up with too many thunks being updated in older
+ *         generations.
+ *
+ *       - the oldest generation has one step.  There's no point in aging
+ *         objects in the oldest generation.
+ *
+ *       - generation 0, step 0 (G0S0) is the allocation area.  It is given
+ *         a fixed set of blocks during initialisation, and these blocks
+ *         normally stay in G0S0.  In parallel execution, each
+ *         Capability has its own nursery.
+ *
+ *       - during garbage collection, each step which is an evacuation
+ *         destination (i.e. all steps except G0S0) is allocated a to-space.
+ *         evacuated objects are allocated into the step's to-space until
+ *         GC is finished, when the original step's contents may be freed
+ *         and replaced by the to-space.
+ *
+ *       - the mutable-list is per-generation (not per-step).  G0 doesn't 
+ *         have one (since every garbage collection collects at least G0).
+ * 
+ *       - block descriptors contain pointers to both the step and the
+ *         generation that the block belongs to, for convenience.
+ *
+ *       - static objects are stored in per-generation lists.  See GC.c for
+ *         details of how we collect CAFs in the generational scheme.
+ *
+ *       - large objects are per-step, and are promoted in the same way
+ *         as small objects, except that we may allocate large objects into
+ *         generation 1 initially.
+ *
+ * ------------------------------------------------------------------------- */
+
+typedef struct step_ {
+    unsigned int         no;		// step number in this generation
+    unsigned int         abs_no;	// absolute step number
+
+    struct generation_ * gen;		// generation this step belongs to
+    unsigned int         gen_no;        // generation number (cached)
+
+    bdescr *             blocks;	// blocks in this step
+    unsigned int         n_blocks;	// number of blocks
+    unsigned int         n_words;       // number of words
+
+    struct step_ *       to;		// destination step for live objects
+
+    bdescr *             large_objects;	 // large objects (doubly linked)
+    unsigned int         n_large_blocks; // no. of blocks used by large objs
+
+    StgTSO *             threads;       // threads in this step
+                                        // linked via global_link
+
+    // ------------------------------------
+    // Fields below are used during GC only
+
+    // During GC, if we are collecting this step, blocks and n_blocks
+    // are copied into the following two fields.  After GC, these blocks
+    // are freed.
+
+#if defined(THREADED_RTS)
+    char pad[128];                      // make sure the following is
+                                        // on a separate cache line.
+    SpinLock     sync_large_objects;    // lock for large_objects
+                                        //    and scavenged_large_objects
+#endif
+
+    int          mark;			// mark (not copy)? (old gen only)
+    int          compact;		// compact (not sweep)? (old gen only)
+
+    bdescr *     old_blocks;	        // bdescr of first from-space block
+    unsigned int n_old_blocks;		// number of blocks in from-space
+    unsigned int live_estimate;         // for sweeping: estimate of live data
+    
+    bdescr *     part_blocks;           // partially-full scanned blocks
+    unsigned int n_part_blocks;         // count of above
+
+    bdescr *     scavenged_large_objects;  // live large objs after GC (d-link)
+    unsigned int n_scavenged_large_blocks; // size (not count) of above
+
+    bdescr *     bitmap;  		// bitmap for compacting collection
+
+    StgTSO *     old_threads;
+
+} step;
+
+
+typedef struct generation_ {
+    unsigned int   no;			// generation number
+    step *         steps;		// steps
+    unsigned int   n_steps;		// number of steps
+    unsigned int   max_blocks;		// max blocks in step 0
+    bdescr        *mut_list;      	// mut objects in this gen (not G0)
+    
+    // stats information
+    unsigned int collections;
+    unsigned int par_collections;
+    unsigned int failed_promotions;
+
+    // temporary use during GC:
+    bdescr        *saved_mut_list;
+} generation;
+
+extern generation * generations;
+
+extern generation * g0;
+extern step * g0s0;
+extern generation * oldest_gen;
+extern step * all_steps;
+extern nat total_steps;
+
+/* -----------------------------------------------------------------------------
+   Generic allocation
+
+   StgPtr allocateInGen(generation *g, nat n)
+                                Allocates a chunk of contiguous store
+   				n words long in generation g,
+   				returning a pointer to the first word.
+   				Always succeeds.
+				
+   StgPtr allocate(nat n)       Equaivalent to allocateInGen(g0)
+				
+   StgPtr allocateLocal(Capability *cap, nat n)
+                                Allocates memory from the nursery in
+				the current Capability.  This can be
+				done without taking a global lock,
+                                unlike allocate().
+
+   StgPtr allocatePinned(nat n) Allocates a chunk of contiguous store
+   				n words long, which is at a fixed
+				address (won't be moved by GC).  
+				Returns a pointer to the first word.
+				Always succeeds.
+				
+				NOTE: the GC can't in general handle
+				pinned objects, so allocatePinned()
+				can only be used for ByteArrays at the
+				moment.
+
+				Don't forget to TICK_ALLOC_XXX(...)
+				after calling allocate or
+				allocatePinned, for the
+				benefit of the ticky-ticky profiler.
+
+   rtsBool doYouWantToGC(void)  Returns True if the storage manager is
+   				ready to perform a GC, False otherwise.
+
+   lnat  allocatedBytes(void)  Returns the number of bytes allocated
+                                via allocate() since the last GC.
+				Used in the reporting of statistics.
+
+   -------------------------------------------------------------------------- */
+
+StgPtr  allocate        ( lnat n );
+StgPtr  allocateInGen   ( generation *g, lnat n );
+StgPtr  allocateLocal   ( Capability *cap, lnat n );
+StgPtr  allocatePinned  ( lnat n );
+lnat    allocatedBytes  ( void );
+
+/* memory allocator for executable memory */
+void * allocateExec(unsigned int len, void **exec_addr);
+void   freeExec (void *p);
+
+/* -----------------------------------------------------------------------------
+   Performing Garbage Collection
+   -------------------------------------------------------------------------- */
+
+void performGC(void);
+void performMajorGC(void);
+
+/* -----------------------------------------------------------------------------
+   The CAF table - used to let us revert CAFs in GHCi
+   -------------------------------------------------------------------------- */
+
+void newCAF     (StgClosure*);
+void newDynCAF  (StgClosure *);
+void revertCAFs (void);
+
+/* set to disable CAF garbage collection in GHCi. */
+/* (needed when dynamic libraries are used). */
+extern rtsBool keepCAFs;
+
+#endif /* RTS_STORAGE_GC_H */
diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h
new file mode 100644
index 0000000000..4596ce2d75
--- /dev/null
+++ b/includes/rts/storage/InfoTables.h
@@ -0,0 +1,410 @@
+/* ----------------------------------------------------------------------------
+ * 
+ * (c) The GHC Team, 1998-2002
+ *
+ * Info Tables
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifndef RTS_STORAGE_INFOTABLES_H
+#define RTS_STORAGE_INFOTABLES_H
+
+/* ----------------------------------------------------------------------------
+   Relative pointers
+
+   Several pointer fields in info tables are expressed as offsets
+   relative to the info pointer, so that we can generate
+   position-independent code.
+
+   Note [x86-64-relative]
+   There is a complication on the x86_64 platform, where pointeres are
+   64 bits, but the tools don't support 64-bit relative relocations.
+   However, the default memory model (small) ensures that all symbols
+   have values in the lower 2Gb of the address space, so offsets all
+   fit in 32 bits.  Hence we can use 32-bit offset fields.
+
+   When going via-C, the mangler arranges that we only generate
+   relative relocations between symbols in the same segment (the text
+   segment).  The NCG, however, puts things in the right sections and
+   uses 32-bit relative offsets instead.
+
+   Somewhere between binutils-2.16.1 and binutils-2.16.91.0.6,
+   support for 64-bit PC-relative relocations was added, so maybe this
+   hackery can go away sometime.
+   ------------------------------------------------------------------------- */
+
+#if x86_64_TARGET_ARCH
+#define OFFSET_FIELD(n) StgHalfInt n; StgHalfWord __pad_##n;
+#else   
+#define OFFSET_FIELD(n) StgInt n;
+#endif
+
+/* -----------------------------------------------------------------------------
+   Profiling info
+   -------------------------------------------------------------------------- */
+
+typedef struct {
+#ifndef TABLES_NEXT_TO_CODE
+    char *closure_type;
+    char *closure_desc;
+#else
+    OFFSET_FIELD(closure_type_off);
+    OFFSET_FIELD(closure_desc_off);
+#endif
+} StgProfInfo;
+
+/* -----------------------------------------------------------------------------
+   Ticky info
+
+   There is no ticky-specific stuff in an info table at this time.
+   -------------------------------------------------------------------------- */
+
+/* -----------------------------------------------------------------------------
+   Debugging info
+   -------------------------------------------------------------------------- */
+
+#ifdef DEBUG_CLOSURE
+
+typedef struct {
+	... whatever ...
+} StgDebugInfo;
+
+#else /* !DEBUG_CLOSURE */
+
+/* There is no DEBUG-specific stuff in an info table at this time. */
+
+#endif /* DEBUG_CLOSURE */
+
+/* -----------------------------------------------------------------------------
+   Closure flags
+   -------------------------------------------------------------------------- */
+
+/* The type flags provide quick access to certain properties of a closure. */
+
+#define _HNF (1<<0)  /* head normal form?    */
+#define _BTM (1<<1)  /* bitmap-style layout? */
+#define _NS  (1<<2)  /* non-sparkable        */
+#define _STA (1<<3)  /* static?              */
+#define _THU (1<<4)  /* thunk?               */
+#define _MUT (1<<5)  /* mutable?             */
+#define _UPT (1<<6)  /* unpointed?           */
+#define _SRT (1<<7)  /* has an SRT?          */
+#define _IND (1<<8)  /* is an indirection?   */
+
+#define isSTATIC(flags)    ((flags) &_STA)
+#define isMUTABLE(flags)   ((flags) &_MUT)
+#define isBITMAP(flags)    ((flags) &_BTM)
+#define isTHUNK(flags)     ((flags) &_THU)
+#define isUNPOINTED(flags) ((flags) &_UPT)
+#define hasSRT(flags)      ((flags) &_SRT)
+
+extern StgWord16 closure_flags[];
+
+#define closureFlags(c)         (closure_flags[get_itbl(UNTAG_CLOSURE(c))->type])
+
+#define closure_HNF(c)          (  closureFlags(c) & _HNF)
+#define closure_BITMAP(c)       (  closureFlags(c) & _BTM)
+#define closure_NON_SPARK(c)    ( (closureFlags(c) & _NS))
+#define closure_SHOULD_SPARK(c) (!(closureFlags(c) & _NS))
+#define closure_STATIC(c)       (  closureFlags(c) & _STA)
+#define closure_THUNK(c)        (  closureFlags(c) & _THU)
+#define closure_MUTABLE(c)      (  closureFlags(c) & _MUT)
+#define closure_UNPOINTED(c)    (  closureFlags(c) & _UPT)
+#define closure_SRT(c)          (  closureFlags(c) & _SRT)
+#define closure_IND(c)          (  closureFlags(c) & _IND)
+
+/* same as above but for info-ptr rather than closure */
+#define ipFlags(ip)             (closure_flags[ip->type])
+
+#define ip_HNF(ip)               (  ipFlags(ip) & _HNF)
+#define ip_BITMAP(ip)       	 (  ipFlags(ip) & _BTM)
+#define ip_SHOULD_SPARK(ip) 	 (!(ipFlags(ip) & _NS))
+#define ip_STATIC(ip)       	 (  ipFlags(ip) & _STA)
+#define ip_THUNK(ip)        	 (  ipFlags(ip) & _THU)
+#define ip_MUTABLE(ip)      	 (  ipFlags(ip) & _MUT)
+#define ip_UNPOINTED(ip)    	 (  ipFlags(ip) & _UPT)
+#define ip_SRT(ip)          	 (  ipFlags(ip) & _SRT)
+#define ip_IND(ip)          	 (  ipFlags(ip) & _IND)
+
+/* -----------------------------------------------------------------------------
+   Bitmaps
+
+   These are used to describe the pointerhood of a sequence of words
+   (usually on the stack) to the garbage collector.  The two primary
+   uses are for stack frames, and functions (where we need to describe
+   the layout of a PAP to the GC).
+
+   In these bitmaps: 0 == ptr, 1 == non-ptr.
+   -------------------------------------------------------------------------- */
+
+/*
+ * Small bitmaps:  for a small bitmap, we store the size and bitmap in 
+ * the same word, using the following macros.  If the bitmap doesn't
+ * fit in a single word, we use a pointer to an StgLargeBitmap below.
+ */
+#define MK_SMALL_BITMAP(size,bits) (((bits)<<BITMAP_BITS_SHIFT) | (size))
+
+#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
+#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)
+
+/*
+ * A large bitmap.
+ */
+typedef struct {
+  StgWord size;
+  StgWord bitmap[FLEXIBLE_ARRAY];
+} StgLargeBitmap;
+
+/* -----------------------------------------------------------------------------
+   SRTs  (Static Reference Tables)
+
+   These tables are used to keep track of the static objects referred
+   to by the code for a closure or stack frame, so that we can follow
+   static data references from code and thus accurately
+   garbage-collect CAFs.
+   -------------------------------------------------------------------------- */
+
+/* An SRT is just an array of closure pointers: */
+typedef StgClosure* StgSRT[];
+
+/*
+ * Each info table refers to some subset of the closure pointers in an
+ * SRT.  It does this using a pair of an StgSRT pointer and a
+ * half-word bitmap.  If the half-word bitmap isn't large enough, then
+ * we fall back to a large SRT, including an unbounded bitmap.  If the
+ * half-word bitmap is set to all ones (0xffff), then the StgSRT
+ * pointer instead points to an StgLargeSRT:
+ */
+typedef struct StgLargeSRT_ {
+    StgSRT *srt;
+    StgLargeBitmap l;
+} StgLargeSRT;
+
+/* ----------------------------------------------------------------------------
+   Info Tables
+   ------------------------------------------------------------------------- */
+
+/*
+ * Stuff describing the closure layout.  Well, actually, it might
+ * contain the selector index for a THUNK_SELECTOR.  This union is one
+ * word long.
+ */
+typedef union {
+    struct {			/* Heap closure payload layout: */
+	StgHalfWord ptrs;	/* number of pointers */
+	StgHalfWord nptrs;	/* number of non-pointers */
+    } payload;
+    
+    StgWord bitmap;		  /* word-sized bit pattern describing */
+				  /*  a stack frame: see below */
+
+#ifndef TABLES_NEXT_TO_CODE
+    StgLargeBitmap* large_bitmap; /* pointer to large bitmap structure */
+#else
+    OFFSET_FIELD( large_bitmap_offset );  /* offset from info table to large bitmap structure */
+#endif
+    
+    StgWord selector_offset;	  /* used in THUNK_SELECTORs */
+
+} StgClosureInfo;
+
+
+/*
+ * The "standard" part of an info table.  Every info table has this bit.
+ */
+typedef struct StgInfoTable_ {
+
+#ifdef PROFILING
+    StgProfInfo     prof;
+#endif
+#ifdef TICKY
+  /* Ticky-specific stuff would go here. */
+#endif
+#ifdef DEBUG_CLOSURE
+  /* Debug-specific stuff would go here. */
+#endif
+
+    StgClosureInfo  layout;	/* closure layout info (one word) */
+
+    StgHalfWord     type;	/* closure type */
+    StgHalfWord     srt_bitmap;    /* number of entries in SRT (or constructor tag) */
+
+#ifdef TABLES_NEXT_TO_CODE
+    StgCode         code[FLEXIBLE_ARRAY];
+#endif
+} *StgInfoTablePtr;
+
+
+/* -----------------------------------------------------------------------------
+   Function info tables
+
+   This is the general form of function info tables.  The compiler
+   will omit some of the fields in common cases:
+
+   -  If fun_type is not ARG_GEN or ARG_GEN_BIG, then the slow_apply
+      and bitmap fields may be left out (they are at the end, so omitting
+      them doesn't affect the layout).
+      
+   -  If srt_bitmap (in the std info table part) is zero, then the srt
+      field may be omitted.  This only applies if the slow_apply and
+      bitmap fields have also been omitted.
+   -------------------------------------------------------------------------- */
+
+typedef struct StgFunInfoExtraRev_ {
+    OFFSET_FIELD ( slow_apply_offset ); /* apply to args on the stack */
+    union { 
+	StgWord bitmap;
+	OFFSET_FIELD ( bitmap_offset );	/* arg ptr/nonptr bitmap */
+    } b;
+    OFFSET_FIELD ( srt_offset ); /* pointer to the SRT table */
+    StgHalfWord    fun_type;    /* function type */
+    StgHalfWord    arity;       /* function arity */
+} StgFunInfoExtraRev;
+
+typedef struct StgFunInfoExtraFwd_ {
+    StgHalfWord    fun_type;    /* function type */
+    StgHalfWord    arity;       /* function arity */
+    StgSRT         *srt;	/* pointer to the SRT table */
+    union { /* union for compat. with TABLES_NEXT_TO_CODE version */
+	StgWord        bitmap;	/* arg ptr/nonptr bitmap */
+    } b;
+    StgFun         *slow_apply; /* apply to args on the stack */
+} StgFunInfoExtraFwd;
+
+typedef struct {
+#if defined(TABLES_NEXT_TO_CODE)
+    StgFunInfoExtraRev f;
+    StgInfoTable i;
+#else
+    StgInfoTable i;
+    StgFunInfoExtraFwd f;
+#endif
+} StgFunInfoTable;
+
+/* -----------------------------------------------------------------------------
+   Return info tables
+   -------------------------------------------------------------------------- */
+
+/*
+ * When info tables are laid out backwards, we can omit the SRT
+ * pointer iff srt_bitmap is zero.
+ */
+
+typedef struct {
+#if defined(TABLES_NEXT_TO_CODE)
+    OFFSET_FIELD( srt_offset );	/* offset to the SRT table */
+    StgInfoTable i;
+#else
+    StgInfoTable i;
+    StgSRT      *srt;	/* pointer to the SRT table */
+#endif
+} StgRetInfoTable;
+
+/* -----------------------------------------------------------------------------
+   Thunk info tables
+   -------------------------------------------------------------------------- */
+
+/*
+ * When info tables are laid out backwards, we can omit the SRT
+ * pointer iff srt_bitmap is zero.
+ */
+
+typedef struct StgThunkInfoTable_ {
+#if !defined(TABLES_NEXT_TO_CODE)
+    StgInfoTable i;
+#endif
+#if defined(TABLES_NEXT_TO_CODE)
+    OFFSET_FIELD( srt_offset );	/* offset to the SRT table */
+#else
+    StgSRT         *srt;	/* pointer to the SRT table */
+#endif
+#if defined(TABLES_NEXT_TO_CODE)
+    StgInfoTable i;
+#endif
+} StgThunkInfoTable;
+
+/* -----------------------------------------------------------------------------
+   Constructor info tables
+   -------------------------------------------------------------------------- */
+
+typedef struct StgConInfoTable_ {
+#if !defined(TABLES_NEXT_TO_CODE)
+    StgInfoTable i;
+#endif
+
+#ifndef TABLES_NEXT_TO_CODE
+    char *con_desc;
+#else
+    OFFSET_FIELD(con_desc) // the name of the data constructor 
+                           // as: Package:Module.Name
+#endif
+
+#if defined(TABLES_NEXT_TO_CODE)
+    StgInfoTable i;
+#endif
+} StgConInfoTable;
+
+
+/* -----------------------------------------------------------------------------
+   Accessor macros for fields that might be offsets (C version)
+   -------------------------------------------------------------------------- */
+
+/*
+ * GET_SRT(info)
+ * info must be a Stg[Ret|Thunk]InfoTable* (an info table that has a SRT)
+ */
+#ifdef TABLES_NEXT_TO_CODE
+#define GET_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->srt_offset))
+#else
+#define GET_SRT(info) ((info)->srt)
+#endif
+
+/*
+ * GET_CON_DESC(info)
+ * info must be a StgConInfoTable*.
+ */
+#ifdef TABLES_NEXT_TO_CODE
+#define GET_CON_DESC(info) ((char *)((StgWord)((info)+1) + (info->con_desc)))
+#else
+#define GET_CON_DESC(info) ((info)->con_desc)
+#endif
+
+/*
+ * GET_FUN_SRT(info)
+ * info must be a StgFunInfoTable*
+ */
+#ifdef TABLES_NEXT_TO_CODE
+#define GET_FUN_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->f.srt_offset))
+#else
+#define GET_FUN_SRT(info) ((info)->f.srt)
+#endif
+
+#ifdef TABLES_NEXT_TO_CODE
+#define GET_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \
+                                        + (info)->layout.large_bitmap_offset))
+#else
+#define GET_LARGE_BITMAP(info) ((info)->layout.large_bitmap)
+#endif
+
+#ifdef TABLES_NEXT_TO_CODE
+#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \
+                                        + (info)->f.b.bitmap_offset))
+#else
+#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) ((info)->f.b.bitmap))
+#endif
+
+/*
+ * GET_PROF_TYPE, GET_PROF_DESC
+ */
+#ifdef TABLES_NEXT_TO_CODE
+#define GET_PROF_TYPE(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_type_off)))
+#else
+#define GET_PROF_TYPE(info) ((info)->prof.closure_type)
+#endif
+#ifdef TABLES_NEXT_TO_CODE
+#define GET_PROF_DESC(info) ((char *)((StgWord)((info)+1) + (info->prof.closure_desc_off)))
+#else
+#define GET_PROF_DESC(info) ((info)->prof.closure_desc)
+#endif
+
+#endif /* RTS_STORAGE_INFOTABLES_H */
diff --git a/includes/rts/storage/Liveness.h b/includes/rts/storage/Liveness.h
new file mode 100644
index 0000000000..66c82f3134
--- /dev/null
+++ b/includes/rts/storage/Liveness.h
@@ -0,0 +1,34 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The University of Glasgow 2004
+ *
+ * Building liveness masks for RET_DYN stack frames.
+ * A few macros that are used in both .cmm and .c sources.
+ *
+ * A liveness mask is constructed like so:
+ *
+ *    R1_PTR & R2_PTR & R3_PTR
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifndef RTS_STORAGE_LIVENESS_H
+#define RTS_STORAGE_LIVENESS_H
+
+#define NO_PTRS   0xff
+#define R1_PTR	  (NO_PTRS ^ (1<<0))
+#define R2_PTR	  (NO_PTRS ^ (1<<1))
+#define R3_PTR	  (NO_PTRS ^ (1<<2))
+#define R4_PTR	  (NO_PTRS ^ (1<<3))
+#define R5_PTR	  (NO_PTRS ^ (1<<4))
+#define R6_PTR	  (NO_PTRS ^ (1<<5))
+#define R7_PTR	  (NO_PTRS ^ (1<<6))
+#define R8_PTR	  (NO_PTRS ^ (1<<7))
+
+#define N_NONPTRS(n)  ((n)<<16)
+#define N_PTRS(n)     ((n)<<24)
+
+#define RET_DYN_NONPTRS(l) ((l)>>16 & 0xff)
+#define RET_DYN_PTRS(l)    ((l)>>24 & 0xff)
+#define RET_DYN_LIVENESS(l) ((l) & 0xffff)
+
+#endif /* RTS_STORAGE_LIVENESS_H */
diff --git a/includes/rts/storage/MBlock.h b/includes/rts/storage/MBlock.h
new file mode 100644
index 0000000000..03396c1fd7
--- /dev/null
+++ b/includes/rts/storage/MBlock.h
@@ -0,0 +1,206 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2008
+ *
+ * MegaBlock Allocator interface.
+ *
+ * See wiki commentary at
+ *  http://hackage.haskell.org/trac/ghc/wiki/Commentary/HeapAlloced
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef RTS_STORAGE_MBLOCK_H
+#define RTS_STORAGE_MBLOCK_H
+
+extern lnat mblocks_allocated;
+
+extern void initMBlocks(void);
+extern void * getMBlock(void);
+extern void * getMBlocks(nat n);
+extern void freeAllMBlocks(void);
+
+#ifdef DEBUG
+extern void *getFirstMBlock(void);
+extern void *getNextMBlock(void *mblock);
+#endif
+
+/* -----------------------------------------------------------------------------
+   The HEAP_ALLOCED() test.
+
+   HEAP_ALLOCED is called FOR EVERY SINGLE CLOSURE during GC.
+   It needs to be FAST.
+
+   See wiki commentary at
+     http://hackage.haskell.org/trac/ghc/wiki/Commentary/HeapAlloced
+
+   Implementation of HEAP_ALLOCED
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+   Since heap is allocated in chunks of megablocks (MBLOCK_SIZE), we
+   can just use a table to record which megablocks in the address
+   space belong to the heap.  On a 32-bit machine, with 1Mb
+   megablocks, using 8 bits for each entry in the table, the table
+   requires 4k.  Lookups during GC will be fast, because the table
+   will be quickly cached (indeed, performance measurements showed no
+   measurable difference between doing the table lookup and using a
+   constant comparison).
+
+   On 64-bit machines, we cache one 12-bit block map that describes
+   4096 megablocks or 4GB of memory. If HEAP_ALLOCED is called for
+   an address that is not in the cache, it calls slowIsHeapAlloced
+   (see MBlock.c) which will find the block map for the 4GB block in
+   question.
+   -------------------------------------------------------------------------- */
+
+#if SIZEOF_VOID_P == 4
+extern StgWord8 mblock_map[];
+
+/* On a 32-bit machine a 4KB table is always sufficient */
+# define MBLOCK_MAP_SIZE	4096
+# define MBLOCK_MAP_ENTRY(p)	((StgWord)(p) >> MBLOCK_SHIFT)
+# define HEAP_ALLOCED(p)	mblock_map[MBLOCK_MAP_ENTRY(p)]
+# define HEAP_ALLOCED_GC(p)     HEAP_ALLOCED(p)
+
+/* -----------------------------------------------------------------------------
+   HEAP_ALLOCED for 64-bit machines.
+
+ Here are some cache layout options:
+
+ [1]
+ 16KB cache of 16-bit entries, 1MB lines (capacity 8GB)
+  mblock size =          20 bits
+  entries   =     8192   13 bits
+  line size =             0 bits (1 bit of value)
+  tag size  =            15 bits
+                       = 48 bits
+
+ [2]
+ 32KB cache of 16-bit entries, 4MB lines (capacity 32GB)
+  mblock size =          20 bits
+  entries   =    16384   14 bits
+  line size =             2 bits (4 bits of value)
+  tag size  =            12 bits
+                       = 48 bits
+
+ [3]
+ 16KB cache of 16-bit entries, 2MB lines (capacity 16GB)
+  mblock size =          20 bits
+  entries   =    8192    13 bits
+  line size =             1 bits (2 bits of value)
+  tag size  =            14 bits
+                       = 48 bits
+
+ [4]
+ 4KB cache of 32-bit entries, 16MB lines (capacity 16GB)
+  mblock size =          20 bits
+  entries   =     1024   10 bits
+  line size =             4 bits (16 bits of value)
+  tag size  =            14 bits
+                       = 48 bits
+
+ [5]
+ 4KB cache of 64-bit entries, 32MB lines (capacity 16GB)
+  mblock size =          20 bits
+  entries   =     512     9 bits
+  line size =             5 bits (32 bits of value)
+  tag size  =            14 bits
+                       = 48 bits
+
+ We actually use none of the above.  After much experimentation it was
+ found that optimising the lookup is the most important factor,
+ followed by reducing the number of misses.  To that end, we use a
+ variant of [1] in which each cache entry is ((mblock << 1) + value)
+ where value is 0 for non-heap and 1 for heap.  The cache entries can
+ be 32 bits, since the mblock number is 48-20 = 28 bits, and we need
+ 1 bit for the value.  The cache can be as big as we like, but
+ currently we use 8k entries, giving us 8GB capacity.
+
+ ---------------------------------------------------------------------------- */
+
+#elif SIZEOF_VOID_P == 8
+
+#define MBC_LINE_BITS 0
+#define MBC_TAG_BITS 15
+typedef StgWord32 MbcCacheLine;  // could use 16, but 32 was faster
+typedef StgWord8  MBlockMapLine;
+
+#define MBLOCK_MAP_LINE(p)  (((StgWord)p & 0xffffffff) >> (MBLOCK_SHIFT + MBC_LINE_BITS))
+
+#define MBC_LINE_SIZE  (1<<MBC_LINE_BITS)
+#define MBC_SHIFT      (48 - MBLOCK_SHIFT - MBC_LINE_BITS - MBC_TAG_BITS)
+#define MBC_ENTRIES    (1<<MBC_SHIFT)
+
+extern MbcCacheLine mblock_cache[];
+
+#define MBC_LINE(p) ((StgWord)p >> (MBLOCK_SHIFT + MBC_LINE_BITS))
+
+#define MBLOCK_MAP_ENTRIES  (1 << (32 - MBLOCK_SHIFT - MBC_LINE_BITS))
+
+typedef struct {
+    StgWord32    addrHigh32;
+    MBlockMapLine lines[MBLOCK_MAP_ENTRIES];
+} MBlockMap;
+
+extern lnat mpc_misses;
+
+StgBool HEAP_ALLOCED_miss(StgWord mblock, void *p);
+
+INLINE_HEADER
+StgBool HEAP_ALLOCED(void *p)
+{
+    StgWord mblock;
+    nat entry_no;
+    MbcCacheLine entry, value;
+
+    mblock   = (StgWord)p >> MBLOCK_SHIFT;
+    entry_no = mblock & (MBC_ENTRIES-1);
+    entry    = mblock_cache[entry_no];
+    value    = entry ^ (mblock << 1);
+    // this formulation coaxes gcc into prioritising the value==1
+    // case, which we expect to be the most common.
+    // __builtin_expect() didn't have any useful effect (gcc-4.3.0).
+    if (value == 1) {
+        return 1;
+    } else if (value == 0) {
+        return 0;
+    } else {
+        // putting the rest out of line turned out to be a slight
+        // performance improvement:
+        return HEAP_ALLOCED_miss(mblock,p);
+    }
+}
+
+// In the parallel GC, the cache itself is safe to *read*, and can be
+// updated atomically, but we need to place a lock around operations
+// that touch the MBlock map.
+INLINE_HEADER
+StgBool HEAP_ALLOCED_GC(void *p)
+{
+    StgWord mblock;
+    nat entry_no;
+    MbcCacheLine entry, value;
+    StgBool b;
+
+    mblock   = (StgWord)p >> MBLOCK_SHIFT;
+    entry_no = mblock & (MBC_ENTRIES-1);
+    entry    = mblock_cache[entry_no];
+    value    = entry ^ (mblock << 1);
+    if (value == 1) {
+        return 1;
+    } else if (value == 0) {
+        return 0;
+    } else {
+        // putting the rest out of line turned out to be a slight
+        // performance improvement:
+        ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync);
+        b = HEAP_ALLOCED_miss(mblock,p);
+        RELEASE_SPIN_LOCK(&gc_alloc_block_sync);
+        return b;
+    }
+}
+
+#else
+# error HEAP_ALLOCED not defined
+#endif
+
+#endif /* RTS_STORAGE_MBLOCK_H */
diff --git a/includes/rts/storage/SMPClosureOps.h b/includes/rts/storage/SMPClosureOps.h
new file mode 100644
index 0000000000..d5f7c3f295
--- /dev/null
+++ b/includes/rts/storage/SMPClosureOps.h
@@ -0,0 +1,78 @@
+/* ----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 2005
+ *
+ * Macros for THREADED_RTS support
+ *
+ * -------------------------------------------------------------------------- */
+
+#ifndef RTS_STORAGE_SMPCLOSUREOPS_H
+#define RTS_STORAGE_SMPCLOSUREOPS_H
+
+#ifdef CMINUSMINUS
+
+#define unlockClosure(ptr,info)                 \
+    prim %write_barrier() [];                   \
+    StgHeader_info(ptr) = info;    
+
+#else
+
+EXTERN_INLINE StgInfoTable *lockClosure(StgClosure *p);
+EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info);
+
+#if defined(THREADED_RTS)
+
+/* -----------------------------------------------------------------------------
+ * Locking/unlocking closures
+ *
+ * This is used primarily in the implementation of MVars.
+ * -------------------------------------------------------------------------- */
+
+#define SPIN_COUNT 4000
+
+// We want a callable copy of lockClosure() so that we can refer to it
+// from .cmm files compiled using the native codegen.
+EXTERN_INLINE StgInfoTable *lockClosure(StgClosure *p)
+{
+    StgWord info;
+    do {
+	nat i = 0;
+	do {
+	    info = xchg((P_)(void *)&p->header.info, (W_)&stg_WHITEHOLE_info);
+	    if (info != (W_)&stg_WHITEHOLE_info) return (StgInfoTable *)info;
+	} while (++i < SPIN_COUNT);
+	yieldThread();
+    } while (1);
+}
+
+EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info)
+{
+    // This is a strictly ordered write, so we need a write_barrier():
+    write_barrier();
+    p->header.info = info;
+}
+
+#else /* !THREADED_RTS */
+
+EXTERN_INLINE StgInfoTable *
+lockClosure(StgClosure *p)
+{ return (StgInfoTable *)p->header.info; }
+
+EXTERN_INLINE void
+unlockClosure(StgClosure *p STG_UNUSED, const StgInfoTable *info STG_UNUSED)
+{ /* nothing */ }
+
+#endif /* THREADED_RTS */
+
+// Handy specialised versions of lockClosure()/unlockClosure()
+EXTERN_INLINE void lockTSO(StgTSO *tso);
+EXTERN_INLINE void lockTSO(StgTSO *tso)
+{ lockClosure((StgClosure *)tso); }
+
+EXTERN_INLINE void unlockTSO(StgTSO *tso);
+EXTERN_INLINE void unlockTSO(StgTSO *tso)
+{ unlockClosure((StgClosure*)tso, (const StgInfoTable *)&stg_TSO_info); }
+
+#endif /* CMINUSMINUS */
+
+#endif /* RTS_STORAGE_SMPCLOSUREOPS_H */
diff --git a/includes/rts/storage/TSO.h b/includes/rts/storage/TSO.h
new file mode 100644
index 0000000000..7cb245909f
--- /dev/null
+++ b/includes/rts/storage/TSO.h
@@ -0,0 +1,206 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2009
+ *
+ * The definitions for Thread State Objects.
+ *
+ * ---------------------------------------------------------------------------*/
+
+#ifndef RTS_STORAGE_TSO_H
+#define RTS_STORAGE_TSO_H
+
+/*
+ * PROFILING info in a TSO
+ */
+typedef struct {
+  CostCentreStack *CCCS;	/* thread's current CCS */
+} StgTSOProfInfo;
+
+/*
+ * There is no TICKY info in a TSO at this time.
+ */
+
+/*
+ * Thread IDs are 32 bits.
+ */
+typedef StgWord32 StgThreadID;
+
+#define tsoDirty(tso)  ((tso)->flags & TSO_DIRTY)
+#define tsoLocked(tso) ((tso)->flags & TSO_LOCKED)
+
+/*
+ * Type returned after running a thread.  Values of this type
+ * include HeapOverflow, StackOverflow etc.  See Constants.h for the
+ * full list.
+ */
+typedef unsigned int StgThreadReturnCode;
+
+#if defined(mingw32_HOST_OS)
+/* results from an async I/O request + its request ID. */
+typedef struct {
+  unsigned int reqID;
+  int          len;
+  int          errCode;
+} StgAsyncIOResult;
+#endif
+
+/* Reason for thread being blocked. See comment above struct StgTso_. */
+typedef union {
+  StgClosure *closure;
+  struct StgTSO_ *tso;
+  StgInt fd;	/* StgInt instead of int, so that it's the same size as the ptrs */
+#if defined(mingw32_HOST_OS)
+  StgAsyncIOResult *async_result;
+#endif
+  StgWord target;
+} StgTSOBlockInfo;
+
+
+/*
+ * TSOs live on the heap, and therefore look just like heap objects.
+ * Large TSOs will live in their own "block group" allocated by the
+ * storage manager, and won't be copied during garbage collection.
+ */
+
+/*
+ * Threads may be blocked for several reasons.  A blocked thread will
+ * have the reason in the why_blocked field of the TSO, and some
+ * further info (such as the closure the thread is blocked on, or the
+ * file descriptor if the thread is waiting on I/O) in the block_info
+ * field.
+ */
+
+typedef struct StgTSO_ {
+    StgHeader               header;
+
+    /* The link field, for linking threads together in lists (e.g. the
+       run queue on a Capability.
+    */
+    struct StgTSO_*         _link;
+    /*
+       NOTE!!!  do not modify _link directly, it is subject to
+       a write barrier for generational GC.  Instead use the
+       setTSOLink() function.  Exceptions to this rule are:
+
+       * setting the link field to END_TSO_QUEUE
+       * putting a TSO on the blackhole_queue
+       * setting the link field of the currently running TSO, as it
+         will already be dirty.
+    */
+
+    struct StgTSO_*         global_link;    /* Links all threads together */
+    
+    StgWord16               what_next;      /* Values defined in Constants.h */
+    StgWord16               why_blocked;    /* Values defined in Constants.h */
+    StgWord32               flags;
+    StgTSOBlockInfo         block_info;
+    StgThreadID             id;
+    int                     saved_errno;
+    struct Task_*           bound;
+    struct Capability_*     cap;
+    struct StgTRecHeader_ * trec;       /* STM transaction record */
+
+    /*
+       A list of threads blocked on this TSO waiting to throw
+       exceptions.  In order to access this field, the TSO must be
+       locked using lockClosure/unlockClosure (see SMP.h).
+    */
+    struct StgTSO_ *        blocked_exceptions;
+
+#ifdef TICKY_TICKY
+    /* TICKY-specific stuff would go here. */
+#endif
+#ifdef PROFILING
+    StgTSOProfInfo prof;
+#endif
+#ifdef mingw32_HOST_OS
+    StgWord32 saved_winerror;
+#endif
+
+    /* The thread stack... */
+    StgWord32	       stack_size;     /* stack size in *words* */
+    StgWord32          max_stack_size; /* maximum stack size in *words* */
+    StgPtr             sp;
+    
+    StgWord            stack[FLEXIBLE_ARRAY];
+} *StgTSOPtr;
+
+/* -----------------------------------------------------------------------------
+   functions
+   -------------------------------------------------------------------------- */
+
+void dirty_TSO  (Capability *cap, StgTSO *tso);
+void setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target);
+
+/* -----------------------------------------------------------------------------
+   Invariants:
+
+   An active thread has the following properties:
+
+      tso->stack < tso->sp < tso->stack+tso->stack_size
+      tso->stack_size <= tso->max_stack_size
+      
+      RESERVED_STACK_WORDS is large enough for any heap-check or
+      stack-check failure.
+
+      The size of the TSO struct plus the stack is either
+        (a) smaller than a block, or
+	(b) a multiple of BLOCK_SIZE
+
+	tso->why_blocked       tso->block_info      location
+        ----------------------------------------------------------------------
+	NotBlocked             NULL                 runnable_queue, or running
+	
+        BlockedOnBlackHole     the BLACKHOLE        blackhole_queue
+	
+        BlockedOnMVar          the MVAR             the MVAR's queue
+
+	BlockedOnSTM           END_TSO_QUEUE        STM wait queue(s)
+	
+        BlockedOnException     the TSO              TSO->blocked_exception
+
+        BlockedOnRead          NULL                 blocked_queue
+        BlockedOnWrite         NULL		    blocked_queue
+        BlockedOnDelay         NULL                 blocked_queue
+	BlockedOnGA            closure TSO blocks on   BQ of that closure
+	BlockedOnGA_NoSend     closure TSO blocks on   BQ of that closure
+
+      tso->link == END_TSO_QUEUE, if the thread is currently running.
+
+   A zombie thread has the following properties:
+      
+      tso->what_next == ThreadComplete or ThreadKilled
+      tso->link     ==  (could be on some queue somewhere)
+      tso->su       ==  tso->stack + tso->stack_size
+      tso->sp       ==  tso->stack + tso->stack_size - 1 (i.e. top stack word)
+      tso->sp[0]    ==  return value of thread, if what_next == ThreadComplete,
+                        exception             , if what_next == ThreadKilled
+
+      (tso->sp is left pointing at the top word on the stack so that
+      the return value or exception will be retained by a GC).
+
+   The 2 cases BlockedOnGA and BlockedOnGA_NoSend are needed in a GUM
+   setup only. They mark a TSO that has entered a FETCH_ME or
+   FETCH_ME_BQ closure, respectively; only the first TSO hitting the
+   closure will send a Fetch message.
+   Currently we have no separate code for blocking on an RBH; we use the
+   BlockedOnBlackHole case for that.   -- HWL
+
+ ---------------------------------------------------------------------------- */
+
+/* Workaround for a bug/quirk in gcc on certain architectures.
+ * symptom is that (&tso->stack - &tso->header) /=  sizeof(StgTSO)
+ * in other words, gcc pads the structure at the end.
+ */
+
+extern StgTSO dummy_tso;
+
+#define TSO_STRUCT_SIZE \
+   ((char *)&dummy_tso.stack - (char *)&dummy_tso.header)
+
+#define TSO_STRUCT_SIZEW (TSO_STRUCT_SIZE / sizeof(W_))
+
+/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */
+#define END_TSO_QUEUE  ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure)
+
+#endif /* RTS_STORAGE_TSO_H */