Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/596c263224146a9c0a0a27e09db0a171eaa90aba >--------------------------------------------------------------- commit 596c263224146a9c0a0a27e09db0a171eaa90aba Author: Simon Marlow <[email protected]> Date: Tue Apr 5 13:34:12 2011 +0100 add some debugging traces >--------------------------------------------------------------- tests/ghc-regress/rts/testblockalloc.c | 51 +++++++++++++++++-------------- 1 files changed, 28 insertions(+), 23 deletions(-) diff --git a/tests/ghc-regress/rts/testblockalloc.c b/tests/ghc-regress/rts/testblockalloc.c index 586aa1b..5ccc14b 100644 --- a/tests/ghc-regress/rts/testblockalloc.c +++ b/tests/ghc-regress/rts/testblockalloc.c @@ -1,5 +1,4 @@ #include "Rts.h" -#include "RtsFlags.h" #include <stdio.h> @@ -9,7 +8,7 @@ extern void freeGroup_lock(bdescr *p); const int ARRSIZE = 256; const int LOOPS = 100; const int MAXALLOC = ((8 * 1024 * 1024) / BLOCK_SIZE - 1); -//const int MAXALLOC = ((4 * 1024 * 1024) / BLOCK_SIZE - 1); +//const int MAXALLOC = ((64 * 1024 * 1024) / BLOCK_SIZE - 1); const int SEED = 0xf00f00; extern lnat mblocks_allocated; @@ -24,27 +23,30 @@ int main (int argc, char *argv[]) hs_init(&argc, &argv); - // repeatedly sweep though the array, allocating new random-sized - // objects and deallocating the old ones. - for (i=0; i < LOOPS; i++) - { - for (j=0; j < ARRSIZE; j++) - { - if (i > 0) - { - freeGroup_lock(a[j]); - DEBUG_ONLY(checkFreeListSanity()); - } - a[j] = allocGroup_lock((rand() % MAXALLOC) + 1); - // allocating zero blocks isn't allowed - DEBUG_ONLY(checkFreeListSanity()); - } - } + // repeatedly sweep though the array, allocating new random-sized + // objects and deallocating the old ones. + for (i=0; i < LOOPS; i++) + { + for (j=0; j < ARRSIZE; j++) + { + if (i > 0) + { + IF_DEBUG(block_alloc, debugBelch("A%d: freeing %p, %d blocks @ %p\n", j, a[j], a[j]->blocks, a[j]->start)); + freeGroup_lock(a[j]); + DEBUG_ONLY(checkFreeListSanity()); + } + b = (rand() % MAXALLOC) + 1; + a[j] = allocGroup_lock(b); + IF_DEBUG(block_alloc, debugBelch("A%d: allocated %p, %d blocks @ %p\n", j, a[j], b, a[j]->start)); + // allocating zero blocks isn't allowed + DEBUG_ONLY(checkFreeListSanity()); + } + } - for (j=0; j < ARRSIZE; j++) - { - freeGroup_lock(a[j]); - } + for (j=0; j < ARRSIZE; j++) + { + freeGroup_lock(a[j]); + } // this time, sweep forwards allocating new blocks, and then // backwards deallocating them. @@ -52,11 +54,14 @@ int main (int argc, char *argv[]) { for (j=0; j < ARRSIZE; j++) { - a[j] = allocGroup_lock((rand() % MAXALLOC) + 1); + b = (rand() % MAXALLOC) + 1; + a[j] = allocGroup_lock(b); + IF_DEBUG(block_alloc, debugBelch("B%d,%d: allocated %p, %d blocks @ %p\n", i, j, a[j], b, a[j]->start)); DEBUG_ONLY(checkFreeListSanity()); } for (j=ARRSIZE-1; j >= 0; j--) { + IF_DEBUG(block_alloc, debugBelch("B%d,%d: freeing %p, %d blocks @ %p\n", i, j, a[j], a[j]->blocks, a[j]->start)); freeGroup_lock(a[j]); DEBUG_ONLY(checkFreeListSanity()); } _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
