mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-11 20:03:28 +00:00
Code Issues Projects Releases Wiki Activity
Files
50daad3ff7bcaa7588c29fc746f04f111af6aa38
mercury/runtime/mercury_tabling.c
Peter Wang 257efbd678 Store double-precision `float' constructor arguments in unboxed form, 
Branches: main

Store double-precision `float' constructor arguments in unboxed form,
in high-level C grades on 32-bit platforms, i.e. `float' (and equivalent)
arguments may occupy two machine words.

As the C code generated by the MLDS back-end makes use of MR_Float variables
and parameters, float (un)boxing may be reduced substantially in many programs.

compiler/prog_data.m:
	Add `double_word' as a new option for constructor argument widths,
	only used for float arguments as yet.

compiler/make_hlds_passes.m:
	Set constructor arguments to have `double_word' width if required,
	and possible.

compiler/type_util.m:
	Add helper predicate.

compiler/builtin_ops.m:
compiler/c_util.m:
compiler/llds.m:
	Add two new binary operators used by the MLDS back-end.

compiler/arg_pack.m:
	Handle `double_word' arguments.

compiler/ml_code_util.m:
	Deciding whether or not a float constructor argument requires boxing
	now depends on the width of the field.

compiler/ml_global_data.m:
	When a float constant appears as an initialiser of a generic array
	element, it is now always unboxed, irrespective of --unboxed-float.

compiler/ml_type_gen.m:
	Take double-word arguments into account when generating structure
	fields.

compiler/ml_unify_gen.m:
	Handle double-word float constructor arguments in (de)constructions.
	In some cases we break a float argument into its two words, so
	generating two assignments statements or two separate rvals.

	Take double-word arguments into account when calculating field offsets.

compiler/mlds_to_c.m:
	The new binary operators require no changes here.

	As a special case, write `MR_float_from_dword_ptr(&X)' instead of
	`MR_float_from_dword(X, Y)' when X, Y are consecutive words within a
	field. The definition of `MR_float_from_dword_ptr' is more
	straightforward, and gcc produces better code than if we use the more
	general `MR_float_from_dword'.

compiler/rtti_out.m:
	For double-word arguments, generate MR_DuArgLocn structures with
	MR_arg_bits set to -1.

compiler/rtti_to_mlds.m:
	Handle double-word arguments in field offset calculation.

compiler/unify_gen.m:
	Partially handle double_word arguments in LLDS back-end.

compiler/handle_options.m:
	Set --unboxed-float when targetting Java, C# and Erlang.

compiler/structure_reuse.direct.choose_reuse.m:
	Rename a predicate.

compiler/bytecode.m:
compiler/equiv_type.m:
compiler/equiv_type_hlds.m:
compiler/llds_to_x86_64.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/opt_debug.m:
	Conform to changes.

library/construct.m:
library/store.m:
	Handle double-word constructor arguments.

runtime/mercury_conf.h.in:
	Clarify what `MR_BOXED_FLOAT' now means.

runtime/mercury_float.h:
	Add helper macros for converting between doubles and word/dwords.

runtime/mercury_deconstruct.c:
runtime/mercury_deconstruct.h:
	Add a macro `MR_arg_value' and a helper function to extract a
	constructor argument value.  This replaces `MR_unpack_arg'.

runtime/mercury_type_info.h:
	Remove `MR_unpack_arg'.

	Document that MR_DuArgLocn.MR_arg_bits may be -1.

runtime/mercury_deconstruct_macros.h:
runtime/mercury_deep_copy_body.h:
runtime/mercury_ml_arg_body.h:
runtime/mercury_table_type_body.h:
runtime/mercury_tabling.c:
runtime/mercury_type_info.c:
	Handle double-word constructor arguments.

tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/hard_coded/lco_double.exp:
tests/hard_coded/lco_double.m:
tests/hard_coded/pack_args_float.exp:
tests/hard_coded/pack_args_float.m:
	Add test cases.

trace/mercury_trace_vars.c:
	Conform to changes.
2011-09-06 05:20:45 +00:00

1608 lines
52 KiB
C
Raw Blame History

/*
** vim: ts=4 sw=4 expandtab
*/
/*
** Copyright (C) 1997-2007, 2011 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
/*
** This module contains the functions related to tabling that are not
** specific to minimal model tabling.
*/
#include "mercury_imp.h"
#include "mercury_type_info.h"
#include "mercury_array_macros.h"
#include "mercury_builtin_types.h"
#include "mercury_deconstruct.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
static void MR_table_assert_failed(const char *file, unsigned line);
#ifdef MR_TABLE_DEBUG
#define MR_table_assert(cond) \
do { \
if (! (cond)) { \
MR_table_assert_failed(__FILE__, __LINE__); \
} \
}
#else
#define MR_table_assert(cond) ((void) 0)
#endif
/*---------------------------------------------------------------------------*/
/*
** This part deals with tabling using resizable hash tables.
*/
/*
** All hash table slot structures have the same fields, since they are
** manipulated by the same macro (MR_GENERIC_HASH_LOOKUP_OR_ADD).
** The variable size part is at the end, in order to make all the offsets
** the same.
*/
typedef struct MR_IntHashTableSlot_Struct MR_IntHashTableSlot;
typedef struct MR_FloatHashTableSlot_Struct MR_FloatHashTableSlot;
typedef struct MR_StringHashTableSlot_Struct MR_StringHashTableSlot;
typedef struct MR_BitmapHashTableSlot_Struct MR_BitmapHashTableSlot;
typedef struct MR_WordHashTableSlot_Struct MR_WordHashTableSlot;
typedef struct MR_AllocRecord_Struct MR_AllocRecord;
struct MR_IntHashTableSlot_Struct {
MR_IntHashTableSlot *next;
MR_TableNode data;
MR_Integer key;
};
struct MR_FloatHashTableSlot_Struct {
MR_FloatHashTableSlot *next;
MR_TableNode data;
MR_Float key;
};
struct MR_StringHashTableSlot_Struct {
MR_StringHashTableSlot *next;
MR_TableNode data;
MR_ConstString key;
};
struct MR_BitmapHashTableSlot_Struct {
MR_BitmapHashTableSlot *next;
MR_TableNode data;
MR_ConstBitmapPtr key;
};
struct MR_WordHashTableSlot_Struct {
MR_WordHashTableSlot *next;
MR_TableNode data;
MR_Word key;
};
typedef union {
MR_IntHashTableSlot *int_slot_ptr;
MR_FloatHashTableSlot *float_slot_ptr;
MR_StringHashTableSlot *string_slot_ptr;
MR_BitmapHashTableSlot *bitmap_slot_ptr;
MR_WordHashTableSlot *word_slot_ptr;
} MR_HashTableSlotPtr;
struct MR_AllocRecord_Struct {
MR_HashTableSlotPtr chunk;
MR_AllocRecord *next;
};
/*
** Our hash table design uses separate chaining to avoid the bad worst case
** behavior of open addressing. This is important, because the worst case
** can be expected to occur reasonably often in tabling workloads. The reason
** is that successive queries are not independent. Often, query N is a
** recursive call made from query N-1, which means that its input values are
** much more likely to fall into the same or next hash bucket than an
** independent query's input values would, especially for integer values.
** Repeated over many queries, such input pattern can give rise to "convoys",
** long sequences of occupied hash table slots. Any input value whose search
** for a free slot runs into the convoy will have very long search time.
**
** The `hash_table' field points to an array of `size' slots, each of which
** is a pointer to a hash table slot; hash table slots have embedded `next'
** pointers to chain together all the values that hash to the same value.
**
** To keep maximum chain lengths bounded (in a statistical sense), we record
** the number of values in the table (in the `value_count' field), and when
** this exceeds a certain fraction of the size of the hash table, we increase
** the size of the hash table and rehash all the existing entries. We do this
** when the value in the `value_count' field exceeds the one in the `threshold'
** field, which is set to `size' times MAX_LOAD_FACTOR whenever the size
** is changed. (This avoids a float multiplication on each insertion.)
**
** The reason why the hash table array contains pointers to slots instead of
** the slots themselves is that the latter would require the addresses of some
** hash table slots (those in the array itself and not in a chain) to change
** when the table is resized. As for why this is bad, see the documentation
** of the MR_TableNode type in mercury_tabling.h.
**
** To avoid calling GC_malloc on each insertion, we allocate memory in chunks,
** with each chunk containing CHUNK_SIZE hash table slots. The `freeleft'
** field contains count of the number of hash table slots left in the space
** allocated but not yet used; the `freespace' field point to the first
** of these slots.
**
** This design leads to pointers into the middle of GC_malloc'd memory.
** To make sure that the code works even without the boehm gc being compiled
** with interior pointers, we retain pointers to all the chunks we have
** allocated in the `allocrecord' field. This field has no purpose other than
** to serve as roots for boehm gc.
*/
struct MR_HashTable_Struct {
MR_Integer size;
MR_Integer threshold;
MR_Integer value_count;
MR_HashTableSlotPtr *hash_table;
MR_HashTableSlotPtr freespace;
MR_Integer freeleft;
MR_AllocRecord *allocrecord;
};
#define CHUNK_SIZE 256
#define MAX_LOAD_FACTOR 0.65
/*
** Prime numbers which are close to powers of 2. Used for choosing
** the next size for a hash table.
*/
#define NUM_OF_PRIMES 16
static MR_Word primes[NUM_OF_PRIMES] = {
127,
257,
509,
1021,
2053,
4099,
8191,
16381,
32771,
65537,
131071,
262147,
524287,
1048573,
2097143,
4194301
};
/* Initial size of a new table */
#define HASH_TABLE_START_SIZE primes[0]
static MR_Integer next_prime(MR_Integer);
/*
** Return the next prime number greater than the number received.
** If no such prime number can be found, compute an approximate one.
*/
static MR_Integer
next_prime(MR_Integer old_size)
{
int i;
i = 0;
while ( (old_size >= primes[i]) && (i < NUM_OF_PRIMES) ) {
i++;
}
if (i < NUM_OF_PRIMES) {
return primes[i];
} else {
return 2 * old_size - 1;
}
}
/*
** The MR_GENERIC_HASH_LOOKUP_OR_ADD macro is intended to be the body of
** a function that looks to see if the given key is in the given hash table.
** If it is, it returns the address of the data pointer associated with
** the key. If it is not, it creates a new slot for the key in the table
** and returns the address of its data pointer.
**
** It in turn relies on three groups of macros to perform part of the task.
**
** The first group optionally records statistics about the number of successful
** and unsuccessful searches, and the number of key comparisons they needed.
** From this information, one can compute the average successful and
** unsuccessful search lengths. These macros are defined and undefined in the
** files mercury_tabling_stats_{defs,nodefs,undefs}.h.
**
** The second optionally prints debugging messages.
**
** The third implements the initial creation of the hash table.
*/
#ifdef MR_TABLE_DEBUG
#define debug_key_msg(keyvalue, keyformat, keycast) \
do { \
if (MR_hashdebug) { \
printf("HT search key " keyformat "\n", \
(keycast) keyvalue); \
} \
} while (0)
#define debug_resize_msg(oldsize, newsize, newthreshold) \
do { \
if (MR_hashdebug) { \
printf("HT expanding table from %d to %d(%d)\n", \
(oldsize), (newsize), (newthreshold)); \
} \
} while (0)
#define debug_rehash_msg(rehash_bucket) \
do { \
if (MR_hashdebug) { \
printf("HT rehashing bucket: %d\n", \
(rehash_bucket)); \
} \
} while (0)
#define debug_key_compare_msg(home_bucket) \
do { \
if (MR_hashdebug) { \
printf("HT comparing keys in bucket: %d\n", \
(home_bucket)); \
} \
} while (0)
#define debug_lookup_msg(home_bucket) \
do { \
if (MR_hashdebug) { \
printf("HT search successful in bucket: %d\n", \
(home_bucket)); \
} \
} while (0)
#define debug_insert_msg(home_bucket) \
do { \
if (MR_hashdebug) { \
printf("HT search unsuccessful in bucket: %d\n", \
(home_bucket)); \
} \
} while (0)
#else
#define debug_key_msg(keyvalue, keyformat, keycast) ((void) 0)
#define debug_resize_msg(oldsize, newsize, newthreshold) ((void) 0)
#define debug_rehash_msg(rehash_bucket) ((void) 0)
#define debug_key_compare_msg(home_bucket) ((void) 0)
#define debug_lookup_msg(home_bucket) ((void) 0)
#define debug_insert_msg(home_bucket) ((void) 0)
#endif
/*
** The MR_GENERIC_HASH_LOOKUP_OR_ADD macro, and its helper macro
** MR_CREATE_HASH_TABLE implement the bodies of the following functions:
**
** MR_int_hash_lookup_or_add
** MR_int_hash_lookup_or_add_stats
** MR_int_hash_lookup
** MR_float_hash_lookup_or_add
** MR_float_hash_lookup_or_add_stats
** MR_float_hash_lookup
** MR_string_hash_lookup_or_add
** MR_string_hash_lookup_or_add_stats
** MR_string_hash_lookup
*/
#define MR_CREATE_HASH_TABLE(table_ptr, table_type, table_field, table_size)\
do { \
MR_Word i; \
MR_HashTable *newtable; \
\
newtable = MR_TABLE_NEW(MR_HashTable); \
\
newtable->size = table_size; \
newtable->threshold = (MR_Integer) \
((float) table_size * MAX_LOAD_FACTOR); \
newtable->value_count = 0; \
newtable->freespace.table_field = NULL; \
newtable->freeleft = 0; \
newtable->allocrecord = NULL; \
newtable->hash_table = MR_TABLE_NEW_ARRAY(MR_HashTableSlotPtr, \
table_size); \
\
for (i = 0; i < table_size; i++) { \
newtable->hash_table[i].table_field = NULL; \
} \
\
table_ptr = newtable; \
} while (0)
MR_TrieNode
MR_int_hash_lookup_or_add(MR_TrieNode t, MR_Integer key)
{
#define key_format "%ld"
#define key_cast long
#define table_type MR_IntHashTableSlot
#define table_field int_slot_ptr
#define hash(key) (key)
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_int_hash_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode t, MR_Integer key)
{
#define key_format "%ld"
#define key_cast long
#define table_type MR_IntHashTableSlot
#define table_field int_slot_ptr
#define hash(key) (key)
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_defs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_int_hash_lookup(MR_TrieNode t, MR_Integer key)
{
#define key_format "%ld"
#define key_cast long
#define table_type MR_IntHashTableSlot
#define table_field int_slot_ptr
#define hash(key) (key)
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_TRUE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
/*
** Note that the equal_keys operation should compare two floats for
** bit-for-bit equality. This is different from the usual == operator
** in the presence of NaNs, infinities, etc.
*/
MR_TrieNode
MR_float_hash_lookup_or_add(MR_TrieNode t, MR_Float key)
{
#define key_format "%f"
#define key_cast double
#define table_type MR_FloatHashTableSlot
#define table_field float_slot_ptr
#define hash(key) (MR_hash_float(key))
#define equal_keys(k1, k2) (memcmp(&(k1), &(k2), sizeof(MR_Float)) == 0)
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_float_hash_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode t, MR_Float key)
{
#define key_format "%f"
#define key_cast double
#define table_type MR_FloatHashTableSlot
#define table_field float_slot_ptr
#define hash(key) (MR_hash_float(key))
#define equal_keys(k1, k2) (memcmp(&(k1), &(k2), sizeof(MR_Float)) == 0)
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_defs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_float_hash_lookup(MR_TrieNode t, MR_Float key)
{
#define key_format "%f"
#define key_cast double
#define table_type MR_FloatHashTableSlot
#define table_field float_slot_ptr
#define hash(key) (MR_hash_float(key))
#define equal_keys(k1, k2) (memcmp(&(k1), &(k2), sizeof(MR_Float)) == 0)
#define lookup_only MR_TRUE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_string_hash_lookup_or_add(MR_TrieNode t, MR_ConstString key)
{
#define key_format "%s"
#define key_cast const char *
#define table_type MR_StringHashTableSlot
#define table_field string_slot_ptr
#define hash(key) (MR_hash_string(key))
#define equal_keys(k1, k2) (MR_strtest((k1), (k2)) == 0)
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_string_hash_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode t, MR_ConstString key)
{
#define key_format "%s"
#define key_cast const char *
#define table_type MR_StringHashTableSlot
#define table_field string_slot_ptr
#define hash(key) (MR_hash_string(key))
#define equal_keys(k1, k2) (MR_strtest((k1), (k2)) == 0)
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_defs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_string_hash_lookup(MR_TrieNode t, MR_ConstString key)
{
#define key_format "%s"
#define key_cast const char *
#define table_type MR_StringHashTableSlot
#define table_field string_slot_ptr
#define hash(key) (MR_hash_string(key))
#define equal_keys(k1, k2) (MR_strtest((k1), (k2)) == 0)
#define lookup_only MR_TRUE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_bitmap_hash_lookup_or_add(MR_TrieNode t, MR_ConstBitmapPtr key)
{
#define key_format "%d"
#define key_cast void *
#define table_type MR_BitmapHashTableSlot
#define table_field bitmap_slot_ptr
#define hash(key) (MR_hash_bitmap(key))
#define equal_keys(k1, k2) (MR_bitmap_cmp((k1), (k2)) == 0)
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_bitmap_hash_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode t, MR_ConstBitmapPtr key)
{
#define key_format "%d"
#define key_cast MR_Word
#define table_type MR_BitmapHashTableSlot
#define table_field bitmap_slot_ptr
#define hash(key) (MR_hash_bitmap(key))
#define equal_keys(k1, k2) (MR_bitmap_cmp((k1), (k2)) == 0)
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_defs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_bitmap_hash_lookup(MR_TrieNode t, MR_ConstBitmapPtr key)
{
#define key_format "%d"
#define key_cast MR_Word
#define table_type MR_BitmapHashTableSlot
#define table_field bitmap_slot_ptr
#define hash(key) (MR_hash_bitmap(key))
#define equal_keys(k1, k2) (MR_bitmap_cmp((k1), (k2)) == 0)
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_word_hash_lookup_or_add(MR_TrieNode t, MR_Word key)
{
#define key_format "%d"
#define key_cast MR_Word
#define table_type MR_WordHashTableSlot
#define table_field word_slot_ptr
#define hash(key) ((long) (key))
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_word_hash_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode t, MR_Word key)
{
#define key_format "%d"
#define key_cast MR_Word
#define table_type MR_WordHashTableSlot
#define table_field word_slot_ptr
#define hash(key) ((long) (key))
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_FALSE
#include "mercury_tabling_stats_defs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
MR_TrieNode
MR_word_hash_lookup(MR_TrieNode t, MR_Word key)
{
#define key_format "%d"
#define key_cast MR_Word
#define table_type MR_WordHashTableSlot
#define table_field word_slot_ptr
#define hash(key) ((long) (key))
#define equal_keys(k1, k2) ((k1) == (k2))
#define lookup_only MR_TRUE
#include "mercury_tabling_stats_nodefs.h"
#include "mercury_hash_lookup_or_add_body.h"
#include "mercury_tabling_stats_undefs.h"
#undef key_format
#undef key_cast
#undef table_type
#undef table_field
#undef hash
#undef equal_keys
#undef lookup_only
}
static int
MR_cmp_ints(const void *p1, const void *p2)
{
MR_Integer i1 = * (MR_Integer *) p1;
MR_Integer i2 = * (MR_Integer *) p2;
if (i1 < i2) {
return -1;
} else if (i1 > i2) {
return 1;
} else {
return 0;
}
}
static int
MR_cmp_floats(const void *p1, const void *p2)
{
MR_Float f1 = * (MR_Float *) p1;
MR_Float f2 = * (MR_Float *) p2;
if (f1 < f2) {
return -1;
} else if (f1 > f2) {
return 1;
} else {
return 0;
}
}
static int
MR_cmp_strings(const void *p1, const void *p2)
{
MR_ConstString s1 = * (MR_ConstString *) p1;
MR_ConstString s2 = * (MR_ConstString *) p2;
return strcmp(s1, s2);
}
static int
MR_cmp_bitmaps(const void *p1, const void *p2)
{
MR_ConstBitmapPtr s1 = * (MR_ConstBitmapPtr *) p1;
MR_ConstBitmapPtr s2 = * (MR_ConstBitmapPtr *) p2;
return MR_bitmap_cmp(s1, s2);
}
/*
** The MR_HASH_CONTENTS_FUNC_BODY macro implements the bodies of the
** following functions:
**
** MR_get_int_hash_table_contents
** MR_get_float_hash_table_contents
** MR_get_string_hash_table_contents
*/
#define MR_INIT_HASH_CONTENTS_ARRAY_SIZE 100
#define MR_HASH_CONTENTS_FUNC_BODY \
MR_bool \
func_name(MR_TrieNode t, type_name **values_ptr, \
int *value_next_ptr) \
{ \
type_name *values; \
int value_next; \
int value_max; \
MR_HashTable *table; \
int bucket; \
table_type *slot; \
\
if (t->MR_hash_table == NULL) { \
return MR_FALSE; \
} \
\
table = t->MR_hash_table; \
values = NULL; \
value_next = 0; \
value_max = 0; \
\
for (bucket = 0; bucket < table->size; bucket++) { \
slot = table->hash_table[bucket].table_field; \
while (slot != NULL) { \
MR_GC_ensure_room_for_next(value, type_name, \
MR_INIT_HASH_CONTENTS_ARRAY_SIZE, \
MR_ALLOC_SITE_TABLING); \
values[value_next] = slot->key; \
value_next++; \
slot = slot->next; \
} \
} \
\
qsort(values, value_next, sizeof(type_name), comp_func); \
*values_ptr = values; \
*value_next_ptr = value_next; \
return MR_TRUE; \
}
#define func_name MR_get_int_hash_table_contents
#define type_name MR_Integer
#define table_type MR_IntHashTableSlot
#define table_field int_slot_ptr
#define comp_func MR_cmp_ints
MR_HASH_CONTENTS_FUNC_BODY
#undef func_name
#undef type_name
#undef table_type
#undef table_field
#undef comp_func
#define func_name MR_get_float_hash_table_contents
#define type_name MR_Float
#define table_type MR_FloatHashTableSlot
#define table_field float_slot_ptr
#define comp_func MR_cmp_floats
MR_HASH_CONTENTS_FUNC_BODY
#undef func_name
#undef type_name
#undef table_type
#undef table_field
#undef comp_func
#define func_name MR_get_string_hash_table_contents
#define type_name MR_ConstString
#define table_type MR_StringHashTableSlot
#define table_field string_slot_ptr
#define comp_func MR_cmp_strings
MR_HASH_CONTENTS_FUNC_BODY
#undef func_name
#undef type_name
#undef table_type
#undef table_field
#undef comp_func
#define func_name MR_get_bitmap_hash_table_contents
#define type_name MR_ConstBitmapPtr
#define table_type MR_BitmapHashTableSlot
#define table_field bitmap_slot_ptr
#define comp_func MR_cmp_bitmaps
MR_HASH_CONTENTS_FUNC_BODY
#undef func_name
#undef type_name
#undef table_type
#undef table_field
#undef comp_func
/*---------------------------------------------------------------------------*/
/*
** This part deals with tabling using fixed size tables simply indexed
** by a given integer. t->MR_fix_table[i] contains the trie node for key i.
**
** The enum and the du_functor versions differ only in what statistics field
** we increment.
*/
MR_TrieNode
MR_int_fix_index_enum_lookup_or_add(MR_TrieNode t, MR_Integer range,
MR_Integer key)
{
#define MR_table_record_fix_alloc(numbytes) ((void) 0)
#include "mercury_table_int_fix_index_body.h"
#undef MR_table_record_fix_alloc
}
MR_TrieNode
MR_int_fix_index_enum_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode t, MR_Integer range, MR_Integer key)
{
#define MR_table_record_fix_alloc(numbytes) \
do { \
stats->MR_tss_enum_num_node_allocs++; \
stats->MR_tss_enum_num_node_alloc_bytes += (numbytes); \
} while(0)
#include "mercury_table_int_fix_index_body.h"
#undef MR_table_record_fix_alloc
}
MR_TrieNode
MR_int_fix_index_du_lookup_or_add(MR_TrieNode t, MR_Integer range,
MR_Integer key)
{
#define MR_table_record_fix_alloc(numbytes) ((void) 0)
#include "mercury_table_int_fix_index_body.h"
#undef MR_table_record_fix_alloc
}
MR_TrieNode
MR_int_fix_index_du_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode t, MR_Integer range, MR_Integer key)
{
#define MR_table_record_fix_alloc(numbytes) \
do { \
stats->MR_tss_du_num_node_allocs++; \
stats->MR_tss_du_num_node_alloc_bytes += (numbytes); \
} while(0)
#include "mercury_table_int_fix_index_body.h"
#undef MR_table_record_fix_alloc
}
/*---------------------------------------------------------------------------*/
/*
** This part deals with tabling using expandable tables simply indexed
** by the given integer minus a given starting point. t->MR_start_table[i+1]
** contains the trie node for key i - start. t->MR_start_table[0] contains
** the number of trienode slots currently allocated for the array; this does
** not include the slot used for the zeroeth element.
*/
#define MR_START_TABLE_INIT_SIZE 1024
MR_TrieNode
MR_int_start_index_lookup_or_add(MR_TrieNode table, MR_Integer start,
MR_Integer key)
{
#define MR_table_record_start_alloc(numbytes) ((void) 0)
#include "mercury_table_int_start_index_body.h"
#undef MR_table_record_start_alloc
}
MR_TrieNode
MR_int_start_index_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode table, MR_Integer start, MR_Integer key)
{
#define MR_table_record_start_alloc(numbytes) \
do { \
stats->MR_tss_start_num_allocs++; \
stats->MR_tss_start_num_alloc_bytes += (numbytes); \
} while(0)
#include "mercury_table_int_start_index_body.h"
#undef MR_table_record_start_alloc
}
/*---------------------------------------------------------------------------*/
MR_TrieNode
MR_type_info_lookup_or_add(MR_TrieNode table, MR_TypeInfo type_info)
{
#define tci_call(n, tci) MR_int_hash_lookup_or_add((n), (tci))
#define rec_call(n, ti) MR_type_info_lookup_or_add((n), (ti))
#include "mercury_table_typeinfo_body.h"
#undef tci_call
#undef rec_call
}
MR_TrieNode
MR_type_info_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode table, MR_TypeInfo type_info)
{
#define tci_call(n, tci) MR_int_hash_lookup_or_add_stats(stats, (n), (tci))
#define rec_call(n, ti) MR_type_info_lookup_or_add_stats(stats, (n), (ti))
#include "mercury_table_typeinfo_body.h"
#undef tci_call
#undef rec_call
}
MR_TrieNode
MR_type_class_info_lookup_or_add(MR_TrieNode table, MR_Word *type_class_info)
{
MR_fatal_error("tabling of typeclass_infos not yet implemented");
return NULL;
}
MR_TrieNode
MR_type_class_info_lookup_or_add_stats(MR_TableStepStats *stats,
MR_TrieNode table, MR_Word *type_class_info)
{
MR_fatal_error("tabling of typeclass_infos not yet implemented");
return NULL;
}
/*---------------------------------------------------------------------------*/
MR_TrieNode
MR_table_type(MR_TrieNode table, MR_TypeInfo type_info, MR_Word data)
{
#define func "MR_table_type"
#define STATS NULL
#define DEBUG MR_FALSE
#define BACK MR_FALSE
#define MR_table_record_exist_lookup() ((void) 0)
#define MR_table_record_arg_lookup() ((void) 0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
#undef MR_table_record_exist_lookup
#undef MR_table_record_arg_lookup
}
MR_TrieNode
MR_table_type_debug(MR_TrieNode table, MR_TypeInfo type_info, MR_Word data)
{
#define func "MR_table_type_debug"
#define STATS NULL
#define DEBUG MR_TRUE
#define BACK MR_FALSE
#define MR_table_record_exist_lookup() ((void) 0)
#define MR_table_record_arg_lookup() ((void) 0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
#undef MR_table_record_exist_lookup
#undef MR_table_record_arg_lookup
}
MR_TrieNode
MR_table_type_stats(MR_TableStepStats *stats, MR_TrieNode table,
MR_TypeInfo type_info, MR_Word data)
{
#define func "MR_table_type_stats"
#define STATS stats
#define DEBUG MR_FALSE
#define BACK MR_FALSE
#define MR_table_record_exist_lookup() \
do { \
stats->MR_tss_du_num_exist_lookups++; \
} while(0)
#define MR_table_record_arg_lookup() \
do { \
stats->MR_tss_du_num_arg_lookups++; \
} while(0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
#undef MR_table_record_exist_lookup
#undef MR_table_record_arg_lookup
}
MR_TrieNode
MR_table_type_stats_debug(MR_TableStepStats *stats, MR_TrieNode table,
MR_TypeInfo type_info, MR_Word data)
{
#define func "MR_table_type_stats_debug"
#define STATS stats
#define DEBUG MR_TRUE
#define BACK MR_FALSE
#define MR_table_record_exist_lookup() \
do { \
stats->MR_tss_du_num_exist_lookups++; \
} while(0)
#define MR_table_record_arg_lookup() \
do { \
stats->MR_tss_du_num_arg_lookups++; \
} while(0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
#undef MR_table_record_exist_lookup
#undef MR_table_record_arg_lookup
}
MR_TrieNode
MR_table_type_back(MR_TrieNode table, MR_TypeInfo type_info, MR_Word data)
{
#define func "MR_table_type"
#define STATS NULL
#define DEBUG MR_FALSE
#define BACK MR_TRUE
#define MR_table_record_exist_lookup() ((void) 0)
#define MR_table_record_arg_lookup() ((void) 0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
#undef MR_table_record_exist_lookup
#undef MR_table_record_arg_lookup
}
MR_TrieNode
MR_table_type_debug_back(MR_TrieNode table, MR_TypeInfo type_info,
MR_Word data)
{
#define func "MR_table_type_debug"
#define STATS NULL
#define DEBUG MR_TRUE
#define BACK MR_TRUE
#define MR_table_record_exist_lookup() ((void) 0)
#define MR_table_record_arg_lookup() ((void) 0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
#undef MR_table_record_exist_lookup
#undef MR_table_record_arg_lookup
}
MR_TrieNode
MR_table_type_stats_back(MR_TableStepStats *stats, MR_TrieNode table,
MR_TypeInfo type_info, MR_Word data)
{
#define func "MR_table_type_stats"
#define STATS stats
#define DEBUG MR_FALSE
#define BACK MR_TRUE
#define MR_table_record_exist_lookup() \
do { \
stats->MR_tss_du_num_exist_lookups++; \
} while(0)
#define MR_table_record_arg_lookup() \
do { \
stats->MR_tss_du_num_arg_lookups++; \
} while(0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
#undef MR_table_record_exist_lookup
#undef MR_table_record_arg_lookup
}
MR_TrieNode
MR_table_type_stats_debug_back(MR_TableStepStats *stats, MR_TrieNode table,
MR_TypeInfo type_info, MR_Word data)
{
#define func "MR_table_type_stats_debug"
#define STATS stats
#define DEBUG MR_TRUE
#define BACK MR_TRUE
#define MR_table_record_exist_lookup() \
do { \
stats->MR_tss_du_num_exist_lookups++; \
} while(0)
#define MR_table_record_arg_lookup() \
do { \
stats->MR_tss_du_num_arg_lookups++; \
} while(0)
#include "mercury_table_type_body.h"
#undef func
#undef STATS
#undef DEBUG
#undef BACK
#undef MR_table_record_exist_lookup
#undef MR_table_record_arg_lookup
}
/*---------------------------------------------------------------------------*/
void
MR_table_report_statistics(FILE *fp)
{
#ifdef MR_USE_MINIMAL_MODEL_STACK_COPY
#ifdef MR_TABLE_STATISTICS
MR_minimal_model_report_stats(fp);
#endif
#endif
#ifdef MR_USE_MINIMAL_MODEL_OWN_STACKS
MR_mm_own_stacks_report_stats(fp);
#endif
}
/*---------------------------------------------------------------------------*/
const char *
MR_loopcheck_status(MR_Unsigned status)
{
switch (status) {
case MR_LOOP_INACTIVE:
return "INACTIVE";
case MR_LOOP_ACTIVE:
return "ACTIVE";
}
return "INVALID";
}
const char *
MR_memo_status(MR_Unsigned status)
{
switch (status) {
case MR_MEMO_INACTIVE:
return "INACTIVE";
case MR_MEMO_ACTIVE:
return "ACTIVE";
case MR_MEMO_SUCCEEDED:
return "SUCCEEDED";
case MR_MEMO_FAILED:
return "FAILED";
default:
return "SUCCESS_BLOCK";
}
return "INVALID";
}
const char *
MR_memo_non_status(MR_MemoNonStatus status)
{
switch (status) {
case MR_MEMO_NON_INACTIVE:
return "INACTIVE";
case MR_MEMO_NON_ACTIVE:
return "ACTIVE";
case MR_MEMO_NON_INCOMPLETE:
return "INCOMPLETE";
case MR_MEMO_NON_COMPLETE:
return "COMPLETE";
}
return "INVALID";
}
void
MR_print_loopcheck_tip(FILE *fp, const MR_ProcLayout *proc, MR_TrieNode table)
{
switch (table->MR_loop_status) {
case MR_LOOP_INACTIVE:
fprintf(fp, "uninitialized\n");
break;
case MR_LOOP_ACTIVE:
fprintf(fp, "working\n");
break;
default:
MR_fatal_error("MR_print_loopcheck: bad status");
}
}
void
MR_print_memo_tip(FILE *fp, const MR_ProcLayout *proc, MR_TrieNode table)
{
switch (table->MR_memo_status) {
case MR_MEMO_INACTIVE:
fprintf(fp, "uninitialized\n");
break;
case MR_MEMO_ACTIVE:
fprintf(fp, "working\n");
break;
case MR_MEMO_FAILED:
fprintf(fp, "failed\n");
break;
case MR_MEMO_SUCCEEDED:
fprintf(fp, "succeeded (no outputs)\n");
break;
default:
fprintf(fp, "succeeded <");
MR_print_answerblock(fp, proc, table->MR_answerblock);
fprintf(fp, ">\n");
break;
}
}
void
MR_print_memo_non_record(FILE *fp, const MR_ProcLayout *proc,
MR_MemoNonRecordPtr record)
{
MR_AnswerList answer_list;
int i;
if (record == NULL) {
fprintf(fp, "inactive\n");
return;
}
switch (record->MR_mn_status) {
case MR_MEMO_NON_INACTIVE:
fprintf(fp, "inactive\n");
return;
case MR_MEMO_NON_ACTIVE:
fprintf(fp, "active\n");
break;
case MR_MEMO_NON_INCOMPLETE:
fprintf(fp, "incomplete\n");
break;
case MR_MEMO_NON_COMPLETE:
fprintf(fp, "complete\n");
break;
default:
MR_fatal_error("MR_print_memo_non_record: bad status");
break;
}
answer_list = record->MR_mn_answer_list;
i = 1;
while (answer_list != NULL) {
fprintf(fp, "answer #%d: <", i);
MR_print_answerblock(fp, proc, answer_list->MR_aln_answer_block);
fprintf(fp, ">\n");
answer_list = answer_list->MR_aln_next_answer;
i++;
}
}
void
MR_print_answerblock(FILE *fp, const MR_ProcLayout *proc,
MR_Word *answer_block)
{
const MR_PseudoTypeInfo *ptis;
MR_PseudoTypeInfo pti;
MR_TypeCtorInfo tci;
int num_inputs;
int num_outputs;
int i;
num_inputs = proc->MR_sle_table_info.MR_table_proc->MR_pt_num_inputs;
num_outputs = proc->MR_sle_table_info.MR_table_proc->MR_pt_num_outputs;
ptis = proc->MR_sle_table_info.MR_table_proc->MR_pt_ptis;
ptis += num_inputs;
for (i = 0; i < num_outputs; i++) {
if (i > 0) {
fprintf(fp, ", ");
}
pti = ptis[i];
if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pti)) {
fprintf(fp, "poly");
continue;
}
tci = MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(pti);
if (tci == &MR_TYPE_CTOR_INFO_NAME(builtin, int, 0)) {
fprintf(fp, "%ld", (long) answer_block[i]);
} else if (tci == &MR_TYPE_CTOR_INFO_NAME(builtin, float, 0)) {
fprintf(fp, "%f",
#ifdef MR_HIGHLEVEL_CODE
(double) MR_unbox_float((MR_Box) answer_block[i]));
#else
(double) MR_word_to_float(answer_block[i]));
#endif
} else if (tci == &MR_TYPE_CTOR_INFO_NAME(builtin, string, 0)) {
fprintf(fp, "\"%s\"", (char *) answer_block[i]);
} else {
fprintf(fp, "value of unsupported type");
}
}
}
#ifdef MR_HIGHLEVEL_CODE
#ifdef MR_USE_GCC_NESTED_FUNCTIONS
static void MR_CALL
mercury__table_builtin__table_memo_return_all_answers_2_p_0(
MR_AnswerList answer_list0, MR_Box *boxed_answer_block,
MR_NestedCont cont);
static void MR_CALL
mercury__table_builtin__table_memo_return_all_answers_2_p_0(
MR_AnswerList answer_list0, MR_Box *boxed_answer_block_ptr,
MR_NestedCont cont)
{
MR_AnswerList answer_list;
while (answer_list0 != NULL) {
answer_list = answer_list0->MR_aln_next_answer;
*boxed_answer_block_ptr =
(MR_Box) answer_list0->MR_aln_answer_block;
cont();
answer_list0 = answer_list;
}
}
void MR_CALL
mercury__table_builtin__table_memo_return_all_answers_multi_2_p_0(
MR_Box boxed_record, MR_Box *boxed_answer_block_ptr,
MR_NestedCont cont)
{
MR_MemoNonRecordPtr record;
MR_AnswerList list;
record = (MR_MemoNonRecordPtr) boxed_record;
list = record->MR_mn_answer_list;
if (list == NULL) {
MR_fatal_error(
"table_memo_return_all_answers_multi: no answers");
}
mercury__table_builtin__table_memo_return_all_answers_2_p_0(list,
boxed_answer_block_ptr, cont);
}
void MR_CALL
mercury__table_builtin__table_memo_return_all_answers_nondet_2_p_0(
MR_Box boxed_record, MR_Box *boxed_answer_block_ptr,
MR_NestedCont cont)
{
MR_MemoNonRecordPtr record;
MR_AnswerList list;
record = (MR_MemoNonRecordPtr) boxed_record;
list = record->MR_mn_answer_list;
mercury__table_builtin__table_memo_return_all_answers_2_p_0(list,
boxed_answer_block_ptr, cont);
}
#else /* ! MR_USE_GCC_NESTED_FUNCTIONS */
static void MR_CALL
mercury__table_builtin__table_memo_return_all_answers_2_p_0(
MR_AnswerList answer_list0, MR_Box *boxed_answer_block,
MR_Cont cont, void *cont_env_ptr);
static void MR_CALL
mercury__table_builtin__table_memo_return_all_answers_2_p_0(
MR_AnswerList answer_list0, MR_Box *boxed_answer_block_ptr,
MR_Cont cont, void *cont_env_ptr)
{
MR_AnswerList answer_list;
while (answer_list0 != NULL) {
answer_list = answer_list0->MR_aln_next_answer;
*boxed_answer_block_ptr =
(MR_Box) answer_list0->MR_aln_answer_block;
cont(cont_env_ptr);
answer_list0 = answer_list;
}
}
void MR_CALL
mercury__table_builtin__table_memo_return_all_answers_multi_2_p_0(
MR_Box boxed_record, MR_Box *boxed_answer_block_ptr,
MR_Cont cont, void *cont_env_ptr)
{
MR_MemoNonRecordPtr record;
MR_AnswerList list;
record = (MR_MemoNonRecordPtr) boxed_record;
list = record->MR_mn_answer_list;
if (list == NULL) {
MR_fatal_error(
"table_memo_return_all_answers_multi: no answers");
}
mercury__table_builtin__table_memo_return_all_answers_2_p_0(list,
boxed_answer_block_ptr, cont, cont_env_ptr);
}
void MR_CALL
mercury__table_builtin__table_memo_return_all_answers_nondet_2_p_0(
MR_Box boxed_record, MR_Box *boxed_answer_block_ptr,
MR_Cont cont, void *cont_env_ptr)
{
MR_MemoNonRecordPtr record;
MR_AnswerList list;
record = (MR_MemoNonRecordPtr) boxed_record;
list = record->MR_mn_answer_list;
mercury__table_builtin__table_memo_return_all_answers_2_p_0(list,
boxed_answer_block_ptr, cont, cont_env_ptr);
}
#endif /* MR_USE_GCC_NESTED_FUNCTIONS */
#else /* MR_HIGHLEVEL_CODE */
MR_define_extern_entry(MR_MEMO_NON_RET_ALL_NONDET_ENTRY);
MR_define_extern_entry(MR_MEMO_NON_RET_ALL_MULTI_ENTRY);
MR_EXTERN_USER_PROC_ID_PROC_LAYOUT(MR_DETISM_NON, 0, -1,
MR_PREDICATE, table_builtin, table_memo_return_all_answers_nondet, 2, 0);
MR_EXTERN_USER_PROC_ID_PROC_LAYOUT(MR_DETISM_NON, 0, -1,
MR_PREDICATE, table_builtin, table_memo_return_all_answers_multi, 2, 0);
#define MEMO_NON_RET_ALL_NONDET_LABEL(name) \
MR_label_name(MR_MEMO_NON_RET_ALL_NONDET_ENTRY, name)
#define MEMO_NON_RET_ALL_MULTI_LABEL(name) \
MR_label_name(MR_MEMO_NON_RET_ALL_MULTI_ENTRY, name)
MR_declare_label(MEMO_NON_RET_ALL_NONDET_LABEL(Next));
MR_declare_label(MEMO_NON_RET_ALL_MULTI_LABEL(Next));
MR_MAKE_USER_INTERNAL_LAYOUT(table_builtin,
table_memo_return_all_answers_nondet, 2, 0, Next);
MR_MAKE_USER_INTERNAL_LAYOUT(table_builtin,
table_memo_return_all_answers_multi, 2, 0, Next);
MR_BEGIN_MODULE(table_memo_non_module)
MR_init_entry_sl(MR_MEMO_NON_RET_ALL_NONDET_ENTRY);
MR_init_label_sl(MEMO_NON_RET_ALL_NONDET_LABEL(Next));
MR_init_entry_sl(MR_MEMO_NON_RET_ALL_MULTI_ENTRY);
MR_init_label_sl(MEMO_NON_RET_ALL_MULTI_LABEL(Next));
MR_BEGIN_CODE
MR_define_entry(MR_MEMO_NON_RET_ALL_NONDET_ENTRY);
{
MR_MemoNonRecordPtr record;
MR_AnswerList cur_node0;
MR_AnswerList cur_node;
MR_AnswerBlock answer_block;
record = (MR_MemoNonRecordPtr) MR_r1;
cur_node0 = record->MR_mn_answer_list;
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
printf("picking up all answers in %p -> %p\n",
record->MR_mn_back_ptr, record);
}
#endif
if (cur_node0 == NULL) {
MR_redo();
}
answer_block = cur_node0->MR_aln_answer_block;
cur_node = cur_node0->MR_aln_next_answer;
/* Consider not creating the stack frame if cur_node is NULL. */
MR_mkframe("pred table_builtin.table_memo_return_all_answers_nondet/2-0",
1, MR_LABEL(MEMO_NON_RET_ALL_NONDET_LABEL(Next)));
MR_framevar(1) = (MR_Word) cur_node;
MR_r1 = (MR_Word) answer_block;
}
MR_succeed();
MR_define_label(MEMO_NON_RET_ALL_NONDET_LABEL(Next));
{
MR_AnswerList cur_node0;
MR_AnswerList cur_node;
MR_AnswerBlock answer_block;
cur_node0 = (MR_AnswerList) MR_framevar(1);
if (cur_node0 == NULL) {
MR_fail();
}
answer_block = cur_node0->MR_aln_answer_block;
cur_node = cur_node0->MR_aln_next_answer;
MR_framevar(1) = (MR_Word) cur_node;
MR_r1 = (MR_Word) answer_block;
}
MR_succeed();
MR_define_entry(MR_MEMO_NON_RET_ALL_MULTI_ENTRY);
{
MR_MemoNonRecordPtr record;
MR_AnswerList cur_node0;
MR_AnswerList cur_node;
MR_AnswerBlock answer_block;
record = (MR_MemoNonRecordPtr) MR_r1;
cur_node0 = record->MR_mn_answer_list;
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
printf("picking up all answers in %p -> %p\n",
record->MR_mn_back_ptr, record);
}
#endif
if (cur_node0 == NULL) {
MR_fatal_error("table_memo_return_all_answers_multi: no answers");
}
answer_block = cur_node0->MR_aln_answer_block;
cur_node = cur_node0->MR_aln_next_answer;
/* Consider not creating the stack frame if cur_node is NULL. */
MR_mkframe("pred table_builtin.table_memo_return_all_answers_multi/2-0",
1, MR_LABEL(MEMO_NON_RET_ALL_MULTI_LABEL(Next)));
MR_framevar(1) = (MR_Word) cur_node;
MR_r1 = (MR_Word) answer_block;
}
MR_succeed();
MR_define_label(MEMO_NON_RET_ALL_MULTI_LABEL(Next));
{
MR_AnswerList cur_node0;
MR_AnswerList cur_node;
MR_AnswerBlock answer_block;
cur_node0 = (MR_AnswerList) MR_framevar(1);
if (cur_node0 == NULL) {
MR_fail();
}
answer_block = cur_node0->MR_aln_answer_block;
cur_node = cur_node0->MR_aln_next_answer;
MR_framevar(1) = (MR_Word) cur_node;
MR_r1 = (MR_Word) answer_block;
}
MR_succeed();
MR_END_MODULE
#endif /* MR_HIGHLEVEL_CODE */
/* Ensure that the initialization code for the above modules gets to run. */
/*
INIT mercury_sys_init_table_modules
*/
MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc table_memo_non_module;
/* forward declarations to suppress gcc -Wmissing-decl warnings */
void mercury_sys_init_table_modules_init(void);
void mercury_sys_init_table_modules_init_type_tables(void);
#ifdef MR_DEEP_PROFILING
void mercury_sys_init_table_modules_write_out_proc_statics(FILE *fp);
#endif
void mercury_sys_init_table_modules_init(void)
{
#ifndef MR_HIGHLEVEL_CODE
table_memo_non_module();
#endif /* MR_HIGHLEVEL_CODE */
}
void mercury_sys_init_table_modules_init_type_tables(void)
{
/* no types to register */
}
#ifdef MR_DEEP_PROFILING
void mercury_sys_init_table_modules_write_out_proc_statics(FILE *fp)
{
/* no proc_statics to write out */
/* XXX we need to fix the deep profiling */
/* of model_non memo tabled predicates */
}
#endif
/*---------------------------------------------------------------------------*/
static void
MR_table_assert_failed(const char *file, unsigned line)
{
char buf[256];
snprintf(buf, 256, "assertion failed: file %s, line %d", file, line);
MR_fatal_error(buf);
}
/*---------------------------------------------------------------------------*/
Reference in New Issue View Git Blame Copy Permalink