1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 1998-2005
10 * See the PPoPP 2005 paper "Composable memory transactions". In summary,
11 * each transcation has a TRec (transaction record) holding entries for each of the
12 * TVars (transactional variables) that it has accessed. Each entry records
13 * (a) the TVar, (b) the expected value seen in the TVar, (c) the new value that
14 * the transaction wants to write to the TVar, (d) during commit, the identity of
15 * the TRec that wrote the expected value.
17 * Separate TRecs are used for each level in a nest of transactions. This allows
18 * a nested transaction to be aborted without condemning its enclosing transactions.
19 * This is needed in the implementation of catchRetry. Note that the "expected value"
20 * in a nested transaction's TRec is the value expected to be *held in memory* if
21 * the transaction commits -- not the "new value" stored in one of the enclosing
22 * transactions. This means that validation can be done without searching through
28 * Three different concurrency control schemes can be built according to the settings
31 * STM_UNIPROC assumes that the caller serialises invocations on the STM interface.
32 * In the Haskell RTS this means it is suitable only for non-SMP builds.
34 * STM_CG_LOCK uses coarse-grained locking -- a single 'stm lock' is acquired during
35 * an invocation on the STM interface. Note that this does not mean that
36 * transactions are simply serialized -- the lock is only held *within* the
37 * implementation of stmCommitTransaction, stmWait etc.
39 * STM_FG_LOCKS uses fine-grained locking -- locking is done on a per-TVar basis
40 * and, when committing a transaction, no locks are acquired for TVars that have
41 * been read but not updated.
43 * Concurrency control is implemented in the functions:
47 * lock_tvar / cond_lock_tvar
50 * The choice between STM_UNIPROC / STM_CG_LOCK / STM_FG_LOCKS affects the
51 * implementation of these functions.
53 * lock_stm & unlock_stm are straightforward : they acquire a simple spin-lock
54 * using STM_CG_LOCK, and otherwise they are no-ops.
56 * lock_tvar / cond_lock_tvar and unlock_tvar are more complex because they
57 * have other effects (present in STM_UNIPROC and STM_CG_LOCK builds) as well
58 * as the actual business of maniupultaing a lock (present only in STM_FG_LOCKS
59 * builds). This is because locking a TVar is implemented by writing the lock
60 * holder's TRec into the TVar's current_value field:
62 * lock_tvar - lock a specified TVar (STM_FG_LOCKS only), returning the value
65 * cond_lock_tvar - lock a specified TVar (STM_FG_LOCKS only) if it
66 * contains a specified value. Return TRUE if this succeeds,
69 * unlock_tvar - release the lock on a specified TVar (STM_FG_LOCKS only),
70 * storing a specified value in place of the lock entry.
72 * Using these operations, the typcial pattern of a commit/validate/wait operation
73 * is to (a) lock the STM, (b) lock all the TVars being updated, (c) check that
74 * the TVars that were only read from still contain their expected values,
75 * (d) release the locks on the TVars, writing updates to them in the case of a
76 * commit, (e) unlock the STM.
78 * Queues of waiting threads hang off the first_wait_queue_entry field of each
79 * TVar. This may only be manipulated when holding that TVar's lock. In
80 * particular, when a thread is putting itself to sleep, it mustn't release
81 * the TVar's lock until it has added itself to the wait queue and marked its
82 * TSO as BlockedOnSTM -- this makes sure that other threads will know to wake it.
84 * ---------------------------------------------------------------------------*/
86 #include "PosixSource.h"
101 // ACQ_ASSERT is used for assertions which are only required for SMP builds with
102 // fine-grained locking.
104 #if defined(STM_FG_LOCKS)
105 #define ACQ_ASSERT(_X) ASSERT(_X)
106 #define NACQ_ASSERT(_X) /*Nothing*/
108 #define ACQ_ASSERT(_X) /*Nothing*/
109 #define NACQ_ASSERT(_X) ASSERT(_X)
112 /*......................................................................*/
114 // If SHAKE is defined then validation will sometime spuriously fail. They helps test
115 // unusualy code paths if genuine contention is rare
119 #if defined(THREADED_RTS)
120 #define TRACE(_x...) IF_DEBUG(stm, debugBelch("STM (task %p): ", (void *)(unsigned long)(unsigned int)osThreadId()); debugBelch ( _x ))
122 #define TRACE(_x...) IF_DEBUG(stm, debugBelch ( _x ))
125 #define TRACE(_x...) /*Nothing*/
129 static const int do_shake = TRUE;
131 static const int do_shake = FALSE;
133 static int shake_ctr = 0;
134 static int shake_lim = 1;
136 static int shake(void) {
138 if (((shake_ctr++) % shake_lim) == 0) {
149 /*......................................................................*/
151 // Helper macros for iterating over entries within a transaction
154 #define FOR_EACH_ENTRY(_t,_x,CODE) do { \
155 StgTRecHeader *__t = (_t); \
156 StgTRecChunk *__c = __t -> current_chunk; \
157 StgWord __limit = __c -> next_entry_idx; \
158 TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%ld\n", __t, __c, __limit); \
159 while (__c != END_STM_CHUNK_LIST) { \
161 for (__i = 0; __i < __limit; __i ++) { \
162 TRecEntry *_x = &(__c -> entries[__i]); \
163 do { CODE } while (0); \
165 __c = __c -> prev_chunk; \
166 __limit = TREC_CHUNK_NUM_ENTRIES; \
169 if (FALSE) goto exit_for_each; \
172 #define BREAK_FOR_EACH goto exit_for_each
174 /*......................................................................*/
176 #define IF_STM_UNIPROC(__X) do { } while (0)
177 #define IF_STM_CG_LOCK(__X) do { } while (0)
178 #define IF_STM_FG_LOCKS(__X) do { } while (0)
180 #if defined(STM_UNIPROC)
181 #undef IF_STM_UNIPROC
182 #define IF_STM_UNIPROC(__X) do { __X } while (0)
183 static const StgBool use_read_phase = FALSE;
185 static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
186 TRACE("%p : lock_stm()\n", trec);
189 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
190 TRACE("%p : unlock_stm()\n", trec);
193 static StgClosure *lock_tvar(StgTRecHeader *trec STG_UNUSED,
194 StgTVar *s STG_UNUSED) {
196 TRACE("%p : lock_tvar(%p)\n", trec, s);
197 result = s -> current_value;
201 static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
202 StgTVar *s STG_UNUSED,
204 StgBool force_update) {
205 TRACE("%p : unlock_tvar(%p)\n", trec, s);
207 s -> current_value = c;
211 static StgBool cond_lock_tvar(StgTRecHeader *trec STG_UNUSED,
212 StgTVar *s STG_UNUSED,
213 StgClosure *expected) {
215 TRACE("%p : cond_lock_tvar(%p, %p)\n", trec, s, expected);
216 result = s -> current_value;
217 TRACE("%p : %s\n", trec, (result == expected) ? "success" : "failure");
218 return (result == expected);
222 #if defined(STM_CG_LOCK) /*........................................*/
224 #undef IF_STM_CG_LOCK
225 #define IF_STM_CG_LOCK(__X) do { __X } while (0)
226 static const StgBool use_read_phase = FALSE;
227 static volatile StgTRecHeader *smp_locked = NULL;
229 static void lock_stm(StgTRecHeader *trec) {
230 while (cas(&smp_locked, NULL, trec) != NULL) { }
231 TRACE("%p : lock_stm()\n", trec);
234 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
235 TRACE("%p : unlock_stm()\n", trec);
236 ASSERT (smp_locked == trec);
240 static StgClosure *lock_tvar(StgTRecHeader *trec STG_UNUSED,
241 StgTVar *s STG_UNUSED) {
243 TRACE("%p : lock_tvar(%p)\n", trec, s);
244 ASSERT (smp_locked == trec);
245 result = s -> current_value;
249 static void *unlock_tvar(StgTRecHeader *trec STG_UNUSED,
250 StgTVar *s STG_UNUSED,
252 StgBool force_update) {
253 TRACE("%p : unlock_tvar(%p, %p)\n", trec, s, c);
254 ASSERT (smp_locked == trec);
256 s -> current_value = c;
260 static StgBool cond_lock_tvar(StgTRecHeader *trec STG_UNUSED,
261 StgTVar *s STG_UNUSED,
262 StgClosure *expected) {
264 TRACE("%p : cond_lock_tvar(%p, %p)\n", trec, s, expected);
265 ASSERT (smp_locked == trec);
266 result = s -> current_value;
267 TRACE("%p : %d\n", result ? "success" : "failure");
268 return (result == expected);
272 #if defined(STM_FG_LOCKS) /*...................................*/
274 #undef IF_STM_FG_LOCKS
275 #define IF_STM_FG_LOCKS(__X) do { __X } while (0)
276 static const StgBool use_read_phase = TRUE;
278 static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
279 TRACE("%p : lock_stm()\n", trec);
282 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
283 TRACE("%p : unlock_stm()\n", trec);
286 static StgClosure *lock_tvar(StgTRecHeader *trec,
287 StgTVar *s STG_UNUSED) {
289 TRACE("%p : lock_tvar(%p)\n", trec, s);
292 result = s -> current_value;
293 } while (GET_INFO(result) == &stg_TREC_HEADER_info);
294 } while (cas(&(s -> current_value), result, trec) != result);
298 static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
301 StgBool force_update STG_UNUSED) {
302 TRACE("%p : unlock_tvar(%p, %p)\n", trec, s, c);
303 ASSERT(s -> current_value == trec);
304 s -> current_value = c;
307 static StgBool cond_lock_tvar(StgTRecHeader *trec,
309 StgClosure *expected) {
311 TRACE("%p : cond_lock_tvar(%p, %p)\n", trec, s, expected);
312 result = cas(&(s -> current_value), expected, trec);
313 TRACE("%p : %s\n", trec, result ? "success" : "failure");
314 return (result == expected);
318 /*......................................................................*/
320 // Helper functions for thread blocking and unblocking
322 static void park_tso(StgTSO *tso) {
323 ASSERT(tso -> why_blocked == NotBlocked);
324 tso -> why_blocked = BlockedOnSTM;
325 tso -> block_info.closure = (StgClosure *) END_TSO_QUEUE;
326 TRACE("park_tso on tso=%p\n", tso);
329 static void unpark_tso(Capability *cap, StgTSO *tso) {
330 // We will continue unparking threads while they remain on one of the wait
331 // queues: it's up to the thread itself to remove it from the wait queues
332 // if it decides to do so when it is scheduled.
333 if (tso -> why_blocked == BlockedOnSTM) {
334 TRACE("unpark_tso on tso=%p\n", tso);
337 TRACE("spurious unpark_tso on tso=%p\n", tso);
341 static void unpark_waiters_on(Capability *cap, StgTVar *s) {
343 TRACE("unpark_waiters_on tvar=%p\n", s);
344 for (q = s -> first_wait_queue_entry;
345 q != END_STM_WAIT_QUEUE;
346 q = q -> next_queue_entry) {
347 unpark_tso(cap, q -> waiting_tso);
351 /*......................................................................*/
353 // Helper functions for allocation and initialization
355 static StgTVarWaitQueue *new_stg_tvar_wait_queue(Capability *cap,
356 StgTSO *waiting_tso) {
357 StgTVarWaitQueue *result;
358 result = (StgTVarWaitQueue *)allocateLocal(cap, sizeofW(StgTVarWaitQueue));
359 SET_HDR (result, &stg_TVAR_WAIT_QUEUE_info, CCS_SYSTEM);
360 result -> waiting_tso = waiting_tso;
364 static StgTRecChunk *new_stg_trec_chunk(Capability *cap) {
365 StgTRecChunk *result;
366 result = (StgTRecChunk *)allocateLocal(cap, sizeofW(StgTRecChunk));
367 SET_HDR (result, &stg_TREC_CHUNK_info, CCS_SYSTEM);
368 result -> prev_chunk = END_STM_CHUNK_LIST;
369 result -> next_entry_idx = 0;
373 static StgTRecHeader *new_stg_trec_header(Capability *cap,
374 StgTRecHeader *enclosing_trec) {
375 StgTRecHeader *result;
376 result = (StgTRecHeader *) allocateLocal(cap, sizeofW(StgTRecHeader));
377 SET_HDR (result, &stg_TREC_HEADER_info, CCS_SYSTEM);
379 result -> enclosing_trec = enclosing_trec;
380 result -> current_chunk = new_stg_trec_chunk(cap);
382 if (enclosing_trec == NO_TREC) {
383 result -> state = TREC_ACTIVE;
385 ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
386 enclosing_trec -> state == TREC_CONDEMNED);
387 result -> state = enclosing_trec -> state;
393 /*......................................................................*/
395 // Helper functions for managing waiting lists
397 static void build_wait_queue_entries_for_trec(Capability *cap,
399 StgTRecHeader *trec) {
400 ASSERT(trec != NO_TREC);
401 ASSERT(trec -> enclosing_trec == NO_TREC);
402 ASSERT(trec -> state == TREC_ACTIVE);
404 TRACE("%p : build_wait_queue_entries_for_trec()\n", trec);
406 FOR_EACH_ENTRY(trec, e, {
409 StgTVarWaitQueue *fq;
411 TRACE("%p : adding tso=%p to wait queue for tvar=%p\n", trec, tso, s);
412 ACQ_ASSERT(s -> current_value == trec);
413 NACQ_ASSERT(s -> current_value == e -> expected_value);
414 fq = s -> first_wait_queue_entry;
415 q = new_stg_tvar_wait_queue(cap, tso);
416 q -> next_queue_entry = fq;
417 q -> prev_queue_entry = END_STM_WAIT_QUEUE;
418 if (fq != END_STM_WAIT_QUEUE) {
419 fq -> prev_queue_entry = q;
421 s -> first_wait_queue_entry = q;
422 e -> new_value = (StgClosure *) q;
426 static void remove_wait_queue_entries_for_trec(StgTRecHeader *trec) {
427 ASSERT(trec != NO_TREC);
428 ASSERT(trec -> enclosing_trec == NO_TREC);
429 ASSERT(trec -> state == TREC_WAITING ||
430 trec -> state == TREC_CONDEMNED);
432 TRACE("%p : remove_wait_queue_entries_for_trec()\n", trec);
434 FOR_EACH_ENTRY(trec, e, {
436 StgTVarWaitQueue *pq;
437 StgTVarWaitQueue *nq;
440 StgClosure *saw = lock_tvar(trec, s);
441 q = (StgTVarWaitQueue *) (e -> new_value);
442 TRACE("%p : removing tso=%p from wait queue for tvar=%p\n", trec, q -> waiting_tso, s);
443 ACQ_ASSERT(s -> current_value == trec);
444 nq = q -> next_queue_entry;
445 pq = q -> prev_queue_entry;
446 if (nq != END_STM_WAIT_QUEUE) {
447 nq -> prev_queue_entry = pq;
449 if (pq != END_STM_WAIT_QUEUE) {
450 pq -> next_queue_entry = nq;
452 ASSERT (s -> first_wait_queue_entry == q);
453 s -> first_wait_queue_entry = nq;
455 unlock_tvar(trec, s, saw, FALSE);
459 /*......................................................................*/
461 static TRecEntry *get_new_entry(Capability *cap,
467 c = t -> current_chunk;
468 i = c -> next_entry_idx;
469 ASSERT(c != END_STM_CHUNK_LIST);
471 if (i < TREC_CHUNK_NUM_ENTRIES) {
472 // Continue to use current chunk
473 result = &(c -> entries[i]);
474 c -> next_entry_idx ++;
476 // Current chunk is full: allocate a fresh one
478 nc = new_stg_trec_chunk(cap);
479 nc -> prev_chunk = c;
480 nc -> next_entry_idx = 1;
481 t -> current_chunk = nc;
482 result = &(nc -> entries[0]);
488 /*......................................................................*/
490 static void merge_update_into(Capability *cap,
493 StgClosure *expected_value,
494 StgClosure *new_value) {
497 // Look for an entry in this trec
499 FOR_EACH_ENTRY(t, e, {
504 if (e -> expected_value != expected_value) {
505 // Must abort if the two entries start from different values
506 TRACE("%p : entries inconsistent at %p (%p vs %p)\n",
507 t, tvar, e -> expected_value, expected_value);
508 t -> state = TREC_CONDEMNED;
510 e -> new_value = new_value;
516 // No entry so far in this trec
518 ne = get_new_entry(cap, t);
520 ne -> expected_value = expected_value;
521 ne -> new_value = new_value;
525 /*......................................................................*/
527 static StgBool entry_is_update(TRecEntry *e) {
529 result = (e -> expected_value != e -> new_value);
533 static StgBool entry_is_read_only(TRecEntry *e) {
535 result = (e -> expected_value == e -> new_value);
539 static StgBool tvar_is_locked(StgTVar *s, StgTRecHeader *h) {
542 c = s -> current_value;
543 result = (c == (StgClosure *) h);
547 // revert_ownership : release a lock on a TVar, storing back
548 // the value that it held when the lock was acquired. "revert_all"
549 // is set in stmWait and stmReWait when we acquired locks on all of
550 // the TVars involved. "revert_all" is not set in commit operations
551 // where we don't lock TVars that have been read from but not updated.
553 static void revert_ownership(StgTRecHeader *trec STG_UNUSED,
554 StgBool revert_all STG_UNUSED) {
555 #if defined(STM_FG_LOCKS)
556 FOR_EACH_ENTRY(trec, e, {
557 if (revert_all || entry_is_update(e)) {
560 if (tvar_is_locked(s, trec)) {
561 unlock_tvar(trec, s, e -> expected_value, TRUE);
568 /*......................................................................*/
570 // validate_and_acquire_ownership : this performs the twin functions
571 // of checking that the TVars referred to by entries in trec hold the
572 // expected values and:
574 // - locking the TVar (on updated TVars during commit, or all TVars
577 // - recording the identity of the TRec who wrote the value seen in the
578 // TVar (on non-updated TVars during commit). These values are
579 // stashed in the TRec entries and are then checked in check_read_only
580 // to ensure that an atomic snapshot of all of these locations has been
583 static StgBool validate_and_acquire_ownership (StgTRecHeader *trec,
585 int retain_ownership) {
589 TRACE("%p : shake, pretending trec is invalid when it may not be\n", trec);
593 ASSERT ((trec -> state == TREC_ACTIVE) ||
594 (trec -> state == TREC_WAITING) ||
595 (trec -> state == TREC_CONDEMNED));
596 result = !((trec -> state) == TREC_CONDEMNED);
598 FOR_EACH_ENTRY(trec, e, {
601 if (acquire_all || entry_is_update(e)) {
602 TRACE("%p : trying to acquire %p\n", trec, s);
603 if (!cond_lock_tvar(trec, s, e -> expected_value)) {
604 TRACE("%p : failed to acquire %p\n", trec, s);
609 ASSERT(use_read_phase);
611 TRACE("%p : will need to check %p\n", trec, s);
612 if (s -> current_value != e -> expected_value) {
613 TRACE("%p : doesn't match\n", trec);
617 e -> saw_update_by = s -> last_update_by;
618 if (s -> current_value != e -> expected_value) {
619 TRACE("%p : doesn't match (race)\n", trec);
623 TRACE("%p : need to check update by %p\n", trec, e -> saw_update_by);
630 if ((!result) || (!retain_ownership)) {
631 revert_ownership(trec, acquire_all);
637 // check_read_only : check that we've seen an atomic snapshot of the
638 // non-updated TVars accessed by a trec. This checks that the last TRec to
639 // commit an update to the TVar is unchanged since the value was stashed in
640 // validate_and_acquire_ownership. If no udpate is seen to any TVar than
641 // all of them contained their expected values at the start of the call to
644 // The paper "Concurrent programming without locks" (under submission), or
645 // Keir Fraser's PhD dissertation "Practical lock-free programming" discuss
646 // this kind of algorithm.
648 static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
649 StgBool result = TRUE;
651 ASSERT (use_read_phase);
653 FOR_EACH_ENTRY(trec, e, {
656 if (entry_is_read_only(e)) {
657 TRACE("%p : check_read_only for TVar %p, saw %p\n", trec, s, e -> saw_update_by);
658 if (s -> last_update_by != e -> saw_update_by) {
659 // ||s -> current_value != e -> expected_value) {
660 TRACE("%p : mismatch\n", trec);
672 /************************************************************************/
674 void stmPreGCHook() {
676 TRACE("stmPreGCHook\n");
680 /************************************************************************/
683 TRACE("initSTM, NO_TREC=%p\n", NO_TREC);
686 /*......................................................................*/
688 StgTRecHeader *stmStartTransaction(Capability *cap,
689 StgTRecHeader *outer) {
691 TRACE("%p : stmStartTransaction\n", outer);
692 t = new_stg_trec_header(cap, outer);
693 TRACE("%p : stmStartTransaction()=%p\n", outer, t);
697 /*......................................................................*/
699 void stmAbortTransaction(StgTRecHeader *trec) {
700 TRACE("%p : stmAbortTransaction\n", trec);
701 ASSERT (trec != NO_TREC);
702 ASSERT ((trec -> state == TREC_ACTIVE) ||
703 (trec -> state == TREC_WAITING) ||
704 (trec -> state == TREC_CONDEMNED));
707 if (trec -> state == TREC_WAITING) {
708 ASSERT (trec -> enclosing_trec == NO_TREC);
709 TRACE("%p : stmAbortTransaction aborting waiting transaction\n", trec);
710 remove_wait_queue_entries_for_trec(trec);
712 trec -> state = TREC_ABORTED;
715 TRACE("%p : stmAbortTransaction done\n", trec);
718 /*......................................................................*/
720 void stmCondemnTransaction(StgTRecHeader *trec) {
721 TRACE("%p : stmCondemnTransaction\n", trec);
722 ASSERT (trec != NO_TREC);
723 ASSERT ((trec -> state == TREC_ACTIVE) ||
724 (trec -> state == TREC_WAITING) ||
725 (trec -> state == TREC_CONDEMNED));
728 if (trec -> state == TREC_WAITING) {
729 ASSERT (trec -> enclosing_trec == NO_TREC);
730 TRACE("%p : stmCondemnTransaction condemning waiting transaction\n", trec);
731 remove_wait_queue_entries_for_trec(trec);
733 trec -> state = TREC_CONDEMNED;
736 TRACE("%p : stmCondemnTransaction done\n", trec);
739 /*......................................................................*/
741 StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec) {
742 StgTRecHeader *outer;
743 TRACE("%p : stmGetEnclosingTRec\n", trec);
744 outer = trec -> enclosing_trec;
745 TRACE("%p : stmGetEnclosingTRec()=%p\n", trec, outer);
749 /*......................................................................*/
751 StgBool stmValidateNestOfTransactions(StgTRecHeader *trec) {
755 TRACE("%p : stmValidateNestOfTransactions\n", trec);
756 ASSERT(trec != NO_TREC);
757 ASSERT((trec -> state == TREC_ACTIVE) ||
758 (trec -> state == TREC_WAITING) ||
759 (trec -> state == TREC_CONDEMNED));
765 while (t != NO_TREC) {
766 result &= validate_and_acquire_ownership(t, TRUE, FALSE);
767 t = t -> enclosing_trec;
770 if (!result && trec -> state != TREC_WAITING) {
771 trec -> state = TREC_CONDEMNED;
776 TRACE("%p : stmValidateNestOfTransactions()=%d\n", trec, result);
780 /*......................................................................*/
782 StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
785 TRACE("%p : stmCommitTransaction()\n", trec);
786 ASSERT (trec != NO_TREC);
790 ASSERT (trec -> enclosing_trec == NO_TREC);
791 ASSERT ((trec -> state == TREC_ACTIVE) ||
792 (trec -> state == TREC_CONDEMNED));
794 result = validate_and_acquire_ownership(trec, (!use_read_phase), TRUE);
796 // We now know that all the updated locations hold their expected values.
797 ASSERT (trec -> state == TREC_ACTIVE);
799 if (use_read_phase) {
800 TRACE("%p : doing read check\n", trec);
801 result = check_read_only(trec);
802 TRACE("%p : read-check %s\n", trec, result ? "succeeded" : "failed");
806 // We now know that all of the read-only locations held their exepcted values
807 // at the end of the call to validate_and_acquire_ownership. This forms the
808 // linearization point of the commit.
810 FOR_EACH_ENTRY(trec, e, {
813 if (e -> new_value != e -> expected_value) {
814 // Entry is an update: write the value back to the TVar, unlocking it if
817 ACQ_ASSERT(tvar_is_locked(s, trec));
818 TRACE("%p : writing %p to %p, waking waiters\n", trec, e -> new_value, s);
819 unpark_waiters_on(cap,s);
821 s -> last_update_by = trec;
823 unlock_tvar(trec, s, e -> new_value, TRUE);
825 ACQ_ASSERT(!tvar_is_locked(s, trec));
828 revert_ownership(trec, FALSE);
834 TRACE("%p : stmCommitTransaction()=%d\n", trec, result);
839 /*......................................................................*/
841 StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) {
844 ASSERT (trec != NO_TREC && trec -> enclosing_trec != NO_TREC);
845 TRACE("%p : stmCommitNestedTransaction() into %p\n", trec, trec -> enclosing_trec);
846 ASSERT ((trec -> state == TREC_ACTIVE) || (trec -> state == TREC_CONDEMNED));
850 et = trec -> enclosing_trec;
851 result = validate_and_acquire_ownership(trec, FALSE, TRUE);
853 // We now know that all the updated locations hold their expected values.
855 if (use_read_phase) {
856 TRACE("%p : doing read check\n", trec);
857 result = check_read_only(trec);
860 // We now know that all of the read-only locations held their exepcted values
861 // at the end of the call to validate_and_acquire_ownership. This forms the
862 // linearization point of the commit.
865 TRACE("%p : read-check succeeded\n", trec);
866 FOR_EACH_ENTRY(trec, e, {
867 // Merge each entry into the enclosing transaction record, release all
872 if (entry_is_update(e)) {
873 unlock_tvar(trec, s, e -> expected_value, FALSE);
875 merge_update_into(cap, et, s, e -> expected_value, e -> new_value);
876 ACQ_ASSERT(s -> current_value != trec);
879 revert_ownership(trec, FALSE);
886 TRACE("%p : stmCommitNestedTransaction()=%d\n", trec, result);
891 /*......................................................................*/
893 StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
895 TRACE("%p : stmWait(%p)\n", trec, tso);
896 ASSERT (trec != NO_TREC);
897 ASSERT (trec -> enclosing_trec == NO_TREC);
898 ASSERT ((trec -> state == TREC_ACTIVE) ||
899 (trec -> state == TREC_CONDEMNED));
902 result = validate_and_acquire_ownership(trec, TRUE, TRUE);
904 // The transaction is valid so far so we can actually start waiting.
905 // (Otherwise the transaction was not valid and the thread will have to
908 // Put ourselves to sleep. We retain locks on all the TVars involved
909 // until we are sound asleep : (a) on the wait queues, (b) BlockedOnSTM
910 // in the TSO, (c) TREC_WAITING in the Trec.
911 build_wait_queue_entries_for_trec(cap, tso, trec);
913 trec -> state = TREC_WAITING;
915 // We haven't released ownership of the transaction yet. The TSO
916 // has been put on the wait queue for the TVars it is waiting for,
917 // but we haven't yet tidied up the TSO's stack and made it safe
918 // to wake up the TSO. Therefore, we must wait until the TSO is
919 // safe to wake up before we release ownership - when all is well,
920 // the runtime will call stmWaitUnlock() below, with the same
927 TRACE("%p : stmWait(%p)=%d\n", trec, tso, result);
933 stmWaitUnlock(Capability *cap, StgTRecHeader *trec) {
934 revert_ownership(trec, TRUE);
938 /*......................................................................*/
940 StgBool stmReWait(StgTSO *tso) {
942 StgTRecHeader *trec = tso->trec;
944 TRACE("%p : stmReWait\n", trec);
945 ASSERT (trec != NO_TREC);
946 ASSERT (trec -> enclosing_trec == NO_TREC);
947 ASSERT ((trec -> state == TREC_WAITING) ||
948 (trec -> state == TREC_CONDEMNED));
951 result = validate_and_acquire_ownership(trec, TRUE, TRUE);
952 TRACE("%p : validation %s\n", trec, result ? "succeeded" : "failed");
954 // The transaction remains valid -- do nothing because it is already on
956 ASSERT (trec -> state == TREC_WAITING);
958 revert_ownership(trec, TRUE);
960 // The transcation has become invalid. We can now remove it from the wait
962 if (trec -> state != TREC_CONDEMNED) {
963 remove_wait_queue_entries_for_trec (trec);
969 TRACE("%p : stmReWait()=%d\n", trec, result);
973 /*......................................................................*/
975 static TRecEntry *get_entry_for(StgTRecHeader *trec, StgTVar *tvar, StgTRecHeader **in) {
976 TRecEntry *result = NULL;
978 TRACE("%p : get_entry_for TVar %p\n", trec, tvar);
979 ASSERT(trec != NO_TREC);
982 FOR_EACH_ENTRY(trec, e, {
983 if (e -> tvar == tvar) {
991 trec = trec -> enclosing_trec;
992 } while (result == NULL && trec != NO_TREC);
997 static StgClosure *read_current_value(StgTRecHeader *trec STG_UNUSED, StgTVar *tvar) {
999 result = tvar -> current_value;
1001 #if defined(STM_FG_LOCKS)
1002 while (GET_INFO(result) == &stg_TREC_HEADER_info) {
1003 TRACE("%p : read_current_value(%p) saw %p\n", trec, tvar, result);
1004 result = tvar -> current_value;
1008 TRACE("%p : read_current_value(%p)=%p\n", trec, tvar, result);
1012 /*......................................................................*/
1014 StgClosure *stmReadTVar(Capability *cap,
1015 StgTRecHeader *trec,
1017 StgTRecHeader *entry_in;
1018 StgClosure *result = NULL;
1019 TRecEntry *entry = NULL;
1020 TRACE("%p : stmReadTVar(%p)\n", trec, tvar);
1021 ASSERT (trec != NO_TREC);
1022 ASSERT (trec -> state == TREC_ACTIVE ||
1023 trec -> state == TREC_CONDEMNED);
1025 entry = get_entry_for(trec, tvar, &entry_in);
1027 if (entry != NULL) {
1028 if (entry_in == trec) {
1029 // Entry found in our trec
1030 result = entry -> new_value;
1032 // Entry found in another trec
1033 TRecEntry *new_entry = get_new_entry(cap, trec);
1034 new_entry -> tvar = tvar;
1035 new_entry -> expected_value = entry -> expected_value;
1036 new_entry -> new_value = entry -> new_value;
1037 result = new_entry -> new_value;
1041 StgClosure *current_value = read_current_value(trec, tvar);
1042 TRecEntry *new_entry = get_new_entry(cap, trec);
1043 new_entry -> tvar = tvar;
1044 new_entry -> expected_value = current_value;
1045 new_entry -> new_value = current_value;
1046 result = current_value;
1049 TRACE("%p : stmReadTVar(%p)=%p\n", trec, tvar, result);
1053 /*......................................................................*/
1055 void stmWriteTVar(Capability *cap,
1056 StgTRecHeader *trec,
1058 StgClosure *new_value) {
1060 StgTRecHeader *entry_in;
1061 TRecEntry *entry = NULL;
1062 TRACE("%p : stmWriteTVar(%p, %p)\n", trec, tvar, new_value);
1063 ASSERT (trec != NO_TREC);
1064 ASSERT (trec -> state == TREC_ACTIVE ||
1065 trec -> state == TREC_CONDEMNED);
1067 entry = get_entry_for(trec, tvar, &entry_in);
1069 if (entry != NULL) {
1070 if (entry_in == trec) {
1071 // Entry found in our trec
1072 entry -> new_value = new_value;
1074 // Entry found in another trec
1075 TRecEntry *new_entry = get_new_entry(cap, trec);
1076 new_entry -> tvar = tvar;
1077 new_entry -> expected_value = entry -> expected_value;
1078 new_entry -> new_value = new_value;
1082 StgClosure *current_value = read_current_value(trec, tvar);
1083 TRecEntry *new_entry = get_new_entry(cap, trec);
1084 new_entry -> tvar = tvar;
1085 new_entry -> expected_value = current_value;
1086 new_entry -> new_value = new_value;
1089 TRACE("%p : stmWriteTVar done\n", trec);
1092 /*......................................................................*/
1094 StgTVar *stmNewTVar(Capability *cap,
1095 StgClosure *new_value) {
1097 result = (StgTVar *)allocateLocal(cap, sizeofW(StgTVar));
1098 SET_HDR (result, &stg_TVAR_info, CCS_SYSTEM);
1099 result -> current_value = new_value;
1100 result -> first_wait_queue_entry = END_STM_WAIT_QUEUE;
1102 result -> last_update_by = NO_TREC;
1107 /*......................................................................*/