/* -----------------------------------------------------------------------------
* (c) The GHC Team 1998-2005
*
* STM implementation.
*
* Overview
* --------
*
* See the PPoPP 2005 paper "Composable memory transactions". In summary,
* each transcation has a TRec (transaction record) holding entries for each of the
* TVars (transactional variables) that it has accessed. Each entry records
* (a) the TVar, (b) the expected value seen in the TVar, (c) the new value that
* the transaction wants to write to the TVar, (d) during commit, the identity of
* the TRec that wrote the expected value.
*
* Separate TRecs are used for each level in a nest of transactions. This allows
* a nested transaction to be aborted without condemning its enclosing transactions.
* This is needed in the implementation of catchRetry. Note that the "expected value"
* in a nested transaction's TRec is the value expected to be *held in memory* if
* the transaction commits -- not the "new value" stored in one of the enclosing
* transactions. This means that validation can be done without searching through
* a nest of TRecs.
*
* Concurrency control
* -------------------
*
* Three different concurrency control schemes can be built according to the settings
* in STM.h:
*
* STM_UNIPROC assumes that the caller serialises invocations on the STM interface.
* In the Haskell RTS this means it is suitable only for non-THREADED_RTS builds.
*
* STM_CG_LOCK uses coarse-grained locking -- a single 'stm lock' is acquired during
* an invocation on the STM interface. Note that this does not mean that
* transactions are simply serialized -- the lock is only held *within* the
* implementation of stmCommitTransaction, stmWait etc.
*
* STM_FG_LOCKS uses fine-grained locking -- locking is done on a per-TVar basis
* and, when committing a transaction, no locks are acquired for TVars that have
* been read but not updated.
*
* Concurrency control is implemented in the functions:
*
* lock_stm
* unlock_stm
* lock_tvar / cond_lock_tvar
* unlock_tvar
*
* The choice between STM_UNIPROC / STM_CG_LOCK / STM_FG_LOCKS affects the
* implementation of these functions.
*
* lock_stm & unlock_stm are straightforward : they acquire a simple spin-lock
* using STM_CG_LOCK, and otherwise they are no-ops.
*
* lock_tvar / cond_lock_tvar and unlock_tvar are more complex because they
* have other effects (present in STM_UNIPROC and STM_CG_LOCK builds) as well
* as the actual business of maniupultaing a lock (present only in STM_FG_LOCKS
* builds). This is because locking a TVar is implemented by writing the lock
* holder's TRec into the TVar's current_value field:
*
* lock_tvar - lock a specified TVar (STM_FG_LOCKS only), returning the value
* it contained.
*
* cond_lock_tvar - lock a specified TVar (STM_FG_LOCKS only) if it
* contains a specified value. Return TRUE if this succeeds,
* FALSE otherwise.
*
* unlock_tvar - release the lock on a specified TVar (STM_FG_LOCKS only),
* storing a specified value in place of the lock entry.
*
* Using these operations, the typcial pattern of a commit/validate/wait operation
* is to (a) lock the STM, (b) lock all the TVars being updated, (c) check that
* the TVars that were only read from still contain their expected values,
* (d) release the locks on the TVars, writing updates to them in the case of a
* commit, (e) unlock the STM.
*
* Queues of waiting threads hang off the first_watch_queue_entry
* field of each TVar. This may only be manipulated when holding that
* TVar's lock. In particular, when a thread is putting itself to
* sleep, it mustn't release the TVar's lock until it has added itself
* to the wait queue and marked its TSO as BlockedOnSTM -- this makes
* sure that other threads will know to wake it.
*
* ---------------------------------------------------------------------------*/
#include "PosixSource.h"
#include "Rts.h"
#include "RtsUtils.h"
#include "Schedule.h"
#include "STM.h"
#include "Trace.h"
#include "Threads.h"
#include <stdio.h>
#define TRUE 1
#define FALSE 0
// ACQ_ASSERT is used for assertions which are only required for
// THREADED_RTS builds with fine-grained locking.
#if defined(STM_FG_LOCKS)
#define ACQ_ASSERT(_X) ASSERT(_X)
#define NACQ_ASSERT(_X) /*Nothing*/
#else
#define ACQ_ASSERT(_X) /*Nothing*/
#define NACQ_ASSERT(_X) ASSERT(_X)
#endif
/*......................................................................*/
// If SHAKE is defined then validation will sometime spuriously fail. They helps test
// unusualy code paths if genuine contention is rare
#define TRACE(_x...) debugTrace(DEBUG_stm, "STM: " _x)
#ifdef SHAKE
static const int do_shake = TRUE;
#else
static const int do_shake = FALSE;
#endif
static int shake_ctr = 0;
static int shake_lim = 1;
static int shake(void) {
if (do_shake) {
if (((shake_ctr++) % shake_lim) == 0) {
shake_ctr = 1;
shake_lim ++;
return TRUE;
}
return FALSE;
} else {
return FALSE;
}
}
/*......................................................................*/
// Helper macros for iterating over entries within a transaction
// record
#define FOR_EACH_ENTRY(_t,_x,CODE) do { \
StgTRecHeader *__t = (_t); \
StgTRecChunk *__c = __t -> current_chunk; \
StgWord __limit = __c -> next_entry_idx; \
TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%ld", __t, __c, __limit); \
while (__c != END_STM_CHUNK_LIST) { \
StgWord __i; \
for (__i = 0; __i < __limit; __i ++) { \
TRecEntry *_x = &(__c -> entries[__i]); \
do { CODE } while (0); \
} \
__c = __c -> prev_chunk; \
__limit = TREC_CHUNK_NUM_ENTRIES; \
} \
exit_for_each: \
if (FALSE) goto exit_for_each; \
} while (0)
#define BREAK_FOR_EACH goto exit_for_each
/*......................................................................*/
// if REUSE_MEMORY is defined then attempt to re-use descriptors, log chunks,
// and wait queue entries without GC
#define REUSE_MEMORY
/*......................................................................*/
#define IF_STM_UNIPROC(__X) do { } while (0)
#define IF_STM_CG_LOCK(__X) do { } while (0)
#define IF_STM_FG_LOCKS(__X) do { } while (0)
#if defined(STM_UNIPROC)
#undef IF_STM_UNIPROC
#define IF_STM_UNIPROC(__X) do { __X } while (0)
static const StgBool config_use_read_phase = FALSE;
static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
TRACE("%p : lock_stm()", trec);
}
static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
TRACE("%p : unlock_stm()", trec);
}
static StgClosure *lock_tvar(StgTRecHeader *trec STG_UNUSED,
StgTVar *s STG_UNUSED) {
StgClosure *result;
TRACE("%p : lock_tvar(%p)", trec, s);
result = s -> current_value;
return result;
}
static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
StgTVar *s STG_UNUSED,
StgClosure *c,
StgBool force_update) {
TRACE("%p : unlock_tvar(%p)", trec, s);
if (force_update) {
s -> current_value = c;
}
}
static StgBool cond_lock_tvar(StgTRecHeader *trec STG_UNUSED,
StgTVar *s STG_UNUSED,
StgClosure *expected) {
StgClosure *result;
TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
result = s -> current_value;
TRACE("%p : %s", trec, (result == expected) ? "success" : "failure");
return (result == expected);
}
static StgBool lock_inv(StgAtomicInvariant *inv STG_UNUSED) {
// Nothing -- uniproc
return TRUE;
}
static void unlock_inv(StgAtomicInvariant *inv STG_UNUSED) {
// Nothing -- uniproc
}
#endif
#if defined(STM_CG_LOCK) /*........................................*/
#undef IF_STM_CG_LOCK
#define IF_STM_CG_LOCK(__X) do { __X } while (0)
static const StgBool config_use_read_phase = FALSE;
static volatile StgTRecHeader *smp_locked = NULL;
static void lock_stm(StgTRecHeader *trec) {
while (cas(&smp_locked, NULL, trec) != NULL) { }
TRACE("%p : lock_stm()", trec);
}
static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
TRACE("%p : unlock_stm()", trec);
ASSERT (smp_locked == trec);
smp_locked = 0;
}
static StgClosure *lock_tvar(StgTRecHeader *trec STG_UNUSED,
StgTVar *s STG_UNUSED) {
StgClosure *result;
TRACE("%p : lock_tvar(%p)", trec, s);
ASSERT (smp_locked == trec);
result = s -> current_value;
return result;
}
static void *unlock_tvar(StgTRecHeader *trec STG_UNUSED,
StgTVar *s STG_UNUSED,
StgClosure *c,
StgBool force_update) {
TRACE("%p : unlock_tvar(%p, %p)", trec, s, c);
ASSERT (smp_locked == trec);
if (force_update) {
s -> current_value = c;
}
}
static StgBool cond_lock_tvar(StgTRecHeader *trec STG_UNUSED,
StgTVar *s STG_UNUSED,
StgClosure *expected) {
StgClosure *result;
TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
ASSERT (smp_locked == trec);
result = s -> current_value;
TRACE("%p : %d", result ? "success" : "failure");
return (result == expected);
}
static StgBool lock_inv(StgAtomicInvariant *inv STG_UNUSED) {
// Nothing -- protected by STM lock
return TRUE;
}
static void unlock_inv(StgAtomicInvariant *inv STG_UNUSED) {
// Nothing -- protected by STM lock
}
#endif
#if defined(STM_FG_LOCKS) /*...................................*/
#undef IF_STM_FG_LOCKS
#define IF_STM_FG_LOCKS(__X) do { __X } while (0)
static const StgBool config_use_read_phase = TRUE;
static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
TRACE("%p : lock_stm()", trec);
}
static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
TRACE("%p : unlock_stm()", trec);
}
static StgClosure *lock_tvar(StgTRecHeader *trec,
StgTVar *s STG_UNUSED) {
StgClosure *result;
TRACE("%p : lock_tvar(%p)", trec, s);
do {
do {
result = s -> current_value;
} while (GET_INFO(UNTAG_CLOSURE(result)) == &stg_TREC_HEADER_info);
} while (cas((void *)&(s -> current_value),
(StgWord)result, (StgWord)trec) != (StgWord)result);
return result;
}
static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
StgTVar *s,
StgClosure *c,
StgBool force_update STG_UNUSED) {
TRACE("%p : unlock_tvar(%p, %p)", trec, s, c);
ASSERT(s -> current_value == (StgClosure *)trec);
s -> current_value = c;
}
static StgBool cond_lock_tvar(StgTRecHeader *trec,
StgTVar *s,
StgClosure *expected) {
StgClosure *result;
StgWord w;
TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
w = cas((void *)&(s -> current_value), (StgWord)expected, (StgWord)trec);
result = (StgClosure *)w;
TRACE("%p : %s", trec, result ? "success" : "failure");
return (result == expected);
}
static StgBool lock_inv(StgAtomicInvariant *inv) {
return (cas(&(inv -> lock), 0, 1) == 0);
}
static void unlock_inv(StgAtomicInvariant *inv) {
ASSERT(inv -> lock == 1);
inv -> lock = 0;
}
#endif
/*......................................................................*/
static StgBool watcher_is_tso(StgTVarWatchQueue *q) {
StgClosure *c = q -> closure;
StgInfoTable *info = get_itbl(c);
return (info -> type) == TSO;
}
static StgBool watcher_is_invariant(StgTVarWatchQueue *q) {
StgClosure *c = q -> closure;
StgInfoTable *info = get_itbl(c);
return (info -> type) == ATOMIC_INVARIANT;
}
/*......................................................................*/
// Helper functions for thread blocking and unblocking
static void park_tso(StgTSO *tso) {
ASSERT(tso -> why_blocked == NotBlocked);
tso -> why_blocked = BlockedOnSTM;
tso -> block_info.closure = (StgClosure *) END_TSO_QUEUE;
TRACE("park_tso on tso=%p", tso);
}
static void unpark_tso(Capability *cap, StgTSO *tso) {
// We will continue unparking threads while they remain on one of the wait
// queues: it's up to the thread itself to remove it from the wait queues
// if it decides to do so when it is scheduled.
// Unblocking a TSO from BlockedOnSTM is done under the TSO lock,
// to avoid multiple CPUs unblocking the same TSO, and also to
// synchronise with throwTo().
lockTSO(tso);
if (tso -> why_blocked == BlockedOnSTM) {
TRACE("unpark_tso on tso=%p", tso);
unblockOne(cap,tso);
} else {
TRACE("spurious unpark_tso on tso=%p", tso);
}
unlockTSO(tso);
}
static void unpark_waiters_on(Capability *cap, StgTVar *s) {
StgTVarWatchQueue *q;
StgTVarWatchQueue *trail;
TRACE("unpark_waiters_on tvar=%p", s);
// unblock TSOs in reverse order, to be a bit fairer (#2319)
for (q = s -> first_watch_queue_entry, trail = q;
q != END_STM_WATCH_QUEUE;
q = q -> next_queue_entry) {
trail = q;
}
q = trail;
for (;
q != END_STM_WATCH_QUEUE;
q = q -> prev_queue_entry) {
if (watcher_is_tso(q)) {
unpark_tso(cap, (StgTSO *)(q -> closure));
}
}
}
/*......................................................................*/
// Helper functions for downstream allocation and initialization
static StgInvariantCheckQueue *new_stg_invariant_check_queue(Capability *cap,
StgAtomicInvariant *invariant) {
StgInvariantCheckQueue *result;
result = (StgInvariantCheckQueue *)allocateLocal(cap, sizeofW(StgInvariantCheckQueue));
SET_HDR (result, &stg_INVARIANT_CHECK_QUEUE_info, CCS_SYSTEM);
result -> invariant = invariant;
result -> my_execution = NO_TREC;
return result;
}
static StgTVarWatchQueue *new_stg_tvar_watch_queue(Capability *cap,
StgClosure *closure) {
StgTVarWatchQueue *result;
result = (StgTVarWatchQueue *)allocateLocal(cap, sizeofW(StgTVarWatchQueue));
SET_HDR (result, &stg_TVAR_WATCH_QUEUE_info, CCS_SYSTEM);
result -> closure = closure;
return result;
}
static StgTRecChunk *new_stg_trec_chunk(Capability *cap) {
StgTRecChunk *result;
result = (StgTRecChunk *)allocateLocal(cap, sizeofW(StgTRecChunk));
SET_HDR (result, &stg_TREC_CHUNK_info, CCS_SYSTEM);
result -> prev_chunk = END_STM_CHUNK_LIST;
result -> next_entry_idx = 0;
return result;
}
static StgTRecHeader *new_stg_trec_header(Capability *cap,
StgTRecHeader *enclosing_trec) {
StgTRecHeader *result;
result = (StgTRecHeader *) allocateLocal(cap, sizeofW(StgTRecHeader));
SET_HDR (result, &stg_TREC_HEADER_info, CCS_SYSTEM);
result -> enclosing_trec = enclosing_trec;
result -> current_chunk = new_stg_trec_chunk(cap);
result -> invariants_to_check = END_INVARIANT_CHECK_QUEUE;
if (enclosing_trec == NO_TREC) {
result -> state = TREC_ACTIVE;
} else {
ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
enclosing_trec -> state == TREC_CONDEMNED);
result -> state = enclosing_trec -> state;
}
return result;
}
/*......................................................................*/
// Allocation / deallocation functions that retain per-capability lists
// of closures that can be re-used
static StgInvariantCheckQueue *alloc_stg_invariant_check_queue(Capability *cap,
StgAtomicInvariant *invariant) {
StgInvariantCheckQueue *result = NULL;
if (cap -> free_invariant_check_queues == END_INVARIANT_CHECK_QUEUE) {
result = new_stg_invariant_check_queue(cap, invariant);
} else {
result = cap -> free_invariant_check_queues;
result -> invariant = invariant;
result -> my_execution = NO_TREC;
cap -> free_invariant_check_queues = result -> next_queue_entry;
}
return result;
}
static StgTVarWatchQueue *alloc_stg_tvar_watch_queue(Capability *cap,
StgClosure *closure) {
StgTVarWatchQueue *result = NULL;
if (cap -> free_tvar_watch_queues == END_STM_WATCH_QUEUE) {
result = new_stg_tvar_watch_queue(cap, closure);
} else {
result = cap -> free_tvar_watch_queues;
result -> closure = closure;
cap -> free_tvar_watch_queues = result -> next_queue_entry;
}
return result;
}
static void free_stg_tvar_watch_queue(Capability *cap,
StgTVarWatchQueue *wq) {
#if defined(REUSE_MEMORY)
wq -> next_queue_entry = cap -> free_tvar_watch_queues;
cap -> free_tvar_watch_queues = wq;
#endif
}
static StgTRecChunk *alloc_stg_trec_chunk(Capability *cap) {
StgTRecChunk *result = NULL;
if (cap -> free_trec_chunks == END_STM_CHUNK_LIST) {
result = new_stg_trec_chunk(cap);
} else {
result = cap -> free_trec_chunks;
cap -> free_trec_chunks = result -> prev_chunk;
result -> prev_chunk = END_STM_CHUNK_LIST;
result -> next_entry_idx = 0;
}
return result;
}
static void free_stg_trec_chunk(Capability *cap,
StgTRecChunk *c) {
#if defined(REUSE_MEMORY)
c -> prev_chunk = cap -> free_trec_chunks;
cap -> free_trec_chunks = c;
#endif
}
static StgTRecHeader *alloc_stg_trec_header(Capability *cap,
StgTRecHeader *enclosing_trec) {
StgTRecHeader *result = NULL;
if (cap -> free_trec_headers == NO_TREC) {
result = new_stg_trec_header(cap, enclosing_trec);
} else {
result = cap -> free_trec_headers;
cap -> free_trec_headers = result -> enclosing_trec;
result -> enclosing_trec = enclosing_trec;
result -> current_chunk -> next_entry_idx = 0;
result -> invariants_to_check = END_INVARIANT_CHECK_QUEUE;
if (enclosing_trec == NO_TREC) {
result -> state = TREC_ACTIVE;
} else {
ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
enclosing_trec -> state == TREC_CONDEMNED);
result -> state = enclosing_trec -> state;
}
}
return result;
}
static void free_stg_trec_header(Capability *cap,
StgTRecHeader *trec) {
#if defined(REUSE_MEMORY)
StgTRecChunk *chunk = trec -> current_chunk -> prev_chunk;
while (chunk != END_STM_CHUNK_LIST) {
StgTRecChunk *prev_chunk = chunk -> prev_chunk;
free_stg_trec_chunk(cap, chunk);
chunk = prev_chunk;
}
trec -> current_chunk -> prev_chunk = END_STM_CHUNK_LIST;
trec -> enclosing_trec = cap -> free_trec_headers;
cap -> free_trec_headers = trec;
#endif
}
/*......................................................................*/
// Helper functions for managing waiting lists
static void build_watch_queue_entries_for_trec(Capability *cap,
StgTSO *tso,
StgTRecHeader *trec) {
ASSERT(trec != NO_TREC);
ASSERT(trec -> enclosing_trec == NO_TREC);
ASSERT(trec -> state == TREC_ACTIVE);
TRACE("%p : build_watch_queue_entries_for_trec()", trec);
FOR_EACH_ENTRY(trec, e, {
StgTVar *s;
StgTVarWatchQueue *q;
StgTVarWatchQueue *fq;
s = e -> tvar;
TRACE("%p : adding tso=%p to watch queue for tvar=%p", trec, tso, s);
ACQ_ASSERT(s -> current_value == (StgClosure *)trec);
NACQ_ASSERT(s -> current_value == e -> expected_value);
fq = s -> first_watch_queue_entry;
q = alloc_stg_tvar_watch_queue(cap, (StgClosure*) tso);
q -> next_queue_entry = fq;
q -> prev_queue_entry = END_STM_WATCH_QUEUE;
if (fq != END_STM_WATCH_QUEUE) {
fq -> prev_queue_entry = q;
}
s -> first_watch_queue_entry = q;
e -> new_value = (StgClosure *) q;
});
}
static void remove_watch_queue_entries_for_trec(Capability *cap,
StgTRecHeader *trec) {
ASSERT(trec != NO_TREC);
ASSERT(trec -> enclosing_trec == NO_TREC);
ASSERT(trec -> state == TREC_WAITING ||
trec -> state == TREC_CONDEMNED);
TRACE("%p : remove_watch_queue_entries_for_trec()", trec);
FOR_EACH_ENTRY(trec, e, {
StgTVar *s;
StgTVarWatchQueue *pq;
StgTVarWatchQueue *nq;
StgTVarWatchQueue *q;
StgClosure *saw;
s = e -> tvar;
saw = lock_tvar(trec, s);
q = (StgTVarWatchQueue *) (e -> new_value);
TRACE("%p : removing tso=%p from watch queue for tvar=%p",
trec,
q -> closure,
s);
ACQ_ASSERT(s -> current_value == (StgClosure *)trec);
nq = q -> next_queue_entry;
pq = q -> prev_queue_entry;
if (nq != END_STM_WATCH_QUEUE) {
nq -> prev_queue_entry = pq;
}
if (pq != END_STM_WATCH_QUEUE) {
pq -> next_queue_entry = nq;
} else {
ASSERT (s -> first_watch_queue_entry == q);
s -> first_watch_queue_entry = nq;
}
free_stg_tvar_watch_queue(cap, q);
unlock_tvar(trec, s, saw, FALSE);
});
}
/*......................................................................*/
static TRecEntry *get_new_entry(Capability *cap,
StgTRecHeader *t) {
TRecEntry *result;
StgTRecChunk *c;
int i;
c = t -> current_chunk;
i = c -> next_entry_idx;
ASSERT(c != END_STM_CHUNK_LIST);
if (i < TREC_CHUNK_NUM_ENTRIES) {
// Continue to use current chunk
result = &(c -> entries[i]);
c -> next_entry_idx ++;
} else {
// Current chunk is full: allocate a fresh one
StgTRecChunk *nc;
nc = alloc_stg_trec_chunk(cap);
nc -> prev_chunk = c;
nc -> next_entry_idx = 1;
t -> current_chunk = nc;
result = &(nc -> entries[0]);
}
return result;
}
/*......................................................................*/
static void merge_update_into(Capability *cap,
StgTRecHeader *t,
StgTVar *tvar,
StgClosure *expected_value,
StgClosure *new_value) {
int found;
// Look for an entry in this trec
found = FALSE;
FOR_EACH_ENTRY(t, e, {
StgTVar *s;
s = e -> tvar;
if (s == tvar) {
found = TRUE;
if (e -> expected_value != expected_value) {
// Must abort if the two entries start from different values
TRACE("%p : update entries inconsistent at %p (%p vs %p)",
t, tvar, e -> expected_value, expected_value);
t -> state = TREC_CONDEMNED;
}
e -> new_value = new_value;
BREAK_FOR_EACH;
}
});
if (!found) {
// No entry so far in this trec
TRecEntry *ne;
ne = get_new_entry(cap, t);
ne -> tvar = tvar;
ne -> expected_value = expected_value;
ne -> new_value = new_value;
}
}
/*......................................................................*/
static void merge_read_into(Capability *cap,
StgTRecHeader *t,
StgTVar *tvar,
StgClosure *expected_value) {
int found;
// Look for an entry in this trec
found = FALSE;
FOR_EACH_ENTRY(t, e, {
StgTVar *s;
s = e -> tvar;
if (s == tvar) {
found = TRUE;
if (e -> expected_value != expected_value) {
// Must abort if the two entries start from different values
TRACE("%p : read entries inconsistent at %p (%p vs %p)",
t, tvar, e -> expected_value, expected_value);
t -> state = TREC_CONDEMNED;
}
BREAK_FOR_EACH;
}
});
if (!found) {
// No entry so far in this trec
TRecEntry *ne;
ne = get_new_entry(cap, t);
ne -> tvar = tvar;
ne -> expected_value = expected_value;
ne -> new_value = expected_value;
}
}
/*......................................................................*/
static StgBool entry_is_update(TRecEntry *e) {
StgBool result;
result = (e -> expected_value != e -> new_value);
return result;
}
#if defined(STM_FG_LOCKS)
static StgBool entry_is_read_only(TRecEntry *e) {
StgBool result;
result = (e -> expected_value == e -> new_value);
return result;
}
static StgBool tvar_is_locked(StgTVar *s, StgTRecHeader *h) {
StgClosure *c;
StgBool result;
c = s -> current_value;
result = (c == (StgClosure *) h);
return result;
}
#endif
// revert_ownership : release a lock on a TVar, storing back
// the value that it held when the lock was acquired. "revert_all"
// is set in stmWait and stmReWait when we acquired locks on all of
// the TVars involved. "revert_all" is not set in commit operations
// where we don't lock TVars that have been read from but not updated.
static void revert_ownership(StgTRecHeader *trec STG_UNUSED,
StgBool revert_all STG_UNUSED) {
#if defined(STM_FG_LOCKS)
FOR_EACH_ENTRY(trec, e, {
if (revert_all || entry_is_update(e)) {
StgTVar *s;
s = e -> tvar;
if (tvar_is_locked(s, trec)) {
unlock_tvar(trec, s, e -> expected_value, TRUE);
}
}
});
#endif
}
/*......................................................................*/
// validate_and_acquire_ownership : this performs the twin functions
// of checking that the TVars referred to by entries in trec hold the
// expected values and:
//
// - locking the TVar (on updated TVars during commit, or all TVars
// during wait)
//
// - recording the identity of the TRec who wrote the value seen in the
// TVar (on non-updated TVars during commit). These values are
// stashed in the TRec entries and are then checked in check_read_only
// to ensure that an atomic snapshot of all of these locations has been
// seen.
static StgBool validate_and_acquire_ownership (StgTRecHeader *trec,
int acquire_all,
int retain_ownership) {
StgBool result;
if (shake()) {
TRACE("%p : shake, pretending trec is invalid when it may not be", trec);
return FALSE;
}
ASSERT ((trec -> state == TREC_ACTIVE) ||
(trec -> state == TREC_WAITING) ||
(trec -> state == TREC_CONDEMNED));
result = !((trec -> state) == TREC_CONDEMNED);
if (result) {
FOR_EACH_ENTRY(trec, e, {
StgTVar *s;
s = e -> tvar;
if (acquire_all || entry_is_update(e)) {
TRACE("%p : trying to acquire %p", trec, s);
if (!cond_lock_tvar(trec, s, e -> expected_value)) {
TRACE("%p : failed to acquire %p", trec, s);
result = FALSE;
BREAK_FOR_EACH;
}
} else {
ASSERT(config_use_read_phase);
IF_STM_FG_LOCKS({
TRACE("%p : will need to check %p", trec, s);
if (s -> current_value != e -> expected_value) {
TRACE("%p : doesn't match", trec);
result = FALSE;
BREAK_FOR_EACH;
}
e -> num_updates = s -> num_updates;
if (s -> current_value != e -> expected_value) {
TRACE("%p : doesn't match (race)", trec);
result = FALSE;
BREAK_FOR_EACH;
} else {
TRACE("%p : need to check version %ld", trec, e -> num_updates);
}
});
}
});
}
if ((!result) || (!retain_ownership)) {
revert_ownership(trec, acquire_all);
}
return result;
}
// check_read_only : check that we've seen an atomic snapshot of the
// non-updated TVars accessed by a trec. This checks that the last TRec to
// commit an update to the TVar is unchanged since the value was stashed in
// validate_and_acquire_ownership. If no udpate is seen to any TVar than
// all of them contained their expected values at the start of the call to
// check_read_only.
//
// The paper "Concurrent programming without locks" (under submission), or
// Keir Fraser's PhD dissertation "Practical lock-free programming" discuss
// this kind of algorithm.
static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
StgBool result = TRUE;
ASSERT (config_use_read_phase);
IF_STM_FG_LOCKS({
FOR_EACH_ENTRY(trec, e, {
StgTVar *s;
s = e -> tvar;
if (entry_is_read_only(e)) {
TRACE("%p : check_read_only for TVar %p, saw %ld", trec, s, e -> num_updates);
if (s -> num_updates != e -> num_updates) {
// ||s -> current_value != e -> expected_value) {
TRACE("%p : mismatch", trec);
result = FALSE;
BREAK_FOR_EACH;
}
}
});
});
return result;
}
/************************************************************************/
void stmPreGCHook() {
nat i;
lock_stm(NO_TREC);
TRACE("stmPreGCHook");
for (i = 0; i < n_capabilities; i ++) {
Capability *cap = &capabilities[i];
cap -> free_tvar_watch_queues = END_STM_WATCH_QUEUE;
cap -> free_trec_chunks = END_STM_CHUNK_LIST;
cap -> free_trec_headers = NO_TREC;
}
unlock_stm(NO_TREC);
}
/************************************************************************/
// check_read_only relies on version numbers held in TVars' "num_updates"
// fields not wrapping around while a transaction is committed. The version
// number is incremented each time an update is committed to the TVar
// This is unlikely to wrap around when 32-bit integers are used for the counts,
// but to ensure correctness we maintain a shared count on the maximum
// number of commit operations that may occur and check that this has
// not increased by more than 2^32 during a commit.
#define TOKEN_BATCH_SIZE 1024
static volatile StgInt64 max_commits = 0;
#if defined(THREADED_RTS)
static volatile StgBool token_locked = FALSE;
static void getTokenBatch(Capability *cap) {
while (cas((void *)&token_locked, FALSE, TRUE) == TRUE) { /* nothing */ }
max_commits += TOKEN_BATCH_SIZE;
TRACE("%p : cap got token batch, max_commits=%" FMT_Int64, cap, max_commits);
cap -> transaction_tokens = TOKEN_BATCH_SIZE;
token_locked = FALSE;
}
static void getToken(Capability *cap) {
if (cap -> transaction_tokens == 0) {
getTokenBatch(cap);
}
cap -> transaction_tokens --;
}
#else
static void getToken(Capability *cap STG_UNUSED) {
// Nothing
}
#endif
/*......................................................................*/
StgTRecHeader *stmStartTransaction(Capability *cap,
StgTRecHeader *outer) {
StgTRecHeader *t;
TRACE("%p : stmStartTransaction with %d tokens",
outer,
cap -> transaction_tokens);
getToken(cap);
t = alloc_stg_trec_header(cap, outer);
TRACE("%p : stmStartTransaction()=%p", outer, t);
return t;
}
/*......................................................................*/
void stmAbortTransaction(Capability *cap,
StgTRecHeader *trec) {
StgTRecHeader *et;
TRACE("%p : stmAbortTransaction", trec);
ASSERT (trec != NO_TREC);
ASSERT ((trec -> state == TREC_ACTIVE) ||
(trec -> state == TREC_WAITING) ||
(trec -> state == TREC_CONDEMNED));
lock_stm(trec);
et = trec -> enclosing_trec;
if (et == NO_TREC) {
// We're a top-level transaction: remove any watch queue entries that
// we may have.
TRACE("%p : aborting top-level transaction", trec);
if (trec -> state == TREC_WAITING) {
ASSERT (trec -> enclosing_trec == NO_TREC);
TRACE("%p : stmAbortTransaction aborting waiting transaction", trec);
remove_watch_queue_entries_for_trec(cap, trec);
}
} else {
// We're a nested transaction: merge our read set into our parent's
TRACE("%p : retaining read-set into parent %p", trec, et);
FOR_EACH_ENTRY(trec, e, {
StgTVar *s = e -> tvar;
merge_read_into(cap, et, s, e -> expected_value);
});
}
trec -> state = TREC_ABORTED;
unlock_stm(trec);
TRACE("%p : stmAbortTransaction done", trec);
}
/*......................................................................*/
void stmFreeAbortedTRec(Capability *cap,
StgTRecHeader *trec) {
TRACE("%p : stmFreeAbortedTRec", trec);
ASSERT (trec != NO_TREC);
ASSERT ((trec -> state == TREC_CONDEMNED) ||
(trec -> state == TREC_ABORTED));
free_stg_trec_header(cap, trec);
TRACE("%p : stmFreeAbortedTRec done", trec);
}
/*......................................................................*/
void stmCondemnTransaction(Capability *cap,
StgTRecHeader *trec) {
TRACE("%p : stmCondemnTransaction", trec);
ASSERT (trec != NO_TREC);
ASSERT ((trec -> state == TREC_ACTIVE) ||
(trec -> state == TREC_WAITING) ||
(trec -> state == TREC_CONDEMNED));
lock_stm(trec);
if (trec -> state == TREC_WAITING) {
ASSERT (trec -> enclosing_trec == NO_TREC);
TRACE("%p : stmCondemnTransaction condemning waiting transaction", trec);
remove_watch_queue_entries_for_trec(cap, trec);
}
trec -> state = TREC_CONDEMNED;
unlock_stm(trec);
TRACE("%p : stmCondemnTransaction done", trec);
}
/*......................................................................*/
StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec) {
StgTRecHeader *outer;
TRACE("%p : stmGetEnclosingTRec", trec);
outer = trec -> enclosing_trec;
TRACE("%p : stmGetEnclosingTRec()=%p", trec, outer);
return outer;
}
/*......................................................................*/
StgBool stmValidateNestOfTransactions(StgTRecHeader *trec) {
StgTRecHeader *t;
StgBool result;
TRACE("%p : stmValidateNestOfTransactions", trec);
ASSERT(trec != NO_TREC);
ASSERT((trec -> state == TREC_ACTIVE) ||
(trec -> state == TREC_WAITING) ||
(trec -> state == TREC_CONDEMNED));
lock_stm(trec);
t = trec;
result = TRUE;
while (t != NO_TREC) {
result &= validate_and_acquire_ownership(t, TRUE, FALSE);
t = t -> enclosing_trec;
}
if (!result && trec -> state != TREC_WAITING) {
trec -> state = TREC_CONDEMNED;
}
unlock_stm(trec);
TRACE("%p : stmValidateNestOfTransactions()=%d", trec, result);
return result;
}
/*......................................................................*/
static TRecEntry *get_entry_for(StgTRecHeader *trec, StgTVar *tvar, StgTRecHeader **in) {
TRecEntry *result = NULL;
TRACE("%p : get_entry_for TVar %p", trec, tvar);
ASSERT(trec != NO_TREC);
do {
FOR_EACH_ENTRY(trec, e, {
if (e -> tvar == tvar) {
result = e;
if (in != NULL) {
*in = trec;
}
BREAK_FOR_EACH;
}
});
trec = trec -> enclosing_trec;
} while (result == NULL && trec != NO_TREC);
return result;
}
/*......................................................................*/
/*
* Add/remove links between an invariant TVars. The caller must have
* locked the TVars involved and the invariant.
*/
static void disconnect_invariant(Capability *cap,
StgAtomicInvariant *inv) {
StgTRecHeader *last_execution = inv -> last_execution;
TRACE("unhooking last execution inv=%p trec=%p", inv, last_execution);
FOR_EACH_ENTRY(last_execution, e, {
StgTVar *s = e -> tvar;
StgTVarWatchQueue *q = s -> first_watch_queue_entry;
StgBool found = FALSE;
TRACE(" looking for trec on tvar=%p", s);
for (q = s -> first_watch_queue_entry;
q != END_STM_WATCH_QUEUE;
q = q -> next_queue_entry) {
if (q -> closure == (StgClosure*)inv) {
StgTVarWatchQueue *pq;
StgTVarWatchQueue *nq;
nq = q -> next_queue_entry;
pq = q -> prev_queue_entry;
if (nq != END_STM_WATCH_QUEUE) {
nq -> prev_queue_entry = pq;
}
if (pq != END_STM_WATCH_QUEUE) {
pq -> next_queue_entry = nq;
} else {
ASSERT (s -> first_watch_queue_entry == q);
s -> first_watch_queue_entry = nq;
}
TRACE(" found it in watch queue entry %p", q);
free_stg_tvar_watch_queue(cap, q);
found = TRUE;
break;
}
}
ASSERT(found);
});
inv -> last_execution = NO_TREC;
}
static void connect_invariant_to_trec(Capability *cap,
StgAtomicInvariant *inv,
StgTRecHeader *my_execution) {
TRACE("connecting execution inv=%p trec=%p", inv, my_execution);
ASSERT(inv -> last_execution == NO_TREC);
FOR_EACH_ENTRY(my_execution, e, {
StgTVar *s = e -> tvar;
StgTVarWatchQueue *q = alloc_stg_tvar_watch_queue(cap, (StgClosure*)inv);
StgTVarWatchQueue *fq = s -> first_watch_queue_entry;
// We leave "last_execution" holding the values that will be
// in the heap after the transaction we're in the process
// of committing has finished.
TRecEntry *entry = get_entry_for(my_execution -> enclosing_trec, s, NULL);
if (entry != NULL) {
e -> expected_value = entry -> new_value;
e -> new_value = entry -> new_value;
}
TRACE(" linking trec on tvar=%p value=%p q=%p", s, e -> expected_value, q);
q -> next_queue_entry = fq;
q -> prev_queue_entry = END_STM_WATCH_QUEUE;
if (fq != END_STM_WATCH_QUEUE) {
fq -> prev_queue_entry = q;
}
s -> first_watch_queue_entry = q;
});
inv -> last_execution = my_execution;
}
/*
* Add a new invariant to the trec's list of invariants to check on commit
*/
void stmAddInvariantToCheck(Capability *cap,
StgTRecHeader *trec,
StgClosure *code) {
StgAtomicInvariant *invariant;
StgInvariantCheckQueue *q;
TRACE("%p : stmAddInvariantToCheck closure=%p", trec, code);
ASSERT(trec != NO_TREC);
ASSERT(trec -> state == TREC_ACTIVE ||
trec -> state == TREC_CONDEMNED);
// 1. Allocate an StgAtomicInvariant, set last_execution to NO_TREC
// to signal that this is a new invariant in the current atomic block
invariant = (StgAtomicInvariant *) allocateLocal(cap, sizeofW(StgAtomicInvariant));
TRACE("%p : stmAddInvariantToCheck allocated invariant=%p", trec, invariant);
SET_HDR (invariant, &stg_ATOMIC_INVARIANT_info, CCS_SYSTEM);
invariant -> code = code;
invariant -> last_execution = NO_TREC;
// 2. Allocate an StgInvariantCheckQueue entry, link it to the current trec
q = alloc_stg_invariant_check_queue(cap, invariant);
TRACE("%p : stmAddInvariantToCheck allocated q=%p", trec, q);
q -> invariant = invariant;
q -> my_execution = NO_TREC;
q -> next_queue_entry = trec -> invariants_to_check;
trec -> invariants_to_check = q;
TRACE("%p : stmAddInvariantToCheck done", trec);
}
/*
* Fill in the trec's list of invariants that might be violated by the
* current transaction.
*/
StgInvariantCheckQueue *stmGetInvariantsToCheck(Capability *cap, StgTRecHeader *trec) {
StgTRecChunk *c;
TRACE("%p : stmGetInvariantsToCheck, head was %p",
trec,
trec -> invariants_to_check);
ASSERT(trec != NO_TREC);
ASSERT ((trec -> state == TREC_ACTIVE) ||
(trec -> state == TREC_WAITING) ||
(trec -> state == TREC_CONDEMNED));
ASSERT(trec -> enclosing_trec == NO_TREC);
lock_stm(trec);
c = trec -> current_chunk;
while (c != END_STM_CHUNK_LIST) {
unsigned int i;
for (i = 0; i < c -> next_entry_idx; i ++) {
TRecEntry *e = &(c -> entries[i]);
if (entry_is_update(e)) {
StgTVar *s = e -> tvar;
StgClosure *old = lock_tvar(trec, s);
// Pick up any invariants on the TVar being updated
// by entry "e"
StgTVarWatchQueue *q;
TRACE("%p : checking for invariants on %p", trec, s);
for (q = s -> first_watch_queue_entry;
q != END_STM_WATCH_QUEUE;
q = q -> next_queue_entry) {
if (watcher_is_invariant(q)) {
StgBool found = FALSE;
StgInvariantCheckQueue *q2;
TRACE("%p : Touching invariant %p", trec, q -> closure);
for (q2 = trec -> invariants_to_check;
q2 != END_INVARIANT_CHECK_QUEUE;
q2 = q2 -> next_queue_entry) {
if (q2 -> invariant == (StgAtomicInvariant*)(q -> closure)) {
TRACE("%p : Already found %p", trec, q -> closure);
found = TRUE;
break;
}
}
if (!found) {
StgInvariantCheckQueue *q3;
TRACE("%p : Not already found %p", trec, q -> closure);
q3 = alloc_stg_invariant_check_queue(cap,
(StgAtomicInvariant*) q -> closure);
q3 -> next_queue_entry = trec -> invariants_to_check;
trec -> invariants_to_check = q3;
}
}
}
unlock_tvar(trec, s, old, FALSE);
}
}
c = c -> prev_chunk;
}
unlock_stm(trec);
TRACE("%p : stmGetInvariantsToCheck, head now %p",
trec,
trec -> invariants_to_check);
return (trec -> invariants_to_check);
}
/*......................................................................*/
StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
int result;
StgInt64 max_commits_at_start = max_commits;
StgBool touched_invariants;
StgBool use_read_phase;
TRACE("%p : stmCommitTransaction()", trec);
ASSERT (trec != NO_TREC);
lock_stm(trec);
ASSERT (trec -> enclosing_trec == NO_TREC);
ASSERT ((trec -> state == TREC_ACTIVE) ||
(trec -> state == TREC_CONDEMNED));
// touched_invariants is true if we've written to a TVar with invariants
// attached to it, or if we're trying to add a new invariant to the system.
touched_invariants = (trec -> invariants_to_check != END_INVARIANT_CHECK_QUEUE);
// If we have touched invariants then (i) lock the invariant, and (ii) add
// the invariant's read set to our own. Step (i) is needed to serialize
// concurrent transactions that attempt to make conflicting updates
// to the invariant's trec (suppose it read from t1 and t2, and that one
// concurrent transcation writes only to t1, and a second writes only to
// t2). Step (ii) is needed so that both transactions will lock t1 and t2
// to gain access to their wait lists (and hence be able to unhook the
// invariant from both tvars).
if (touched_invariants) {
StgInvariantCheckQueue *q = trec -> invariants_to_check;
TRACE("%p : locking invariants", trec);
while (q != END_INVARIANT_CHECK_QUEUE) {
StgTRecHeader *inv_old_trec;
StgAtomicInvariant *inv;
TRACE("%p : locking invariant %p", trec, q -> invariant);
inv = q -> invariant;
if (!lock_inv(inv)) {
TRACE("%p : failed to lock %p", trec, inv);
trec -> state = TREC_CONDEMNED;
break;
}
inv_old_trec = inv -> last_execution;
if (inv_old_trec != NO_TREC) {
StgTRecChunk *c = inv_old_trec -> current_chunk;
while (c != END_STM_CHUNK_LIST) {
unsigned int i;
for (i = 0; i < c -> next_entry_idx; i ++) {
TRecEntry *e = &(c -> entries[i]);
TRACE("%p : ensuring we lock TVars for %p", trec, e -> tvar);
merge_read_into (cap, trec, e -> tvar, e -> expected_value);
}
c = c -> prev_chunk;
}
}
q = q -> next_queue_entry;
}
TRACE("%p : finished locking invariants", trec);
}
// Use a read-phase (i.e. don't lock TVars we've read but not updated) if
// (i) the configuration lets us use a read phase, and (ii) we've not
// touched or introduced any invariants.
//
// In principle we could extend the implementation to support a read-phase
// and invariants, but it complicates the logic: the links between
// invariants and TVars are managed by the TVar watch queues which are
// protected by the TVar's locks.
use_read_phase = ((config_use_read_phase) && (!touched_invariants));
result = validate_and_acquire_ownership(trec, (!use_read_phase), TRUE);
if (result) {
// We now know that all the updated locations hold their expected values.
ASSERT (trec -> state == TREC_ACTIVE);
if (use_read_phase) {
StgInt64 max_commits_at_end;
StgInt64 max_concurrent_commits;
TRACE("%p : doing read check", trec);
result = check_read_only(trec);
TRACE("%p : read-check %s", trec, result ? "succeeded" : "failed");
max_commits_at_end = max_commits;
max_concurrent_commits = ((max_commits_at_end - max_commits_at_start) +
(n_capabilities * TOKEN_BATCH_SIZE));
if (((max_concurrent_commits >> 32) > 0) || shake()) {
result = FALSE;
}
}
if (result) {
// We now know that all of the read-only locations held their exepcted values
// at the end of the call to validate_and_acquire_ownership. This forms the
// linearization point of the commit.
// 1. If we have touched or introduced any invariants then unhook them
// from the TVars they depended on last time they were executed
// and hook them on the TVars that they now depend on.
if (touched_invariants) {
StgInvariantCheckQueue *q = trec -> invariants_to_check;
while (q != END_INVARIANT_CHECK_QUEUE) {
StgAtomicInvariant *inv = q -> invariant;
if (inv -> last_execution != NO_TREC) {
disconnect_invariant(cap, inv);
}
TRACE("%p : hooking up new execution trec=%p", trec, q -> my_execution);
connect_invariant_to_trec(cap, inv, q -> my_execution);
TRACE("%p : unlocking invariant %p", trec, inv);
unlock_inv(inv);
q = q -> next_queue_entry;
}
}
// 2. Make the updates required by the transaction
FOR_EACH_ENTRY(trec, e, {
StgTVar *s;
s = e -> tvar;
if ((!use_read_phase) || (e -> new_value != e -> expected_value)) {
// Either the entry is an update or we're not using a read phase:
// write the value back to the TVar, unlocking it if necessary.
ACQ_ASSERT(tvar_is_locked(s, trec));
TRACE("%p : writing %p to %p, waking waiters", trec, e -> new_value, s);
unpark_waiters_on(cap,s);
IF_STM_FG_LOCKS({
s -> num_updates ++;
});
unlock_tvar(trec, s, e -> new_value, TRUE);
}
ACQ_ASSERT(!tvar_is_locked(s, trec));
});
} else {
revert_ownership(trec, FALSE);
}
}
unlock_stm(trec);
free_stg_trec_header(cap, trec);
TRACE("%p : stmCommitTransaction()=%d", trec, result);
return result;
}
/*......................................................................*/
StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) {
StgTRecHeader *et;
int result;
ASSERT (trec != NO_TREC && trec -> enclosing_trec != NO_TREC);
TRACE("%p : stmCommitNestedTransaction() into %p", trec, trec -> enclosing_trec);
ASSERT ((trec -> state == TREC_ACTIVE) || (trec -> state == TREC_CONDEMNED));
lock_stm(trec);
et = trec -> enclosing_trec;
result = validate_and_acquire_ownership(trec, (!config_use_read_phase), TRUE);
if (result) {
// We now know that all the updated locations hold their expected values.
if (config_use_read_phase) {
TRACE("%p : doing read check", trec);
result = check_read_only(trec);
}
if (result) {
// We now know that all of the read-only locations held their exepcted values
// at the end of the call to validate_and_acquire_ownership. This forms the
// linearization point of the commit.
TRACE("%p : read-check succeeded", trec);
FOR_EACH_ENTRY(trec, e, {
// Merge each entry into the enclosing transaction record, release all
// locks.
StgTVar *s;
s = e -> tvar;
if (entry_is_update(e)) {
unlock_tvar(trec, s, e -> expected_value, FALSE);
}
merge_update_into(cap, et, s, e -> expected_value, e -> new_value);
ACQ_ASSERT(s -> current_value != (StgClosure *)trec);
});
} else {
revert_ownership(trec, FALSE);
}
}
unlock_stm(trec);
free_stg_trec_header(cap, trec);
TRACE("%p : stmCommitNestedTransaction()=%d", trec, result);
return result;
}
/*......................................................................*/
StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
int result;
TRACE("%p : stmWait(%p)", trec, tso);
ASSERT (trec != NO_TREC);
ASSERT (trec -> enclosing_trec == NO_TREC);
ASSERT ((trec -> state == TREC_ACTIVE) ||
(trec -> state == TREC_CONDEMNED));
lock_stm(trec);
result = validate_and_acquire_ownership(trec, TRUE, TRUE);
if (result) {
// The transaction is valid so far so we can actually start waiting.
// (Otherwise the transaction was not valid and the thread will have to
// retry it).
// Put ourselves to sleep. We retain locks on all the TVars involved
// until we are sound asleep : (a) on the wait queues, (b) BlockedOnSTM
// in the TSO, (c) TREC_WAITING in the Trec.
build_watch_queue_entries_for_trec(cap, tso, trec);
park_tso(tso);
trec -> state = TREC_WAITING;
// We haven't released ownership of the transaction yet. The TSO
// has been put on the wait queue for the TVars it is waiting for,
// but we haven't yet tidied up the TSO's stack and made it safe
// to wake up the TSO. Therefore, we must wait until the TSO is
// safe to wake up before we release ownership - when all is well,
// the runtime will call stmWaitUnlock() below, with the same
// TRec.
} else {
unlock_stm(trec);
free_stg_trec_header(cap, trec);
}
TRACE("%p : stmWait(%p)=%d", trec, tso, result);
return result;
}
void
stmWaitUnlock(Capability *cap STG_UNUSED, StgTRecHeader *trec) {
revert_ownership(trec, TRUE);
unlock_stm(trec);
}
/*......................................................................*/
StgBool stmReWait(Capability *cap, StgTSO *tso) {
int result;
StgTRecHeader *trec = tso->trec;
TRACE("%p : stmReWait", trec);
ASSERT (trec != NO_TREC);
ASSERT (trec -> enclosing_trec == NO_TREC);
ASSERT ((trec -> state == TREC_WAITING) ||
(trec -> state == TREC_CONDEMNED));
lock_stm(trec);
result = validate_and_acquire_ownership(trec, TRUE, TRUE);
TRACE("%p : validation %s", trec, result ? "succeeded" : "failed");
if (result) {
// The transaction remains valid -- do nothing because it is already on
// the wait queues
ASSERT (trec -> state == TREC_WAITING);
park_tso(tso);
revert_ownership(trec, TRUE);
} else {
// The transcation has become invalid. We can now remove it from the wait
// queues.
if (trec -> state != TREC_CONDEMNED) {
remove_watch_queue_entries_for_trec (cap, trec);
}
free_stg_trec_header(cap, trec);
}
unlock_stm(trec);
TRACE("%p : stmReWait()=%d", trec, result);
return result;
}
/*......................................................................*/
static StgClosure *read_current_value(StgTRecHeader *trec STG_UNUSED, StgTVar *tvar) {
StgClosure *result;
result = tvar -> current_value;
#if defined(STM_FG_LOCKS)
while (GET_INFO(UNTAG_CLOSURE(result)) == &stg_TREC_HEADER_info) {
TRACE("%p : read_current_value(%p) saw %p", trec, tvar, result);
result = tvar -> current_value;
}
#endif
TRACE("%p : read_current_value(%p)=%p", trec, tvar, result);
return result;
}
/*......................................................................*/
StgClosure *stmReadTVar(Capability *cap,
StgTRecHeader *trec,
StgTVar *tvar) {
StgTRecHeader *entry_in = NULL;
StgClosure *result = NULL;
TRecEntry *entry = NULL;
TRACE("%p : stmReadTVar(%p)", trec, tvar);
ASSERT (trec != NO_TREC);
ASSERT (trec -> state == TREC_ACTIVE ||
trec -> state == TREC_CONDEMNED);
entry = get_entry_for(trec, tvar, &entry_in);
if (entry != NULL) {
if (entry_in == trec) {
// Entry found in our trec
result = entry -> new_value;
} else {
// Entry found in another trec
TRecEntry *new_entry = get_new_entry(cap, trec);
new_entry -> tvar = tvar;
new_entry -> expected_value = entry -> expected_value;
new_entry -> new_value = entry -> new_value;
result = new_entry -> new_value;
}
} else {
// No entry found
StgClosure *current_value = read_current_value(trec, tvar);
TRecEntry *new_entry = get_new_entry(cap, trec);
new_entry -> tvar = tvar;
new_entry -> expected_value = current_value;
new_entry -> new_value = current_value;
result = current_value;
}
TRACE("%p : stmReadTVar(%p)=%p", trec, tvar, result);
return result;
}
/*......................................................................*/
void stmWriteTVar(Capability *cap,
StgTRecHeader *trec,
StgTVar *tvar,
StgClosure *new_value) {
StgTRecHeader *entry_in = NULL;
TRecEntry *entry = NULL;
TRACE("%p : stmWriteTVar(%p, %p)", trec, tvar, new_value);
ASSERT (trec != NO_TREC);
ASSERT (trec -> state == TREC_ACTIVE ||
trec -> state == TREC_CONDEMNED);
entry = get_entry_for(trec, tvar, &entry_in);
if (entry != NULL) {
if (entry_in == trec) {
// Entry found in our trec
entry -> new_value = new_value;
} else {
// Entry found in another trec
TRecEntry *new_entry = get_new_entry(cap, trec);
new_entry -> tvar = tvar;
new_entry -> expected_value = entry -> expected_value;
new_entry -> new_value = new_value;
}
} else {
// No entry found
StgClosure *current_value = read_current_value(trec, tvar);
TRecEntry *new_entry = get_new_entry(cap, trec);
new_entry -> tvar = tvar;
new_entry -> expected_value = current_value;
new_entry -> new_value = new_value;
}
TRACE("%p : stmWriteTVar done", trec);
}
/*......................................................................*/
StgTVar *stmNewTVar(Capability *cap,
StgClosure *new_value) {
StgTVar *result;
result = (StgTVar *)allocateLocal(cap, sizeofW(StgTVar));
SET_HDR (result, &stg_TVAR_info, CCS_SYSTEM);
result -> current_value = new_value;
result -> first_watch_queue_entry = END_STM_WATCH_QUEUE;
#if defined(THREADED_RTS)
result -> num_updates = 0;
#endif
return result;
}
/*......................................................................*/