diff --git a/library/exception.m b/library/exception.m index cb192e85a..d59d03ffa 100644 --- a/library/exception.m +++ b/library/exception.m @@ -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), +:- 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 unsafe_try_stm(in(pred(out, di, uo) is cc_multi), out(cannot_fail), di, uo) is cc_multi. %-----------------------------------------------------------------------------% @@ -689,19 +705,35 @@ wrap_exception(Exception, exception(Exception)). %-----------------------------------------------------------------------------% -:- 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 + ) + ). -try_stm(TransactionGoal::in(pred(out, di, uo) is det), +:- pragma promise_equivalent_clauses(unsafe_try_stm/4). + +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_stm_det(exp_detism_det, TransactionGoal, Result, !STM) :- 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_stm_cc_multi(exp_detism_cc_multi, TransactionGoal, Result, !STM) :- 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. diff --git a/library/stm_builtin.m b/library/stm_builtin.m index e79a21773..bd757ea11 100644 --- a/library/stm_builtin.m +++ b/library/stm_builtin.m @@ -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", " +:- pragma foreign_decl("C", "#include \"mercury_stm.h\""). -#if defined(MR_HIGHLEVEL_CODE) - - #if defined(MR_THREAD_SAFE) - #include - - 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_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 @@ ML_stm_remove_wait_entry(ML_Stm_TVar *tvar, ML_ThreadId thread) { %----------------------------------------------------------------------------% -:- 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 @@ ml_initialise_stm :- 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 @@ ml_initialise_stm :- 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 @@ ml_initialise_stm :- 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 @@ ml_initialise_stm :- 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 @@ ml_initialise_stm :- 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 @@ ml_initialise_stm :- 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 @@ ml_initialise_stm :- 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 "). %-----------------------------------------------------------------------------% diff --git a/runtime/Mmakefile b/runtime/Mmakefile index 11233ee44..896890e59 100644 --- a/runtime/Mmakefile +++ b/runtime/Mmakefile @@ -81,6 +81,7 @@ HDRS = \ 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 @@ CFILES = \ mercury_stacks.c \ mercury_stack_layout.c \ mercury_stack_trace.c \ + mercury_stm.c \ mercury_string.c \ mercury_tabling.c \ mercury_term_size.c \ diff --git a/runtime/mercury_conf_param.h b/runtime/mercury_conf_param.h index acbf99c78..a6489c01c 100644 --- a/runtime/mercury_conf_param.h +++ b/runtime/mercury_conf_param.h @@ -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. */ /* diff --git a/runtime/mercury_context.c b/runtime/mercury_context.c index 46a9180ab..b327f2f60 100644 --- a/runtime/mercury_context.c +++ b/runtime/mercury_context.c @@ -18,6 +18,7 @@ ENDINIT #include #ifdef MR_THREAD_SAFE #include "mercury_thread.h" + #include "mercury_stm.h" #endif #ifdef MR_CAN_DO_PENDING_IO #include /* for fd_set */ @@ -84,6 +85,7 @@ MR_init_thread_stuff(void) 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 diff --git a/runtime/mercury_stm.c b/runtime/mercury_stm.c new file mode 100644 index 000000000..2b7aead56 --- /dev/null +++ b/runtime/mercury_stm.c @@ -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; +} diff --git a/runtime/mercury_stm.h b/runtime/mercury_stm.h new file mode 100644 index 000000000..d3210015e --- /dev/null +++ b/runtime/mercury_stm.h @@ -0,0 +1,189 @@ +/* +** 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" +#include "mercury_context.h" +#include "mercury_engine.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. +*/ +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 */