1 /* -----------------------------------------------------------------------------
2 * (c) The GHC Team 1998-2005
9 * See the PPoPP 2005 paper "Composable memory transactions". In summary,
10 * each transcation has a TRec (transaction record) holding entries for each of the
11 * TVars (transactional variables) that it has accessed. Each entry records
12 * (a) the TVar, (b) the expected value seen in the TVar, (c) the new value that
13 * the transaction wants to write to the TVar, (d) during commit, the identity of
14 * the TRec that wrote the expected value.
16 * Separate TRecs are used for each level in a nest of transactions. This allows
17 * a nested transaction to be aborted without condemning its enclosing transactions.
18 * This is needed in the implementation of catchRetry. Note that the "expected value"
19 * in a nested transaction's TRec is the value expected to be *held in memory* if
20 * the transaction commits -- not the "new value" stored in one of the enclosing
21 * transactions. This means that validation can be done without searching through
27 * Three different concurrency control schemes can be built according to the settings
30 * STM_UNIPROC assumes that the caller serialises invocations on the STM interface.
31 * In the Haskell RTS this means it is suitable only for non-THREADED_RTS builds.
33 * STM_CG_LOCK uses coarse-grained locking -- a single 'stm lock' is acquired during
34 * an invocation on the STM interface. Note that this does not mean that
35 * transactions are simply serialized -- the lock is only held *within* the
36 * implementation of stmCommitTransaction, stmWait etc.
38 * STM_FG_LOCKS uses fine-grained locking -- locking is done on a per-TVar basis
39 * and, when committing a transaction, no locks are acquired for TVars that have
40 * been read but not updated.
42 * Concurrency control is implemented in the functions:
46 * lock_tvar / cond_lock_tvar
49 * The choice between STM_UNIPROC / STM_CG_LOCK / STM_FG_LOCKS affects the
50 * implementation of these functions.
52 * lock_stm & unlock_stm are straightforward : they acquire a simple spin-lock
53 * using STM_CG_LOCK, and otherwise they are no-ops.
55 * lock_tvar / cond_lock_tvar and unlock_tvar are more complex because they
56 * have other effects (present in STM_UNIPROC and STM_CG_LOCK builds) as well
57 * as the actual business of maniupultaing a lock (present only in STM_FG_LOCKS
58 * builds). This is because locking a TVar is implemented by writing the lock
59 * holder's TRec into the TVar's current_value field:
61 * lock_tvar - lock a specified TVar (STM_FG_LOCKS only), returning the value
64 * cond_lock_tvar - lock a specified TVar (STM_FG_LOCKS only) if it
65 * contains a specified value. Return TRUE if this succeeds,
68 * unlock_tvar - release the lock on a specified TVar (STM_FG_LOCKS only),
69 * storing a specified value in place of the lock entry.
71 * Using these operations, the typcial pattern of a commit/validate/wait operation
72 * is to (a) lock the STM, (b) lock all the TVars being updated, (c) check that
73 * the TVars that were only read from still contain their expected values,
74 * (d) release the locks on the TVars, writing updates to them in the case of a
75 * commit, (e) unlock the STM.
77 * Queues of waiting threads hang off the first_watch_queue_entry
78 * field of each TVar. This may only be manipulated when holding that
79 * TVar's lock. In particular, when a thread is putting itself to
80 * sleep, it mustn't release the TVar's lock until it has added itself
81 * to the wait queue and marked its TSO as BlockedOnSTM -- this makes
82 * sure that other threads will know to wake it.
84 * ---------------------------------------------------------------------------*/
86 #include "PosixSource.h"
100 // ACQ_ASSERT is used for assertions which are only required for
101 // THREADED_RTS builds with fine-grained locking.
103 #if defined(STM_FG_LOCKS)
104 #define ACQ_ASSERT(_X) ASSERT(_X)
105 #define NACQ_ASSERT(_X) /*Nothing*/
107 #define ACQ_ASSERT(_X) /*Nothing*/
108 #define NACQ_ASSERT(_X) ASSERT(_X)
111 /*......................................................................*/
113 // If SHAKE is defined then validation will sometime spuriously fail. They helps test
114 // unusualy code paths if genuine contention is rare
116 #define TRACE(_x...) debugTrace(DEBUG_stm, "STM: " _x)
119 static const int do_shake = TRUE;
121 static const int do_shake = FALSE;
123 static int shake_ctr = 0;
124 static int shake_lim = 1;
126 static int shake(void) {
128 if (((shake_ctr++) % shake_lim) == 0) {
139 /*......................................................................*/
141 // Helper macros for iterating over entries within a transaction
144 #define FOR_EACH_ENTRY(_t,_x,CODE) do { \
145 StgTRecHeader *__t = (_t); \
146 StgTRecChunk *__c = __t -> current_chunk; \
147 StgWord __limit = __c -> next_entry_idx; \
148 TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%ld", __t, __c, __limit); \
149 while (__c != END_STM_CHUNK_LIST) { \
151 for (__i = 0; __i < __limit; __i ++) { \
152 TRecEntry *_x = &(__c -> entries[__i]); \
153 do { CODE } while (0); \
155 __c = __c -> prev_chunk; \
156 __limit = TREC_CHUNK_NUM_ENTRIES; \
159 if (FALSE) goto exit_for_each; \
162 #define BREAK_FOR_EACH goto exit_for_each
164 /*......................................................................*/
166 // if REUSE_MEMORY is defined then attempt to re-use descriptors, log chunks,
167 // and wait queue entries without GC
171 /*......................................................................*/
173 #define IF_STM_UNIPROC(__X) do { } while (0)
174 #define IF_STM_CG_LOCK(__X) do { } while (0)
175 #define IF_STM_FG_LOCKS(__X) do { } while (0)
177 #if defined(STM_UNIPROC)
178 #undef IF_STM_UNIPROC
179 #define IF_STM_UNIPROC(__X) do { __X } while (0)
180 static const StgBool config_use_read_phase = FALSE;
182 static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
183 TRACE("%p : lock_stm()", trec);
186 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
187 TRACE("%p : unlock_stm()", trec);
190 static StgClosure *lock_tvar(StgTRecHeader *trec STG_UNUSED,
191 StgTVar *s STG_UNUSED) {
193 TRACE("%p : lock_tvar(%p)", trec, s);
194 result = s -> current_value;
198 static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
199 StgTVar *s STG_UNUSED,
201 StgBool force_update) {
202 TRACE("%p : unlock_tvar(%p)", trec, s);
204 s -> current_value = c;
208 static StgBool cond_lock_tvar(StgTRecHeader *trec STG_UNUSED,
209 StgTVar *s STG_UNUSED,
210 StgClosure *expected) {
212 TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
213 result = s -> current_value;
214 TRACE("%p : %s", trec, (result == expected) ? "success" : "failure");
215 return (result == expected);
218 static StgBool lock_inv(StgAtomicInvariant *inv STG_UNUSED) {
219 // Nothing -- uniproc
223 static void unlock_inv(StgAtomicInvariant *inv STG_UNUSED) {
224 // Nothing -- uniproc
228 #if defined(STM_CG_LOCK) /*........................................*/
230 #undef IF_STM_CG_LOCK
231 #define IF_STM_CG_LOCK(__X) do { __X } while (0)
232 static const StgBool config_use_read_phase = FALSE;
233 static volatile StgTRecHeader *smp_locked = NULL;
235 static void lock_stm(StgTRecHeader *trec) {
236 while (cas(&smp_locked, NULL, trec) != NULL) { }
237 TRACE("%p : lock_stm()", trec);
240 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
241 TRACE("%p : unlock_stm()", trec);
242 ASSERT (smp_locked == trec);
246 static StgClosure *lock_tvar(StgTRecHeader *trec STG_UNUSED,
247 StgTVar *s STG_UNUSED) {
249 TRACE("%p : lock_tvar(%p)", trec, s);
250 ASSERT (smp_locked == trec);
251 result = s -> current_value;
255 static void *unlock_tvar(StgTRecHeader *trec STG_UNUSED,
256 StgTVar *s STG_UNUSED,
258 StgBool force_update) {
259 TRACE("%p : unlock_tvar(%p, %p)", trec, s, c);
260 ASSERT (smp_locked == trec);
262 s -> current_value = c;
266 static StgBool cond_lock_tvar(StgTRecHeader *trec STG_UNUSED,
267 StgTVar *s STG_UNUSED,
268 StgClosure *expected) {
270 TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
271 ASSERT (smp_locked == trec);
272 result = s -> current_value;
273 TRACE("%p : %d", result ? "success" : "failure");
274 return (result == expected);
277 static StgBool lock_inv(StgAtomicInvariant *inv STG_UNUSED) {
278 // Nothing -- protected by STM lock
282 static void unlock_inv(StgAtomicInvariant *inv STG_UNUSED) {
283 // Nothing -- protected by STM lock
287 #if defined(STM_FG_LOCKS) /*...................................*/
289 #undef IF_STM_FG_LOCKS
290 #define IF_STM_FG_LOCKS(__X) do { __X } while (0)
291 static const StgBool config_use_read_phase = TRUE;
293 static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
294 TRACE("%p : lock_stm()", trec);
297 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
298 TRACE("%p : unlock_stm()", trec);
301 static StgClosure *lock_tvar(StgTRecHeader *trec,
302 StgTVar *s STG_UNUSED) {
304 TRACE("%p : lock_tvar(%p)", trec, s);
307 result = s -> current_value;
308 } while (GET_INFO(UNTAG_CLOSURE(result)) == &stg_TREC_HEADER_info);
309 } while (cas((void *)&(s -> current_value),
310 (StgWord)result, (StgWord)trec) != (StgWord)result);
314 static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
317 StgBool force_update STG_UNUSED) {
318 TRACE("%p : unlock_tvar(%p, %p)", trec, s, c);
319 ASSERT(s -> current_value == (StgClosure *)trec);
320 s -> current_value = c;
323 static StgBool cond_lock_tvar(StgTRecHeader *trec,
325 StgClosure *expected) {
328 TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
329 w = cas((void *)&(s -> current_value), (StgWord)expected, (StgWord)trec);
330 result = (StgClosure *)w;
331 TRACE("%p : %s", trec, result ? "success" : "failure");
332 return (result == expected);
335 static StgBool lock_inv(StgAtomicInvariant *inv) {
336 return (cas(&(inv -> lock), 0, 1) == 0);
339 static void unlock_inv(StgAtomicInvariant *inv) {
340 ASSERT(inv -> lock == 1);
345 /*......................................................................*/
347 static StgBool watcher_is_tso(StgTVarWatchQueue *q) {
348 StgClosure *c = q -> closure;
349 StgInfoTable *info = get_itbl(c);
350 return (info -> type) == TSO;
353 static StgBool watcher_is_invariant(StgTVarWatchQueue *q) {
354 StgClosure *c = q -> closure;
355 StgInfoTable *info = get_itbl(c);
356 return (info -> type) == ATOMIC_INVARIANT;
359 /*......................................................................*/
361 // Helper functions for thread blocking and unblocking
363 static void park_tso(StgTSO *tso) {
364 ASSERT(tso -> why_blocked == NotBlocked);
365 tso -> why_blocked = BlockedOnSTM;
366 tso -> block_info.closure = (StgClosure *) END_TSO_QUEUE;
367 TRACE("park_tso on tso=%p", tso);
370 static void unpark_tso(Capability *cap, StgTSO *tso) {
371 // We will continue unparking threads while they remain on one of the wait
372 // queues: it's up to the thread itself to remove it from the wait queues
373 // if it decides to do so when it is scheduled.
375 // Unblocking a TSO from BlockedOnSTM is done under the TSO lock,
376 // to avoid multiple CPUs unblocking the same TSO, and also to
377 // synchronise with throwTo().
379 if (tso -> why_blocked == BlockedOnSTM) {
380 TRACE("unpark_tso on tso=%p", tso);
383 TRACE("spurious unpark_tso on tso=%p", tso);
388 static void unpark_waiters_on(Capability *cap, StgTVar *s) {
389 StgTVarWatchQueue *q;
390 StgTVarWatchQueue *trail;
391 TRACE("unpark_waiters_on tvar=%p", s);
392 // unblock TSOs in reverse order, to be a bit fairer (#2319)
393 for (q = s -> first_watch_queue_entry, trail = q;
394 q != END_STM_WATCH_QUEUE;
395 q = q -> next_queue_entry) {
400 q != END_STM_WATCH_QUEUE;
401 q = q -> prev_queue_entry) {
402 if (watcher_is_tso(q)) {
403 unpark_tso(cap, (StgTSO *)(q -> closure));
408 /*......................................................................*/
410 // Helper functions for downstream allocation and initialization
412 static StgInvariantCheckQueue *new_stg_invariant_check_queue(Capability *cap,
413 StgAtomicInvariant *invariant) {
414 StgInvariantCheckQueue *result;
415 result = (StgInvariantCheckQueue *)allocateLocal(cap, sizeofW(StgInvariantCheckQueue));
416 SET_HDR (result, &stg_INVARIANT_CHECK_QUEUE_info, CCS_SYSTEM);
417 result -> invariant = invariant;
418 result -> my_execution = NO_TREC;
422 static StgTVarWatchQueue *new_stg_tvar_watch_queue(Capability *cap,
423 StgClosure *closure) {
424 StgTVarWatchQueue *result;
425 result = (StgTVarWatchQueue *)allocateLocal(cap, sizeofW(StgTVarWatchQueue));
426 SET_HDR (result, &stg_TVAR_WATCH_QUEUE_info, CCS_SYSTEM);
427 result -> closure = closure;
431 static StgTRecChunk *new_stg_trec_chunk(Capability *cap) {
432 StgTRecChunk *result;
433 result = (StgTRecChunk *)allocateLocal(cap, sizeofW(StgTRecChunk));
434 SET_HDR (result, &stg_TREC_CHUNK_info, CCS_SYSTEM);
435 result -> prev_chunk = END_STM_CHUNK_LIST;
436 result -> next_entry_idx = 0;
440 static StgTRecHeader *new_stg_trec_header(Capability *cap,
441 StgTRecHeader *enclosing_trec) {
442 StgTRecHeader *result;
443 result = (StgTRecHeader *) allocateLocal(cap, sizeofW(StgTRecHeader));
444 SET_HDR (result, &stg_TREC_HEADER_info, CCS_SYSTEM);
446 result -> enclosing_trec = enclosing_trec;
447 result -> current_chunk = new_stg_trec_chunk(cap);
448 result -> invariants_to_check = END_INVARIANT_CHECK_QUEUE;
450 if (enclosing_trec == NO_TREC) {
451 result -> state = TREC_ACTIVE;
453 ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
454 enclosing_trec -> state == TREC_CONDEMNED);
455 result -> state = enclosing_trec -> state;
461 /*......................................................................*/
463 // Allocation / deallocation functions that retain per-capability lists
464 // of closures that can be re-used
466 static StgInvariantCheckQueue *alloc_stg_invariant_check_queue(Capability *cap,
467 StgAtomicInvariant *invariant) {
468 StgInvariantCheckQueue *result = NULL;
469 if (cap -> free_invariant_check_queues == END_INVARIANT_CHECK_QUEUE) {
470 result = new_stg_invariant_check_queue(cap, invariant);
472 result = cap -> free_invariant_check_queues;
473 result -> invariant = invariant;
474 result -> my_execution = NO_TREC;
475 cap -> free_invariant_check_queues = result -> next_queue_entry;
480 static StgTVarWatchQueue *alloc_stg_tvar_watch_queue(Capability *cap,
481 StgClosure *closure) {
482 StgTVarWatchQueue *result = NULL;
483 if (cap -> free_tvar_watch_queues == END_STM_WATCH_QUEUE) {
484 result = new_stg_tvar_watch_queue(cap, closure);
486 result = cap -> free_tvar_watch_queues;
487 result -> closure = closure;
488 cap -> free_tvar_watch_queues = result -> next_queue_entry;
493 static void free_stg_tvar_watch_queue(Capability *cap,
494 StgTVarWatchQueue *wq) {
495 #if defined(REUSE_MEMORY)
496 wq -> next_queue_entry = cap -> free_tvar_watch_queues;
497 cap -> free_tvar_watch_queues = wq;
501 static StgTRecChunk *alloc_stg_trec_chunk(Capability *cap) {
502 StgTRecChunk *result = NULL;
503 if (cap -> free_trec_chunks == END_STM_CHUNK_LIST) {
504 result = new_stg_trec_chunk(cap);
506 result = cap -> free_trec_chunks;
507 cap -> free_trec_chunks = result -> prev_chunk;
508 result -> prev_chunk = END_STM_CHUNK_LIST;
509 result -> next_entry_idx = 0;
514 static void free_stg_trec_chunk(Capability *cap,
516 #if defined(REUSE_MEMORY)
517 c -> prev_chunk = cap -> free_trec_chunks;
518 cap -> free_trec_chunks = c;
522 static StgTRecHeader *alloc_stg_trec_header(Capability *cap,
523 StgTRecHeader *enclosing_trec) {
524 StgTRecHeader *result = NULL;
525 if (cap -> free_trec_headers == NO_TREC) {
526 result = new_stg_trec_header(cap, enclosing_trec);
528 result = cap -> free_trec_headers;
529 cap -> free_trec_headers = result -> enclosing_trec;
530 result -> enclosing_trec = enclosing_trec;
531 result -> current_chunk -> next_entry_idx = 0;
532 result -> invariants_to_check = END_INVARIANT_CHECK_QUEUE;
533 if (enclosing_trec == NO_TREC) {
534 result -> state = TREC_ACTIVE;
536 ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
537 enclosing_trec -> state == TREC_CONDEMNED);
538 result -> state = enclosing_trec -> state;
544 static void free_stg_trec_header(Capability *cap,
545 StgTRecHeader *trec) {
546 #if defined(REUSE_MEMORY)
547 StgTRecChunk *chunk = trec -> current_chunk -> prev_chunk;
548 while (chunk != END_STM_CHUNK_LIST) {
549 StgTRecChunk *prev_chunk = chunk -> prev_chunk;
550 free_stg_trec_chunk(cap, chunk);
553 trec -> current_chunk -> prev_chunk = END_STM_CHUNK_LIST;
554 trec -> enclosing_trec = cap -> free_trec_headers;
555 cap -> free_trec_headers = trec;
559 /*......................................................................*/
561 // Helper functions for managing waiting lists
563 static void build_watch_queue_entries_for_trec(Capability *cap,
565 StgTRecHeader *trec) {
566 ASSERT(trec != NO_TREC);
567 ASSERT(trec -> enclosing_trec == NO_TREC);
568 ASSERT(trec -> state == TREC_ACTIVE);
570 TRACE("%p : build_watch_queue_entries_for_trec()", trec);
572 FOR_EACH_ENTRY(trec, e, {
574 StgTVarWatchQueue *q;
575 StgTVarWatchQueue *fq;
577 TRACE("%p : adding tso=%p to watch queue for tvar=%p", trec, tso, s);
578 ACQ_ASSERT(s -> current_value == (StgClosure *)trec);
579 NACQ_ASSERT(s -> current_value == e -> expected_value);
580 fq = s -> first_watch_queue_entry;
581 q = alloc_stg_tvar_watch_queue(cap, (StgClosure*) tso);
582 q -> next_queue_entry = fq;
583 q -> prev_queue_entry = END_STM_WATCH_QUEUE;
584 if (fq != END_STM_WATCH_QUEUE) {
585 fq -> prev_queue_entry = q;
587 s -> first_watch_queue_entry = q;
588 e -> new_value = (StgClosure *) q;
592 static void remove_watch_queue_entries_for_trec(Capability *cap,
593 StgTRecHeader *trec) {
594 ASSERT(trec != NO_TREC);
595 ASSERT(trec -> enclosing_trec == NO_TREC);
596 ASSERT(trec -> state == TREC_WAITING ||
597 trec -> state == TREC_CONDEMNED);
599 TRACE("%p : remove_watch_queue_entries_for_trec()", trec);
601 FOR_EACH_ENTRY(trec, e, {
603 StgTVarWatchQueue *pq;
604 StgTVarWatchQueue *nq;
605 StgTVarWatchQueue *q;
608 saw = lock_tvar(trec, s);
609 q = (StgTVarWatchQueue *) (e -> new_value);
610 TRACE("%p : removing tso=%p from watch queue for tvar=%p",
614 ACQ_ASSERT(s -> current_value == (StgClosure *)trec);
615 nq = q -> next_queue_entry;
616 pq = q -> prev_queue_entry;
617 if (nq != END_STM_WATCH_QUEUE) {
618 nq -> prev_queue_entry = pq;
620 if (pq != END_STM_WATCH_QUEUE) {
621 pq -> next_queue_entry = nq;
623 ASSERT (s -> first_watch_queue_entry == q);
624 s -> first_watch_queue_entry = nq;
626 free_stg_tvar_watch_queue(cap, q);
627 unlock_tvar(trec, s, saw, FALSE);
631 /*......................................................................*/
633 static TRecEntry *get_new_entry(Capability *cap,
639 c = t -> current_chunk;
640 i = c -> next_entry_idx;
641 ASSERT(c != END_STM_CHUNK_LIST);
643 if (i < TREC_CHUNK_NUM_ENTRIES) {
644 // Continue to use current chunk
645 result = &(c -> entries[i]);
646 c -> next_entry_idx ++;
648 // Current chunk is full: allocate a fresh one
650 nc = alloc_stg_trec_chunk(cap);
651 nc -> prev_chunk = c;
652 nc -> next_entry_idx = 1;
653 t -> current_chunk = nc;
654 result = &(nc -> entries[0]);
660 /*......................................................................*/
662 static void merge_update_into(Capability *cap,
665 StgClosure *expected_value,
666 StgClosure *new_value) {
669 // Look for an entry in this trec
671 FOR_EACH_ENTRY(t, e, {
676 if (e -> expected_value != expected_value) {
677 // Must abort if the two entries start from different values
678 TRACE("%p : update entries inconsistent at %p (%p vs %p)",
679 t, tvar, e -> expected_value, expected_value);
680 t -> state = TREC_CONDEMNED;
682 e -> new_value = new_value;
688 // No entry so far in this trec
690 ne = get_new_entry(cap, t);
692 ne -> expected_value = expected_value;
693 ne -> new_value = new_value;
697 /*......................................................................*/
699 static void merge_read_into(Capability *cap,
702 StgClosure *expected_value) {
705 // Look for an entry in this trec
707 FOR_EACH_ENTRY(t, e, {
712 if (e -> expected_value != expected_value) {
713 // Must abort if the two entries start from different values
714 TRACE("%p : read entries inconsistent at %p (%p vs %p)",
715 t, tvar, e -> expected_value, expected_value);
716 t -> state = TREC_CONDEMNED;
723 // No entry so far in this trec
725 ne = get_new_entry(cap, t);
727 ne -> expected_value = expected_value;
728 ne -> new_value = expected_value;
732 /*......................................................................*/
734 static StgBool entry_is_update(TRecEntry *e) {
736 result = (e -> expected_value != e -> new_value);
740 #if defined(STM_FG_LOCKS)
741 static StgBool entry_is_read_only(TRecEntry *e) {
743 result = (e -> expected_value == e -> new_value);
747 static StgBool tvar_is_locked(StgTVar *s, StgTRecHeader *h) {
750 c = s -> current_value;
751 result = (c == (StgClosure *) h);
756 // revert_ownership : release a lock on a TVar, storing back
757 // the value that it held when the lock was acquired. "revert_all"
758 // is set in stmWait and stmReWait when we acquired locks on all of
759 // the TVars involved. "revert_all" is not set in commit operations
760 // where we don't lock TVars that have been read from but not updated.
762 static void revert_ownership(StgTRecHeader *trec STG_UNUSED,
763 StgBool revert_all STG_UNUSED) {
764 #if defined(STM_FG_LOCKS)
765 FOR_EACH_ENTRY(trec, e, {
766 if (revert_all || entry_is_update(e)) {
769 if (tvar_is_locked(s, trec)) {
770 unlock_tvar(trec, s, e -> expected_value, TRUE);
777 /*......................................................................*/
779 // validate_and_acquire_ownership : this performs the twin functions
780 // of checking that the TVars referred to by entries in trec hold the
781 // expected values and:
783 // - locking the TVar (on updated TVars during commit, or all TVars
786 // - recording the identity of the TRec who wrote the value seen in the
787 // TVar (on non-updated TVars during commit). These values are
788 // stashed in the TRec entries and are then checked in check_read_only
789 // to ensure that an atomic snapshot of all of these locations has been
792 static StgBool validate_and_acquire_ownership (StgTRecHeader *trec,
794 int retain_ownership) {
798 TRACE("%p : shake, pretending trec is invalid when it may not be", trec);
802 ASSERT ((trec -> state == TREC_ACTIVE) ||
803 (trec -> state == TREC_WAITING) ||
804 (trec -> state == TREC_CONDEMNED));
805 result = !((trec -> state) == TREC_CONDEMNED);
807 FOR_EACH_ENTRY(trec, e, {
810 if (acquire_all || entry_is_update(e)) {
811 TRACE("%p : trying to acquire %p", trec, s);
812 if (!cond_lock_tvar(trec, s, e -> expected_value)) {
813 TRACE("%p : failed to acquire %p", trec, s);
818 ASSERT(config_use_read_phase);
820 TRACE("%p : will need to check %p", trec, s);
821 if (s -> current_value != e -> expected_value) {
822 TRACE("%p : doesn't match", trec);
826 e -> num_updates = s -> num_updates;
827 if (s -> current_value != e -> expected_value) {
828 TRACE("%p : doesn't match (race)", trec);
832 TRACE("%p : need to check version %ld", trec, e -> num_updates);
839 if ((!result) || (!retain_ownership)) {
840 revert_ownership(trec, acquire_all);
846 // check_read_only : check that we've seen an atomic snapshot of the
847 // non-updated TVars accessed by a trec. This checks that the last TRec to
848 // commit an update to the TVar is unchanged since the value was stashed in
849 // validate_and_acquire_ownership. If no udpate is seen to any TVar than
850 // all of them contained their expected values at the start of the call to
853 // The paper "Concurrent programming without locks" (under submission), or
854 // Keir Fraser's PhD dissertation "Practical lock-free programming" discuss
855 // this kind of algorithm.
857 static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
858 StgBool result = TRUE;
860 ASSERT (config_use_read_phase);
862 FOR_EACH_ENTRY(trec, e, {
865 if (entry_is_read_only(e)) {
866 TRACE("%p : check_read_only for TVar %p, saw %ld", trec, s, e -> num_updates);
867 if (s -> num_updates != e -> num_updates) {
868 // ||s -> current_value != e -> expected_value) {
869 TRACE("%p : mismatch", trec);
881 /************************************************************************/
883 void stmPreGCHook() {
887 TRACE("stmPreGCHook");
888 for (i = 0; i < n_capabilities; i ++) {
889 Capability *cap = &capabilities[i];
890 cap -> free_tvar_watch_queues = END_STM_WATCH_QUEUE;
891 cap -> free_trec_chunks = END_STM_CHUNK_LIST;
892 cap -> free_trec_headers = NO_TREC;
897 /************************************************************************/
899 // check_read_only relies on version numbers held in TVars' "num_updates"
900 // fields not wrapping around while a transaction is committed. The version
901 // number is incremented each time an update is committed to the TVar
902 // This is unlikely to wrap around when 32-bit integers are used for the counts,
903 // but to ensure correctness we maintain a shared count on the maximum
904 // number of commit operations that may occur and check that this has
905 // not increased by more than 2^32 during a commit.
907 #define TOKEN_BATCH_SIZE 1024
909 static volatile StgInt64 max_commits = 0;
911 #if defined(THREADED_RTS)
912 static volatile StgBool token_locked = FALSE;
914 static void getTokenBatch(Capability *cap) {
915 while (cas((void *)&token_locked, FALSE, TRUE) == TRUE) { /* nothing */ }
916 max_commits += TOKEN_BATCH_SIZE;
917 TRACE("%p : cap got token batch, max_commits=%" FMT_Int64, cap, max_commits);
918 cap -> transaction_tokens = TOKEN_BATCH_SIZE;
919 token_locked = FALSE;
922 static void getToken(Capability *cap) {
923 if (cap -> transaction_tokens == 0) {
926 cap -> transaction_tokens --;
929 static void getToken(Capability *cap STG_UNUSED) {
934 /*......................................................................*/
936 StgTRecHeader *stmStartTransaction(Capability *cap,
937 StgTRecHeader *outer) {
939 TRACE("%p : stmStartTransaction with %d tokens",
941 cap -> transaction_tokens);
945 t = alloc_stg_trec_header(cap, outer);
946 TRACE("%p : stmStartTransaction()=%p", outer, t);
950 /*......................................................................*/
952 void stmAbortTransaction(Capability *cap,
953 StgTRecHeader *trec) {
955 TRACE("%p : stmAbortTransaction", trec);
956 ASSERT (trec != NO_TREC);
957 ASSERT ((trec -> state == TREC_ACTIVE) ||
958 (trec -> state == TREC_WAITING) ||
959 (trec -> state == TREC_CONDEMNED));
963 et = trec -> enclosing_trec;
965 // We're a top-level transaction: remove any watch queue entries that
967 TRACE("%p : aborting top-level transaction", trec);
969 if (trec -> state == TREC_WAITING) {
970 ASSERT (trec -> enclosing_trec == NO_TREC);
971 TRACE("%p : stmAbortTransaction aborting waiting transaction", trec);
972 remove_watch_queue_entries_for_trec(cap, trec);
976 // We're a nested transaction: merge our read set into our parent's
977 TRACE("%p : retaining read-set into parent %p", trec, et);
979 FOR_EACH_ENTRY(trec, e, {
980 StgTVar *s = e -> tvar;
981 merge_read_into(cap, et, s, e -> expected_value);
985 trec -> state = TREC_ABORTED;
988 TRACE("%p : stmAbortTransaction done", trec);
991 /*......................................................................*/
993 void stmFreeAbortedTRec(Capability *cap,
994 StgTRecHeader *trec) {
995 TRACE("%p : stmFreeAbortedTRec", trec);
996 ASSERT (trec != NO_TREC);
997 ASSERT ((trec -> state == TREC_CONDEMNED) ||
998 (trec -> state == TREC_ABORTED));
1000 free_stg_trec_header(cap, trec);
1002 TRACE("%p : stmFreeAbortedTRec done", trec);
1005 /*......................................................................*/
1007 void stmCondemnTransaction(Capability *cap,
1008 StgTRecHeader *trec) {
1009 TRACE("%p : stmCondemnTransaction", trec);
1010 ASSERT (trec != NO_TREC);
1011 ASSERT ((trec -> state == TREC_ACTIVE) ||
1012 (trec -> state == TREC_WAITING) ||
1013 (trec -> state == TREC_CONDEMNED));
1016 if (trec -> state == TREC_WAITING) {
1017 ASSERT (trec -> enclosing_trec == NO_TREC);
1018 TRACE("%p : stmCondemnTransaction condemning waiting transaction", trec);
1019 remove_watch_queue_entries_for_trec(cap, trec);
1021 trec -> state = TREC_CONDEMNED;
1024 TRACE("%p : stmCondemnTransaction done", trec);
1027 /*......................................................................*/
1029 StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec) {
1030 StgTRecHeader *outer;
1031 TRACE("%p : stmGetEnclosingTRec", trec);
1032 outer = trec -> enclosing_trec;
1033 TRACE("%p : stmGetEnclosingTRec()=%p", trec, outer);
1037 /*......................................................................*/
1039 StgBool stmValidateNestOfTransactions(StgTRecHeader *trec) {
1043 TRACE("%p : stmValidateNestOfTransactions", trec);
1044 ASSERT(trec != NO_TREC);
1045 ASSERT((trec -> state == TREC_ACTIVE) ||
1046 (trec -> state == TREC_WAITING) ||
1047 (trec -> state == TREC_CONDEMNED));
1053 while (t != NO_TREC) {
1054 result &= validate_and_acquire_ownership(t, TRUE, FALSE);
1055 t = t -> enclosing_trec;
1058 if (!result && trec -> state != TREC_WAITING) {
1059 trec -> state = TREC_CONDEMNED;
1064 TRACE("%p : stmValidateNestOfTransactions()=%d", trec, result);
1068 /*......................................................................*/
1070 static TRecEntry *get_entry_for(StgTRecHeader *trec, StgTVar *tvar, StgTRecHeader **in) {
1071 TRecEntry *result = NULL;
1073 TRACE("%p : get_entry_for TVar %p", trec, tvar);
1074 ASSERT(trec != NO_TREC);
1077 FOR_EACH_ENTRY(trec, e, {
1078 if (e -> tvar == tvar) {
1086 trec = trec -> enclosing_trec;
1087 } while (result == NULL && trec != NO_TREC);
1092 /*......................................................................*/
1095 * Add/remove links between an invariant TVars. The caller must have
1096 * locked the TVars involved and the invariant.
1099 static void disconnect_invariant(Capability *cap,
1100 StgAtomicInvariant *inv) {
1101 StgTRecHeader *last_execution = inv -> last_execution;
1103 TRACE("unhooking last execution inv=%p trec=%p", inv, last_execution);
1105 FOR_EACH_ENTRY(last_execution, e, {
1106 StgTVar *s = e -> tvar;
1107 StgTVarWatchQueue *q = s -> first_watch_queue_entry;
1108 StgBool found = FALSE;
1109 TRACE(" looking for trec on tvar=%p", s);
1110 for (q = s -> first_watch_queue_entry;
1111 q != END_STM_WATCH_QUEUE;
1112 q = q -> next_queue_entry) {
1113 if (q -> closure == (StgClosure*)inv) {
1114 StgTVarWatchQueue *pq;
1115 StgTVarWatchQueue *nq;
1116 nq = q -> next_queue_entry;
1117 pq = q -> prev_queue_entry;
1118 if (nq != END_STM_WATCH_QUEUE) {
1119 nq -> prev_queue_entry = pq;
1121 if (pq != END_STM_WATCH_QUEUE) {
1122 pq -> next_queue_entry = nq;
1124 ASSERT (s -> first_watch_queue_entry == q);
1125 s -> first_watch_queue_entry = nq;
1127 TRACE(" found it in watch queue entry %p", q);
1128 free_stg_tvar_watch_queue(cap, q);
1135 inv -> last_execution = NO_TREC;
1138 static void connect_invariant_to_trec(Capability *cap,
1139 StgAtomicInvariant *inv,
1140 StgTRecHeader *my_execution) {
1141 TRACE("connecting execution inv=%p trec=%p", inv, my_execution);
1143 ASSERT(inv -> last_execution == NO_TREC);
1145 FOR_EACH_ENTRY(my_execution, e, {
1146 StgTVar *s = e -> tvar;
1147 StgTVarWatchQueue *q = alloc_stg_tvar_watch_queue(cap, (StgClosure*)inv);
1148 StgTVarWatchQueue *fq = s -> first_watch_queue_entry;
1150 // We leave "last_execution" holding the values that will be
1151 // in the heap after the transaction we're in the process
1152 // of committing has finished.
1153 TRecEntry *entry = get_entry_for(my_execution -> enclosing_trec, s, NULL);
1154 if (entry != NULL) {
1155 e -> expected_value = entry -> new_value;
1156 e -> new_value = entry -> new_value;
1159 TRACE(" linking trec on tvar=%p value=%p q=%p", s, e -> expected_value, q);
1160 q -> next_queue_entry = fq;
1161 q -> prev_queue_entry = END_STM_WATCH_QUEUE;
1162 if (fq != END_STM_WATCH_QUEUE) {
1163 fq -> prev_queue_entry = q;
1165 s -> first_watch_queue_entry = q;
1168 inv -> last_execution = my_execution;
1172 * Add a new invariant to the trec's list of invariants to check on commit
1174 void stmAddInvariantToCheck(Capability *cap,
1175 StgTRecHeader *trec,
1177 StgAtomicInvariant *invariant;
1178 StgInvariantCheckQueue *q;
1179 TRACE("%p : stmAddInvariantToCheck closure=%p", trec, code);
1180 ASSERT(trec != NO_TREC);
1181 ASSERT(trec -> state == TREC_ACTIVE ||
1182 trec -> state == TREC_CONDEMNED);
1185 // 1. Allocate an StgAtomicInvariant, set last_execution to NO_TREC
1186 // to signal that this is a new invariant in the current atomic block
1188 invariant = (StgAtomicInvariant *) allocateLocal(cap, sizeofW(StgAtomicInvariant));
1189 TRACE("%p : stmAddInvariantToCheck allocated invariant=%p", trec, invariant);
1190 SET_HDR (invariant, &stg_ATOMIC_INVARIANT_info, CCS_SYSTEM);
1191 invariant -> code = code;
1192 invariant -> last_execution = NO_TREC;
1194 // 2. Allocate an StgInvariantCheckQueue entry, link it to the current trec
1196 q = alloc_stg_invariant_check_queue(cap, invariant);
1197 TRACE("%p : stmAddInvariantToCheck allocated q=%p", trec, q);
1198 q -> invariant = invariant;
1199 q -> my_execution = NO_TREC;
1200 q -> next_queue_entry = trec -> invariants_to_check;
1201 trec -> invariants_to_check = q;
1203 TRACE("%p : stmAddInvariantToCheck done", trec);
1207 * Fill in the trec's list of invariants that might be violated by the
1208 * current transaction.
1211 StgInvariantCheckQueue *stmGetInvariantsToCheck(Capability *cap, StgTRecHeader *trec) {
1213 TRACE("%p : stmGetInvariantsToCheck, head was %p",
1215 trec -> invariants_to_check);
1217 ASSERT(trec != NO_TREC);
1218 ASSERT ((trec -> state == TREC_ACTIVE) ||
1219 (trec -> state == TREC_WAITING) ||
1220 (trec -> state == TREC_CONDEMNED));
1221 ASSERT(trec -> enclosing_trec == NO_TREC);
1224 c = trec -> current_chunk;
1225 while (c != END_STM_CHUNK_LIST) {
1227 for (i = 0; i < c -> next_entry_idx; i ++) {
1228 TRecEntry *e = &(c -> entries[i]);
1229 if (entry_is_update(e)) {
1230 StgTVar *s = e -> tvar;
1231 StgClosure *old = lock_tvar(trec, s);
1233 // Pick up any invariants on the TVar being updated
1236 StgTVarWatchQueue *q;
1237 TRACE("%p : checking for invariants on %p", trec, s);
1238 for (q = s -> first_watch_queue_entry;
1239 q != END_STM_WATCH_QUEUE;
1240 q = q -> next_queue_entry) {
1241 if (watcher_is_invariant(q)) {
1242 StgBool found = FALSE;
1243 StgInvariantCheckQueue *q2;
1244 TRACE("%p : Touching invariant %p", trec, q -> closure);
1245 for (q2 = trec -> invariants_to_check;
1246 q2 != END_INVARIANT_CHECK_QUEUE;
1247 q2 = q2 -> next_queue_entry) {
1248 if (q2 -> invariant == (StgAtomicInvariant*)(q -> closure)) {
1249 TRACE("%p : Already found %p", trec, q -> closure);
1256 StgInvariantCheckQueue *q3;
1257 TRACE("%p : Not already found %p", trec, q -> closure);
1258 q3 = alloc_stg_invariant_check_queue(cap,
1259 (StgAtomicInvariant*) q -> closure);
1260 q3 -> next_queue_entry = trec -> invariants_to_check;
1261 trec -> invariants_to_check = q3;
1266 unlock_tvar(trec, s, old, FALSE);
1269 c = c -> prev_chunk;
1274 TRACE("%p : stmGetInvariantsToCheck, head now %p",
1276 trec -> invariants_to_check);
1278 return (trec -> invariants_to_check);
1281 /*......................................................................*/
1283 StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
1285 StgInt64 max_commits_at_start = max_commits;
1286 StgBool touched_invariants;
1287 StgBool use_read_phase;
1289 TRACE("%p : stmCommitTransaction()", trec);
1290 ASSERT (trec != NO_TREC);
1294 ASSERT (trec -> enclosing_trec == NO_TREC);
1295 ASSERT ((trec -> state == TREC_ACTIVE) ||
1296 (trec -> state == TREC_CONDEMNED));
1298 // touched_invariants is true if we've written to a TVar with invariants
1299 // attached to it, or if we're trying to add a new invariant to the system.
1301 touched_invariants = (trec -> invariants_to_check != END_INVARIANT_CHECK_QUEUE);
1303 // If we have touched invariants then (i) lock the invariant, and (ii) add
1304 // the invariant's read set to our own. Step (i) is needed to serialize
1305 // concurrent transactions that attempt to make conflicting updates
1306 // to the invariant's trec (suppose it read from t1 and t2, and that one
1307 // concurrent transcation writes only to t1, and a second writes only to
1308 // t2). Step (ii) is needed so that both transactions will lock t1 and t2
1309 // to gain access to their wait lists (and hence be able to unhook the
1310 // invariant from both tvars).
1312 if (touched_invariants) {
1313 StgInvariantCheckQueue *q = trec -> invariants_to_check;
1314 TRACE("%p : locking invariants", trec);
1315 while (q != END_INVARIANT_CHECK_QUEUE) {
1316 StgTRecHeader *inv_old_trec;
1317 StgAtomicInvariant *inv;
1318 TRACE("%p : locking invariant %p", trec, q -> invariant);
1319 inv = q -> invariant;
1320 if (!lock_inv(inv)) {
1321 TRACE("%p : failed to lock %p", trec, inv);
1322 trec -> state = TREC_CONDEMNED;
1326 inv_old_trec = inv -> last_execution;
1327 if (inv_old_trec != NO_TREC) {
1328 StgTRecChunk *c = inv_old_trec -> current_chunk;
1329 while (c != END_STM_CHUNK_LIST) {
1331 for (i = 0; i < c -> next_entry_idx; i ++) {
1332 TRecEntry *e = &(c -> entries[i]);
1333 TRACE("%p : ensuring we lock TVars for %p", trec, e -> tvar);
1334 merge_read_into (cap, trec, e -> tvar, e -> expected_value);
1336 c = c -> prev_chunk;
1339 q = q -> next_queue_entry;
1341 TRACE("%p : finished locking invariants", trec);
1344 // Use a read-phase (i.e. don't lock TVars we've read but not updated) if
1345 // (i) the configuration lets us use a read phase, and (ii) we've not
1346 // touched or introduced any invariants.
1348 // In principle we could extend the implementation to support a read-phase
1349 // and invariants, but it complicates the logic: the links between
1350 // invariants and TVars are managed by the TVar watch queues which are
1351 // protected by the TVar's locks.
1353 use_read_phase = ((config_use_read_phase) && (!touched_invariants));
1355 result = validate_and_acquire_ownership(trec, (!use_read_phase), TRUE);
1357 // We now know that all the updated locations hold their expected values.
1358 ASSERT (trec -> state == TREC_ACTIVE);
1360 if (use_read_phase) {
1361 StgInt64 max_commits_at_end;
1362 StgInt64 max_concurrent_commits;
1363 TRACE("%p : doing read check", trec);
1364 result = check_read_only(trec);
1365 TRACE("%p : read-check %s", trec, result ? "succeeded" : "failed");
1367 max_commits_at_end = max_commits;
1368 max_concurrent_commits = ((max_commits_at_end - max_commits_at_start) +
1369 (n_capabilities * TOKEN_BATCH_SIZE));
1370 if (((max_concurrent_commits >> 32) > 0) || shake()) {
1376 // We now know that all of the read-only locations held their exepcted values
1377 // at the end of the call to validate_and_acquire_ownership. This forms the
1378 // linearization point of the commit.
1380 // 1. If we have touched or introduced any invariants then unhook them
1381 // from the TVars they depended on last time they were executed
1382 // and hook them on the TVars that they now depend on.
1383 if (touched_invariants) {
1384 StgInvariantCheckQueue *q = trec -> invariants_to_check;
1385 while (q != END_INVARIANT_CHECK_QUEUE) {
1386 StgAtomicInvariant *inv = q -> invariant;
1387 if (inv -> last_execution != NO_TREC) {
1388 disconnect_invariant(cap, inv);
1391 TRACE("%p : hooking up new execution trec=%p", trec, q -> my_execution);
1392 connect_invariant_to_trec(cap, inv, q -> my_execution);
1394 TRACE("%p : unlocking invariant %p", trec, inv);
1397 q = q -> next_queue_entry;
1401 // 2. Make the updates required by the transaction
1402 FOR_EACH_ENTRY(trec, e, {
1405 if ((!use_read_phase) || (e -> new_value != e -> expected_value)) {
1406 // Either the entry is an update or we're not using a read phase:
1407 // write the value back to the TVar, unlocking it if necessary.
1409 ACQ_ASSERT(tvar_is_locked(s, trec));
1410 TRACE("%p : writing %p to %p, waking waiters", trec, e -> new_value, s);
1411 unpark_waiters_on(cap,s);
1413 s -> num_updates ++;
1415 unlock_tvar(trec, s, e -> new_value, TRUE);
1417 ACQ_ASSERT(!tvar_is_locked(s, trec));
1420 revert_ownership(trec, FALSE);
1426 free_stg_trec_header(cap, trec);
1428 TRACE("%p : stmCommitTransaction()=%d", trec, result);
1433 /*......................................................................*/
1435 StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) {
1438 ASSERT (trec != NO_TREC && trec -> enclosing_trec != NO_TREC);
1439 TRACE("%p : stmCommitNestedTransaction() into %p", trec, trec -> enclosing_trec);
1440 ASSERT ((trec -> state == TREC_ACTIVE) || (trec -> state == TREC_CONDEMNED));
1444 et = trec -> enclosing_trec;
1445 result = validate_and_acquire_ownership(trec, (!config_use_read_phase), TRUE);
1447 // We now know that all the updated locations hold their expected values.
1449 if (config_use_read_phase) {
1450 TRACE("%p : doing read check", trec);
1451 result = check_read_only(trec);
1454 // We now know that all of the read-only locations held their exepcted values
1455 // at the end of the call to validate_and_acquire_ownership. This forms the
1456 // linearization point of the commit.
1458 TRACE("%p : read-check succeeded", trec);
1459 FOR_EACH_ENTRY(trec, e, {
1460 // Merge each entry into the enclosing transaction record, release all
1465 if (entry_is_update(e)) {
1466 unlock_tvar(trec, s, e -> expected_value, FALSE);
1468 merge_update_into(cap, et, s, e -> expected_value, e -> new_value);
1469 ACQ_ASSERT(s -> current_value != (StgClosure *)trec);
1472 revert_ownership(trec, FALSE);
1478 free_stg_trec_header(cap, trec);
1480 TRACE("%p : stmCommitNestedTransaction()=%d", trec, result);
1485 /*......................................................................*/
1487 StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
1489 TRACE("%p : stmWait(%p)", trec, tso);
1490 ASSERT (trec != NO_TREC);
1491 ASSERT (trec -> enclosing_trec == NO_TREC);
1492 ASSERT ((trec -> state == TREC_ACTIVE) ||
1493 (trec -> state == TREC_CONDEMNED));
1496 result = validate_and_acquire_ownership(trec, TRUE, TRUE);
1498 // The transaction is valid so far so we can actually start waiting.
1499 // (Otherwise the transaction was not valid and the thread will have to
1502 // Put ourselves to sleep. We retain locks on all the TVars involved
1503 // until we are sound asleep : (a) on the wait queues, (b) BlockedOnSTM
1504 // in the TSO, (c) TREC_WAITING in the Trec.
1505 build_watch_queue_entries_for_trec(cap, tso, trec);
1507 trec -> state = TREC_WAITING;
1509 // We haven't released ownership of the transaction yet. The TSO
1510 // has been put on the wait queue for the TVars it is waiting for,
1511 // but we haven't yet tidied up the TSO's stack and made it safe
1512 // to wake up the TSO. Therefore, we must wait until the TSO is
1513 // safe to wake up before we release ownership - when all is well,
1514 // the runtime will call stmWaitUnlock() below, with the same
1519 free_stg_trec_header(cap, trec);
1522 TRACE("%p : stmWait(%p)=%d", trec, tso, result);
1528 stmWaitUnlock(Capability *cap STG_UNUSED, StgTRecHeader *trec) {
1529 revert_ownership(trec, TRUE);
1533 /*......................................................................*/
1535 StgBool stmReWait(Capability *cap, StgTSO *tso) {
1537 StgTRecHeader *trec = tso->trec;
1539 TRACE("%p : stmReWait", trec);
1540 ASSERT (trec != NO_TREC);
1541 ASSERT (trec -> enclosing_trec == NO_TREC);
1542 ASSERT ((trec -> state == TREC_WAITING) ||
1543 (trec -> state == TREC_CONDEMNED));
1546 result = validate_and_acquire_ownership(trec, TRUE, TRUE);
1547 TRACE("%p : validation %s", trec, result ? "succeeded" : "failed");
1549 // The transaction remains valid -- do nothing because it is already on
1551 ASSERT (trec -> state == TREC_WAITING);
1553 revert_ownership(trec, TRUE);
1555 // The transcation has become invalid. We can now remove it from the wait
1557 if (trec -> state != TREC_CONDEMNED) {
1558 remove_watch_queue_entries_for_trec (cap, trec);
1560 free_stg_trec_header(cap, trec);
1564 TRACE("%p : stmReWait()=%d", trec, result);
1568 /*......................................................................*/
1570 static StgClosure *read_current_value(StgTRecHeader *trec STG_UNUSED, StgTVar *tvar) {
1572 result = tvar -> current_value;
1574 #if defined(STM_FG_LOCKS)
1575 while (GET_INFO(UNTAG_CLOSURE(result)) == &stg_TREC_HEADER_info) {
1576 TRACE("%p : read_current_value(%p) saw %p", trec, tvar, result);
1577 result = tvar -> current_value;
1581 TRACE("%p : read_current_value(%p)=%p", trec, tvar, result);
1585 /*......................................................................*/
1587 StgClosure *stmReadTVar(Capability *cap,
1588 StgTRecHeader *trec,
1590 StgTRecHeader *entry_in = NULL;
1591 StgClosure *result = NULL;
1592 TRecEntry *entry = NULL;
1593 TRACE("%p : stmReadTVar(%p)", trec, tvar);
1594 ASSERT (trec != NO_TREC);
1595 ASSERT (trec -> state == TREC_ACTIVE ||
1596 trec -> state == TREC_CONDEMNED);
1598 entry = get_entry_for(trec, tvar, &entry_in);
1600 if (entry != NULL) {
1601 if (entry_in == trec) {
1602 // Entry found in our trec
1603 result = entry -> new_value;
1605 // Entry found in another trec
1606 TRecEntry *new_entry = get_new_entry(cap, trec);
1607 new_entry -> tvar = tvar;
1608 new_entry -> expected_value = entry -> expected_value;
1609 new_entry -> new_value = entry -> new_value;
1610 result = new_entry -> new_value;
1614 StgClosure *current_value = read_current_value(trec, tvar);
1615 TRecEntry *new_entry = get_new_entry(cap, trec);
1616 new_entry -> tvar = tvar;
1617 new_entry -> expected_value = current_value;
1618 new_entry -> new_value = current_value;
1619 result = current_value;
1622 TRACE("%p : stmReadTVar(%p)=%p", trec, tvar, result);
1626 /*......................................................................*/
1628 void stmWriteTVar(Capability *cap,
1629 StgTRecHeader *trec,
1631 StgClosure *new_value) {
1633 StgTRecHeader *entry_in = NULL;
1634 TRecEntry *entry = NULL;
1635 TRACE("%p : stmWriteTVar(%p, %p)", trec, tvar, new_value);
1636 ASSERT (trec != NO_TREC);
1637 ASSERT (trec -> state == TREC_ACTIVE ||
1638 trec -> state == TREC_CONDEMNED);
1640 entry = get_entry_for(trec, tvar, &entry_in);
1642 if (entry != NULL) {
1643 if (entry_in == trec) {
1644 // Entry found in our trec
1645 entry -> new_value = new_value;
1647 // Entry found in another trec
1648 TRecEntry *new_entry = get_new_entry(cap, trec);
1649 new_entry -> tvar = tvar;
1650 new_entry -> expected_value = entry -> expected_value;
1651 new_entry -> new_value = new_value;
1655 StgClosure *current_value = read_current_value(trec, tvar);
1656 TRecEntry *new_entry = get_new_entry(cap, trec);
1657 new_entry -> tvar = tvar;
1658 new_entry -> expected_value = current_value;
1659 new_entry -> new_value = new_value;
1662 TRACE("%p : stmWriteTVar done", trec);
1665 /*......................................................................*/
1667 StgTVar *stmNewTVar(Capability *cap,
1668 StgClosure *new_value) {
1670 result = (StgTVar *)allocateLocal(cap, sizeofW(StgTVar));
1671 SET_HDR (result, &stg_TVAR_info, CCS_SYSTEM);
1672 result -> current_value = new_value;
1673 result -> first_watch_queue_entry = END_STM_WATCH_QUEUE;
1674 #if defined(THREADED_RTS)
1675 result -> num_updates = 0;
1680 /*......................................................................*/