static
void*
findFreeBlocks(nat n) {
void* ret=0;
block_rec* it;
block_rec temp;
block_rec* prev;
W_ required_size;
it=free_blocks;
required_size = n*MBLOCK_SIZE;
temp.next=free_blocks; temp.base=0; temp.size=0;
prev=&temp;
/* TODO: Don't just take first block, find smallest sufficient block */
for( ; it!=0 && it->size<required_size; prev=it, it=it->next ) {}
if(it!=0) {
if( (((W_)it->base) & MBLOCK_MASK) == 0) { /* MBlock aligned */
ret = (void*)it->base;
if(it->size==required_size) {
prev->next=it->next;
stgFree(it);
} else {
it->base += required_size;
it->size -=required_size;
}
} else {
char* need_base;
block_rec* next;
int new_size;
need_base =
(char*)(((W_)it->base) & ((W_)~MBLOCK_MASK)) + MBLOCK_SIZE;
next = (block_rec*)stgMallocBytes(
sizeof(block_rec)
, "getMBlocks: findFreeBlocks: splitting");
new_size = need_base - it->base;
next->base = need_base +required_size;
next->size = it->size - (new_size+required_size);
it->size = new_size;
next->next = it->next;
it->next = next;
ret=(void*)need_base;
}
}
free_blocks=temp.next;
return ret;
}
static void
endInCall (Task *task)
{
InCall *incall;
incall = task->incall;
incall->tso = NULL;
task->incall = task->incall->prev_stack;
if (task->n_spare_incalls >= MAX_SPARE_INCALLS) {
stgFree(incall);
} else {
incall->next = task->spare_incalls;
task->spare_incalls = incall;
task->n_spare_incalls++;
}
}
/* Called at the end of execution, to write out the Hpc *.tix file
* for this exection. Safe to call, even if coverage is not used.
*/
void
exitHpc(void) {
debugTrace(DEBUG_hpc,"exitHpc");
if (hpc_inited == 0) {
return;
}
// Only write the tix file if you are the original process.
// Any sub-process from use of fork from inside Haskell will
// not clober the .tix file.
if (hpc_pid == getpid()) {
FILE *f = fopen(tixFilename,"w");
writeTix(f);
}
freeHashTable(moduleHash, (void (*)(void *))freeHpcModuleInfo);
moduleHash = NULL;
stgFree(tixFilename);
tixFilename = NULL;
}
void
moreCapabilities (nat from USED_IF_THREADS, nat to USED_IF_THREADS)
{
#if defined(THREADED_RTS)
nat i;
Capability **old_capabilities = capabilities;
capabilities = stgMallocBytes(to * sizeof(Capability*), "moreCapabilities");
if (to == 1) {
// THREADED_RTS must work on builds that don't have a mutable
// BaseReg (eg. unregisterised), so in this case
// capabilities[0] must coincide with &MainCapability.
capabilities[0] = &MainCapability;
initCapability(&MainCapability, 0);
}
else
{
for (i = 0; i < to; i++) {
if (i < from) {
capabilities[i] = old_capabilities[i];
} else {
capabilities[i] = stgMallocBytes(sizeof(Capability),
"moreCapabilities");
initCapability(capabilities[i], i);
}
}
}
debugTrace(DEBUG_sched, "allocated %d more capabilities", to - from);
if (old_capabilities != NULL) {
stgFree(old_capabilities);
}
#endif
}
static void freeSptEntry(void* entry) {
freeStablePtr(*(StgStablePtr*)entry);
stgFree(entry);
}
void freeProgEnvv(int envc, char *envv[]) {
/* we stashed the win32 env block in the last+1 entry */
FreeEnvironmentStringsA(envv[envc]);
stgFree(envv);
}
/* MP_quit disconnects current node from MP-System:
* Parameters:
* IN isError - error number, 0 if normal exit
* Returns: Bool: success (1) or failure (0)
*
* MPI Version: MPI requires that all sent messages must be received
* before quitting. Receive or cancel all pending messages (using msg.
* count), then quit from MPI.
*/
rtsBool MP_quit(int isError) {
StgWord data[2];
MPI_Request sysRequest2;
data[0] = PP_FINISH;
data[1] = isError;
if (IAmMainThread) {
int i;
IF_PAR_DEBUG(mpcomm,
debugBelch("Main PE stopping MPI system (exit code: %d)\n",
isError));
// bcast FINISH to other PEs
for (i=2; i<=(int)nPEs; i++) {
// synchronous send operation in order 2..nPEs ... might slow down.
MPI_Isend(&pingMessage, 1, MPI_INT, i-1, PP_FINISH,
sysComm, &sysRequest2);
MPI_Send(data,2*sizeof(StgWord),MPI_BYTE,i-1, PP_FINISH, MPI_COMM_WORLD);
MPI_Wait(&sysRequest2, MPI_STATUS_IGNORE);
}
// receive answers from all children (just counting)
while (finishRecvd < mpiWorldSize-1) {
MPI_Recv(data, 2*sizeof(StgWord), MPI_BYTE, MPI_ANY_SOURCE, PP_FINISH,
MPI_COMM_WORLD, &status);
ASSERT(status.MPI_TAG == PP_FINISH);
// and receive corresponding sysComm ping:
MPI_Recv(&pingMessage, 1, MPI_INT, status.MPI_SOURCE, PP_FINISH,
sysComm, MPI_STATUS_IGNORE);
IF_PAR_DEBUG(mpcomm,
debugBelch("Received FINISH reply from %d\n",
status.MPI_SOURCE));
finishRecvd++;
}
} else {
IF_PAR_DEBUG(mpcomm,
debugBelch("Non-main PE stopping MPI system (exit code: %d)\n",
isError));
// send FINISH to rank 0
MPI_Isend(&pingMessage, 1, MPI_INT, 0, PP_FINISH, sysComm, &sysRequest2);
MPI_Send(data, 2*sizeof(StgWord), MPI_BYTE, 0, PP_FINISH, MPI_COMM_WORLD);
// can omit: MPI_Wait(&sysRequest2, MPI_STATUS_IGNORE);
// if non-main PE terminates first, await answer
if (finishRecvd < 1) {
MPI_Recv(data, 2*sizeof(StgWord), MPI_BYTE, 0, PP_FINISH,
MPI_COMM_WORLD, MPI_STATUS_IGNORE);
MPI_Recv(&pingMessage, 1, MPI_INT, 0, PP_FINISH,
sysComm, MPI_STATUS_IGNORE);
finishRecvd++;
}
}
// TODO: receive or cancel all pending messages...
/* ------------------------------------------------
*q&d solution:
* receive anything retrievable by MPI_Probe
* then get in sync
* then again receive remaining messages
*
* (since buffering is used, and buffers are detached to force
* messages, a PE might get stuck detaching its mpiMsgBuffer, and
* send another message as soon as buffer space is available again.
* The other PEs will not )
*
* ---------------------------------------------- */
{
// allocate fresh buffer to avoid overflow
void* voidbuffer;
int voidsize;
// we might come here because of requesting too much buffer (bug!)
voidsize = (INT_MAX / sizeof(StgWord) < DATASPACEWORDS)?\
INT_MAX : DATASPACEWORDS * sizeof(StgWord);
voidbuffer = (void*)
stgMallocBytes(voidsize, "voidBuffer");
// receive whatever is out there...
while (MP_probe()) {
MPI_Recv(voidbuffer, voidsize, MPI_BYTE,
MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, &status);
if (ISSYSCODE(status.MPI_TAG))
MPI_Recv(voidbuffer, 1, MPI_INT,
MPI_ANY_SOURCE, MPI_ANY_TAG,
sysComm, MPI_STATUS_IGNORE);
}
MPI_Barrier(MPI_COMM_WORLD);
// all in sync (noone sends further messages), receive rest
while (MP_probe()) {
MPI_Recv(voidbuffer, voidsize, MPI_BYTE,
MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_COMM_WORLD, &status);
if (ISSYSCODE(status.MPI_TAG))
MPI_Recv(voidbuffer, 1, MPI_INT,
MPI_ANY_SOURCE, MPI_ANY_TAG,
sysComm, MPI_STATUS_IGNORE);
}
stgFree(voidbuffer);
}
// end of q&d
IF_PAR_DEBUG(mpcomm,
debugBelch("detaching MPI buffer\n"));
stgFree(mpiMsgBuffer);
IF_PAR_DEBUG(mpcomm,
debugBelch("Goodbye\n"));
MPI_Finalize();
/* indicate that quit has been executed */
nPEs = 0;
return rtsTrue;
}
void libdwFree(LibdwSession *session) {
if (session == NULL)
return;
dwfl_end(session->dwfl);
stgFree(session);
}
extern void DEBUG_LoadSymbols( 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");
}
#if 0
if (storage_needed == 0) {
debugBelch("no storage needed");
}
#endif
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");
}
for( i = 0; i != number_of_symbols; ++i ) {
symbol_info info;
bfd_get_symbol_info(abfd,symbol_table[i],&info);
/*debugBelch("\t%c\t0x%x \t%s\n",info.type,(nat)info.value,info.name); */
if (isReal(info.type, 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)
);
reset_table( num_real_syms );
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)) {
insert( info.value, info.name );
}
}
stgFree(symbol_table);
}
prepare_table();
}
void osReleaseFreeMemory(void)
{
alloc_rec *prev_a, *a;
alloc_rec head_a;
block_rec *prev_fb, *fb;
block_rec head_fb;
char *a_end, *fb_end;
/* go through allocs and free_blocks in lockstep, looking for allocs
that are completely free, and uncommit them */
head_a.base = 0;
head_a.size = 0;
head_a.next = allocs;
head_fb.base = 0;
head_fb.size = 0;
head_fb.next = free_blocks;
prev_a = &head_a;
a = allocs;
prev_fb = &head_fb;
fb = free_blocks;
while (a != NULL) {
a_end = a->base + a->size;
/* If a is freeable then there is a single freeblock in fb that
covers it. The end of this free block must be >= the end of
a, so skip anything in fb that ends before a. */
while (fb != NULL && fb->base + fb->size < a_end) {
prev_fb = fb;
fb = fb->next;
}
if (fb == NULL) {
/* If we have nothing left in fb, then neither a nor
anything later in the list is freeable, so we are done. */
break;
}
else {
fb_end = fb->base + fb->size;
/* We have a candidate fb. But does it really cover a? */
if (fb->base <= a->base) {
/* Yes, the alloc is within the free block. Now we need
to know if it sticks out at either end. */
if (fb_end == a_end) {
if (fb->base == a->base) {
/* fb and a are identical, so just free fb */
prev_fb->next = fb->next;
stgFree(fb);
fb = prev_fb->next;
}
else {
/* fb begins earlier, so truncate it to not include a */
fb->size = a->base - fb->base;
}
}
else {
/* fb ends later, so we'll make fb just be the part
after a. First though, if it also starts earlier,
we make a new free block record for the before bit. */
if (fb->base != a->base) {
block_rec *new_fb;
new_fb =
(block_rec *)stgMallocBytes(sizeof(block_rec),
"osReleaseFreeMemory");
new_fb->base = fb->base;
new_fb->size = a->base - fb->base;
new_fb->next = fb;
prev_fb->next = new_fb;
}
fb->size = fb_end - a_end;
fb->base = a_end;
}
/* Now we can free the alloc */
prev_a->next = a->next;
if(!VirtualFree((void *)a->base, 0, MEM_RELEASE)) {
sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE "
"failed");
stg_exit(EXIT_FAILURE);
}
stgFree(a);
a = prev_a->next;
}
else {
/* Otherwise this alloc is not freeable, so go on to the
next one */
prev_a = a;
a = a->next;
}
}
}
allocs = head_a.next;
free_blocks = head_fb.next;
}
void
stat_exit (void)
{
generation *gen;
Time gc_cpu = 0;
Time gc_elapsed = 0;
Time init_cpu = 0;
Time init_elapsed = 0;
Time mut_cpu = 0;
Time mut_elapsed = 0;
Time exit_cpu = 0;
Time exit_elapsed = 0;
W_ tot_alloc;
W_ alloc;
if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
char temp[BIG_STRING_LEN];
Time tot_cpu;
Time tot_elapsed;
nat i, g, total_collections = 0;
getProcessTimes( &tot_cpu, &tot_elapsed );
tot_elapsed -= start_init_elapsed;
tot_alloc = calcTotalAllocated();
// allocated since the last GC
alloc = tot_alloc - GC_tot_alloc;
GC_tot_alloc = tot_alloc;
/* Count total garbage collections */
for (g = 0; g < RtsFlags.GcFlags.generations; g++)
total_collections += generations[g].collections;
/* avoid divide by zero if tot_cpu is measured as 0.00 seconds -- SDM */
if (tot_cpu == 0.0) tot_cpu = 1;
if (tot_elapsed == 0.0) tot_elapsed = 1;
if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
statsPrintf("%9" FMT_SizeT " %9.9s %9.9s", (W_)alloc*sizeof(W_), "", "");
statsPrintf(" %6.3f %6.3f\n\n", 0.0, 0.0);
}
for (i = 0; i < RtsFlags.GcFlags.generations; i++) {
gc_cpu += GC_coll_cpu[i];
gc_elapsed += GC_coll_elapsed[i];
}
// heapCensus() is called by the GC, so RP and HC time are
// included in the GC stats. We therefore subtract them to
// obtain the actual GC cpu time.
gc_cpu -= PROF_VAL(RP_tot_time + HC_tot_time);
gc_elapsed -= PROF_VAL(RPe_tot_time + HCe_tot_time);
init_cpu = get_init_cpu();
init_elapsed = get_init_elapsed();
exit_cpu = end_exit_cpu - start_exit_cpu;
exit_elapsed = end_exit_elapsed - start_exit_elapsed;
mut_elapsed = start_exit_elapsed - end_init_elapsed - gc_elapsed;
mut_cpu = start_exit_cpu - end_init_cpu - gc_cpu
- PROF_VAL(RP_tot_time + HC_tot_time);
if (mut_cpu < 0) { mut_cpu = 0; }
if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS) {
showStgWord64(GC_tot_alloc*sizeof(W_),
temp, rtsTrue/*commas*/);
statsPrintf("%16s bytes allocated in the heap\n", temp);
showStgWord64(GC_tot_copied*sizeof(W_),
temp, rtsTrue/*commas*/);
statsPrintf("%16s bytes copied during GC\n", temp);
if ( residency_samples > 0 ) {
showStgWord64(max_residency*sizeof(W_),
temp, rtsTrue/*commas*/);
statsPrintf("%16s bytes maximum residency (%" FMT_Word " sample(s))\n",
temp, residency_samples);
}
showStgWord64(max_slop*sizeof(W_), temp, rtsTrue/*commas*/);
statsPrintf("%16s bytes maximum slop\n", temp);
statsPrintf("%16" FMT_SizeT " MB total memory in use (%" FMT_SizeT " MB lost due to fragmentation)\n\n",
(size_t)(peak_mblocks_allocated * MBLOCK_SIZE_W) / (1024 * 1024 / sizeof(W_)),
(size_t)(peak_mblocks_allocated * BLOCKS_PER_MBLOCK * BLOCK_SIZE_W - hw_alloc_blocks * BLOCK_SIZE_W) / (1024 * 1024 / sizeof(W_)));
/* Print garbage collections in each gen */
statsPrintf(" Tot time (elapsed) Avg pause Max pause\n");
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
gen = &generations[g];
statsPrintf(" Gen %2d %5d colls, %5d par %6.3fs %6.3fs %3.4fs %3.4fs\n",
gen->no,
gen->collections,
gen->par_collections,
TimeToSecondsDbl(GC_coll_cpu[g]),
TimeToSecondsDbl(GC_coll_elapsed[g]),
gen->collections == 0 ? 0 : TimeToSecondsDbl(GC_coll_elapsed[g] / gen->collections),
TimeToSecondsDbl(GC_coll_max_pause[g]));
}
#if defined(THREADED_RTS)
if (RtsFlags.ParFlags.parGcEnabled && n_capabilities > 1) {
statsPrintf("\n Parallel GC work balance: %.2f%% (serial 0%%, perfect 100%%)\n",
100 * (((double)GC_par_tot_copied / (double)GC_par_max_copied) - 1)
/ (n_capabilities - 1)
);
}
#endif
statsPrintf("\n");
#if defined(THREADED_RTS)
statsPrintf(" TASKS: %d (%d bound, %d peak workers (%d total), using -N%d)\n",
taskCount, taskCount - workerCount,
peakWorkerCount, workerCount,
n_capabilities);
statsPrintf("\n");
{
nat i;
SparkCounters sparks = { 0, 0, 0, 0, 0, 0};
for (i = 0; i < n_capabilities; i++) {
sparks.created += capabilities[i]->spark_stats.created;
sparks.dud += capabilities[i]->spark_stats.dud;
sparks.overflowed+= capabilities[i]->spark_stats.overflowed;
sparks.converted += capabilities[i]->spark_stats.converted;
sparks.gcd += capabilities[i]->spark_stats.gcd;
sparks.fizzled += capabilities[i]->spark_stats.fizzled;
}
statsPrintf(" SPARKS: %" FMT_Word " (%" FMT_Word " converted, %" FMT_Word " overflowed, %" FMT_Word " dud, %" FMT_Word " GC'd, %" FMT_Word " fizzled)\n\n",
sparks.created + sparks.dud + sparks.overflowed,
sparks.converted, sparks.overflowed, sparks.dud,
sparks.gcd, sparks.fizzled);
}
#endif
statsPrintf(" INIT time %7.3fs (%7.3fs elapsed)\n",
TimeToSecondsDbl(init_cpu), TimeToSecondsDbl(init_elapsed));
statsPrintf(" MUT time %7.3fs (%7.3fs elapsed)\n",
TimeToSecondsDbl(mut_cpu), TimeToSecondsDbl(mut_elapsed));
statsPrintf(" GC time %7.3fs (%7.3fs elapsed)\n",
TimeToSecondsDbl(gc_cpu), TimeToSecondsDbl(gc_elapsed));
#ifdef PROFILING
statsPrintf(" RP time %7.3fs (%7.3fs elapsed)\n",
TimeToSecondsDbl(RP_tot_time), TimeToSecondsDbl(RPe_tot_time));
statsPrintf(" PROF time %7.3fs (%7.3fs elapsed)\n",
TimeToSecondsDbl(HC_tot_time), TimeToSecondsDbl(HCe_tot_time));
#endif
statsPrintf(" EXIT time %7.3fs (%7.3fs elapsed)\n",
TimeToSecondsDbl(exit_cpu), TimeToSecondsDbl(exit_elapsed));
statsPrintf(" Total time %7.3fs (%7.3fs elapsed)\n\n",
TimeToSecondsDbl(tot_cpu), TimeToSecondsDbl(tot_elapsed));
#ifndef THREADED_RTS
statsPrintf(" %%GC time %5.1f%% (%.1f%% elapsed)\n\n",
TimeToSecondsDbl(gc_cpu)*100/TimeToSecondsDbl(tot_cpu),
TimeToSecondsDbl(gc_elapsed)*100/TimeToSecondsDbl(tot_elapsed));
#endif
if (mut_cpu == 0) {
showStgWord64(0, temp, rtsTrue/*commas*/);
} else {
showStgWord64(
(StgWord64)((GC_tot_alloc*sizeof(W_)) / TimeToSecondsDbl(mut_cpu)),
temp, rtsTrue/*commas*/);
}
statsPrintf(" Alloc rate %s bytes per MUT second\n\n", temp);
statsPrintf(" Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
TimeToSecondsDbl(tot_cpu - gc_cpu -
PROF_VAL(RP_tot_time + HC_tot_time) - init_cpu) * 100
/ TimeToSecondsDbl(tot_cpu),
TimeToSecondsDbl(tot_cpu - gc_cpu -
PROF_VAL(RP_tot_time + HC_tot_time) - init_cpu) * 100
/ TimeToSecondsDbl(tot_elapsed));
/*
TICK_PRINT(1);
TICK_PRINT(2);
REPORT(TOTAL_CALLS);
TICK_PRINT_TOT(1);
TICK_PRINT_TOT(2);
*/
#if USE_PAPI
papi_stats_report();
#endif
#if defined(THREADED_RTS) && defined(PROF_SPIN)
{
nat g;
statsPrintf("gc_alloc_block_sync: %"FMT_Word64"\n", gc_alloc_block_sync.spin);
statsPrintf("whitehole_spin: %"FMT_Word64"\n", whitehole_spin);
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
statsPrintf("gen[%d].sync: %"FMT_Word64"\n", g, generations[g].sync.spin);
}
}
#endif
}
if (RtsFlags.GcFlags.giveStats == ONELINE_GC_STATS) {
char *fmt1, *fmt2;
if (RtsFlags.MiscFlags.machineReadable) {
fmt1 = " [(\"bytes allocated\", \"%llu\")\n";
fmt2 = " ,(\"num_GCs\", \"%d\")\n"
" ,(\"average_bytes_used\", \"%ld\")\n"
" ,(\"max_bytes_used\", \"%ld\")\n"
" ,(\"num_byte_usage_samples\", \"%ld\")\n"
" ,(\"peak_megabytes_allocated\", \"%lu\")\n"
" ,(\"init_cpu_seconds\", \"%.3f\")\n"
" ,(\"init_wall_seconds\", \"%.3f\")\n"
" ,(\"mutator_cpu_seconds\", \"%.3f\")\n"
" ,(\"mutator_wall_seconds\", \"%.3f\")\n"
" ,(\"GC_cpu_seconds\", \"%.3f\")\n"
" ,(\"GC_wall_seconds\", \"%.3f\")\n"
" ]\n";
}
else {
fmt1 = "<<ghc: %llu bytes, ";
fmt2 = "%d GCs, %ld/%ld avg/max bytes residency (%ld samples), %luM in use, %.3f INIT (%.3f elapsed), %.3f MUT (%.3f elapsed), %.3f GC (%.3f elapsed) :ghc>>\n";
}
/* print the long long separately to avoid bugginess on mingwin (2001-07-02, mingw-0.5) */
statsPrintf(fmt1, GC_tot_alloc*(StgWord64)sizeof(W_));
statsPrintf(fmt2,
total_collections,
residency_samples == 0 ? 0 :
cumulative_residency*sizeof(W_)/residency_samples,
max_residency*sizeof(W_),
residency_samples,
(unsigned long)(peak_mblocks_allocated * MBLOCK_SIZE / (1024L * 1024L)),
TimeToSecondsDbl(init_cpu), TimeToSecondsDbl(init_elapsed),
TimeToSecondsDbl(mut_cpu), TimeToSecondsDbl(mut_elapsed),
TimeToSecondsDbl(gc_cpu), TimeToSecondsDbl(gc_elapsed));
}
statsFlush();
statsClose();
}
if (GC_coll_cpu) {
stgFree(GC_coll_cpu);
GC_coll_cpu = NULL;
}
if (GC_coll_elapsed) {
stgFree(GC_coll_elapsed);
GC_coll_elapsed = NULL;
}
if (GC_coll_max_pause) {
stgFree(GC_coll_max_pause);
GC_coll_max_pause = NULL;
}
}
void
stat_exit(int alloc)
{
generation *gen;
Ticks gc_cpu = 0;
Ticks gc_elapsed = 0;
Ticks init_cpu = 0;
Ticks init_elapsed = 0;
Ticks mut_cpu = 0;
Ticks mut_elapsed = 0;
Ticks exit_cpu = 0;
Ticks exit_elapsed = 0;
if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
char temp[BIG_STRING_LEN];
Ticks tot_cpu;
Ticks tot_elapsed;
nat i, g, total_collections = 0;
getProcessTimes( &tot_cpu, &tot_elapsed );
tot_elapsed -= start_init_elapsed;
GC_tot_alloc += alloc;
/* Count total garbage collections */
for (g = 0; g < RtsFlags.GcFlags.generations; g++)
total_collections += generations[g].collections;
/* avoid divide by zero if tot_cpu is measured as 0.00 seconds -- SDM */
if (tot_cpu == 0.0) tot_cpu = 1;
if (tot_elapsed == 0.0) tot_elapsed = 1;
if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
statsPrintf("%9ld %9.9s %9.9s", (lnat)alloc*sizeof(W_), "", "");
statsPrintf(" %5.2f %5.2f\n\n", 0.0, 0.0);
}
for (i = 0; i < RtsFlags.GcFlags.generations; i++) {
gc_cpu += GC_coll_cpu[i];
gc_elapsed += GC_coll_elapsed[i];
}
init_cpu = get_init_cpu();
init_elapsed = get_init_elapsed();
exit_cpu = end_exit_cpu - start_exit_cpu;
exit_elapsed = end_exit_elapsed - start_exit_elapsed;
mut_elapsed = start_exit_elapsed - end_init_elapsed - gc_elapsed;
mut_cpu = start_exit_cpu - end_init_cpu - gc_cpu
- PROF_VAL(RP_tot_time + HC_tot_time);
if (mut_cpu < 0) { mut_cpu = 0; }
if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS) {
showStgWord64(GC_tot_alloc*sizeof(W_),
temp, rtsTrue/*commas*/);
statsPrintf("%16s bytes allocated in the heap\n", temp);
showStgWord64(GC_tot_copied*sizeof(W_),
temp, rtsTrue/*commas*/);
statsPrintf("%16s bytes copied during GC\n", temp);
if ( residency_samples > 0 ) {
showStgWord64(max_residency*sizeof(W_),
temp, rtsTrue/*commas*/);
statsPrintf("%16s bytes maximum residency (%ld sample(s))\n",
temp, residency_samples);
}
showStgWord64(max_slop*sizeof(W_), temp, rtsTrue/*commas*/);
statsPrintf("%16s bytes maximum slop\n", temp);
statsPrintf("%16ld MB total memory in use (%ld MB lost due to fragmentation)\n\n",
peak_mblocks_allocated * MBLOCK_SIZE_W / (1024 * 1024 / sizeof(W_)),
(peak_mblocks_allocated * BLOCKS_PER_MBLOCK * BLOCK_SIZE_W - hw_alloc_blocks * BLOCK_SIZE_W) / (1024 * 1024 / sizeof(W_)));
/* Print garbage collections in each gen */
statsPrintf(" Tot time (elapsed) Avg pause Max pause\n");
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
gen = &generations[g];
statsPrintf(" Gen %2d %5d colls, %5d par %5.2fs %5.2fs %3.4fs %3.4fs\n",
gen->no,
gen->collections,
gen->par_collections,
TICK_TO_DBL(GC_coll_cpu[g]),
TICK_TO_DBL(GC_coll_elapsed[g]),
gen->collections == 0 ? 0 : TICK_TO_DBL(GC_coll_elapsed[g] / gen->collections),
TICK_TO_DBL(GC_coll_max_pause[g]));
}
#if defined(THREADED_RTS)
if (RtsFlags.ParFlags.parGcEnabled) {
statsPrintf("\n Parallel GC work balance: %.2f (%ld / %ld, ideal %d)\n",
(double)GC_par_avg_copied / (double)GC_par_max_copied,
(lnat)GC_par_avg_copied, (lnat)GC_par_max_copied,
RtsFlags.ParFlags.nNodes
);
}
#endif
statsPrintf("\n");
#if defined(THREADED_RTS)
{
nat i;
Task *task;
statsPrintf(" MUT time (elapsed) GC time (elapsed)\n");
for (i = 0, task = all_tasks;
task != NULL;
i++, task = task->all_link) {
statsPrintf(" Task %2d %-8s : %6.2fs (%6.2fs) %6.2fs (%6.2fs)\n",
i,
(task->worker) ? "(worker)" : "(bound)",
TICK_TO_DBL(task->mut_time),
TICK_TO_DBL(task->mut_etime),
TICK_TO_DBL(task->gc_time),
TICK_TO_DBL(task->gc_etime));
}
}
statsPrintf("\n");
{
nat i;
SparkCounters sparks = { 0, 0, 0, 0, 0, 0};
for (i = 0; i < n_capabilities; i++) {
sparks.created += capabilities[i].spark_stats.created;
sparks.dud += capabilities[i].spark_stats.dud;
sparks.overflowed+= capabilities[i].spark_stats.overflowed;
sparks.converted += capabilities[i].spark_stats.converted;
sparks.gcd += capabilities[i].spark_stats.gcd;
sparks.fizzled += capabilities[i].spark_stats.fizzled;
}
statsPrintf(" SPARKS: %ld (%ld converted, %ld overflowed, %ld dud, %ld GC'd, %ld fizzled)\n\n",
sparks.created + sparks.dud + sparks.overflowed,
sparks.converted, sparks.overflowed, sparks.dud,
sparks.gcd, sparks.fizzled);
}
#endif
statsPrintf(" INIT time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(init_cpu), TICK_TO_DBL(init_elapsed));
statsPrintf(" MUT time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(mut_cpu), TICK_TO_DBL(mut_elapsed));
statsPrintf(" GC time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(gc_cpu), TICK_TO_DBL(gc_elapsed));
#ifdef PROFILING
statsPrintf(" RP time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(RP_tot_time), TICK_TO_DBL(RPe_tot_time));
statsPrintf(" PROF time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(HC_tot_time), TICK_TO_DBL(HCe_tot_time));
#endif
statsPrintf(" EXIT time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(exit_cpu), TICK_TO_DBL(exit_elapsed));
statsPrintf(" Total time %6.2fs (%6.2fs elapsed)\n\n",
TICK_TO_DBL(tot_cpu), TICK_TO_DBL(tot_elapsed));
#ifndef THREADED_RTS
statsPrintf(" %%GC time %5.1f%% (%.1f%% elapsed)\n\n",
TICK_TO_DBL(gc_cpu)*100/TICK_TO_DBL(tot_cpu),
TICK_TO_DBL(gc_elapsed)*100/TICK_TO_DBL(tot_elapsed));
#endif
if (tot_cpu - GC_tot_cpu - PROF_VAL(RP_tot_time + HC_tot_time) == 0)
showStgWord64(0, temp, rtsTrue/*commas*/);
else
showStgWord64(
(StgWord64)((GC_tot_alloc*sizeof(W_))/
TICK_TO_DBL(tot_cpu - GC_tot_cpu -
PROF_VAL(RP_tot_time + HC_tot_time))),
temp, rtsTrue/*commas*/);
statsPrintf(" Alloc rate %s bytes per MUT second\n\n", temp);
statsPrintf(" Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
TICK_TO_DBL(tot_cpu - GC_tot_cpu -
PROF_VAL(RP_tot_time + HC_tot_time) - init_cpu) * 100
/ TICK_TO_DBL(tot_cpu),
TICK_TO_DBL(tot_cpu - GC_tot_cpu -
PROF_VAL(RP_tot_time + HC_tot_time) - init_cpu) * 100
/ TICK_TO_DBL(tot_elapsed));
/*
TICK_PRINT(1);
TICK_PRINT(2);
REPORT(TOTAL_CALLS);
TICK_PRINT_TOT(1);
TICK_PRINT_TOT(2);
*/
#if USE_PAPI
papi_stats_report();
#endif
#if defined(THREADED_RTS) && defined(PROF_SPIN)
{
nat g;
statsPrintf("gc_alloc_block_sync: %"FMT_Word64"\n", gc_alloc_block_sync.spin);
statsPrintf("whitehole_spin: %"FMT_Word64"\n", whitehole_spin);
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
statsPrintf("gen[%d].sync: %"FMT_Word64"\n", g, generations[g].sync.spin);
}
}
#endif
}
if (RtsFlags.GcFlags.giveStats == ONELINE_GC_STATS) {
char *fmt1, *fmt2;
if (RtsFlags.MiscFlags.machineReadable) {
fmt1 = " [(\"bytes allocated\", \"%llu\")\n";
fmt2 = " ,(\"num_GCs\", \"%d\")\n"
" ,(\"average_bytes_used\", \"%ld\")\n"
" ,(\"max_bytes_used\", \"%ld\")\n"
" ,(\"num_byte_usage_samples\", \"%ld\")\n"
" ,(\"peak_megabytes_allocated\", \"%lu\")\n"
" ,(\"init_cpu_seconds\", \"%.2f\")\n"
" ,(\"init_wall_seconds\", \"%.2f\")\n"
" ,(\"mutator_cpu_seconds\", \"%.2f\")\n"
" ,(\"mutator_wall_seconds\", \"%.2f\")\n"
" ,(\"GC_cpu_seconds\", \"%.2f\")\n"
" ,(\"GC_wall_seconds\", \"%.2f\")\n"
" ]\n";
}
else {
fmt1 = "<<ghc: %llu bytes, ";
fmt2 = "%d GCs, %ld/%ld avg/max bytes residency (%ld samples), %luM in use, %.2f INIT (%.2f elapsed), %.2f MUT (%.2f elapsed), %.2f GC (%.2f elapsed) :ghc>>\n";
}
/* print the long long separately to avoid bugginess on mingwin (2001-07-02, mingw-0.5) */
statsPrintf(fmt1, GC_tot_alloc*(StgWord64)sizeof(W_));
statsPrintf(fmt2,
total_collections,
residency_samples == 0 ? 0 :
cumulative_residency*sizeof(W_)/residency_samples,
max_residency*sizeof(W_),
residency_samples,
(unsigned long)(peak_mblocks_allocated * MBLOCK_SIZE / (1024L * 1024L)),
TICK_TO_DBL(init_cpu), TICK_TO_DBL(init_elapsed),
TICK_TO_DBL(mut_cpu), TICK_TO_DBL(mut_elapsed),
TICK_TO_DBL(gc_cpu), TICK_TO_DBL(gc_elapsed));
}
statsFlush();
statsClose();
}
if (GC_coll_cpu) {
stgFree(GC_coll_cpu);
GC_coll_cpu = NULL;
}
if (GC_coll_elapsed) {
stgFree(GC_coll_elapsed);
GC_coll_elapsed = NULL;
}
if (GC_coll_max_pause) {
stgFree(GC_coll_max_pause);
GC_coll_max_pause = NULL;
}
}
static void
readTix(void) {
unsigned int i;
HpcModuleInfo *tmpModule;
const HpcModuleInfo *lookup;
ws();
expect('T');
expect('i');
expect('x');
ws();
expect('[');
ws();
while(tix_ch != ']') {
tmpModule = (HpcModuleInfo *)stgMallocBytes(sizeof(HpcModuleInfo),
"Hpc.readTix");
tmpModule->from_file = true;
expect('T');
expect('i');
expect('x');
expect('M');
expect('o');
expect('d');
expect('u');
expect('l');
expect('e');
ws();
tmpModule -> modName = expectString();
ws();
tmpModule -> hashNo = (unsigned int)expectWord64();
ws();
tmpModule -> tickCount = (int)expectWord64();
tmpModule -> tixArr = (StgWord64 *)calloc(tmpModule->tickCount,sizeof(StgWord64));
ws();
expect('[');
ws();
for(i = 0;i < tmpModule->tickCount;i++) {
tmpModule->tixArr[i] = expectWord64();
ws();
if (tix_ch == ',') {
expect(',');
ws();
}
}
expect(']');
ws();
lookup = lookupHashTable(moduleHash, (StgWord)tmpModule->modName);
if (lookup == NULL) {
debugTrace(DEBUG_hpc,"readTix: new HpcModuleInfo for %s",
tmpModule->modName);
insertHashTable(moduleHash, (StgWord)tmpModule->modName, tmpModule);
} else {
ASSERT(lookup->tixArr != 0);
ASSERT(!strcmp(tmpModule->modName, lookup->modName));
debugTrace(DEBUG_hpc,"readTix: existing HpcModuleInfo for %s",
tmpModule->modName);
if (tmpModule->hashNo != lookup->hashNo) {
fprintf(stderr,"in module '%s'\n",tmpModule->modName);
failure("module mismatch with .tix/.mix file hash number");
if (tixFilename != NULL) {
fprintf(stderr,"(perhaps remove %s ?)\n",tixFilename);
}
stg_exit(EXIT_FAILURE);
}
for (i=0; i < tmpModule->tickCount; i++) {
lookup->tixArr[i] = tmpModule->tixArr[i];
}
stgFree(tmpModule->tixArr);
stgFree(tmpModule->modName);
stgFree(tmpModule);
}
if (tix_ch == ',') {
expect(',');
ws();
}
}
expect(']');
fclose(tixFile);
}
static void
freeLock(void *lock)
{
stgFree(lock);
}
