--- /dev/null
+/* -----------------------------------------------------------------------------
+ $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;
+}
+
--- /dev/null
+/* -----------------------------------------------------------------------------
+ $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
/* -----------------------------------------------------------------------------
- * $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
*
#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
void
initProfiling1 (void)
{
+ // initialise our arena
+ prof_arena = newArena();
+
/* for the benefit of allocate()... */
CCCS = CCS_SYSTEM;
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 */
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 */
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);
}
{
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;
/* -----------------------------------------------------------------------------
- * $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
*
#include "MBlock.h"
#include "Weak.h"
#include "Sanity.h"
+#include "Arena.h"
#include "Storage.h"
#include "Schedule.h"
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();
projects / ghc-hetmet.git / commitdiff