Fri Aug 20 08:26:22 BRT 2010 Marco Túlio Gontijo e Silva * Immix: allocate and free memory on lines. diff -rN -u old-ghc-organizado/includes/rts/storage/Block.h new-ghc-organizado/includes/rts/storage/Block.h --- old-ghc-organizado/includes/rts/storage/Block.h 2010-08-20 08:27:54.000000000 -0300 +++ new-ghc-organizado/includes/rts/storage/Block.h 2010-08-20 08:27:54.000000000 -0300 @@ -100,6 +100,8 @@ #define BF_KNOWN 128 /* Block was swept in the last generation */ #define BF_SWEPT 256 +/* Block contains objects larger than a line */ +#define BF_MEDIUM 512 /* Finding the block descriptor for a given block -------------------------- */ diff -rN -u old-ghc-organizado/includes/rts/storage/GC.h new-ghc-organizado/includes/rts/storage/GC.h --- old-ghc-organizado/includes/rts/storage/GC.h 2010-08-20 08:27:54.000000000 -0300 +++ new-ghc-organizado/includes/rts/storage/GC.h 2010-08-20 08:27:54.000000000 -0300 @@ -12,6 +12,15 @@ #include #include "rts/OSThreads.h" +// This data type represents a free line group. Each generation has a linked +// list of these groups with various size. +typedef struct line_ { + struct line_ *next; // A link to the next free line group + StgWord size; // The size of this group + StgWord pad[BITS_IN(W_) - 2]; +} line; + + /* ----------------------------------------------------------------------------- * Generational GC * @@ -112,6 +121,9 @@ bdescr * bitmap; // bitmap for compacting collection StgTSO * old_threads; + + // The first free line group of this generation + line * first_line; } generation; extern generation * generations; diff -rN -u old-ghc-organizado/rts/sm/Evac.c new-ghc-organizado/rts/sm/Evac.c --- old-ghc-organizado/rts/sm/Evac.c 2010-08-20 08:27:54.000000000 -0300 +++ new-ghc-organizado/rts/sm/Evac.c 2010-08-20 08:27:54.000000000 -0300 @@ -80,7 +80,15 @@ if (ws->todo_free > ws->todo_lim) { to = todo_block_full(size, ws); } - ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim); + + // If a line is being used for allocation + if(ws->todo_bd == NULL) { + mark(to, Bdescr(to)); + push_mark_stack(to); + } + + ASSERT((ws->todo_bd == NULL || ws->todo_free >= ws->todo_bd->free) && + ws->todo_free <= ws->todo_lim); return to; } @@ -98,6 +106,13 @@ to = alloc_for_copy(size,gen); + // Mark this block as containing medium objects, that is, larger than the + // size of a line. This will make Immix unavailable for this block, in + // Sweep.c. + if(size > BITS_IN(W_)) { + Bdescr(to)->flags |= BF_MEDIUM; + } + from = (StgPtr)src; to[0] = (W_)info; diff -rN -u old-ghc-organizado/rts/sm/GCUtils.c new-ghc-organizado/rts/sm/GCUtils.c --- old-ghc-organizado/rts/sm/GCUtils.c 2010-08-20 08:27:54.000000000 -0300 +++ new-ghc-organizado/rts/sm/GCUtils.c 2010-08-20 08:27:54.000000000 -0300 @@ -165,73 +165,93 @@ { StgPtr p; bdescr *bd; + generation *gen; // todo_free has been pre-incremented by Evac.c:alloc_for_copy(). We // are expected to leave it bumped when we've finished here. ws->todo_free -= size; bd = ws->todo_bd; + gen = ws->gen; - ASSERT(bd != NULL); - ASSERT(bd->link == NULL); - ASSERT(bd->gen == ws->gen); - - // If the global list is not empty, or there's not much work in - // this block to push, and there's enough room in - // this block to evacuate the current object, then just increase - // the limit. - if (!looksEmptyWSDeque(ws->todo_q) || - (ws->todo_free - bd->u.scan < WORK_UNIT_WORDS / 2)) { - if (ws->todo_free + size < bd->start + bd->blocks * BLOCK_SIZE_W) { - ws->todo_lim = stg_min(bd->start + bd->blocks * BLOCK_SIZE_W, - ws->todo_lim + stg_max(WORK_UNIT_WORDS,size)); - debugTrace(DEBUG_gc, "increasing limit for %p to %p", bd->start, ws->todo_lim); - p = ws->todo_free; - ws->todo_free += size; - return p; + // bd == NULL means we're allocating on a line + if (bd != NULL) { + + ASSERT(bd->link == NULL); + ASSERT(bd->gen == gen); + + // If the global list is not empty, or there's not much work in + // this block to push, and there's enough room in + // this block to evacuate the current object, then just increase + // the limit. + if (!looksEmptyWSDeque(ws->todo_q) || + (ws->todo_free - bd->u.scan < WORK_UNIT_WORDS / 2)) { + if (ws->todo_free + size < bd->start + bd->blocks * BLOCK_SIZE_W) { + ws->todo_lim = stg_min(bd->start + bd->blocks * BLOCK_SIZE_W, + ws->todo_lim + stg_max(WORK_UNIT_WORDS,size)); + debugTrace(DEBUG_gc, "increasing limit for %p to %p", bd->start, ws->todo_lim); + p = ws->todo_free; + ws->todo_free += size; + return p; + } } - } - gct->copied += ws->todo_free - bd->free; - bd->free = ws->todo_free; + gct->copied += ws->todo_free - bd->free; + bd->free = ws->todo_free; - ASSERT(bd->u.scan >= bd->start && bd->u.scan <= bd->free); + ASSERT(bd->u.scan >= bd->start && bd->u.scan <= bd->free); - // If this block is not the scan block, we want to push it out and - // make room for a new todo block. - if (bd != gct->scan_bd) - { - // If this block does not have enough space to allocate the - // current object, but it also doesn't have any work to push, then - // push it on to the scanned list. It cannot be empty, because - // then there would be enough room to copy the current object. - if (bd->u.scan == bd->free) + // If this block is not the scan block, we want to push it out and + // make room for a new todo block. + if (bd != gct->scan_bd) { - ASSERT(bd->free != bd->start); - push_scanned_block(bd, ws); - } - // Otherwise, push this block out to the global list. - else - { - generation *gen; - gen = ws->gen; - debugTrace(DEBUG_gc, "push todo block %p (%ld words), step %d, todo_q: %ld", - bd->start, (unsigned long)(bd->free - bd->u.scan), - gen->no, dequeElements(ws->todo_q)); - - if (!pushWSDeque(ws->todo_q, bd)) { - bd->link = ws->todo_overflow; - ws->todo_overflow = bd; - ws->n_todo_overflow++; + // If this block does not have enough space to allocate the + // current object, but it also doesn't have any work to push, then + // push it on to the scanned list. It cannot be empty, because + // then there would be enough room to copy the current object. + if (bd->u.scan == bd->free) + { + ASSERT(bd->free != bd->start); + push_scanned_block(bd, ws); + } + // Otherwise, push this block out to the global list. + else + { + debugTrace(DEBUG_gc, "push todo block %p (%ld words), step %d, todo_q: %ld", + bd->start, (unsigned long)(bd->free - bd->u.scan), + gen->no, dequeElements(ws->todo_q)); + + if (!pushWSDeque(ws->todo_q, bd)) { + bd->link = ws->todo_overflow; + ws->todo_overflow = bd; + ws->n_todo_overflow++; + } } } } ws->todo_bd = NULL; - ws->todo_free = NULL; - ws->todo_lim = NULL; - alloc_todo_block(ws, size); + // Currently the mark stack is used to ensure that the allocated object + // gets scavenged, so allocation in lines only happens when the mark stack + // is active, that is, in major GCs. + if (major_gc && gen->first_line != NULL && + + // Check if there is another free line group, and if the object + // fits in it. + size <= BITS_IN(W_) * gen->first_line->size) { + + ws->todo_free = (StgPtr) gen->first_line; + ws->todo_lim = ws->todo_free + BITS_IN(W_) * + gen->first_line->size; + gen->first_line = gen->first_line->next; + } else { + + // Allocate in blocks + ws->todo_free = NULL; + ws->todo_lim = NULL; + alloc_todo_block(ws, size); + } p = ws->todo_free; ws->todo_free += size; diff -rN -u old-ghc-organizado/rts/sm/Scav.c new-ghc-organizado/rts/sm/Scav.c --- old-ghc-organizado/rts/sm/Scav.c 2010-08-20 08:27:54.000000000 -0300 +++ new-ghc-organizado/rts/sm/Scav.c 2010-08-20 08:27:54.000000000 -0300 @@ -1814,7 +1814,7 @@ // If we have a scan block with some work to do, // scavenge everything up to the free pointer. - if (ws->todo_bd->u.scan < ws->todo_free) + if (ws->todo_bd != NULL && ws->todo_bd->u.scan < ws->todo_free) { scavenge_block(ws->todo_bd); did_something = rtsTrue; diff -rN -u old-ghc-organizado/rts/sm/Storage.c new-ghc-organizado/rts/sm/Storage.c --- old-ghc-organizado/rts/sm/Storage.c 2010-08-20 08:27:54.000000000 -0300 +++ new-ghc-organizado/rts/sm/Storage.c 2010-08-20 08:27:54.000000000 -0300 @@ -89,6 +89,7 @@ #endif gen->threads = END_TSO_QUEUE; gen->old_threads = END_TSO_QUEUE; + gen->first_line = NULL; } void diff -rN -u old-ghc-organizado/rts/sm/Sweep.c new-ghc-organizado/rts/sm/Sweep.c --- old-ghc-organizado/rts/sm/Sweep.c 2010-08-20 08:27:54.000000000 -0300 +++ new-ghc-organizado/rts/sm/Sweep.c 2010-08-20 08:27:54.000000000 -0300 @@ -36,7 +36,13 @@ // freed, fragd and blocks are only used for debugging // resid is the number of BITS_IN(W_) words groups that contains a mark nat freed, resid, fragd, blocks, live; - + line *last_line; + line *start; + rtsBool sequence; + + gen->first_line = NULL; + last_line = NULL; + ASSERT(countBlocks(gen->old_blocks) == gen->n_old_blocks); live = 0; // estimate of live data in this gen @@ -81,18 +87,71 @@ prev->link = next; } freeGroup(bd); + continue; } - else - { - prev = bd; - // if more than 1/4 of the word groups are completely umnarked, - // the block is fragmented. - if (resid < (BLOCK_SIZE_W * 3) / (BITS_IN(W_) * 4)) { - fragd++; - bd->flags |= BF_FRAGMENTED; + prev = bd; + bd->flags |= BF_SWEPT; + + // if more than 1/4 of the word groups are completely umnarked, + // the block is fragmented. + if (bd->flags & BF_MEDIUM || + resid < (BLOCK_SIZE_W * 3) / (BITS_IN(W_) * 4)) { + fragd++; + bd->flags |= BF_FRAGMENTED; + continue; + } + + // Continue if there are no free lines + if (resid == BLOCK_SIZE_W / BITS_IN(W_)) { + continue; + } + + sequence = rtsFalse; + + // Don't create free lines in the unalocated area of the block. + for (i = 1, start = (line *) bd->start + 1; start + 1 <= bd->free; + i++, start++) { + + // Tests if this is the first line we've found in a free line + // group. Due to conservative marking, we don't consider the first + // free line of a line group as free. + if (bd->u.bitmap[i] != 0 || bd->u.bitmap[i - 1] != 0) { + + // This is not a free line. If a new free line is found, it'll + // be the first of a free line group. + sequence = rtsFalse; + continue; + } + + // This is a line inside a free line group, so all that is needed + // is to increment the size of the group. + if (sequence) { + last_line->size++; + continue; + } + // This is the first line of a group. + + // This is the first line of the generation. + if (gen->first_line == NULL) { + gen->first_line = (line *) start; } - bd->flags |= BF_SWEPT; + // If this is not the first group of the generation, update the + // link of the last group. + if(last_line != NULL) { + last_line->next = (line *) start; + } + + // Create the link of the list + last_line = (line *) start; + + // Finishes the list + last_line->next = NULL; + + // Sets the size + last_line->size = 1; + + sequence = rtsTrue; } }