[m-dev.] for review: cleanup of tabling
Zoltan Somogyi
zs at cs.mu.OZ.AU
Tue Dec 28 18:31:07 AEDT 1999
For review by anyone.
A major cleanup of the internals of tabling.
Tabling builds up two kinds of tables, both conceptually tries. For call
tables, there is one layer in the trie for each input argument; for answer
tables, there is one layer in the trie for each output argument. However,
the way each trie node is implemented depends on the type of the relevant
argument. In addition, what is stored at the tips of the call and answer tables
also depends on what kind of tabling (e.g. loopcheck, memo, minimal model)
is being performed on the current predicate, and (in some cases) on what
stage the execution of the current predicate has reached.
Previously, all trie nodes were declared with the C type Word **, and were
cast to their actual types at the point of use, with the casts mostly being
hidden inside macros. This arrangement lacked readability and was highly
error prone. I have replaced it with a system in which trie nodes are declared
with a C type which is a pointer to a union of all the possible actual types.
There are very few casts left in the internals of the tabling system; this
change replaces them with casts at the interface (in the predicates of
private_builtin.m) and the use of the various fields of the union.
library/private_builtin.m:
Changes to conform to the changed types in mercury_tabling.h.
In some cases, improve the debugging support.
runtime/mercury_tabling.h:
Define the new types.
Add macros for allocating memory for holding one or more structures.
Make the existing macros call the versions that check for malloc
returning NULL.
runtime/mercury_tabling_macros.h:
This new file contains macros that used to be part of the file
mercury_tabling.h. The macros call the functions defined in
mercury_tabling.c, but they also optionally print debugging messages.
runtime/Mmakefile:
Add mercury_tabling_macros.h to the list of header files.
runtime/mercury_tabling.c:
Conform to the new system of C types.
Recode the hash table routines, to achieve two performance benefits.
1. The old code represented a hash table with a variable sized struct,
because the last field was a variable sized array. This required
the use of casts all over the place. The new code makes the last
field a pointer to an array, not the array itself. This adds an
extra indirection, which we immediately gain back by making the
array elements into structures, not pointers to structures.
The cost is somewhat higher apparent memory consumption,
because for a table of size N with a load factor LF, we always
have N three-word structures allocated, instead of N one word
pointers and N*LF two-word structures. However, the actual
memory consumption should actually be smaller, since all the
structures are in an array, thus sharing the boehm_gc overhead,
which the old system did not do. The big payoff is that we do not
need to call GC_malloc whenever we add an item to a hash table.
2. In order to check whether the hash table should be expanded, the
old code was executing a float multiplication and a float comparison
on every hash table access. The new code executes the float
multiplication only when the table size is changed; in the usual
case it only executes an integer comparison, which is much cheaper.
Recode the routines for tabling typeinfos for higher speed. Instead
of storing them in a binary search tree, which requires lots of
comparisons, store the address of the type_ctor_info in a hash table
and chain its argument typeinfos from that.
Add support for expandable tables, which are implemented as arrays
indexed by key - start. This is not used yet, but will be used for
I/O tabling soon.
runtime/mercury_stacks.c:
Conform to the new system of C types for tabling.
Improve the debugging support.
runtime/mercury_wrapper.c:
When debugging tabling, set stdout to be line buffered.
runtime/mercury_trace_base.c:
Disable the generation of nuisance debugging messages from Mercury
initialization code called before main, which may have been compiled
with MR_TABLE_DEBUG enabled.
trace/mercury_trace_internal.c:
Disable the generation of nuisance debugging messages from Mercury
code called by the debugger that may have been compiled with
MR_TABLE_DEBUG enabled, by turning off MR_tabledebug when MR_trace
is entered. We then turn MR_tabledebug back on (even if it wasn't
turned on in the first place) when executing debugger commands
that require it to be turned on in order to work.
tests/tabling/fib.m:
Improve the (commented out) debugging support. Start the search
for the right problem size closer to its probable end point.
tests/tabling/ffib.{m,exp}:
New test case to test the low-level routines for tabling floats;
float version of fib.
tests/tabling/ffib.{m,exp}:
tests/tabling/Mmakefile:
Enable ffib.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing library
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.35
diff -u -b -r1.35 private_builtin.m
--- library/private_builtin.m 1999/12/15 04:14:07 1.35
+++ library/private_builtin.m 1999/12/28 04:51:38
@@ -698,91 +698,131 @@
:- implementation.
:- pragma c_code(table_simple_is_complete(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""checking if %p is succeeded or failed: %lu\\n"",
- (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+ printf(""checking if simple %p is complete: %ld\\n"",
+ table, (long) table->MR_simpletable_status);
}
#endif
SUCCESS_INDICATOR =
- ((*((Unsigned *) T) == MR_SIMPLETABLE_FAILED)
- || (*((Unsigned *) T) >= MR_SIMPLETABLE_SUCCEEDED));
+ ((table->MR_simpletable_status == MR_SIMPLETABLE_FAILED)
+ || (table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED));
").
:- pragma c_code(table_simple_has_succeeded(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""checking if %p is succeeded: %lu\\n"",
- (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+ printf(""checking if simple %p is succeeded: %ld\\n"",
+ table, (long) table->MR_simpletable_status);
}
#endif
- SUCCESS_INDICATOR = (*((Unsigned *) T) >= MR_SIMPLETABLE_SUCCEEDED)
+ SUCCESS_INDICATOR =
+ (table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED);
").
:- pragma c_code(table_simple_has_failed(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""checking if %p is failed: %lu\\n"",
- (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+ printf(""checking if simple %p is failed: %ld\\n"",
+ table, (long) table->MR_simpletable_status);
}
#endif
- SUCCESS_INDICATOR = (*((Unsigned *) T) == MR_SIMPLETABLE_FAILED);
+ SUCCESS_INDICATOR =
+ (table->MR_simpletable_status == MR_SIMPLETABLE_FAILED);
").
:- pragma c_code(table_simple_is_active(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""checking if %p is active: %lu\\n"",
- (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+ printf(""checking if simple %p is active: %ld\\n"",
+ table, (long) table->MR_simpletable_status);
}
#endif
- SUCCESS_INDICATOR = (*((Unsigned *) T) == MR_SIMPLETABLE_WORKING);
+ SUCCESS_INDICATOR =
+ (table->MR_simpletable_status == MR_SIMPLETABLE_WORKING);
").
:- pragma c_code(table_simple_is_inactive(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""checking if %p is not inactive: %lu\\n"",
- (Unsigned *) T, (unsigned long) (*((Unsigned *) T)));
+ printf(""checking if simple %p is inactive: %ld\\n"",
+ table, (long) table->MR_simpletable_status);
}
#endif
- SUCCESS_INDICATOR = (*((Unsigned *) T) != MR_SIMPLETABLE_WORKING);
+ SUCCESS_INDICATOR =
+ (table->MR_simpletable_status != MR_SIMPLETABLE_WORKING);
").
:- pragma c_code(table_simple_mark_as_succeeded(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""marking %p as succeeded\\n"", (Unsigned *) T);
+ printf(""marking %p as succeeded\\n"", table);
}
#endif
- *((Unsigned *) T) = MR_SIMPLETABLE_SUCCEEDED;
+ table->MR_simpletable_status = MR_SIMPLETABLE_SUCCEEDED;
").
:- pragma c_code(table_simple_mark_as_failed(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""marking %p as failed\\n"", (Unsigned *) T);
+ printf(""marking %p as failed\\n"", table);
}
#endif
- *((Unsigned *) T) = MR_SIMPLETABLE_FAILED;
+ table->MR_simpletable_status = MR_SIMPLETABLE_FAILED;
").
:- pragma c_code(table_simple_mark_as_active(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""marking %p as working\\n"", (Unsigned *) T);
+ printf(""marking %p as working\\n"", table);
}
#endif
- *((Unsigned *) T) = MR_SIMPLETABLE_WORKING;
+ table->MR_simpletable_status = MR_SIMPLETABLE_WORKING;
").
:- pragma c_code(table_simple_mark_as_inactive(T::in), will_not_call_mercury, "
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""marking %p as uninitialized\\n"", (Unsigned *) T);
+ printf(""marking %p as uninitialized\\n"", table);
}
#endif
- *((Unsigned *) T) = MR_SIMPLETABLE_UNINITIALIZED;
+ table->MR_simpletable_status = MR_SIMPLETABLE_UNINITIALIZED;
").
%-----------------------------------------------------------------------------%
@@ -849,10 +889,16 @@
:- implementation.
:- pragma c_code(table_nondet_setup(T0::in, T::out), will_not_call_mercury, "
-#ifdef MR_USE_MINIMAL_MODEL
+#ifndef MR_USE_MINIMAL_MODEL
+ fatal_error(""minimal model code entered when not enabled"");
+#else
#ifdef MR_THREAD_SAFE
#error ""Sorry, not yet implemented: mixing minimal model tabling and threads""
#endif
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T0;
+
/*
** Initialize the subgoal if this is the first time we see it.
** If the subgoal structure already exists but is marked inactive,
@@ -861,20 +907,16 @@
** In that case, we want to forget all about the old generator.
*/
- if (MR_SUBGOAL(T0) == NULL) {
+ if (table->MR_subgoal == NULL) {
MR_Subgoal *subgoal;
- subgoal = (MR_Subgoal *)
- table_allocate_bytes(sizeof(MR_Subgoal));
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""setting up table %p -> %p\\n"",
- (MR_Subgoal **) T0, subgoal);
- }
-#endif
+ subgoal = MR_table_allocate(MR_Subgoal);
+ table->MR_subgoal = subgoal;
+
subgoal->status = MR_SUBGOAL_INACTIVE;
subgoal->leader = NULL;
- subgoal->followers = MR_GC_NEW(struct MR_SubgoalListNode);
+ subgoal->followers = MR_table_allocate(struct
+ MR_SubgoalListNode);
subgoal->followers->item = subgoal;
subgoal->followers->next = NULL;
subgoal->followers_tail = &(subgoal->followers->next);
@@ -884,18 +926,22 @@
subgoal->answer_list_tail = &subgoal->answer_list;
subgoal->consumer_list = NULL;
subgoal->consumer_list_tail = &subgoal->consumer_list;
+
#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""setting up table %p -> %p, answer slot %p\\n"",
+ table, subgoal, subgoal->answer_list_tail);
+ }
+
if (MR_maxfr != MR_curfr) {
fatal_error(""MR_maxfr != MR_curfr at table setup\\n"");
}
#endif
+
subgoal->generator_maxfr = MR_prevfr_slot(MR_maxfr);
subgoal->generator_sp = MR_sp;
- MR_SUBGOAL(T0) = subgoal;
}
T = T0;
-#else
- fatal_error(""minimal model code entered when not enabled"");
#endif
").
@@ -906,7 +952,11 @@
:- pragma c_code(table_nondet_is_complete(T::in),"
#ifdef MR_USE_MINIMAL_MODEL
- SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_COMPLETE);
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+ SUCCESS_INDICATOR = (table->MR_subgoal->status == MR_SUBGOAL_COMPLETE);
#else
fatal_error(""minimal model code entered when not enabled"");
#endif
@@ -914,7 +964,11 @@
:- pragma c_code(table_nondet_is_active(T::in), will_not_call_mercury, "
#ifdef MR_USE_MINIMAL_MODEL
- SUCCESS_INDICATOR = (MR_SUBGOAL(T)->status == MR_SUBGOAL_ACTIVE);
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+ SUCCESS_INDICATOR = (table->MR_subgoal->status == MR_SUBGOAL_ACTIVE);
#else
fatal_error(""minimal model code entered when not enabled"");
#endif
@@ -922,9 +976,13 @@
:- pragma c_code(table_nondet_mark_as_active(T::in), will_not_call_mercury, "
#ifdef MR_USE_MINIMAL_MODEL
- MR_push_generator(MR_curfr, MR_SUBGOAL(T));
- MR_register_generator_ptr((MR_Subgoal **) T);
- MR_SUBGOAL(T)->status = MR_SUBGOAL_ACTIVE;
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+ MR_push_generator(MR_curfr, table);
+ MR_register_generator_ptr(table);
+ table->MR_subgoal->status = MR_SUBGOAL_ACTIVE;
#else
fatal_error(""minimal model code entered when not enabled"");
#endif
@@ -933,7 +991,11 @@
:- pragma c_code(table_nondet_get_ans_table(T::in, AT::out),
will_not_call_mercury, "
#ifdef MR_USE_MINIMAL_MODEL
- AT = (Word) &(MR_SUBGOAL(T)->answer_table);
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+
+ AT = (Word) &(table->MR_subgoal->answer_table);
#else
fatal_error(""minimal model code entered when not enabled"");
#endif
@@ -941,38 +1003,40 @@
:- pragma c_code(table_nondet_answer_is_not_duplicate(T::in),
will_not_call_mercury, "
-#ifdef MR_USE_MINIMAL_MODEL
+#ifndef MR_USE_MINIMAL_MODEL
+ fatal_error(""minimal model code entered when not enabled"");
+#else
+ MR_TrieNode table;
bool is_new_answer;
+ table = (MR_TrieNode) T;
+
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
- printf(""checking if %p is a duplicate answer: %d\\n"",
- (Word *) T, *((Word *) T));
+ printf(""checking if %p is a duplicate answer: %ld\\n"",
+ table, (long) table->MR_integer);
}
#endif
- is_new_answer = (*((Word *) T) == MR_ANS_NOT_GENERATED);
- *((Word *) T) = MR_ANS_GENERATED;
+
+ is_new_answer = (table->MR_integer == 0);
+ table->MR_integer = 1; /* any nonzero value will do */
SUCCESS_INDICATOR = is_new_answer;
-#else
- fatal_error(""minimal model code entered when not enabled"");
#endif
").
:- pragma c_code(table_nondet_new_ans_slot(T::in, Slot::out),
will_not_call_mercury, "
-#ifdef MR_USE_MINIMAL_MODEL
- MR_Subgoal *table;
+#ifndef MR_USE_MINIMAL_MODEL
+ fatal_error(""minimal model code entered when not enabled"");
+#else
+ MR_TrieNode table;
+ MR_Subgoal *subgoal;
MR_AnswerListNode *answer_node;
- table = MR_SUBGOAL(T);
- table->num_ans += 1;
+ table = (MR_TrieNode) T;
+ subgoal = table->MR_subgoal;
+ subgoal->num_ans += 1;
-#ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""new answer slot %d, storing into addr %p\\n"",
- table->num_ans, table->answer_list_tail);
- }
-#endif
/*
**
** We fill in the answer_data slot with a dummy value.
@@ -980,17 +1044,23 @@
** to be executed after we return, which is why we return its address.
*/
- answer_node = table_allocate_bytes(sizeof(MR_AnswerListNode));
- answer_node->answer_num = table->num_ans;
- answer_node->answer_data = 0;
+ answer_node = MR_table_allocate(MR_AnswerListNode);
+ answer_node->answer_num = subgoal->num_ans;
+ answer_node->answer_data.MR_integer = 0;
answer_node->next_answer = NULL;
- *(table->answer_list_tail) = answer_node;
- table->answer_list_tail = &(answer_node->next_answer);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""new answer slot %d at %p(%p), storing into %p\\n"",
+ subgoal->num_ans, answer_node,
+ &answer_node->answer_data, subgoal->answer_list_tail);
+ }
+#endif
+
+ *(subgoal->answer_list_tail) = answer_node;
+ subgoal->answer_list_tail = &(answer_node->next_answer);
Slot = (Word) &(answer_node->answer_data);
-#else
- fatal_error(""minimal model code entered when not enabled"");
#endif
").
@@ -1006,7 +1076,17 @@
"),
first_code("
#ifdef MR_USE_MINIMAL_MODEL
- LOCALS->cur_node = MR_SUBGOAL(T)->answer_list;
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ LOCALS->cur_node = table->MR_subgoal->answer_list;
+
+ #ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""restoring all answers in %p -> %p\\n"",
+ table, table->MR_subgoal);
+ }
+ #endif
#endif
"),
retry_code("
@@ -1016,7 +1096,7 @@
if (LOCALS->cur_node == NULL) {
FAIL;
} else {
- A = LOCALS->cur_node->answer_data;
+ A = (Word) &LOCALS->cur_node->answer_data;
LOCALS->cur_node = LOCALS->cur_node->next_answer;
SUCCEED;
}
@@ -1131,98 +1211,161 @@
:- pragma c_code(table_lookup_insert_int(T0::in, I::in, T::out),
will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_INT(T, T0, I);
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_INT(table, table0, (Integer) I);
+ T = (Word) table;
").
:- pragma c_code(table_lookup_insert_char(T0::in, C::in, T::out),
will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_CHAR(T, T0, C);
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_CHAR(table, table0, (Integer) C);
+ T = (Word) table;
").
:- pragma c_code(table_lookup_insert_string(T0::in, S::in, T::out),
will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_STRING(T, T0, S);
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_STRING(table, table0, (String) S);
+ T = (Word) table;
").
:- pragma c_code(table_lookup_insert_float(T0::in, F::in, T::out),
will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_FLOAT(T, T0, F);
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ /* should avoid the allocation if floats are boxed */
+ MR_DEBUG_NEW_TABLE_FLOAT(table, table0, float_to_word(F));
+ T = (Word) table;
").
:- pragma c_code(table_lookup_insert_enum(T0::in, R::in, V::in, T::out),
will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_ENUM(T, T0, R, V);
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_ENUM(table, table0, R, V);
+ T = (Word) table;
").
:- pragma c_code(table_lookup_insert_user(T0::in, V::in, T::out),
will_not_call_mercury, "
- MR_DEBUG_NEW_TABLE_ANY(T, T0, TypeInfo_for_T, V);
+ MR_TrieNode table0, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_ANY(table, table0, (Word *) TypeInfo_for_T, V);
+ T = (Word) table;
").
:- pragma c_code(table_lookup_insert_poly(T0::in, V::in, T::out),
will_not_call_mercury, "
- Word T1;
- MR_DEBUG_NEW_TABLE_TYPEINFO(T1, T0, TypeInfo_for_T);
- MR_DEBUG_NEW_TABLE_ANY(T, T1, TypeInfo_for_T, V);
+ MR_TrieNode table0, table1, table;
+
+ table0 = (MR_TrieNode) T0;
+ MR_DEBUG_NEW_TABLE_TYPEINFO(table1, table0, (Word *) TypeInfo_for_T);
+ MR_DEBUG_NEW_TABLE_ANY(table, table1, (Word *) TypeInfo_for_T, V);
+ T = (Word) table;
").
:- pragma c_code(table_save_int_ans(T::in, Offset::in, I::in),
will_not_call_mercury, "
- MR_TABLE_SAVE_ANSWER(Offset, T, I,
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ MR_TABLE_SAVE_ANSWER(table, Offset, I,
mercury_data___type_ctor_info_int_0);
").
:- pragma c_code(table_save_char_ans(T::in, Offset::in, C::in),
will_not_call_mercury, "
- MR_TABLE_SAVE_ANSWER(Offset, T, C,
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ MR_TABLE_SAVE_ANSWER(table, Offset, C,
mercury_data___type_ctor_info_character_0);
").
:- pragma c_code(table_save_string_ans(T::in, Offset::in, S::in),
will_not_call_mercury, "
- MR_TABLE_SAVE_ANSWER(Offset, T, (Word) S,
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ MR_TABLE_SAVE_ANSWER(table, Offset, (Word) S,
mercury_data___type_ctor_info_string_0);
").
:- pragma c_code(table_save_float_ans(T::in, Offset::in, F::in),
will_not_call_mercury, "
- MR_TABLE_SAVE_ANSWER(Offset, T, float_to_word(F),
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ /* XXX F vs float_to_word(F) */
+ MR_TABLE_SAVE_ANSWER(table, Offset, F,
mercury_data___type_ctor_info_float_0);
").
:- pragma c_code(table_save_any_ans(T::in, Offset::in, V::in),
will_not_call_mercury, "
- MR_TABLE_SAVE_ANSWER(Offset, T, V, TypeInfo_for_T);
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ MR_TABLE_SAVE_ANSWER(table, Offset, V, TypeInfo_for_T);
").
:- pragma c_code(table_restore_int_ans(T::in, Offset::in, I::out),
will_not_call_mercury, "
- I = (Integer) MR_TABLE_GET_ANSWER(Offset, T);
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ I = (Integer) MR_TABLE_GET_ANSWER(table, Offset);
").
:- pragma c_code(table_restore_char_ans(T::in, Offset::in, C::out),
will_not_call_mercury, "
- C = (Char) MR_TABLE_GET_ANSWER(Offset, T);
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ C = (Char) MR_TABLE_GET_ANSWER(table, Offset);
").
:- pragma c_code(table_restore_string_ans(T::in, Offset::in, S::out),
will_not_call_mercury, "
- S = (String) MR_TABLE_GET_ANSWER(Offset, T);
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ S = (String) MR_TABLE_GET_ANSWER(table, Offset);
").
:- pragma c_code(table_restore_float_ans(T::in, Offset::in, F::out),
will_not_call_mercury, "
- F = word_to_float(MR_TABLE_GET_ANSWER(Offset, T));
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ /* XXX F = word_to_float(MR_TABLE_GET_ANSWER(table, Offset)); */
+ F = MR_TABLE_GET_ANSWER(table, Offset);
").
:- pragma c_code(table_restore_any_ans(T::in, Offset::in, V::out),
will_not_call_mercury, "
- V = (Word) MR_TABLE_GET_ANSWER(Offset, T);
+ MR_TrieNode table;
+
+ table = (MR_TrieNode) T;
+ V = (Word) MR_TABLE_GET_ANSWER(table, Offset);
").
:- pragma c_code(table_create_ans_block(T0::in, Size::in, T::out),
will_not_call_mercury, "
- MR_TABLE_CREATE_ANSWER_BLOCK(T0, Size);
+ MR_TrieNode table0;
+
+ table0 = (MR_TrieNode) T0;
+ MR_TABLE_CREATE_ANSWER_BLOCK(table0, Size);
T = T0;
").
cvs diff: Diffing profiler
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.49
diff -u -b -r1.49 Mmakefile
--- runtime/Mmakefile 1999/09/16 04:46:28 1.49
+++ runtime/Mmakefile 1999/12/25 04:07:54
@@ -71,6 +71,7 @@
mercury_stacks.h \
mercury_string.h \
mercury_tabling.h \
+ mercury_tabling_macros.h \
mercury_tags.h \
mercury_thread.h \
mercury_timing.h \
Index: runtime/mercury_stacks.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stacks.c,v
retrieving revision 1.4
diff -u -b -r1.4 mercury_stacks.c
--- runtime/mercury_stacks.c 1999/10/18 15:47:00 1.4
+++ runtime/mercury_stacks.c 1999/12/26 08:40:39
@@ -10,10 +10,10 @@
#ifdef MR_USE_MINIMAL_MODEL
static void MR_print_gen_stack_entry(FILE *fp, Integer i);
-static void MR_cleanup_generator_ptr(MR_Subgoal **generator_ptr);
+static void MR_cleanup_generator_ptr(MR_TrieNode generator_ptr);
void
-MR_push_generator(Word *frame_addr, MR_Subgoal *table_addr)
+MR_push_generator(Word *frame_addr, MR_TrieNode table_addr)
{
MR_gen_stack[MR_gen_next].generator_frame = frame_addr;
MR_gen_stack[MR_gen_next].generator_table = table_addr;
@@ -37,7 +37,7 @@
}
#endif
- return MR_gen_stack[MR_gen_next - 1].generator_table;
+ return MR_gen_stack[MR_gen_next - 1].generator_table->MR_subgoal;
}
void
@@ -74,8 +74,7 @@
if (MR_tabledebug) {
fprintf(fp, "gen %ld = <", (long) i);
MR_print_nondstackptr(fp, MR_gen_stack[i].generator_frame);
- fprintf(fp, ", %p>\n",
- (void *) MR_gen_stack[i].generator_table);
+ fprintf(fp, ", %p>\n", MR_gen_stack[i].generator_table);
}
#endif
}
@@ -110,6 +109,10 @@
if (MR_tabledebug) {
printf("commit stack next down to %ld\n",
(long) MR_cut_next);
+ printf("setting generator stack next back to %ld from %ld\n",
+ (long) MR_cut_stack[MR_cut_next].gen_next,
+ (long) MR_gen_next);
+
if (MR_gen_next != MR_cut_stack[MR_cut_next].gen_next) {
if (MR_gen_next <= MR_cut_stack[MR_cut_next].gen_next)
{
@@ -123,10 +126,6 @@
fatal_error("GEN_NEXT ASSERTION FAILURE");
}
}
-
- printf("setting generator stack next back to %ld from %ld\n",
- (long) MR_cut_stack[MR_cut_next].gen_next,
- (long) MR_gen_next);
}
#endif
@@ -141,7 +140,7 @@
}
void
-MR_register_generator_ptr(MR_Subgoal **generator_ptr)
+MR_register_generator_ptr(MR_TrieNode generator_ptr)
{
struct MR_CutGeneratorListNode *node;
@@ -154,20 +153,21 @@
if (MR_tabledebug) {
printf("registering generator %p -> %p "
"at commit stack level %d\n",
- generator_ptr, *generator_ptr, MR_cut_next - 1);
+ generator_ptr, generator_ptr->MR_subgoal,
+ MR_cut_next - 1);
}
#endif
}
static void
-MR_cleanup_generator_ptr(MR_Subgoal **generator_ptr)
+MR_cleanup_generator_ptr(MR_TrieNode generator_ptr)
{
- if ((*generator_ptr)->status == MR_SUBGOAL_COMPLETE) {
+ if (generator_ptr->MR_subgoal->status == MR_SUBGOAL_COMPLETE) {
/* there is nothing to do, everything is OK */
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
printf("no cleanup: generator %p -> %p is complete\n",
- generator_ptr, *generator_ptr);
+ generator_ptr, generator_ptr->MR_subgoal);
}
#endif
} else {
@@ -175,11 +175,11 @@
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
printf("cleanup: generator %p -> %p deleted\n",
- generator_ptr, *generator_ptr);
+ generator_ptr, generator_ptr->MR_subgoal);
}
#endif
- *generator_ptr = NULL;
+ generator_ptr->MR_subgoal = NULL;
}
}
Index: runtime/mercury_stacks.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stacks.h,v
retrieving revision 1.19
diff -u -b -r1.19 mercury_stacks.h
--- runtime/mercury_stacks.h 1999/09/27 05:20:47 1.19
+++ runtime/mercury_stacks.h 1999/12/26 08:37:01
@@ -357,11 +357,11 @@
typedef struct MR_GeneratorStackFrameStruct {
Word *generator_frame;
- MR_Subgoal *generator_table;
+ MR_TrieNode generator_table;
} MR_GeneratorStackFrame;
extern void MR_push_generator(Word *frame_addr,
- MR_Subgoal *table_addr);
+ MR_TrieNode table_addr);
extern MR_Subgoal *MR_top_generator_table(void);
extern void MR_pop_generator(void);
extern void MR_print_gen_stack(FILE *fp);
@@ -370,7 +370,7 @@
typedef struct MR_CutGeneratorListNode *MR_CutGeneratorList;
struct MR_CutGeneratorListNode {
- MR_Subgoal **generator_ptr;
+ MR_TrieNode generator_ptr;
MR_CutGeneratorList next_generator;
};
@@ -383,7 +383,7 @@
extern void MR_commit_mark(void);
extern void MR_commit_cut(void);
-extern void MR_register_generator_ptr(MR_Subgoal **);
+extern void MR_register_generator_ptr(MR_TrieNode);
#endif /* MR_USE_MINIMAL_MODEL */
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.17
diff -u -b -r1.17 mercury_tabling.c
--- runtime/mercury_tabling.c 1999/12/11 15:32:32 1.17
+++ runtime/mercury_tabling.c 1999/12/28 04:49:10
@@ -13,57 +13,62 @@
/*---------------------------------------------------------------------------*/
/*
-** this part defines the functions
-** MR_int_hash_lookup_or_add(),
-** MR_float_hash_lookup_or_add(), and
-** MR_string_hash_lookup_or_add().
+** This part deals with tabling using resizable hash tables.
*/
-/* Initial size of a new table */
-#define TABLE_START_SIZE primes[0]
-
/*
-** Maximum ratio of used to unused buckets in the table. Must be less than
-** 0.9 if you want even poor lookup times.
+** If the present field is FALSE, then the bucket is unoccupied and the
+** other two fields may be garbage.
*/
-#define MAX_EL_SIZE_RATIO 0.65
-/* Extract info from a table */
-#define SIZE(table) (((TableRoot *) table)->size)
-#define ELEMENTS(table) (((TableRoot *) table)->used_elements)
-#define BUCKET(table, Bucket) ((TableNode **) &(((TableRoot *) table)-> \
- elements))[(Bucket)]
typedef struct {
+ bool present;
Word key;
- Word * data;
-} TableNode;
+ MR_TableNode data;
+} MR_HashTableSlot;
-typedef struct {
- Word size;
- Word used_elements;
- Word elements;
-} TableRoot;
-
-static Word next_prime(Word);
-static Word * create_hash_table(Word);
-static void re_hash(Word *, Word, TableNode * Node);
+/*
+** The elements field points to an array of size slots, of which user_slots
+** are occupied. When the ratio of occupied to total slots exceeds
+** MAX_EL_SIZE_RATIO, we increase the table size to the next prime.
+*/
+struct MR_Struct_HashTable {
+ Integer size;
+ Integer threshold;
+ Integer used_slots;
+ MR_HashTableSlot *elements;
+};
+
/*
-** Prime numbers which are close to powers of 2. Used for choosing
-** the next size for a hash table.
+** Maximum ratio of used to unused buckets in the table. Must be less than
+** 0.9 if you want even poor lookup times.
*/
+#define MAX_EL_SIZE_RATIO 0.65
#define NUM_OF_PRIMES 16
static 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 Integer next_prime(Integer);
+static MR_HashTable *create_hash_table(Integer);
+
/*
+** Prime numbers which are close to powers of 2. Used for choosing
+** the next size for a hash table.
+*/
+
+/*
** Return the next prime number greater than the number received.
** If no such prime number can be found, compute an approximate one.
*/
-static Word
-next_prime(Word old_size)
+
+static Integer
+next_prime(Integer old_size)
{
int i;
@@ -80,370 +85,267 @@
}
/* Create a new empty hash table. */
-static Word *
-create_hash_table(Word table_size)
+static MR_HashTable *
+create_hash_table(Integer table_size)
{
Word i;
- TableRoot * table =
- table_allocate_bytes(sizeof(Word) * 2 +
- table_size * sizeof(TableNode *));
+ MR_HashTable *table;
+
+ table = MR_table_allocate(MR_HashTable);
table->size = table_size;
- table->used_elements = 0;
+ table->threshold = (Integer) ((float) table_size * MAX_EL_SIZE_RATIO);
+ table->used_slots = 0;
+ table->elements = MR_table_allocate_array(MR_HashTableSlot,
+ table_size);
for (i = 0; i < table_size; i++) {
- BUCKET(table, i) = NULL;
+ table->elements[i].present = FALSE;
}
- return (Word *) table;
+ return table;
}
/*
-** Insert key and Data into a new hash table using the given hash.
-** this function does not have to do compares as the given key
-** is definitely not in the table.
+** Look to see if the given key is in the given table. If it is,
+** return the address of the data pointer associated with the key.
+** If it is not, create a new element for the key in the table and
+** return the address of its data pointer.
*/
-static void
-re_hash(Word * table, Word hash, TableNode * node)
-{
- Word bucket = hash % SIZE(table);
- while (BUCKET(table, bucket)) {
- ++bucket;
- if (bucket == SIZE(table))
- bucket = 0;
- }
-
- BUCKET(table, bucket) = node;
- ++ELEMENTS(table);
-}
+#define MR_generic_lookup_or_add \
+ MR_HashTable *table; \
+ Integer bucket; \
+ \
+ /* Has the table been built? */ \
+ if (t->MR_hash_table == NULL) { \
+ t->MR_hash_table = create_hash_table(HASH_TABLE_START_SIZE); \
+ } \
+ \
+ table = t->MR_hash_table; /* Deref the table pointer */ \
+ \
+ /* Rehash the table if it has grown too full */ \
+ if (table->used_slots >= table->threshold) \
+ { \
+ MR_HashTableSlot *new_elements; \
+ int new_size; \
+ int i; \
+ \
+ new_size = next_prime(table->size); \
+ \
+ new_elements = MR_table_allocate_array(MR_HashTableSlot, \
+ new_size); \
+ for (i = 0; i < new_size; i++) { \
+ new_elements[i].present = FALSE; \
+ } \
+ \
+ for (i = 0; i < table->size; i++) { \
+ if (table->elements[i].present) { \
+ Integer newbucket; \
+ \
+ newbucket = hash(table->elements[i].key) \
+ % new_size; \
+ while (new_elements[newbucket].present) { \
+ ++newbucket; \
+ if (newbucket == new_size) \
+ newbucket = 0; \
+ } \
+ \
+ new_elements[i].present = \
+ table->elements[i].present; \
+ new_elements[i].key = \
+ table->elements[i].key; \
+ new_elements[i].data = \
+ table->elements[i].data; \
+ } \
+ } \
+ \
+ table_free(table->elements); \
+ table->elements = new_elements; \
+ \
+ table->size = new_size; \
+ table->threshold = (Integer) ((float) new_size \
+ * MAX_EL_SIZE_RATIO); \
+ } \
+ \
+ bucket = hash(key) % table->size; \
+ \
+ /* Find if the element is present. If not add it */ \
+ while (table->elements[bucket].present) { \
+ if (equal_keys(key, table->elements[bucket].key)) { \
+ return &table->elements[bucket].data; \
+ } \
+ \
+ bucket++; \
+ if (bucket == table->size) \
+ bucket = 0; \
+ } \
+ \
+ table->elements[bucket].present = TRUE; \
+ table->elements[bucket].key = assigned_key; \
+ table->elements[bucket].data.MR_integer = 0; \
+ \
+ return &table->elements[bucket].data;
-/*
-** Look to see if the given integer key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not; create a new element for the key in the table and
-** return the address of its data pointer.
-*/
MR_TrieNode
MR_int_hash_lookup_or_add(MR_TrieNode t, Integer key)
{
- TableNode * p, * q;
- Word * table = *t; /* Deref the table pointer */
- Word bucket;
-
- /* Has the the table been built? */
- if (table == NULL) {
- table = create_hash_table(TABLE_START_SIZE);
- *t = table;
- }
-
- bucket = key % SIZE(table);
- p = BUCKET(table, bucket);
-
- /* Find if the element is present. If not add it */
- while (p) {
- if (key == p->key) {
- return &p->data;
- }
-
- bucket++;
- if (bucket == SIZE(table))
- bucket = 0;
-
- p = BUCKET(table, bucket);
- }
-
- p = table_allocate_bytes(sizeof(TableNode));
- p->key = key;
- p->data = NULL;
-
- /* Rehash the table if it has grown to full */
- if ((float) ELEMENTS(table) / (float) SIZE(table) >
- MAX_EL_SIZE_RATIO)
- {
- int old_size = SIZE(table);
- int new_size = next_prime(old_size);
- Word * new_table = create_hash_table(new_size);
- int i;
-
- for (i = 0; i < old_size; i++) {
- q = BUCKET(table, i);
- if (q) {
- re_hash(new_table, q->key, q);
- }
- }
-
- /* Free the old table */
- table_free(table);
-
- /* Point to the new table */
- *t = new_table;
-
- /* Add a new element */
- re_hash(new_table, key, p);
- } else {
- BUCKET(table, bucket) = p;
- ++ELEMENTS(table);
- }
-
- return &p->data;
+#define hash(key) (key)
+#define equal_keys(k1, k2) (k1 == k2)
+#define assigned_key ((Word) key)
+MR_generic_lookup_or_add
+#undef hash(key)
+#undef equal_keys(k1, k2)
+#undef assigned_key
}
-/*
-** Look to see if the given float key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not create a new element for the key in the table and
-** return the address of its data pointer.
-*/
MR_TrieNode
-MR_float_hash_lookup_or_add(MR_TrieNode t, Float key)
+MR_float_hash_lookup_or_add(MR_TrieNode t, Word maybe_boxed_key)
{
- TableNode *p, *q;
- Word *table = *t; /* Deref the table pointer */
- Word bucket;
- Word hash;
-
- /* Has the the table been built? */
- if (table == NULL) {
- table = create_hash_table(TABLE_START_SIZE);
- *t = table;
- }
-
- hash = hash_float(key);
- bucket = hash % SIZE(table);
-
- p = BUCKET(table, bucket);
-
- /* Find if the element is present. If not add it */
- while (p) {
- if (key == word_to_float(p->key)) {
- return &p->data;
- }
+ Float key = word_to_float(maybe_boxed_key);
- ++bucket;
- if (bucket == SIZE(table))
- bucket = 0;
-
- p = BUCKET(table, bucket);
- }
-
- p = table_allocate_bytes(sizeof(TableNode));
- p->key = float_to_word(key);
- p->data = NULL;
-
- /* Rehash the table if it has grown to full */
- if ((float) ELEMENTS(table) / (float) SIZE(table) >
- MAX_EL_SIZE_RATIO)
- {
- int old_size = SIZE(table);
- int new_size = next_prime(old_size);
- Word * new_table = create_hash_table(new_size);
- int i;
-
- for (i = 0; i < old_size; i++) {
- q = BUCKET(table, i);
- if (q) {
- re_hash(new_table, hash_float(q->key), q);
- }
- }
-
- /* Free the old table */
- table_free(table);
-
- /* Point to the new table */
- *t = new_table;
-
- /* Add a new element */
- re_hash(new_table, hash, p);
- } else {
- ++ELEMENTS(table);
- BUCKET(table, bucket) = p;
- }
-
- return &p->data;
+#define hash(key) (hash_float(key))
+#define equal_keys(k1, k2) (k1 == word_to_float(k2))
+#define assigned_key maybe_boxed_key
+MR_generic_lookup_or_add
+#undef hash(key)
+#undef equal_keys(k1, k2)
+#undef assigned_key
}
-
-
-/*
-** Look to see if the given string key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not create a new element for the key in the table and
-** return the address of its data pointer.
-*/
MR_TrieNode
MR_string_hash_lookup_or_add(MR_TrieNode t, String key)
{
- TableNode * p, * q;
- Word * table = *t; /* Deref the table pointer */
- Word bucket;
- Word hash;
-
- /* Has the the table been built? */
- if (table == NULL) {
- table = create_hash_table(TABLE_START_SIZE);
- *t = table;
- }
-
- hash = hash_string((Word) key);
- bucket = hash % SIZE(table);
-
- p = BUCKET(table, bucket);
-
- /* Find if the element is present. */
- while (p) {
- int res = strtest((String)p->key, key);
-
- if (res == 0) {
- return &p->data;
- }
-
- ++bucket;
- if (bucket == SIZE(table))
- bucket = 0;
-
- p = BUCKET(table, bucket);
- }
-
- p = table_allocate_bytes(sizeof(TableNode));
- p->key = (Word) key;
- p->data = NULL;
-
- /* Rehash the table if it has grown to full */
- if ((float) ELEMENTS(table) / (float) SIZE(table) >
- MAX_EL_SIZE_RATIO)
- {
- int old_size = SIZE(table);
- int new_size = next_prime(old_size);
- Word * new_table = create_hash_table(new_size);
- int i;
-
- for (i = 0; i < old_size; i++) {
- q = BUCKET(table, i);
- if (q) {
- re_hash(new_table,
- hash_string((Word) q->key), q);
- }
- }
-
- /* Free the old table */
- table_free(t);
-
- /* Point to the new table */
- *t = new_table;
-
- /* Add a new element to rehashed table */
- re_hash(new_table, hash, p);
- } else {
- BUCKET(table, bucket) = p;
- ++ELEMENTS(table);
- }
-
- return &p->data;
+#define hash(key) (hash_string((Word) key))
+#define equal_keys(k1, k2) (strtest(k1, (String) k2) == 0)
+#define assigned_key ((Word) key)
+MR_generic_lookup_or_add
+#undef hash(key)
+#undef equal_keys(k1, k2)
+#undef assigned_key
}
/*---------------------------------------------------------------------------*/
-/*
-** This part defines the MR_int_index_lookup_or_add() function.
-*/
-
-#define ELEMENT(Table, Key) ((Word**)&((Table)[Key]))
-
/*
-** MR_int_index_lookup_or_add() : This function maintains a simple indexed
-** table of size Range.
+** 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.
*/
MR_TrieNode
-MR_int_index_lookup_or_add(MR_TrieNode t, Integer range, Integer key)
+MR_int_fix_index_lookup_or_add(MR_TrieNode t, Integer range, Integer key)
{
- Word *table = *t; /* Deref table */
+ if (t->MR_fix_table == NULL) {
+ t->MR_fix_table = MR_table_allocate_array(MR_TableNode, range);
+ memset(t->MR_fix_table, 0, sizeof(MR_TableNode) * range);
+ }
#ifdef MR_TABLE_DEBUG
if (key >= range) {
- fatal_error("MR_int_index_lookup_or_add: key out of range");
+ fatal_error("MR_int_fix_index_lookup_or_add: key out of range");
}
#endif
-
- if (table == NULL) {
- *t = table = table_allocate_words(range);
- memset(table, 0, sizeof(Word *) * range);
- }
- return ELEMENT(table, key);
+ return &t->MR_fix_table[key];
}
-#undef ELEMENT
-
/*---------------------------------------------------------------------------*/
/*
-** This part defines the type_info_lookup_or_add() function.
+** 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.
*/
-typedef struct TreeNode_struct {
- Word * key;
- Word value;
- struct TreeNode_struct * right;
- struct TreeNode_struct * left;
-} TreeNode;
+#define MR_START_TABLE_INIT_SIZE 1024
MR_TrieNode
-MR_type_info_lookup_or_add(MR_TrieNode table, Word * type_info)
+MR_int_start_index_lookup_or_add(MR_TrieNode table, Integer start, Integer key)
{
- TreeNode *p, *q;
- int i;
+ Integer diff, size;
- if (*table == NULL) {
- p = table_allocate_bytes(sizeof(TreeNode));
+ diff = key - start;
- p->key = type_info;
- p->value = (Word) NULL;
- p->left = NULL;
- p->right = NULL;
-
- *table = (Word *) p;
+#ifdef MR_TABLE_DEBUG
+ if (key < start) {
+ fatal_error("MR_int_start_index_lookup_or_add: small too key");
+ }
+#endif
- return (Word**) &p->value;
+ if (table->MR_start_table == NULL) {
+ size = max(MR_START_TABLE_INIT_SIZE, diff + 1);
+ table->MR_start_table = MR_table_allocate_array(MR_TableNode,
+ size + 1);
+ memset(table->MR_start_table + 1, 0,
+ sizeof(MR_TableNode) * size);
+ table->MR_start_table[0].MR_integer = size;
+ } else {
+ size = table->MR_start_table[0].MR_integer;
}
- p = (TreeNode *) *table;
+ if (diff >= size) {
+ MR_TableNode *new_array;
+ Integer new_size, i;
- while (p != NULL) {
- i = MR_compare_type_info((Word) p->key, (Word) type_info);
+ new_size = max(2 * size, diff + 1);
+ new_array = MR_table_allocate_array(MR_TableNode,
+ new_size + 1);
- if (i == COMPARE_EQUAL) {
- return (Word **) &p->value;
- }
+ new_array[0].MR_integer = new_size;
- q = p;
+ for (i = 0; i < size; i++) {
+ new_array[i + 1] = table->MR_start_table[i + 1];
+ }
- if (i == COMPARE_LESS) {
- p = p->left;
- } else {
- p = p->right;
+ for (; i < new_size; i++) {
+ new_array[i + 1].MR_integer = 0;
}
+
+ table->MR_start_table = new_array;
}
- p = table_allocate_bytes(sizeof(TreeNode));
- p->key = type_info;
- p->value = (Word) NULL;
- p->left = NULL;
- p->right = NULL;
+ return &table->MR_start_table[diff + 1];
+}
- if (i == COMPARE_LESS) {
- q->left = p;
- } else {
- q ->right = p;
+/*---------------------------------------------------------------------------*/
+
+MR_TrieNode
+MR_type_info_lookup_or_add(MR_TrieNode table, Word *type_info)
+{
+ MR_TypeInfo collapsed_type_info;
+ MR_TypeCtorInfo type_ctor_info;
+ MR_TrieNode node;
+ Word **type_info_args;
+ int i;
+
+ /* XXX memory allocation here should be optimized */
+ collapsed_type_info = MR_collapse_equivalences((Word) type_info);
+
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+ node = MR_int_hash_lookup_or_add(table, (Integer) type_ctor_info);
+
+ /*
+ ** All calls to MR_type_info_lookup_or_add that have the same value
+ ** of node at this point agree on the type_ctor_info of the type
+ ** being tabled. They must therefore also agree on its arity.
+ ** This is why looping over all the arguments works.
+ **
+ ** XXX maybe not for ho types
+ */
+
+ type_info_args = (Word **) collapsed_type_info;
+
+ for (i = 1; i <= type_ctor_info->arity; i++) {
}
- return (Word **) &p->value;
+ return node;
}
/*---------------------------------------------------------------------------*/
-
/*
** This part defines the MR_table_type() function.
*/
@@ -454,7 +356,7 @@
/*
** Due to the depth of the control here, we'll use 4 space indentation.
**
-** NOTE : changes to this function will probably also have to be reflected
+** NOTE: changes to this function will probably also have to be reflected
** in mercury_deep_copy.c and std_util::ML_expand().
*/
@@ -607,7 +509,7 @@
break;
case MR_TYPECTOR_REP_STRING:
- MR_DEBUG_TABLE_STRING(table, data);
+ MR_DEBUG_TABLE_STRING(table, (String) data);
break;
case MR_TYPECTOR_REP_PRED: {
@@ -1199,7 +1101,8 @@
Define_entry(mercury__table_nondet_suspend_2_0);
{
- MR_Subgoal *table;
+ MR_TrieNode table;
+ MR_Subgoal *subgoal;
MR_Consumer *consumer;
MR_ConsumerList listnode;
Integer cur_gen;
@@ -1219,13 +1122,14 @@
*/
MR_mkframe("mercury__table_nondet_suspend", 1, ENTRY(do_fail));
- table = MR_SUBGOAL(r1);
+ table = (MR_TrieNode) r1;
+ subgoal = table->MR_subgoal;
consumer = table_allocate_bytes(sizeof(MR_Consumer));
- consumer->remaining_answer_list_ptr = &table->answer_list;
+ consumer->remaining_answer_list_ptr = &subgoal->answer_list;
save_transient_registers();
save_state(&(consumer->saved_state),
- table->generator_maxfr, table->generator_sp,
+ subgoal->generator_maxfr, subgoal->generator_sp,
"suspension", "consumer");
restore_transient_registers();
@@ -1247,7 +1151,9 @@
#endif
if (fr == MR_gen_stack[cur_gen].generator_frame) {
- if (MR_gen_stack[cur_gen].generator_table == table) {
+ if (MR_gen_stack[cur_gen].generator_table->MR_subgoal
+ == subgoal)
+ {
/*
** This is the nondet stack frame of the
** generator corresponding to this consumer.
@@ -1292,8 +1198,9 @@
save_transient_registers();
make_subgoal_follow_leader(
- MR_gen_stack[cur_gen].generator_table,
- table);
+ MR_gen_stack[cur_gen].
+ generator_table->MR_subgoal,
+ subgoal);
restore_transient_registers();
}
@@ -1324,15 +1231,15 @@
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
printf("adding suspension node %p to table %p",
- (void *) consumer, (void *) table);
- printf(" at slot %p\n", table->consumer_list_tail);
+ consumer, subgoal);
+ printf(" at slot %p\n", subgoal->consumer_list_tail);
}
#endif
- assert(*(table->consumer_list_tail) == NULL);
+ assert(*(subgoal->consumer_list_tail) == NULL);
listnode = table_allocate_bytes(sizeof(struct MR_ConsumerListNode));
- *(table->consumer_list_tail) = listnode;
- table->consumer_list_tail = &(listnode->next);
+ *(subgoal->consumer_list_tail) = listnode;
+ subgoal->consumer_list_tail = &(listnode->next);
listnode->item = consumer;
listnode->next = NULL;
}
@@ -1439,7 +1346,7 @@
}
#endif
} else {
- MR_cur_leader->resume_info = MR_GC_NEW(MR_ResumeInfo);
+ MR_cur_leader->resume_info = MR_table_allocate(MR_ResumeInfo);
save_transient_registers();
save_state(&(MR_cur_leader->resume_info->leader_state),
@@ -1585,7 +1492,6 @@
** we returned the first answer, we don't need to restore it again,
** since will not have changed in the meantime.
*/
-
r1 = (Word) &MR_cur_leader->resume_info->cur_consumer_answer_list->
answer_data;
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.16
diff -u -b -r1.16 mercury_tabling.h
--- runtime/mercury_tabling.h 1999/10/26 14:17:56 1.16
+++ runtime/mercury_tabling.h 1999/12/28 05:33:25
@@ -16,6 +16,7 @@
#define MERCURY_TABLING_H
#include "mercury_types.h"
+#include "mercury_type_info.h"
#include "mercury_float.h"
#ifndef CONSERVATIVE_GC
@@ -23,500 +24,38 @@
#endif
/*---------------------------------------------------------------------------*/
-/*
-** The functions defined here are used only via the macros defined below.
-*/
-
-typedef Word **MR_TrieNode;
-typedef Word **MR_AnswerBlock;
-
-/* functions to handle the builtin types: string, int, float, type_info */
-
-/*
-** Look to see if the given integer key is in the given table. If it
-** is, return the address of the data pointer associated with the key.
-** If it is not, create a new element for the key in the table and
-** return the address of its data pointer.
-**/
-MR_TrieNode MR_int_hash_lookup_or_add(MR_TrieNode Table, Integer Key);
-/*
-** Look to see if the given float key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not create a new element for the key in the table and
-** return the address of its data pointer.
-**/
-MR_TrieNode MR_float_hash_lookup_or_add(MR_TrieNode Table, Float Key);
-
-/*
-** Look to see if the given string key is in the given table. If it
-** is return the address of the data pointer associated with the key.
-** If it is not create a new element for the key in the table and
-** return the address of its data pointer.
-**/
-MR_TrieNode MR_string_hash_lookup_or_add(MR_TrieNode Table, String Key);
-
-/*
-** Lookup or insert the given type_info into the given table. Return a
-** pointer to the node of the table reached by the lookup/insert.
-*/
-MR_TrieNode MR_type_info_lookup_or_add(MR_TrieNode, Word *);
-
-/* --- a function to handle enumerated types --- */
-
-/*
-** MR_int_index_lookup_or_add() : This function maintains a simple indexed
-** table of size Range. The return value is a pointer to the table
-** node found by the lookup/insert.
-*/
-MR_TrieNode MR_int_index_lookup_or_add(MR_TrieNode table, Integer range, Integer key);
-
-/* --- a function to handle any type at all --- */
+typedef union MR_Union_TableNode MR_TableNode;
+typedef struct MR_Struct_HashTable MR_HashTable;
+typedef struct MR_Struct_StartTable MR_StartTable;
+typedef struct MR_SubgoalStruct MR_Subgoal;
+typedef struct MR_SubgoalListNode *MR_SubgoalList;
+typedef struct MR_AnswerListNodeStruct MR_AnswerListNode;
+typedef struct MR_AnswerListNodeStruct *MR_AnswerList;
+typedef struct MR_ConsumerListNode *MR_ConsumerList;
-/*
-** This function will lookup or insert any type of value into a
-** table. It uses the provided type_info to extract the necessary
-** info to do this. It returns a pointer to the node found by the
-** insertion/lookup.
-*/
-MR_TrieNode MR_table_type(MR_TrieNode Table, Word *type_info, Word data_value);
+typedef MR_TableNode *MR_TrieNode;
/*---------------------------------------------------------------------------*/
-
-#define MR_RAW_TABLE_ANY(Table, TypeInfo, Value) \
- MR_table_type(Table, (Word *) TypeInfo, Value)
-
-#define MR_RAW_TABLE_TAG(Table, Tag) \
- MR_int_index_lookup_or_add(Table, 1 << TAGBITS, Tag)
-
-#define MR_RAW_TABLE_ENUM(Table, Range, Value) \
- MR_int_index_lookup_or_add(Table, Range, Value)
-
-#define MR_RAW_TABLE_WORD(Table, Value) \
- MR_int_hash_lookup_or_add(Table, (Integer) Value);
-
-#define MR_RAW_TABLE_INT(Table, Value) \
- MR_int_hash_lookup_or_add(Table, Value);
-
-#define MR_RAW_TABLE_CHAR(Table, Value) \
- MR_int_hash_lookup_or_add(Table, (Integer) Value);
-
-#define MR_RAW_TABLE_FLOAT(Table, Value) \
- MR_float_hash_lookup_or_add(Table, Value);
-
-#define MR_RAW_TABLE_STRING(Table, Value) \
- MR_string_hash_lookup_or_add(Table, (String) Value);
-
-#define MR_RAW_TABLE_TYPE_INFO(Table, Type) \
- MR_type_info_lookup_or_add(Table, (Word *) Type)
-
-#ifdef MR_TABLE_DEBUG
-
-#define MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_ANY((Word **) (table0), \
- (type_info), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: any %x type %p => %p\n", \
- (Word **) (table0), (value), \
- (Word **) (type_info), (Word **) (table));\
- } \
- } while (0)
-#define MR_DEBUG_TABLE_ANY(table, type_info, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = (Word **) MR_RAW_TABLE_ANY((table), \
- (type_info), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: any %x type %p => %p\n", \
- prev_table, (value), (type_info), \
- (table)); \
- } \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_TAG(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_TAG((Word **) (table0), \
- (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: tag %d => %p\n", \
- (Word **) (table0), (value), \
- (Word **) (table)) \
- } \
- } while (0)
-#define MR_DEBUG_TABLE_TAG(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = (Word **) MR_RAW_TABLE_TAG((table), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: tag %d => %p\n", prev_table, \
- (value), (table)); \
- } \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_ENUM((Word **) (table0), \
- (count), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: enum %d of %d => %p\n", \
- (Word **) (table0), (value), (count), \
- (Word **) (table)); \
- } \
- } while (0)
-#define MR_DEBUG_TABLE_ENUM(table, count, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = (Word **) MR_RAW_TABLE_ENUM((table), (count), \
- (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: enum %d of %d => %p\n", \
- prev_table, (value), (count), (table)); \
- } \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_WORD(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_WORD((Word **) (table0), \
- (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: word %d => %p\n", \
- (Word **) (table0), (value), \
- (Word **) (table)); \
- } \
- } while (0)
-#define MR_DEBUG_TABLE_WORD(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = (Word **) MR_RAW_TABLE_WORD((table), (value));\
- if (MR_tabledebug) { \
- printf("TABLE %p: word %d => %p\n", \
- prev_table, (value), (table)); \
- } \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_INT(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_INT((Word **) (table0), \
- (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: int %d => %p\n", \
- (Word **) (table0), (value), \
- (Word **) (table)); \
- } \
- } while (0)
-#define MR_DEBUG_TABLE_INT(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = (Word **) MR_RAW_TABLE_INT((table), (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: int %d => %p\n", \
- prev_table, (value), (table)); \
- } \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_CHAR(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_CHAR((Word **) (table0), \
- (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: char `%c'/%d => %p\n", \
- (Word **) (table0), (int) (value), \
- (int) (value), (Word **) (table)); \
- } \
- } while (0)
-#define MR_DEBUG_TABLE_CHAR(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = (Word **) MR_RAW_TABLE_CHAR((table), (value));\
- if (MR_tabledebug) { \
- printf("TABLE %p: char `%c'/%d => %p\n", \
- prev_table, (int) (value), \
- (int) (value), (table)); \
- } \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_FLOAT((Word **) (table0), \
- (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: float %f => %p\n", \
- (Word **) (table0), value, \
- (Word **) (table)); \
- } \
- } while (0)
-#define MR_DEBUG_TABLE_FLOAT(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = (Word **) MR_RAW_TABLE_FLOAT((table), (value));\
- if (MR_tabledebug) { \
- printf("TABLE %p: float %f => %p\n", \
- prev_table, (double) word_to_float(value),\
- (table)); \
- } \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_STRING(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_STRING((Word **) (table0),\
- (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: string `%s' => %p\n", \
- (Word **) (table), (char *) (value), \
- (Word **) (table)); \
- } \
- } while (0)
-#define MR_DEBUG_TABLE_STRING(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = (Word **) MR_RAW_TABLE_STRING((table), (value));\
- if (MR_tabledebug) { \
- printf("TABLE %p: string `%s' => %p\n", \
- prev_table, (char *) (value), (table)); \
- } \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_TYPE_INFO((Word **) (table0),\
- (value)); \
- if (MR_tabledebug) { \
- printf("TABLE %p: typeinfo %p => %p\n", \
- (Word **) (table), (Word **) (value), \
- (Word **) (table)); \
- } \
- } while (0)
-#define MR_DEBUG_TABLE_TYPEINFO(table, value) \
- do { \
- MR_TrieNode prev_table = (table); \
- (table) = (Word **) MR_RAW_TABLE_TYPE_INFO((table), (value));\
- if (MR_tabledebug) { \
- printf("TABLE %p: typeinfo %p => %p\n", \
- prev_table, (value), (table)); \
- } \
- } while (0)
-
-#else /* not MR_TABLE_DEBUG */
-
-#define MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_ANY((Word **) (table0), \
- (type_info), (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_ANY(table, type_info, value) \
- do { \
- (table) = (Word **) MR_RAW_TABLE_ANY((table), \
- (type_info), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_TAG(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_TAG((Word **) (table0), \
- (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_TAG(table, value) \
- do { \
- (table) = (Word **) MR_RAW_TABLE_TAG((table), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_ENUM((Word **) (table0), \
- (count), (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_ENUM(table, count, value) \
- do { \
- (table) = (Word **) MR_RAW_TABLE_ENUM((table), (count), \
- (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_WORD(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_WORD((Word **) (table0), \
- (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_WORD(table, value) \
- do { \
- (table) = (Word **) MR_RAW_TABLE_WORD((table), (value));\
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_INT(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_INT((Word **) (table0), \
- (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_INT(table, value) \
- do { \
- (table) = (Word **) MR_RAW_TABLE_INT((table), (value)); \
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_CHAR(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_CHAR((Word **) (table0), \
- (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_CHAR(table, value) \
- do { \
- (table) = (Word **) MR_RAW_TABLE_CHAR((table), (value));\
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_FLOAT((Word **) (table0), \
- (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_FLOAT(table, value) \
- do { \
- (table) = (Word **) MR_RAW_TABLE_FLOAT((table), (value));\
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_STRING(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_STRING((Word **) (table0),\
- (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_STRING(table, value) \
- do { \
- (table) = (Word **) MR_RAW_TABLE_STRING((table), (value));\
- } while (0)
-
-#define MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value) \
- do { \
- (table) = (Word) MR_RAW_TABLE_TYPE_INFO((Word **) (table0),\
- (value)); \
- } while (0)
-#define MR_DEBUG_TABLE_TYPEINFO(table, value) \
- do { \
- (table) = (Word **) MR_RAW_TABLE_TYPE_INFO((table), (value));\
- } while (0)
-
-#endif /* MR_TABLE_DEBUG */
-
-/***********************************************************************/
-
-#ifdef MR_TABLE_DEBUG
-
-#define MR_TABLE_CREATE_ANSWER_BLOCK(ABlock, Elements) \
- do { \
- *((MR_AnswerBlock) ABlock) = \
- (Word *) table_allocate_words(Elements); \
- if (MR_tabledebug) \
- printf("allocated answer block %p -> %p\n", \
- ((MR_AnswerBlock) ABlock), \
- *((MR_AnswerBlock) ABlock)); \
- } while(0)
-
-#define MR_TABLE_GET_ANSWER(Offset, ABlock) \
- (( MR_tabledebug ? \
- (printf("using answer block: %p\n", \
- ((MR_AnswerBlock) ABlock)), \
- printf("pointing to: %p\n", \
- *((MR_AnswerBlock) ABlock))) \
- : \
- (void) 0 /* do nothing */ \
- ), \
- (* ((MR_AnswerBlock) ABlock))[Offset])
-
-#else
-
-#define MR_TABLE_CREATE_ANSWER_BLOCK(ABlock, Elements) \
- do { \
- *((MR_AnswerBlock) ABlock) = \
- (Word *) table_allocate_words(Elements); \
- } while(0)
-
-#define MR_TABLE_GET_ANSWER(Offset, ABlock) \
- (* ((MR_AnswerBlock) ABlock))[Offset]
-
-#endif
-
-#ifdef CONSERVATIVE_GC
-
- #define MR_TABLE_SAVE_ANSWER(Offset, ABlock, Value, TypeInfo) \
- do { \
- (* ((MR_AnswerBlock) ABlock))[Offset] = Value; \
- } while(0)
-
-#else /* not CONSERVATIVE_GC */
-
- #define MR_TABLE_SAVE_ANSWER(Offset, ABlock, Value, TypeInfo) \
- do { \
- save_transient_hp(); \
- { Word local_val = Value; \
- (* ((MR_AnswerBlock) ABlock))[Offset] = \
- deep_copy(&local_val, (Word *) (Word) &TypeInfo,\
- NULL, NULL); \
- } \
- restore_transient_hp(); \
- } while(0)
-
-#endif /* CONSERVATIVE_GC */
-
-#ifdef CONSERVATIVE_GC
-
- #define table_allocate_bytes(size) \
- GC_MALLOC(size)
-
- #define table_reallocate_bytes(pointer, size) \
- GC_REALLOC(pointer, size)
-
- #define table_allocate_words(size) \
- GC_MALLOC(sizeof(Word) * size)
-
- #define table_reallocate_words(pointer, size) \
- GC_REALLOC(pointer, sizeof(Word) * size)
-
- #define table_free(pointer) \
- GC_FREE(pointer)
-
- #define MR_table_list_cons(h, t) MR_list_cons((h), (t))
-
-#else /* not CONSERVATIVE_GC */
-
- #define table_allocate_bytes(Size) \
- (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
- (void *) NULL)
- #define table_reallocate_bytes(Pointer, Size) \
- (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
- (void *) NULL)
- #define table_allocate_words(Size) \
- (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
- (void *) NULL)
- #define table_reallocate_words(Pointer, Size) \
- (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
- (void *) NULL)
- #define table_free(Pointer) \
- fatal_error("Sorry, not implemented: tabling in non-GC grades")
-
- #define MR_table_list_cons(h, t) \
- (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
- (Word) 0)
-#endif /* CONSERVATIVE_GC */
-
-#define table_copy_bytes(Dest, Source, Size) \
- MR_memcpy(Dest, Source, Size)
-
-#define table_copy_words(Dest, Source, Size) \
- MR_memcpy((char *) (Dest), (char *) (Source), sizeof(Word) * Size)
+union MR_Union_TableNode {
+ Integer MR_integer;
+ Integer MR_simpletable_status;
+ MR_HashTable *MR_hash_table;
+ MR_TableNode *MR_start_table;
+ MR_TableNode *MR_fix_table;
+ Word *MR_answerblock;
+ MR_Subgoal *MR_subgoal;
+};
/*---------------------------------------------------------------------------*/
-typedef struct MR_AnswerListNodeStruct MR_AnswerListNode;
-typedef struct MR_AnswerListNodeStruct *MR_AnswerList;
-
struct MR_AnswerListNodeStruct {
Integer answer_num;
- Word answer_data;
+ MR_TableNode answer_data; /* always uses the MR_answerblock field */
MR_AnswerList next_answer;
};
-typedef enum {
- MR_ANS_NOT_GENERATED,
- MR_ANS_GENERATED
-} MR_AnswerDuplState;
-
/*
** The state of a model_det or model_semi subgoal.
**
@@ -531,15 +70,11 @@
** for success with "(Unsigned) x >= MR_SIMPLETABLE_SUCCEEDED".
*/
-typedef enum {
- MR_SIMPLETABLE_UNINITIALIZED,
- MR_SIMPLETABLE_WORKING,
- MR_SIMPLETABLE_FAILED,
- MR_SIMPLETABLE_SUCCEEDED
-} MR_SimpletableStatus;
+#define MR_SIMPLETABLE_UNINITIALIZED 0
+#define MR_SIMPLETABLE_WORKING 1
+#define MR_SIMPLETABLE_FAILED 2
+#define MR_SIMPLETABLE_SUCCEEDED 3
-#ifdef MR_USE_MINIMAL_MODEL
-
typedef enum {
MR_SUBGOAL_INACTIVE,
MR_SUBGOAL_ACTIVE,
@@ -598,16 +133,11 @@
MR_AnswerList *remaining_answer_list_ptr;
} MR_Consumer;
-typedef struct MR_ConsumerListNode *MR_ConsumerList;
-
struct MR_ConsumerListNode {
MR_Consumer *item;
MR_ConsumerList next;
};
-typedef struct MR_SubgoalStruct MR_Subgoal;
-typedef struct MR_SubgoalListNode *MR_SubgoalList;
-
/*
** The following structure is used to hold the state and variables used in
** the table_resume procedure.
@@ -660,15 +190,136 @@
/* MR_sp at the time of the */
/* call to the generator */
};
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** The functions defined here should be used only via the macros defined
+** in mercury_tabling_macros.h.
+**
+** These functions look to see if the given key is in the given table.
+** If it is, they return the address of the data pointer associated with
+** the key. If it is not, they create a new element for the key in the table
+** and return the address of its data pointer.
+**
+** The function for tabling a float takes a word, not a float. If the float
+** argument is not in the table, and floats are supposed to be boxed, then
+** it is more efficient to reuse the existing box of the argument instead of
+** allocating new one, and this requires passing the box as well as the float.
+*/
+
+/*
+** These functions assume that the table is a dynamically resizable hash table.
+*/
+
+extern MR_TrieNode MR_int_hash_lookup_or_add(MR_TrieNode table,
+ Integer key);
+extern MR_TrieNode MR_float_hash_lookup_or_add(MR_TrieNode table,
+ Word maybe_boxed_key);
+extern MR_TrieNode MR_string_hash_lookup_or_add(MR_TrieNode table,
+ String key);
+
+/*
+** This function assumes that the table is a statically sized array,
+** with the index ranging from 0 to range - 1.
+*/
+
+extern MR_TrieNode MR_int_fix_index_lookup_or_add(MR_TrieNode table,
+ Integer range, Integer key);
+
+/*
+** This function assumes that the table is an expandable array,
+** with the smallest valid index value being start.
+*/
+
+extern MR_TrieNode MR_int_start_index_lookup_or_add(MR_TrieNode table,
+ Integer start, Integer key);
+
+/*
+** This function tables type_infos in a hash table.
+*/
+
+extern MR_TrieNode MR_type_info_lookup_or_add(MR_TrieNode table,
+ Word *type_info);
+
+/*
+** This function tables values of arbitrary types; the form of the data
+** structure depends on the actual type of the value.
+*/
+
+extern MR_TrieNode MR_table_type(MR_TrieNode table,
+ Word *type_info, Word data_value);
+
+/*---------------------------------------------------------------------------*/
+
+#ifdef CONSERVATIVE_GC
+
+ #define MR_table_allocate(type) \
+ MR_GC_NEW(type)
+
+ #define MR_table_allocate_array(type, count) \
+ MR_GC_NEW_ARRAY(type, count)
+
+ #define MR_table_reallocate_array(ptr, type, count) \
+ MR_GC_NEW_ARRAY(ptr, type, count)
+
+ #define table_allocate_bytes(size) \
+ MR_GC_malloc(size)
+
+ #define table_reallocate_bytes(pointer, size) \
+ MR_GC_realloc(pointer, size)
- /*
- ** Cast a Word to a MR_Subgoal*: saves on typing and improves
- ** readability.
- */
-#define MR_SUBGOAL(T) (*(MR_Subgoal **) T)
+ #define table_allocate_words(size) \
+ MR_GC_malloc(sizeof(Word) * size)
+
+ #define table_reallocate_words(pointer, size) \
+ MR_GC_realloc(pointer, sizeof(Word) * size)
+
+ #define table_free(pointer) \
+ MR_GC_free(pointer)
+
+ #define MR_table_list_cons(h, t) \
+ MR_list_cons((h), (t))
+
+#else /* not CONSERVATIVE_GC */
+
+ #define MR_table_allocate(type) \
+ (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+ (void *) NULL)
+ #define MR_table_allocate_array(type, count) \
+ (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+ (void *) NULL)
+ #define MR_table_reallocate_array(pointer, type, count) \
+ (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+ (void *) NULL)
+ #define table_allocate_bytes(size) \
+ (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+ (void *) NULL)
+ #define table_reallocate_bytes(pointer, size) \
+ (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+ (void *) NULL)
+ #define table_allocate_words(size) \
+ (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+ (void *) NULL)
+ #define table_reallocate_words(pointer, size) \
+ (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+ (void *) NULL)
+ #define table_free(pointer) \
+ fatal_error("Sorry, not implemented: tabling in non-GC grades")
+ #define MR_table_list_cons(h, t) \
+ (fatal_error("Sorry, not implemented: tabling in non-GC grades"), \
+ (Word) 0)
+
+#endif /* CONSERVATIVE_GC */
+
+#define table_copy_bytes(Dest, Source, Size) \
+ MR_memcpy(Dest, Source, Size)
+
+#define table_copy_words(Dest, Source, Size) \
+ MR_memcpy((char *) (Dest), (char *) (Source), sizeof(Word) * Size)
/*---------------------------------------------------------------------------*/
-#endif /* MR_USE_MINIMAL_MODEL */
+#include "mercury_tabling_macros.h"
#endif /* not MERCURY_TABLING_H */
Index: runtime/mercury_tabling_macros.h
===================================================================
RCS file: mercury_tabling_macros.h
diff -N mercury_tabling_macros.h
--- /dev/null Thu Sep 2 15:00:04 1999
+++ mercury_tabling_macros.h Tue Dec 28 15:33:16 1999
@@ -0,0 +1,356 @@
+/*
+** Copyright (C) 1997-1999 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.
+*/
+
+/*
+** mercury_tabling_macros.h
+**
+** This file defines macros used by the implementation of tabling
+** (which means mostly the procedures defined in library/private_builtin.m).
+** These macros just call the real implementation routines defined in
+** runtime/mercury_tabling.c, but they also optionally print debugging
+** information.
+*/
+
+#define MR_RAW_TABLE_ANY(table, type_info, value) \
+ MR_table_type(table, type_info, value)
+
+#define MR_RAW_TABLE_TAG(table, tag) \
+ MR_int_fix_index_lookup_or_add(table, 1 << TAGBITS, tag)
+
+#define MR_RAW_TABLE_ENUM(table, range, value) \
+ MR_int_fix_index_lookup_or_add(table, range, value)
+
+#define MR_RAW_TABLE_WORD(table, value) \
+ MR_int_hash_lookup_or_add(table, value);
+
+#define MR_RAW_TABLE_INT(table, value) \
+ MR_int_hash_lookup_or_add(table, value);
+
+#define MR_RAW_TABLE_CHAR(table, value) \
+ MR_int_hash_lookup_or_add(table, value);
+
+#define MR_RAW_TABLE_FLOAT(table, value) \
+ MR_float_hash_lookup_or_add(table, value);
+
+#define MR_RAW_TABLE_STRING(table, value) \
+ MR_string_hash_lookup_or_add(table, value);
+
+#define MR_RAW_TABLE_TYPEINFO(table, type_info) \
+ MR_type_info_lookup_or_add(table, type_info)
+
+#ifdef MR_TABLE_DEBUG
+
+#define MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value) \
+ do { \
+ (table) = MR_RAW_TABLE_ANY((table0), (type_info), \
+ (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: any %x type %p => %p\n", \
+ (table0), (value), (type_info), (table));\
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_ANY(table, type_info, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_ANY((table), \
+ (type_info), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: any %x type %p => %p\n", \
+ prev_table, (value), (type_info), \
+ (table)); \
+ } \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_TAG(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_TAG((table0), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: tag %d => %p\n", \
+ (table0), (value), (table)) \
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_TAG(table, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_TAG((table), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: tag %d => %p\n", \
+ prev_table, (value), (table)); \
+ } \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value) \
+ do { \
+ (table) = MR_RAW_TABLE_ENUM((table0), (count), (value));\
+ if (MR_tabledebug) { \
+ printf("TABLE %p: enum %d of %d => %p\n", \
+ (table0), (value), (count), (table)); \
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_ENUM(table, count, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_ENUM((table), (count), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: enum %d of %d => %p\n", \
+ prev_table, (value), (count), (table)); \
+ } \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_WORD(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_WORD((table0), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: word %d => %p\n", \
+ (table0), (value), (table)); \
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_WORD(table, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_WORD((table), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: word %d => %p\n", \
+ prev_table, (value), (table)); \
+ } \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_INT(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_INT((table0), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: int %d => %p\n", \
+ (table0), (value), (table)); \
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_INT(table, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_INT((table), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: int %d => %p\n", \
+ prev_table, (value), (table)); \
+ } \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_CHAR(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_CHAR((table0), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: char `%c'/%d => %p\n", \
+ (table0), (int) (value), \
+ (int) (value), (table)); \
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_CHAR(table, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_CHAR((table), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: char `%c'/%d => %p\n", \
+ prev_table, (int) (value), \
+ (int) (value), (table)); \
+ } \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_FLOAT((table0), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: float %f => %p\n", \
+ (table0), (double) word_to_float(value),\
+ (table)); \
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_FLOAT(table, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_FLOAT((table), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: float %f => %p\n", \
+ prev_table, (double) word_to_float(value),\
+ (table)); \
+ } \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_STRING(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_STRING((table0), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: string `%s' => %p\n", \
+ (table), (char *) (value), (table)); \
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_STRING(table, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_STRING((table), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: string `%s' => %p\n", \
+ prev_table, (char *) (value), (table)); \
+ } \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_TYPEINFO((table0), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: typeinfo %p => %p\n", \
+ (table), (value), (table)); \
+ } \
+ } while (0)
+#define MR_DEBUG_TABLE_TYPEINFO(table, value) \
+ do { \
+ MR_TrieNode prev_table = (table); \
+ (table) = MR_RAW_TABLE_TYPEINFO((table), (value)); \
+ if (MR_tabledebug) { \
+ printf("TABLE %p: typeinfo %p => %p\n", \
+ prev_table, (value), (table)); \
+ } \
+ } while (0)
+
+#else /* not MR_TABLE_DEBUG */
+
+#define MR_DEBUG_NEW_TABLE_ANY(table, table0, type_info, value) \
+ do { \
+ (table) = MR_RAW_TABLE_ANY((table0), (type_info), (value));\
+ } while (0)
+#define MR_DEBUG_TABLE_ANY(table, type_info, value) \
+ do { \
+ (table) = MR_RAW_TABLE_ANY((table), (type_info), (value));\
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_TAG(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_TAG((table0), (value)); \
+ } while (0)
+#define MR_DEBUG_TABLE_TAG(table, value) \
+ do { \
+ (table) = MR_RAW_TABLE_TAG((table), (value)); \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_ENUM(table, table0, count, value) \
+ do { \
+ (table) = MR_RAW_TABLE_ENUM((table0), (count), (value));\
+ } while (0)
+#define MR_DEBUG_TABLE_ENUM(table, count, value) \
+ do { \
+ (table) = MR_RAW_TABLE_ENUM((table), (count), (value)); \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_WORD(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_WORD((table0), (value)); \
+ } while (0)
+#define MR_DEBUG_TABLE_WORD(table, value) \
+ do { \
+ (table) = MR_RAW_TABLE_WORD((table), (value));\
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_INT(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_INT((table0), (value)); \
+ } while (0)
+#define MR_DEBUG_TABLE_INT(table, value) \
+ do { \
+ (table) = MR_RAW_TABLE_INT((table), (value)); \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_CHAR(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_CHAR((table0), (value)); \
+ } while (0)
+#define MR_DEBUG_TABLE_CHAR(table, value) \
+ do { \
+ (table) = MR_RAW_TABLE_CHAR((table), (value)); \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_FLOAT(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_FLOAT((table0), (value)); \
+ } while (0)
+#define MR_DEBUG_TABLE_FLOAT(table, value) \
+ do { \
+ (table) = MR_RAW_TABLE_FLOAT((table), (value)); \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_STRING(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_STRING((table0), (value)); \
+ } while (0)
+#define MR_DEBUG_TABLE_STRING(table, value) \
+ do { \
+ (table) = MR_RAW_TABLE_STRING((table), (value)); \
+ } while (0)
+
+#define MR_DEBUG_NEW_TABLE_TYPEINFO(table, table0, value) \
+ do { \
+ (table) = MR_RAW_TABLE_TYPEINFO((table0), (value)); \
+ } while (0)
+#define MR_DEBUG_TABLE_TYPEINFO(table, value) \
+ do { \
+ (table) = MR_RAW_TABLE_TYPEINFO((table), (value)); \
+ } while (0)
+
+#endif /* MR_TABLE_DEBUG */
+
+/***********************************************************************/
+
+#ifdef MR_TABLE_DEBUG
+
+#define MR_TABLE_CREATE_ANSWER_BLOCK(table, num_slots) \
+ do { \
+ (table)->MR_answerblock = MR_table_allocate_array(Word, \
+ (num_slots)); \
+ if (MR_tabledebug) \
+ printf("allocated answer block %p -> %p, %d words\n",\
+ (table), (table)->MR_answerblock, \
+ (int) (num_slots)); \
+ } while(0)
+
+#define MR_TABLE_GET_ANSWER(table, offset) \
+ (( MR_tabledebug ? \
+ printf("using answer block: %p -> %p, slot %d\n", \
+ table, table->MR_answerblock, (int) (offset)) \
+ : \
+ (void) 0 /* do nothing */ \
+ ), \
+ ((table)->MR_answerblock)[(offset)])
+
+#else
+
+#define MR_TABLE_CREATE_ANSWER_BLOCK(table, num_slots) \
+ do { \
+ (table)->MR_answerblock = MR_table_allocate_array(Word, \
+ num_slots); \
+ } while(0)
+
+#define MR_TABLE_GET_ANSWER(table, offset) \
+ ((table)->MR_answerblock)[offset]
+
+#endif
+
+#ifdef CONSERVATIVE_GC
+
+ #define MR_TABLE_SAVE_ANSWER(table, offset, value, type_info) \
+ do { \
+ (table)->MR_answerblock[offset] = value; \
+ } while(0)
+
+#else /* not CONSERVATIVE_GC */
+
+ #define MR_TABLE_SAVE_ANSWER(table, offset, value, type_info) \
+ do { \
+ save_transient_hp(); \
+ { Word local_val = Value; \
+ (table)->MR_answerblock[offset] = \
+ deep_copy(&local_val, (Word *) &type_info, \
+ NULL, NULL); \
+ } \
+ restore_transient_hp(); \
+ } while(0)
+
+#endif /* CONSERVATIVE_GC */
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.23
diff -u -b -r1.23 mercury_trace_base.c
--- runtime/mercury_trace_base.c 1999/12/20 14:03:50 1.23
+++ runtime/mercury_trace_base.c 1999/12/25 09:45:22
@@ -156,9 +156,23 @@
return NULL;
}
+#ifdef MR_TABLE_DEBUG
+bool MR_saved_tabledebug;
+#endif
+
void
MR_trace_init(void)
{
+#ifdef MR_TABLE_DEBUG
+ /*
+ ** We don't want to see any tabling debugging messages from
+ ** initialization code about entering and leaving commit goals.
+ */
+
+ MR_saved_tabledebug = MR_tabledebug;
+ MR_tabledebug = FALSE;
+#endif
+
#ifdef MR_USE_EXTERNAL_DEBUGGER
if (MR_trace_handler == MR_TRACE_EXTERNAL) {
if (MR_address_of_trace_init_external != NULL) {
@@ -192,6 +206,14 @@
MR_trace_call_depth = 0;
MR_trace_from_full = TRUE;
MR_trace_enabled = enabled;
+
+#ifdef MR_TABLE_DEBUG
+ /*
+ ** Restore the value saved by MR_trace_init.
+ */
+
+ MR_tabledebug = MR_saved_tabledebug;
+#endif
/*
** Install the SIGINT signal handler.
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.52
diff -u -b -r1.52 mercury_wrapper.c
--- runtime/mercury_wrapper.c 1999/12/20 14:03:51 1.52
+++ runtime/mercury_wrapper.c 1999/12/25 08:17:25
@@ -284,6 +284,12 @@
process_args(argc, argv);
process_environment_options();
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ setlinebuf(stdout);
+ }
+#endif
+
/*
** Some of the rest of this function may call Mercury code
** that may have been compiled with tracing (e.g. the initialization
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/Mmakefile,v
retrieving revision 1.9
diff -u -b -r1.9 Mmakefile
--- tests/tabling/Mmakefile 1999/10/29 06:53:48 1.9
+++ tests/tabling/Mmakefile 1999/12/28 05:41:09
@@ -8,6 +8,7 @@
SIMPLE_PROGS = \
boyer \
+ ffib \
fib \
loopcheck
Index: tests/tabling/ffib.exp
===================================================================
RCS file: ffib.exp
diff -N ffib.exp
--- /dev/null Thu Sep 2 15:00:04 1999
+++ ffib.exp Sat Dec 25 23:26:11 1999
@@ -0,0 +1 @@
+tabling works
Index: tests/tabling/ffib.m
===================================================================
RCS file: ffib.m
diff -N ffib.m
--- /dev/null Thu Sep 2 15:00:04 1999
+++ ffib.m Sat Dec 25 23:25:05 1999
@@ -0,0 +1,74 @@
+:- module ffib.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module benchmarking, require, int, float.
+
+main -->
+ perform_trials(20.0).
+
+:- pred perform_trials(float::in, io__state::di, io__state::uo) is cc_multi.
+
+perform_trials(N) -->
+ { trial(N, Time, MTime) },
+ io__write_float(N),
+ io__write_string(": "),
+ io__write_int(Time),
+ io__write_string("ms vs "),
+ io__write_int(MTime),
+ io__write_string("ms\n"),
+ (
+ {
+ Time > 10 * MTime,
+ MTime > 0 % untabled takes ten times as long
+ ;
+ Time > 100, % untabled takes at least 100 ms
+ MTime < 1 % while untabled takes at most 1 ms
+ }
+ ->
+ io__write_string("tabling works\n")
+ ;
+ { Time > 10000 } % Untabled takes at least 10 seconds
+ ->
+ io__write_string("tabling does not appear to work\n")
+ ;
+ % We couldn't get a measurable result with N,
+ % and it looks like we can afford a bigger trial
+ perform_trials(N + 3.0)
+ ).
+
+:- pred trial(float::in, int::out, int::out) is cc_multi.
+
+trial(N, Time, MTime) :-
+ benchmark_det(fib, N, Res, 1, Time),
+ benchmark_det(mfib, N, MRes, 1, MTime),
+ require(unify(Res, MRes), "tabling produces wrong answer").
+
+:- pred fib(float::in, float::out) is det.
+
+fib(N, F) :-
+ ( N < 2.0 ->
+ F = 1.0
+ ;
+ fib(N - 1.0, F1),
+ fib(N - 2.0, F2),
+ F is F1 + F2
+ ).
+
+:- pred mfib(float::in, float::out) is det.
+:- pragma memo(mfib/2).
+
+mfib(N, F) :-
+ ( N < 2.0 ->
+ F = 1.0
+ ;
+ mfib(N - 1.0, F1),
+ mfib(N - 2.0, F2),
+ F is F1 + F2
+ ).
Index: tests/tabling/fib.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/fib.m,v
retrieving revision 1.1
diff -u -b -r1.1 fib.m
--- tests/tabling/fib.m 1998/08/14 06:27:08 1.1
+++ tests/tabling/fib.m 1999/12/25 11:40:39
@@ -11,16 +11,18 @@
:- import_module benchmarking, require, int.
main -->
- perform_trials(10).
+ perform_trials(20).
:- pred perform_trials(int::in, io__state::di, io__state::uo) is cc_multi.
perform_trials(N) -->
{ trial(N, Time, MTime) },
+ % io__write_int(N),
+ % io__write_string(": "),
% io__write_int(Time),
- % io__write_string(" "),
+ % io__write_string("ms vs "),
% io__write_int(MTime),
- % io__write_string(" \n"),
+ % io__write_string("ms\n"),
(
{
Time > 10 * MTime,
Index: tests/tabling/tc_loop.exp
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/tc_loop.exp,v
retrieving revision 1.1
diff -u -b -r1.1 tc_loop.exp
--- tests/tabling/tc_loop.exp 1998/08/14 06:27:09 1.1
+++ tests/tabling/tc_loop.exp 1999/12/25 23:58:00
@@ -1,2 +1,3 @@
-Software error: detected infinite recursion in pred tc_loop:tc/2
+Uncaught exception:
+Software Error: detected infinite recursion in pred tc_loop:tc/2
Stack dump not available in this grade.
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.61
diff -u -b -r1.61 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 1999/12/20 14:04:03 1.61
+++ trace/mercury_trace_internal.c 1999/12/28 05:19:44
@@ -97,6 +97,18 @@
#endif
/*
+** We don't want to see any messages from initialization code about
+** entering and leaving commits. We must therefore disable MR_tabledebug
+** at the start after saving its old value in MR_saved_tabledebug, and
+** restore the old value when we have finished executing all initialization
+** code.
+*/
+
+#ifdef MR_TABLE_DEBUG
+bool MR_saved_tabledebug;
+#endif
+
+/*
** We print confirmation of commands (e.g. new aliases) if this is TRUE.
*/
@@ -203,6 +215,7 @@
char *line;
MR_Next res;
MR_Event_Details event_details;
+ bool saved_tabledebug;
if (! interactive) {
return MR_trace_event_internal_report(cmd, event_info);
@@ -216,7 +229,16 @@
}
#endif MR_USE_DECLARATIVE_DEBUGGER
+ /*
+ ** We want to make sure that the Mercury code used to implement some
+ ** of the debugger's commands (a) doesn't generate any trace events,
+ ** and (b) doesn't generate any unwanted debugging output.
+ */
+
MR_trace_enabled = FALSE;
+ saved_tabledebug = MR_tabledebug;
+ MR_tabledebug = FALSE;
+
MR_trace_internal_ensure_init();
MR_trace_event_print_internal_report(event_info);
@@ -254,6 +276,7 @@
MR_scroll_next = 0;
MR_trace_enabled = TRUE;
+ MR_tabledebug = saved_tabledebug;
return jumpaddr;
}
@@ -289,6 +312,10 @@
if (! MR_trace_internal_initialized) {
char *env;
int n;
+#ifdef MR_TABLE_DEBUG
+ MR_saved_tabledebug = MR_tabledebug;
+ MR_tabledebug = FALSE;
+#endif
MR_mdb_in = MR_try_fopen(MR_mdb_in_filename, "r", stdin);
MR_mdb_out = MR_try_fopen(MR_mdb_out_filename, "w", stdout);
@@ -1506,8 +1533,13 @@
#ifdef MR_USE_MINIMAL_MODEL
} else if (streq(words[0], "gen_stack")) {
if (word_count == 1) {
+ bool saved_tabledebug;
+
do_init_modules();
+ saved_tabledebug = MR_tabledebug;
+ MR_tabledebug = TRUE;
MR_print_gen_stack(MR_mdb_out);
+ MR_tabledebug = saved_tabledebug;
} else {
MR_trace_usage("developer", "gen_stack");
}
cvs diff: Diffing trial
cvs diff: Diffing util
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list