[m-rev.] for review: trail segments

Julien Fischer juliensf at csse.unimelb.edu.au
Thu Sep 4 08:14:14 AEST 2008


(I will post some benchmarks with G12's FD solver shortly -- benchmarking
the compiler will be unenlightening in this case since the additional
overhead is only incurred when entries are added to the trail, which the
compiler doesn't do.)

Estimated hours taken: 20
Branches: main

Add a mechanism for dynamically growing the trail by adding new segments to it
in a similar fashion to what we do for the stacks with stack segments.  The
mechanism is enabled by the trseg (trail segments) grade component.  Unlike
stack segments the trail segment mechanism also works with the high-level C
backend.

The mechanism works by adding a test to MR_trail_{value,function} that checks
if we are about to run out of a trail and allocates a new trail segment if
that test succeeds.

Extend mdb's trail_details command to print the current number of trail
segments in trseg grades.

Fix a bug where the MR_trail_ptr was not being reset correctly after
a trail reset.

runtime/mercury_grade.h:
 	Add the new grade component.

runtime/mercury_conf_param.h:
 	Document the new grade component, and the option used to debug
 	trail segments.

runtime/mercury_memory_zones.h:
 	Shift the definition MR_MemoryZones to this file in order break
 	a cyclic dependency between header files.

runtime/mercury_context.h:
 	Add a new field to the context structure to hold a list previous
 	trail segments.

 	Delete the definition of the type MR_MemoryZones from here.

runtime/mercury_trail.[ch]:
 	When adding a new trail entry in trseg grades first check whether we
 	need to extend the trail and do so if necessary.

 	Export the definitions of MR_TRAIL_{BASE,ZONE}.

 	Add a macro, MR_PREV_TRAIL_ZONES, for accessing the list of trail zones
 	in a grade independent manner.

 	Fix a typo in a comment.

 	Add functions for creating and destroying trail segments.

 	Handle trail segments in the code that handles untrailing and
 	resets.  This also fixes a bug with trail reset where MR_trail_ptr
 	was not being reset along with the rest of the trail state.

compiler/options.m:
compiler/handle_options.m:
compiler/compile_target_code.m:
scripts/canonical_grade.sh-subr:
scripts/init_grade_option.sh-subr:
scripts/mgnuc.in:
scripts/parse_grade_options.sh-subr:
 	Handle the new grade component.

trace/mercury_trace_cmd_developer.c:
 	Make the trail_details command print out the number of trail segments
 	in trseg grades.

tests/trailing/Mmakefile:
tests/trailing/tr_reset_bug.{m,exp}:
 	Regression test for the bug with trail resets.

Julien.

Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.129
diff -u -r1.129 compile_target_code.m
--- compiler/compile_target_code.m	21 Jul 2008 03:10:06 -0000	1.129
+++ compiler/compile_target_code.m	3 Sep 2008 22:04:00 -0000
@@ -669,11 +669,20 @@
          ;
              C_CompilerType = cc_unknown,
              C_FnAlignOpt = ""
+        ),
+        globals.io_lookup_bool_option(trail_segments, TrailSegments, !IO),
+        (
+            TrailSegments = yes,
+            TrailSegOpt = "-DMR_TRAIL_SEGMENTS "
+        ;
+            TrailSegments = no,
+            TrailSegOpt = ""
          )
      ;
          UseTrail = no,
          UseTrailOpt = "",
-        C_FnAlignOpt = ""
+        C_FnAlignOpt = "",
+        TrailSegOpt = ""
      ),
      globals.io_lookup_bool_option(use_minimal_model_stack_copy,
          MinimalModelStackCopy, !IO),
@@ -831,6 +840,7 @@
          SourceDebugOpt,
          ExecTraceOpt,
          UseTrailOpt, 
+        TrailSegOpt,
          MinimalModelOpt,
          SinglePrecFloatOpt,
          UseRegionsOpt,
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.322
diff -u -r1.322 handle_options.m
--- compiler/handle_options.m	29 Jul 2008 23:57:57 -0000	1.322
+++ compiler/handle_options.m	3 Sep 2008 22:04:00 -0000
@@ -771,6 +771,9 @@
              )
          ),

+        % Using trail segments implies the use of the trail.
+        option_implies(trail_segments, use_trail, bool(yes), !Globals),
+
          %
          % Set up options for position independent code.
          %
@@ -2696,7 +2699,10 @@
      record_term_sizes_as_cells - bool(yes)], no, yes).

      % Trailing components.
-grade_component_table("tr", comp_trail, [use_trail - bool(yes)], no, yes).
+grade_component_table("tr", comp_trail,
+    [use_trail - bool(yes), trail_segments - bool(no)], no, yes).
+grade_component_table("trseg", comp_trail,
+    [use_trail - bool(yes), trail_segments - bool(yes)], no, yes).

      % Minimal model tabling components.
      % NOTE: we do not include `.mm' and `.dmm' in grade strings
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.625
diff -u -r1.625 options.m
--- compiler/options.m	2 Sep 2008 09:44:08 -0000	1.625
+++ compiler/options.m	3 Sep 2008 22:04:02 -0000
@@ -323,6 +323,7 @@
      ;       gc
      ;       parallel
      ;       use_trail
+    ;       trail_segments
      ;       use_minimal_model_stack_copy
      ;       use_minimal_model_own_stacks
      ;       minimal_model_debug
@@ -1175,6 +1176,7 @@
      gc                                  -   string("boehm"),
      parallel                            -   bool(no),
      use_trail                           -   bool(no),
+    trail_segments                      -   bool(no),
      maybe_thread_safe_opt               -   string("no"),
      extend_stacks_when_needed           -   bool(no),
      stack_segments                      -   bool(no),
@@ -2016,6 +2018,7 @@
  long_option("garbage-collection",   gc).
  long_option("parallel",             parallel).
  long_option("use-trail",            use_trail).
+long_option("trail-segments",       trail_segments).
  long_option("type-layout",          type_layout).
  long_option("maybe-thread-safe",    maybe_thread_safe_opt).
  long_option("extend-stacks-when-needed",    extend_stacks_when_needed).
@@ -3992,6 +3995,10 @@
          "\tThis is necessary for interfacing with constraint solvers,",
          "\tor for backtrackable destructive update.",
          "\tThis option is not yet supported for the IL or Java back-ends.",
+        "--trail-segments\t\t\t(grade modifier: `.trseg')",
+        "\tAs above, but use a dynamically sized trail that is composed",
+        "\tof small segments.  This can help to avoid trail exhaustion",
+        "\tat the cost of increased execution time.",
          "--maybe-thread-safe {yes, no}",
          "\tSpecify how to treat the `maybe_thread_safe' foreign code",
          "\tattribute.  `yes' means that a foreign procedure with the",
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.106
diff -u -r1.106 mercury_conf_param.h
--- runtime/mercury_conf_param.h	11 Feb 2008 03:56:13 -0000	1.106
+++ runtime/mercury_conf_param.h	3 Sep 2008 22:04:02 -0000
@@ -58,6 +58,7 @@
  ** MR_USE_SINGLE_PREC_FLOAT
  ** MR_EXTEND_STACKS_WHEN_NEEDED
  ** MR_STACK_SEGMENTS
+** MR_TRAIL_SEGMENTS
  ** MR_INLINE_ALLOC
  ** MR_PIC_REG
  ** MR_HIGHTAGS
@@ -83,6 +84,7 @@
  **		--single-prec-float
  **		--extend-stacks-when-needed
  **		--stack-segments
+**		--trail-segments
  **		--inline-alloc
  **		--pic-reg
  **		--tags
@@ -307,6 +309,10 @@
  **	Enables low-level debugging messages when updating the list of
  **	stack segments.
  **
+** MR_DEBUG_TRAIL_SEGMENTS
+**	Enables low-level debugging messages when updating the list of
+**	trail segments.
+**
  ** MR_TRACE_CHECK_INTEGRITY
  **	Enables the -i and --integrity options on mdb's forward movement
  **	commands, which cause the debugger to check the integrity of the
Index: runtime/mercury_context.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_context.h,v
retrieving revision 1.45
diff -u -r1.45 mercury_context.h
--- runtime/mercury_context.h	19 Mar 2008 05:30:00 -0000	1.45
+++ runtime/mercury_context.h	3 Sep 2008 22:04:02 -0000
@@ -175,7 +175,8 @@
  **                  but also via MR_eng_this_context.)
  **
  ** trail_zone       The trail zone for this context.
-**                  (Accessed via MR_eng_context.)
+** prev_trail_zones A list of any previous trail zones for this context.
+**                  (Both accessed via MR_eng_context.)
  **
  ** trail_ptr        The saved MR_trail_ptr for this context.
  ** ticket_counter   The saved MR_ticket_counter for this context.
@@ -233,12 +234,6 @@
  };
  #endif

-typedef struct MR_MemoryZones_Struct    MR_MemoryZones;
-
-struct MR_MemoryZones_Struct {
-    MR_MemoryZone       *MR_zones_head;
-    MR_MemoryZones      *MR_zones_tail;
-};

  #ifdef MR_LL_PARALLEL_CONJ
  typedef struct MR_Spark_Struct          MR_Spark;
@@ -304,6 +299,9 @@

  #ifdef  MR_USE_TRAIL
      MR_MemoryZone       *MR_ctxt_trail_zone;
+  #ifdef MR_TRAIL_SEGMENTS
+    MR_MemoryZones      *MR_ctxt_prev_trail_zones;
+  #endif
      MR_TrailEntry       *MR_ctxt_trail_ptr;
      MR_ChoicepointId    MR_ctxt_ticket_counter;
      MR_ChoicepointId    MR_ctxt_ticket_high_water;
Index: runtime/mercury_grade.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_grade.h,v
retrieving revision 1.77
diff -u -r1.77 mercury_grade.h
--- runtime/mercury_grade.h	10 Jun 2008 04:26:30 -0000	1.77
+++ runtime/mercury_grade.h	3 Sep 2008 22:04:02 -0000
@@ -213,8 +213,13 @@
  #endif

  #ifdef MR_USE_TRAIL
-  #define MR_GRADE_PART_7       MR_PASTE2(MR_GRADE_PART_6, _tr)
-  #define MR_GRADE_OPT_PART_7   MR_GRADE_OPT_PART_6 ".tr"
+   #ifdef MR_TRAIL_SEGMENTS
+    #define MR_GRADE_PART_7     MR_PASTE2(MR_GRADE_PART_6, _trseg)
+    #define MR_GRADE_OPT_PART_7 MR_GRADE_OPT_PART_6 ".trseg"
+  #else 
+    #define MR_GRADE_PART_7     MR_PASTE2(MR_GRADE_PART_6, _tr)
+    #define MR_GRADE_OPT_PART_7 MR_GRADE_OPT_PART_6 ".tr"
+   #endif /* ! MR_TRAIL_SEGMENTS */
  #else
    #define MR_GRADE_PART_7       MR_GRADE_PART_6
    #define MR_GRADE_OPT_PART_7   MR_GRADE_OPT_PART_6
Index: runtime/mercury_memory_zones.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_memory_zones.h,v
retrieving revision 1.19
diff -u -r1.19 mercury_memory_zones.h
--- runtime/mercury_memory_zones.h	1 Dec 2006 04:53:42 -0000	1.19
+++ runtime/mercury_memory_zones.h	3 Sep 2008 22:04:02 -0000
@@ -127,6 +127,13 @@
  #endif
  };

+typedef struct MR_MemoryZones_Struct    MR_MemoryZones;
+
+struct MR_MemoryZones_Struct {
+    MR_MemoryZone       *MR_zones_head;
+    MR_MemoryZones      *MR_zones_tail;
+};
+
  	/*
  	** MR_zone_end specifies the end of the area accessible without
  	** a page fault. It is used by MR_clear_zone_for_GC().
Index: runtime/mercury_trail.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trail.c,v
retrieving revision 1.16
diff -u -r1.16 mercury_trail.c
--- runtime/mercury_trail.c	13 Jun 2008 07:27:56 -0000	1.16
+++ runtime/mercury_trail.c	3 Sep 2008 22:04:02 -0000
@@ -14,54 +14,45 @@
  */

  #include "mercury_imp.h"
-
  #include "mercury_trail.h"
-
  #include "mercury_memory.h"
+#include "mercury_memory_handlers.h"
  #include "mercury_misc.h"

  #ifdef MR_USE_TRAIL

-/*
-** The following macros are used to access (parts of) the trail zone in a
-** grade independent manner.
-** 
-** MR_TRAIL_ZONE expands to the address of the trail zone for the current
-** thread.
-**
-** MR_TRAIL_BASE expands to the address of the base of the trail for the
-** current thread, i.e. the initial value to which MR_trail_ptr_var is set.
-**
-*/
-#if defined(MR_THREAD_SAFE)
-
-    #define MR_TRAIL_ZONE (MR_CONTEXT(MR_ctxt_trail_zone))
-
-    #define MR_TRAIL_BASE \
-        ((MR_TrailEntry *) (MR_CONTEXT(MR_ctxt_trail_zone)->MR_zone_min))
-#else
-    #define MR_TRAIL_ZONE   MR_trail_zone
-    #define MR_TRAIL_BASE   ((MR_TrailEntry *) (MR_trail_zone->MR_zone_min))
-#endif
-
  #if !defined(MR_THREAD_SAFE)
  MR_MemoryZone   *MR_trail_zone;
  MR_TrailEntry   *MR_trail_ptr_var;
+
+    #if defined(MR_TRAIL_SEGMENTS)
+        MR_MemoryZones *MR_prev_trail_zones;
+    #endif
+
  MR_Unsigned     MR_ticket_counter_var = 1;
  MR_Unsigned     MR_ticket_high_water_var = 1;
  #endif

+#if defined(MR_TRAIL_SEGMENTS)
+static void
+MR_pop_trail_segment(void);
+#endif
+
+static void
+MR_reset_trail_zone(void);
+
  void
  MR_untrail_to(MR_TrailEntry *old_trail_ptr, MR_untrail_reason reason)
  {
      MR_TrailEntry *tr_ptr;
-    /* not needed, since MR_trail_ptr is never a real reg: */
+    /* Not needed, since MR_trail_ptr is never a real reg: */
      /* MR_restore_transient_registers(); */
      tr_ptr = MR_trail_ptr;

      switch (reason) {
      case MR_solve:
      case MR_commit:
+
          /* Just handle the function trail entries */
          while (tr_ptr != old_trail_ptr) {
              tr_ptr--;
@@ -69,6 +60,42 @@
                  (*MR_get_trail_entry_untrail_func(tr_ptr))(
                      MR_get_trail_entry_datum(tr_ptr), reason);
              }
+ 
+            /*
+            ** When we are using trail segments it is possible that
+            ** `old_trail_ptr' is not a location on the current trail segment.
+            ** We need to walk backwards through all the previous segments
+            ** (invoking function trail entires as we go) until we find it.
+            */ 
+            #if defined(MR_TRAIL_SEGMENTS)
+                if (tr_ptr == MR_TRAIL_BASE 
+                    && tr_ptr != old_trail_ptr)
+                {
+                    MR_MemoryZones  *prev_zones;
+                    MR_MemoryZone   *zone; 
+ 
+                    prev_zones = MR_PREV_TRAIL_ZONES;
+                    zone = prev_zones->MR_zones_head;
+                    tr_ptr = (MR_TrailEntry *) zone->MR_zone_end;
+
+                    while (tr_ptr != old_trail_ptr) {
+                        tr_ptr--;
+                        if (MR_get_trail_entry_kind(tr_ptr) == MR_func_entry) {
+                            (*MR_get_trail_entry_untrail_func(tr_ptr))(
+                                MR_get_trail_entry_datum(tr_ptr), reason);
+                        }
+ 
+                        if (tr_ptr == (MR_TrailEntry *) zone->MR_zone_min
+                            && tr_ptr != old_trail_ptr)
+                        {
+                            prev_zones = prev_zones->MR_zones_tail;
+                            zone = prev_zones->MR_zones_head;
+                            tr_ptr = (MR_TrailEntry *) zone->MR_zone_end; 
+                        }
+                    }
+                    break;
+                } 
+            #endif
          }
          /*
          ** NB. We do _not_ reset the trail pointer here. Doing so would be
@@ -91,6 +118,14 @@
                  *MR_get_trail_entry_address(tr_ptr) =
                      MR_get_trail_entry_value(tr_ptr);
              }
+            #if defined(MR_TRAIL_SEGMENTS)
+                if (tr_ptr == MR_TRAIL_BASE 
+                    && tr_ptr != old_trail_ptr)
+                {
+                    MR_pop_trail_segment();
+                    tr_ptr = MR_trail_ptr;
+                }
+            #endif
          }

          MR_trail_ptr = tr_ptr;
@@ -105,11 +140,27 @@

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

-
  MR_Unsigned
  MR_num_trail_entries(void)
  {
-    return MR_trail_ptr - MR_TRAIL_BASE;
+    MR_Unsigned     n_entries = 0;
+
+#if defined(MR_TRAIL_SEGMENTS)
+    MR_MemoryZones  *list;
+    MR_MemoryZone   *zone;
+
+    list = MR_PREV_TRAIL_ZONES;
+    while (list != NULL) {
+        zone = list->MR_zones_head;
+        n_entries += (MR_TrailEntry *) zone->MR_zone_end
+            - (MR_TrailEntry *) zone->MR_zone_min;
+        list = list->MR_zones_tail; 
+    }
+#endif /* MR_TRAIL_SEGMENTS */
+
+    n_entries += MR_trail_ptr - MR_TRAIL_BASE;
+
+    return n_entries;
  }

  /*---------------------------------------------------------------------------*/
@@ -117,7 +168,27 @@
  void
  MR_reset_trail(void)
  {
-    MR_TrailEntry *tr_ptr;
+    #if defined(MR_TRAIL_SEGMENTS)
+        while (MR_PREV_TRAIL_ZONES != NULL) {
+            MR_reset_trail_zone();
+            MR_pop_trail_segment();
+        }
+    #endif 
+ 
+    MR_reset_trail_zone();
+
+    #if defined(MR_CONSERVATIVE_GC)
+        MR_clear_zone_for_GC(MR_TRAIL_ZONE, MR_trail_ptr);
+    #endif
+
+    MR_ticket_counter = 1;
+    MR_ticket_high_water = 1;
+}
+
+static void
+MR_reset_trail_zone(void) {
+ 
+    MR_TrailEntry   *tr_ptr;

      tr_ptr = MR_trail_ptr;

@@ -128,14 +199,88 @@
                  MR_get_trail_entry_datum(tr_ptr), MR_gc);
          }
      }
+    MR_trail_ptr = MR_TRAIL_BASE;
+}

-    #if defined(MR_CONSERVATIVE_GC)
-        MR_clear_zone_for_GC(MR_TRAIL_ZONE, MR_trail_ptr);
-    #endif
+/*---------------------------------------------------------------------------*/

-    MR_ticket_counter = 1;
-    MR_ticket_high_water = 1;
+#if defined(MR_TRAIL_SEGMENTS)
+void
+MR_new_trail_segment(void)
+{
+
+    MR_MemoryZones  *list;
+    MR_MemoryZone   *new_zone;
+    MR_TrailEntry   *old_trail_ptr;
+
+    old_trail_ptr = MR_trail_ptr;
+ 
+    /*
+    ** We perform explicit overflow checks so redzones just waste space. 
+    */
+    new_zone = MR_create_zone("trail_segment", 0, MR_trail_size, 0,
+        0, MR_default_handler);
+ 
+    list = MR_GC_malloc_uncollectable(sizeof(MR_MemoryZones));
+
+#if defined(MR_DEBUG_TRAIL_SEGMENTS)
+    printf("create new trail segment: old zone: %p, old trail_ptr %p\n",
+        MR_TRAIL_ZONE, MR_trail_ptr);
+#endif
+
+    list->MR_zones_head = MR_TRAIL_ZONE;
+    list->MR_zones_tail = MR_PREV_TRAIL_ZONES;
+    MR_PREV_TRAIL_ZONES = list;
+    MR_TRAIL_ZONE = new_zone;
+    MR_trail_ptr = (MR_TrailEntry *) MR_TRAIL_ZONE->MR_zone_min; 
+
+#if defined(MR_DEBUG_TRAIL_SEGMENTS)
+    printf("create new trail segment: new zone: %p, new trail_ptr %p\n",
+        MR_TRAIL_ZONE, MR_trail_ptr);
+#endif
+}
+
+static void
+MR_pop_trail_segment(void)
+{
+
+    MR_MemoryZones  *list;
+
+#if defined(MR_DEBUG_TRAIL_SEGMENTS)
+    printf("restore old trail segment: old zone %p, old trail_ptr %p\n",
+        MR_TRAIL_ZONE, MR_trail_ptr);
+#endif
+
+    MR_unget_zone(MR_TRAIL_ZONE);
+
+    list = MR_PREV_TRAIL_ZONES;
+    MR_TRAIL_ZONE = list->MR_zones_head;
+    MR_PREV_TRAIL_ZONES = list->MR_zones_tail;
+    MR_trail_ptr = (MR_TrailEntry *) MR_TRAIL_ZONE->MR_zone_end;
+    MR_GC_free(list);
+
+#if defined(MR_DEBUG_TRAIL_SEGMENTS)
+    printf("restore old trail segment: new zone %p, new trail_ptr %p\n",
+        MR_TRAIL_ZONE, MR_trail_ptr);
+#endif
+}
+
+MR_Unsigned
+MR_num_trail_segments(void)
+{
+    MR_Unsigned     n_segments = 1;
+    MR_MemoryZones  *list;
+
+    list = MR_PREV_TRAIL_ZONES;
+    while (list != NULL) {
+        n_segments++;
+        list = list->MR_zones_tail;
+    }
+
+    return n_segments;
  }

+#endif /* MR_TRAIL_SEGMENTS */
+
  #endif /* MR_USE_TRAIL */
  /*---------------------------------------------------------------------------*/
Index: runtime/mercury_trail.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trail.h,v
retrieving revision 1.30
diff -u -r1.30 mercury_trail.h
--- runtime/mercury_trail.h	13 Jun 2008 07:27:56 -0000	1.30
+++ runtime/mercury_trail.h	3 Sep 2008 22:04:02 -0000
@@ -25,6 +25,7 @@
    #define MR_IF_USE_TRAIL(x)
  #endif

+
  /*---------------------------------------------------------------------------*/
  /*
  ** The following macros define how to store and retrieve a 'ticket' -
@@ -307,7 +308,7 @@
        } while (0)

    /*
-  ** void MR_store_function_trail_entry_kind(
+  ** void MR_store_function_trail_entry(
    **        MR_trail_entry *entry, MR_untrail_func *func, void *datum);
    */
    #define MR_store_function_trail_entry(entry, func, datum)                 \
@@ -316,7 +317,8 @@
          (entry)->MR_union.MR_func.MR_untrail_func = (func);                 \
          (entry)->MR_union.MR_func.MR_datum = (datum);                       \
        } while (0)
-#endif
+
+#endif /* ! MR_USE_TAGGED_TRAIL */

  /*
  ** MR_Word MR_get_trail_entry_value(const MR_trail_entry *);
@@ -355,6 +357,11 @@
      /* The Mercury trail */
      extern MR_MemoryZone *MR_trail_zone;

+    #if !defined(MR_TRAIL_SEGMENTS)
+        /* A list of any previous trail zones. */
+         extern MR_MemoryZones *MR_prev_trail_zones;
+    #endif
+
      /*
      ** A pointer to the current top of the Mercury trail.
      ** N.B. Use `MR_trail_ptr', defined in mercury_regs.h, 
@@ -387,6 +394,41 @@

  #endif /* !defined(MR_THREAD_SAFE) */

+/*
+** The following macros are used to access (parts of) the trail zone in a
+** grade independent manner.
+** 
+** MR_TRAIL_ZONE expands to the address of the trail zone for the current
+** thread.
+**
+** MR_PREV_TRAIL_ZONES expands to the address of the list of previous trail
+** zones for the current thread.  This is only defined in grades that support
+** trail segments.
+**
+** MR_TRAIL_BASE expands to the address of the base of the trail for the
+** current thread, i.e. the initial value to which MR_trail_ptr_var is set.
+**
+*/
+#if defined(MR_THREAD_SAFE)
+
+    #define MR_TRAIL_ZONE (MR_CONTEXT(MR_ctxt_trail_zone))
+ 
+    #if defined(MR_TRAIL_SEGMENTS)
+        #define MR_PREV_TRAIL_ZONES (MR_CONTEXT(MR_ctxt_prev_trail_zones))
+    #endif
+
+    #define MR_TRAIL_BASE \
+        ((MR_TrailEntry *) (MR_CONTEXT(MR_ctxt_trail_zone)->MR_zone_min))
+#else
+    #define MR_TRAIL_ZONE   MR_trail_zone
+ 
+    #if defined(MR_TRAIL_SEGMENTS)
+        #define MR_PREV_TRAIL_ZONES MR_prev_trail_zones
+    #endif
+
+    #define MR_TRAIL_BASE   ((MR_TrailEntry *) (MR_trail_zone->MR_zone_min))
+#endif
+
  /*---------------------------------------------------------------------------*/
  /*
  ** This is the interface that should be used by C code that wants to
@@ -397,6 +439,22 @@
  */
  /*---------------------------------------------------------------------------*/

+#if defined(MR_TRAIL_SEGMENTS)
+
+#define MR_trail_extend_and_check()                                         \
+    do {                                                                    \
+        if (MR_trail_ptr >= (MR_TrailEntry *) MR_TRAIL_ZONE->MR_zone_end) { \
+            MR_new_trail_segment();                                         \
+        }                                                                   \
+    } while (0)
+
+#else /* ! MR_TRAIL_SEGMENTS */
+
+    #define MR_trail_extend_and_check()
+
+#endif /* !MR_TRAIL_SEGMENTS */
+
+
  /*
  ** void  MR_trail_value(MR_Word *address, MR_Word value);
  **
@@ -406,6 +464,7 @@

  #define MR_trail_value(address, value)                                      \
      do {                                                                    \
+        MR_trail_extend_and_check();                                        \
          MR_store_value_trail_entry(MR_trail_ptr,                            \
              (address), (value));                                            \
          MR_trail_ptr++;                                                     \
@@ -435,6 +494,7 @@

  #define MR_trail_function(untrail_func, datum)                              \
      do {                                                                    \
+        MR_trail_extend_and_check();                                        \
          MR_store_function_trail_entry((MR_trail_ptr),                       \
              (untrail_func), (datum));                                       \
          MR_trail_ptr++;                                                     \
@@ -443,8 +503,8 @@
  /*
  ** Apply all the trail entries between MR_trail_ptr and old_trail_ptr.
  */
-
-void MR_untrail_to(MR_TrailEntry *old_trail_ptr, MR_untrail_reason reason);
+extern void
+MR_untrail_to(MR_TrailEntry *old_trail_ptr, MR_untrail_reason reason);

  /* Abstract type. */
  typedef MR_Unsigned MR_ChoicepointId;
@@ -511,4 +571,22 @@
  extern void
  MR_reset_trail(void);

+#if defined(MR_TRAIL_SEGMENTS)
+
+/*
+** Push the current trail segment onto the list of previous segments,
+** allocate a new segment and set MR_trail_ptr to point to beginning
+** of that segment.
+*/
+extern void
+MR_new_trail_segment(void);
+
+/*
+** Return the number of segments that make up the trail.
+*/
+extern MR_Unsigned
+MR_num_trail_segments(void);
+
+#endif /* MR_TRAIL_SEGMENTS */
+
  #endif /* not MERCURY_TRAIL_H */
Index: scripts/canonical_grade.sh-subr
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/canonical_grade.sh-subr,v
retrieving revision 1.21
diff -u -r1.21 canonical_grade.sh-subr
--- scripts/canonical_grade.sh-subr	24 Oct 2007 09:21:17 -0000	1.21
+++ scripts/canonical_grade.sh-subr	3 Sep 2008 22:04:02 -0000
@@ -118,9 +118,14 @@
  			;;
  esac

-case $use_trail in
-	true)		GRADE="$GRADE.tr" ;;
-	false)		;;
+case $use_trail,$trail_segments in
+	true,false)	GRADE="$GRADE.tr" ;;
+	true,true)	GRADE="$GRADE.trseg" ;;
+	false,false)	;;
+	*)		progname=`basename $0`
+			echo "$progname: error: invalid combination of trailing opitons." 1>&2
+			exit 1
+			;;
  esac

  case $use_minimal_model_stack_copy,$use_minimal_model_own_stacks,$minimal_model_debug in
Index: scripts/init_grade_options.sh-subr
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/init_grade_options.sh-subr,v
retrieving revision 1.32
diff -u -r1.32 init_grade_options.sh-subr
--- scripts/init_grade_options.sh-subr	24 Oct 2007 09:21:17 -0000	1.32
+++ scripts/init_grade_options.sh-subr	3 Sep 2008 22:04:02 -0000
@@ -39,6 +39,7 @@
  	--record-term-sizes-as-words
  	--record-term-sizes-as-cells
  	--use-trail
+	--use-trail-segments
  	--reserve-tag
  	--use-minimal-model-stack-copy
  	--use-minimal-model-own-stacks
@@ -79,6 +80,7 @@
  record_term_sizes_as_words=false
  record_term_sizes_as_cells=false
  use_trail=false
+trail_segments=false
  use_minimal_model_stack_copy=false
  use_minimal_model_own_stacks=false
  minimal_model_debug=false
Index: scripts/mgnuc.in
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/mgnuc.in,v
retrieving revision 1.124
diff -u -r1.124 mgnuc.in
--- scripts/mgnuc.in	23 Jan 2008 13:12:17 -0000	1.124
+++ scripts/mgnuc.in	3 Sep 2008 22:04:02 -0000
@@ -353,6 +353,9 @@
  case $use_trail in
      true)
          TRAIL_OPTS="-DMR_USE_TRAIL"
+        case $trail_segments in
+            true) TRAIL_OPTS="$TRAIL_OPTS -DMR_TRAIL_SEGMENTS" ;;
+        esac
          # See the comment in compile_c_file/7 in compiler/comipler_target_code.m
          # for an explanation of this.
          case $COMPILER in
@@ -363,6 +366,12 @@

      false)
          TRAIL_OPTS=""
+        case $trail_segments in
+            true)
+                    progname`basename $0`
+                    echo "$progname: cannot use trail segments without trailing"
+                    exit 1;;
+        esac
          FN_ALIGN_OPTS=""
      ;;
  esac
Index: scripts/parse_grade_options.sh-subr
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/parse_grade_options.sh-subr,v
retrieving revision 1.39
diff -u -r1.39 parse_grade_options.sh-subr
--- scripts/parse_grade_options.sh-subr	24 Oct 2007 09:21:18 -0000	1.39
+++ scripts/parse_grade_options.sh-subr	3 Sep 2008 22:04:02 -0000
@@ -150,6 +150,11 @@
      --no-use-trail)
          use_trail=false ;;

+    --trail-segments)
+        trail_segments=true ;;
+    --no-trail-segments)
+        trail_segments=false ;;
+
      --use-minimal-model-stack-copy)
          use_minimal_model_stack_copy=true ;;
      --no-use-minimal-model-stack-copy)
@@ -246,6 +251,7 @@
          record_term_sizes_as_words=false
          record_term_sizes_as_cells=false
          use_trail=false
+        trail_segments=false
          use_minimal_model_stack_copy=false
          use_minimal_model_own_stacks=false
          minimal_model_debug=false
@@ -451,8 +457,14 @@

                  tr)
                      use_trail=true
+                    trail_segments=false
                      ;;

+                trseg)
+                    use_trail=true
+                    trail_segments=true
+                    ;;
+
                  mm)
                      use_minimal_model_stack_copy=true
                      minimal_model_debug=false
Index: tests/trailing/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/trailing/Mmakefile,v
retrieving revision 1.5
diff -u -r1.5 Mmakefile
--- tests/trailing/Mmakefile	13 Jun 2008 07:27:56 -0000	1.5
+++ tests/trailing/Mmakefile	3 Sep 2008 22:04:02 -0000
@@ -11,6 +11,7 @@
  		func_trail_test		\
  		func_trail_test_2	\
  		test_trail_reset	\
+		tr_reset_bug		\
  		tu_test1		\
  		tu_test2
  endif
Index: tests/trailing/tr_reset_bug.exp
===================================================================
RCS file: tests/trailing/tr_reset_bug.exp
diff -N tests/trailing/tr_reset_bug.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/trailing/tr_reset_bug.exp	3 Sep 2008 22:04:02 -0000
@@ -0,0 +1 @@
+passed
Index: tests/trailing/tr_reset_bug.m
===================================================================
RCS file: tests/trailing/tr_reset_bug.m
diff -N tests/trailing/tr_reset_bug.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/trailing/tr_reset_bug.m	3 Sep 2008 22:04:02 -0000
@@ -0,0 +1,86 @@
+% vim: ft=mercury ts=4 et
+% MR_reset_trail() in rotd-2008-09-04 and before was not
+% resetting MR_trail_ptr;
+%
+:- module tr_reset_bug.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module bool.
+
+main(!IO) :-
+    save_trail_ptr(!IO),
+    ( add_trail_entries(10) ->
+        do_success_stuff(Result, !IO),
+        (
+            Result = yes,
+            io.write_string("passed\n", !IO)
+        ;
+            Result = no,
+            io.write_string("failed\n", !IO)
+        )
+    ;
+        true
+    ).
+
+:- pred save_trail_ptr(io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+    save_trail_ptr(_IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
+    pre = MR_trail_ptr;
+").
+
+:- pred add_trail_entries(int::in) is semidet.
+:- pragma foreign_proc("C",
+    add_trail_entries(N::in),
+    [will_not_call_mercury, promise_pure],
+"
+
+    MR_Integer i;
+ 
+    for (i = 0; i < N; i++) {
+        MR_trail_function(my_func, (void *) i)
+    }
+    SUCCESS_INDICATOR = MR_TRUE;
+").
+
+:- pragma foreign_decl("C", "
+
+extern MR_TrailEntry *pre;
+
+extern void
+my_func(void *data, MR_untrail_reason reason);
+
+").
+
+:- pragma foreign_code("C", "
+
+MR_TrailEntry *pre;
+
+void
+my_func(void *data, MR_untrail_reason reason)
+{
+}
+").
+
+:- pred do_success_stuff(bool::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+    do_success_stuff(Result::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure],
+"
+    MR_TrailEntry *post;
+ 
+    MR_reset_trail();
+    post = MR_trail_ptr;
+
+    Result = (post == pre) ? MR_YES : MR_NO;
+").
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
Index: trace/mercury_trace_cmd_developer.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_developer.c,v
retrieving revision 1.11
diff -u -r1.11 mercury_trace_cmd_developer.c
--- trace/mercury_trace_cmd_developer.c	13 Jun 2008 15:32:19 -0000	1.11
+++ trace/mercury_trace_cmd_developer.c	3 Sep 2008 22:04:02 -0000
@@ -1365,7 +1365,13 @@
          (unsigned long) MR_saved_ticket_high_water(saved_regs));
      fprintf(MR_mdb_out, "number of trail entries: %lu\n",
          (unsigned long) MR_num_trail_entries());
-#else
+
+    #if defined(MR_TRAIL_SEGMENTS)
+        fprintf(MR_mdb_out, "number of trail segments: %lu\n",
+            (unsigned long) MR_num_trail_segments());
+    #endif
+
+#else /* ! MR_USE_TRAIL */

      fprintf(MR_mdb_out, "mdb: the `trail_details' command is available "
          "only in trailing grades.\n");

--------------------------------------------------------------------------
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