[m-rev.] diff: initial stm nested transaction runtime support

[Julien Fischer]

This diff is a follow-up to a discussion Leon and I had this afternoon.

Estimated hours taken: 1
Branches: main

Begin extending the STM runtime to support nested transactions.

runtime/mercury_stm.h:
 	Add an extra field to the TransLog structure that contains a pointer
 	to that points to the transaction log of the enclosing transaction.

 	Add another argument to the MR_stm_create_log macro that allows
 	the value of the above pointer to be specified when a new log
 	is created.

library/stm_builtin.m:
 	Extend the rollback_exception/0 type so that we can distinguish
 	between rollbacks that occurred because a transaction was invalid
 	and rollbacks that occur because of a call to retry/1.  We need
 	to make this distinction for the `or_else' STM operation.

 	Rename two predicate so their name is more closely related to the
 	macros in the runtime that they call.

 	Add a new predicate that creates a transaction log for a nested
 	transaction.

 	Add the initial validity check to the implementation of retry/1.
 	(Upon reflection it's probably better to implement this bit in
 	Mercury rather than in C as we have been intending to do.)

library/exception.m:
 	Conform to the above change.

Julien.

Index: library/exception.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.132
diff -u -r1.132 exception.m
--- library/exception.m	13 Sep 2007 04:40:50 -0000	1.132
+++ library/exception.m	17 Sep 2007 05:44:10 -0000
@@ -715,7 +715,11 @@
          % If the exception is an STM rollback exception rethrow it since
          % the handler at the beginning of the atomic scope should deal with
          % it; otherwise let the user deal with it.
-        ( Exception = univ(stm_builtin.rollback_exception) ->
+        (
+            ( Exception = univ(stm_builtin.rollback_invalid_transaction)
+            ; Exception = univ(stm_builtin.rollback_retry)
+            )
+        ->
              rethrow(Result0)
          ;
              Result = Result0
Index: library/stm_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/stm_builtin.m,v
retrieving revision 1.10
diff -u -r1.10 stm_builtin.m
--- library/stm_builtin.m	15 Sep 2007 14:25:56 -0000	1.10
+++ library/stm_builtin.m	17 Sep 2007 05:44:10 -0000
@@ -108,15 +108,22 @@
      % being rolled back.
      %
  :- type rollback_exception
-    --->    rollback_exception.
+    --->    rollback_invalid_transaction
+    ;       rollback_retry.

      % Create a new transaction log.
      %
-:- impure pred stm_create_state(stm::uo) is det.
+:- impure pred stm_create_transaction_log(stm::uo) is det.

      % Discard a transaction log.
      %
-:- impure pred stm_drop_state(stm::di) is det.
+:- impure pred stm_discard_transaction_log(stm::di) is det.
+
+    % stm_create_nested_transaction_log(Parent, Child):
+    % `Child' is a new transaction log whose enclosing transaction's
+    % log is given by `Parent'.
+    %
+:- impure pred stm_create_nested_transaction_log(stm::ui, stm::uo) is det.

      % Lock the STM global mutex.
      %
@@ -228,14 +235,21 @@
  ").

  :- pragma foreign_proc("C",
-    stm_create_state(STM::uo),
+    stm_create_transaction_log(STM::uo),
      [will_not_call_mercury, thread_safe],
  "
-    MR_STM_create_log(STM);
+    MR_STM_create_log(STM, NULL);
  ").

  :- pragma foreign_proc("C",
-    stm_drop_state(STM::di),
+    stm_create_nested_transaction_log(Parent::ui, Child::uo),
+    [will_not_call_mercury, thread_safe],
+"
+    MR_STM_create_log(Child, Parent);
+").
+
+:- pragma foreign_proc("C",
+    stm_discard_transaction_log(STM::di),
      [will_not_call_mercury, thread_safe],
  "
      MR_STM_discard_log(STM);
@@ -310,8 +324,18 @@

  retry(STM) :-
      promise_pure (
-        impure retry_impl(STM),
-        throw(rollback_exception)
+        impure stm_lock,
+        impure stm_validate(STM, IsValid),
+        (
+            IsValid = stm_transaction_valid,
+            % NOTE: retry_impl is responsible for releasing the STM lock.
+            impure retry_impl(STM),
+            throw(rollback_retry)
+        ;
+            IsValid = stm_transaction_invalid,
+            impure stm_unlock,
+            throw(rollback_invalid_transaction)
+        )
      ).

  :- impure pred retry_impl(stm::di) is det.
@@ -341,7 +365,7 @@
      is det.

  atomic_transaction_impl(Goal, Result) :-
-    impure stm_create_state(STM0),
+    impure stm_create_transaction_log(STM0),
      promise_equivalent_solutions [Result0, STM] (
          unsafe_try_stm(call_atomic_goal(Goal), Result0, STM0, STM)
      ),
@@ -349,7 +373,11 @@
          Result0 = succeeded(Result)
      ;
          Result0 = exception(Excp),
-        ( Excp = univ(rollback_exception) ->
+        (
+            ( Excp = univ(rollback_invalid_transaction)
+            ; Excp = univ(rollback_retry)
+            )
+        ->
              impure atomic_transaction_impl(Goal, Result)
          ;
              impure stm_lock,
@@ -360,7 +388,7 @@
                  rethrow(Result0)
              ;
                  IsValid = stm_transaction_invalid,
-                impure stm_drop_state(STM),
+                impure stm_discard_transaction_log(STM),
                  impure atomic_transaction_impl(Goal, Result)
              )
          )
@@ -382,7 +410,7 @@
      ;
          IsValid = stm_transaction_invalid,
          impure stm_unlock,
-        throw(rollback_exception)
+        throw(rollback_invalid_transaction)
      ).

  %----------------------------------------------------------------------------%
Index: runtime/mercury_stm.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stm.h,v
retrieving revision 1.3
diff -u -r1.3 mercury_stm.h
--- runtime/mercury_stm.h	16 Sep 2007 13:09:43 -0000	1.3
+++ runtime/mercury_stm.h	17 Sep 2007 05:44:10 -0000
@@ -90,6 +90,7 @@
  struct MR_STM_TransLog_Struct {
      MR_STM_TransRecord  *MR_STM_tl_records;
      MR_ThreadId         MR_STM_tl_thread;
+    MR_STM_TransLog     *MR_STM_tl_parent;
  };

  /*
@@ -104,12 +105,15 @@

  /*
  ** Create a new transaction log.
+** If the log is for a nested transaction then the field `parent' points
+** to the log of the enclosing transaction.  It is NULL otherwise.
  */
-#define MR_STM_create_log(tlog)                                         \
+#define MR_STM_create_log(tlog, parent)                                 \
      do {                                                                \
          (tlog) = MR_GC_NEW(MR_STM_TransLog);                            \
          (tlog)->MR_STM_tl_records = NULL;                               \
          (tlog)->MR_STM_tl_thread = MR_THIS_THREAD_ID;                   \
+        (tlog)->MR_STM_tl_parent = (parent);                            \
      } while (0)

  /*

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