Shift most of the STM runtime into the Mercury runtime.

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.
This commit is contained in:
Julien Fischer
2007-09-13 04:40:52 +00:00
parent 8a02479464
commit 853622ad87
7 changed files with 424 additions and 296 deletions

View File

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

View File

@@ -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 <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_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
").
%-----------------------------------------------------------------------------%

View File

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

View File

@@ -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.
*/
/*

View File

@@ -18,6 +18,7 @@ ENDINIT
#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 @@ 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

161
runtime/mercury_stm.c Normal file
View File

@@ -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;
}

189
runtime/mercury_stm.h Normal file
View File

@@ -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 */