/*
* Remove 'node' from the heap. O(log n) amortized.
*/
void
pairingheap_remove(pairingheap *heap, pairingheap_node *node)
{
pairingheap_node *children;
pairingheap_node *replacement;
pairingheap_node *next_sibling;
pairingheap_node **prev_ptr;
/*
* If the removed node happens to be the root node, do it with
* pairingheap_remove_first().
*/
if (node == heap->ph_root)
{
(void) pairingheap_remove_first(heap);
return;
}
/*
* Before we modify anything, remember the removed node's first_child and
* next_sibling pointers.
*/
children = node->first_child;
next_sibling = node->next_sibling;
/*
* Also find the pointer to the removed node in its previous sibling, or
* if this is the first child of its parent, in its parent.
*/
if (node->prev_or_parent->first_child == node)
prev_ptr = &node->prev_or_parent->first_child;
else
prev_ptr = &node->prev_or_parent->next_sibling;
Assert(*prev_ptr == node);
/*
* If this node has children, make a new subheap of the children and link
* the subheap in place of the removed node. Otherwise just unlink this
* node.
*/
if (children)
{
replacement = merge_children(heap, children);
replacement->prev_or_parent = node->prev_or_parent;
replacement->next_sibling = node->next_sibling;
*prev_ptr = replacement;
if (next_sibling)
next_sibling->prev_or_parent = replacement;
}
else
{
*prev_ptr = next_sibling;
if (next_sibling)
next_sibling->prev_or_parent = node->prev_or_parent;
}
}
/*
* pairingheap_remove_first
*
* Removes the first (root, topmost) node in the heap and returns a pointer to
* it after rebalancing the heap. The caller must ensure that this routine is
* not used on an empty heap. O(log n) amortized.
*/
pairingheap_node *
pairingheap_remove_first(pairingheap *heap)
{
pairingheap_node *result;
pairingheap_node *children;
Assert(!pairingheap_is_empty(heap));
/* Remove the root, and form a new heap of its children. */
result = heap->ph_root;
children = result->first_child;
heap->ph_root = merge_children(heap, children);
if (heap->ph_root)
{
heap->ph_root->prev_or_parent = NULL;
heap->ph_root->next_sibling = NULL;
}
return result;
}
void
iprofiletable()
{
nialptr result; /* result to be returned */
int c1,
c2;
int num_funs = 0; /* total number of used functions */
int pos = 0; /* current count of used fucntions */
if (newprofile) {
buildfault("no profile available");
return;
}
#ifndef OLD_BUILD_SYMBOL_TABLE
if (symtab)
free_symtab();
symtab = NULL;
build_symbol_table();
#endif
/* If profiling is still on, then turn it off */
if (profile == true) {
apush(createbool(0));
isetprofile();
apop();
}
/* traverse the call tree placing nodes in the symbol table entries */
if (!traversed) {
traverse_tree(calltree);
traversed = true;
}
/* count the number of called functions so we know how big to
make the container array. Funcitons in the symbol table that
are not called at all are excluded */
for (c1 = 0; c1 < symtabsize; c1++)
if ((symtab[c1]->num_locs > 0) || (symtab[c1]->num_rcalls > 0))
num_funs++;
/* create the outer most container to hold the table */
result = new_create_array(atype, 1, 0, &num_funs);
for (c1 = 0; c1 < symtabsize; c1++) {
if ((symtab[c1]->num_locs > 0) || (symtab[c1]->num_rcalls > 0)) {
double totaloptime = 0;
int totalopcalls = 0;
int totalropcalls;
int len = 5;
/* create the table entry */
nialptr table_entry = new_create_array(atype, 1, 0, &len);
/* store it in the outer table */
store_array(result, pos, table_entry);
for (c2 = 0; c2 < symtab[c1]->num_locs; c2++) {
if (symtab[c1]->id != symtab[c1]->locations[c2]->parent->opid)
/* omit adding calls and time for direct recursions */
{
totaloptime += symtab[c1]->locations[c2]->total_time;
totalopcalls += symtab[c1]->locations[c2]->total_calls;
}
}
totalropcalls = symtab[c1]->num_rcalls;
/* fill in the cells in the table entry */
store_array(table_entry, 0, makephrase(symtab[c1]->name));
store_array(table_entry, 1, createint(totalopcalls));
store_array(table_entry, 2, createint(totalropcalls));
store_array(table_entry, 3, createreal(totaloptime));
{
struct node **chlist;
nialptr child_array;
int c,
used,
cpos = 0;
int children = 0;
chlist = merge_children(symtab[c1], &used);
for (c = 0; c < used; c++)
if (chlist[c]->opid != symtab[c1]->id) /* recursions only counted */
children++;
child_array = new_create_array(atype, 1, 0, &children);
store_array(table_entry, 4, child_array);
for (c = 0; c < used; c++) {
nialptr child_entry;
int len = 5;
if (chlist[c]->opid == symtab[c1]->id) /* recursions only counted */
break;
/* create each child entry and place it in the child list */
child_entry = new_create_array(atype, 1, 0, &len);
store_array(child_array, cpos, child_entry);
/* fill in the information about the child entry */
store_array(child_entry, 0, makephrase(num_to_name(chlist[c]->opid)));
store_array(child_entry, 1, createint(chlist[c]->total_calls));
store_array(child_entry, 2, createint(0));
store_array(child_entry, 3, createreal(chlist[c]->total_time));
store_array(child_entry, 4, Null);
cpos++;
}
free_merge_list(chlist, used);
}
}
pos++;
}
apush(result);
}
void
iprofile()
{
char sbuf[1000];
nialptr z;
FILE *prf = STDOUT;
int c1,
c2;
int i;
double real_total_time = 0;
double profile_duration_time;
int NMWIDTH = 30;
/* grab the argument */
z = apop();
if (newprofile) {
buildfault("no profile available");
freeup(z);
return;
}
/* handle input argument */
if (kind(z) == phrasetype) {
apush(z);
istring();
z = apop();
}
if (tally(z) != 0) {
if (!istext(z)) {
buildfault("profile file name arg is not text");
freeup(z);
return;
}
else {
prf = openfile(pfirstchar(z), 'w', 't');
if (prf == OPENFAILED) {
buildfault("unable to open specified file to write profile to");
freeup(z);
return;
/* exit_cover(NC_PROFILE_FILE_W); removed Nov 22/95 because this
* cleared profile information */
}
}
}
freeup(z);
/* If profiling is still on, then turn it off */
if (profile == true) {
apush(createbool(0));
isetprofile();
apop();
}
#ifndef OLD_BUILD_SYMBOL_TABLE
if (symtab)
free_symtab();
symtab = NULL;
build_symbol_table();
#endif
profile_duration_time = (calltree->total_time);
for (i = 0;i <calltree->num_children;i++) {
real_total_time += calltree->children[i]->total_time;
}
/* traverse the call tree placing nodes in the symbol table entries */
if (!traversed) {
traverse_tree(calltree);
traversed = true;
}
/* generate the output and place it in the output file or stdout */
/* if a filename has been specified then write that out */
if (tally(z)) {
sprintf(sbuf,"Profile output file: \"%s\"\n\n",pfirstchar(z));
writechars(prf, sbuf, strlen(sbuf), false);
}
sprintf(sbuf, "\nTotal execution time of profile session: \t%f\n", profile_duration_time);
writechars(prf, sbuf, strlen(sbuf), false);
sprintf(sbuf, "Total execution time in top level calls: \t%f\n\n",real_total_time);
writechars(prf, sbuf, strlen(sbuf), false);
/* header line for all data */
sprintf(sbuf, "op name[.tr arg] calls[rec] ");
writechars(prf, sbuf, strlen(sbuf), false);
sprintf(sbuf, "time time/call %% time\n");
writechars(prf, sbuf, strlen(sbuf), false);
for (c1 = 0; c1 < symtabsize; c1++) {
if ((symtab[c1]->num_locs > 0) || (symtab[c1]->num_rcalls > 0)) {
double totaloptime = 0;
int totalopcalls = 0;
int totalropcalls;
char *tmp;
for (c2 = 0; c2 < symtab[c1]->num_locs; c2++) {
if (symtab[c1]->id != symtab[c1]->locations[c2]->parent->opid)
/* omit adding calls and time for direct recursions */
{
totaloptime += symtab[c1]->locations[c2]->total_time;
totalopcalls += symtab[c1]->locations[c2]->total_calls;
}
}
totalropcalls = symtab[c1]->num_rcalls;
sprintf(sbuf, "%s%5d", (tmp = padright(NMWIDTH, (char *) symtab[c1]->name)),
totalopcalls);
writechars(prf, sbuf, strlen(sbuf), false);
free(tmp);
if (totalropcalls != 0) {
sprintf(sbuf, "[%5d]", totalropcalls);
writechars(prf, sbuf, strlen(sbuf), false);
}
else {
sprintf(sbuf, " ");
writechars(prf, sbuf, strlen(sbuf), false);
}
/* details for each definition */
sprintf(sbuf, "%8.2f %8.4f %8.1f%s\n",
totaloptime,
(totaloptime / totalopcalls),
100 * (totaloptime / real_total_time),
((symtab[c1]->toplevel_call == true)?"<":""));
writechars(prf, sbuf, strlen(sbuf), false);
{
struct node **chlist;
int c,
used;
char tname[40];
chlist = merge_children(symtab[c1], &used);
for (c = 0; c < used; c++) {
char *tmp;
if (chlist[c]->opid == symtab[c1]->id) /* recursions only counted */
break;
strcpy(tname, num_to_name(chlist[c]->opid));
/* details for each definition it calls */
if (chlist[c]->total_time > 0.0)
sprintf(sbuf, " %s%5d %8.2f %8.4f %8.2f\n",
(tmp = padright(NMWIDTH - 1, tname)),
chlist[c]->total_calls,
chlist[c]->total_time,
chlist[c]->total_time / chlist[c]->total_calls,
100 * (chlist[c]->total_time / totaloptime));
else
sprintf(sbuf, " %s%5d %8.2f %8.4f %8.2f\n",
(tmp = padright(NMWIDTH - 1, tname)),
chlist[c]->total_calls,
chlist[c]->total_time,
0.0, 0.0);
writechars(prf, sbuf, strlen(sbuf), false);
free(tmp);
}
free_merge_list(chlist, used);
}
sprintf(sbuf, "\n");
writechars(prf, sbuf, strlen(sbuf), false);
}
}
if (prf != STDOUT)
closefile(prf);
apush(Nullexpr);
return;
}
