[m-rev.] for review: thread-local backjumping

Julien Fischer juliensf at csse.unimelb.edu.au
Wed Mar 12 15:52:45 AEDT 2008


For review by Mark.

Estimated hours taken: 7
Branches: main

Add support for thread-local backjumping in grades that support concurrency.

library/backjump.m:
 	Shift the C definition of backjump handlers and choice ids into the
 	runtime.  This is needed because MR_Context now refers to them and
 	the runtime should not depend on the library.

 	Delete the XXX comment regarding pred_is_external/3.  (This has been
 	fixed below.)

runtime/mercury_backjump.h:
runtime/mercury_backjump.c:
 	New module that defines those parts of the backjumping support that
 	the runtime requires access to.

 	In high-level C .par grades make the global state required by
 	backjumping thread-specific.

 	Conform to the usual coding conventions in the runtime in the new
 	versions of the data structures that were originally in backjump.m.

 	Rename ML_Choice_Id to MR_BackJumpChoiceId, the latter is less
 	ambiguous.

runtime/mercury_context.h:
runtime/mercury_context.c:
 	In low-level C grades add two extra fields to the MR_Context structure
 	to hold the global state required by backjumping.

 	In high-level C .par grades initialise the the thread-specific data that
 	is used to store the backjump global state at program startup.

 	Reformat a function prototype.

runtime/mercury_thread.h:
 	Reformat a function prototype.

runtime/Mmakefile:
 	Include the new files.

mdbcomp/program_representation.m:
 	Update pred_is_external/3 to include backjump.builtin_choice_id/1
 	and backjump.builtin_backjump/1.

tests/hard_coded/Mmakefile:
tests/hard_coded/tl_backjump_test.m:
tests/hard_coded/tl_backjump_test.exp:
 	Test thread-local backjumping.

tests/hard_coded/tl_backjump_test.exp2:
 	Expected output for the above test case for grades in which spawn/3
 	does not work.

Julien.

Index: library/backjump.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/backjump.m,v
retrieving revision 1.1
diff -u -r1.1 backjump.m
--- library/backjump.m	9 Mar 2008 09:39:24 -0000	1.1
+++ library/backjump.m	12 Mar 2008 04:48:15 -0000
@@ -112,53 +112,13 @@
  % mdbcomp/program_representation.m.  The debugger needs to know what predicates
  % are defined externally, so that it knows not to expect events for those
  % predicates.
-%
-% XXX we haven't done this yet.
-%

  :- external(builtin_choice_id/1).
  :- external(builtin_backjump/1).

  %-----------------------------------------------------------------------------%

-:- pragma foreign_decl("C", "
-
-typedef MR_Integer      ML_Choice_Id;
-
-typedef struct ML_BackJumpHandler_struct {
-    struct ML_BackJumpHandler_struct *prev;
-    ML_Choice_Id        id;
-
-#ifdef MR_HIGHLEVEL_CODE
-
-    jmp_buf             handler;
-
-#else /* !MR_HIGHLEVEL_CODE */
-
-    MR_Word             *saved_sp;
-    MR_Word             *saved_fr;
-
-#endif /* !MR_HIGHLEVEL_CODE */
-
-} ML_BackJumpHandler;
-
-
-/*
-** XXX Does not work properly in grades that support multiple threads.
-*/
-#define ML_GET_BACKJUMP_HANDLER()      ML_backjump_handler
-#define ML_SET_BACKJUMP_HANDLER(val)   ML_backjump_handler = (val)
-#define ML_GET_NEXT_CHOICE_ID()        (ML_next_choice_id++)
-
-extern ML_BackJumpHandler   *ML_backjump_handler;
-extern ML_Choice_Id         ML_next_choice_id;
-
-").
-
-:- pragma foreign_code("C", "
-    ML_BackJumpHandler  *ML_backjump_handler;
-    ML_Choice_Id        ML_next_choice_id = 0;
-").
+:- pragma foreign_decl("C", "#include \"mercury_backjump.h\"").

  %-----------------------------------------------------------------------------%
  %
@@ -188,10 +148,10 @@
  #endif

  void MR_CALL
-mercury__backjump__builtin_choice_id_1_p_0(ML_Choice_Id *id, MR_CONT_PARAMS);
+mercury__backjump__builtin_choice_id_1_p_0(MR_BackJumpChoiceId *id, MR_CONT_PARAMS);

  void MR_CALL
-mercury__backjump__builtin_backjump_1_p_0(ML_Choice_Id id);
+mercury__backjump__builtin_backjump_1_p_0(MR_BackJumpChoiceId id);

  #endif /* MR_HIGHLEVEL_CODE */
  #endif /* ML_BACKJUMP_GUARD */
@@ -213,18 +173,18 @@
  void MR_CALL
  mercury__backjump__builtin_choice_id_1_p_0(MR_Integer *id, MR_CONT_PARAMS)
  {
-    ML_BackJumpHandler this_handler;
+    MR_BackJumpHandler this_handler;

-    this_handler.prev = ML_GET_BACKJUMP_HANDLER();
-    this_handler.id = ML_GET_NEXT_CHOICE_ID();
-    ML_SET_BACKJUMP_HANDLER(&this_handler);
+    this_handler.MR_bjh_prev = MR_GET_BACKJUMP_HANDLER();
+    this_handler.MR_bjh_id = MR_GET_NEXT_CHOICE_ID();
+    MR_SET_BACKJUMP_HANDLER(&this_handler);

-    if (setjmp(this_handler.handler) == 0) {
+    if (setjmp(this_handler.MR_bjh_handler) == 0) {
      #ifdef MR_DEBUG_JMPBUFS
          fprintf(stderr, ""choice setjmp %p\\n"", this_handler.handler);
      #endif

-        *id = this_handler.id;
+        *id = this_handler.MR_bjh_id;
          MR_CONT_CALL();
      } else {
      #ifdef MR_DEBUG_JMPBUFS
@@ -232,13 +192,15 @@
      #endif
      }

-    ML_SET_BACKJUMP_HANDLER(this_handler.prev);
+    MR_SET_BACKJUMP_HANDLER(this_handler.MR_bjh_prev);
  }

  void MR_CALL
-mercury__backjump__builtin_backjump_1_p_0(ML_Choice_Id id)
+mercury__backjump__builtin_backjump_1_p_0(MR_BackJumpChoiceId id)
  {
-    ML_BackJumpHandler *backjump_handler = ML_GET_BACKJUMP_HANDLER();
+    MR_BackJumpHandler *backjump_handler;
+ 
+    backjump_handler = MR_GET_BACKJUMP_HANDLER();

      /*
      ** XXX when we commit and prune away nondet stack frames, we leave the
@@ -260,10 +222,10 @@
      ** commits.)
      */
      while (backjump_handler != NULL) {
-        if (backjump_handler->id == id) {
+        if (backjump_handler->MR_bjh_id == id) {
              break;
          }
-        backjump_handler = backjump_handler->prev;
+        backjump_handler = backjump_handler->MR_bjh_prev;
      }

      if (backjump_handler == NULL) {
@@ -272,9 +234,10 @@
      } else {

    #ifdef MR_DEBUG_JMPBUFS
-        fprintf(stderr, ""backjump longjmp %p\\n"", backjump_handler->handler);
+        fprintf(stderr, ""backjump longjmp %p\\n"",
+            backjump_handler->MR_bjh_handler);
    #endif
-        longjmp(backjump_handler->handler, 1);
+        longjmp(backjump_handler->MR_bjh_handler, 1);
      }
  }

@@ -313,7 +276,7 @@
  #define ML_DUMMY_LINE 0

  #define ML_BACKJUMP_STRUCT \
-    (((ML_BackJumpHandler *) (MR_curfr + 1 - MR_NONDET_FIXED_SIZE)) - 1)
+    (((MR_BackJumpHandler *) (MR_curfr + 1 - MR_NONDET_FIXED_SIZE)) - 1)

  #ifdef ML_DEBUG_BACKJUMPS
  #define ML_BACKJUMP_CHECKPOINT(s, p) \
@@ -321,7 +284,8 @@
          fflush(stdout); \
          fprintf(stderr, ""backjumps (%s): "" \
              ""loc %p, prev %p, id %d, sp %p, fr %p\\n"", \
-            s, p, p->prev, p->id, p->saved_sp, p->saved_fr); \
+            s, p, p->MR_bjh_prev, p->MR_bjh_id, p->MR_bjh_saved_sp, \
+            p->MR_bjh_saved_fr); \
      } while (0)
  #else
  #define ML_BACKJUMP_CHECKPOINT(s, p)
@@ -355,43 +319,45 @@

  MR_define_entry(mercury__backjump__builtin_choice_id_1_0);
  {
-    MR_mkpragmaframe(""builtin_choice_id/1"", 0, ML_BackJumpHandler_struct,
+    MR_mkpragmaframe(""builtin_choice_id/1"", 0, MR_BackJumpHandler_Struct,
          MR_LABEL(mercury__backjump__builtin_choice_id_1_0_i1));

-    ML_BACKJUMP_STRUCT->prev = ML_GET_BACKJUMP_HANDLER();
-    ML_BACKJUMP_STRUCT->id = ML_GET_NEXT_CHOICE_ID();
-    ML_BACKJUMP_STRUCT->saved_sp = MR_sp;
-    ML_BACKJUMP_STRUCT->saved_fr = MR_curfr;
-    ML_SET_BACKJUMP_HANDLER(ML_BACKJUMP_STRUCT);
+    ML_BACKJUMP_STRUCT->MR_bjh_prev = MR_GET_BACKJUMP_HANDLER();
+    ML_BACKJUMP_STRUCT->MR_bjh_id = MR_GET_NEXT_CHOICE_ID();
+    ML_BACKJUMP_STRUCT->MR_bjh_saved_sp = MR_sp;
+    ML_BACKJUMP_STRUCT->MR_bjh_saved_fr = MR_curfr;
+    MR_SET_BACKJUMP_HANDLER(ML_BACKJUMP_STRUCT);

      ML_BACKJUMP_CHECKPOINT(""create"", ML_BACKJUMP_STRUCT);

-    MR_r1 = (MR_Word) ML_BACKJUMP_STRUCT->id;
+    MR_r1 = (MR_Word) ML_BACKJUMP_STRUCT->MR_bjh_id;
      MR_succeed();
  }
  MR_define_label(mercury__backjump__builtin_choice_id_1_0_i1);
  {
      /* Restore the previous handler. */
-    ML_SET_BACKJUMP_HANDLER(ML_BACKJUMP_STRUCT->prev);
+    MR_SET_BACKJUMP_HANDLER(ML_BACKJUMP_STRUCT->MR_bjh_prev);
      MR_fail();
  }

  MR_define_entry(mercury__backjump__builtin_backjump_1_0);
  {
-    ML_Choice_Id id = MR_r1;
-    ML_BackJumpHandler *backjump_handler = ML_GET_BACKJUMP_HANDLER();
+    MR_BackJumpChoiceId id = MR_r1;
+    MR_BackJumpHandler *backjump_handler;
+ 
+    backjump_handler = MR_GET_BACKJUMP_HANDLER();

      /*
      ** XXX see comments in the high-level implementation.
      */
      while (backjump_handler != NULL) {
-        if (backjump_handler->id == id) {
+        if (backjump_handler->MR_bjh_id == id) {
              break;
          }

          ML_BACKJUMP_CHECKPOINT(""scan"", backjump_handler);

-        backjump_handler = backjump_handler->prev;
+        backjump_handler = backjump_handler->MR_bjh_prev;
      }

      if (backjump_handler == NULL) {
@@ -406,9 +372,9 @@
          ** (possibly incorrect) backjump.
          */

-        ML_SET_BACKJUMP_HANDLER(backjump_handler->prev);
-        MR_sp_word = (MR_Word) backjump_handler->saved_sp;
-        MR_maxfr_word = (MR_Word) backjump_handler->saved_fr;
+        MR_SET_BACKJUMP_HANDLER(backjump_handler->MR_bjh_prev);
+        MR_sp_word = (MR_Word) backjump_handler->MR_bjh_saved_sp;
+        MR_maxfr_word = (MR_Word) backjump_handler->MR_bjh_saved_fr;
          MR_fail();
      }
  }
Index: mdbcomp/program_representation.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/program_representation.m,v
retrieving revision 1.29
diff -u -r1.29 program_representation.m
--- mdbcomp/program_representation.m	27 Feb 2008 07:23:56 -0000	1.29
+++ mdbcomp/program_representation.m	12 Mar 2008 04:48:16 -0000
@@ -1319,6 +1319,8 @@
  pred_is_external("builtin", "unify", 3).
  pred_is_external("builtin", "compare", 4).
  pred_is_external("builtin", "compare_representation", 4).
+pred_is_external("backjump", "builtin_choice_id", 1).
+pred_is_external("backjump", "builtin_backjump", 1).

  %-----------------------------------------------------------------------------%

Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.144
diff -u -r1.144 Mmakefile
--- runtime/Mmakefile	11 Oct 2007 11:45:21 -0000	1.144
+++ runtime/Mmakefile	12 Mar 2008 04:48:16 -0000
@@ -26,6 +26,7 @@
  			mercury_agc_debug.h	\
  			mercury_array_macros.h	\
  			mercury_atomic_ops.h	\
+			mercury_backjump.h	\
  			mercury_bootstrap.h	\
  			mercury_builtin_types.h	\
  			mercury_builtin_types_proc_layouts.h	\
@@ -150,6 +151,7 @@
  			mercury_accurate_gc.c	\
  			mercury_agc_debug.c	\
  			mercury_atomic_ops.c	\
+			mercury_backjump.c	\
  			mercury_bootstrap.c	\
  			mercury_builtin_types.c	\
  			mercury_bitmap.c	\
Index: runtime/mercury_backjump.c
===================================================================
RCS file: runtime/mercury_backjump.c
diff -N runtime/mercury_backjump.c
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_backjump.c	12 Mar 2008 04:48:16 -0000
@@ -0,0 +1,53 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2008 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.
+*/
+
+#include "mercury_backjump.h"
+#include "mercury_thread.h"
+
+#if defined(MR_THREAD_SAFE)
+    #include    <pthread.h>
+#endif
+
+/*
+** The low-level C counterparts to these globals are the `backjump_handler'
+** and `backjump_next_choice_id' fields of the MR_Context structure.
+** (See mercury_context.h for details.)
+*/
+
+#if defined(MR_HIGHLEVEL_CODE) 
+    #if defined(MR_THREAD_SAFE)
+ 
+        MercuryThreadKey    MR_backjump_handler_key;
+        MercuryThreadKey    MR_backjump_next_choice_id_key;
+
+    #else /* not MR_THREAD_SAFE */
+ 
+        MR_BackJumpHandler  *MR_backjump_handler;
+        MR_BackJumpChoiceId MR_backjump_next_choice_id = 0;
+
+    #endif /* not MR_THREAD_SAFE */
+#endif /* not MR_HIGHLEVEL_CODE */
+
+#if defined(MR_HIGHLEVEL_CODE) && defined(MR_THREAD_SAFE)
+
+MR_BackJumpChoiceId
+MR_get_tl_backjump_next_choice_id(void)
+{
+    MR_BackJumpChoiceId    new_choice_id;
+
+    /* NOTE: this only works because sizeof(MR_Integer) == sizeof(void *). */
+    new_choice_id = (MR_Integer) MR_GETSPECIFIC(MR_backjump_next_choice_id_key);
+    pthread_setspecific(MR_backjump_next_choice_id_key,
+        (void *)(new_choice_id + 1));
+    return new_choice_id;
+}
+
+#endif /* MR_HIGLEVEL_CODE && MR_THREAD_SAFE */
+
+/*---------------------------------------------------------------------------*/
Index: runtime/mercury_backjump.h
===================================================================
RCS file: runtime/mercury_backjump.h
diff -N runtime/mercury_backjump.h
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_backjump.h	12 Mar 2008 04:48:16 -0000
@@ -0,0 +1,109 @@
+/*
+** vim:ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2008 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** mercury_backjump.h - code for handling backjumping.
+*/
+
+#ifndef MERCURY_BACKJUMP_H
+#define MERCURY_BACKJUMP_H
+
+#include "mercury_conf.h"
+#include "mercury_thread.h"
+#include <setjmp.h>
+
+typedef MR_Integer	MR_BackJumpChoiceId;
+
+typedef struct MR_BackJumpHandler_Struct {
+    struct MR_BackJumpHandler_Struct    *MR_bjh_prev;
+    MR_BackJumpChoiceId MR_bjh_id;
+
+#ifdef MR_HIGHLEVEL_CODE
+
+    jmp_buf             MR_bjh_handler;
+
+#else /* !MR_HIGHLEVEL_CODE */
+
+    MR_Word             *MR_bjh_saved_sp;
+    MR_Word             *MR_bjh_saved_fr;
+
+#endif /* !MR_HIGHLEVEL_CODE */
+
+} MR_BackJumpHandler;
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** This section defines the global state required to support backjumping.
+** In low-level C grades this state is part of the MR_Context structure
+** (see mercury_context.h).  In non .par high-level C grades we store the
+** state in global variables and in .par high-level C grades we need to use
+** thread-local data.
+*/
+
+#if defined(MR_HIGHLEVEL_CODE)
+
+    #if defined(MR_THREAD_SAFE)
+
+        extern MR_BackJumpChoiceId
+        MR_get_tl_backjump_next_choice_id(void);
+
+        /*
+        ** MR_backjump_handler_key stores a key that can be used to get
+        ** the current backjump handler for the current thread.
+        ** MR_backjump_next_choice_id_key stores a key that can be used
+        ** to get the next available backjump choice id for the current thread.
+        ** NOTE: changes here may need to be reflected in the function
+        ** MR_init_thread_stuff() in mercury_context.c.
+        */
+        extern MercuryThreadKey MR_backjump_handler_key;
+        extern MercuryThreadKey MR_backjump_next_choice_id_key;
+
+        #define MR_GET_BACKJUMP_HANDLER()   \
+            MR_GETSPECIFIC(MR_backjump_handler_key)
+
+        #define MR_SET_BACKJUMP_HANDLER(val)   \
+            pthread_setspecific(MR_backjump_handler_key, (val))
+ 
+        #define MR_GET_NEXT_CHOICE_ID()     \
+            MR_get_tl_backjump_next_choice_id() 
+
+    #else /* not MR_THREAD_SAFE */
+ 
+        /*
+        ** MR_backjump_handler points to the current backjump handler.
+        */ 
+        extern MR_BackJumpHandler   *MR_backjump_handler;
+ 
+        /*
+        ** The value MR_backjump_next_choice_id is the next available 
+        ** backjump choice id.
+        */
+        extern MR_BackJumpChoiceId  MR_backjump_next_choice_id;
+
+        #define MR_GET_BACKJUMP_HANDLER()      MR_backjump_handler
+        #define MR_SET_BACKJUMP_HANDLER(val)   MR_backjump_handler = (val)
+        #define MR_GET_NEXT_CHOICE_ID()        (MR_backjump_next_choice_id++)
+
+    #endif /* not MR_THREAD_SAFE */
+
+#else /* not MR_HIGHLEVEL_CODE */
+
+    #define MR_GET_BACKJUMP_HANDLER() \
+        MR_ENGINE(MR_eng_this_context)->MR_ctxt_backjump_handler
+
+    #define MR_SET_BACKJUMP_HANDLER(val) \
+        MR_ENGINE(MR_eng_this_context)->MR_ctxt_backjump_handler = (val)
+
+    #define MR_GET_NEXT_CHOICE_ID() \
+        (MR_ENGINE(MR_eng_this_context)->MR_ctxt_backjump_next_choice_id++)
+
+#endif /* not MR_HIGHLEVEL_CODE */
+
+#endif /* not MERCURY_BACKJUMP_H */
Index: runtime/mercury_context.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_context.c,v
retrieving revision 1.59
diff -u -r1.59 mercury_context.c
--- runtime/mercury_context.c	30 Oct 2007 00:46:22 -0000	1.59
+++ runtime/mercury_context.c	12 Mar 2008 04:48:16 -0000
@@ -33,8 +33,9 @@
  #include "mercury_engine.h"             /* for `MR_memdebug' */
  #include "mercury_reg_workarounds.h"    /* for `MR_fd*' stuff */

-static  void            MR_init_context_maybe_generator(MR_Context *c,
-                            const char *id, MR_GeneratorPtr gen);
+static void
+MR_init_context_maybe_generator(MR_Context *c, const char *id,
+    MR_GeneratorPtr gen);

  /*---------------------------------------------------------------------------*/

@@ -104,6 +105,11 @@
    #endif
      MR_KEY_CREATE(&MR_exception_handler_key, NULL);

+  #ifdef MR_HIGHLEVEL_CODE
+    MR_KEY_CREATE(&MR_backjump_handler_key, NULL);
+    MR_KEY_CREATE(&MR_backjump_next_choice_id_key, (void *)0);
+  #endif 
+
      /* These are actually in mercury_thread.c. */
      pthread_mutex_init(&MR_thread_barrier_lock, MR_MUTEX_ATTR);
    #ifdef MR_HIGHLEVEL_CODE
@@ -278,6 +284,11 @@
      c->MR_ctxt_ticket_high_water = 1;
  #endif

+#ifndef MR_HIGHLEVEL_CODE
+    c->MR_ctxt_backjump_handler = NULL;
+    c->MR_ctxt_backjump_next_choice_id = 0;
+#endif
+
  #ifndef MR_CONSERVATIVE_GC
      if (gen != NULL) {
          MR_fatal_error("MR_init_context: generator and no conservative gc");
Index: runtime/mercury_context.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_context.h,v
retrieving revision 1.44
diff -u -r1.44 mercury_context.h
--- runtime/mercury_context.h	11 Oct 2007 11:45:21 -0000	1.44
+++ runtime/mercury_context.h	12 Mar 2008 04:48:16 -0000
@@ -58,6 +58,7 @@
  #include "mercury_thread.h"     /* for MercuryLock */
  #include "mercury_goto.h"       /* for MR_GOTO() */
  #include "mercury_conf.h"       /* for MR_CONSERVATIVE_GC */
+#include "mercury_backjump.h"   /* for MR_BackJumpHandler, etc */

  #ifdef  MR_THREAD_SAFE
    #define MR_IF_THREAD_SAFE(x)  x
@@ -181,6 +182,11 @@
  ** ticket_highwater The saved MR_ticket_high_water for this context.
  **                  (All accessed via abstract machine register.)
  **
+** backjump_handler         The backjump handler for this context.
+** backjump_next_choice_id  The next available backjump choice id counter
+**                          for this context.
+**                          (All accessed via MR_eng_context.)
+**
  ** hp               The saved hp for this context.
  **                  (Accessed via abstract machine register.)
  **
@@ -303,6 +309,11 @@
      MR_ChoicepointId    MR_ctxt_ticket_high_water;
  #endif

+#ifndef MR_HIGHLEVEL_CODE 
+    MR_BackJumpHandler  *MR_ctxt_backjump_handler;
+    MR_BackJumpChoiceId MR_ctxt_backjump_next_choice_id;
+#endif
+
  #ifndef MR_CONSERVATIVE_GC
      MR_Word             *MR_ctxt_hp;
      MR_Word             *MR_ctxt_min_hp_rec;
Index: runtime/mercury_thread.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_thread.h,v
retrieving revision 1.24
diff -u -r1.24 mercury_thread.h
--- runtime/mercury_thread.h	3 May 2007 04:34:56 -0000	1.24
+++ runtime/mercury_thread.h	12 Mar 2008 04:48:16 -0000
@@ -244,7 +244,8 @@
  /*
  ** Allocate an index into the thread-local mutable array for a mutable.
  */
-extern MR_Unsigned  MR_new_thread_local_mutable_index(void);
+extern MR_Unsigned
+MR_new_thread_local_mutable_index(void);

  /*
  ** Allocate a thread-local mutable array.
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.342
diff -u -r1.342 Mmakefile
--- tests/hard_coded/Mmakefile	9 Mar 2008 09:39:25 -0000	1.342
+++ tests/hard_coded/Mmakefile	12 Mar 2008 04:48:16 -0000
@@ -473,6 +473,8 @@
  # defined.
  #
  # backjump_test fails because deep profiler cannot yet handle backjumps.
+# tl_backjump_test fails because the deep profiler cannot yet handle
+# backjumps and threads.

  ifeq "$(findstring profdeep,$(GRADE))" ""
  	NON_PROFDEEP_PROGS = \
@@ -491,6 +493,7 @@
  		solver_default_eq_cmp \
  		test_array2d \
  		test_injection \
+		tl_backjump_test \
  		user_defined_equality \
  		version_array_test \
  		write_binary
@@ -670,7 +673,7 @@
  			< $@.tmp > $@; \
  		rm -f $@.tmp; \
  	fi
-
+
  # final_excp.out is expected to fail (it calls throw/1).
  #
  final_excp.out: final_excp
@@ -743,6 +746,20 @@
  		done \
  	) > runtime_opt.out 2>&1

+# The test checks the output from multiple threads and since that output
+# may be interleaved arbitrarily we need to filter it so that all the output
+# from each thread appears sequentially in a block.
+tl_backjump_test.out: tl_backjump_test
+	if ./tl_backjump_test > $@.tmp 2>&1; then \
+		grep "^(TID: #2" $@.tmp > $@; \
+		grep "^(TID: #3" $@.tmp >> $@; \
+		grep "^spawn"    $@.tmp >> $@; \
+		rm -f $@.tmp; \
+	else \
+		grep . $@.tmp; \
+		exit 1; \
+	fi 
+
  #-----------------------------------------------------------------------------#

  dir_test.out: prepare_for_dir_test
Index: tests/hard_coded/tl_backjump_test.exp
===================================================================
RCS file: tests/hard_coded/tl_backjump_test.exp
diff -N tests/hard_coded/tl_backjump_test.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/tl_backjump_test.exp	12 Mar 2008 04:48:16 -0000
@@ -0,0 +1,50 @@
+(TID: #2) label A = 1, (0)
+(TID: #2) label B = 1, (1)
+(TID: #2) label C = 1, (2)
+(TID: #2) label C = 2, (3)
+(TID: #2) backjump (3)
+(TID: #2) label C = 3, (4)
+(TID: #2) solution 1, 1, 3
+(TID: #2) label B = 2, (5)
+(TID: #2) label C = 1, (6)
+(TID: #2) backjump (0)
+(TID: #2) label A = 2, (7)
+(TID: #2) label B = 1, (8)
+(TID: #2) label C = 1, (9)
+(TID: #2) solution 2, 1, 1
+(TID: #2) label C = 2, (10)
+(TID: #2) backjump (8)
+(TID: #2) label B = 2, (11)
+(TID: #2) label C = 1, (12)
+(TID: #2) label C = 2, (13)
+(TID: #2) solution 2, 2, 2
+(TID: #2) label C = 3, (14)
+(TID: #2) Solutions:
+(TID: #2) {1, 1, 3},
+(TID: #2) {2, 1, 1},
+(TID: #2) {2, 2, 2}
+(TID: #3) label A = 1, (0)
+(TID: #3) label B = 1, (1)
+(TID: #3) label C = 1, (2)
+(TID: #3) label C = 2, (3)
+(TID: #3) backjump (3)
+(TID: #3) label C = 3, (4)
+(TID: #3) solution 1, 1, 3
+(TID: #3) label B = 2, (5)
+(TID: #3) label C = 1, (6)
+(TID: #3) backjump (0)
+(TID: #3) label A = 2, (7)
+(TID: #3) label B = 1, (8)
+(TID: #3) label C = 1, (9)
+(TID: #3) solution 2, 1, 1
+(TID: #3) label C = 2, (10)
+(TID: #3) backjump (8)
+(TID: #3) label B = 2, (11)
+(TID: #3) label C = 1, (12)
+(TID: #3) label C = 2, (13)
+(TID: #3) solution 2, 2, 2
+(TID: #3) label C = 3, (14)
+(TID: #3) Solutions:
+(TID: #3) {1, 1, 3},
+(TID: #3) {2, 1, 1},
+(TID: #3) {2, 2, 2}
Index: tests/hard_coded/tl_backjump_test.exp2
===================================================================
RCS file: tests/hard_coded/tl_backjump_test.exp2
diff -N tests/hard_coded/tl_backjump_test.exp2
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/tl_backjump_test.exp2	12 Mar 2008 04:48:16 -0000
@@ -0,0 +1 @@
+spawn/3 not supported in this grade
Index: tests/hard_coded/tl_backjump_test.m
===================================================================
RCS file: tests/hard_coded/tl_backjump_test.m
diff -N tests/hard_coded/tl_backjump_test.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/tl_backjump_test.m	12 Mar 2008 04:48:16 -0000
@@ -0,0 +1,108 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+%
+% Test for thread-local backjumping.
+%
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- module tl_backjump_test.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module backjump.
+:- import_module list.
+:- import_module solutions.
+:- import_module string.
+:- import_module thread.
+
+main(!IO) :-
+    ( can_spawn ->
+        thread.spawn(run_problem(2), !IO),
+        thread.spawn(run_problem(3), !IO)
+    ;
+        io.write_string("spawn/3 not supported in this grade", !IO)
+    ).
+ 
+:- type thread_id == int.
+
+:- pred run_problem(thread_id::in, io::di, io::uo) is cc_multi.
+
+run_problem(TId0, !IO) :-
+    cc_multi_equal(TId0, TId),  % Make sure we are cc_multi.
+    solutions(problem(TId), Sols),
+    (
+        Sols = [],
+        io.format("(TID: #%d) No solutions!\n",
+            [i(TId)], !IO)
+    ;
+        Sols = [_ | _],
+        io.format("(TID: #%d) Solutions:\n", [i(TId)], !IO),
+        WriteSoln = (pred(Sol::in, !.IO::di, !:IO::uo) is det :- 
+            io.format("(TID: #%d) ", [i(TId)], !IO),
+            io.write(Sol, !IO)
+        ),
+        io.write_list(Sols, ",\n", WriteSoln, !IO),
+        io.nl(!IO)
+    ).
+
+:- pred problem(thread_id::in, {int, int, int}::out) is nondet.
+
+problem(TId, {A, B, C}) :-
+    promise_pure (
+        impure label(TId, "A", [1, 2], A, PA),
+        impure label(TId, "B", [1, 2], B, PB),
+        impure label(TId, "C", [1, 2, 3], C, PC),
+        impure check(TId, A, B, C, PA, PB, PC)
+    ).
+
+:- impure pred label(thread_id::in, string::in, list(int)::in, int::out,
+    choice_id::out) is nondet.
+
+label(TId, Name, [N | _], N, P) :-
+    impure get_choice_id(P),
+    trace [io(!IO)] (
+        io.format("(TID: #%d) label %s = %d, (%d)\n",
+            [i(TId), s(Name), i(N), i(to_int(P))], !IO),
+        true
+    ).
+label(TId, Name, [_ | Ns], N, P) :-
+    impure label(TId, Name, Ns, N, P).
+
+:- impure pred check(thread_id::in, int::in, int::in, int::in, choice_id::in,
+    choice_id::in, choice_id::in) is semidet.
+
+check(TId, A, B, C, PA, PB, PC) :-
+    ( is_nogood(A, B, C, PA, PB, PC, P) ->
+        trace [io(!IO)] (
+            io.format("(TID: #%d) backjump (%d)\n", [i(TId), i(to_int(P))],
+                !IO)
+        ),
+        impure backjump(P)
+    ;
+        is_solution(A, B, C),
+        trace [io(!IO)] (
+            io.format("(TID: #%d) solution %d, %d, %d\n",
+                [i(TId), i(A), i(B), i(C)], !IO)
+        )
+    ).
+
+:- pred is_nogood(int::in, int::in, int::in, choice_id::in, choice_id::in,
+    choice_id::in, choice_id::out) is semidet.
+
+is_nogood(1, 1, 2, _, _, P, P).
+is_nogood(1, 2, 1, P, _, _, P).
+is_nogood(2, 1, 2, _, P, _, P).
+
+:- pred is_solution(int::in, int::in, int::in) is semidet.
+
+is_solution(1, 1, 3).
+is_solution(2, 1, 1).
+is_solution(2, 2, 2).
+

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list