diff options
Diffstat (limited to 'rts/RetainerSet.c')
-rw-r--r-- | rts/RetainerSet.c | 498 |
1 files changed, 498 insertions, 0 deletions
diff --git a/rts/RetainerSet.c b/rts/RetainerSet.c new file mode 100644 index 0000000000..bfa0bc8acf --- /dev/null +++ b/rts/RetainerSet.c @@ -0,0 +1,498 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2001 + * Author: Sungwoo Park + * + * Retainer set implementation for retainer profiling (see RetainerProfile.c) + * + * ---------------------------------------------------------------------------*/ + +#ifdef PROFILING + +#include "Rts.h" +#include "RtsFlags.h" +#include "Stats.h" +#include "RtsUtils.h" +#include "RetainerSet.h" +#include "Arena.h" +#include "Profiling.h" + +#include <stdlib.h> +#include <string.h> + +#define HASH_TABLE_SIZE 255 +#define hash(hk) (hk % HASH_TABLE_SIZE) +static RetainerSet *hashTable[HASH_TABLE_SIZE]; + +static Arena *arena; // arena in which we store retainer sets + +static int nextId; // id of next retainer set + +/* ----------------------------------------------------------------------------- + * rs_MANY is a distinguished retainer set, such that + * + * isMember(e, rs_MANY) = True + * + * addElement(e, rs) = rs_MANY, if rs->num >= maxRetainerSetSize + * addElement(e, rs_MANY) = rs_MANY + * + * The point of rs_MANY is to keep the total number of retainer sets + * from growing too large. + * -------------------------------------------------------------------------- */ +RetainerSet rs_MANY = { + num : 0, + hashKey : 0, + link : NULL, + id : 1, + element : {} +}; + +/* ----------------------------------------------------------------------------- + * calculate the size of a RetainerSet structure + * -------------------------------------------------------------------------- */ +STATIC_INLINE size_t +sizeofRetainerSet( int elems ) +{ + return (sizeof(RetainerSet) + elems * sizeof(retainer)); +} + +/* ----------------------------------------------------------------------------- + * Creates the first pool and initializes hashTable[]. + * Frees all pools if any. + * -------------------------------------------------------------------------- */ +void +initializeAllRetainerSet(void) +{ + int i; + + arena = newArena(); + + for (i = 0; i < HASH_TABLE_SIZE; i++) + hashTable[i] = NULL; + nextId = 2; // Initial value must be positive, 2 is MANY. +} + +/* ----------------------------------------------------------------------------- + * Refreshes all pools for reuse and initializes hashTable[]. + * -------------------------------------------------------------------------- */ +void +refreshAllRetainerSet(void) +{ +#ifdef FIRST_APPROACH + int i; + + // first approach: completely refresh + arenaFree(arena); + arena = newArena(); + + for (i = 0; i < HASH_TABLE_SIZE; i++) + hashTable[i] = NULL; + nextId = 2; +#endif /* FIRST_APPROACH */ +} + +/* ----------------------------------------------------------------------------- + * Frees all pools. + * -------------------------------------------------------------------------- */ +void +closeAllRetainerSet(void) +{ + arenaFree(arena); +} + +/* ----------------------------------------------------------------------------- + * Finds or creates if needed a singleton retainer set. + * -------------------------------------------------------------------------- */ +RetainerSet * +singleton(retainer r) +{ + RetainerSet *rs; + StgWord hk; + + hk = hashKeySingleton(r); + for (rs = hashTable[hash(hk)]; rs != NULL; rs = rs->link) + if (rs->num == 1 && rs->element[0] == r) return rs; // found it + + // create it + rs = arenaAlloc( arena, sizeofRetainerSet(1) ); + rs->num = 1; + rs->hashKey = hk; + rs->link = hashTable[hash(hk)]; + rs->id = nextId++; + rs->element[0] = r; + + // The new retainer set is placed at the head of the linked list. + hashTable[hash(hk)] = rs; + + return rs; +} + +/* ----------------------------------------------------------------------------- + * Finds or creates a retainer set *rs augmented with r. + * Invariants: + * r is not a member of rs, i.e., isMember(r, rs) returns rtsFalse. + * rs is not NULL. + * Note: + * We could check if rs is NULL, in which case this function call + * reverts to singleton(). We do not choose this strategy because + * in most cases addElement() is invoked with non-NULL rs. + * -------------------------------------------------------------------------- */ +RetainerSet * +addElement(retainer r, RetainerSet *rs) +{ + nat i; + nat nl; // Number of retainers in *rs Less than r + RetainerSet *nrs; // New Retainer Set + StgWord hk; // Hash Key + +#ifdef DEBUG_RETAINER + // debugBelch("addElement(%p, %p) = ", r, rs); +#endif + + ASSERT(rs != NULL); + ASSERT(rs->num <= RtsFlags.ProfFlags.maxRetainerSetSize); + + if (rs == &rs_MANY || rs->num == RtsFlags.ProfFlags.maxRetainerSetSize) { + return &rs_MANY; + } + + ASSERT(!isMember(r, rs)); + + for (nl = 0; nl < rs->num; nl++) + if (r < rs->element[nl]) break; + // Now nl is the index for r into the new set. + // Also it denotes the number of retainers less than r in *rs. + // Thus, compare the first nl retainers, then r itself, and finally the + // remaining (rs->num - nl) retainers. + + hk = hashKeyAddElement(r, rs); + for (nrs = hashTable[hash(hk)]; nrs != NULL; nrs = nrs->link) { + // test *rs and *nrs for equality + + // check their size + if (rs->num + 1 != nrs->num) continue; + + // compare the first nl retainers and find the first non-matching one. + for (i = 0; i < nl; i++) + if (rs->element[i] != nrs->element[i]) break; + if (i < nl) continue; + + // compare r itself + if (r != nrs->element[i]) continue; // i == nl + + // compare the remaining retainers + for (; i < rs->num; i++) + if (rs->element[i] != nrs->element[i + 1]) break; + if (i < rs->num) continue; + +#ifdef DEBUG_RETAINER + // debugBelch("%p\n", nrs); +#endif + // The set we are seeking already exists! + return nrs; + } + + // create a new retainer set + nrs = arenaAlloc( arena, sizeofRetainerSet(rs->num + 1) ); + nrs->num = rs->num + 1; + nrs->hashKey = hk; + nrs->link = hashTable[hash(hk)]; + nrs->id = nextId++; + for (i = 0; i < nl; i++) { // copy the first nl retainers + nrs->element[i] = rs->element[i]; + } + nrs->element[i] = r; // copy r + for (; i < rs->num; i++) { // copy the remaining retainers + nrs->element[i + 1] = rs->element[i]; + } + + hashTable[hash(hk)] = nrs; + +#ifdef DEBUG_RETAINER + // debugBelch("%p\n", nrs); +#endif + return nrs; +} + +/* ----------------------------------------------------------------------------- + * Call f() for each retainer set. + * -------------------------------------------------------------------------- */ +void +traverseAllRetainerSet(void (*f)(RetainerSet *)) +{ + int i; + RetainerSet *rs; + + (*f)(&rs_MANY); + for (i = 0; i < HASH_TABLE_SIZE; i++) + for (rs = hashTable[i]; rs != NULL; rs = rs->link) + (*f)(rs); +} + + +/* ----------------------------------------------------------------------------- + * printRetainer() prints the full information on a given retainer, + * not a retainer set. + * -------------------------------------------------------------------------- */ +#if defined(RETAINER_SCHEME_INFO) +// Retainer scheme 1: retainer = info table +void +printRetainer(FILE *f, retainer itbl) +{ + fprintf(f, "%s[%s]", itbl->prof.closure_desc, itbl->prof.closure_type); +} +#elif defined(RETAINER_SCHEME_CCS) +// Retainer scheme 2: retainer = cost centre stack +void +printRetainer(FILE *f, retainer ccs) +{ + fprintCCS(f, ccs); +} +#elif defined(RETAINER_SCHEME_CC) +// Retainer scheme 3: retainer = cost centre +void +printRetainer(FILE *f, retainer cc) +{ + fprintf(f,"%s.%s", cc->module, cc->label); +} +#endif + +/* ----------------------------------------------------------------------------- + * printRetainerSetShort() should always display the same output for + * a given retainer set regardless of the time of invocation. + * -------------------------------------------------------------------------- */ +#ifdef SECOND_APPROACH +#if defined(RETAINER_SCHEME_INFO) +// Retainer scheme 1: retainer = info table +void +printRetainerSetShort(FILE *f, RetainerSet *rs) +{ +#define MAX_RETAINER_SET_SPACE 24 + char tmp[MAX_RETAINER_SET_SPACE + 1]; + int size; + nat j; + + ASSERT(rs->id < 0); + + tmp[MAX_RETAINER_SET_SPACE] = '\0'; + + // No blank characters are allowed. + sprintf(tmp + 0, "(%d)", -(rs->id)); + size = strlen(tmp); + ASSERT(size < MAX_RETAINER_SET_SPACE); + + for (j = 0; j < rs->num; j++) { + if (j < rs->num - 1) { + strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size); + size = strlen(tmp); + if (size == MAX_RETAINER_SET_SPACE) + break; + strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size); + size = strlen(tmp); + if (size == MAX_RETAINER_SET_SPACE) + break; + } + else { + strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size); + // size = strlen(tmp); + } + } + fprintf(f, tmp); +} +#elif defined(RETAINER_SCHEME_CC) +// Retainer scheme 3: retainer = cost centre +void +printRetainerSetShort(FILE *f, RetainerSet *rs) +{ +#define MAX_RETAINER_SET_SPACE 24 + char tmp[MAX_RETAINER_SET_SPACE + 1]; + int size; + nat j; + +} +#elif defined(RETAINER_SCHEME_CCS) +// Retainer scheme 2: retainer = cost centre stack +void +printRetainerSetShort(FILE *f, RetainerSet *rs) +{ +#define MAX_RETAINER_SET_SPACE 24 + char tmp[MAX_RETAINER_SET_SPACE + 1]; + int size; + nat j; + + ASSERT(rs->id < 0); + + tmp[MAX_RETAINER_SET_SPACE] = '\0'; + + // No blank characters are allowed. + sprintf(tmp + 0, "(%d)", -(rs->id)); + size = strlen(tmp); + ASSERT(size < MAX_RETAINER_SET_SPACE); + + for (j = 0; j < rs->num; j++) { + if (j < rs->num - 1) { + strncpy(tmp + size, rs->element[j]->cc->label, MAX_RETAINER_SET_SPACE - size); + size = strlen(tmp); + if (size == MAX_RETAINER_SET_SPACE) + break; + strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size); + size = strlen(tmp); + if (size == MAX_RETAINER_SET_SPACE) + break; + } + else { + strncpy(tmp + size, rs->element[j]->cc->label, MAX_RETAINER_SET_SPACE - size); + // size = strlen(tmp); + } + } + fprintf(f, tmp); +} +#elif defined(RETAINER_SCHEME_CC) +// Retainer scheme 3: retainer = cost centre +static void +printRetainerSetShort(FILE *f, retainerSet *rs) +{ +#define MAX_RETAINER_SET_SPACE 24 + char tmp[MAX_RETAINER_SET_SPACE + 1]; + int size; + nat j; + + ASSERT(rs->id < 0); + + tmp[MAX_RETAINER_SET_SPACE] = '\0'; + + // No blank characters are allowed. + sprintf(tmp + 0, "(%d)", -(rs->id)); + size = strlen(tmp); + ASSERT(size < MAX_RETAINER_SET_SPACE); + + for (j = 0; j < rs->num; j++) { + if (j < rs->num - 1) { + strncpy(tmp + size, rs->element[j]->label, + MAX_RETAINER_SET_SPACE - size); + size = strlen(tmp); + if (size == MAX_RETAINER_SET_SPACE) + break; + strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size); + size = strlen(tmp); + if (size == MAX_RETAINER_SET_SPACE) + break; + } + else { + strncpy(tmp + size, rs->element[j]->label, + MAX_RETAINER_SET_SPACE - size); + // size = strlen(tmp); + } + } + fprintf(f, tmp); +/* + #define MAX_RETAINER_SET_SPACE 24 + #define DOT_NUMBER 3 + // 1. 32 > MAX_RETAINER_SET_SPACE + 1 (1 for '\0') + // 2. (MAX_RETAINER_SET_SPACE - DOT_NUMBER ) characters should be enough for + // printing one natural number (plus '(' and ')'). + char tmp[32]; + int size, ts; + nat j; + + ASSERT(rs->id < 0); + + // No blank characters are allowed. + sprintf(tmp + 0, "(%d)", -(rs->id)); + size = strlen(tmp); + ASSERT(size < MAX_RETAINER_SET_SPACE - DOT_NUMBER); + + for (j = 0; j < rs->num; j++) { + ts = strlen(rs->element[j]->label); + if (j < rs->num - 1) { + if (size + ts + 1 > MAX_RETAINER_SET_SPACE - DOT_NUMBER) { + sprintf(tmp + size, "..."); + break; + } + sprintf(tmp + size, "%s,", rs->element[j]->label); + size += ts + 1; + } + else { + if (size + ts > MAX_RETAINER_SET_SPACE - DOT_NUMBER) { + sprintf(tmp + size, "..."); + break; + } + sprintf(tmp + size, "%s", rs->element[j]->label); + size += ts; + } + } + fprintf(f, tmp); +*/ +} +#endif /* RETAINER_SCHEME_CC */ +#endif /* SECOND_APPROACH */ + +/* ----------------------------------------------------------------------------- + * Dump the contents of each retainer set into the log file at the end + * of the run, so the user can find out for a given retainer set ID + * the full contents of that set. + * --------------------------------------------------------------------------- */ +#ifdef SECOND_APPROACH +void +outputAllRetainerSet(FILE *prof_file) +{ + nat i, j; + nat numSet; + RetainerSet *rs, **rsArray, *tmp; + + // find out the number of retainer sets which have had a non-zero cost at + // least once during retainer profiling + numSet = 0; + for (i = 0; i < HASH_TABLE_SIZE; i++) + for (rs = hashTable[i]; rs != NULL; rs = rs->link) { + if (rs->id < 0) + numSet++; + } + + if (numSet == 0) // retainer profiling was not done at all. + return; + + // allocate memory + rsArray = stgMallocBytes(numSet * sizeof(RetainerSet *), + "outputAllRetainerSet()"); + + // prepare for sorting + j = 0; + for (i = 0; i < HASH_TABLE_SIZE; i++) + for (rs = hashTable[i]; rs != NULL; rs = rs->link) { + if (rs->id < 0) { + rsArray[j] = rs; + j++; + } + } + + ASSERT(j == numSet); + + // sort rsArray[] according to the id of each retainer set + for (i = numSet - 1; i > 0; i--) { + for (j = 0; j <= i - 1; j++) { + // if (-(rsArray[j]->id) < -(rsArray[j + 1]->id)) + if (rsArray[j]->id < rsArray[j + 1]->id) { + tmp = rsArray[j]; + rsArray[j] = rsArray[j + 1]; + rsArray[j + 1] = tmp; + } + } + } + + fprintf(prof_file, "\nRetainer sets created during profiling:\n"); + for (i = 0;i < numSet; i++) { + fprintf(prof_file, "SET %u = {", -(rsArray[i]->id)); + for (j = 0; j < rsArray[i]->num - 1; j++) { + printRetainer(prof_file, rsArray[i]->element[j]); + fprintf(prof_file, ", "); + } + printRetainer(prof_file, rsArray[i]->element[j]); + fprintf(prof_file, "}\n"); + } + + stgFree(rsArray); +} +#endif /* SECOND_APPROACH */ + +#endif /* PROFILING */ |