From bda943136e7dee3ad36e368fd81014850b5d6db9 Mon Sep 17 00:00:00 2001 From: simonmar Date: Thu, 18 Oct 2001 14:41:01 +0000 Subject: [PATCH] [project @ 2001-10-18 14:41:01 by simonmar] Add a lightweight arena allocation scheme, and use it to speed up allocation of cost centres and cost-centre stacks in the profiler. --- ghc/rts/Arena.c | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++ ghc/rts/Arena.h | 25 ++++++++++++ ghc/rts/Profiling.c | 19 ++++++--- ghc/rts/Storage.c | 6 ++- 4 files changed, 153 insertions(+), 6 deletions(-) create mode 100644 ghc/rts/Arena.c create mode 100644 ghc/rts/Arena.h diff --git a/ghc/rts/Arena.c b/ghc/rts/Arena.c new file mode 100644 index 0000000..f719400 --- /dev/null +++ b/ghc/rts/Arena.c @@ -0,0 +1,109 @@ +/* ----------------------------------------------------------------------------- + $Id: Arena.c,v 1.1 2001/10/18 14:41:01 simonmar Exp $ + (c) The University of Glasgow 2001 + + Arena allocation. Arenas provide fast memory allocation at the + expense of fine-grained recycling of storage: memory may be + only be returned to the system by freeing the entire arena, it + isn't possible to return individual objects within an arena. + + Do not assume that sequentially allocated objects will be adjacent + in memory. + + Quirks: this allocator makes use of the RTS block allocator. If + the current block doesn't have enough room for the requested + object, then a new block is allocated. This means that allocating + large objects will tend to result in wasted space at the end of + each block. In the worst case, half of the allocated space is + wasted. This allocator is therefore best suited to situations in + which most allocations are small. + -------------------------------------------------------------------------- */ + +#include "Rts.h" +#include "RtsUtils.h" +#include "BlockAlloc.h" +#include "Arena.h" + +// Each arena struct is allocated using malloc(). +struct _Arena { + bdescr *current; + StgWord *free; // ptr to next free byte in current block + StgWord *lim; // limit (== last free byte + 1) +}; + +// We like to keep track of how many blocks we've allocated for +// Storage.c:memInventory(). +static long arena_blocks = 0; + +// Begin a new arena +Arena * +newArena( void ) +{ + Arena *arena; + + arena = stgMallocBytes(sizeof(Arena), "newArena"); + arena->current = allocBlock(); + arena->current->link = NULL; + arena->free = arena->current->start; + arena->lim = arena->current->start + BLOCK_SIZE_W; + arena_blocks++; + + return arena; +} + +// 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 word size... + size_w = (size + sizeof(W_) - 1) / sizeof(W_); + + 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 = (lnat)BLOCK_ROUND_UP(size_w*sizeof(W_)) / BLOCK_SIZE; + bd = allocGroup(req_blocks); + arena_blocks += req_blocks; + + bd->gen_no = 0; + bd->step = NULL; + 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; + } +} + +// Free an entire arena +void +arenaFree( Arena *arena ) +{ + bdescr *bd, *next; + + for (bd = arena->current; bd != NULL; bd = next) { + next = bd->link; + arena_blocks -= bd->blocks; + ASSERT(arena_blocks >= 0); + freeGroup(bd); + } + free(arena); +} + +unsigned long +arenaBlocks( void ) +{ + return arena_blocks; +} + diff --git a/ghc/rts/Arena.h b/ghc/rts/Arena.h new file mode 100644 index 0000000..7b7ac91 --- /dev/null +++ b/ghc/rts/Arena.h @@ -0,0 +1,25 @@ +/* ----------------------------------------------------------------------------- + $Id: Arena.h,v 1.1 2001/10/18 14:41:01 simonmar Exp $ + (c) The University of Glasgow 2001 + + Arena allocation interface. + -------------------------------------------------------------------------- */ + +#ifndef ARENA_H + +// Abstract type of arenas +typedef struct _Arena Arena; + +// Start a new arena +extern Arena * newArena ( void ); + +// Allocate memory in an arena +extern void * arenaAlloc ( Arena *, size_t ); + +// Free an entire arena +extern void arenaFree ( Arena * ); + +// For internal use only: +extern unsigned long arenaBlocks( void ); + +#endif // ARENA_H diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c index b0c38db..a8cf7a4 100644 --- a/ghc/rts/Profiling.c +++ b/ghc/rts/Profiling.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Profiling.c,v 1.23 2001/10/18 13:46:47 simonmar Exp $ + * $Id: Profiling.c,v 1.24 2001/10/18 14:41:01 simonmar Exp $ * * (c) The GHC Team, 1998-2000 * @@ -18,6 +18,12 @@ #include "Proftimer.h" #include "Itimer.h" #include "ProfHeap.h" +#include "Arena.h" + +/* + * Profiling allocation arena. + */ +Arena *prof_arena; /* * Global variables used to assign unique IDs to cc's, ccs's, and @@ -153,6 +159,9 @@ static void reportCCS_XML ( CostCentreStack *ccs ); void initProfiling1 (void) { + // initialise our arena + prof_arena = newArena(); + /* for the benefit of allocate()... */ CCCS = CCS_SYSTEM; @@ -226,7 +235,7 @@ static void initProfilingLogFile(void) { /* Initialise the log file name */ - prof_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling"); + prof_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6); sprintf(prof_filename, "%s.prof", prog_argv[0]); /* open the log file */ @@ -253,7 +262,7 @@ initProfilingLogFile(void) if (RtsFlags.ProfFlags.doHeapProfile) { /* Initialise the log file name */ - hp_filename = stgMallocBytes(strlen(prog_argv[0]) + 6, "initProfiling"); + hp_filename = arenaAlloc(prof_arena, strlen(prog_argv[0]) + 6); sprintf(hp_filename, "%s.hp", prog_argv[0]); /* open the log file */ @@ -415,7 +424,7 @@ ActualPush ( CostCentreStack *ccs, CostCentre *cc ) CostCentreStack *new_ccs; /* allocate space for a new CostCentreStack */ - new_ccs = (CostCentreStack *) stgMallocBytes(sizeof(CostCentreStack), "Error allocating space for CostCentreStack"); + new_ccs = (CostCentreStack *) arenaAlloc(prof_arena, sizeof(CostCentreStack)); return ActualPush_(ccs, cc, new_ccs); } @@ -480,7 +489,7 @@ AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs, { IndexTable *new_it; - new_it = stgMallocBytes(sizeof(IndexTable), "AddToIndexTable"); + new_it = arenaAlloc(prof_arena, sizeof(IndexTable)); new_it->cc = cc; new_it->ccs = new_ccs; diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index 134106d..6b4333d 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.c,v 1.51 2001/10/01 11:09:02 simonmar Exp $ + * $Id: Storage.c,v 1.52 2001/10/18 14:41:01 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -17,6 +17,7 @@ #include "MBlock.h" #include "Weak.h" #include "Sanity.h" +#include "Arena.h" #include "Storage.h" #include "Schedule.h" @@ -773,6 +774,9 @@ memInventory(void) total_blocks += bd->blocks; } + // count the blocks allocated by the arena allocator + total_blocks += arenaBlocks(); + /* count the blocks on the free list */ free_blocks = countFreeList(); -- 1.7.10.4