[m-rev.] for review: new library module: stm_builtin
Leon Ilario MIKA
lmika at students.csse.unimelb.edu.au
Thu Aug 23 13:06:58 AEST 2007
Estimated hours taken: 18
Branches: main
Addition of the software transactional memory library module (stm_builtin.m)
which currently contains the private and public predicates relevant to
Software Transactional Memory.
doc/Mmakefile.m:
Added "library/stm_builtin.m" module to the list of modules excluded
from documentation.
library/exception.m:
Added predicate "try_stm" which performs a similar operation to
"try_io" in that it ensures that ui and do variables maintain their
uniqueness / deadness.
library/library.m:
Added "librar/stm_builtin.m" module to the list of standard library
modules.
library/stm_builtin.m:
New software transactional memory library module.
Nominated Reviewers: Julien Fischer, Zoltan Somogyi
Index: doc/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/Mmakefile,v
retrieving revision 1.49
diff -u -r1.49 Mmakefile
--- doc/Mmakefile 3 Aug 2007 06:36:58 -0000 1.49
+++ doc/Mmakefile 22 Aug 2007 06:35:43 -0000
@@ -263,6 +263,8 @@
;; \
$(LIBRARY_DIR)/robdd.m) \
;; \
+ $(LIBRARY_DIR)/stm_builtin.m) \
+ ;; \
$(LIBRARY_DIR)/term_size_prof_builtin.m) \
;; \
$(LIBRARY_DIR)/mutvar.m) \
@@ -297,6 +299,8 @@
;; \
$(LIBRARY_DIR)/robdd.m) \
;; \
+ $(LIBRARY_DIR)/stm_builtin.m) \
+ ;; \
$(LIBRARY_DIR)/term_size_prof_builtin.m) \
;; \
$(LIBRARY_DIR)/mutvar.m) \
Index: library/exception.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.129
diff -u -r1.129 exception.m
--- library/exception.m 17 Jul 2007 05:36:07 -0000 1.129
+++ library/exception.m 2 Aug 2007 06:51:51 -0000
@@ -211,6 +211,23 @@
:- implementation.
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+:- import_module stm_builtin.
+
+
+:- pred try_stm(pred(A, stm, stm), exception_result(A), stm, stm).
+:- mode try_stm(in(pred(out, di, uo) is det),
+ out(cannot_fail), di, uo) is cc_multi.
+:- mode try_stm(in(pred(out, di, uo) is cc_multi),
+ out(cannot_fail), di, uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
:- import_module solutions.
:- import_module string.
:- import_module unit.
@@ -672,6 +689,64 @@
%-----------------------------------------------------------------------------%
+:- pragma promise_equivalent_clauses(try_stm/4).
+
+try_stm(TransactionGoal::in(pred(out, di, uo) is det),
+ Result::out(cannot_fail), STM0::di, STM::uo) :-
+ get_determinism_2(TransactionGoal, Detism),
+ try_stm_det(Detism, TransactionGoal, Result, STM0, STM).
+
+try_stm(TransactionGoal::in(pred(out, di, uo) is cc_multi),
+ Result::out(cannot_fail), STM0::di, STM::uo) :-
+ get_determinism_2(TransactionGoal, Detism),
+ try_stm_cc_multi(Detism, TransactionGoal, Result, STM0, STM).
+
+
+:- pred try_stm_det(exp_determinism, pred(T, stm, stm),
+ exception_result(T), stm, stm).
+:- mode try_stm_det(in(bound(exp_detism_det)),
+ pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi.
+
+try_stm_det(exp_detism_det, TransactionGoal, Result, !STM) :-
+ Goal = (pred({R, S}::out) is det :-
+ unsafe_promise_unique(!.STM, S0),
+ TransactionGoal(R, S0, S)
+ ),
+ try_det(exp_detism_det, Goal, Result0),
+ handle_stm_result(Result0, Result, !STM).
+
+
+:- pred try_stm_cc_multi(exp_determinism, pred(T, stm, stm),
+ exception_result(T), stm, stm).
+:- mode try_stm_cc_multi(in(bound(exp_detism_cc_multi)),
+ pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi.
+
+try_stm_cc_multi(exp_detism_cc_multi, TransactionGoal, Result, !STM) :-
+ Goal = (pred({R, S}::out) is cc_multi :-
+ unsafe_promise_unique(!.STM, S0),
+ TransactionGoal(R, S0, S)
+ ),
+ try_det(exp_detism_cc_multi, Goal, Result0),
+ handle_stm_result(Result0, Result, !STM).
+
+
+:- pred handle_stm_result(exception_result({T, stm})::in(cannot_fail),
+ exception_result(T)::out(cannot_fail), stm::in, stm::uo) is det.
+
+handle_stm_result(Result0, Result, !STM) :-
+ (
+ Result0 = succeeded({Res, NewSTM}),
+ Result = succeeded(Res),
+ unsafe_promise_unique(NewSTM, !:STM)
+ ;
+ Result0 = exception(E0),
+ copy(E0, E),
+ Result = exception(E),
+ unsafe_promise_unique(!STM)
+ ).
+
+%-----------------------------------------------------------------------------%
+
:- pred throw_impl(univ::in) is erroneous.
:- type handler(T) == pred(univ, T).
Index: library/library.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.110
diff -u -r1.110 library.m
--- library/library.m 12 Jun 2007 06:53:58 -0000 1.110
+++ library/library.m 2 Aug 2007 05:12:09 -0000
@@ -152,6 +152,7 @@
:- import_module profiling_builtin.
:- import_module region_builtin.
:- import_module rtti_implementation.
+:- import_module stm_builtin.
:- import_module table_builtin.
:- import_module term_size_prof_builtin.
@@ -266,6 +267,7 @@
mercury_std_library_module("sparse_bitset").
mercury_std_library_module("stack").
mercury_std_library_module("std_util").
+mercury_std_library_module("stm_builtin").
mercury_std_library_module("store").
mercury_std_library_module("stream").
mercury_std_library_module("stream.string_writer").
Index: library/stm_builtin.m
===================================================================
RCS file: library/stm_builtin.m
diff -N library/stm_builtin.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ library/stm_builtin.m 16 Aug 2007 05:45:53 -0000
@@ -0,0 +1,436 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
+% Copyright (C) 1994-2007 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.
+%---------------------------------------------------------------------------%
+%
+% File: stm_builtin.m.
+% Main author: lm.
+% Stability: low.
+%
+% This file is automatically imported into every module.
+% It contains the builtin datatypes and runtime support for
+% the Software Memory Transactional system.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module stm_builtin.
+:- interface.
+
+:- import_module bool.
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+ % The Software Transactional Memory state. This is created for each
+ % transaction when execution reaches a new atomic goal.
+ %
+:- type stm.
+
+ % A Transaction Variable of type T. This is available to all Memory
+ % Transactions. XXX Name, should be transaction_var?
+ %
+:- type tvar(T).
+
+%----------------------------------------------------------------------------%
+
+ % Defines a new transaction variable. The type and initial value of
+ % the transaction variable is determined by the first argument to
+ % this predicate.
+ %
+:- pred new_tvar(T::in, tvar(T)::out, io::di, io::uo) is det.
+
+ % Adds a STM log entry indicating a write to a transaction variable.
+ %
+:- pred write_tvar(tvar(T)::in, T::in, stm::di, stm::uo) is det.
+
+ % Adds a STM log entry indicating a read from a transaction variable.
+ %
+:- pred read_tvar(tvar(T)::in, T::out, stm::di, stm::uo) is det.
+
+% % Blocks the execution of a transaction.
+% %
+%:- pred atomic(stm::di) is failure.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+ % Type that is thrown when a rollback is required. Currently, the
+ % exception handling routines are being used to handle the unravelling
+ % of stack frames. An exception of this type indicates that the
+ % current transaction is invalid and needs to be discarded (and retried).
+ %
+:- type rollback_exception
+ ---> rollback_exception.
+
+ % Creates a new stm state which will contain a transaction log
+ % along with other information that is deemed important for
+ % STM transactions.
+ %
+:- impure pred stm_create_state(stm::uo) is det.
+
+ % Drops an stm state (simply used to assist the GC).
+ %
+:- impure pred stm_drop_state(stm::di) is det.
+
+ % Locks the stm global mutex.
+ %
+:- impure pred stm_lock is det.
+
+ % Unlocks the stm global mutex.
+ %
+:- impure pred stm_unlock is det.
+
+%----------------------------------------------------------------------------%
+% NOTE: The following predicates may only be called by a thread if it
+% has aquired the global stm lock.
+%----------------------------------------------------------------------------%
+
+ % Determines whether or not a transaction is consistent with other
+ % concurrently running transaction.
+ %
+:- impure pred stm_validate(stm::ui, bool::out) is det.
+
+ % Commits the changes made to a log to memory.
+ %
+:- impure pred stm_commit(stm::ui) is det.
+
+ % Debugging predicates. XXX Only temp.
+ %
+:- pred very_unsafe_write_tvar(tvar(T)::in, T::in, stm::di, stm::uo) is det.
+:- pred stm_debug_sleep(int::in, stm::di, stm::uo) is det.
+:- pred stm_debug_sleep_IO(int::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module exception.
+
+
+:- pragma foreign_decl("C", "
+/*
+#if defined(MR_HIGHLEVEL_CODE)
+ typedef pthread_t ML_ThreadId;
+#else
+ typedef MR_Context *ML_ThreadId;
+#endif
+*/
+
+typedef struct ML_Stm_Wait_List_Struct {
+ /* Pointer lists */
+ struct ML_Stm_Wait_List_Struct *next;
+} ML_Stm_Wait_List;
+
+typedef struct {
+ MR_Word tvar_val;
+ ML_Stm_Wait_List *wait_list;
+} ML_Stm_TVar;
+
+typedef struct ML_Stm_TLog_Entry_Struct {
+ ML_Stm_TVar *tvar; /* Transaction variable in question */
+ MR_Word old_value; /* Old value of the transaction variable */
+ MR_Word new_value; /* New value of the transaction variable */
+ struct ML_Stm_TLog_Entry_Struct *next; /* Next log entry */
+} ML_Stm_TLog_Entry;
+
+typedef struct {
+ ML_Stm_TLog_Entry *entrylist; /* Log of transaction */
+} ML_Stm_TLog;
+
+
+/* ------------------------------------------------------------------------- */
+
+
+extern void
+ML_stm_add_new_log_entry(ML_Stm_TLog *slog, ML_Stm_TVar *tvar,
+ MR_Word old_value, MR_Word new_value);
+
+/* ------------------------------------------------------------------------- */
+
+#define ML_TRACE_STM(s) \
+ do {printf(\"STM: %s\\n\", (s)); fflush(stdout);} while (0)
+").
+
+ % Local C functions.
+ %
+:- pragma foreign_code("C", "
+/*
+** Adds a new log entry into a transaction log.
+*/
+
+void
+ML_stm_add_new_log_entry(ML_Stm_TLog *slog, ML_Stm_TVar *tvar,
+ MR_Word old_value, MR_Word new_value) {
+ ML_Stm_TLog_Entry *new_entry;
+
+ new_entry = MR_GC_NEW(ML_Stm_TLog_Entry);
+
+ new_entry->tvar = tvar;
+ new_entry->old_value = old_value;
+ new_entry->new_value = new_value;
+
+ new_entry->next = slog->entrylist;
+ slog->entrylist = new_entry;
+}
+").
+
+%----------------------------------------------------------------------------%
+
+:- pragma foreign_type("C", tvar(T), "ML_Stm_TVar *",
+ [stable, can_pass_as_mercury_type]).
+
+:- pragma foreign_type("C", stm, "ML_Stm_TLog *", [can_pass_as_mercury_type]).
+
+%----------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C",
+"
+ #ifdef MR_THREAD_SAFE
+ extern MercuryLock ML_STM_global_lock;
+ #endif
+").
+
+:- pragma foreign_code("C",
+"
+ #ifdef MR_THREAD_SAFE
+ MercuryLock ML_STM_global_lock;
+ #endif
+").
+
+:- initialise ml_initialise_stm/0.
+
+:- impure pred ml_initialise_stm is det.
+:- pragma foreign_proc("C", ml_initialise_stm, [will_not_call_mercury],
+"
+ #ifdef MR_THREAD_SAFE
+ pthread_mutex_init(&ML_STM_global_lock, MR_MUTEX_ATTR);
+ #endif
+").
+
+%----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ new_tvar(T::in, TVar::out, IO0::di, IO::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ TVar = MR_GC_NEW(ML_Stm_TVar);
+ TVar->tvar_val = T;
+ TVar->wait_list = NULL;
+ IO = IO0;
+").
+
+:- pragma foreign_proc("C",
+ write_tvar(TVar::in, Value::in, STM0::di, STM::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ ML_Stm_TLog_Entry *current_entry;
+ MR_bool found_entry = MR_FALSE;
+
+ /* Looks for entry for TVar and UPDATES it */
+ for (current_entry = STM0->entrylist; current_entry != NULL;
+ current_entry = current_entry->next) {
+ if (current_entry->tvar == TVar) {
+ /* Found write entry for tvar. */
+ found_entry = MR_TRUE;
+ current_entry->new_value = Value;
+ break;
+ }
+ }
+
+ /* Adds an entry if no record of the TVar is present */
+ if (found_entry == MR_FALSE) {
+ ML_stm_add_new_log_entry(STM0, TVar, TVar->tvar_val, Value);
+ }
+
+ STM = STM0;
+").
+
+:- pragma foreign_proc("C",
+ read_tvar(TVar::in, Value::out, STM0::di, STM::uo),
+ [promise_pure, will_not_call_mercury, thread_safe],
+"
+ ML_Stm_TLog_Entry *current_entry;
+ MR_bool found_entry = MR_FALSE;
+
+ /* Looks for entry for TVar and READS it */
+ for (current_entry = STM0->entrylist; current_entry != NULL;
+ current_entry = current_entry->next) {
+ if (current_entry->tvar == TVar) {
+ /* Found write entry for tvar. */
+ found_entry = MR_TRUE;
+ Value = current_entry->new_value;
+ break;
+ }
+ }
+
+ /* Add a default entry to indicate a read has been found */
+ if (found_entry == MR_FALSE)
+ {
+ ML_stm_add_new_log_entry(STM0, TVar, TVar->tvar_val, TVar->tvar_val);
+ Value = TVar->tvar_val;
+ }
+
+ STM = STM0;
+").
+
+:- pragma foreign_proc("C", stm_create_state(STM::uo),
+ [will_not_call_mercury, thread_safe],
+"
+ ML_TRACE_STM(""Allocating new STM Log --- New Ver"");
+
+ STM = MR_GC_NEW(ML_Stm_TLog);
+ STM->entrylist = NULL;
+").
+
+:- pragma foreign_proc("C", stm_drop_state(X::di),
+ [will_not_call_mercury, thread_safe],
+"
+ ML_TRACE_STM(""Dropping STM Log"");
+ X = NULL;
+").
+
+:- pragma foreign_proc("C", stm_lock,
+ [will_not_call_mercury, thread_safe],
+"
+ ML_TRACE_STM(""Locking STM Global Lock"");
+ #ifdef MR_THREAD_SAFE
+ MR_LOCK(&ML_STM_global_lock, \"stm_lock/0\");
+ #endif
+").
+
+:- pragma foreign_proc("C", stm_unlock,
+ [will_not_call_mercury, thread_safe],
+"
+ ML_TRACE_STM(""Unlocking STM Global Lock"");
+ #ifdef MR_THREAD_SAFE
+ MR_UNLOCK(&ML_STM_global_lock, \"stm_unlock/0\");
+ #endif
+").
+
+:- pragma foreign_proc("C",
+ stm_validate(STM::ui, Res::out),
+ [will_not_call_mercury, thread_safe],
+"
+ ML_Stm_TLog_Entry *current_entry;
+ ML_TRACE_STM(""Validating STM log"");
+
+ Res = MR_YES;
+
+ for (current_entry = STM->entrylist; current_entry != NULL;
+ current_entry = current_entry->next) {
+ if (current_entry->tvar->tvar_val != current_entry->old_value) {
+ ML_TRACE_STM(""STM LOG INVALID!"");
+
+ Res = MR_NO;
+ break;
+ }
+ }
+
+").
+
+:- pragma foreign_proc("C",
+ stm_commit(STM::ui),
+ [will_not_call_mercury, thread_safe],
+"
+ ML_Stm_TLog_Entry *current_entry;
+ ML_TRACE_STM(""Committing STM log"");
+
+ for (current_entry = STM->entrylist; current_entry != NULL;
+ current_entry = current_entry->next) {
+ current_entry->tvar->tvar_val = current_entry->new_value;
+ }
+").
+
+:- pragma foreign_proc("C",
+ very_unsafe_write_tvar(TVar::in, Val::in, STM0::di, STM::uo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ ML_TRACE_STM(""WARNING: very_unsafe_write_tvar predicate called"");
+
+ TVar->tvar_val = Val;
+ STM = STM0;
+").
+
+%:- pred stm_debug_sleep(int::in, stm::di, stm::uo) is det.
+:- pragma foreign_proc("C",
+ stm_debug_sleep(Amt::in, STM0::di, STM::uo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ ML_TRACE_STM(""Putting thread to sleep"");
+ sleep(Amt);
+
+ STM = STM0;
+").
+
+%:- pred stm_debug_sleep_IO(int::in, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+ stm_debug_sleep_IO(Amt::in, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ ML_TRACE_STM(""Putting thread to sleep"");
+ sleep(Amt);
+ IO = IO0;
+").
+%----------------------------------------------------------------------------%
+
+/* To Implement:
+**
+** retry(STM) :-
+** stm_lock,
+** stm_validate(STM, Valid),
+** (
+** Valid = yes,
+** stm_wait(STM), % Add wait variables to TVars
+** stm_unlock,
+** block_and_wait(STM)
+** ;
+** Valid = no,
+** stm_unlock,
+** throw(RollbackException)
+** ).
+**
+** :- pred block_and_wait(stm::di) is failure.
+**
+** block_and_wait(STM) :-
+** block_thread(STM), ***
+** stm_lock,
+** stm_validate(STM, Valid),
+** (
+** Valid = yes,
+** stm_unlock,
+** block_and_wait,
+** ;
+** Valid = no,
+** stm_unwait(STM), % Remove wait variables from TVar
+** stm_unlock
+** throw(RollbackException)
+** ).
+**
+** Need to implement:
+**
+** :- impure pred stm_wait(stm::ui) is det.
+** % Adds the current thread to the wait list of all TVars in the
+** % STM log so far.
+**
+** :- impure pred stm_unwait(stm::ui) is det.
+** % Removes the current thread from the wait list of all TVars.
+**
+** :- impure pred block_thread(stm::ui) is det.
+** % Blocks the current thread until another transaction is committed.
+** % XXX: What to do when there is only one thread?
+*/
+
+%----------------------------------------------------------------------------%
+:- end_module stm_builtin.
+%----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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