[m-dev.] diff: minimal model tabling, part 3
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Apr 19 16:22:49 AEST 1999
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.46
diff -u -b -u -r1.46 Mmakefile
--- Mmakefile 1999/04/16 06:05:23 1.46
+++ Mmakefile 1999/04/17 10:56:20
@@ -66,9 +66,9 @@
mercury_regs.h \
mercury_signal.h \
mercury_std.h \
- mercury_stacks.h \
mercury_stack_layout.h \
mercury_stack_trace.h \
+ mercury_stacks.h \
mercury_string.h \
mercury_tabling.h \
mercury_tags.h \
@@ -123,6 +123,7 @@
mercury_regs.c \
mercury_signal.c \
mercury_stack_trace.c \
+ mercury_stacks.c \
mercury_tabling.c \
mercury_thread.c \
mercury_timing.c \
Index: runtime/mercury_context.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_context.c,v
retrieving revision 1.18
diff -u -b -u -r1.18 mercury_context.c
--- mercury_context.c 1998/12/16 17:10:28 1.18
+++ mercury_context.c 1999/03/21 09:38:36
@@ -3,7 +3,7 @@
ENDINIT
*/
/*
-** Copyright (C) 1995-1998 The University of Melbourne.
+** Copyright (C) 1995-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.
*/
@@ -116,6 +116,26 @@
MR_prevfr_slot(c->context_curfr) = NULL;
MR_succip_slot(c->context_curfr) = ENTRY(do_not_reached);
MR_succfr_slot(c->context_curfr) = NULL;
+
+#ifdef MR_USE_MINIMAL_MODEL
+ if (c->generatorstack_zone != NULL) {
+ reset_redzone(c->generatorstack_zone);
+ } else {
+ c->generatorstack_zone = create_zone("generatorstack", 0,
+ generatorstack_size, next_offset(),
+ generatorstack_zone_size, default_handler);
+ }
+ c->context_gen_next = 0;
+
+ if (c->cutstack_zone != NULL) {
+ reset_redzone(c->cutstack_zone);
+ } else {
+ c->cutstack_zone = create_zone("cutstack", 0,
+ cutstack_size, next_offset(),
+ cutstack_zone_size, default_handler);
+ }
+ c->context_cut_next = 0;
+#endif
#ifdef MR_USE_TRAIL
if (c->trail_zone != NULL) {
Index: runtime/mercury_context.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_context.h,v
retrieving revision 1.9
diff -u -b -u -r1.9 mercury_context.h
--- mercury_context.h 1998/12/15 00:22:15 1.9
+++ mercury_context.h 1999/03/21 10:24:01
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1997-1998 The University of Melbourne.
+** 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.
*/
@@ -106,6 +106,16 @@
/* saved maxfr pointer for this context */
Word *context_curfr;
/* saved curfr pointer for this context */
+#ifdef MR_USE_MINIMAL_MODEL
+ MemoryZone *generatorstack_zone;
+ /* pointer to the generatorstack_zone for this context */
+ Integer context_gen_next;
+ /* saved generator stack index for this context */
+ MemoryZone *cutstack_zone;
+ /* pointer to the cutstack_zone for this context */
+ Integer context_cut_next;
+ /* saved cut stack index for this context */
+#endif
#ifdef MR_USE_TRAIL
MemoryZone *trail_zone;
@@ -316,6 +326,12 @@
#define MR_IF_USE_TRAIL(x)
#endif
+#ifdef MR_USE_MINIMAL_MODEL
+ #define MR_IF_USE_MINIMAL_MODEL(x) x
+#else
+ #define MR_IF_USE_MINIMAL_MODEL(x)
+#endif
+
#define load_context(cptr) \
do { \
MR_Context *load_context_c; \
@@ -324,6 +340,10 @@
MR_sp = load_context_c->context_sp; \
MR_maxfr = load_context_c->context_maxfr; \
MR_curfr = load_context_c->context_curfr; \
+ MR_IF_USE_MINIMAL_MODEL( \
+ MR_gen_next = load_context_c->context_gen_next; \
+ MR_cut_next = load_context_c->context_cut_next; \
+ ) \
MR_IF_USE_TRAIL( \
MR_trail_zone = load_context_c->trail_zone; \
MR_trail_ptr = load_context_c->context_trail_ptr; \
@@ -334,6 +354,16 @@
load_context_c->detstack_zone; \
MR_ENGINE(context).nondetstack_zone = \
load_context_c->nondetstack_zone; \
+ MR_IF_USE_MINIMAL_MODEL( \
+ MR_ENGINE(context).generatorstack_zone = \
+ load_context_c->generatorstack_zone; \
+ MR_ENGINE(context).cutstack_zone = \
+ load_context_c->cutstack_zone; \
+ MR_gen_stack = (MR_GeneratorStackFrame *) \
+ MR_ENGINE(context).generatorstack_zone; \
+ MR_cut_stack = (MR_CutStackFrame *) \
+ MR_ENGINE(context).cutstack_zone; \
+ ) \
set_min_heap_reclamation_point(load_context_c); \
} while (0)
@@ -345,6 +375,10 @@
save_context_c->context_sp = MR_sp; \
save_context_c->context_maxfr = MR_maxfr; \
save_context_c->context_curfr = MR_curfr; \
+ MR_IF_USE_MINIMAL_MODEL( \
+ save_context_c->context_gen_next = MR_gen_next; \
+ save_context_c->context_cut_next = MR_cut_next; \
+ ) \
MR_IF_USE_TRAIL( \
save_context_c->trail_zone = MR_trail_zone; \
save_context_c->context_trail_ptr = MR_trail_ptr; \
@@ -355,6 +389,16 @@
MR_ENGINE(context).detstack_zone; \
save_context_c->nondetstack_zone = \
MR_ENGINE(context).nondetstack_zone; \
+ MR_IF_USE_MINIMAL_MODEL( \
+ save_context_c->generatorstack_zone = \
+ MR_ENGINE(context).generatorstack_zone; \
+ save_context_c->cutstack_zone = \
+ MR_ENGINE(context).cutstack_zone; \
+ assert(MR_gen_stack == (MR_GeneratorStackFrame *) \
+ MR_ENGINE(context).generatorstack_zone);\
+ assert(MR_cut_stack == (MR_CutStackFrame *) \
+ MR_ENGINE(context).cutstack_zone); \
+ ) \
save_hp_in_context(save_context_c); \
} while (0)
Index: runtime/mercury_engine.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_engine.h,v
retrieving revision 1.11
diff -u -b -u -r1.11 mercury_engine.h
--- mercury_engine.h 1998/11/09 11:02:35 1.11
+++ mercury_engine.h 1999/03/11 06:27:11
@@ -47,8 +47,9 @@
#define MR_SREGFLAG 8
#define MR_TRACEFLAG 9
#define MR_TABLEFLAG 10
-#define MR_DETAILFLAG 11
-#define MR_MAXFLAG 12
+#define MR_TABLESTACKFLAG 11
+#define MR_DETAILFLAG 12
+#define MR_MAXFLAG 13
/* MR_DETAILFLAG should be the last real flag */
#define MR_progdebug MR_debugflag[MR_PROGFLAG]
@@ -62,6 +63,7 @@
#define MR_sregdebug MR_debugflag[MR_SREGFLAG]
#define MR_tracedebug MR_debugflag[MR_TRACEFLAG]
#define MR_tabledebug MR_debugflag[MR_TABLEFLAG]
+#define MR_tablestackdebug MR_debugflag[MR_TABLESTACKFLAG]
#define MR_detaildebug MR_debugflag[MR_DETAILFLAG]
/*
Index: runtime/mercury_grade.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_grade.h,v
retrieving revision 1.17
diff -u -b -u -r1.17 mercury_grade.h
--- mercury_grade.h 1999/03/29 06:15:07 1.17
+++ mercury_grade.h 1999/04/09 06:26:09
@@ -129,13 +129,23 @@
#define MR_GRADE_PART_6 MR_GRADE_PART_5
#endif
+#ifdef MR_USE_MINIMAL_MODEL
+ #define MR_GRADE_PART_6A MR_PASTE2(MR_GRADE_PART_6, _mm)
+#else
+ #define MR_GRADE_PART_6A MR_GRADE_PART_6
+#endif
+
+#if defined(MR_USE_TRAIL) && defined(MR_USE_MINIMAL_MODEL)
+ #error "trailing and minimal model tabling are not compatible"
+#endif
+
#if TAGBITS == 0
- #define MR_GRADE_PART_7 MR_PASTE2(MR_GRADE_PART_6, _notags)
+ #define MR_GRADE_PART_7 MR_PASTE2(MR_GRADE_PART_6A, _notags)
#elif defined(HIGHTAGS)
- #define MR_GRADE_PART_7 MR_PASTE2(MR_GRADE_PART_6, \
+ #define MR_GRADE_PART_7 MR_PASTE2(MR_GRADE_PART_6A, \
MR_PASTE2(_hightags, TAGBITS))
#else
- #define MR_GRADE_PART_7 MR_PASTE2(MR_GRADE_PART_6, \
+ #define MR_GRADE_PART_7 MR_PASTE2(MR_GRADE_PART_6A, \
MR_PASTE2(_tags, TAGBITS))
#endif
@@ -275,6 +285,12 @@
#define MR_GRADE_OPT_PART_6 MR_GRADE_OPT_PART_5
#endif
+#ifdef MR_USE_MINIMAL_MODEL
+ #define MR_GRADE_OPT_PART_6A MR_GRADE_OPT_PART_6 ".mm"
+#else
+ #define MR_GRADE_OPT_PART_6A MR_GRADE_OPT_PART_6
+#endif
+
/*
** Parts 7-10 above (i.e. tag bits, compact args, and (un)boxed float)
** are documented as "not for general use", and can't be set via the
@@ -282,9 +298,9 @@
*/
#if defined(PIC_REG) && defined(USE_GCC_GLOBAL_REGISTERS) && defined(__i386__)
- #define MR_GRADE_OPT_PART_11 MR_GRADE_OPT_PART_6 ".picreg"
+ #define MR_GRADE_OPT_PART_11 MR_GRADE_OPT_PART_6A ".picreg"
#else
- #define MR_GRADE_OPT_PART_11 MR_GRADE_OPT_PART_6
+ #define MR_GRADE_OPT_PART_11 MR_GRADE_OPT_PART_6A
#endif
/*
Index: runtime/mercury_init.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_init.h,v
retrieving revision 1.11
diff -u -b -u -r1.11 mercury_init.h
--- mercury_init.h 1999/04/16 06:37:20 1.11
+++ mercury_init.h 1999/04/17 10:56:25
@@ -76,6 +76,7 @@
** by C programs that wish to interface to Mercury.
*/
+#include "mercury_regs.h" /* must come before system headers */
#include "mercury_goto.h" /* for Declare_entry */
#include "mercury_types.h" /* for `Word' */
#include "mercury_wrapper.h" /* for do_init_modules,
Index: runtime/mercury_memory.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_memory.c,v
retrieving revision 1.15
diff -u -b -u -r1.15 mercury_memory.c
--- mercury_memory.c 1998/09/29 05:10:58 1.15
+++ mercury_memory.c 1999/03/21 09:38:54
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1994-1998 The University of Melbourne.
+** Copyright (C) 1994-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.
*/
@@ -109,6 +109,10 @@
MemoryZone *heap_zone;
MemoryZone *solutions_heap_zone;
#endif
+#ifdef MR_USE_MINIMAL_MODEL
+ MemoryZone *generatorstack_zone;
+ MemoryZone *cutstack_zone;
+#endif
#ifdef MR_LOWLEVEL_DEBUG
MemoryZone *dumpstack_zone;
@@ -136,29 +140,36 @@
unit = max(page_size, pcache_size);
#ifdef CONSERVATIVE_GC
- heap_zone_size = 0;
heap_size = 0;
- solutions_heap_zone_size = 0;
+ heap_zone_size = 0;
solutions_heap_size = 0;
- global_heap_zone_size = 0;
+ solutions_heap_zone_size = 0;
global_heap_size = 0;
- debug_heap_zone_size = 0;
+ global_heap_zone_size = 0;
debug_heap_size = 0;
+ debug_heap_zone_size = 0;
#else
- heap_zone_size = round_up(heap_zone_size * 1024, unit);
heap_size = round_up(heap_size * 1024, unit);
+ heap_zone_size = round_up(heap_zone_size * 1024, unit);
+ solutions_heap_size = round_up(solutions_heap_size * 1024, unit);
solutions_heap_zone_size = round_up(solutions_heap_zone_size * 1024,
unit);
- solutions_heap_size = round_up(solutions_heap_size * 1024, unit);
- global_heap_zone_size = round_up(global_heap_zone_size * 1024, unit);
global_heap_size = round_up(global_heap_size * 1024, unit);
- debug_heap_zone_size = round_up(debug_heap_zone_size * 1024, unit);
+ global_heap_zone_size = round_up(global_heap_zone_size * 1024, unit);
debug_heap_size = round_up(debug_heap_size * 1024, unit);
+ debug_heap_zone_size = round_up(debug_heap_zone_size * 1024, unit);
#endif
detstack_size = round_up(detstack_size * 1024, unit);
detstack_zone_size = round_up(detstack_zone_size * 1024, unit);
nondstack_size = round_up(nondstack_size * 1024, unit);
nondstack_zone_size = round_up(nondstack_zone_size * 1024, unit);
+#ifdef MR_USE_MINIMAL_MODEL
+ generatorstack_size = round_up(generatorstack_size * 1024, unit);
+ generatorstack_zone_size = round_up(generatorstack_zone_size * 1024,
+ unit);
+ cutstack_size = round_up(cutstack_size * 1024, unit);
+ cutstack_zone_size = round_up(cutstack_zone_size * 1024, unit);
+#endif
#ifdef MR_USE_TRAIL
trail_size = round_up(trail_size * 1024, unit);
Index: runtime/mercury_regorder.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_regorder.h,v
retrieving revision 1.10
diff -u -b -u -r1.10 mercury_regorder.h
--- mercury_regorder.h 1998/11/09 14:35:36 1.10
+++ mercury_regorder.h 1999/03/26 10:17:26
@@ -101,6 +101,14 @@
count_usage(MR_MIN_HP_REC, mr(40)))
#define MR_global_hp LVALUE_CAST(Word *, \
count_usage(MR_GLOBAL_HP_RN, mr(41)))
+#define MR_gen_next LVALUE_CAST(Integer, \
+ count_usage(MR_GEN_NEXT_RN, mr(42)))
+#define MR_gen_stack LVALUE_CAST(struct MR_GeneratorStackFrameStruct *, \
+ count_usage(MR_GEN_STACK_RN, mr(43)))
+#define MR_cut_next LVALUE_CAST(Integer, \
+ count_usage(MR_CUT_NEXT_RN, mr(44)))
+#define MR_cut_stack LVALUE_CAST(struct MR_CutStackFrameStruct *, \
+ count_usage(MR_CUT_STACK_RN, mr(45)))
#define MR_trail_ptr count_usage(MR_TRAIL_PTR_RN, MR_trail_ptr_var)
#define MR_ticket_counter \
@@ -114,10 +122,10 @@
#define MR_NUM_VERY_SPECIAL_REG 6
/* the number of special-purpose Mercury registers */
-#define MR_NUM_SPECIAL_REG 12
+#define MR_NUM_SPECIAL_REG 16
/* the maximum mrN number of special registers */
-#define MR_MAX_SPECIAL_REG_MR 41
+#define MR_MAX_SPECIAL_REG_MR 45
/*
** The MR_saved_foo macros are like MR_foo except that
@@ -134,6 +142,14 @@
#define MR_saved_min_hp_rec(save_area) LVALUE_CAST(Word *, save_area[39])
#define MR_saved_min_sol_hp_rec(save_area) LVALUE_CAST(Word *, save_area[40])
#define MR_saved_global_hp(save_area) LVALUE_CAST(Word *, save_area[41])
+#define MR_saved_gen_stack(save_area) LVALUE_CAST(Integer, save_area[42])
+#define MR_saved_gen_next(save_area) LVALUE_CAST( \
+ struct MR_GeneratorStackFrameStruct *,\
+ save_area[43])
+#define MR_saved_cut_stack(save_area) LVALUE_CAST(Integer, save_area[44])
+#define MR_saved_cut_next(save_area) LVALUE_CAST( \
+ struct MR_CutStackFrameStruct *, \
+ save_area[45])
#define VIRTUAL_REG_MAP_BODY { \
3, \
@@ -243,6 +259,14 @@
#define MR_trail_ptr count_usage(MR_TRAIL_PTR_RN, MR_trail_ptr_var)
#define MR_ticket_counter \
count_usage(MR_TICKET_COUNTER_RN, MR_ticket_counter_var)
+#define MR_gen_next LVALUE_CAST(Integer, \
+ count_usage(MR_GEN_NEXT_RN, mr(41)))
+#define MR_gen_stack LVALUE_CAST(struct MR_GeneratorStackFrameStruct *, \
+ count_usage(MR_GEN_STACK_RN, mr(42)))
+#define MR_cut_next LVALUE_CAST(Integer, \
+ count_usage(MR_CUT_NEXT_RN, mr(43)))
+#define MR_cut_stack LVALUE_CAST(struct MR_CutStackFrameStruct *, \
+ count_usage(MR_CUT_STACK_RN, mr(44)))
/*
** the number of "very special" registers, i.e. special registers that can
@@ -252,10 +276,10 @@
#define MR_NUM_VERY_SPECIAL_REG 5
/* the number of special registers */
-#define MR_NUM_SPECIAL_REG 11
+#define MR_NUM_SPECIAL_REG 15
/* the maximum mrN number of special, non rN registers */
-#define MR_MAX_SPECIAL_REG_MR 40
+#define MR_MAX_SPECIAL_REG_MR 44
/*
** The MR_saved_foo macros are like MR_foo except that
@@ -272,6 +296,14 @@
#define MR_saved_min_hp_rec(save_area) LVALUE_CAST(Word *, save_area[38])
#define MR_saved_min_sol_hp_rec(save_area) LVALUE_CAST(Word *, save_area[39])
#define MR_saved_global_hp(save_area) LVALUE_CAST(Word *, save_area[40])
+#define MR_saved_gen_stack(save_area) LVALUE_CAST(Integer, save_area[41])
+#define MR_saved_gen_next(save_area) LVALUE_CAST( \
+ struct MR_GeneratorStackFrameStruct *,\
+ save_area[42])
+#define MR_saved_cut_stack(save_area) LVALUE_CAST(Integer, save_area[43])
+#define MR_saved_cut_next(save_area) LVALUE_CAST( \
+ struct MR_CutStackFrameStruct *, \
+ save_area[44])
#define VIRTUAL_REG_MAP_BODY { \
2, \
Index: runtime/mercury_regs.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_regs.h,v
retrieving revision 1.12
diff -u -b -u -r1.12 mercury_regs.h
--- mercury_regs.h 1999/03/10 22:05:24 1.12
+++ mercury_regs.h 1999/03/26 10:09:03
@@ -260,6 +260,10 @@
#define MR_MIN_HP_REC (MR_ORD_RN + 8)
#define MR_MIN_SOL_HP_REC (MR_ORD_RN + 9)
#define MR_GLOBAL_HP_RN (MR_ORD_RN + 10)
-#define MAX_RN (MR_ORD_RN + 11)
+#define MR_GEN_STACK_RN (MR_ORD_RN + 11)
+#define MR_GEN_NEXT_RN (MR_ORD_RN + 12)
+#define MR_CUT_STACK_RN (MR_ORD_RN + 13)
+#define MR_CUT_NEXT_RN (MR_ORD_RN + 14)
+#define MAX_RN (MR_ORD_RN + 15)
#endif /* not MERCURY_REGS_H */
Index: runtime/mercury_stacks.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stacks.h,v
retrieving revision 1.15
diff -u -b -u -r1.15 mercury_stacks.h
--- mercury_stacks.h 1998/12/16 20:38:15 1.15
+++ mercury_stacks.h 1999/03/26 10:12:38
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1995-1998 The University of Melbourne.
+** Copyright (C) 1995-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.
*/
@@ -14,6 +14,7 @@
#include "mercury_overflow.h"
#include "mercury_debug.h"
#include "mercury_goto.h"
+#include "mercury_tabling.h"
/* DEFINITIONS FOR MANIPULATING THE DET STACK */
@@ -97,6 +98,15 @@
#define MR_SAVEVAL (-MR_NONDET_FIXED_SIZE)
/* saved values start at this offset */
+#define MR_prevfr_addr(fr) (&((Word *) (fr))[MR_PREVFR])
+#define MR_redoip_addr(fr) (&((Word *) (fr))[MR_REDOIP])
+#define MR_redofr_addr(fr) (&((Word *) (fr))[MR_REDOFR])
+#define MR_succip_addr(fr) (&((Word *) (fr))[MR_SUCCIP])
+#define MR_succfr_addr(fr) (&((Word *) (fr))[MR_SUCCFR])
+#define MR_detfr_addr(fr) (&((Word *) (fr))[MR_DETFR])
+#define MR_based_framevar_addr(fr, n) \
+ (&(((Word *) (fr))[MR_SAVEVAL + 1 - (n)]))
+
#define MR_prevfr_slot(fr) LVALUE_CAST(Word *, ((Word *) (fr))[MR_PREVFR])
#define MR_redoip_slot(fr) LVALUE_CAST(Code *, ((Word *) (fr))[MR_REDOIP])
#define MR_redofr_slot(fr) LVALUE_CAST(Word *, ((Word *) (fr))[MR_REDOFR])
@@ -224,4 +234,40 @@
GOTO(MR_redoip_slot(MR_maxfr)); \
} while (0)
+#ifdef MR_USE_MINIMAL_MODEL
+
+/* DEFINITIONS FOR GENERATOR STACK FRAMES */
+
+typedef struct MR_GeneratorStackFrameStruct {
+ Word *generator_frame;
+ MR_Subgoal *generator_table;
+} MR_GeneratorStackFrame;
+
+extern void MR_push_generator(Word *frame_addr,
+ MR_Subgoal *table_addr);
+extern MR_Subgoal *MR_top_generator_table(void);
+extern void MR_pop_generator(void);
+extern void MR_print_gen_stack(FILE *fp);
+
+/* DEFINITIONS FOR CUT STACK FRAMES */
+
+typedef struct MR_CutGeneratorListNode *MR_CutGeneratorList;
+struct MR_CutGeneratorListNode {
+ MR_Subgoal **generator_ptr;
+ MR_CutGeneratorList next_generator;
+};
+
+typedef struct MR_CutStackFrameStruct {
+ Word *frame;
+ Integer gen_next;
+ MR_CutGeneratorList generators;
+} MR_CutStackFrame;
+
+extern void MR_commit_mark(void);
+extern void MR_commit_cut(void);
+
+extern void MR_register_generator_ptr(MR_Subgoal **);
+
+#endif /* MR_USE_MINIMAL_MODEL */
+
#endif /* not MERCURY_STACKS_H */
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.2
diff -u -b -u -r1.2 mercury_tabling.c
--- mercury_tabling.c 1999/03/22 08:09:06 1.2
+++ mercury_tabling.c 1999/04/09 06:34:19
@@ -43,7 +43,6 @@
Word elements;
} TableRoot;
-
static Word next_prime(Word);
static Word * create_hash_table(Word);
static void re_hash(Word *, Word, TableNode * Node);
@@ -125,8 +124,8 @@
** If it is not; create a new element for the key in the table and
** return the address of its data pointer.
*/
-TrieNode
-MR_int_hash_lookup_or_add(TrieNode t, Integer key)
+MR_TrieNode
+MR_int_hash_lookup_or_add(MR_TrieNode t, Integer key)
{
TableNode * p, * q;
Word * table = *t; /* Deref the table pointer */
@@ -195,8 +194,8 @@
** If it is not create a new element for the key in the table and
** return the address of its data pointer.
*/
-TrieNode
-MR_float_hash_lookup_or_add(TrieNode t, Float key)
+MR_TrieNode
+MR_float_hash_lookup_or_add(MR_TrieNode t, Float key)
{
TableNode * p, * q;
Word * table = *t; /* Deref the table pointer */
@@ -271,8 +270,8 @@
** If it is not create a new element for the key in the table and
** return the address of its data pointer.
*/
-TrieNode
-MR_string_hash_lookup_or_add(TrieNode t, String key)
+MR_TrieNode
+MR_string_hash_lookup_or_add(MR_TrieNode t, String key)
{
TableNode * p, * q;
Word * table = *t; /* Deref the table pointer */
@@ -355,8 +354,8 @@
** table of size Range.
*/
-TrieNode
-MR_int_index_lookup_or_add(TrieNode t, Integer range, Integer key)
+MR_TrieNode
+MR_int_index_lookup_or_add(MR_TrieNode t, Integer range, Integer key)
{
Word *table = *t; /* Deref table */
@@ -389,8 +388,8 @@
struct TreeNode_struct * left;
} TreeNode;
-TrieNode
-MR_type_info_lookup_or_add(TrieNode table, Word * type_info)
+MR_TrieNode
+MR_type_info_lookup_or_add(MR_TrieNode table, Word * type_info)
{
TreeNode *p, *q;
int i;
@@ -458,8 +457,8 @@
** in mercury_deep_copy.c and std_util::ML_expand().
*/
-TrieNode
-MR_table_type(TrieNode table, Word *type_info, Word data)
+MR_TrieNode
+MR_table_type(MR_TrieNode table, Word *type_info, Word data)
{
Word *type_ctor_info, *type_ctor_layout, *type_ctor_functors;
Word layout_for_tag, *layout_vector_for_tag, *data_value;
@@ -651,3 +650,1003 @@
} /* end table_any() */
/*---------------------------------------------------------------------------*/
+
+#ifdef MR_USE_MINIMAL_MODEL
+
+/*
+** Save the current state of the Mercury abstract machine, so that the
+** current computation may be suspended for a while, and restored later.
+** The generator_{maxfr,sp} arguments give the points from which we need
+** to copy the nondet and the det stacks. The parts of those stacks below
+** the given points will not change between the suspension and the resumption
+** of this state, or if they do, the stack segments in the saved state
+** will be extended (via extend_consumer_stacks).
+*/
+
+static void
+save_state(MR_SavedState *saved_state,
+ Word *generator_maxfr, Word *generator_sp,
+ const char *who, const char *what)
+{
+ restore_transient_registers();
+
+ saved_state->succ_ip = MR_succip;
+ saved_state->s_p = MR_sp;
+ saved_state->cur_fr = MR_curfr;
+ saved_state->max_fr = MR_maxfr;
+
+ saved_state->non_stack_block_start = generator_maxfr + 1;
+ if (MR_maxfr > generator_maxfr) {
+ saved_state->non_stack_block_size = MR_maxfr - generator_maxfr;
+ saved_state->non_stack_block =
+ table_allocate_words(saved_state->non_stack_block_size);
+ table_copy_words(saved_state->non_stack_block,
+ saved_state->non_stack_block_start,
+ saved_state->non_stack_block_size);
+ } else {
+ saved_state->non_stack_block_size = 0;
+ saved_state->non_stack_block = NULL;
+ }
+
+ saved_state->det_stack_block_start = generator_sp;
+ if (MR_sp > generator_sp) {
+ saved_state->det_stack_block_size = (MR_sp - 1) - generator_sp;
+ saved_state->det_stack_block =
+ table_allocate_words(saved_state->det_stack_block_size);
+ table_copy_words(saved_state->det_stack_block,
+ saved_state->det_stack_block_start,
+ saved_state->det_stack_block_size);
+ } else {
+ saved_state->det_stack_block_size = 0;
+ saved_state->det_stack_block = NULL;
+ }
+
+ saved_state->gen_next = MR_gen_next;
+ saved_state->generator_stack_block = table_allocate_bytes(
+ MR_gen_next * sizeof(MR_GeneratorStackFrame));
+ table_copy_bytes(saved_state->generator_stack_block,
+ (char *) MR_gen_stack,
+ MR_gen_next * sizeof(MR_GeneratorStackFrame));
+
+ saved_state->cut_next = MR_cut_next;
+ saved_state->cut_stack_block = table_allocate_bytes(
+ MR_cut_next * sizeof(MR_CutStackFrame));
+ table_copy_bytes(saved_state->cut_stack_block,
+ (char *) MR_cut_stack,
+ MR_cut_next * sizeof(MR_CutStackFrame));
+
+#ifdef MR_USE_TRAIL
+ /*
+ ** Saving the trail state here would not be sufficient to handle
+ ** the combination of trailing and minimal model tabling.
+ ** Consider the following sequence of events:
+ **
+ ** execution enters a goal being committed across
+ ** a new entry is pushed on the trail
+ ** a tabled goal suspends,
+ ** causing the saving of a trail segment
+ ** and then a failure
+ ** the goal being committed across fails,
+ ** which invokes a failed commit on the trail entry
+ ** ...
+ ** the tabled goal is resumed,
+ ** causing the restoring of the saved trail segment
+ ** and then a success
+ ** the goal being committed across now succeeds,
+ ** which invokes a successful commit on the trail entry
+ **
+ ** The trail handler will be thoroughly confused by such a sequence.
+ */
+
+ fatal_error("Sorry, not implemented: "
+ "can't have both minimal model tabling and trailing");
+#endif
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("\n%s saves %s stacks: ", who, what);
+ printf("%d non, %d det, %d generator, %d cut\n",
+ saved_state->non_stack_block_size,
+ saved_state->det_stack_block_size,
+ MR_gen_next, MR_cut_next);
+
+ printf("non region from ");
+ MR_printnondstackptr(saved_state->non_stack_block_start);
+ printf(" to ");
+ MR_printnondstackptr(MR_maxfr);
+ printf(" (both inclusive)\n");
+ printf("stored at %p to %p (both inclusive)\n",
+ saved_state->non_stack_block,
+ saved_state->non_stack_block +
+ saved_state->non_stack_block_size - 1);
+
+ printf("det region from ");
+ MR_printdetstackptr(saved_state->det_stack_block_start);
+ printf(" to ");
+ MR_printdetstackptr(MR_sp);
+ printf(" (both inclusive)\n");
+ printf("stored at %p to %p (both inclusive)\n",
+ saved_state->det_stack_block,
+ saved_state->det_stack_block +
+ saved_state->det_stack_block_size - 1);
+
+ printf("succip = %p, sp = ", (void *) MR_succip);
+ MR_printdetstackptr(MR_sp);
+ printf("\nmaxfr = ");
+ MR_printnondstackptr(MR_maxfr);
+ printf(", curfr = ");
+ MR_printnondstackptr(MR_curfr);
+ printf("\n\n");
+
+ MR_print_gen_stack(stdout);
+
+ if (MR_tablestackdebug) {
+ MR_dump_nondet_stack_from_layout(stdout, MR_maxfr);
+ }
+ }
+#endif
+
+ save_transient_registers();
+}
+
+/*
+** Restore the state of the Mercury abstract machine from saved_state.
+*/
+
+static void
+restore_state(MR_SavedState *saved_state, const char *who, const char *what)
+{
+ restore_transient_registers();
+
+ MR_succip = saved_state->succ_ip;
+ MR_sp = saved_state->s_p;
+ MR_curfr = saved_state->cur_fr;
+ MR_maxfr = saved_state->max_fr;
+
+ table_copy_words(saved_state->non_stack_block_start,
+ saved_state->non_stack_block,
+ saved_state->non_stack_block_size);
+
+ table_copy_words(saved_state->det_stack_block_start,
+ saved_state->det_stack_block,
+ saved_state->det_stack_block_size);
+
+ MR_gen_next = saved_state->gen_next;
+ table_copy_bytes((char *) MR_gen_stack,
+ saved_state->generator_stack_block,
+ saved_state->gen_next * sizeof(MR_GeneratorStackFrame));
+
+ MR_cut_next = saved_state->cut_next;
+ table_copy_bytes((char *) MR_cut_stack,
+ (char *) saved_state->cut_stack_block,
+ saved_state->cut_next * sizeof(MR_CutStackFrame));
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("\n%s restores %s stacks: ", who, what);
+ printf("%d non, %d det, %d generator, %d cut\n",
+ saved_state->non_stack_block_size,
+ saved_state->det_stack_block_size,
+ saved_state->gen_next, saved_state->cut_next);
+
+ printf("non region from ");
+ MR_printnondstackptr(saved_state->non_stack_block_start);
+ printf(" to ");
+ MR_printnondstackptr(saved_state->non_stack_block_start +
+ saved_state->non_stack_block_size - 1);
+ printf(" (both inclusive)\n");
+ printf("stored at %p to %p (both inclusive)\n",
+ saved_state->non_stack_block,
+ saved_state->non_stack_block +
+ saved_state->non_stack_block_size - 1);
+
+ printf("det region from ");
+ MR_printdetstackptr(saved_state->det_stack_block_start);
+ printf(" to ");
+ MR_printdetstackptr(saved_state->det_stack_block_start +
+ saved_state->det_stack_block_size - 1);
+ printf(" (both inclusive)\n");
+ printf("stored at %p to %p (both inclusive)\n",
+ saved_state->det_stack_block,
+ saved_state->det_stack_block +
+ saved_state->det_stack_block_size - 1);
+
+ printf("succip = %p, sp = ", (void *) MR_succip);
+ MR_printdetstackptr(MR_sp);
+ printf("\nmaxfr = ");
+ MR_printnondstackptr(MR_maxfr);
+ printf(", curfr = ");
+ MR_printnondstackptr(MR_curfr);
+ printf("\n");
+
+ MR_print_gen_stack(stdout);
+
+ if (MR_tablestackdebug) {
+ MR_dump_nondet_stack_from_layout(stdout, MR_maxfr);
+ }
+ }
+#endif
+
+ save_transient_registers();
+}
+
+static void
+print_saved_state_stacks(MR_SavedState *saved_state)
+{
+ int i;
+
+ printf("saved state parameters:\n");
+ printf("succip:\t");
+ printlabel(saved_state->succ_ip);
+ printf("sp:\t");
+ MR_printdetstackptr(saved_state->s_p);
+ printf("\ncurfr:\t");
+ MR_printnondstackptr(saved_state->cur_fr);
+ printf("\nmaxfr:\t");
+ MR_printnondstackptr(saved_state->max_fr);
+
+ printf("\n\nnondet stack block: %d words from %p\n",
+ saved_state->non_stack_block_size,
+ saved_state->non_stack_block_start);
+ for (i = 0; i < saved_state->non_stack_block_size; i++) {
+ printf("%2d: %x\n", i, saved_state->non_stack_block[i]);
+ }
+
+ printf("\ndet stack block: %d words from %p\n",
+ saved_state->det_stack_block_size,
+ saved_state->det_stack_block_start);
+ for (i = 0; i < saved_state->det_stack_block_size; i++) {
+ printf("%2d: %x\n", i, saved_state->det_stack_block[i]);
+ }
+
+ printf("\n");
+}
+
+/*
+** The saved state of a consumer for a subgoal (say subgoal A) includes
+** the stack segments between the tops of the stack at the time that
+** A's generator was entered and the time that A's consumer was entered.
+** When A becomes a follower of another subgoal B, the responsibility for
+** scheduling A's consumers passes to B's generator. Since by definition
+** B's nondet stack frame is lower in the stack than A's generator's,
+** we need to extend the stack segments of A's consumers to also include
+** the parts of the stacks between the generator of B and the generator of A.
+*/
+
+Declare_entry(mercury__table_nondet_resume_1_0);
+
+static void
+extend_consumer_stacks(MR_Subgoal *leader, MR_Consumer *suspension)
+{
+ Word *arena_block;
+ Word *arena_start;
+ Word arena_size;
+ Word extension_size;
+ Word *saved_fr;
+ Word *real_fr;
+ Word frame_size;
+ Word offset;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("\nextending saved consumer stacks\n");
+ print_saved_state_stacks(&suspension->saved_state);
+ }
+#endif
+
+ arena_start = leader->generator_sp;
+ extension_size = suspension->saved_state.det_stack_block_start
+ - arena_start;
+ arena_size = extension_size
+ + suspension->saved_state.det_stack_block_size;
+ if (arena_size != 0) {
+ assert(arena_start + arena_size
+ == suspension->saved_state.s_p - 1);
+ }
+
+ arena_block = table_allocate_words(arena_size);
+
+ table_copy_words(arena_block, arena_start, extension_size);
+ table_copy_words(arena_block + extension_size,
+ suspension->saved_state.det_stack_block,
+ suspension->saved_state.det_stack_block_size);
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("extending det stack of suspension %p for %p\n",
+ suspension, leader);
+ printf("start: old %p, new %p\n",
+ suspension->saved_state.det_stack_block_start,
+ arena_start);
+ printf("size: old %d, new %d\n",
+ suspension->saved_state.det_stack_block_size,
+ arena_size);
+ printf("block: old %p, new %p\n",
+ suspension->saved_state.det_stack_block,
+ arena_block);
+ }
+#endif
+
+ suspension->saved_state.det_stack_block = arena_block;
+ suspension->saved_state.det_stack_block_size = arena_size;
+ suspension->saved_state.det_stack_block_start = arena_start;
+
+ arena_start = leader->generator_maxfr + 1;
+ extension_size = suspension->saved_state.non_stack_block_start
+ - arena_start;
+ arena_size = extension_size
+ + suspension->saved_state.non_stack_block_size;
+ assert(leader->generator_maxfr + arena_size
+ == suspension->saved_state.max_fr);
+
+ arena_block = table_allocate_words(arena_size);
+
+ table_copy_words(arena_block, arena_start, extension_size);
+ table_copy_words(arena_block + extension_size,
+ suspension->saved_state.non_stack_block,
+ suspension->saved_state.non_stack_block_size);
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("extending non stack of suspension %p for %p\n",
+ suspension, leader);
+ printf("start: old %p, new %p\n",
+ suspension->saved_state.non_stack_block_start,
+ arena_start);
+ printf("size: old %d, new %d\n",
+ suspension->saved_state.non_stack_block_size,
+ arena_size);
+ printf("block: old %p, new %p\n",
+ suspension->saved_state.non_stack_block,
+ arena_block);
+ }
+#endif
+
+ suspension->saved_state.non_stack_block = arena_block;
+ suspension->saved_state.non_stack_block_size = arena_size;
+ suspension->saved_state.non_stack_block_start = arena_start;
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("\nbefore pickling nondet stack\n");
+ print_saved_state_stacks(&suspension->saved_state);
+ }
+#endif
+
+ saved_fr = suspension->saved_state.non_stack_block +
+ suspension->saved_state.non_stack_block_size - 1;
+ real_fr = suspension->saved_state.non_stack_block_start +
+ suspension->saved_state.non_stack_block_size - 1;
+ while (saved_fr > suspension->saved_state.non_stack_block) {
+ frame_size = real_fr - MR_prevfr_slot(saved_fr);
+
+ if (saved_fr - frame_size
+ > suspension->saved_state.non_stack_block)
+ {
+ *MR_redoip_addr(saved_fr) = (Word) ENTRY(do_fail);
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("do_fail to redoip at %p (%d)\n",
+ MR_redoip_addr(saved_fr),
+ MR_redoip_addr(saved_fr) -
+ suspension->
+ saved_state.non_stack_block);
+ }
+#endif
+ } else {
+ *MR_redoip_addr(saved_fr) = (Word)
+ ENTRY(mercury__table_nondet_resume_1_0);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("resume to redoip at %p (%d)\n",
+ MR_redoip_addr(saved_fr),
+ MR_redoip_addr(saved_fr) -
+ suspension->
+ saved_state.non_stack_block);
+ }
+#endif
+ }
+
+ saved_fr -= frame_size;
+ real_fr -= frame_size;
+ }
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("\nfinished extending saved consumer stacks\n");
+ print_saved_state_stacks(&suspension->saved_state);
+ }
+#endif
+}
+
+/*
+** When we discover that two subgoals depend on each other, neither can be
+** completed alone. We therefore pass responsibility for completing all
+** the subgoals in an SCC to the subgoal whose nondet stack frame is
+** lowest in the nondet stack.
+*/
+
+static void
+make_subgoal_follow_leader(MR_Subgoal *this_follower, MR_Subgoal *leader)
+{
+ MR_Consumer *suspension;
+ MR_SubgoalList sub_followers;
+ MR_ConsumerList suspend_list;
+
+ restore_transient_registers();
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("making %p follow %p\n", this_follower, leader);
+ }
+#endif
+
+ for (sub_followers = this_follower->followers;
+ sub_followers != NULL; sub_followers = sub_followers->next)
+ {
+ for (suspend_list = sub_followers->item->consumer_list;
+ suspend_list != NULL;
+ suspend_list = suspend_list->next)
+ {
+ save_transient_registers();
+ extend_consumer_stacks(leader, suspend_list->item);
+ restore_transient_registers();
+ }
+ }
+
+ this_follower->leader = leader;
+ *(leader->followers_tail) = this_follower->followers;
+ this_follower->followers = NULL;
+
+ save_transient_registers();
+}
+
+/*
+** The following procedure saves the state of the Mercury runtime
+** so that it may be used in the table_nondet_resume procedure below to return
+** answers through this saved state. The procedure table_nondet_suspend is
+** declared as nondet but the code below is obviously of detism failure;
+** the reason for this is quite simple. Normally when a nondet proc
+** is called it will first return all of its answers and then fail. In the
+** case of calls to this procedure this is reversed: first the call will fail
+** then later on, when the answers are found, answers will be returned.
+** It is also important to note that the answers are returned not from the
+** procedure that was originally called (table_nondet_suspend) but from the
+** procedure table_nondet_resume. So essentially what is below is the code
+** to do the initial fail; the code to return the answers is in
+** table_nondet_resume.
+*/
+
+Declare_entry(mercury__table_nondet_resume_1_0);
+Declare_entry(MR_do_trace_redo_fail);
+Declare_entry(MR_table_nondet_commit);
+Define_extern_entry(mercury__table_nondet_suspend_2_0);
+MR_MAKE_PROC_LAYOUT(mercury__table_nondet_suspend_2_0,
+ MR_DETISM_NON, 0, MR_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, "private_builtin", "table_nondet_suspend", 2, 0);
+BEGIN_MODULE(table_nondet_suspend_module)
+ init_entry_sl(mercury__table_nondet_suspend_2_0);
+ MR_INIT_PROC_LAYOUT_ADDR(mercury__table_nondet_suspend_2_0);
+BEGIN_CODE
+
+Define_entry(mercury__table_nondet_suspend_2_0);
+{
+ MR_Subgoal *table;
+ MR_Consumer *consumer;
+ MR_ConsumerList listnode;
+ Integer cur_gen;
+ Integer cur_cut;
+ Word *fr;
+ Word *prev_fr;
+ Word *stop_addr;
+ Word offset;
+ Word *clobber_addr;
+
+ /*
+ ** This frame is not used in table_nondet_suspend, but it is copied
+ ** to the suspend list as part of the saved nondet stack fragment,
+ ** and it *will* be used when table_nondet_resume copies back the
+ ** nondet stack fragment. The framevar slot is for use by
+ ** table_nondet_resume.
+ */
+ mkframe(mercury__table_nondet_suspend/2, 1, ENTRY(do_fail));
+
+ table = MR_SUBGOAL(r1);
+ consumer = table_allocate_bytes(sizeof(MR_Consumer));
+ consumer->remaining_answer_list_ptr = &table->answer_list;
+
+ save_transient_registers();
+ save_state(&(consumer->saved_state),
+ table->generator_maxfr, table->generator_sp,
+ "suspension", "consumer");
+ restore_transient_registers();
+
+ cur_gen = MR_gen_next - 1;
+ cur_cut = MR_cut_next - 1;
+ stop_addr = consumer->saved_state.non_stack_block_start;
+ for (fr = MR_maxfr; fr > stop_addr; fr = MR_prevfr_slot(fr))
+ {
+ offset = MR_redoip_addr(fr) -
+ consumer->saved_state.non_stack_block_start;
+ clobber_addr = consumer->saved_state.non_stack_block + offset;
+#if 0
+ if (MR_tablestackdebug) {
+ printf("redoip addr ");
+ MR_printnondstackptr(MR_redoip_addr(fr));
+ printf(", offset %d from start, ", offset);
+ printf("saved copy at %p\n", clobber_addr);
+ }
+#endif
+
+ if (fr == MR_gen_stack[cur_gen].generator_frame) {
+ if (MR_gen_stack[cur_gen].generator_table == table) {
+ /*
+ ** This is the nondet stack frame of the
+ ** generator corresponding to this consumer.
+ */
+
+ assert(MR_prevfr_slot(fr) == (stop_addr - 1));
+ *clobber_addr = (Word)
+ ENTRY(mercury__table_nondet_resume_1_0);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("completing redoip "
+ "of frame at ");
+ MR_printnondstackptr(fr);
+ printf(" (in saved copy)\n");
+ }
+#endif
+
+ consumer->saved_state.gen_next = cur_gen + 1;
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("saved gen_next set to %d\n",
+ cur_gen + 1);
+ }
+#endif
+ } else {
+ /*
+ ** This is the nondet stack frame of some
+ ** other generator.
+ */
+
+ assert(MR_prevfr_slot(fr) != (stop_addr - 1));
+
+ *clobber_addr = (Word) ENTRY(do_fail);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("clobbering redoip "
+ "of frame at ");
+ MR_printnondstackptr(fr);
+ printf(" (in saved copy)\n");
+ }
+#endif
+
+ save_transient_registers();
+ make_subgoal_follow_leader(
+ MR_gen_stack[cur_gen].generator_table,
+ table);
+ restore_transient_registers();
+ }
+
+ cur_gen--;
+ } else if (cur_cut > 0 && fr == MR_cut_stack[cur_cut].frame) {
+ *clobber_addr = (Word) ENTRY(MR_table_nondet_commit);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("committing redoip of frame at ");
+ MR_printnondstackptr(fr);
+ printf(" (in saved copy)\n");
+ }
+#endif
+
+ cur_cut--;
+ } else {
+ *clobber_addr = (Word) ENTRY(do_fail);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tablestackdebug) {
+ printf("clobbering redoip of frame at ");
+ MR_printnondstackptr(fr);
+ printf(" (in saved copy)\n");
+ }
+#endif
+ }
+ }
+
+#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);
+ }
+#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);
+ listnode->item = consumer;
+ listnode->next = NULL;
+}
+ fail();
+END_MODULE
+
+MR_Subgoal *MR_cur_leader;
+
+/*
+** The procedure defined below restores answers to suspended consumers.
+** It works by restoring the consumer state saved by the consumer's call
+** to table_nondet_suspend. By restoring such states and then returning
+** answers, table_nondet_resume is essentially returning answers out of
+** the call to table_nondet_suspend, not out of the call to
+** table_nondet_resume.
+**
+** The code is arranged as a three level iteration to a fixpoint.
+** The three levels are: iterating over all subgoals in a connected component,
+** iterating over all consumers of each of those subgoals, and iterating
+** over all the answers to be returned to each of those consumers.
+** Note that returning an answer could lead to further answers for
+** any of the subgoals in the connected component; it can even lead
+** to the expansion of the component (i.e. the addition of more subgoals
+** to it).
+*/
+
+Define_extern_entry(mercury__table_nondet_resume_1_0);
+Declare_label(mercury__table_nondet_resume_1_0_ChangeLoop);
+Declare_label(mercury__table_nondet_resume_1_0_ReachedFixpoint);
+Declare_label(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+Declare_label(mercury__table_nondet_resume_1_0_ReturnAnswer);
+Declare_label(mercury__table_nondet_resume_1_0_RedoPoint);
+
+MR_MAKE_PROC_LAYOUT(mercury__table_nondet_resume_1_0,
+ MR_DETISM_NON, MR_ENTRY_NO_SLOT_COUNT, MR_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, "private_builtin", "table_nondet_resume", 1, 0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_ChangeLoop,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_ReachedFixpoint,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_LoopOverSubgoals,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_LoopOverSuspensions,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_ReturnAnswer,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_RedoPoint,
+ mercury__table_nondet_resume_1_0);
+MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
+ mercury__table_nondet_resume_1_0_RestartPoint,
+ mercury__table_nondet_resume_1_0);
+
+BEGIN_MODULE(table_nondet_resume_module)
+ init_entry_sl(mercury__table_nondet_resume_1_0);
+ MR_INIT_PROC_LAYOUT_ADDR(mercury__table_nondet_resume_1_0);
+ init_label_sl(mercury__table_nondet_resume_1_0_ChangeLoop);
+ init_label_sl(mercury__table_nondet_resume_1_0_ReachedFixpoint);
+ init_label_sl(mercury__table_nondet_resume_1_0_LoopOverSubgoals);
+ init_label_sl(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+ init_label_sl(mercury__table_nondet_resume_1_0_ReturnAnswer);
+ init_label_sl(mercury__table_nondet_resume_1_0_RedoPoint);
+ init_label_sl(mercury__table_nondet_resume_1_0_RestartPoint);
+BEGIN_CODE
+
+Define_entry(mercury__table_nondet_resume_1_0);
+ MR_cur_leader = MR_top_generator_table();
+
+ if (MR_cur_leader->leader != NULL) {
+ /*
+ ** The predicate that called table_nondet_resume
+ ** is not the leader of its component.
+ ** We will leave all answers to be returned
+ ** by the leader.
+ */
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("non-leader table_nondet_resume fails\n");
+ }
+#endif
+
+ (void) MR_pop_generator();
+ redo();
+ }
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("table_nondet_resume enter: current leader is %p\n",
+ MR_cur_leader);
+ }
+#endif
+
+ if (MR_cur_leader->resume_info != NULL) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("using existing resume info %p\n",
+ MR_cur_leader->resume_info);
+ }
+#endif
+ } else {
+ MR_cur_leader->resume_info = make(MR_ResumeInfo);
+
+ save_transient_registers();
+ save_state(&(MR_cur_leader->resume_info->leader_state),
+ MR_cur_leader->generator_maxfr,
+ MR_cur_leader->generator_sp,
+ "resumption", "generator");
+ restore_transient_registers();
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("creating new resume info %p\n",
+ MR_cur_leader->resume_info);
+ }
+#endif
+ }
+
+ MR_cur_leader->resume_info->changed = TRUE;
+
+Define_label(mercury__table_nondet_resume_1_0_ChangeLoop);
+
+ if (MR_cur_leader->resume_info->changed) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("changed flag set\n");
+ }
+#endif
+ } else {
+ MR_SubgoalList table_list;
+
+ for (table_list = MR_cur_leader->resume_info->subgoal_list;
+ table_list != NULL; table_list = table_list->next)
+ {
+ if (table_list->item->num_committed_ans
+ != table_list->item->num_ans)
+ {
+ MR_cur_leader->resume_info->changed = TRUE;
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("table %p has new answers\n",
+ table_list->item);
+ }
+#endif
+ }
+ }
+ }
+
+ if (! MR_cur_leader->resume_info->changed) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no more changes\n");
+ }
+#endif
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_ReachedFixpoint);
+ }
+
+ MR_cur_leader->resume_info->subgoal_list = MR_cur_leader->followers;
+
+ /* For each of the subgoals on our list of followers */
+Define_label(mercury__table_nondet_resume_1_0_LoopOverSubgoals);
+
+ if (MR_cur_leader->resume_info->subgoal_list == NULL) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no more subgoals in the followers list\n");
+ }
+#endif
+
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_ChangeLoop);
+ }
+
+ MR_cur_leader->resume_info->cur_subgoal =
+ MR_cur_leader->resume_info->subgoal_list->item;
+ MR_cur_leader->resume_info->subgoal_list =
+ MR_cur_leader->resume_info->subgoal_list->next;
+
+ MR_cur_leader->resume_info->consumer_list =
+ MR_cur_leader->resume_info->cur_subgoal->consumer_list;
+
+ MR_cur_leader->resume_info->changed = FALSE;
+ MR_cur_leader->resume_info->cur_subgoal->num_committed_ans =
+ MR_cur_leader->resume_info->cur_subgoal->num_ans;
+
+ /* For each of the suspended nodes for cur_subgoal */
+Define_label(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+
+ if (MR_cur_leader->resume_info->consumer_list == NULL) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no more suspensions for current subgoal\n");
+ }
+#endif
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_LoopOverSubgoals);
+ }
+
+ MR_cur_leader->resume_info->cur_consumer =
+ MR_cur_leader->resume_info->consumer_list->item;
+ MR_cur_leader->resume_info->consumer_list =
+ MR_cur_leader->resume_info->consumer_list->next;
+
+ MR_cur_leader->resume_info->cur_consumer_answer_list =
+ *(MR_cur_leader->resume_info->cur_consumer->
+ remaining_answer_list_ptr);
+
+ if (MR_cur_leader->resume_info->cur_consumer_answer_list == NULL) {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no first answer for this suspension\n");
+ }
+#endif
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+ }
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("resuming consumer %p from table %p\n",
+ (void *) MR_cur_leader->resume_info->cur_consumer,
+ (void *) MR_cur_leader->resume_info->cur_subgoal);
+ }
+#endif
+
+ save_transient_registers();
+ restore_state(
+ &(MR_cur_leader->resume_info->cur_consumer->saved_state),
+ "resumption", "consumer");
+ restore_transient_registers();
+
+ /* check that there is room for exactly one framevar */
+ assert((MR_maxfr - MR_prevfr_slot(MR_maxfr)) ==
+ (MR_NONDET_FIXED_SIZE + 1));
+
+ MR_gen_next = MR_cur_leader->resume_info->leader_state.gen_next;
+ MR_redoip_slot(MR_maxfr) =
+ LABEL(mercury__table_nondet_resume_1_0_RedoPoint);
+ MR_redofr_slot(MR_maxfr) = MR_maxfr;
+ MR_based_framevar(MR_maxfr, 1) = (Word) MR_cur_leader;
+
+Define_label(mercury__table_nondet_resume_1_0_ReturnAnswer);
+
+ /*
+ ** Return the next answer in MR_cur_leader->resume_info->
+ ** cur_consumer_answer_list to the current consumer. Since we have
+ ** already restored the context of the suspended consumer before
+ ** we returned the first answer, we don't need to restore it again,
+ ** since will not have changed in the meantime.
+ */
+
+
+#ifdef COMPACT_ARGS
+ r1 = (Word) &MR_cur_leader->resume_info->cur_consumer_answer_list->
+ answer_data;
+#else
+ r2 = (Word) &MR_cur_leader->resume_info->cur_consumer_answer_list->
+ answer_data;
+#endif
+
+ MR_cur_leader->resume_info->cur_consumer->remaining_answer_list_ptr =
+ &(MR_cur_leader->resume_info->cur_consumer_answer_list->
+ next_answer);
+
+ MR_cur_leader->resume_info->cur_consumer_answer_list =
+ MR_cur_leader->resume_info->cur_consumer_answer_list->
+ next_answer;
+
+ /*
+ ** Return the answer. Since we just restored the state of the
+ ** computation that existed when suspend was called, the code
+ ** that we return to is the code following the call to suspend.
+ */
+ succeed();
+
+Define_label(mercury__table_nondet_resume_1_0_RedoPoint);
+ update_prof_current_proc(LABEL(mercury__table_nondet_resume_1_0));
+
+ /*
+ ** This is where the current consumer suspension will go on
+ ** backtracking when it wants the next solution. If there is a solution
+ ** we haven't returned to this consumer yet, we do so, otherwise we
+ ** remember how many answers we have returned to this consumer so far
+ ** and move on to the next suspended consumer of the current subgoal.
+ */
+
+ MR_cur_leader = (MR_Subgoal *) MR_based_framevar(MR_maxfr, 1);
+
+Define_label(mercury__table_nondet_resume_1_0_RestartPoint);
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("cur_consumer_answer_list: %p\n",
+ MR_cur_leader->resume_info->cur_consumer_answer_list);
+ printf("*cur_consumer->remaining_answer_list_ptr: %p\n",
+ *(MR_cur_leader->resume_info->cur_consumer->
+ remaining_answer_list_ptr));
+ }
+#endif
+
+ if (MR_cur_leader->resume_info->cur_consumer_answer_list != NULL) {
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_ReturnAnswer);
+ }
+
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("no more unreturned answers for this suspension\n");
+ }
+#endif
+
+ if (MR_cur_leader->resume_info->cur_subgoal->num_committed_ans
+ != MR_cur_leader->resume_info->cur_subgoal->num_ans)
+ {
+ MR_cur_leader->resume_info->changed = TRUE;
+ }
+
+ GOTO_LABEL(mercury__table_nondet_resume_1_0_LoopOverSuspensions);
+
+Define_label(mercury__table_nondet_resume_1_0_ReachedFixpoint);
+ {
+ MR_SubgoalList table_list;
+
+ for (table_list = MR_cur_leader->followers;
+ table_list != NULL; table_list = table_list->next)
+ {
+#ifdef MR_TABLE_DEBUG
+ if (MR_tabledebug) {
+ printf("marking table %p complete\n",
+ table_list->item);
+ }
+#endif
+
+ table_list->item->status = MR_SUBGOAL_COMPLETE;
+ table_list->item->num_committed_ans = -1;
+ }
+ }
+
+ /* Restore the state we had when table_nondet_resume was called */
+ save_transient_registers();
+ restore_state(&(MR_cur_leader->resume_info->leader_state),
+ "resumption", "generator");
+ restore_transient_registers();
+
+ /* XXX we should free this cell and its components */
+ MR_cur_leader->resume_info = NULL;
+
+ /* We are done with this generator */
+ (void) MR_pop_generator();
+
+ proceed();
+END_MODULE
+
+Define_extern_entry(MR_table_nondet_commit);
+BEGIN_MODULE(table_nondet_commit_module)
+ init_entry_ai(MR_table_nondet_commit);
+BEGIN_CODE
+Define_entry(MR_table_nondet_commit);
+ MR_commit_cut();
+ fail();
+END_MODULE
+
+#endif
+
+/* Ensure that the initialization code for the above modules gets to run. */
+/*
+INIT mercury_sys_init_table_modules
+*/
+
+#ifdef MR_USE_MINIMAL_MODEL
+extern ModuleFunc table_nondet_suspend_module;
+extern ModuleFunc table_nondet_resume_module;
+extern ModuleFunc table_nondet_commit_module;
+#endif
+
+void mercury_sys_init_table_modules(void);
+ /* extra declaration to suppress gcc -Wmissing-decl warning */
+void mercury_sys_init_table_modules(void) {
+#ifdef MR_USE_MINIMAL_MODEL
+ table_nondet_suspend_module();
+ table_nondet_resume_module();
+ table_nondet_commit_module();
+#endif
+}
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.11
diff -u -b -u -r1.11 mercury_tabling.h
--- mercury_tabling.h 1999/03/10 22:05:25 1.11
+++ mercury_tabling.h 1999/03/21 09:44:30
@@ -19,15 +19,13 @@
#include "mercury_float.h"
/*---------------------------------------------------------------------------*/
-
-typedef Word **TrieNode;
-typedef Word **AnswerBlock;
-
-/*---------------------------------------------------------------------------*/
/*
** 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 */
/*
@@ -36,7 +34,7 @@
** If it is not, create a new element for the key in the table and
** return the address of its data pointer.
**/
-TrieNode MR_int_hash_lookup_or_add(TrieNode Table, Integer Key);
+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
@@ -44,7 +42,7 @@
** If it is not create a new element for the key in the table and
** return the address of its data pointer.
**/
-TrieNode MR_float_hash_lookup_or_add(TrieNode Table, Float Key);
+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
@@ -52,13 +50,13 @@
** If it is not create a new element for the key in the table and
** return the address of its data pointer.
**/
-TrieNode MR_string_hash_lookup_or_add(TrieNode Table, String Key);
+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.
*/
-TrieNode MR_type_info_lookup_or_add(TrieNode, Word *);
+MR_TrieNode MR_type_info_lookup_or_add(MR_TrieNode, Word *);
/* --- a function to handle enumerated types --- */
@@ -67,7 +65,7 @@
** table of size Range. The return value is a pointer to the table
** node found by the lookup/insert.
*/
-TrieNode MR_int_index_lookup_or_add(TrieNode table, Integer range, Integer key);
+MR_TrieNode MR_int_index_lookup_or_add(MR_TrieNode table, Integer range, Integer key);
/* --- a function to handle any type at all --- */
@@ -77,7 +75,7 @@
** info to do this. It returns a pointer to the node found by the
** insertion/lookup.
*/
-TrieNode MR_table_type(TrieNode Table, Word *type_info, Word data_value);
+MR_TrieNode MR_table_type(MR_TrieNode Table, Word *type_info, Word data_value);
/*---------------------------------------------------------------------------*/
@@ -122,7 +120,7 @@
} while (0)
#define MR_DEBUG_TABLE_ANY(table, type_info, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_ANY((table), \
(type_info), (value)); \
if (MR_tabledebug) { \
@@ -144,7 +142,7 @@
} while (0)
#define MR_DEBUG_TABLE_TAG(table, value) \
do { \
- TrieNode prev_table = (table); \
+ 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, \
@@ -164,7 +162,7 @@
} while (0)
#define MR_DEBUG_TABLE_ENUM(table, count, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_ENUM((table), (count), \
(value)); \
if (MR_tabledebug) { \
@@ -185,7 +183,7 @@
} while (0)
#define MR_DEBUG_TABLE_WORD(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_WORD((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: word %d => %p\n", \
@@ -205,7 +203,7 @@
} while (0)
#define MR_DEBUG_TABLE_INT(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_INT((table), (value)); \
if (MR_tabledebug) { \
printf("TABLE %p: int %d => %p\n", \
@@ -225,7 +223,7 @@
} while (0)
#define MR_DEBUG_TABLE_CHAR(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_CHAR((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: char `%c'/%d => %p\n", \
@@ -246,7 +244,7 @@
} while (0)
#define MR_DEBUG_TABLE_FLOAT(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_FLOAT((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: float %f => %p\n", \
@@ -267,7 +265,7 @@
} while (0)
#define MR_DEBUG_TABLE_STRING(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_STRING((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: string `%s' => %p\n", \
@@ -287,7 +285,7 @@
} while (0)
#define MR_DEBUG_TABLE_TYPEINFO(table, value) \
do { \
- TrieNode prev_table = (table); \
+ MR_TrieNode prev_table = (table); \
(table) = (Word **) MR_RAW_TABLE_TYPE_INFO((table), (value));\
if (MR_tabledebug) { \
printf("TABLE %p: typeinfo %p => %p\n", \
@@ -393,20 +391,47 @@
/***********************************************************************/
+#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 { \
- *((AnswerBlock) ABlock) = \
+ *((MR_AnswerBlock) ABlock) = \
(Word *) table_allocate_words(Elements); \
} while(0)
#define MR_TABLE_GET_ANSWER(Offset, ABlock) \
- (* ((AnswerBlock) ABlock))[Offset]
+ (* ((MR_AnswerBlock) ABlock))[Offset]
+#endif
+
#ifdef CONSERVATIVE_GC
#define MR_TABLE_SAVE_ANSWER(Offset, ABlock, Value, TypeInfo) \
do { \
- (* ((AnswerBlock) ABlock))[Offset] = Value; \
+ (* ((MR_AnswerBlock) ABlock))[Offset] = Value; \
} while(0)
#else /* not CONSERVATIVE_GC */
@@ -415,7 +440,7 @@
do { \
save_transient_hp(); \
{ Word local_val = Value; \
- (* ((AnswerBlock) ABlock))[Offset] = \
+ (* ((MR_AnswerBlock) ABlock))[Offset] = \
deep_copy(&local_val, (Word *) (Word) &TypeInfo,\
NULL, NULL); \
} \
@@ -467,9 +492,179 @@
#endif /* CONSERVATIVE_GC */
#define table_copy_bytes(Dest, Source, Size) \
- memcpy(Dest, Source, Size)
+ MR_memcpy(Dest, Source, Size)
#define table_copy_words(Dest, Source, Size) \
- memcpy((char *) Dest, (char *) Source, sizeof(Word) * 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.
+**
+** 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".
+*/
+
+typedef enum {
+ MR_SIMPLETABLE_UNINITIALIZED,
+ MR_SIMPLETABLE_WORKING,
+ MR_SIMPLETABLE_FAILED,
+ MR_SIMPLETABLE_SUCCEEDED
+} MR_SimpletableStatus;
+
+#ifdef MR_USE_MINIMAL_MODEL
+
+typedef enum {
+ MR_SUBGOAL_INACTIVE,
+ MR_SUBGOAL_ACTIVE,
+ MR_SUBGOAL_COMPLETE
+} MR_SubgoalStatus;
+
+/*
+** The saved state of a generator or a consumer. While consumers get
+** suspended while they are waiting for generators to produce more solutions,
+** generators need their state saved when they restore the state of a consumer
+** to consume a new solution.
+**
+** The saved state contains copies of
+**
+** - several virtual machine registers:
+** MR_succip, MR_sp, MR_curfr and MR_maxfr
+**
+** - segments of the nondet and det stacks:
+** the parts that cannot possibly change between the times of saving
+** and restoring the saved state are not saved.
+**
+** The segments are described by three fields each. The *_block_start
+** field gives the address of the first word in the real stack
+** that is part of the saved segment, the *_block_size field
+** gives the size of the saved segment in words, and the *_block
+** field points to the area of memory containing the saved segment.
+**
+** - the entire generator stack and the entire cut stack:
+** they are usually so small, it is faster to save them all
+** than to figure out which parts need saving.
+**
+** Each stack is described by its size in words and a pointer to
+** an area of memory containing the entire saved stack.
+*/
+
+typedef struct {
+ Code *succ_ip;
+ Word *s_p;
+ Word *cur_fr;
+ Word *max_fr;
+ Word *non_stack_block_start;
+ Word non_stack_block_size;
+ Word *non_stack_block;
+ Word *det_stack_block_start;
+ Word det_stack_block_size;
+ Word *det_stack_block;
+ Integer gen_next;
+ char *generator_stack_block;
+ Integer cut_next;
+ char *cut_stack_block;
+} MR_SavedState;
+
+/* The state of a consumer subgoal */
+typedef struct {
+ MR_SavedState saved_state;
+ MR_AnswerList *remaining_answer_list_ptr;
+} MR_Consumer;
+
+typedef struct MR_ConsumerListNode *MR_ConsumerList;
+
+struct MR_ConsumerListNode {
+ MR_Consumer *item;
+ MR_ConsumerList next;
+};
+
+typedef struct MR_SubgoalStruct MR_Subgoal;
+typedef struct MR_SubgoalListNode *MR_SubgoalList;
+
+/*
+** The following structure is used to hold the state and variables used in
+** the table_resume procedure.
+*/
+
+typedef struct {
+ MR_SavedState leader_state;
+ MR_SubgoalList subgoal_list;
+ MR_Subgoal *cur_subgoal;
+ MR_ConsumerList consumer_list; /* for the current subgoal */
+ MR_Consumer *cur_consumer;
+ MR_AnswerList cur_consumer_answer_list;
+ bool changed;
+} MR_ResumeInfo;
+
+struct MR_SubgoalListNode {
+ MR_Subgoal *item;
+ MR_SubgoalList next;
+};
+
+/* Used to save info about a single subgoal in the table */
+struct MR_SubgoalStruct {
+ MR_SubgoalStatus status;
+ MR_Subgoal *leader;
+ MR_SubgoalList followers;
+ MR_SubgoalList *followers_tail;
+ MR_ResumeInfo *resume_info;
+ Word answer_table; /* Table of answers returned */
+ /* by the subgoal */
+ Integer num_ans; /* # of answers returned */
+ /* by the subgoal */
+ Integer num_committed_ans;
+ /* # of answers our leader */
+ /* is committed to returning */
+ /* to every consumer. */
+ MR_AnswerList answer_list; /* List of answers returned */
+ /* by the subgoal */
+ MR_AnswerList *answer_list_tail;
+ /* Pointer to the tail of */
+ /* the answer list. This is */
+ /* used to update the tail. */
+ MR_ConsumerList consumer_list; /* List of suspended calls */
+ /* to the subgoal */
+ MR_ConsumerList *consumer_list_tail;
+ /* As for answer_list_tail */
+ Word *generator_maxfr;
+ /* MR_maxfr at the time of */
+ /* the call to the generator */
+ Word *generator_sp;
+ /* MR_sp at the time of the */
+ /* call to the generator */
+};
+
+ /*
+ ** Cast a Word to a MR_Subgoal*: saves on typing and improves
+ ** readability.
+ */
+#define MR_SUBGOAL(T) (*(MR_Subgoal **) T)
+
+/*---------------------------------------------------------------------------*/
+
+#endif /* MR_USE_MINIMAL_MODEL */
#endif /* not MERCURY_TABLING_H */
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.34
diff -u -b -u -r1.34 mercury_wrapper.c
--- mercury_wrapper.c 1999/04/16 03:07:59 1.34
+++ mercury_wrapper.c 1999/04/17 10:56:31
@@ -57,6 +57,8 @@
size_t global_heap_size = 1024;
size_t trail_size = 128;
size_t debug_heap_size = 4096;
+size_t generatorstack_size = 32;
+size_t cutstack_size = 32;
/* size of the redzones at the end of data areas, in kilobytes */
/* (but we later multiply by 1024 to convert to bytes) */
@@ -71,6 +73,8 @@
size_t global_heap_zone_size = 16;
size_t trail_zone_size = 16;
size_t debug_heap_zone_size = 16;
+size_t generatorstack_zone_size = 16;
+size_t cutstack_zone_size = 16;
/* primary cache size to optimize for, in bytes */
size_t pcache_size = 8192;
@@ -684,6 +688,8 @@
MR_sregdebug = TRUE;
else if (streq(MR_optarg, "t"))
MR_tracedebug = TRUE;
+ else if (streq(MR_optarg, "S"))
+ MR_tablestackdebug = TRUE;
else if (streq(MR_optarg, "T"))
MR_tabledebug = TRUE;
else if (streq(MR_optarg, "a")) {
@@ -952,6 +958,18 @@
break;
case MR_GLOBAL_HP_RN:
printf("MR_global_hp");
+ break;
+ case MR_GEN_STACK_RN:
+ printf("MR_gen_stack");
+ break;
+ case MR_GEN_NEXT_RN:
+ printf("MR_gen_next");
+ break;
+ case MR_CUT_STACK_RN:
+ printf("MR_cut_stack");
+ break;
+ case MR_CUT_NEXT_RN:
+ printf("MR_cut_next");
break;
default:
printf("UNKNOWN%d", i);
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.18
diff -u -b -u -r1.18 mercury_wrapper.h
--- mercury_wrapper.h 1999/04/14 14:09:01 1.18
+++ mercury_wrapper.h 1999/04/15 02:03:01
@@ -16,6 +16,7 @@
#include "mercury_std.h" /* for `bool' */
#include "mercury_stack_layout.h" /* for `MR_Stack_Layout_Label' */
#include "mercury_trace_base.h" /* for `MR_trace_port' */
+#include "mercury_stacks.h" /* for `MR_{Cut,Generator}StackFrame' */
/*
** mercury_runtime_init() does some stuff to initialize the garbage collector
@@ -114,6 +115,8 @@
extern size_t trail_size;
extern size_t global_heap_size;
extern size_t debug_heap_size;
+extern size_t generatorstack_size;
+extern size_t cutstack_size;
/* sizes of the red zones */
extern size_t heap_zone_size;
@@ -123,6 +126,8 @@
extern size_t trail_zone_size;
extern size_t global_heap_zone_size;
extern size_t debug_heap_zone_size;
+extern size_t generatorstack_zone_size;
+extern size_t cutstack_zone_size;
/* file names for the mdb debugging streams */
extern const char *MR_mdb_in_filename;
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 scripts
Index: scripts/final_grade_options.sh-subr
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/final_grade_options.sh-subr,v
retrieving revision 1.1
diff -u -b -u -r1.1 final_grade_options.sh-subr
--- final_grade_options.sh-subr 1998/10/16 06:19:22 1.1
+++ final_grade_options.sh-subr 1999/04/13 23:43:09
@@ -1,5 +1,5 @@
#---------------------------------------------------------------------------#
-# Copyright (C) 1998 The University of Melbourne.
+# Copyright (C) 1998-1999 The University of Melbourne.
# This file may only be copied under the terms of the GNU General
# Public License - see the file COPYING in the Mercury distribution.
#---------------------------------------------------------------------------#
@@ -14,11 +14,21 @@
#---------------------------------------------------------------------------#
#
-# .debug grade implies --use-trail
-# (see comment in compiler/handle_options.m for rationale)
+# .tr grade is not compatible with .mm
+# (see comment in runtime/mercury_tabling.c for rationale)
#
-case $stack_trace,$require_tracing in
+case $use_trail,$use_minimal_model in
true,true)
+ echo "trailing and minimal model tabling are not compatible"
+ exit 1 ;;
+esac
+
+#
+# .debug grade implies --use-trail in the absence of .mm
+# (see comment in compiler/handle_options.m for rationale)
+#
+case $stack_trace,$require_tracing,$use_minimal_model in
+ true,true,false)
use_trail=true ;;
esac
Index: scripts/init_grade_options.sh-subr
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/init_grade_options.sh-subr,v
retrieving revision 1.5
diff -u -b -u -r1.5 init_grade_options.sh-subr
--- init_grade_options.sh-subr 1998/06/09 02:16:22 1.5
+++ init_grade_options.sh-subr 1999/04/13 23:43:17
@@ -1,5 +1,5 @@
#---------------------------------------------------------------------------#
-# Copyright (C) 1997-1998 The University of Melbourne.
+# Copyright (C) 1997-1999 The University of Melbourne.
# This file may only be copied under the terms of the GNU General
# Public License - see the file COPYING in the Mercury distribution.
#---------------------------------------------------------------------------#
@@ -21,6 +21,7 @@
profile_calls=false
profile_memory=false
use_trail=false
+use_minimal_model=false
args_method=compact
stack_trace=false
require_tracing=false
Index: scripts/mgnuc.in
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/mgnuc.in,v
retrieving revision 1.62
diff -u -b -u -r1.62 mgnuc.in
--- mgnuc.in 1999/04/06 17:13:01 1.62
+++ mgnuc.in 1999/04/13 23:42:55
@@ -267,6 +267,11 @@
false) TRAIL_OPTS="" ;;
esac
+case $use_minimal_model in
+ true) MINIMAL_MODEL_OPTS="-DMR_USE_MINIMAL_MODEL" ;;
+ false) MINIMAL_MODEL_OPTS="" ;;
+esac
+
case $thread_safe in
true)
case $FULLARCH in
@@ -434,8 +439,8 @@
$GRADE_OPTS $GC_OPTS $DEFINE_OPTS \
$TRACE_OPTS $STACK_TRACE_OPTS $LLDEBUG_OPTS $C_DEBUG_OPTS \
$PROF_TIME_OPTS $PROF_CALLS_OPTS $PROF_MEMORY_OPTS \
- $INLINE_ALLOC_OPTS $TRAIL_OPTS $SPLIT_OPTS $THREAD_OPTS \
- $PICREG_OPTS $ARCH_OPTS $ARG_OPTS"
+ $INLINE_ALLOC_OPTS $TRAIL_OPTS $MINIMAL_MODEL_OPTS \
+ $SPLIT_OPTS $THREAD_OPTS $PICREG_OPTS $ARCH_OPTS $ARG_OPTS"
case $verbose in true)
echo $CC $ALL_CC_OPTS "$@" $OVERRIDE_OPTS $ALL_LOCAL_C_INCL_DIRS;;
Index: scripts/parse_grade_options.sh-subr
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/parse_grade_options.sh-subr,v
retrieving revision 1.8
diff -u -b -u -r1.8 parse_grade_options.sh-subr
--- parse_grade_options.sh-subr 1998/09/22 22:57:11 1.8
+++ parse_grade_options.sh-subr 1999/04/13 23:43:35
@@ -96,6 +96,11 @@
--no-use-trail)
use_trail=false ;;
+ --use-minimal-model)
+ use_minimal_model=true ;;
+ --no-use-minimal-model)
+ use_minimal_model=false ;;
+
--args)
shift
case "$1" in
@@ -133,6 +138,7 @@
profile_calls=false
profile_memory=false
use_trail=false
+ use_minimal_model=false
args_method=compact
stack_trace=false
require_tracing=false
@@ -161,6 +167,8 @@
args_method=simple
;;
tr) use_trail=true
+ ;;
+ mm) use_minimal_model=true
;;
memprof)
profile_time=false
cvs diff: Diffing tests
Index: tests/Mmake.common
===================================================================
RCS file: /home/mercury1/repository/tests/Mmake.common,v
retrieving revision 1.13
diff -u -b -u -r1.13 Mmake.common
--- Mmake.common 1998/11/04 07:53:21 1.13
+++ Mmake.common 1999/04/08 11:52:38
@@ -13,6 +13,8 @@
DIFF_OPTS=-c
+EXTRA_MLFLAGS=--no-readline
+
#-----------------------------------------------------------------------------#
# .PRECIOUS: %.mod %.c %.o %_init.c %.no %.nu %_init.nl %_init.no
Index: tests/runtests
===================================================================
RCS file: /home/mercury1/repository/tests/runtests,v
retrieving revision 1.4
diff -u -b -u -r1.4 runtests
--- runtests 1998/04/23 09:27:02 1.4
+++ runtests 1999/04/13 04:57:29
@@ -2,6 +2,7 @@
# Run the tests in each of the subdirectories.
. ./handle_options
+gflag="-g asm_fast.gc.mm"
failures=""
for dir in *
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/hard_coded
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.4
diff -u -b -u -r1.4 Mmakefile
--- Mmakefile 1998/09/24 11:45:33 1.4
+++ Mmakefile 1999/04/14 10:34:09
@@ -6,26 +6,56 @@
#-----------------------------------------------------------------------------#
-PROGS= \
+SIMPLE_PROGS = \
boyer \
fib \
tc_loop \
tc_minimal
-# We don't yet pass the following tests:
-# coup
+# make sure that all the tests here have a GRADEFLAGS that specifies
+# --use-minimal-model
+NONDET_PROGS = \
+ coup \
+ coup_det_frame \
+ coup_no_commit \
+ coup_non_tabled_frame \
+ generator_in_commit \
+ repeat \
+ seq
+# We don't yet pass the following minimal model tests. The reason is that
+# they contain interactions between tabling and constructs that function
+# as negated contexts.
+#
+# consumer_in_commit
+# consumer_in_solutions
+
+ifneq "$(findstring .gc,$(GRADE))" ""
+ ifneq "$(findstring mm,$(GRADE))" ""
+ PROGS=$(SIMPLE_PROGS)
+ else
+ PROGS=$(SIMPLE_PROGS) $(NONDET_PROGS)
+ endif
+else
+ PROGS=
+endif
+
#-----------------------------------------------------------------------------#
-# at the moment tabling only works with conservative gc
-GRADEFLAGS = --gc conservative
+MCFLAGS-coup = --use-minimal-model
+MCFLAGS-coup_det_frame = --use-minimal-model
+MCFLAGS-coup_no_commit = --use-minimal-model
+MCFLAGS-coup_non_tabled_frame = --use-minimal-model
+MCFLAGS-generator_in_commit = --use-minimal-model
+MCFLAGS-repeat = --use-minimal-model
+MCFLAGS-seq = --use-minimal-model
# 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
+# Some test cases are expected to abort, so we need to ignore the exit status
# (hence the leading `-')
tc_loop.out: tc_loop
-./tc_loop > tc_loop.out 2>&1;
Index: tests/tabling/consumer_in_commit.exp
===================================================================
RCS file: consumer_in_commit.exp
diff -N consumer_in_commit.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ consumer_in_commit.exp Fri Mar 12 11:51:19 1999
@@ -0,0 +1,2 @@
+Mercury runtime: Sorry, not implemented:
+committing across a suspended call to a tabled predicate
Index: tests/tabling/consumer_in_commit.m
===================================================================
RCS file: consumer_in_commit.m
diff -N consumer_in_commit.m
--- /dev/null Wed May 28 10:49:58 1997
+++ consumer_in_commit.m Fri Mar 12 11:44:18 1999
@@ -0,0 +1,46 @@
+% This test case checks whether we get incorrect answers
+% when a consumer gets suspended inside a commit.
+
+:- module consumer_in_commit.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ q(X),
+ r(X).
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(X) :-
+ (
+ X = 1
+ ;
+ q(Y),
+ X = Y + 1,
+ X < 10
+ ).
+
+:- pred r(int).
+:- mode r(in) is semidet.
+
+r(X) :-
+ X < 5,
+ q(_).
Index: tests/tabling/consumer_in_solutions.exp
===================================================================
RCS file: consumer_in_solutions.exp
diff -N consumer_in_solutions.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ consumer_in_solutions.exp Fri Feb 26 18:00:42 1999
@@ -0,0 +1 @@
+[1 - [1, 2, 3], 2 - [1, 2, 3], 3 - [1, 2, 3]]
Index: tests/tabling/consumer_in_solutions.m
===================================================================
RCS file: consumer_in_solutions.m
diff -N consumer_in_solutions.m
--- /dev/null Wed May 28 10:49:58 1997
+++ consumer_in_solutions.m Fri Mar 12 11:46:11 1999
@@ -0,0 +1,35 @@
+% This test case checks whether we get incorrect answers
+% when a consumer gets suspended inside solutions.
+
+:- module consumer_in_solutions.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(q, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pragma minimal_model(q/1).
+:- pred q(pair(int, list(int))).
+:- mode q(out) is nondet.
+
+q(X - L) :-
+ p(X),
+ solutions(p, L).
+
+:- pragma minimal_model(p/1).
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(1).
+p(2).
+p(3).
Index: tests/tabling/coup.exp
===================================================================
RCS file: coup.exp
diff -N coup.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ coup.exp Fri Feb 26 18:03:17 1999
@@ -0,0 +1 @@
+[1, 3, 4]
Index: tests/tabling/coup.m
===================================================================
RCS file: /home/mercury1/repository/tests/tabling/coup.m,v
retrieving revision 1.1
diff -u -b -u -r1.1 coup.m
--- coup.m 1998/09/24 11:45:36 1.1
+++ coup.m 1999/02/26 06:45:23
@@ -16,8 +16,9 @@
:- import_module std_util.
main -->
- { solutions(p, L) },
- writeilist(L).
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
:- pragma minimal_model(p/1).
:- pred p(int).
@@ -34,11 +35,3 @@
q(3) :- q(_).
q(4) :- p(_).
-
-:- pred writeilist(list(int)::in,io__state::di, io__state::uo) is det.
-
-writeilist([]) --> [].
-writeilist([X|R]) -->
- io__write_int(X),
- io__write_string(" "),
- writeilist(R).
Index: tests/tabling/coup_det_frame.exp
===================================================================
RCS file: coup_det_frame.exp
diff -N coup_det_frame.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_det_frame.exp Fri Feb 26 18:13:24 1999
@@ -0,0 +1 @@
+[1, 3, 4]
Index: tests/tabling/coup_det_frame.m
===================================================================
RCS file: coup_det_frame.m
diff -N coup_det_frame.m
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_det_frame.m Sun Mar 21 19:58:08 1999
@@ -0,0 +1,51 @@
+% This test is a variant of coup, with the commits around the recursive
+% calls wrapped up inside explicit predicates. This means that when a
+% subgoal is suspended, coup_det_frame will require a non-empty det
+% stack segment to be saved, whereas in coup the saved det stack segment
+% is empty. Both need to be tested.
+%
+% In case there are any problems with the interaction of the commits
+% and tabling, this version is more likely to be easy to debug, since
+% putting breakpoints on any_p and any_q effectively puts breakpoint
+% on the commits, which otherwise you can't easily do.
+
+:- module coup_det_frame.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pragma minimal_model(p/1).
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ q(X).
+p(X) :-
+ X = 1.
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(3) :- any_q.
+q(4) :- any_p.
+
+:- pred any_q is semidet.
+
+any_q :- q(_).
+
+:- pred any_p is semidet.
+
+any_p :- p(_).
Index: tests/tabling/coup_no_commit.exp
===================================================================
RCS file: coup_no_commit.exp
diff -N coup_no_commit.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_no_commit.exp Fri Feb 26 18:13:38 1999
@@ -0,0 +1 @@
+[1, 4]
Index: tests/tabling/coup_no_commit.m
===================================================================
RCS file: coup_no_commit.m
diff -N coup_no_commit.m
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_no_commit.m Fri Feb 26 17:48:07 1999
@@ -0,0 +1,39 @@
+% This test case is a variant of coup. It does not use commits,
+% but does use the output value of every tabled subgoal.
+
+:- module coup_no_commit.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pragma minimal_model(p/1).
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ (
+ q(X)
+ ;
+ X = 1
+ ).
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(Y) :-
+ p(Z),
+ Y is Z + 3,
+ Y < 10.
Index: tests/tabling/coup_non_tabled_frame.exp
===================================================================
RCS file: coup_non_tabled_frame.exp
diff -N coup_non_tabled_frame.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_non_tabled_frame.exp Fri Feb 26 18:03:47 1999
@@ -0,0 +1 @@
+[1, 3, 4, 5, 6]
Index: tests/tabling/coup_non_tabled_frame.m
===================================================================
RCS file: coup_non_tabled_frame.m
diff -N coup_non_tabled_frame.m
--- /dev/null Wed May 28 10:49:58 1997
+++ coup_non_tabled_frame.m Fri Feb 26 17:49:06 1999
@@ -0,0 +1,44 @@
+% This is yet another variant of the coup test case. This one includes
+% a non-tabled model_non procedure in the nondet stack segment that needs
+% to be saved and restored, checking that the frames of such procedures
+% are handled correctly.
+
+:- module coup_non_tabled_frame.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pragma minimal_model(p/1).
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ r(X).
+p(X) :-
+ X = 1.
+
+:- pred r(int).
+:- mode r(out) is multi.
+
+r(X) :- q(X).
+r(6).
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(3) :- q(_).
+q(4) :- p(_).
+q(5).
Index: tests/tabling/generator_in_commit.exp
===================================================================
RCS file: generator_in_commit.exp
diff -N generator_in_commit.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ generator_in_commit.exp Wed Mar 17 18:28:09 1999
@@ -0,0 +1 @@
+[21, 22, 23, 24, 25, 26, 27, 28, 29, 42]
Index: tests/tabling/generator_in_commit.m
===================================================================
RCS file: generator_in_commit.m
diff -N generator_in_commit.m
--- /dev/null Wed May 28 10:49:58 1997
+++ generator_in_commit.m Sun Mar 21 19:58:15 1999
@@ -0,0 +1,44 @@
+% This test case checks whether we get incorrect answers
+% when a generator gets started but not finished inside a commit.
+
+:- module generator_in_commit.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+:- import_module std_util.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pred p(int).
+:- mode p(out) is nondet.
+
+p(X) :-
+ (
+ q(_),
+ X = 42
+ ;
+ q(Y),
+ X = Y + 20
+ ).
+
+:- pragma minimal_model(q/1).
+:- pred q(int).
+:- mode q(out) is nondet.
+
+q(X) :-
+ (
+ q(Y),
+ X = Y + 1,
+ X < 10
+ ;
+ X = 1
+ ).
Index: tests/tabling/repeat.exp
===================================================================
RCS file: repeat.exp
diff -N repeat.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ repeat.exp Thu Mar 11 15:42:37 1999
@@ -0,0 +1,2 @@
+[1, 2, 3]
+[1, 2, 3]
Index: tests/tabling/seq.exp
===================================================================
RCS file: seq.exp
diff -N seq.exp
--- /dev/null Wed May 28 10:49:58 1997
+++ seq.exp Fri Feb 26 18:04:21 1999
@@ -0,0 +1 @@
+[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
Index: tests/tabling/seq.m
===================================================================
RCS file: seq.m
diff -N seq.m
--- /dev/null Wed May 28 10:49:58 1997
+++ seq.m Fri Feb 26 17:49:27 1999
@@ -0,0 +1,33 @@
+% This test case checks the correctness of the code that performs
+% the fixpoint loop returning answers to consumers.
+
+:- module seq.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module std_util, int, list.
+
+main -->
+ { solutions(p, Solns) },
+ io__write(Solns),
+ io__write_string("\n").
+
+:- pred p(int).
+:- mode p(out) is nondet.
+
+:- pragma minimal_model(p/1).
+
+p(X) :-
+ (
+ p(Y),
+ X is Y + 1,
+ X < 10
+ ;
+ X = 0
+ ).
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.33
diff -u -b -u -r1.33 Mmakefile
--- Mmakefile 1999/01/27 08:34:38 1.33
+++ Mmakefile 1999/04/16 02:32:26
@@ -15,6 +15,10 @@
agc_unbound_typevars2.m \
agc_unused_in.m
+TRAIL_SOURCES= \
+ complex_failure.m \
+ semi_fail_in_non_ite.m
+
TYPECLASS_SOURCES= \
func_method.m \
instance_superclass.m \
@@ -22,7 +26,6 @@
OTHER_SOURCES= \
compl_unify_bug.m \
- complex_failure.m \
complicated_unify.m \
constructor_arg_names.m \
dcg_test.m \
@@ -87,7 +90,6 @@
pred_with_no_modes.m \
qualified_cons_id.m \
same_length_2.m \
- semi_fail_in_non_ite.m \
semidet_disj.m \
shape_type.m \
simplify_bug.m \
@@ -120,19 +122,25 @@
# cannot be used with accurate GC or type classes
ifneq "$(findstring asm_,$(GRADE))" ""
- SOURCES=$(AGC_SOURCES) $(TYPECLASS_SOURCES) $(OTHER_SOURCES)
+ SOURCES0=$(AGC_SOURCES) $(TYPECLASS_SOURCES) $(OTHER_SOURCES)
else
ifneq "$(findstring jump,$(GRADE))" ""
- SOURCES=$(OTHER_SOURCES)
+ SOURCES0=$(OTHER_SOURCES)
else
ifneq "$(findstring fast,$(GRADE))" ""
- SOURCES=$(OTHER_SOURCES)
+ SOURCES0=$(OTHER_SOURCES)
else
- SOURCES=$(AGC_SOURCES) $(TYPECLASS_SOURCES) $(OTHER_SOURCES)
+ SOURCES0=$(AGC_SOURCES) $(TYPECLASS_SOURCES) $(OTHER_SOURCES)
endif
endif
endif
+ifneq "$(findstring mm,$(GRADE))" ""
+ SOURCES=$(SOURCES0)
+else
+ SOURCES=$(SOURCES0) $(TRAIL_SOURCES)
+endif
+
DEPS = $(SOURCES:%.m=%.depend)
OBJS = $(SOURCES:%.m=$(os_subdir)%.o)
PROGS = $(SOURCES:%.m=%)
@@ -140,15 +148,18 @@
all: objs
# some regression tests only failed with particular options enabled
-# (please keep this list sorted)
+# (please keep these lists sorted)
+
GRADEFLAGS-agc_graph = --gc accurate
GRADEFLAGS-agc_ho_pred = --gc accurate
GRADEFLAGS-agc_ite = --gc accurate
GRADEFLAGS-agc_unbound_typevars = --gc accurate
GRADEFLAGS-agc_unbound_typevars2 = --gc accurate
GRADEFLAGS-agc_unused_in = --gc accurate
+GRADEFLAGS-complex_failure = --use-trail
+GRADEFLAGS-semi_fail_in_non_ite = --use-trail
+
MCFLAGS-compl_unify_bug = -O3
-MCFLAGS-complex_failure = --use-trail
MCFLAGS-deforest_loop = -O3 --intermodule-optimization
MCFLAGS-deforest_rerun_det = -O3 --check-termination
MCFLAGS-double_vn = -O4
@@ -159,7 +170,6 @@
MCFLAGS-middle_rec_labels = --middle-rec --no-follow-vars
MCFLAGS-mostly_uniq_mode_inf = --infer-all
MCFLAGS-pred_with_no_modes = --infer-all
-MCFLAGS-semi_fail_in_non_ite = --use-trail
MCFLAGS-simplify_bug = -O-1
MCFLAGS-two_way_unif = -O-1
MCFLAGS-type_inf_ambig_test = --infer-all
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.38
diff -u -b -u -r1.38 mercury_trace_internal.c
--- mercury_trace_internal.c 1999/04/12 04:11:48 1.38
+++ mercury_trace_internal.c 1999/04/15 02:04:04
@@ -1294,6 +1294,15 @@
} else {
MR_trace_usage("developer", "nondet_stack");
}
+#ifdef MR_USE_MINIMAL_MODEL
+ } else if (streq(words[0], "gen_stack")) {
+ if (word_count == 1) {
+ do_init_modules();
+ MR_print_gen_stack(MR_mdb_out);
+ } else {
+ MR_trace_usage("developer", "gen_stack");
+ }
+#endif
} else if (streq(words[0], "stack_regs")) {
if (word_count == 1) {
fprintf(MR_mdb_out, "sp = ");
@@ -2489,6 +2498,9 @@
{ "exp", "clear_histogram" },
#endif
{ "developer", "nondet_stack" },
+#ifdef MR_USE_MINIMAL_MODEL
+ { "developer", "gen_stack" },
+#endif
{ "developer", "stack_regs" },
{ "misc", "source" },
{ "misc", "quit" },
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