void traceCapEvent_ (Capability *cap,
EventTypeNum tag)
{
#ifdef DEBUG
if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
ACQUIRE_LOCK(&trace_utx);
tracePreface();
switch (tag) {
case EVENT_CAP_CREATE: // (cap)
debugBelch("cap %d: initialised\n", cap->no);
break;
case EVENT_CAP_DELETE: // (cap)
debugBelch("cap %d: shutting down\n", cap->no);
break;
case EVENT_CAP_ENABLE: // (cap)
debugBelch("cap %d: enabling capability\n", cap->no);
break;
case EVENT_CAP_DISABLE: // (cap)
debugBelch("cap %d: disabling capability\n", cap->no);
break;
}
RELEASE_LOCK(&trace_utx);
} else
#endif
{
if (eventlog_enabled) {
postCapEvent(tag, (EventCapNo)cap->no);
}
}
}
void
stat_startGC (gc_thread *gct)
{
nat bell = RtsFlags.GcFlags.ringBell;
if (bell) {
if (bell > 1) {
debugBelch(" GC ");
rub_bell = 1;
} else {
debugBelch("\007");
}
}
#if USE_PAPI
if(papi_is_reporting) {
/* Switch to counting GC events */
papi_stop_mutator_count();
papi_start_gc_count();
}
#endif
getProcessTimes(&gct->gc_start_cpu, &gct->gc_start_elapsed);
gct->gc_start_thread_cpu = getThreadCPUTime();
if (RtsFlags.GcFlags.giveStats != NO_GC_STATS)
{
gct->gc_start_faults = getPageFaults();
}
}
void traceCapsetEvent_ (EventTypeNum tag,
CapsetID capset,
StgWord info)
{
#ifdef DEBUG
if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
ACQUIRE_LOCK(&trace_utx);
tracePreface();
switch (tag) {
case EVENT_CAPSET_CREATE: // (capset, capset_type)
debugBelch("created capset %lu of type %d\n", (lnat)capset, (int)info);
break;
case EVENT_CAPSET_DELETE: // (capset)
debugBelch("deleted capset %lu\n", (lnat)capset);
break;
case EVENT_CAPSET_ASSIGN_CAP: // (capset, capno)
debugBelch("assigned cap %lu to capset %lu\n",
(lnat)info, (lnat)capset);
break;
case EVENT_CAPSET_REMOVE_CAP: // (capset, capno)
debugBelch("removed cap %lu from capset %lu\n",
(lnat)info, (lnat)capset);
break;
}
RELEASE_LOCK(&trace_utx);
} else
#endif
{
if (eventlog_enabled) {
postCapsetEvent(tag, capset, info);
}
}
}
int main (int argc, char *argv[])
{
int i, j, b;
bdescr *a[ARRSIZE];
srand(SEED);
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)
{
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]);
}
// this time, sweep forwards allocating new blocks, and then
// backwards deallocating them.
for (i=0; i < LOOPS; i++)
{
for (j=0; j < ARRSIZE; j++)
{
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());
}
}
DEBUG_ONLY(checkFreeListSanity());
hs_exit(); // will do a memory leak test
exit(0);
}
static void
initProfilingLogFile(void)
{
char *prog;
prog = arenaAlloc(prof_arena, strlen(prog_name) + 1);
strcpy(prog, prog_name);
#ifdef mingw32_HOST_OS
// on Windows, drop the .exe suffix if there is one
{
char *suff;
suff = strrchr(prog,'.');
if (suff != NULL && !strcmp(suff,".exe")) {
*suff = '\0';
}
}
#endif
if (RtsFlags.CcFlags.doCostCentres == 0 &&
RtsFlags.ProfFlags.doHeapProfile != HEAP_BY_RETAINER &&
RtsFlags.ProfFlags.retainerSelector == NULL)
{
/* No need for the <prog>.prof file */
prof_filename = NULL;
prof_file = NULL;
}
else
{
/* Initialise the log file name */
prof_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
sprintf(prof_filename, "%s.prof", prog);
/* open the log file */
if ((prof_file = fopen(prof_filename, "w")) == NULL) {
debugBelch("Can't open profiling report file %s\n", prof_filename);
RtsFlags.CcFlags.doCostCentres = 0;
// The following line was added by Sung; retainer/LDV profiling may need
// two output files, i.e., <program>.prof/hp.
if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
RtsFlags.ProfFlags.doHeapProfile = 0;
return;
}
}
if (RtsFlags.ProfFlags.doHeapProfile) {
/* Initialise the log file name */
hp_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
sprintf(hp_filename, "%s.hp", prog);
/* open the log file */
if ((hp_file = fopen(hp_filename, "w")) == NULL) {
debugBelch("Can't open profiling report file %s\n",
hp_filename);
RtsFlags.ProfFlags.doHeapProfile = 0;
return;
}
}
}
STATIC_INLINE void
printStdObjHdr( const StgClosure *obj, char* tag )
{
debugBelch("%s(",tag);
printPtr((StgPtr)obj->header.info);
#ifdef PROFILING
debugBelch(", %s", obj->header.prof.ccs->cc->label);
#endif
}
static void tracePreface (void)
{
#ifdef THREADED_RTS
debugBelch("%12lx: ", (unsigned long)osThreadId());
#endif
if (RtsFlags.TraceFlags.timestamp) {
debugBelch("%9" FMT_Word64 ": ", stat_getElapsedTime());
}
}
static void
initProfilingLogFile(void)
{
char *prog;
prog = arenaAlloc(prof_arena, strlen(prog_name) + 1);
strcpy(prog, prog_name);
#ifdef mingw32_HOST_OS
// on Windows, drop the .exe suffix if there is one
{
char *suff;
suff = strrchr(prog,'.');
if (suff != NULL && !strcmp(suff,".exe")) {
*suff = '\0';
}
}
#endif
if (RtsFlags.CcFlags.doCostCentres == 0 && !doingRetainerProfiling())
{
/* No need for the <prog>.prof file */
prof_filename = NULL;
prof_file = NULL;
}
else
{
/* Initialise the log file name */
prof_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
sprintf(prof_filename, "%s.prof", prog);
/* open the log file */
if ((prof_file = fopen(prof_filename, "w")) == NULL) {
debugBelch("Can't open profiling report file %s\n", prof_filename);
RtsFlags.CcFlags.doCostCentres = 0;
// Retainer profiling (`-hr` or `-hr<cc> -h<x>`) writes to
// both <program>.hp as <program>.prof.
if (doingRetainerProfiling()) {
RtsFlags.ProfFlags.doHeapProfile = 0;
}
}
}
if (RtsFlags.ProfFlags.doHeapProfile) {
/* Initialise the log file name */
hp_filename = arenaAlloc(prof_arena, strlen(prog) + 6);
sprintf(hp_filename, "%s.hp", prog);
/* open the log file */
if ((hp_file = fopen(hp_filename, "w")) == NULL) {
debugBelch("Can't open profiling report file %s\n",
hp_filename);
RtsFlags.ProfFlags.doHeapProfile = 0;
}
}
}
static void vtraceCap_stderr(Capability *cap, char *msg, va_list ap)
{
ACQUIRE_LOCK(&trace_utx);
tracePreface();
debugBelch("cap %d: ", cap->no);
vdebugBelch(msg,ap);
debugBelch("\n");
RELEASE_LOCK(&trace_utx);
}
void printPtr( StgPtr p )
{
const char *raw;
raw = lookupGHCName(p);
if (raw != NULL) {
debugBelch("<%s>", raw);
debugBelch("[%p]", p);
} else {
debugBelch("%p", p);
}
}
StgPtr
printStackObj( StgPtr sp )
{
/*debugBelch("Stack[%d] = ", &stgStack[STACK_SIZE] - sp); */
StgClosure* c = (StgClosure*)(*sp);
printPtr((StgPtr)*sp);
if (c == (StgClosure*)&stg_ctoi_R1p_info) {
debugBelch("\t\t\tstg_ctoi_ret_R1p_info\n" );
} else
if (c == (StgClosure*)&stg_ctoi_R1n_info) {
debugBelch("\t\t\tstg_ctoi_ret_R1n_info\n" );
} else
if (c == (StgClosure*)&stg_ctoi_F1_info) {
debugBelch("\t\t\tstg_ctoi_ret_F1_info\n" );
} else
if (c == (StgClosure*)&stg_ctoi_D1_info) {
debugBelch("\t\t\tstg_ctoi_ret_D1_info\n" );
} else
if (c == (StgClosure*)&stg_ctoi_V_info) {
debugBelch("\t\t\tstg_ctoi_ret_V_info\n" );
} else
if (get_itbl(c)->type == BCO) {
debugBelch("\t\t\t");
debugBelch("BCO(...)\n");
}
else {
debugBelch("\t\t\t");
printClosure ( (StgClosure*)(*sp));
}
sp += 1;
return sp;
}
static void printZcoded( const char *raw )
{
nat j = 0;
while ( raw[j] != '\0' ) {
if (raw[j] == 'Z') {
debugBelch("%c", unZcode(raw[j+1]));
j = j + 2;
} else {
debugBelch("%c", unZcode(raw[j+1]));
j = j + 1;
}
}
}
void
printMutableList(bdescr *bd)
{
StgPtr p;
debugBelch("mutable list %p: ", bd);
for (; bd != NULL; bd = bd->link) {
for (p = bd->start; p < bd->free; p++) {
debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
}
}
debugBelch("\n");
}
static void
printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
{
nat i;
for(i = 0; i < size; i++, bitmap >>= 1 ) {
debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i);
if ((bitmap & 1) == 0) {
printPtr((P_)payload[i]);
debugBelch("\n");
} else {
debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
}
}
}
void
findPtr(P_ p, int follow)
{
uint32_t g, n;
bdescr *bd;
const int arr_size = 1024;
StgPtr arr[arr_size];
int i = 0;
searched = 0;
for (n = 0; n < n_capabilities; n++) {
bd = nurseries[i].blocks;
i = findPtrBlocks(p,bd,arr,arr_size,i);
if (i >= arr_size) return;
}
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
bd = generations[g].blocks;
i = findPtrBlocks(p,bd,arr,arr_size,i);
bd = generations[g].large_objects;
i = findPtrBlocks(p,bd,arr,arr_size,i);
if (i >= arr_size) return;
}
if (follow && i == 1) {
debugBelch("-->\n");
findPtr(arr[0], 1);
}
}
void returnMemoryToOS(nat n /* megablocks */)
{
static bdescr *bd;
StgWord size;
bd = free_mblock_list;
while ((n > 0) && (bd != NULL)) {
size = BLOCKS_TO_MBLOCKS(bd->blocks);
if (size > n) {
StgWord newSize = size - n;
char *freeAddr = MBLOCK_ROUND_DOWN(bd->start);
freeAddr += newSize * MBLOCK_SIZE;
bd->blocks = MBLOCK_GROUP_BLOCKS(newSize);
freeMBlocks(freeAddr, n);
n = 0;
}
else {
char *freeAddr = MBLOCK_ROUND_DOWN(bd->start);
n -= size;
bd = bd->link;
freeMBlocks(freeAddr, size);
}
}
free_mblock_list = bd;
osReleaseFreeMemory();
IF_DEBUG(gc,
if (n != 0) {
debugBelch("Wanted to free %d more MBlocks than are freeable\n",
n);
}
);
static void
printThunkPayload( StgThunk *obj )
{
StgWord i, j;
const StgInfoTable* info;
info = get_itbl((StgClosure *)obj);
for (i = 0; i < info->layout.payload.ptrs; ++i) {
debugBelch(", ");
printPtr((StgPtr)obj->payload[i]);
}
for (j = 0; j < info->layout.payload.nptrs; ++j) {
debugBelch(", %pd#",obj->payload[i+j]);
}
debugBelch(")\n");
}
/* MP_sync synchronises all nodes in a parallel computation:
* sets:
* thisPE - GlobalTaskId: node's own task Id
* (logical node address for messages)
* Returns: Bool: success (1) or failure (0)
*
* MPI Version:
* the number of nodes is checked by counting nodes in WORLD
* (could also be done by sync message)
* Own ID is known before, but returned only here.
*/
rtsBool MP_sync(void) {
// initialise counters/constants and allocate/attach the buffer
// buffer size default is 20, use RTS option -qq<N> to change it
maxMsgs = RtsFlags.ParFlags.sendBufferSize;
// and resulting buffer space
// checks inside RtsFlags.c:
// DATASPACEWORDS * sizeof(StgWord) < INT_MAX / 2
// maxMsgs <= max(20,nPEs)
// Howver, they might be just too much in combination.
if (INT_MAX / sizeof(StgWord) < DATASPACEWORDS * maxMsgs) {
IF_PAR_DEBUG(mpcomm,
debugBelch("requested buffer sizes too large, adjusting...\n"));
do {
maxMsgs--;
} while (maxMsgs > 0 &&
INT_MAX / sizeof(StgWord) < DATASPACEWORDS * maxMsgs);
if (maxMsgs == 0) {
// should not be possible with checks inside RtsFlags.c, see above
barf("pack buffer too large to allocate, aborting program.");
} else {
IF_PAR_DEBUG(mpcomm,
debugBelch("send buffer size reduced to %d messages.\n",
maxMsgs));
}
}
bufsize = maxMsgs * DATASPACEWORDS * sizeof(StgWord);
mpiMsgBuffer = (void*) stgMallocBytes(bufsize, "mpiMsgBuffer");
requests = (MPI_Request*)
stgMallocBytes(maxMsgs * sizeof(MPI_Request),"requests");
msgCount = 0; // when maxMsgs reached
thisPE = mpiMyRank + 1;
IF_PAR_DEBUG(mpcomm,
debugBelch("Node %d synchronising.\n", thisPE));
MPI_Barrier(MPI_COMM_WORLD); // unnecessary...
// but currently used to synchronize system times
return rtsTrue;
}
static void traceSchedEvent_stderr (Capability *cap, EventTypeNum tag,
StgTSO *tso,
StgWord info1 STG_UNUSED,
StgWord info2 STG_UNUSED)
{
ACQUIRE_LOCK(&trace_utx);
tracePreface();
switch (tag) {
case EVENT_CREATE_THREAD: // (cap, thread)
debugBelch("cap %d: created thread %lu\n",
cap->no, (lnat)tso->id);
break;
case EVENT_RUN_THREAD: // (cap, thread)
debugBelch("cap %d: running thread %lu (%s)\n",
cap->no, (lnat)tso->id, what_next_strs[tso->what_next]);
break;
case EVENT_THREAD_RUNNABLE: // (cap, thread)
debugBelch("cap %d: thread %lu appended to run queue\n",
cap->no, (lnat)tso->id);
break;
case EVENT_MIGRATE_THREAD: // (cap, thread, new_cap)
debugBelch("cap %d: thread %lu migrating to cap %d\n",
cap->no, (lnat)tso->id, (int)info1);
break;
case EVENT_THREAD_WAKEUP: // (cap, thread, info1_cap)
debugBelch("cap %d: waking up thread %lu on cap %d\n",
cap->no, (lnat)tso->id, (int)info1);
break;
case EVENT_STOP_THREAD: // (cap, thread, status)
if (info1 == 6 + BlockedOnBlackHole) {
debugBelch("cap %d: thread %lu stopped (blocked on black hole owned by thread %lu)\n",
cap->no, (lnat)tso->id, (long)info2);
} else {
debugBelch("cap %d: thread %lu stopped (%s)\n",
cap->no, (lnat)tso->id, thread_stop_reasons[info1]);
}
break;
case EVENT_SHUTDOWN: // (cap)
debugBelch("cap %d: shutting down\n", cap->no);
break;
default:
debugBelch("cap %d: thread %lu: event %d\n\n",
cap->no, (lnat)tso->id, tag);
break;
}
RELEASE_LOCK(&trace_utx);
}
static void traceGcEvent_stderr (Capability *cap, EventTypeNum tag)
{
ACQUIRE_LOCK(&trace_utx);
tracePreface();
switch (tag) {
case EVENT_REQUEST_SEQ_GC: // (cap)
debugBelch("cap %d: requesting sequential GC\n", cap->no);
break;
case EVENT_REQUEST_PAR_GC: // (cap)
debugBelch("cap %d: requesting parallel GC\n", cap->no);
break;
case EVENT_GC_START: // (cap)
debugBelch("cap %d: starting GC\n", cap->no);
break;
case EVENT_GC_END: // (cap)
debugBelch("cap %d: finished GC\n", cap->no);
break;
case EVENT_GC_IDLE: // (cap)
debugBelch("cap %d: GC idle\n", cap->no);
break;
case EVENT_GC_WORK: // (cap)
debugBelch("cap %d: GC working\n", cap->no);
break;
case EVENT_GC_DONE: // (cap)
debugBelch("cap %d: GC done\n", cap->no);
break;
default:
barf("traceGcEvent: unknown event tag %d", tag);
break;
}
RELEASE_LOCK(&trace_utx);
}
/* MP_start starts up the node:
* - connects to the MP-System used,
* - determines wether we are main thread
* - starts up other nodes in case we are first and
* the MP-System requires to spawn nodes from here.
* Parameters:
* IN argv - char**: program arguments
* Sets:
* nPEs - int: no. of PEs to expect/start
* IAmMainThread - rtsBool: wether this node is main PE
* Returns: Bool: success or failure
*
* MPI Version:
* nodes are spawned by startup script calling mpirun
* This function only connects to MPI and determines the main PE.
*/
rtsBool MP_start(int* argc, char** argv[]) {
IF_PAR_DEBUG(mpcomm,
debugBelch("MPI_Init: starting MPI-Comm...\n"));
MPI_Init(argc, argv); // MPI sez: can modify args
MPI_Comm_rank(MPI_COMM_WORLD, &mpiMyRank);
IF_PAR_DEBUG(mpcomm,
debugBelch("I am node %d.\n", mpiMyRank));
if (!mpiMyRank) // we declare node 0 as main PE.
IAmMainThread = rtsTrue;
MPI_Comm_size(MPI_COMM_WORLD, &mpiWorldSize);
// we should have a correct argument...
ASSERT(argv && (*argv)[1]);
nPEs = atoi((*argv)[1]);
if (nPEs) { // we have been given a size, so check it:
IF_PAR_DEBUG(mpcomm,
debugBelch("Expecting to find %d processors, found %d.",
nPEs, mpiWorldSize));
if ((int)nPEs > mpiWorldSize)
IF_PAR_DEBUG(mpcomm,
debugBelch("WARNING: Too few processors started!"));
} else { // otherwise, no size was given
IF_PAR_DEBUG(mpcomm,
debugBelch("No size, given, started program on %d processors.",
mpiWorldSize));
}
nPEs = mpiWorldSize; // (re-)set size from MPI (in any case)
// System communicator sysComm is duplicated from COMM_WORLD
// but has its own context
MPI_Comm_dup(MPI_COMM_WORLD, &sysComm);
// adjust args (ignoring nPEs argument added by the start script)
(*argv)[1] = (*argv)[0]; /* ignore the nPEs argument */
(*argv)++;
(*argc)--;
return rtsTrue;
}
/* Argument 'wait' says whether to wait for I/O to become available,
* or whether to just check and return immediately. If there are
* other threads ready to run, we normally do the non-waiting variety,
* otherwise we wait (see Schedule.c).
*
* SMP note: must be called with sched_mutex locked.
*
* Windows: select only works on sockets, so this doesn't really work,
* though it makes things better than before. MsgWaitForMultipleObjects
* should really be used, though it only seems to work for read handles,
* not write handles.
*
*/
void
awaitEvent(rtsBool wait)
{
StgTSO *tso, *prev, *next;
fd_set rfd,wfd;
int numFound;
int maxfd = -1;
rtsBool seen_bad_fd = rtsFalse;
struct timeval tv, *ptv;
LowResTime now;
IF_DEBUG(scheduler,
debugBelch("scheduler: checking for threads blocked on I/O");
if (wait) {
debugBelch(" (waiting)");
}
debugBelch("\n");
);
/* -----------------------------------------------------------------------------
stat_describe_gens
Produce some detailed info on the state of the generational GC.
-------------------------------------------------------------------------- */
void
statDescribeGens(void)
{
nat g, mut, lge, i;
W_ gen_slop;
W_ tot_live, tot_slop;
W_ gen_live, gen_blocks;
bdescr *bd;
generation *gen;
debugBelch(
"----------------------------------------------------------\n"
" Gen Max Mut-list Blocks Large Live Slop\n"
" Blocks Bytes Objects \n"
"----------------------------------------------------------\n");
tot_live = 0;
tot_slop = 0;
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
gen = &generations[g];
for (bd = gen->large_objects, lge = 0; bd; bd = bd->link) {
lge++;
}
gen_live = genLiveWords(gen);
gen_blocks = genLiveBlocks(gen);
mut = 0;
for (i = 0; i < n_capabilities; i++) {
mut += countOccupied(capabilities[i]->mut_lists[g]);
// Add the pinned object block.
bd = capabilities[i]->pinned_object_block;
if (bd != NULL) {
gen_live += bd->free - bd->start;
gen_blocks += bd->blocks;
}
gen_live += gcThreadLiveWords(i,g);
gen_blocks += gcThreadLiveBlocks(i,g);
}
debugBelch("%5d %7" FMT_Word " %9d", g, (W_)gen->max_blocks, mut);
gen_slop = gen_blocks * BLOCK_SIZE_W - gen_live;
debugBelch("%8" FMT_Word " %8d %8" FMT_Word " %8" FMT_Word "\n", gen_blocks, lge,
gen_live*(W_)sizeof(W_), gen_slop*(W_)sizeof(W_));
tot_live += gen_live;
tot_slop += gen_slop;
}
debugBelch("----------------------------------------------------------\n");
debugBelch("%41s%8" FMT_SizeT " %8" FMT_SizeT "\n",
"",tot_live*sizeof(W_),tot_slop*sizeof(W_));
debugBelch("----------------------------------------------------------\n");
debugBelch("\n");
}
void printPtr( StgPtr p )
{
const char *raw;
raw = lookupGHCName(p);
if (raw != NULL) {
printZcoded(raw);
} else {
debugBelch("%p", p);
}
}
static void vtrace_stderr(char *msg, va_list ap)
{
ACQUIRE_LOCK(&trace_utx);
tracePreface();
vdebugBelch(msg,ap);
debugBelch("\n");
RELEASE_LOCK(&trace_utx);
}
extern void DEBUG_LoadSymbols( const char *name )
{
bfd* abfd;
char **matching;
bfd_init();
abfd = bfd_openr(name, "default");
if (abfd == NULL) {
barf("can't open executable %s to get symbol table", name);
}
if (!bfd_check_format_matches (abfd, bfd_object, &matching)) {
barf("mismatch");
}
{
long storage_needed;
asymbol **symbol_table;
long number_of_symbols;
long num_real_syms = 0;
long i;
storage_needed = bfd_get_symtab_upper_bound (abfd);
if (storage_needed < 0) {
barf("can't read symbol table");
}
symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table);
if (number_of_symbols < 0) {
barf("can't canonicalise symbol table");
}
if (add_to_fname_table == NULL)
add_to_fname_table = allocHashTable();
for( i = 0; i != number_of_symbols; ++i ) {
symbol_info info;
bfd_get_symbol_info(abfd,symbol_table[i],&info);
if (isReal(info.type, info.name)) {
insertHashTable(add_to_fname_table,
info.value, (void*)info.name);
num_real_syms += 1;
}
}
IF_DEBUG(interpreter,
debugBelch("Loaded %ld symbols. Of which %ld are real symbols\n",
number_of_symbols, num_real_syms)
);
stgFree(symbol_table);
}
}
void
printAllTasks(void)
{
Task *task;
for (task = all_tasks; task != NULL; task = task->all_next) {
debugBelch("task %p is %s, ", taskId(task), task->stopped ? "stopped" : "alive");
if (!task->stopped) {
if (task->cap) {
debugBelch("on capability %d, ", task->cap->no);
}
if (task->incall->tso) {
debugBelch("bound to thread %lu",
(unsigned long)task->incall->tso->id);
} else {
debugBelch("worker");
}
}
debugBelch("\n");
}
}
void findSlop(bdescr *bd)
{
W_ slop;
for (; bd != NULL; bd = bd->link) {
slop = (bd->blocks * BLOCK_SIZE_W) - (bd->free - bd->start);
if (slop > (1024/sizeof(W_))) {
debugBelch("block at %p (bdescr %p) has %" FMT_SizeT "KB slop\n",
bd->start, bd, slop / (1024/sizeof(W_)));
}
}
}
static void
printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap, nat size )
{
StgWord bmp;
nat i, j;
i = 0;
for (bmp=0; i < size; bmp++) {
StgWord bitmap = large_bitmap->bitmap[bmp];
j = 0;
for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
debugBelch(" stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i);
if ((bitmap & 1) == 0) {
printPtr((P_)payload[i]);
debugBelch("\n");
} else {
debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
}
}
}
}
void
stat_startGC (Capability *cap, gc_thread *gct)
{
nat bell = RtsFlags.GcFlags.ringBell;
if (bell) {
if (bell > 1) {
debugBelch(" GC ");
rub_bell = 1;
} else {
debugBelch("\007");
}
}
#if USE_PAPI
if(papi_is_reporting) {
/* Switch to counting GC events */
papi_stop_mutator_count();
papi_start_gc_count();
}
#endif
getProcessTimes(&gct->gc_start_cpu, &gct->gc_start_elapsed);
// Post EVENT_GC_START with the same timestamp as used for stats
// (though converted from Time=StgInt64 to EventTimestamp=StgWord64).
// Here, as opposed to other places, the event is emitted on the cap
// that initiates the GC and external tools expect it to have the same
// timestamp as used in +RTS -s calculcations.
traceEventGcStartAtT(cap,
TimeToNS(gct->gc_start_elapsed - start_init_elapsed));
gct->gc_start_thread_cpu = getThreadCPUTime();
if (RtsFlags.GcFlags.giveStats != NO_GC_STATS)
{
gct->gc_start_faults = getPageFaults();
}
}
