[m-rev.] for post-commit review: stm runtime support changes
Julien Fischer
juliensf at csse.unimelb.edu.au
Thu Sep 13 04:03:52 AEST 2007
For post-commit review by Leon.
The following is still pending some bootchecks but I will commit
it as soon as they are finished. It shouldn't affect anyone other
than Leon, who will need to update the source-to-source transformation
he has been working on in a couple of spots.
XXX the documentation in some of the new files in the runtime is a
bit patchy; I will fix that in a separate change.
Estimated hours taken: 12
Branches: main
Shift most of the STM runtime into the Mercury runtime.
Rename a lot of the types and functions used by the STM runtime.
Various other fixes and improvements to the STM runtime.
library/exception.m:
Add a new version of try_stm/4 that is intended for use within
atomic blocks by user code. This version filters out and rethrows
rollback exceptions.
Rename the existing try_stm/4 to unsafe_try_stm/4.
library/stm_builtin.m:
Move all the STM runtime support from this module into the
Mercury runtime. The foreign_procs in this module now just
forward their work to the appropriate function or macro there.
Rename most of the types and functions associated with STM
so that they better conform to our coding standards.
Add a unit dummy type for use with atomic blocks that have no
outputs, for example atomically swapping the values of two
transaction variables. This is needed because the call to
unsafe_try_stm introduced by the source-to-source transformation
still has to return a value if it succeeds.
runtime/mercury_stm.h:
runtime/mercury_stm.c:
New files containing the runtime support for STM that was in
library/stm_builtin.m
Define thread identity for the low-level C grades. In such
grades it just the context address.
Add a macro that returns the identity of the (Mercury) thread that
is currently executing. (The implementation of wait queues will
need this information.)
runtime/mercury_context.c:
At program startup initialise the STM lock.
runtime/mercury_conf_param.h:
Document the macro MR_STM_DEBUG which will be used to
enable low-level debugging of the STM runtime.
runtime/Mmakefile:
Add the new files.
Julien.
Index: library/exception.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.131
diff -u -r1.131 exception.m
--- library/exception.m 12 Sep 2007 06:21:13 -0000 1.131
+++ library/exception.m 12 Sep 2007 17:52:31 -0000
@@ -217,11 +217,27 @@
:- import_module stm_builtin.
-
+ % XXX Once STM is stable this predicate should be moved into the
+ % documented interface of this module.
+ %
:- pred try_stm(pred(A, stm, stm), exception_result(A), stm, stm).
-:- mode try_stm(in(pred(out, di, uo) is det),
+:- 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.
+
+ % This is the version is called by code introduced by the source-to-source
+ % transformation for atomic scopes. This predicate should not be called
+ % by user code.
+ %
+ % It is unsafe in the sense that it does not guarantee that rollback
+ % exceptions are always rethrown.
+ %
+:- pred unsafe_try_stm(pred(A, stm, stm),
+ exception_result(A), stm, stm).
+:- mode unsafe_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),
+:- mode unsafe_try_stm(in(pred(out, di, uo) is cc_multi),
out(cannot_fail), di, uo) is cc_multi.
%-----------------------------------------------------------------------------%
@@ -689,19 +705,35 @@
%-----------------------------------------------------------------------------%
-:- pragma promise_equivalent_clauses(try_stm/4).
+try_stm(Goal, Result, !STM) :-
+ unsafe_try_stm(Goal, Result0, !STM),
+ (
+ Result0 = succeeded(_),
+ Result = Result0
+ ;
+ Result0 = exception(Exception),
+ % 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) ->
+ rethrow(Result0)
+ ;
+ Result = Result0
+ )
+ ).
+
+:- pragma promise_equivalent_clauses(unsafe_try_stm/4).
-try_stm(TransactionGoal::in(pred(out, di, uo) is det),
+unsafe_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),
+unsafe_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)),
@@ -715,7 +747,6 @@
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)),
@@ -729,7 +760,6 @@
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.
Index: library/stm_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/stm_builtin.m,v
retrieving revision 1.8
diff -u -r1.8 stm_builtin.m
--- library/stm_builtin.m 4 Sep 2007 05:03:30 -0000 1.8
+++ library/stm_builtin.m 12 Sep 2007 17:52:31 -0000
@@ -104,7 +104,10 @@
% Values of this type are returned by stm_validate/2 and indicate
% whether a given transaction log is valid.
+ % NOTE: The definition of this type must be kept consistent with the
+ % constants defined in runtime/mercury_stm.h.
%
+ %
:- type stm_validation_result
---> stm_transaction_valid
; stm_transaction_invalid.
@@ -141,6 +144,13 @@
%
:- impure pred stm_block_thread(stm::ui) is det.
+ % This type is used in the case where an atomic_scope has no outputs
+ % since the call to try_stm/3 introduced by the expansion of atomic
+ % scopes needs to return at least one value.
+ %
+:- type stm_dummy_output
+ ---> stm_dummy_output.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -148,152 +158,13 @@
:- import_module exception.
-:- pragma foreign_decl("C", "
-
-#if defined(MR_HIGHLEVEL_CODE)
-
- #if defined(MR_THREAD_SAFE)
- #include <pthread.h>
-
- typedef pthread_t ML_ThreadId;
- #else
- typedef MR_Integer ML_ThreadId;
-
- #endif /* !MR_THREAD_SAFE */
-
-#else /* !MR_HIGHLEVEL_CODE */
-
- typedef MR_Context *ML_ThreadId;
-
-#endif /* !MR_HIGHLEVEL_CODE */
-
-#define ML_STM_TRANSACTION_VALID 0
-#define ML_STM_TRANSACTION_INVALID 1
-
-typedef struct ML_Stm_Wait_List_Struct {
- ML_ThreadId thread;
- 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_ThreadId thread; /* Current thread */
-} 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);
-
-extern void
-ML_stm_add_new_wait_entry(ML_Stm_TVar *tvar, ML_ThreadId thread);
-
-extern void
-ML_stm_remove_wait_entry(ML_Stm_TVar *tvar, ML_ThreadId thread);
-
-/* ------------------------------------------------------------------------- */
-
-#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;
-}
-
-
-/*
-** Adds a new wait entry to a transaction variable.
-*/
-
-void
-ML_stm_add_new_wait_entry(ML_Stm_TVar *tvar, ML_ThreadId thread) {
- ML_Stm_Wait_List *wait_list;
-
- wait_list = MR_GC_NEW(ML_Stm_Wait_List);
-
- wait_list->thread = thread;
- wait_list->next = NULL;
-
- if (tvar->wait_list == NULL) {
- tvar->wait_list = wait_list;
- } else {
- tvar->wait_list->next = wait_list;
- }
-}
-
-
-/*
-** Remove a wait entry from a transaction variable.
-*/
-
-void
-ML_stm_remove_wait_entry(ML_Stm_TVar *tvar, ML_ThreadId thread) {
- ML_Stm_Wait_List *wait_list;
- ML_Stm_Wait_List *prev;
-
- prev = NULL;
-
- for (wait_list = tvar->wait_list; wait_list != NULL;
- wait_list = wait_list->next) {
- if (wait_list->thread == thread) {
- if (prev == NULL) {
- tvar->wait_list = wait_list->next;
- } else {
- prev->next = wait_list->next;
- }
- break;
- }
- prev = wait_list;
- }
-
- /* If wait_list == NULL, the entry is being removed */
-
- if (wait_list != NULL) {
- wait_list = NULL;
- }
-}
-").
-
-%----------------------------------------------------------------------------%
+:- pragma foreign_decl("C", "#include \"mercury_stm.h\"").
-:- pragma foreign_type("C", stm_var(T), "ML_Stm_TVar *",
+:- pragma foreign_type("C", stm_var(T), "MR_STM_Var *",
[stable, can_pass_as_mercury_type]).
-:- pragma foreign_type("C", stm, "ML_Stm_TLog *", [can_pass_as_mercury_type]).
+:- pragma foreign_type("C", stm, "MR_STM_TransLog *",
+ [can_pass_as_mercury_type]).
% Definitions for use with the other backends.
%
@@ -305,43 +176,11 @@
%----------------------------------------------------------------------------%
-:- 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
-").
-
-% For non-C backends.
-ml_initialise_stm :-
- impure impure_true.
-
-%----------------------------------------------------------------------------%
-
:- pragma foreign_proc("C",
new_stm_var(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;
+ MR_STM_new_stm_var(T, TVar);
IO = IO0;
").
@@ -349,25 +188,7 @@
write_stm_var(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);
- }
-
+ MR_STM_write_var(TVar, Value, STM0);
STM = STM0;
").
@@ -375,27 +196,7 @@
read_stm_var(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;
- }
-
+ Value = MR_STM_read_var(TVar, STM0);
STM = STM0;
").
@@ -403,37 +204,22 @@
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;
-
- #if defined(MR_HIGHLEVEL_CODE)
- #if defined(MR_THREAD_SAFE)
- STM->thread = pthread_self();
- #else
- STM->thread = 0;
- #endif
- #else
- STM->thread = NULL; /* current context */
- #endif
+ MR_STM_create_log(STM);
").
:- pragma foreign_proc("C",
- stm_drop_state(X::di),
+ stm_drop_state(STM::di),
[will_not_call_mercury, thread_safe],
"
- ML_TRACE_STM(""Dropping STM Log"");
- X = NULL;
+ MR_STM_discard_log(STM);
").
:- 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\");
+ MR_LOCK(&MR_STM_lock, \"stm_lock/0\");
#endif
").
@@ -441,44 +227,23 @@
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\");
+ MR_UNLOCK(&MR_STM_lock, \"stm_unlock/0\");
#endif
").
:- pragma foreign_proc("C",
- stm_validate(STM::ui, Res::out),
+ stm_validate(STM::ui, IsValid::out),
[will_not_call_mercury, thread_safe],
"
- ML_Stm_TLog_Entry *current_entry;
- ML_TRACE_STM(""Validating STM log"");
-
- Res = ML_STM_TRANSACTION_VALID;
-
- 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 = ML_STM_TRANSACTION_INVALID;
- break;
- }
- }
-
+ IsValid = MR_STM_validate(STM);
").
:- 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;
- }
+ MR_STM_commit(STM);
").
%-----------------------------------------------------------------------------%
@@ -490,17 +255,7 @@
stm_wait(STM::ui),
[will_not_call_mercury, thread_safe],
"
- ML_Stm_TLog_Entry *current_entry;
-
- ML_TRACE_STM(""Waiting on thread"");
-
- /*
- ** Add this thread id to each transaction var referenced by the log.
- */
- for (current_entry = STM->entrylist; current_entry != NULL;
- current_entry = current_entry->next) {
- ML_stm_add_new_wait_entry(current_entry->tvar, STM->thread);
- }
+ MR_STM_wait(STM);
").
% Removes the thread ID to the wait list of all transaction variables
@@ -510,17 +265,7 @@
stm_unwait(STM::ui),
[will_not_call_mercury, thread_safe],
"
- ML_Stm_TLog_Entry *current_entry;
-
- ML_TRACE_STM(""Un-waiting on thread"");
-
- /*
- ** Remove this thread id to each transaction var referenced by the log.
- */
- for (current_entry = STM->entrylist; current_entry != NULL;
- current_entry = current_entry->next) {
- ML_stm_remove_wait_entry(current_entry->tvar, STM->thread);
- }
+ MR_STM_unwait(STM);
").
% Blocks the thread from being rescheduled.
@@ -529,11 +274,6 @@
stm_block_thread(_STM::ui),
[will_not_call_mercury, thread_safe],
"
-#if defined(MR_HIGHLEVEL_CODE) && defined(MR_THREAD_SAFE)
- pthread_yield();
-#else
- ML_TRACE_STM(""Yielding to thread"");
-#endif
").
%-----------------------------------------------------------------------------%
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.140
diff -u -r1.140 Mmakefile
--- runtime/Mmakefile 20 Jul 2007 01:22:05 -0000 1.140
+++ runtime/Mmakefile 12 Sep 2007 17:52:31 -0000
@@ -81,6 +81,7 @@
mercury_stacks.h \
mercury_stack_trace.h \
mercury_std.h \
+ mercury_stm.h \
mercury_string.h \
mercury_tabling.h \
mercury_tabling_macros.h \
@@ -184,6 +185,7 @@
mercury_stacks.c \
mercury_stack_layout.c \
mercury_stack_trace.c \
+ mercury_stm.c \
mercury_string.c \
mercury_tabling.c \
mercury_term_size.c \
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.98
diff -u -r1.98 mercury_conf_param.h
--- runtime/mercury_conf_param.h 31 Jul 2007 07:58:43 -0000 1.98
+++ runtime/mercury_conf_param.h 12 Sep 2007 17:52:31 -0000
@@ -302,6 +302,10 @@
** Enables the -i and --integrity options on mdb's forward movement
** commands, which cause the debugger to check the integrity of the
** representations of all the terms reachable from the stack.
+**
+** MR_STM_DEBUG
+** Enabled low-level debugging messages from the code that implements
+** transactions used by software transactional memory.
*/
/*
Index: runtime/mercury_context.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_context.c,v
retrieving revision 1.56
diff -u -r1.56 mercury_context.c
--- runtime/mercury_context.c 1 May 2007 01:11:42 -0000 1.56
+++ runtime/mercury_context.c 12 Sep 2007 17:52:31 -0000
@@ -18,6 +18,7 @@
#include <stdio.h>
#ifdef MR_THREAD_SAFE
#include "mercury_thread.h"
+ #include "mercury_stm.h"
#endif
#ifdef MR_CAN_DO_PENDING_IO
#include <sys/types.h> /* for fd_set */
@@ -84,6 +85,7 @@
pthread_mutex_init(&free_context_list_lock, MR_MUTEX_ATTR);
pthread_mutex_init(&MR_global_lock, MR_MUTEX_ATTR);
pthread_mutex_init(&MR_pending_contexts_lock, MR_MUTEX_ATTR);
+ pthread_mutex_init(&MR_STM_lock, MR_MUTEX_ATTR);
#ifndef MR_THREAD_LOCAL_STORAGE
MR_KEY_CREATE(&MR_engine_base_key, NULL);
#endif
Index: runtime/mercury_stm.c
===================================================================
RCS file: runtime/mercury_stm.c
diff -N runtime/mercury_stm.c
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_stm.c 12 Sep 2007 17:52:31 -0000
@@ -0,0 +1,161 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 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.
+*/
+
+/* mercury_stm.c - runtime support for software transactional memory. */
+
+#include "mercury_std.h"
+#include "mercury_stm.h"
+#include "mercury_memory.h"
+#include "mercury_misc.h"
+
+#if defined(MR_THREAD_SAFE)
+ MercuryLock MR_STM_lock;
+#endif
+
+void
+MR_STM_record_transaction(MR_STM_TransLog *log, MR_STM_Var *var,
+ MR_Word old_value, MR_Word new_value)
+{
+ MR_STM_TransRecord *new_record;
+
+ new_record = MR_GC_NEW(MR_STM_TransRecord);
+ new_record->MR_STM_tr_var = var;
+ new_record->MR_STM_tr_old_value = old_value;
+ new_record->MR_STM_tr_new_value = new_value;
+ new_record->MR_STM_tr_next = log->MR_STM_tl_records;
+ log->MR_STM_tl_records = new_record;
+}
+
+void
+MR_STM_attach_waiter(MR_STM_Var *var, MR_ThreadId tid)
+{
+ MR_fatal_error("NYI MR_STM_attach_waiter");
+}
+
+void
+MR_STM_detach_waiter(MR_STM_Var *var, MR_ThreadId tid)
+{
+ MR_fatal_error("NYI MR_STM_detach_waiter");
+}
+
+MR_Integer
+MR_STM_validate(MR_STM_TransLog *log)
+{
+ MR_STM_TransRecord *current;
+
+ current = log->MR_STM_tl_records;
+ while (current != NULL) {
+ if (current->MR_STM_tr_var->MR_STM_var_value !=
+ current->MR_STM_tr_old_value)
+ {
+ return MR_STM_TRANSACTION_INVALID;
+ }
+ current = current->MR_STM_tr_next;
+ }
+
+ return MR_STM_TRANSACTION_VALID;
+}
+
+void
+MR_STM_commit(MR_STM_TransLog *log) {
+
+ MR_STM_TransRecord *current;
+
+ current = log->MR_STM_tl_records;
+ while (current != NULL) {
+ current->MR_STM_tr_var->MR_STM_var_value
+ = current->MR_STM_tr_new_value;
+ current = current->MR_STM_tr_next;
+ }
+}
+
+void
+MR_STM_wait(MR_STM_TransLog *log)
+{
+ MR_STM_TransRecord *current;
+ MR_ThreadId this_thread_id;
+
+ this_thread_id = MR_THIS_THREAD_ID;
+
+ current = log->MR_STM_tl_records;
+ while (current != NULL) {
+ MR_STM_attach_waiter(current->MR_STM_tr_var, this_thread_id);
+ current = current->MR_STM_tr_next;
+ }
+}
+
+void
+MR_STM_unwait(MR_STM_TransLog *log)
+{
+ MR_STM_TransRecord *current;
+ MR_ThreadId this_thread_id;
+
+ this_thread_id = MR_THIS_THREAD_ID;
+ current = log->MR_STM_tl_records;
+
+ while (current != NULL) {
+ MR_STM_detach_waiter(current->MR_STM_tr_var, this_thread_id);
+ current = current->MR_STM_tr_next;
+ }
+}
+
+void
+MR_STM_write_var(MR_STM_Var *var, MR_Word value, MR_STM_TransLog *log)
+{
+ MR_STM_TransRecord *current;
+ MR_bool has_existing_record = MR_FALSE;
+
+ /*
+ ** Check to see if this transaction variable has an existing record in
+ ** transaction log; if so, update it.
+ */
+ current = log->MR_STM_tl_records;
+ while (current != NULL) {
+ if (current->MR_STM_tr_var == var) {
+ has_existing_record = MR_TRUE;
+ current->MR_STM_tr_new_value = value;
+ break;
+ }
+ current = current->MR_STM_tr_next;
+ }
+
+ /*
+ ** Add a new entry for the transaction variable if didn't already
+ ** have one.
+ */
+ if (!has_existing_record) {
+ MR_STM_record_transaction(log, var, var->MR_STM_var_value, value);
+ }
+}
+
+MR_Word
+MR_STM_read_var(MR_STM_Var *var, MR_STM_TransLog *log)
+{
+ MR_STM_TransRecord *current;
+
+ current = log->MR_STM_tl_records;
+ while (current != NULL) {
+ if (current->MR_STM_tr_var == var) {
+ return current->MR_STM_tr_new_value;
+ }
+ current = current->MR_STM_tr_next;
+ }
+
+ /*
+ ** We will only get to this point if the transaction variable does not
+ ** currently have a record in the log, i.e. if this is the first time
+ ** that its value has been read during this transaction.
+ ** Add an entry that indicates that it has been read and then return
+ ** the value that is stored in the transaction variable.
+ */
+ MR_STM_record_transaction(log, var, var->MR_STM_var_value,
+ var->MR_STM_var_value);
+
+ return var->MR_STM_var_value;
+}
Index: runtime/mercury_stm.h
===================================================================
RCS file: runtime/mercury_stm.h
diff -N runtime/mercury_stm.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_stm.h 12 Sep 2007 17:52:32 -0000
@@ -0,0 +1,187 @@
+/*
+** vim:ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 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.
+*/
+
+/*
+** mercury_stm.h - runtime support for software transactional memory.
+*/
+
+#ifndef MERCURY_STM_H
+#define MERCURY_STM_H
+
+#include "mercury_types.h"
+#include "mercury_thread.h"
+#include "mercury_conf.h"
+
+typedef struct MR_STM_Waiter_Struct MR_STM_Waiter;
+typedef struct MR_STM_Var_Struct MR_STM_Var;
+typedef struct MR_STM_TransRecord_Struct MR_STM_TransRecord;
+typedef struct MR_STM_TransLog_Struct MR_STM_TransLog;
+
+/*
+** The type MR_ThreadId provides an abstract means of identifying a Mercury
+** thread. Depending upon the grade we use one of three notions of thread
+** identity.
+**
+** For high-level code with parallelism it is the value returned by a call
+** to pthread_self().
+**
+** For high-level code without parallelism it is an MR_Integer - in this case
+** concurrency is not supported so there is only ever one thread.
+**
+** For low-level code with use the context address as the thread id.
+**
+** The macro MR_THIS_THREAD_ID expands to a value of type MR_ThreadId.
+** This value is the identity of the current thread.
+*/
+#if defined(MR_HIGHLEVEL_CODE)
+
+ #if defined(MR_THREAD_SAFE)
+ typedef pthread_t MR_ThreadId;
+ #define MR_THIS_THREAD_ID pthread_self()
+ #else
+ typedef MR_Integer MR_ThreadId;
+ /*
+ ** Since these grades don't support concurrency there is only one
+ ** thread which we always give the id 0.
+ */
+ #define MR_THIS_THREAD_ID 0
+ #endif
+
+#else /* !MR_HIGHLEVEL_CODE */
+
+ typedef MR_Context *MR_ThreadId;
+ #define MR_THIS_THREAD_ID (MR_ENGINE(MR_eng_this_context))
+
+#endif /* !MR_HIGHLEVEL_CODE */
+
+/*
+** A waiter is the identity of a thread that is blocking until the value
+** of this transaction variable changes.
+*/
+struct MR_STM_Waiter_Struct {
+ MR_ThreadId MR_STM_waiter_thread;
+ MR_STM_Waiter *MR_STM_waiter_next;
+};
+
+/*
+** XXX this should also contain the type_info for the value, so we can
+** print them out in the debugger, using io.write, etc.
+*/
+struct MR_STM_Var_Struct {
+ MR_Word MR_STM_var_value;
+ MR_STM_Waiter *MR_STM_var_waiters;
+};
+
+struct MR_STM_TransRecord_Struct {
+ MR_STM_Var *MR_STM_tr_var;
+ MR_Word MR_STM_tr_old_value;
+ MR_Word MR_STM_tr_new_value;
+ MR_STM_TransRecord *MR_STM_tr_next;
+};
+
+struct MR_STM_TransLog_Struct {
+ MR_STM_TransRecord *MR_STM_tl_records;
+ MR_ThreadId MR_STM_tl_thread;
+};
+
+/*
+** Allocate a new transaction variable.
+*/
+#define MR_STM_new_stm_var(value, var) \
+ do { \
+ (var) = MR_GC_NEW(MR_STM_Var) ; \
+ (var)->MR_STM_var_value = (value); \
+ (var)->MR_STM_var_waiters = NULL; \
+ } while (0)
+
+/*
+** Create a new transaction log.
+*/
+#define MR_STM_create_log(log) \
+ do { \
+ (log) = MR_GC_NEW(MR_STM_TransLog); \
+ (log)->MR_STM_tl_records = NULL; \
+ (log)->MR_STM_tl_thread = MR_THIS_THREAD_ID; \
+ } while (0)
+
+/*
+** Discard a transaction log.
+** XXX we should free the memory in nogc grades.
+*/
+#define MR_STM_discard_log(log) \
+ do { \
+ (log) = NULL; \
+ } while (0)
+
+/*
+** Record a change of state for transaction variable `var' in the
+** given transaction log. `old_value' and `new_value' give the value
+** of the transaction variable before and after the change of state.
+*/
+extern void
+MR_STM_record_transaction(MR_STM_TransLog *log, MR_STM_Var *var,
+ MR_Word old_value, MR_Word new_value);
+
+/*
+** Add a waiter for the current thread to all of the transaction variables
+** listed in the log.
+*/
+extern void
+MR_STM_wait(MR_STM_TransLog *log);
+
+/*
+** Detach waiters for the current thread from all of the transaction variables
+** referenced by the given transaction log.
+*/
+extern void
+MR_STM_unwait(MR_STM_TransLog *log);
+
+/*
+** Attach a waiter for thread tid to the transaction variable.
+*/
+extern void
+MR_STM_attach_waiter(MR_STM_Var *var, MR_ThreadId tid);
+
+/*
+** Detach any waiters for thread tid from the transaction variable.
+** This will cause execution to abort if no waiter for thread tid can
+** be found since it can only correctly be called in a situation where
+** such a waiter exists.
+*/
+extern void
+MR_STM_detach_waiter(MR_STM_Var *var, MR_ThreadId tid);
+
+extern MR_Integer
+MR_STM_validate(MR_STM_TransLog *log);
+
+/*
+** Irrevocably write the changes stored in a transaction log to memory.
+*/
+extern void
+MR_STM_commit(MR_STM_TransLog *log);
+
+extern void
+MR_STM_write_var(MR_STM_Var *var, MR_Word value, MR_STM_TransLog *log);
+
+extern MR_Word
+MR_STM_read_var(MR_STM_Var *var, MR_STM_TransLog *log);
+
+#if defined(MR_THREAD_SAFE)
+ extern MercuryLock MR_STM_lock;
+#endif
+
+/*
+** These definitions need to be kept in sync with the definition of the type
+** stm_validation_result/0 in library/stm_builtin.m. Changes here may need
+** be reflected there.
+*/
+#define MR_STM_TRANSACTION_VALID 0
+#define MR_STM_TRANSACTION_INVALID 1
+
+#endif /* not MERCURY_STM_H */
--------------------------------------------------------------------------
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