StgPtr
alloc_todo_block (gen_workspace *ws, nat size)
{
bdescr *bd/*, *hd, *tl */;
// Grab a part block if we have one, and it has enough room
bd = ws->part_list;
if (bd != NULL &&
bd->start + bd->blocks * BLOCK_SIZE_W - bd->free > (int)size)
{
ws->part_list = bd->link;
ws->n_part_blocks -= bd->blocks;
}
else
{
// blocks in to-space get the BF_EVACUATED flag.
// allocBlocks_sync(16, &hd, &tl,
// ws->step->gen_no, ws->step, BF_EVACUATED);
//
// tl->link = ws->part_list;
// ws->part_list = hd->link;
// ws->n_part_blocks += 15;
//
// bd = hd;
if (size > BLOCK_SIZE_W) {
bd = allocGroup_sync((W_)BLOCK_ROUND_UP(size*sizeof(W_))
/ BLOCK_SIZE);
} else {
bd = allocBlock_sync();
}
initBdescr(bd, ws->gen, ws->gen->to);
bd->flags = BF_EVACUATED;
bd->u.scan = bd->free = bd->start;
}
bd->link = NULL;
ws->todo_bd = bd;
ws->todo_free = bd->free;
ws->todo_lim = stg_min(bd->start + bd->blocks * BLOCK_SIZE_W,
bd->free + stg_max(WORK_UNIT_WORDS,size));
debugTrace(DEBUG_gc, "alloc new todo block %p for gen %d",
bd->free, ws->gen->no);
return ws->todo_free;
}
void
compactResize (Capability *cap, StgCompactNFData *str, StgWord new_size)
{
StgWord aligned_size;
aligned_size = BLOCK_ROUND_UP(new_size + sizeof(StgCompactNFDataBlock));
// Don't allow sizes larger than a megablock, because we can't use the
// memory after the first mblock for storing objects.
if (aligned_size >= BLOCK_SIZE * BLOCKS_PER_MBLOCK)
aligned_size = BLOCK_SIZE * BLOCKS_PER_MBLOCK;
str->autoBlockW = aligned_size / sizeof(StgWord);
compactAppendBlock(cap, str, aligned_size);
}
StgPtr
alloc_todo_block (gen_workspace *ws, uint32_t size)
{
bdescr *bd/*, *hd, *tl */;
// Grab a part block if we have one, and it has enough room
bd = ws->part_list;
if (bd != NULL &&
bd->start + bd->blocks * BLOCK_SIZE_W - bd->free > (int)size)
{
ws->part_list = bd->link;
ws->n_part_blocks -= bd->blocks;
ws->n_part_words -= bd->free - bd->start;
}
else
{
if (size > BLOCK_SIZE_W) {
bd = allocGroup_sync((W_)BLOCK_ROUND_UP(size*sizeof(W_))
/ BLOCK_SIZE);
} else {
if (gct->free_blocks) {
bd = gct->free_blocks;
gct->free_blocks = bd->link;
} else {
allocBlocks_sync(16, &bd);
gct->free_blocks = bd->link;
}
}
// blocks in to-space get the BF_EVACUATED flag.
bd->flags = BF_EVACUATED;
bd->u.scan = bd->start;
initBdescr(bd, ws->gen, ws->gen->to);
}
bd->link = NULL;
ws->todo_bd = bd;
ws->todo_free = bd->free;
ws->todo_lim = stg_min(bd->start + bd->blocks * BLOCK_SIZE_W,
bd->free + stg_max(WORK_UNIT_WORDS,size));
// See Note [big objects]
debugTrace(DEBUG_gc, "alloc new todo block %p for gen %d",
bd->free, ws->gen->no);
return ws->todo_free;
}
StgCompactNFDataBlock *
compactAllocateBlock(Capability *cap,
StgWord size,
StgCompactNFDataBlock *previous)
{
StgWord aligned_size;
StgCompactNFDataBlock *block;
bdescr *bd;
aligned_size = BLOCK_ROUND_UP(size);
// We do not link the new object into the generation ever
// - we cannot let the GC know about this object until we're done
// importing it and we have fixed up all info tables and stuff
//
// but we do update n_compact_blocks, otherwise memInventory()
// in Sanity will think we have a memory leak, because it compares
// the blocks he knows about with the blocks obtained by the
// block allocator
// (if by chance a memory leak does happen due to a bug somewhere
// else, memInventory will also report that all compact blocks
// associated with this compact are leaked - but they are not really,
// we have a pointer to them and we're not losing track of it, it's
// just we can't use the GC until we're done with the import)
//
// (That btw means that the high level import code must be careful
// not to lose the pointer, so don't use the primops directly
// unless you know what you're doing!)
// Other trickery: we pass NULL as first, which means our blocks
// are always in generation 0
// This is correct because the GC has never seen the blocks so
// it had no chance of promoting them
block = compactAllocateBlockInternal(cap, aligned_size, NULL,
previous != NULL ? ALLOCATE_IMPORT_APPEND : ALLOCATE_IMPORT_NEW);
if (previous != NULL)
previous->next = block;
bd = Bdescr((P_)block);
bd->free = (P_)((W_)bd->start + size);
return block;
}
StgCompactNFData *
compactNew (Capability *cap, StgWord size)
{
StgWord aligned_size;
StgCompactNFDataBlock *block;
StgCompactNFData *self;
bdescr *bd;
aligned_size = BLOCK_ROUND_UP(size + sizeof(StgCompactNFData)
+ sizeof(StgCompactNFDataBlock));
// Don't allow sizes larger than a megablock, because we can't use the
// memory after the first mblock for storing objects.
if (aligned_size >= BLOCK_SIZE * BLOCKS_PER_MBLOCK)
aligned_size = BLOCK_SIZE * BLOCKS_PER_MBLOCK;
block = compactAllocateBlockInternal(cap, aligned_size, NULL,
ALLOCATE_NEW);
self = firstBlockGetCompact(block);
SET_HDR((StgClosure*)self, &stg_COMPACT_NFDATA_CLEAN_info, CCS_SYSTEM);
self->autoBlockW = aligned_size / sizeof(StgWord);
self->nursery = block;
self->last = block;
self->hash = NULL;
block->owner = self;
bd = Bdescr((P_)block);
bd->free = (StgPtr)((W_)self + sizeof(StgCompactNFData));
self->hp = bd->free;
self->hpLim = bd->start + bd->blocks * BLOCK_SIZE_W;
self->totalW = bd->blocks * BLOCK_SIZE_W;
debugTrace(DEBUG_compact, "compactNew: size %" FMT_Word, size);
return self;
}
// Allocate some memory in an arena
void *
arenaAlloc( Arena *arena, size_t size )
{
void *p;
nat size_w;
nat req_blocks;
bdescr *bd;
// round up to nearest alignment chunk.
size = ROUNDUP(size,MIN_ALIGN);
// size of allocated block in words.
size_w = B_TO_W(size);
if ( arena->free + size_w < arena->lim ) {
// enough room in the current block...
p = arena->free;
arena->free += size_w;
return p;
} else {
// allocate a fresh block...
req_blocks = (W_)BLOCK_ROUND_UP(size) / BLOCK_SIZE;
bd = allocGroup_lock(req_blocks);
arena_blocks += req_blocks;
bd->gen_no = 0;
bd->gen = NULL;
bd->dest_no = 0;
bd->flags = 0;
bd->free = bd->start;
bd->link = arena->current;
arena->current = bd;
arena->free = bd->free + size_w;
arena->lim = bd->free + bd->blocks * BLOCK_SIZE_W;
return bd->start;
}
}
StgPtr
allocate (Capability *cap, W_ n)
{
bdescr *bd;
StgPtr p;
TICK_ALLOC_HEAP_NOCTR(WDS(n));
CCS_ALLOC(cap->r.rCCCS,n);
if (cap->r.rCurrentTSO != NULL) {
// cap->r.rCurrentTSO->alloc_limit -= n*sizeof(W_)
ASSIGN_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit),
(PK_Int64((W_*)&(cap->r.rCurrentTSO->alloc_limit))
- n*sizeof(W_)));
}
if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
// The largest number of words such that
// the computation of req_blocks will not overflow.
W_ max_words = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_);
W_ req_blocks;
if (n > max_words)
req_blocks = HS_WORD_MAX; // signal overflow below
else
req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
// Attempting to allocate an object larger than maxHeapSize
// should definitely be disallowed. (bug #1791)
if ((RtsFlags.GcFlags.maxHeapSize > 0 &&
req_blocks >= RtsFlags.GcFlags.maxHeapSize) ||
req_blocks >= HS_INT32_MAX) // avoid overflow when
// calling allocGroup() below
{
heapOverflow();
// heapOverflow() doesn't exit (see #2592), but we aren't
// in a position to do a clean shutdown here: we
// either have to allocate the memory or exit now.
// Allocating the memory would be bad, because the user
// has requested that we not exceed maxHeapSize, so we
// just exit.
stg_exit(EXIT_HEAPOVERFLOW);
}
ACQUIRE_SM_LOCK
bd = allocGroup(req_blocks);
dbl_link_onto(bd, &g0->large_objects);
g0->n_large_blocks += bd->blocks; // might be larger than req_blocks
g0->n_new_large_words += n;
RELEASE_SM_LOCK;
initBdescr(bd, g0, g0);
bd->flags = BF_LARGE;
bd->free = bd->start + n;
cap->total_allocated += n;
return bd->start;
}
/* small allocation (<LARGE_OBJECT_THRESHOLD) */
bd = cap->r.rCurrentAlloc;
if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
if (bd) finishedNurseryBlock(cap,bd);
// The CurrentAlloc block is full, we need to find another
// one. First, we try taking the next block from the
// nursery:
bd = cap->r.rCurrentNursery->link;
if (bd == NULL) {
// The nursery is empty: allocate a fresh block (we can't
// fail here).
ACQUIRE_SM_LOCK;
bd = allocBlock();
cap->r.rNursery->n_blocks++;
RELEASE_SM_LOCK;
initBdescr(bd, g0, g0);
bd->flags = 0;
// If we had to allocate a new block, then we'll GC
// pretty quickly now, because MAYBE_GC() will
// notice that CurrentNursery->link is NULL.
} else {
newNurseryBlock(bd);
// we have a block in the nursery: take it and put
// it at the *front* of the nursery list, and use it
// to allocate() from.
//
// Previously the nursery looked like this:
//
// CurrentNursery
// /
// +-+ +-+
// nursery -> ... |A| -> |B| -> ...
// +-+ +-+
//
// After doing this, it looks like this:
//
// CurrentNursery
// /
// +-+ +-+
// nursery -> |B| -> ... -> |A| -> ...
// +-+ +-+
// |
// CurrentAlloc
//
// The point is to get the block out of the way of the
// advancing CurrentNursery pointer, while keeping it
// on the nursery list so we don't lose track of it.
cap->r.rCurrentNursery->link = bd->link;
if (bd->link != NULL) {
bd->link->u.back = cap->r.rCurrentNursery;
}
}
dbl_link_onto(bd, &cap->r.rNursery->blocks);
cap->r.rCurrentAlloc = bd;
IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
}
p = bd->free;
bd->free += n;
IF_DEBUG(sanity, ASSERT(*((StgWord8*)p) == 0xaa));
return p;
}
void *
allocateForCompact (Capability *cap,
StgCompactNFData *str,
StgWord sizeW)
{
StgPtr to;
StgWord next_size;
StgCompactNFDataBlock *block;
bdescr *bd;
ASSERT(str->nursery != NULL);
ASSERT(str->hp > Bdescr((P_)str->nursery)->start);
ASSERT(str->hp <= Bdescr((P_)str->nursery)->start +
Bdescr((P_)str->nursery)->blocks * BLOCK_SIZE_W);
retry:
if (str->hp + sizeW < str->hpLim) {
to = str->hp;
str->hp += sizeW;
return to;
}
bd = Bdescr((P_)str->nursery);
bd->free = str->hp;
// We know it doesn't fit in the nursery
// if it is a large object, allocate a new block
if (sizeW > LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
next_size = BLOCK_ROUND_UP(sizeW*sizeof(W_) +
sizeof(StgCompactNFData));
block = compactAppendBlock(cap, str, next_size);
bd = Bdescr((P_)block);
to = bd->free;
bd->free += sizeW;
return to;
}
// move the nursery past full blocks
if (block_is_full (str->nursery)) {
do {
str->nursery = str->nursery->next;
} while (str->nursery && block_is_full(str->nursery));
if (str->nursery == NULL) {
str->nursery = compactAppendBlock(cap, str,
str->autoBlockW * sizeof(W_));
}
bd = Bdescr((P_)str->nursery);
str->hp = bd->free;
str->hpLim = bd->start + bd->blocks * BLOCK_SIZE_W;
goto retry;
}
// try subsequent blocks
for (block = str->nursery->next; block != NULL; block = block->next) {
bd = Bdescr((P_)block);
if (has_room_for(bd,sizeW)) {
to = bd->free;
bd->free += sizeW;
return to;
}
}
// If all else fails, allocate a new block of the right size.
next_size = stg_max(str->autoBlockW * sizeof(StgWord),
BLOCK_ROUND_UP(sizeW * sizeof(StgWord)
+ sizeof(StgCompactNFDataBlock)));
block = compactAppendBlock(cap, str, next_size);
bd = Bdescr((P_)block);
to = bd->free;
bd->free += sizeW;
return to;
}
int main(int argc, char **argv)
{
int fd;
int ret;
int len, i, j, offset;
loff_t seek;
struct timeval tv1, tv2;
struct erase_info_user ei;
if (argc < 4)
{
fprintf(stderr, "Usage: nand_write <dev> <offset> <size>\n");
return -1;
}
fd = open(argv[1], O_RDWR);
if (fd < 0)
{
fprintf(stderr, "Can not open %s\n", argv[1]);
return -1;
}
offset = strtoul(argv[2], NULL, 16);
len = strtoul(argv[3], NULL, 16);
len = BLOCK_ROUND_UP(len);
i = 0;
j = offset;
while (i < len)
{
seek = (loff_t)j;
ret = ioctl(fd, MEMGETBADBLOCK, &seek);
if (ret == 1)
{
j += BLOCK_SIZE;
continue;
}
ei.start = (unsigned int)(j);
ei.length = BLOCK_SIZE;
j += BLOCK_SIZE;
if (-1 == ioctl(fd, MEMERASE, &ei))
continue;
i += BLOCK_SIZE;
}
memset(buffer, 0xaa, sizeof (buffer));
i = 0;
j = offset;
gettimeofday(&tv1, NULL);
while (i < len)
{
seek = (loff_t)j;
ret = ioctl(fd, MEMGETBADBLOCK, &seek);
if (ret == 1)
{
j += BLOCK_SIZE;
continue;
}
seek = (loff_t)j;
lseek(fd, seek, SEEK_SET);
ret = write(fd, buffer, BLOCK_SIZE);
i += BLOCK_SIZE;
}
gettimeofday(&tv2, NULL);
close(fd);
i = tv2.tv_usec - tv1.tv_usec;
if (i < 0)
{
j = tv2.tv_sec - tv1.tv_sec - 1;
i = 1000000 + tv2.tv_usec - tv1.tv_usec;
}
else
{
j = tv2.tv_sec - tv1.tv_sec;
}
ret = len/(j*1000 + i/1000);
ret = ret*1000;
fprintf(stderr, "write %08x bytes, times used %d.%06d, speed %d.%dMB/s\n", len, j, i, ret/0x100000,
(ret%0x100000)*10/0x100000);
return 0;
}
static rtsBool
scavenge_one(StgPtr p)
{
const StgInfoTable *info;
rtsBool no_luck;
rtsBool saved_eager_promotion;
saved_eager_promotion = gct->eager_promotion;
ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
info = get_itbl((StgClosure *)p);
switch (info->type) {
case MVAR_CLEAN:
case MVAR_DIRTY:
{
StgMVar *mvar = ((StgMVar *)p);
gct->eager_promotion = rtsFalse;
evacuate((StgClosure **)&mvar->head);
evacuate((StgClosure **)&mvar->tail);
evacuate((StgClosure **)&mvar->value);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
mvar->header.info = &stg_MVAR_DIRTY_info;
} else {
mvar->header.info = &stg_MVAR_CLEAN_info;
}
break;
}
case THUNK:
case THUNK_1_0:
case THUNK_0_1:
case THUNK_1_1:
case THUNK_0_2:
case THUNK_2_0:
{
StgPtr q, end;
end = (StgPtr)((StgThunk *)p)->payload + info->layout.payload.ptrs;
for (q = (StgPtr)((StgThunk *)p)->payload; q < end; q++) {
evacuate((StgClosure **)q);
}
break;
}
case FUN:
case FUN_1_0: // hardly worth specialising these guys
case FUN_0_1:
case FUN_1_1:
case FUN_0_2:
case FUN_2_0:
case CONSTR:
case CONSTR_1_0:
case CONSTR_0_1:
case CONSTR_1_1:
case CONSTR_0_2:
case CONSTR_2_0:
case WEAK:
case PRIM:
case IND_PERM:
{
StgPtr q, end;
end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) {
evacuate((StgClosure **)q);
}
break;
}
case MUT_VAR_CLEAN:
case MUT_VAR_DIRTY: {
StgPtr q = p;
gct->eager_promotion = rtsFalse;
evacuate(&((StgMutVar *)p)->var);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
} else {
((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
}
break;
}
case BLOCKING_QUEUE:
{
StgBlockingQueue *bq = (StgBlockingQueue *)p;
gct->eager_promotion = rtsFalse;
evacuate(&bq->bh);
evacuate((StgClosure**)&bq->owner);
evacuate((StgClosure**)&bq->queue);
evacuate((StgClosure**)&bq->link);
gct->eager_promotion = saved_eager_promotion;
if (gct->failed_to_evac) {
bq->header.info = &stg_BLOCKING_QUEUE_DIRTY_info;
} else {
bq->header.info = &stg_BLOCKING_QUEUE_CLEAN_info;
}
break;
}
case THUNK_SELECTOR:
{
StgSelector *s = (StgSelector *)p;
evacuate(&s->selectee);
break;
}
case AP_STACK:
{
StgAP_STACK *ap = (StgAP_STACK *)p;
evacuate(&ap->fun);
scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
p = (StgPtr)ap->payload + ap->size;
break;
}
case PAP:
p = scavenge_PAP((StgPAP *)p);
break;
case AP:
p = scavenge_AP((StgAP *)p);
break;
case ARR_WORDS:
// nothing to follow
break;
case MUT_ARR_PTRS_CLEAN:
case MUT_ARR_PTRS_DIRTY:
{
// We don't eagerly promote objects pointed to by a mutable
// array, but if we find the array only points to objects in
// the same or an older generation, we mark it "clean" and
// avoid traversing it during minor GCs.
gct->eager_promotion = rtsFalse;
scavenge_mut_arr_ptrs((StgMutArrPtrs *)p);
if (gct->failed_to_evac) {
((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
} else {
((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
}
gct->eager_promotion = saved_eager_promotion;
gct->failed_to_evac = rtsTrue;
break;
}
case MUT_ARR_PTRS_FROZEN:
case MUT_ARR_PTRS_FROZEN0:
{
// follow everything
scavenge_mut_arr_ptrs((StgMutArrPtrs *)p);
// If we're going to put this object on the mutable list, then
// set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
if (gct->failed_to_evac) {
((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
} else {
((StgClosure *)p)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
}
break;
}
case TSO:
{
scavengeTSO((StgTSO*)p);
break;
}
case STACK:
{
StgStack *stack = (StgStack*)p;
gct->eager_promotion = rtsFalse;
scavenge_stack(stack->sp, stack->stack + stack->stack_size);
stack->dirty = gct->failed_to_evac;
gct->eager_promotion = saved_eager_promotion;
break;
}
case MUT_PRIM:
{
StgPtr end;
gct->eager_promotion = rtsFalse;
end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
evacuate((StgClosure **)p);
}
gct->eager_promotion = saved_eager_promotion;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
case TREC_CHUNK:
{
StgWord i;
StgTRecChunk *tc = ((StgTRecChunk *) p);
TRecEntry *e = &(tc -> entries[0]);
gct->eager_promotion = rtsFalse;
evacuate((StgClosure **)&tc->prev_chunk);
for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
evacuate((StgClosure **)&e->tvar);
evacuate((StgClosure **)&e->expected_value);
evacuate((StgClosure **)&e->new_value);
}
gct->eager_promotion = saved_eager_promotion;
gct->failed_to_evac = rtsTrue; // mutable
break;
}
case IND:
// IND can happen, for example, when the interpreter allocates
// a gigantic AP closure (more than one block), which ends up
// on the large-object list and then gets updated. See #3424.
case BLACKHOLE:
case IND_STATIC:
evacuate(&((StgInd *)p)->indirectee);
#if 0 && defined(DEBUG)
if (RtsFlags.DebugFlags.gc)
/* Debugging code to print out the size of the thing we just
* promoted
*/
{
StgPtr start = gen->scan;
bdescr *start_bd = gen->scan_bd;
nat size = 0;
scavenge(&gen);
if (start_bd != gen->scan_bd) {
size += (P_)BLOCK_ROUND_UP(start) - start;
start_bd = start_bd->link;
while (start_bd != gen->scan_bd) {
size += BLOCK_SIZE_W;
start_bd = start_bd->link;
}
size += gen->scan -
(P_)BLOCK_ROUND_DOWN(gen->scan);
} else {
size = gen->scan - start;
}
debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
}
#endif
break;
default:
barf("scavenge_one: strange object %d", (int)(info->type));
}
no_luck = gct->failed_to_evac;
gct->failed_to_evac = rtsFalse;
return (no_luck);
}
