for review: fix to get tests/tabling/tc_minimal to work
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Sep 18 17:47:36 AEST 1998
This is for Oliver.
runtime/mercury_tabling.h:
Replace the macro table_allocate with two macros table_allocate_bytes
and table_allocate_words, which are explicit about the unit of their
size argument.
Replace the macro table_reallocate with two macros
table_reallocate_bytes and table_reallocate_words,
which are explicit about the unit of their size argument.
Replace the macro table_copy_mem with two macros table_copy_bytes
and table_copy_words, which are explicit about the unit of their
size argument.
Fix the MR_DEBUG_TABLE_* macros, which had the old and new table
pointers the wrong way around in the conditionally enabled diagnostic
messages.
runtime/mercury_table_*.c:
Replace references to the obsolete macros with their appropriate
replacements.
runtime/mercury_stack trace.c:
When dumping the nondet stack, print the size of each stack frame.
This makes it easier to find bugs involving confusion of bytes and
words :-)
library/private_builtin.m:
Fix some bugs involving confusion of bytes and words using the new
macros from mercury_tabling.h.
Make debugging easier, by using variables (whose values can be printed
quite easily in gdb) instead of macros involving several casts (which
cannot be printed easily in gdb), and by adding conditionally included
code that prints diagnostics at saves and restores of stack segments.
Delete some dead code.
Clean up the formatting in some places.
tests/tabling/Mmakefile:
Enable the tc_minimal benchmark, since we now pass it.
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 bytecode/test
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
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/exceptions
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/Togl-1.2
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/odbc
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.8
diff -u -u -r1.8 private_builtin.m
--- private_builtin.m 1998/09/10 06:56:14 1.8
+++ private_builtin.m 1998/09/18 04:29:08
@@ -103,7 +103,7 @@
/*, ... */).
:- type base_typeclass_info(_) ---> typeclass_info(int /*, ... */).
- % type_info_from_typeclass_info(TypeClassInfo, Index, TypeInfo)
+ % type_info_from_typeclass_info(TypeClassInfo, Index, TypeInfo)
% extracts TypeInfo from TypeClassInfo, where TypeInfo is the Indexth
% type_info in the typeclass_info
%
@@ -112,7 +112,7 @@
:- pred type_info_from_typeclass_info(typeclass_info(_), int, type_info(T)).
:- mode type_info_from_typeclass_info(in, in, out) is det.
- % superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass)
+ % superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass)
% extracts SuperClass from TypeClassInfo where TypeInfo is the Indexth
% superclass of the class.
:- pred superclass_from_typeclass_info(typeclass_info(_),
@@ -233,7 +233,7 @@
% not being evaluated (working on an answer).
:- impure pred table_mark_done_working(ml_subgoal_table_node).
:- mode table_mark_done_working(in) is det.
-
+
% Report an error message about the current subgoal looping.
:- pred table_loopcheck_error(string).
:- mode table_loopcheck_error(in) is erroneous.
@@ -336,7 +336,7 @@
:- semipure pred table_restore_int_ans(ml_answer_block, int, int).
:- mode table_restore_int_ans(in, in, out) is det.
- % Restore a character answer from the given answer block at the
+ % Restore a character answer from the given answer block at the
% given offset.
:- semipure pred table_restore_char_ans(ml_answer_block, int, character).
:- mode table_restore_char_ans(in, in, out) is det.
@@ -525,7 +525,7 @@
#include ""mercury_deep_copy.h""
#include ""mercury_type_info.h""
-
+
/* Used to mark the status of the table */
#define ML_UNINITIALIZED 0
#define ML_WORKING_ON_ANS 1
@@ -536,25 +536,25 @@
** succeeded. */
").
-
+
% This is a dummy procedure that never actually gets called.
% See the comments in table_gen.m for its purpose.
:- pragma c_code(get_table(_T::out), will_not_call_mercury, "").
:- pragma c_code(table_working_on_ans(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word*) T) == ML_WORKING_ON_ANS);
+ SUCCESS_INDICATOR = (*((Word *) T) == ML_WORKING_ON_ANS);
").
:- pragma c_code(table_not_working_on_ans(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word*) T) != ML_WORKING_ON_ANS);
+ SUCCESS_INDICATOR = (*((Word *) T) != ML_WORKING_ON_ANS);
").
:- pragma c_code(table_mark_as_working(T::in), will_not_call_mercury, "
- *((Word*) T) = ML_WORKING_ON_ANS;
+ *((Word *) T) = ML_WORKING_ON_ANS;
").
:- pragma c_code(table_mark_done_working(T::in), will_not_call_mercury, "
- *((Word*) T) = ML_UNINITIALIZED;
+ *((Word *) T) = ML_UNINITIALIZED;
").
table_loopcheck_error(Message) :-
@@ -598,7 +598,7 @@
").
:- pragma c_code(table_have_ans(T::in), will_not_call_mercury, "
- if (*((Word*) T) == ML_FAILED || *((Word*) T) >= ML_SUCCEEDED) {
+ if (*((Word *) T) == ML_FAILED || *((Word *) T) >= ML_SUCCEEDED) {
SUCCESS_INDICATOR = TRUE;
} else {
SUCCESS_INDICATOR = FALSE;
@@ -606,11 +606,11 @@
").
:- pragma c_code(table_has_succeeded(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word*) T) >= ML_SUCCEEDED)
+ SUCCESS_INDICATOR = (*((Word *) T) >= ML_SUCCEEDED)
").
:- pragma c_code(table_has_failed(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word*) T) == ML_FAILED);
+ SUCCESS_INDICATOR = (*((Word *) T) == ML_FAILED);
").
:- pragma c_code(table_create_ans_block(T0::in, Size::in, T::out) ,"
@@ -665,11 +665,11 @@
").
:- pragma c_code(table_mark_as_succeeded(T::in), will_not_call_mercury, "
- *((Word*) T) = ML_SUCCEEDED;
+ *((Word *) T) = ML_SUCCEEDED;
").
:- pragma c_code(table_mark_as_failed(T::in), will_not_call_mercury, "
- *((Word*) T) = ML_FAILED;
+ *((Word *) T) = ML_FAILED;
").
:- pragma c_code(table_restore_int_ans(T::in, Offset::in, I::out),
@@ -729,7 +729,7 @@
have_all_ans
} TableStatus;
-/* Used to save info about a single subgoal in the table */
+/* Used to save info about a single subgoal in the table */
typedef struct {
TableStatus status; /* Status of subgoal */
Word answer_table; /* Table of answers returned by the
@@ -750,7 +750,7 @@
copy */
Word *det_stack_bottom; /* Pointer to the bottom point of
the det stack from which to copy */
-
+
} NondetTable;
/* Flag used to indicate the answer has been returned */
@@ -761,25 +761,24 @@
** Cast a Word to a NondetTable*: saves on typing and improves
** readability.
*/
-#define NON_TABLE(T) (*(NondetTable **)T)
+#define NON_TABLE(T) (*(NondetTable **) T)
").
:- pragma c_code(table_setup(T0::in, T::out), will_not_call_mercury, "
/* Init the table if this is the first time me see it */
if (NON_TABLE(T0) == NULL) {
- NON_TABLE(T0) = (NondetTable *) table_allocate(
+ NondetTable *table = (NondetTable *) table_allocate_bytes(
sizeof(NondetTable));
- NON_TABLE(T0)->status = have_no_ans;
- NON_TABLE(T0)->answer_table = (Word) NULL;
- NON_TABLE(T0)->num_ans = 0;
- NON_TABLE(T0)->answer_list = list_empty();
- NON_TABLE(T0)->answer_list_tail =
- &NON_TABLE(T0)->answer_list;
- NON_TABLE(T0)->suspend_list = list_empty();
- NON_TABLE(T0)->suspend_list_tail =
- &NON_TABLE(T0)->suspend_list;
- NON_TABLE(T0)->non_stack_bottom = curprevfr;
- NON_TABLE(T0)->det_stack_bottom = MR_sp;
+ table->status = have_no_ans;
+ table->answer_table = (Word) NULL;
+ table->num_ans = 0;
+ table->answer_list = list_empty();
+ table->answer_list_tail = &table->answer_list;
+ table->suspend_list = list_empty();
+ table->suspend_list_tail = &table->suspend_list;
+ table->non_stack_bottom = MR_prevfr_slot(MR_curfr);
+ table->det_stack_bottom = MR_sp;
+ NON_TABLE(T0) = table;
}
T = T0;
").
@@ -794,7 +793,7 @@
:- pragma c_code(table_return_all_ans_list(T::in, A::out),
will_not_call_mercury, "
- A = NON_TABLE(T)->answer_list;
+ A = (Word) NON_TABLE(T)->answer_list;
").
:- semipure pred table_return_all_ans_2(ml_table, ml_table).
@@ -802,7 +801,7 @@
:- pragma c_code(table_return_all_ans_2(P::in, A::out),
will_not_call_mercury, "
- A = (Word) &((AnswerListNode*) P)->ans;
+ A = (Word) &((AnswerListNode *) P)->ans;
").
:- pragma c_code(table_get_ans_table(T::in, AT::out),
@@ -819,7 +818,7 @@
").
:- pragma c_code(table_has_not_returned(T::in), will_not_call_mercury, "
- SUCCESS_INDICATOR = (*((Word*) T) == ML_ANS_NOT_RET);
+ SUCCESS_INDICATOR = (*((Word *) T) == ML_ANS_NOT_RET);
").
:- pragma c_code(table_mark_have_all_ans(T::in), will_not_call_mercury, "
@@ -851,8 +850,8 @@
** It is also important to note that the answers are returned not from the
** procedure that was originally called (table_suspend) but from the procedure
** table_resume. So essentially what is below is the code to do the initial
-** fail; the code to return the answers is in table_resume.
-*/
+** fail; the code to return the answers is in table_resume.
+*/
Define_extern_entry(mercury__table_suspend_2_0);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__table_suspend_2_0);
BEGIN_MODULE(table_suspend_module)
@@ -860,27 +859,33 @@
BEGIN_CODE
Define_entry(mercury__table_suspend_2_0);
+ /*
+ ** This frame is not used in table_suspend, but it is copied
+ ** to the suspend list as part of the saved nondet stack fragment,
+ ** and it *will* be used when table_resume copies back the nondet
+ ** stack fragment.
+ */
mkframe(mercury__table_suspend/2, 0, ENTRY(do_fail));
{
+ NondetTable *table = NON_TABLE(r1);
Word *non_stack_top = MR_maxfr;
Word *det_stack_top = MR_sp;
- Word *non_stack_bottom = NON_TABLE(r1)->non_stack_bottom;
- Word *det_stack_bottom = NON_TABLE(r1)->det_stack_bottom;
+ Word *non_stack_bottom = table->non_stack_bottom;
+ Word *det_stack_bottom = table->det_stack_bottom;
Word non_stack_delta = non_stack_top - non_stack_bottom;
Word det_stack_delta = det_stack_top - det_stack_bottom;
Word ListNode;
- SuspendListNode *Node = table_allocate(sizeof(SuspendListNode));
+ SuspendListNode *Node = table_allocate_bytes(sizeof(SuspendListNode));
+ Node->last_ret_ans = &table->answer_list;
- Node->last_ret_ans = &(NON_TABLE(r1)->answer_list);
-
Node->non_stack_block_size = non_stack_delta;
- Node->non_stack_block = table_allocate(non_stack_delta);
- table_copy_mem((void *)Node->non_stack_block, (void *)non_stack_bottom,
- non_stack_delta);
-
+ Node->non_stack_block = table_allocate_words(non_stack_delta);
+ table_copy_words(Node->non_stack_block, non_stack_bottom,
+ non_stack_delta);
+
Node->det_stack_block_size = det_stack_delta;
- Node->det_stack_block = table_allocate(det_stack_delta);
- table_copy_mem((void *)Node->det_stack_block, (void *)det_stack_bottom,
+ Node->det_stack_block = table_allocate_words(det_stack_delta);
+ table_copy_words(Node->det_stack_block, det_stack_bottom,
det_stack_delta);
Node->succ_ip = MR_succip;
@@ -888,11 +893,27 @@
Node->cur_fr = MR_curfr;
Node->max_fr = MR_maxfr;
- ListNode = MR_table_list_cons(Node, *NON_TABLE(r1)->suspend_list_tail);
- *NON_TABLE(r1)->suspend_list_tail = ListNode;
- NON_TABLE(r1)->suspend_list_tail = &list_tail(ListNode);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""suspension saves consumer stack: %d non, %d det\n"",
+ non_stack_delta, det_stack_delta);
+ printf(""non region from %p to %p, det region from %p to %p\n"",
+ (void *) non_stack_bottom,
+ (void *) MR_maxfr,
+ (void *) det_stack_bottom,
+ (void *) MR_sp);
+ printf(""succip = %p, sp = %p, maxfr = %p, curfr = %p\n"",
+ (void *) MR_succip, (void *) MR_sp,
+ (void *) MR_maxfr, (void *) MR_curfr);
+ }
+#endif
+
+ assert(list_is_empty(*table->suspend_list_tail));
+ ListNode = MR_table_list_cons(Node, list_empty());
+ *table->suspend_list_tail = ListNode;
+ table->suspend_list_tail = &list_tail(ListNode);
}
- fail();
+ fail();
END_MODULE
/*
@@ -908,14 +929,15 @@
Word *non_stack_block;
Word det_stack_block_size;
Word *det_stack_block;
-
+
Code *succ_ip;
Word *s_p;
Word *cur_fr;
Word *max_fr;
Word changed;
- Word num_ans, new_num_ans;
+ Word num_ans;
+ Word new_num_ans;
Word suspend_list;
SuspendListNode *suspend_node;
Word ans_list;
@@ -926,7 +948,7 @@
Word ML_resumption_stack_size = 4; /* Half the initial size of
the stack in ResumeStackNode's */
-ResumeStackNode** ML_resumption_stack = NULL;
+ResumeStackNode **ML_resumption_stack = NULL;
#define ML_RESUME_PUSH() \\
do { \\
@@ -935,16 +957,16 @@
ML_resumption_stack == NULL) \\
{ \\
ML_resumption_stack_size = \\
- ML_resumption_stack_size*2; \\
- ML_resumption_stack = table_reallocate( \\
+ ML_resumption_stack_size * 2; \\
+ ML_resumption_stack = table_reallocate_bytes( \\
ML_resumption_stack, \\
- ML_resumption_stack_size*sizeof( \\
- ResumeStackNode*)); \\
+ ML_resumption_stack_size * sizeof( \\
+ ResumeStackNode *)); \\
} \\
- ML_resumption_stack[ML_resumption_sp] = table_allocate( \\
- sizeof(ResumeStackNode)); \\
+ ML_resumption_stack[ML_resumption_sp] = \\
+ table_allocate_bytes(sizeof(ResumeStackNode)); \\
} while (0)
-
+
#define ML_RESUME_POP() \\
do { \\
if (ML_resumption_sp < 0) { \\
@@ -957,6 +979,23 @@
#define ML_RESUME_VAR \\
ML_resumption_stack[ML_resumption_sp]
+#ifdef MR_DEBUG_RESUME
+
+ NondetTable *RESUME_DEBUG_TABLE;
+ ResumeStackNode *RESUME_DEBUG_VAR;
+
+ #define ML_SET_RESUME_DEBUG_VARS() \\
+ do { \\
+ RESUME_DEBUG_VAR = ML_resumption_stack[ML_resumption_sp];\\
+ RESUME_DEBUG_TABLE = MR_RESUME_VAR->table; \\
+ } while (0)
+
+#else
+
+ #define ML_SET_RESUME_DEBUG_VARS()
+
+#endif
+
/*
** The procedure defined below restores answers to suspended nodes. It
** works by restoring the states saved when calls to table_suspend were
@@ -966,7 +1005,7 @@
** This procedure iterates until it has returned all answers to all
** suspend nodes. The iteration is a fixpoint type as each time an answer
** is returned to a suspended node it has the chance of introducing more
-** answers and/or suspended nodes.
+** answers and/or suspended nodes.
*/
Define_extern_entry(mercury__table_resume_1_0);
Declare_label(mercury__table_resume_1_0_ChangeLoop);
@@ -975,7 +1014,6 @@
Declare_label(mercury__table_resume_1_0_AnsListLoop);
Declare_label(mercury__table_resume_1_0_AnsListLoopDone1);
Declare_label(mercury__table_resume_1_0_AnsListLoopDone2);
-Declare_label(mercury__table_resume_1_0_SkipAns);
Declare_label(mercury__table_resume_1_0_RedoPoint);
MR_MAKE_STACK_LAYOUT_ENTRY(mercury__table_resume_1_0);
@@ -992,8 +1030,6 @@
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
mercury__table_resume_1_0_AnsListLoopDone2, mercury__table_resume_1_0);
MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
- mercury__table_resume_1_0_SkipAns, mercury__table_resume_1_0);
-MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(
mercury__table_resume_1_0_RedoPoint, mercury__table_resume_1_0);
BEGIN_MODULE(table_resume_module)
@@ -1004,29 +1040,33 @@
init_label_sl(mercury__table_resume_1_0_AnsListLoop);
init_label_sl(mercury__table_resume_1_0_AnsListLoopDone1);
init_label_sl(mercury__table_resume_1_0_AnsListLoopDone2);
- init_label_sl(mercury__table_resume_1_0_SkipAns);
init_label_sl(mercury__table_resume_1_0_RedoPoint);
BEGIN_CODE
Define_entry(mercury__table_resume_1_0);
/* Check that we have answers to return and nodes to return
them to. */
- if (list_is_empty(NON_TABLE(r1)->answer_list) ||
- list_is_empty(NON_TABLE(r1)->suspend_list))
+ if (list_is_empty(NON_TABLE(r1)->answer_list))
+ /* we should free the suspend list */
proceed();
-
- /* Save the current state. */
+
+ if (list_is_empty(NON_TABLE(r1)->suspend_list))
+ proceed();
+
+ /* Save the current state. */
ML_RESUME_PUSH();
ML_RESUME_VAR->table = NON_TABLE(r1);
- ML_RESUME_VAR->non_stack_block_size = (char *) MR_maxfr -
- (char *) ML_RESUME_VAR->table->non_stack_bottom;
- ML_RESUME_VAR->det_stack_block_size = (char *) MR_sp -
- (char *) ML_RESUME_VAR->table->det_stack_bottom;
+ ML_RESUME_VAR->non_stack_block_size =
+ MR_maxfr - ML_RESUME_VAR->table->non_stack_bottom;
+ ML_RESUME_VAR->det_stack_block_size =
+ MR_sp - ML_RESUME_VAR->table->det_stack_bottom;
ML_RESUME_VAR->succ_ip = MR_succip;
ML_RESUME_VAR->s_p = MR_sp;
ML_RESUME_VAR->cur_fr = MR_curfr;
ML_RESUME_VAR->max_fr = MR_maxfr;
+ ML_SET_RESUME_DEBUG_VARS();
+
#ifdef MR_USE_TRAIL
/*
** We ought to save the trail state here --
@@ -1037,44 +1077,63 @@
#endif
ML_RESUME_VAR->changed = 1;
-
- ML_RESUME_VAR->non_stack_block = (Word *) table_allocate(
+
+ ML_RESUME_VAR->non_stack_block = (Word *) table_allocate_words(
ML_RESUME_VAR->non_stack_block_size);
- table_copy_mem(ML_RESUME_VAR->non_stack_block,
+ table_copy_words(ML_RESUME_VAR->non_stack_block,
ML_RESUME_VAR->table->non_stack_bottom,
ML_RESUME_VAR->non_stack_block_size);
-
- ML_RESUME_VAR->det_stack_block = (Word *) table_allocate(
+
+ ML_RESUME_VAR->det_stack_block = (Word *) table_allocate_words(
ML_RESUME_VAR->det_stack_block_size);
- table_copy_mem(ML_RESUME_VAR->det_stack_block,
+ table_copy_words(ML_RESUME_VAR->det_stack_block,
ML_RESUME_VAR->table->det_stack_bottom,
ML_RESUME_VAR->det_stack_block_size);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""resumption saves generator stack: %d non, %d det\n"",
+ ML_RESUME_VAR->non_stack_block_size,
+ ML_RESUME_VAR->det_stack_block_size);
+ printf(""non region from %p to %p, det region from %p to %p\n"",
+ (void *) ML_RESUME_VAR->table->non_stack_bottom,
+ (void *) MR_maxfr,
+ (void *) ML_RESUME_VAR->table->det_stack_bottom,
+ (void *) MR_sp);
+ printf(""succip = %p, sp = %p, maxfr = %p, curfr = %p\n"",
+ (void *) MR_succip, (void *) MR_sp,
+ (void *) MR_maxfr, (void *) MR_curfr);
+ }
+#endif
+
/* If the number of ans or suspended nodes has changed. */
Define_label(mercury__table_resume_1_0_ChangeLoop);
- if (! ML_RESUME_VAR->changed)
+ ML_SET_RESUME_DEBUG_VARS();
+
+if (! ML_RESUME_VAR->changed)
GOTO_LABEL(mercury__table_resume_1_0_ChangeLoopDone);
-
+
ML_RESUME_VAR->suspend_list = ML_RESUME_VAR->table->suspend_list;
ML_RESUME_VAR->changed = 0;
ML_RESUME_VAR->num_ans = ML_RESUME_VAR->table->num_ans;
- /* For each of the suspended nodes */
+ /* For each of the suspended nodes */
Define_label(mercury__table_resume_1_0_SolutionsListLoop);
+ ML_SET_RESUME_DEBUG_VARS();
+
if (list_is_empty(ML_RESUME_VAR->suspend_list))
GOTO_LABEL(mercury__table_resume_1_0_ChangeLoop);
- ML_RESUME_VAR->suspend_node = (SuspendListNode *)list_head(
+ ML_RESUME_VAR->suspend_node = (SuspendListNode *) list_head(
ML_RESUME_VAR->suspend_list);
-
- ML_RESUME_VAR->ans_list = *ML_RESUME_VAR->suspend_node->
- last_ret_ans;
-
+
+ ML_RESUME_VAR->ans_list = *ML_RESUME_VAR->suspend_node->last_ret_ans;
+
if (list_is_empty(ML_RESUME_VAR->ans_list))
GOTO_LABEL(mercury__table_resume_1_0_AnsListLoopDone2);
-
- ML_RESUME_VAR->ansNode = (AnswerListNode *)list_head(
+
+ ML_RESUME_VAR->ansNode = (AnswerListNode *) list_head(
ML_RESUME_VAR->ans_list);
/*
@@ -1082,12 +1141,12 @@
** through the redoip we saved when the node was originally
** suspended
*/
-
- table_copy_mem(ML_RESUME_VAR->table->non_stack_bottom,
+
+ table_copy_words(ML_RESUME_VAR->table->non_stack_bottom,
ML_RESUME_VAR->suspend_node->non_stack_block,
ML_RESUME_VAR->suspend_node->non_stack_block_size);
-
- table_copy_mem(ML_RESUME_VAR->table->det_stack_bottom,
+
+ table_copy_words(ML_RESUME_VAR->table->det_stack_bottom,
ML_RESUME_VAR->suspend_node->det_stack_block,
ML_RESUME_VAR->suspend_node->det_stack_block_size);
@@ -1096,64 +1155,90 @@
MR_curfr = ML_RESUME_VAR->suspend_node->cur_fr;
MR_maxfr = ML_RESUME_VAR->suspend_node->max_fr;
- bt_redoip(maxfr) = LABEL(mercury__table_resume_1_0_RedoPoint);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""resumption restores consumer stack: %d non, %d det\n"",
+ ML_RESUME_VAR->suspend_node->non_stack_block_size,
+ ML_RESUME_VAR->suspend_node->det_stack_block_size);
+ printf(""non region from %p to %p, det region from %p to %p\n"",
+ (void *) ML_RESUME_VAR->table->non_stack_bottom,
+ (void *) (ML_RESUME_VAR->table->non_stack_bottom
+ + ML_RESUME_VAR->suspend_node->
+ non_stack_block_size),
+ (void *) ML_RESUME_VAR->table->det_stack_bottom,
+ (void *) (ML_RESUME_VAR->table->det_stack_bottom
+ + ML_RESUME_VAR->suspend_node->
+ det_stack_block_size));
+ printf(""succip = %p, sp = %p, maxfr = %p, curfr = %p\n"",
+ (void *) MR_succip, (void *) MR_sp,
+ (void *) MR_maxfr, (void *) MR_curfr);
+ }
+#endif
+ MR_redoip_slot(MR_maxfr) = LABEL(mercury__table_resume_1_0_RedoPoint);
+ MR_redofr_slot(MR_maxfr) = MR_maxfr;
+
/*
- ** For each answer not returned to the node whose state we are
- ** currently in.
+ ** Return each answer not previously returned to the node
+ ** whose state we are currently in.
*/
Define_label(mercury__table_resume_1_0_AnsListLoop);
-#ifdef COMPACT_ARGS
+ ML_SET_RESUME_DEBUG_VARS();
+
+#ifdef COMPACT_ARGS
r1 = (Word) &ML_RESUME_VAR->ansNode->ans;
#else
r2 = (word) &ML_RESUME_VAR->ansNode->ans;
#endif
/*
- ** Return the answer though the point where suspend should have
+ ** Return the answer through the point where suspend should have
** returned.
*/
succeed();
Define_label(mercury__table_resume_1_0_RedoPoint);
+ ML_SET_RESUME_DEBUG_VARS();
+
update_prof_current_proc(LABEL(mercury__table_resume_1_0));
-
+
ML_RESUME_VAR->ans_list = list_tail(ML_RESUME_VAR->ans_list);
if (list_is_empty(ML_RESUME_VAR->ans_list))
GOTO_LABEL(mercury__table_resume_1_0_AnsListLoopDone1);
- ML_RESUME_VAR->ansNode = (AnswerListNode *)list_head(
+ ML_RESUME_VAR->ansNode = (AnswerListNode *) list_head(
ML_RESUME_VAR->ans_list);
GOTO_LABEL(mercury__table_resume_1_0_AnsListLoop);
Define_label(mercury__table_resume_1_0_AnsListLoopDone1);
+ ML_SET_RESUME_DEBUG_VARS();
+
if (ML_RESUME_VAR->num_ans == ML_RESUME_VAR->table->num_ans)
ML_RESUME_VAR->changed = 0;
else
ML_RESUME_VAR->changed = 1;
-
- ML_RESUME_VAR->suspend_node->last_ret_ans =
- &ML_RESUME_VAR->ans_list;
+ ML_RESUME_VAR->suspend_node->last_ret_ans = &ML_RESUME_VAR->ans_list;
+
Define_label(mercury__table_resume_1_0_AnsListLoopDone2);
+ ML_SET_RESUME_DEBUG_VARS();
+
ML_RESUME_VAR->suspend_list = list_tail(ML_RESUME_VAR->suspend_list);
GOTO_LABEL(mercury__table_resume_1_0_SolutionsListLoop);
-Define_label(mercury__table_resume_1_0_SkipAns);
- ML_RESUME_VAR->ans_list = list_tail(ML_RESUME_VAR->ans_list);
- GOTO_LABEL(mercury__table_resume_1_0_AnsListLoop);
-
Define_label(mercury__table_resume_1_0_ChangeLoopDone);
+ ML_SET_RESUME_DEBUG_VARS();
+
/* Restore the original state we had when this proc was called */
-
- table_copy_mem(ML_RESUME_VAR->table->non_stack_bottom,
+
+ table_copy_words(ML_RESUME_VAR->table->non_stack_bottom,
ML_RESUME_VAR->non_stack_block,
ML_RESUME_VAR->non_stack_block_size);
table_free(ML_RESUME_VAR->non_stack_block);
- table_copy_mem(ML_RESUME_VAR->table->det_stack_bottom,
+ table_copy_words(ML_RESUME_VAR->table->det_stack_bottom,
ML_RESUME_VAR->det_stack_block,
ML_RESUME_VAR->det_stack_block_size);
table_free(ML_RESUME_VAR->det_stack_block);
@@ -1163,11 +1248,32 @@
MR_curfr = ML_RESUME_VAR->cur_fr;
MR_maxfr = ML_RESUME_VAR->max_fr;
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf(""resumption restores generator stack:""
+ "" %d non, %d det\n"",
+ ML_RESUME_VAR->non_stack_block_size,
+ ML_RESUME_VAR->det_stack_block_size);
+ printf(""non region from %p to %p, det region from %p to %p\n"",
+ (void *) ML_RESUME_VAR->table->non_stack_bottom,
+ (void *) (ML_RESUME_VAR->table->non_stack_bottom +
+ ML_RESUME_VAR->non_stack_block_size),
+ (void *) ML_RESUME_VAR->table->det_stack_bottom,
+ (void *) (ML_RESUME_VAR->table->det_stack_bottom +
+ ML_RESUME_VAR->det_stack_block_size));
+ printf(""succip = %p, sp = %p, maxfr = %p, curfr = %p\n"",
+ (void *) MR_succip, (void *) MR_sp,
+ (void *) MR_maxfr, (void *) MR_curfr);
+ }
+#endif
+
ML_RESUME_POP();
-
+
proceed();
END_MODULE
+#undef ML_SET_RESUME_DEBUG_VARS
+
/* Ensure that the initialization code for the above module gets run. */
/*
INIT sys_init_table_suspend_module
@@ -1192,15 +1298,16 @@
will_not_call_mercury, "
Word ListNode;
Word ans_num;
- AnswerListNode *n = table_allocate(sizeof(AnswerListNode));
-
- ++(NON_TABLE(T)->num_ans);
- ans_num = NON_TABLE(T)->num_ans;
+ NondetTable *table = NON_TABLE(T);
+ AnswerListNode *n = table_allocate_bytes(sizeof(AnswerListNode));
+
+ ++table->num_ans;
+ ans_num = table->num_ans;
n->ans_num = ans_num;
n->ans = 0;
- ListNode = MR_table_list_cons(n, *NON_TABLE(T)->answer_list_tail);
- *NON_TABLE(T)->answer_list_tail = ListNode;
- NON_TABLE(T)->answer_list_tail = &list_tail(ListNode);
+ ListNode = MR_table_list_cons(n, *table->answer_list_tail);
+ *table->answer_list_tail = ListNode;
+ table->answer_list_tail = &list_tail(ListNode);
Slot = (Word) &n->ans;
").
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
cvs diff: Diffing runtime
Index: runtime/mercury_stack_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_trace.c,v
retrieving revision 1.16
diff -u -u -r1.16 mercury_stack_trace.c
--- mercury_stack_trace.c 1998/07/29 08:56:03 1.16
+++ mercury_stack_trace.c 1998/09/18 04:30:33
@@ -212,13 +212,15 @@
while (base_maxfr >= MR_nondet_stack_trace_bottom) {
frame_size = base_maxfr - MR_prevfr_slot(base_maxfr);
if (frame_size == MR_NONDET_TEMP_SIZE) {
- fprintf(fp, "%p: nondet temp\n", base_maxfr);
+ fprintf(fp, "%p: nondet temp, %d words\n",
+ base_maxfr, frame_size);
fprintf(fp, " redoip: ");
printlabel(MR_redoip_slot(base_maxfr));
fprintf(fp, " redofr: %p\n",
MR_redofr_slot(base_maxfr));
} else if (frame_size == MR_DET_TEMP_SIZE) {
- fprintf(fp, "%p: nondet temp\n", base_maxfr);
+ fprintf(fp, "%p: nondet temp, %d words\n",
+ base_maxfr, frame_size);
fprintf(fp, " redoip: ");
printlabel(MR_redoip_slot(base_maxfr));
fprintf(fp, " redofr: %p\n",
@@ -226,7 +228,8 @@
fprintf(fp, " detfr: %p\n",
MR_detfr_slot(base_maxfr));
} else {
- fprintf(fp, "%p: ordinary\n", base_maxfr);
+ fprintf(fp, "%p: ordinary, %d words\n",
+ base_maxfr, frame_size);
fprintf(fp, " redoip: ");
printlabel(MR_redoip_slot(base_maxfr));
fprintf(fp, " redofr: %p\n",
Index: runtime/mercury_table_builtins.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_table_builtins.c,v
retrieving revision 1.2
diff -u -u -r1.2 mercury_table_builtins.c
--- mercury_table_builtins.c 1998/07/13 22:44:10 1.2
+++ mercury_table_builtins.c 1998/09/18 04:29:36
@@ -78,13 +78,13 @@
{
Word i;
TableRoot * table =
- table_allocate(sizeof(Word) * 2 + table_size *
- sizeof(TableNode *));
+ table_allocate_bytes(sizeof(Word) * 2 +
+ table_size * sizeof(TableNode *));
table->size = table_size;
table->used_elements = 0;
- for (i=0; i<table_size; i++) {
+ for (i = 0; i < table_size; i++) {
BUCKET(table, i) = NULL;
}
@@ -146,7 +146,7 @@
p = BUCKET(table, bucket);
}
- p = table_allocate(sizeof(TableNode));
+ p = table_allocate_bytes(sizeof(TableNode));
p->key = key;
p->data = NULL;
@@ -220,7 +220,7 @@
p = BUCKET(table, bucket);
}
- p = table_allocate(sizeof(TableNode));
+ p = table_allocate_bytes(sizeof(TableNode));
p->key = float_to_word(key);
p->data = NULL;
@@ -298,7 +298,7 @@
p = BUCKET(table, bucket);
}
- p = table_allocate(sizeof(TableNode));
+ p = table_allocate_bytes(sizeof(TableNode));
p->key = (Word) key;
p->data = NULL;
Index: runtime/mercury_table_enum.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_table_enum.c,v
retrieving revision 1.2
diff -u -u -r1.2 mercury_table_enum.c
--- mercury_table_enum.c 1998/08/24 08:24:53 1.2
+++ mercury_table_enum.c 1998/09/18 04:29:36
@@ -29,7 +29,7 @@
#endif
if (table == NULL) {
- *t = table = table_allocate(sizeof(Word *) * range);
+ *t = table = table_allocate_words(range);
memset(table, 0, sizeof(Word *) * range);
}
Index: runtime/mercury_table_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_table_type_info.c,v
retrieving revision 1.1
diff -u -u -r1.1 mercury_table_type_info.c
--- mercury_table_type_info.c 1998/05/15 07:09:24 1.1
+++ mercury_table_type_info.c 1998/09/18 04:29:36
@@ -25,7 +25,7 @@
int i;
if (*table == NULL) {
- p = table_allocate(sizeof(TreeNode));
+ p = table_allocate_bytes(sizeof(TreeNode));
p->key = type_info;
p->value = (Word) NULL;
@@ -55,7 +55,7 @@
}
}
- p = table_allocate(sizeof(TreeNode));
+ p = table_allocate_bytes(sizeof(TreeNode));
p->key = type_info;
p->value = (Word) NULL;
p->left = NULL;
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.8
diff -u -u -r1.8 mercury_tabling.h
--- mercury_tabling.h 1998/08/24 08:24:56 1.8
+++ mercury_tabling.h 1998/09/18 04:29:36
@@ -66,8 +66,8 @@
(type_info), (value)); \
if (MR_tabledebug) { \
printf("TABLE %p: any %x type %p => %p\n", \
- (table), (value), (type_info), \
- prev_table); \
+ prev_table, (value), (type_info), \
+ (table)); \
} \
} while (0)
@@ -86,8 +86,8 @@
TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_TAG((table), (value)); \
if (MR_tabledebug) { \
- printf("TABLE %p: tag %d => %p\n", (table), \
- (value), prev_table); \
+ printf("TABLE %p: tag %d => %p\n", prev_table, \
+ (value), (table)); \
} \
} while (0)
@@ -108,7 +108,7 @@
(value)); \
if (MR_tabledebug) { \
printf("TABLE %p: enum %d of %d => %p\n", \
- (table), (value), (count), prev_table); \
+ prev_table, (value), (count), (table)); \
} \
} while (0)
@@ -128,7 +128,7 @@
(table) = (Word **) MR_RAW_TABLE_WORD((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: word %d => %p\n", \
- (table), (value), prev_table); \
+ prev_table, (value), (table)); \
} \
} while (0)
@@ -148,7 +148,7 @@
(table) = (Word **) MR_RAW_TABLE_INT((table), (value)); \
if (MR_tabledebug) { \
printf("TABLE %p: int %d => %p\n", \
- (table), (value), prev_table); \
+ prev_table, (value), (table)); \
} \
} while (0)
@@ -168,8 +168,8 @@
(table) = (Word **) MR_RAW_TABLE_CHAR((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: char `%c'/%d => %p\n", \
- (table), (int) (value), (int) (value), \
- prev_table); \
+ prev_table, (int) (value), \
+ (int) (value), (table)); \
} \
} while (0)
@@ -189,8 +189,8 @@
(table) = (Word **) MR_RAW_TABLE_FLOAT((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: float %f => %p\n", \
- (table), (double) word_to_float(value), \
- prev_table); \
+ prev_table, (double) word_to_float(value),\
+ (table)); \
} \
} while (0)
@@ -210,7 +210,7 @@
(table) = (Word **) MR_RAW_TABLE_STRING((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: string `%s' => %p\n", \
- (table), (char *) (value), prev_table); \
+ prev_table, (char *) (value), (table)); \
} \
} while (0)
@@ -230,7 +230,7 @@
(table) = (Word **) MR_RAW_TABLE_TYPE_INFO((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: typeinfo %p => %p\n", \
- (table), (value), prev_table); \
+ prev_table, (value), (table)); \
} \
} while (0)
@@ -335,7 +335,7 @@
#define MR_TABLE_CREATE_ANSWER_BLOCK(ABlock, Elements) \
do { \
*((AnswerBlock) ABlock) = \
- (Word *) table_allocate(sizeof(Word)*Elements); \
+ (Word *) table_allocate_words(Elements); \
} while(0)
#define MR_TABLE_GET_ANSWER(Offset, ABlock) \
@@ -365,12 +365,18 @@
#ifdef CONSERVATIVE_GC
- #define table_allocate(size) \
+ #define table_allocate_bytes(size) \
GC_MALLOC(size)
- #define table_reallocate(pointer, 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)
@@ -378,12 +384,18 @@
#else /* not CONSERVATIVE_GC */
- #define table_allocate(Size) \
+ #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_reallocate(Pointer, Size) \
+ #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")
@@ -393,7 +405,10 @@
#endif /* CONSERVATIVE_GC */
-#define table_copy_mem(Dest, Source, Size) \
+#define table_copy_bytes(Dest, Source, Size) \
memcpy(Dest, Source, Size)
+
+#define table_copy_words(Dest, Source, Size) \
+ memcpy((char *) Dest, (char *) Source, sizeof(Word) * Size)
#endif /* not MERCURY_TABLING_H */
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 scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/general
cvs diff: Diffing tests/hard_coded
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.2
diff -u -u -r1.2 Mmakefile
--- Mmakefile 1998/08/24 08:25:03 1.2
+++ Mmakefile 1998/09/18 05:15:02
@@ -7,17 +7,20 @@
#-----------------------------------------------------------------------------#
PROGS= \
-# boyer \
+ boyer \
fib \
- tc_loop
+ tc_loop \
+ tc_minimal
-# We don't yet pass the following tests:
-# tc_minimal
-
#-----------------------------------------------------------------------------#
# at the moment tabling only works with conservative gc
GRADEFLAGS = --gc conservative
+
+# With the Mercury system as of 17 September 1998,
+# tc_minimal works on some machines even in the presence of a known bug
+# if inlining is turned on, so we turn inlining off to make the test tougher.
+MCFLAGS-tc_minimal = --no-inlining
# tc_loop is expected to abort, so we need to ignore the exit status
# (hence the leading `-')
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trial
cvs diff: Diffing util
More information about the developers
mailing list