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 */
#define BF_LARGE 2
/* Block is pinned */
#define BF_PINNED 4
-/* Block is part of a compacted generation */
-#define BF_COMPACTED 8
-/* Block is free, and on the free list */
+/* 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
+
/* Finding the block descriptor for a given block -------------------------- */
#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)
*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);
void freeGroup_lock(bdescr *p);
void freeChain_lock(bdescr *p);
-/* Round a value to megablocks --------------------------------------------- */
+bdescr * splitBlockGroup (bdescr *bd, nat blocks);
-#define WORDS_PER_MBLOCK (BLOCKS_PER_MBLOCK * BLOCK_SIZE_W)
+/* Round a value to megablocks --------------------------------------------- */
-INLINE_HEADER nat
-round_to_mblocks(nat words)
+// 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 > WORDS_PER_MBLOCK) {
- if ((words % WORDS_PER_MBLOCK) < (WORDS_PER_MBLOCK / 2)) {
- words = (words / WORDS_PER_MBLOCK) * WORDS_PER_MBLOCK;
- } else {
- words = ((words / WORDS_PER_MBLOCK) + 1) * WORDS_PER_MBLOCK;
+ 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;
+ return words;
}
#endif /* !CMINUSMINUS */