summaryrefslogtreecommitdiff
path: root/ghc/rts/BlockAlloc.c
diff options
context:
space:
mode:
authorSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
committerSimon Marlow <simonmar@microsoft.com>2006-04-07 02:05:11 +0000
commit0065d5ab628975892cea1ec7303f968c3338cbe1 (patch)
tree8e2afe0ab48ee33cf95009809d67c9649573ef92 /ghc/rts/BlockAlloc.c
parent28a464a75e14cece5db40f2765a29348273ff2d2 (diff)
downloadhaskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to Cabal, and with the move to darcs we can now flatten the source tree without losing history, so here goes. The main change is that the ghc/ subdir is gone, and most of what it contained is now at the top level. The build system now makes no pretense at being multi-project, it is just the GHC build system. No doubt this will break many things, and there will be a period of instability while we fix the dependencies. A straightforward build should work, but I haven't yet fixed binary/source distributions. Changes to the Building Guide will follow, too.
Diffstat (limited to 'ghc/rts/BlockAlloc.c')
-rw-r--r--ghc/rts/BlockAlloc.c391
1 files changed, 0 insertions, 391 deletions
diff --git a/ghc/rts/BlockAlloc.c b/ghc/rts/BlockAlloc.c
deleted file mode 100644
index 5e0e321947..0000000000
--- a/ghc/rts/BlockAlloc.c
+++ /dev/null
@@ -1,391 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2006
- *
- * The block allocator and free list manager.
- *
- * This is the architecture independent part of the block allocator.
- * It requires only the following support from the operating system:
- *
- * void *getMBlock();
- *
- * returns the address of an MBLOCK_SIZE region of memory, aligned on
- * an MBLOCK_SIZE boundary. There is no requirement for successive
- * calls to getMBlock to return strictly increasing addresses.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "BlockAlloc.h"
-#include "MBlock.h"
-#include "Storage.h"
-
-#include <string.h>
-
-static void initMBlock(void *mblock);
-static bdescr *allocMegaGroup(nat mblocks);
-static void freeMegaGroup(bdescr *bd);
-
-// In THREADED_RTS mode, the free list is protected by sm_mutex.
-static bdescr *free_list = NULL;
-
-/* -----------------------------------------------------------------------------
- Initialisation
- -------------------------------------------------------------------------- */
-
-void initBlockAllocator(void)
-{
- // The free list starts off NULL
-}
-
-/* -----------------------------------------------------------------------------
- Allocation
- -------------------------------------------------------------------------- */
-
-STATIC_INLINE void
-initGroup(nat n, bdescr *head)
-{
- bdescr *bd;
- nat i;
-
- if (n != 0) {
- head->blocks = n;
- head->free = head->start;
- head->link = NULL;
- for (i=1, bd = head+1; i < n; i++, bd++) {
- bd->free = 0;
- bd->blocks = 0;
- bd->link = head;
- }
- }
-}
-
-bdescr *
-allocGroup(nat n)
-{
- void *mblock;
- bdescr *bd, **last;
-
- ASSERT_SM_LOCK();
- ASSERT(n != 0);
-
- if (n > BLOCKS_PER_MBLOCK) {
- return allocMegaGroup(BLOCKS_TO_MBLOCKS(n));
- }
-
- last = &free_list;
- for (bd = free_list; bd != NULL; bd = bd->link) {
- if (bd->blocks == n) { /* exactly the right size! */
- *last = bd->link;
- /* no initialisation necessary - this is already a
- * self-contained block group. */
- bd->free = bd->start; /* block isn't free now */
- bd->link = NULL;
- return bd;
- }
- if (bd->blocks > n) { /* block too big... */
- bd->blocks -= n; /* take a chunk off the *end* */
- bd += bd->blocks;
- initGroup(n, bd); /* initialise it */
- return bd;
- }
- last = &bd->link;
- }
-
- mblock = getMBlock(); /* get a new megablock */
- initMBlock(mblock); /* initialise the start fields */
- bd = FIRST_BDESCR(mblock);
- initGroup(n,bd); /* we know the group will fit */
- if (n < BLOCKS_PER_MBLOCK) {
- initGroup(BLOCKS_PER_MBLOCK-n, bd+n);
- freeGroup(bd+n); /* add the rest on to the free list */
- }
- return bd;
-}
-
-bdescr *
-allocGroup_lock(nat n)
-{
- bdescr *bd;
- ACQUIRE_SM_LOCK;
- bd = allocGroup(n);
- RELEASE_SM_LOCK;
- return bd;
-}
-
-bdescr *
-allocBlock(void)
-{
- return allocGroup(1);
-}
-
-bdescr *
-allocBlock_lock(void)
-{
- bdescr *bd;
- ACQUIRE_SM_LOCK;
- bd = allocBlock();
- RELEASE_SM_LOCK;
- return bd;
-}
-
-/* -----------------------------------------------------------------------------
- Any request larger than BLOCKS_PER_MBLOCK needs a megablock group.
- First, search the free list for enough contiguous megablocks to
- fulfill the request - if we don't have enough, we need to
- allocate some new ones.
-
- A megablock group looks just like a normal block group, except that
- the blocks field in the head will be larger than BLOCKS_PER_MBLOCK.
-
- Note that any objects placed in this group must start in the first
- megablock, since the other blocks don't have block descriptors.
- -------------------------------------------------------------------------- */
-
-static bdescr *
-allocMegaGroup(nat n)
-{
- nat mbs_found;
- bdescr *bd, *last, *grp_start, *grp_prev;
-
- mbs_found = 0;
- grp_start = NULL;
- grp_prev = NULL;
- last = NULL;
- for (bd = free_list; bd != NULL; bd = bd->link) {
-
- if (bd->blocks == BLOCKS_PER_MBLOCK) { /* whole megablock found */
-
- /* is it the first one we've found or a non-contiguous megablock? */
- if (grp_start == NULL ||
- bd->start != last->start + MBLOCK_SIZE/sizeof(W_)) {
- grp_start = bd;
- grp_prev = last;
- mbs_found = 1;
- } else {
- mbs_found++;
- }
-
- if (mbs_found == n) { /* found enough contig megablocks? */
- break;
- }
- }
-
- else { /* only a partial megablock, start again */
- grp_start = NULL;
- }
-
- last = bd;
- }
-
- /* found all the megablocks we need on the free list
- */
- if (mbs_found == n) {
- /* remove the megablocks from the free list */
- if (grp_prev == NULL) { /* bd now points to the last mblock */
- free_list = bd->link;
- } else {
- grp_prev->link = bd->link;
- }
- }
-
- /* the free list wasn't sufficient, allocate all new mblocks.
- */
- else {
- void *mblock = getMBlocks(n);
- initMBlock(mblock); /* only need to init the 1st one */
- grp_start = FIRST_BDESCR(mblock);
- }
-
- /* set up the megablock group */
- initGroup(BLOCKS_PER_MBLOCK, grp_start);
- grp_start->blocks = MBLOCK_GROUP_BLOCKS(n);
- return grp_start;
-}
-
-/* -----------------------------------------------------------------------------
- De-Allocation
- -------------------------------------------------------------------------- */
-
-/* coalesce the group p with p->link if possible.
- *
- * Returns p->link if no coalescing was done, otherwise returns a
- * pointer to the newly enlarged group p.
- */
-
-STATIC_INLINE bdescr *
-coalesce(bdescr *p)
-{
- bdescr *bd, *q;
- nat i, blocks;
-
- q = p->link;
- if (q != NULL && p->start + p->blocks * BLOCK_SIZE_W == q->start) {
- /* can coalesce */
- p->blocks += q->blocks;
- p->link = q->link;
- blocks = q->blocks;
- for (i = 0, bd = q; i < blocks; bd++, i++) {
- bd->free = 0;
- bd->blocks = 0;
- bd->link = p;
- }
- return p;
- }
- return q;
-}
-
-void
-freeGroup(bdescr *p)
-{
- bdescr *bd, *last;
-
- ASSERT_SM_LOCK();
-
- /* are we dealing with a megablock group? */
- if (p->blocks > BLOCKS_PER_MBLOCK) {
- freeMegaGroup(p);
- return;
- }
-
-
- p->free = (void *)-1; /* indicates that this block is free */
- p->step = NULL;
- p->gen_no = 0;
- /* fill the block group with garbage if sanity checking is on */
- IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
-
- /* find correct place in free list to place new group */
- last = NULL;
- for (bd = free_list; bd != NULL && bd->start < p->start;
- bd = bd->link) {
- last = bd;
- }
-
- /* now, last = previous group (or NULL) */
- if (last == NULL) {
- p->link = free_list;
- free_list = p;
- } else {
- /* coalesce with previous group if possible */
- p->link = last->link;
- last->link = p;
- p = coalesce(last);
- }
-
- /* coalesce with next group if possible */
- coalesce(p);
- IF_DEBUG(sanity, checkFreeListSanity());
-}
-
-void
-freeGroup_lock(bdescr *p)
-{
- ACQUIRE_SM_LOCK;
- freeGroup(p);
- RELEASE_SM_LOCK;
-}
-
-static void
-freeMegaGroup(bdescr *p)
-{
- nat n;
- void *q = p;
-
- n = ((bdescr *)q)->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
- for (; n > 0; q += MBLOCK_SIZE, n--) {
- initMBlock(MBLOCK_ROUND_DOWN(q));
- initGroup(BLOCKS_PER_MBLOCK, (bdescr *)q);
- freeGroup((bdescr *)q);
- }
-}
-
-void
-freeChain(bdescr *bd)
-{
- bdescr *next_bd;
- while (bd != NULL) {
- next_bd = bd->link;
- freeGroup(bd);
- bd = next_bd;
- }
-}
-
-void
-freeChain_lock(bdescr *bd)
-{
- ACQUIRE_SM_LOCK;
- freeChain(bd);
- RELEASE_SM_LOCK;
-}
-
-static void
-initMBlock(void *mblock)
-{
- bdescr *bd;
- void *block;
-
- /* the first few Bdescr's in a block are unused, so we don't want to
- * put them all on the free list.
- */
- block = FIRST_BLOCK(mblock);
- bd = FIRST_BDESCR(mblock);
-
- /* Initialise the start field of each block descriptor
- */
- for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
- bd->start = block;
- }
-}
-
-/* -----------------------------------------------------------------------------
- Debugging
- -------------------------------------------------------------------------- */
-
-#ifdef DEBUG
-static void
-checkWellFormedGroup( bdescr *bd )
-{
- nat i;
-
- for (i = 1; i < bd->blocks; i++) {
- ASSERT(bd[i].blocks == 0);
- ASSERT(bd[i].free == 0);
- ASSERT(bd[i].link == bd);
- }
-}
-
-void
-checkFreeListSanity(void)
-{
- bdescr *bd;
-
- for (bd = free_list; bd != NULL; bd = bd->link) {
- IF_DEBUG(block_alloc,
- debugBelch("group at 0x%p, length %d blocks\n",
- bd->start, bd->blocks));
- ASSERT(bd->blocks > 0);
- checkWellFormedGroup(bd);
- if (bd->link != NULL) {
- /* make sure we're fully coalesced */
- ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);
- ASSERT(bd->start < bd->link->start);
- }
- }
-}
-
-nat /* BLOCKS */
-countFreeList(void)
-{
- bdescr *bd;
- lnat total_blocks = 0;
-
- for (bd = free_list; bd != NULL; bd = bd->link) {
- total_blocks += bd->blocks;
- }
- return total_blocks;
-}
-#endif