X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=includes%2FBlock.h;h=e2e691ab0e17db80981f5fc923b3b5a47eab9756;hb=27a28cf6bc2196ee1690ac1fcc4d4c59d9b0d50f;hp=408088087aeeb0ccfdcf9b60820faf1f8b777646;hpb=e3c55aebd4f9ce7a5b4390d4726612865fd207f2;p=ghc-hetmet.git diff --git a/includes/Block.h b/includes/Block.h index 4080880..e2e691a 100644 --- a/includes/Block.h +++ b/includes/Block.h @@ -54,6 +54,7 @@ typedef struct bdescr_ { 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 */ @@ -130,6 +131,11 @@ INLINE_HEADER bdescr *Bdescr(StgPtr p) #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) @@ -161,6 +167,45 @@ dbl_link_onto(bdescr *bd, bdescr **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); @@ -183,21 +228,30 @@ void freeChain(bdescr *p); 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 */