[m-dev.] for review: cleanup of tabling
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Dec 30 19:42:31 AEDT 1999
> Why not use
>
> enum {
> MR_SIMPLETABLE_UNINITIALIZED,
> MR_SIMPLETABLE_WORKING,
> MR_SIMPLETABLE_FAILED,
> MR_SIMPLETABLE_SUCCEEDED
> };
> typedef Integer MR_SimpletableStatus;
What does this do that the implemented approach doesn't? Remember, the code
must do a >= comparison on MR_SIMPLETABLE_SUCCEEDED; if it were in an enum,
that would look odd.
>> Memoization and loop check could possibly be made to work for MLDS, after
>> a lot of work has been put into eliminating the assumptions currently built
>> in (e.g. all arguments are Word sized) that are not true for the MLDS.
>
> I don't think that assumption is really built in.
Answer tables are indexed by output argument number; this requires all
output args to be the same size.
> I'm on holidays from Christmas until about Jan 5th.
> And I leave for the US on Jan 8th.
> I'm not sure if I will have time before then.
> I'll review it if I can find time, but no guarantees.
> So if you want a timely review, I suggest you ask someone else ;-)
OK, any volunteers? The updated full diff follows; the log entry remains
the same.
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/30 09:29:37
@@ -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,15 @@
** 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(MR_SubgoalListNode);
subgoal->followers->item = subgoal;
subgoal->followers->next = NULL;
subgoal->followers_tail = &(subgoal->followers->next);
@@ -884,18 +925,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 +951,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 +963,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 +975,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 +990,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 +1002,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 +1043,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 +1075,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 +1095,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 +1210,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/30 08:21:29
@@ -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/30 08:21:30
@@ -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/30 08:21:30
@@ -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/30 08:39:30
@@ -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_HashTable_Struct {
+ 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);
- listnode = table_allocate_bytes(sizeof(struct MR_ConsumerListNode));
- *(table->consumer_list_tail) = listnode;
- table->consumer_list_tail = &(listnode->next);
+ assert(*(subgoal->consumer_list_tail) == NULL);
+ listnode = table_allocate_bytes(sizeof(MR_ConsumerListNode));
+ *(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/30 09:26:00
@@ -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,522 +24,102 @@
#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.
+** Forward declarations of type names.
*/
-MR_TrieNode MR_type_info_lookup_or_add(MR_TrieNode, Word *);
-/* --- a function to handle enumerated types --- */
+typedef union MR_TableNode_Union MR_TableNode;
+typedef struct MR_HashTable_Struct MR_HashTable;
+typedef struct MR_Subgoal_Struct MR_Subgoal;
+typedef struct MR_SubgoalListNode_Struct MR_SubgoalListNode;
+typedef struct MR_AnswerListNode_Struct MR_AnswerListNode;
+typedef struct MR_ConsumerListNode_Struct MR_ConsumerListNode;
+
+typedef MR_TableNode *MR_TrieNode;
+typedef MR_SubgoalListNode *MR_SubgoalList;
+typedef MR_AnswerListNode *MR_AnswerList;
+typedef MR_ConsumerListNode *MR_ConsumerList;
-/*
-** 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 --- */
-
-/*
-** 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);
-
/*---------------------------------------------------------------------------*/
-#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)
-
-/*---------------------------------------------------------------------------*/
-
-typedef struct MR_AnswerListNodeStruct MR_AnswerListNode;
-typedef struct MR_AnswerListNodeStruct *MR_AnswerList;
-
-struct MR_AnswerListNodeStruct {
- Integer answer_num;
- Word answer_data;
- 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.
+** 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.
+**
+** We declare trie nodes to have type MR_TrieNode, which is a pointer to
+** MR_TableNode. MR_TableNode is a union of all the types that we may need
+** to be able to store in trie nodes: various kinds of trie implementations,
+** status indications, and answer blocks. Since in several places we write
+** to the union through one member and read from it through another, it is
+** important that all members be the same size; this is why the simple table
+** status field is an (unsigned) integer, not an enum.
+**
+** The integer field is by generic code that does not know what kind of node
+** the node will be; this means initialization. A value of zero means the node
+** is uninitialized; this must be true for all members. (Also, see below on
+** duplicate detection.)
+**
+** The hash table field is used when the "trie" node is implemented with a
+** hash table, whether of ints, floats, strings or another type that can be
+** coerced to one of these types.
+**
+** The fix table field implements a true trie node of fixed size, simply
+** indexed by an integer.
**
-** Note that the word containing the MR_SimpletableStatus,
-** which is at the end of the chain of trie nodes given by
-** the input arguments of the tabled subgoal, will be overwritten
-** by a pointer to the answer block containing the output arguments
-** when the goal succeeds. The MR_SIMPLETABLE_SUCCEEDED status code
-** is used only when the goal has no outputs. This is why
-** MR_SIMPLETABLE_SUCCEEDED must the last entry in the enum,
-** and why code looking at an MR_SimpletableStatus must test
-** for success with "(Unsigned) x >= MR_SIMPLETABLE_SUCCEEDED".
+** The start table field implements a dynamically expandable trie node,
+** simply indexed by the difference between an integer value and a start value.
+**
+** The MR_simpletable_status member of the union gives the status of a
+** model_det or model_semi subgoal; it should be interpreted using the
+** macros below. Note that this word, which is at the end of the chain of
+** trie nodes given by the input arguments of the tabled subgoal, will be
+** overwritten by a pointer to the answer block containing the output
+** arguments when the goal succeeds; the MR_SIMPLETABLE_SUCCEEDED status code
+** is used only when the goal has no outputs, and this no answer block.
+** This is why MR_SIMPLETABLE_SUCCEEDED must have the highest value, and
+** why code looking at MR_simpletable_status must test for success with
+** "table->MR_simpletable_status >= MR_SIMPLETABLE_SUCCEEDED".
+**
+** The subgoal field contains the status of a model_non subgoal.
+**
+** The answer block field contains a pointer to an array of words, with
+** one word per output argument.
+**
+** The hash table, fix table and start table members may appear at any interior
+** node in the trie. The simple table status and subgoal members only appear
+** at the tips of call tables. The answer block member appears only at the tips
+** of call tables, either directly (for model_det and model_semi procedures),
+** or indirectly inside answer lists (for model_non procedures). There are no
+** answer tables for model_det and model_semi procedures, since they can only
+** ever have at most one answer. You can of course have answer tables for
+** model_non procedures, at whose tips you find only a duplicate indication.
+** When the tip nodes of answer tables are created, they are initialized to
+** zero as usual. Duplicate checking checks that the tip node is zero and
+** then sets the tip to a nonzero value; this way if the answer is generated
+** again, duplicate checking will fail.
*/
-typedef enum {
- MR_SIMPLETABLE_UNINITIALIZED,
- MR_SIMPLETABLE_WORKING,
- MR_SIMPLETABLE_FAILED,
- MR_SIMPLETABLE_SUCCEEDED
-} MR_SimpletableStatus;
+union MR_TableNode_Union {
+ Integer MR_integer;
+ MR_HashTable *MR_hash_table;
+ MR_TableNode *MR_fix_table;
+ MR_TableNode *MR_start_table;
+ Unsigned MR_simpletable_status;
+ MR_Subgoal *MR_subgoal;
+ Word *MR_answerblock;
+};
-#ifdef MR_USE_MINIMAL_MODEL
+#define MR_SIMPLETABLE_UNINITIALIZED 0
+#define MR_SIMPLETABLE_WORKING 1
+#define MR_SIMPLETABLE_FAILED 2
+#define MR_SIMPLETABLE_SUCCEEDED 3
typedef enum {
MR_SUBGOAL_INACTIVE,
@@ -546,6 +127,12 @@
MR_SUBGOAL_COMPLETE
} MR_SubgoalStatus;
+struct MR_AnswerListNode_Struct {
+ Integer answer_num;
+ MR_TableNode answer_data; /* always uses the MR_answerblock member */
+ MR_AnswerList next_answer;
+};
+
/*
** The saved state of a generator or a consumer. While consumers get
** suspended while they are waiting for generators to produce more solutions,
@@ -597,17 +184,12 @@
MR_SavedState saved_state;
MR_AnswerList *remaining_answer_list_ptr;
} MR_Consumer;
-
-typedef struct MR_ConsumerListNode *MR_ConsumerList;
-struct MR_ConsumerListNode {
+struct MR_ConsumerListNode_Struct {
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.
@@ -623,13 +205,13 @@
bool changed;
} MR_ResumeInfo;
-struct MR_SubgoalListNode {
+struct MR_SubgoalListNode_Struct {
MR_Subgoal *item;
MR_SubgoalList next;
};
/* Used to save info about a single subgoal in the table */
-struct MR_SubgoalStruct {
+struct MR_Subgoal_Struct {
MR_SubgoalStatus status;
MR_Subgoal *leader;
MR_SubgoalList followers;
@@ -660,15 +242,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_RESIZE_ARRAY((ptr), type, (count))
+
+ #define table_allocate_bytes(size) \
+ MR_GC_malloc((size))
+
+ #define table_reallocate_bytes(pointer, size) \
+ MR_GC_realloc((pointer), (size))
+
+ #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))
- /*
- ** Cast a Word to a MR_Subgoal*: saves on typing and improves
- ** readability.
- */
-#define MR_SUBGOAL(T) (*(MR_Subgoal **) T)
+#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 Thu Dec 30 20:23:31 1999
@@ -0,0 +1,358 @@
+/*
+** 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); \
+ Word local_type_info = (type_info); \
+ (table)->MR_answerblock[(offset)] = \
+ deep_copy(&local_val, &tlocal_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/30 08:21:30
@@ -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/30 08:21:30
@@ -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/30 08:21:48
@@ -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 Thu Dec 30 19:21:49 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 Thu Dec 30 19:21:49 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/30 08:21:48
@@ -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/30 08:21:48
@@ -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/30 08:21:35
@@ -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