static MR_Unsigned
MR_standardize_num(MR_Unsigned num, MR_Hash_Table *table_ptr,
MR_bool *init_ptr, int *next_ptr)
{
const MR_Standard_Hash_Record *record;
MR_Standard_Hash_Record *new_record;
int std_num;
if (! *init_ptr) {
*init_ptr = MR_TRUE;
MR_init_hash_table(*table_ptr);
}
record = MR_lookup_hash_table(*table_ptr, num);
if (record != NULL) {
return record->MR_std_std_number;
}
std_num = *next_ptr;
(*next_ptr)++;
new_record = MR_GC_NEW(MR_Standard_Hash_Record);
new_record->MR_std_orig_number = num;
new_record->MR_std_std_number = std_num;
(void) MR_insert_hash_table(*table_ptr, new_record);
return std_num;
}
void
MR_insert_internal_label(const char *name, MR_Code *addr,
const MR_LabelLayout *label_layout)
{
MR_Internal *internal;
MR_Internal *prev_internal;
MR_do_init_label_tables();
internal = MR_GC_NEW_ATTRIB(MR_Internal, MR_ALLOC_SITE_RUNTIME);
internal->MR_internal_addr = addr;
internal->MR_internal_layout = label_layout;
internal->MR_internal_name = name;
#ifdef MR_LOWLEVEL_DEBUG
if (MR_progdebug) {
/*
** We can't assume that MR_LOWLEVEL_DEBUG was turned on in the code
** that generated the call to this function just because
** MR_LOWLEVEL_DEBUG is turned on here.
*/
if (name != NULL) {
printf("inserting internal label %s at %p\n", name, addr);
} else {
printf("inserting internal label at %p\n", addr);
}
}
#endif
prev_internal = (MR_Internal *)
MR_insert_hash_table(internal_addr_table, internal);
if (prev_internal != NULL) {
/*
** Two labels at same location will happen quite often, when the code
** generated between them turns out to be empty. In this case,
** MR_insert_hash_table will not have inserted internal into the table.
**
** If only one of internal and prev_internal have a layout structure,
** make sure that we associate the layout structure with the label
** address.
**
** If both internal and prev_internal have a layout structure,
** we rely on the compiler to make sure that it is ok to use
** either of their layout structures.
*/
if (prev_internal->MR_internal_layout == NULL) {
prev_internal->MR_internal_layout = label_layout;
}
}
}
void
MR_insert_proc_defn_rep(const MR_ProcLayout *proc_layout,
MR_Word proc_defn_rep)
{
MR_ProcLayoutRep *layout_rep;
MR_do_init_proc_defn_rep_table();
layout_rep = MR_GC_NEW(MR_ProcLayoutRep);
layout_rep->plr_layout = proc_layout;
layout_rep->plr_rep = proc_defn_rep;
(void) MR_insert_hash_table(proc_defn_rep_table, layout_rep);
#ifdef MR_DEBUG_PROC_REP
if (MR_progdebug) {
printf("insert: layout %p, rep %x, pair %p\n",
proc_layout, proc_defn_rep, layout_rep);
}
#endif
}
void
MR_io_tabling_stats(FILE *fp)
{
const MR_TableIoDecl *table_io_decl;
const MR_ProcLayout *proc_layout;
MR_ConstString proc_name;
int arity;
MR_Word is_func;
int hv;
MR_TrieNode answer_block_trie;
MR_Word *answer_block;
MR_Hash_Table hash_table;
MR_IO_Table_Stats_Hash_Record *hash_record;
MR_IO_Table_Stats_Hash_Record *record;
int num_entries;
int count;
int i;
/*
** Create a fresh new hash table, separate the table created by
** any previous call to this function. We can't use structure assignment,
** as that causes gcc 3.2 to throw a fit.
*/
hash_table.MR_ht_size = MR_io_tabling_stats_table.MR_ht_size;
hash_table.MR_ht_store = NULL;
hash_table.MR_ht_key = MR_io_tabling_stats_table.MR_ht_key;
hash_table.MR_ht_hash = MR_io_tabling_stats_table.MR_ht_hash;
hash_table.MR_ht_equal = MR_io_tabling_stats_table.MR_ht_equal;
MR_init_hash_table(hash_table);
num_entries = 0;
for (i = MR_io_tabling_start; i < MR_io_tabling_counter_hwm; i++) {
MR_TABLE_START_INT(NULL, MR_FALSE, MR_FALSE, answer_block_trie,
(MR_TrieNode) &MR_io_tabling_pointer, MR_io_tabling_start, i);
answer_block = answer_block_trie->MR_answerblock;
if (answer_block == NULL) {
continue;
}
table_io_decl = (const MR_TableIoDecl *) answer_block[0];
proc_layout = table_io_decl->MR_table_io_decl_proc;
hash_record = MR_lookup_hash_table(hash_table, proc_layout);
if (hash_record == NULL) {
hash_record = MR_GC_NEW(MR_IO_Table_Stats_Hash_Record);
hash_record->MR_io_tabling_stats_proc = proc_layout;
hash_record->MR_io_tabling_stats_count = 1;
(void) MR_insert_hash_table(hash_table, hash_record);
num_entries++;
} else {
hash_record->MR_io_tabling_stats_count++;
}
}
MR_io_tabling_stats_sort_arena =
MR_GC_NEW_ARRAY(MR_IO_Table_Stats_Hash_Record, num_entries);
MR_io_tabling_stats_sort_arena_next = 0;
MR_process_all_entries(hash_table, MR_add_to_sort_arena);
if (MR_io_tabling_stats_sort_arena_next != num_entries) {
MR_fatal_error("MR_io_tabling_stats: num_entries mismatch");
}
qsort(MR_io_tabling_stats_sort_arena, num_entries,
sizeof(MR_IO_Table_Stats_Hash_Record), MR_compare_in_sort_arena);
for (i = 0; i < num_entries; i++) {
record = &MR_io_tabling_stats_sort_arena[i];
proc_layout = record->MR_io_tabling_stats_proc;
count = record->MR_io_tabling_stats_count;
MR_generate_proc_name_from_layout(proc_layout, &proc_name, &arity,
&is_func);
fprintf(fp, "%8d %4s %s/%d\n", count, (is_func ? "func" : "pred"),
proc_name, arity);
}
}
