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-SMP 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_wait_queue_entry field of each
78 * TVar. This may only be manipulated when holding that TVar's lock. In
79 * particular, when a thread is putting itself to sleep, it mustn't release
80 * the TVar's lock until it has added itself to the wait queue and marked its
81 * TSO as BlockedOnSTM -- this makes sure that other threads will know to wake it.
83 * ---------------------------------------------------------------------------*/
85 #include "PosixSource.h"
100 // ACQ_ASSERT is used for assertions which are only required for SMP builds with
101 // 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
118 #if defined(THREADED_RTS)
119 #define TRACE(_x...) IF_DEBUG(stm, debugBelch("STM (task %p): ", (void *)(unsigned long)(unsigned int)osThreadId()); debugBelch ( _x ))
121 #define TRACE(_x...) IF_DEBUG(stm, debugBelch ( _x ))
124 #define TRACE(_x...) /*Nothing*/
128 static const int do_shake = TRUE;
130 static const int do_shake = FALSE;
132 static int shake_ctr = 0;
133 static int shake_lim = 1;
135 static int shake(void) {
137 if (((shake_ctr++) % shake_lim) == 0) {
148 /*......................................................................*/
150 // Helper macros for iterating over entries within a transaction
153 #define FOR_EACH_ENTRY(_t,_x,CODE) do { \
154 StgTRecHeader *__t = (_t); \
155 StgTRecChunk *__c = __t -> current_chunk; \
156 StgWord __limit = __c -> next_entry_idx; \
157 TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%ld\n", __t, __c, __limit); \
158 while (__c != END_STM_CHUNK_LIST) { \
160 for (__i = 0; __i < __limit; __i ++) { \
161 TRecEntry *_x = &(__c -> entries[__i]); \
162 do { CODE } while (0); \
164 __c = __c -> prev_chunk; \
165 __limit = TREC_CHUNK_NUM_ENTRIES; \
168 if (FALSE) goto exit_for_each; \
171 #define BREAK_FOR_EACH goto exit_for_each
173 /*......................................................................*/
175 // if REUSE_MEMORY is defined then attempt to re-use descriptors, log chunks,
176 // and wait queue entries without GC
180 /*......................................................................*/
182 #define IF_STM_UNIPROC(__X) do { } while (0)
183 #define IF_STM_CG_LOCK(__X) do { } while (0)
184 #define IF_STM_FG_LOCKS(__X) do { } while (0)
186 #if defined(STM_UNIPROC)
187 #undef IF_STM_UNIPROC
188 #define IF_STM_UNIPROC(__X) do { __X } while (0)
189 static const StgBool use_read_phase = FALSE;
191 static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
192 TRACE("%p : lock_stm()\n", trec);
195 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
196 TRACE("%p : unlock_stm()\n", trec);
199 static StgClosure *lock_tvar(StgTRecHeader *trec STG_UNUSED,
200 StgTVar *s STG_UNUSED) {
202 TRACE("%p : lock_tvar(%p)\n", trec, s);
203 result = s -> current_value;
207 static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
208 StgTVar *s STG_UNUSED,
210 StgBool force_update) {
211 TRACE("%p : unlock_tvar(%p)\n", trec, s);
213 s -> current_value = c;
217 static StgBool cond_lock_tvar(StgTRecHeader *trec STG_UNUSED,
218 StgTVar *s STG_UNUSED,
219 StgClosure *expected) {
221 TRACE("%p : cond_lock_tvar(%p, %p)\n", trec, s, expected);
222 result = s -> current_value;
223 TRACE("%p : %s\n", trec, (result == expected) ? "success" : "failure");
224 return (result == expected);
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 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()\n", trec);
240 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
241 TRACE("%p : unlock_stm()\n", 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)\n", 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)\n", 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)\n", trec, s, expected);
271 ASSERT (smp_locked == trec);
272 result = s -> current_value;
273 TRACE("%p : %d\n", result ? "success" : "failure");
274 return (result == expected);
278 #if defined(STM_FG_LOCKS) /*...................................*/
280 #undef IF_STM_FG_LOCKS
281 #define IF_STM_FG_LOCKS(__X) do { __X } while (0)
282 static const StgBool use_read_phase = TRUE;
284 static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
285 TRACE("%p : lock_stm()\n", trec);
288 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
289 TRACE("%p : unlock_stm()\n", trec);
292 static StgClosure *lock_tvar(StgTRecHeader *trec,
293 StgTVar *s STG_UNUSED) {
295 TRACE("%p : lock_tvar(%p)\n", trec, s);
298 result = s -> current_value;
299 } while (GET_INFO(result) == &stg_TREC_HEADER_info);
300 } while (cas(&(s -> current_value), result, trec) != result);
304 static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
307 StgBool force_update STG_UNUSED) {
308 TRACE("%p : unlock_tvar(%p, %p)\n", trec, s, c);
309 ASSERT(s -> current_value == trec);
310 s -> current_value = c;
313 static StgBool cond_lock_tvar(StgTRecHeader *trec,
315 StgClosure *expected) {
317 TRACE("%p : cond_lock_tvar(%p, %p)\n", trec, s, expected);
318 result = cas(&(s -> current_value), expected, trec);
319 TRACE("%p : %s\n", trec, result ? "success" : "failure");
320 return (result == expected);
324 /*......................................................................*/
326 // Helper functions for thread blocking and unblocking
328 static void park_tso(StgTSO *tso) {
329 ASSERT(tso -> why_blocked == NotBlocked);
330 tso -> why_blocked = BlockedOnSTM;
331 tso -> block_info.closure = (StgClosure *) END_TSO_QUEUE;
332 TRACE("park_tso on tso=%p\n", tso);
335 static void unpark_tso(Capability *cap, StgTSO *tso) {
336 // We will continue unparking threads while they remain on one of the wait
337 // queues: it's up to the thread itself to remove it from the wait queues
338 // if it decides to do so when it is scheduled.
339 if (tso -> why_blocked == BlockedOnSTM) {
340 TRACE("unpark_tso on tso=%p\n", tso);
343 TRACE("spurious unpark_tso on tso=%p\n", tso);
347 static void unpark_waiters_on(Capability *cap, StgTVar *s) {
349 TRACE("unpark_waiters_on tvar=%p\n", s);
350 for (q = s -> first_wait_queue_entry;
351 q != END_STM_WAIT_QUEUE;
352 q = q -> next_queue_entry) {
353 unpark_tso(cap, q -> waiting_tso);
357 /*......................................................................*/
359 // Helper functions for downstream allocation and initialization
361 static StgTVarWaitQueue *new_stg_tvar_wait_queue(Capability *cap,
362 StgTSO *waiting_tso) {
363 StgTVarWaitQueue *result;
364 result = (StgTVarWaitQueue *)allocateLocal(cap, sizeofW(StgTVarWaitQueue));
365 SET_HDR (result, &stg_TVAR_WAIT_QUEUE_info, CCS_SYSTEM);
366 result -> waiting_tso = waiting_tso;
370 static StgTRecChunk *new_stg_trec_chunk(Capability *cap) {
371 StgTRecChunk *result;
372 result = (StgTRecChunk *)allocateLocal(cap, sizeofW(StgTRecChunk));
373 SET_HDR (result, &stg_TREC_CHUNK_info, CCS_SYSTEM);
374 result -> prev_chunk = END_STM_CHUNK_LIST;
375 result -> next_entry_idx = 0;
379 static StgTRecHeader *new_stg_trec_header(Capability *cap,
380 StgTRecHeader *enclosing_trec) {
381 StgTRecHeader *result;
382 result = (StgTRecHeader *) allocateLocal(cap, sizeofW(StgTRecHeader));
383 SET_HDR (result, &stg_TREC_HEADER_info, CCS_SYSTEM);
385 result -> enclosing_trec = enclosing_trec;
386 result -> current_chunk = new_stg_trec_chunk(cap);
388 if (enclosing_trec == NO_TREC) {
389 result -> state = TREC_ACTIVE;
391 ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
392 enclosing_trec -> state == TREC_CONDEMNED);
393 result -> state = enclosing_trec -> state;
399 /*......................................................................*/
401 // Allocation / deallocation functions that retain per-capability lists
402 // of closures that can be re-used
404 static StgTVarWaitQueue *alloc_stg_tvar_wait_queue(Capability *cap,
405 StgTSO *waiting_tso) {
406 StgTVarWaitQueue *result = NULL;
407 if (cap -> free_tvar_wait_queues == END_STM_WAIT_QUEUE) {
408 result = new_stg_tvar_wait_queue(cap, waiting_tso);
410 result = cap -> free_tvar_wait_queues;
411 result -> waiting_tso = waiting_tso;
412 cap -> free_tvar_wait_queues = result -> next_queue_entry;
417 static void free_stg_tvar_wait_queue(Capability *cap,
418 StgTVarWaitQueue *wq) {
419 #if defined(REUSE_MEMORY)
420 wq -> next_queue_entry = cap -> free_tvar_wait_queues;
421 cap -> free_tvar_wait_queues = wq;
425 static StgTRecChunk *alloc_stg_trec_chunk(Capability *cap) {
426 StgTRecChunk *result = NULL;
427 if (cap -> free_trec_chunks == END_STM_CHUNK_LIST) {
428 result = new_stg_trec_chunk(cap);
430 result = cap -> free_trec_chunks;
431 cap -> free_trec_chunks = result -> prev_chunk;
432 result -> prev_chunk = END_STM_CHUNK_LIST;
433 result -> next_entry_idx = 0;
438 static void free_stg_trec_chunk(Capability *cap,
440 #if defined(REUSE_MEMORY)
441 c -> prev_chunk = cap -> free_trec_chunks;
442 cap -> free_trec_chunks = c;
446 static StgTRecHeader *alloc_stg_trec_header(Capability *cap,
447 StgTRecHeader *enclosing_trec) {
448 StgTRecHeader *result = NULL;
449 if (cap -> free_trec_headers == NO_TREC) {
450 result = new_stg_trec_header(cap, enclosing_trec);
452 result = cap -> free_trec_headers;
453 cap -> free_trec_headers = result -> enclosing_trec;
454 result -> enclosing_trec = enclosing_trec;
455 result -> current_chunk -> next_entry_idx = 0;
456 if (enclosing_trec == NO_TREC) {
457 result -> state = TREC_ACTIVE;
459 ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
460 enclosing_trec -> state == TREC_CONDEMNED);
461 result -> state = enclosing_trec -> state;
467 static void free_stg_trec_header(Capability *cap,
468 StgTRecHeader *trec) {
469 #if defined(REUSE_MEMORY)
470 StgTRecChunk *chunk = trec -> current_chunk -> prev_chunk;
471 while (chunk != END_STM_CHUNK_LIST) {
472 StgTRecChunk *prev_chunk = chunk -> prev_chunk;
473 free_stg_trec_chunk(cap, chunk);
476 trec -> current_chunk -> prev_chunk = END_STM_CHUNK_LIST;
477 trec -> enclosing_trec = cap -> free_trec_headers;
478 cap -> free_trec_headers = trec;
482 /*......................................................................*/
484 // Helper functions for managing waiting lists
486 static void build_wait_queue_entries_for_trec(Capability *cap,
488 StgTRecHeader *trec) {
489 ASSERT(trec != NO_TREC);
490 ASSERT(trec -> enclosing_trec == NO_TREC);
491 ASSERT(trec -> state == TREC_ACTIVE);
493 TRACE("%p : build_wait_queue_entries_for_trec()\n", trec);
495 FOR_EACH_ENTRY(trec, e, {
498 StgTVarWaitQueue *fq;
500 TRACE("%p : adding tso=%p to wait queue for tvar=%p\n", trec, tso, s);
501 ACQ_ASSERT(s -> current_value == trec);
502 NACQ_ASSERT(s -> current_value == e -> expected_value);
503 fq = s -> first_wait_queue_entry;
504 q = alloc_stg_tvar_wait_queue(cap, tso);
505 q -> next_queue_entry = fq;
506 q -> prev_queue_entry = END_STM_WAIT_QUEUE;
507 if (fq != END_STM_WAIT_QUEUE) {
508 fq -> prev_queue_entry = q;
510 s -> first_wait_queue_entry = q;
511 e -> new_value = (StgClosure *) q;
515 static void remove_wait_queue_entries_for_trec(Capability *cap,
516 StgTRecHeader *trec) {
517 ASSERT(trec != NO_TREC);
518 ASSERT(trec -> enclosing_trec == NO_TREC);
519 ASSERT(trec -> state == TREC_WAITING ||
520 trec -> state == TREC_CONDEMNED);
522 TRACE("%p : remove_wait_queue_entries_for_trec()\n", trec);
524 FOR_EACH_ENTRY(trec, e, {
526 StgTVarWaitQueue *pq;
527 StgTVarWaitQueue *nq;
530 StgClosure *saw = lock_tvar(trec, s);
531 q = (StgTVarWaitQueue *) (e -> new_value);
532 TRACE("%p : removing tso=%p from wait queue for tvar=%p\n", trec, q -> waiting_tso, s);
533 ACQ_ASSERT(s -> current_value == trec);
534 nq = q -> next_queue_entry;
535 pq = q -> prev_queue_entry;
536 if (nq != END_STM_WAIT_QUEUE) {
537 nq -> prev_queue_entry = pq;
539 if (pq != END_STM_WAIT_QUEUE) {
540 pq -> next_queue_entry = nq;
542 ASSERT (s -> first_wait_queue_entry == q);
543 s -> first_wait_queue_entry = nq;
545 free_stg_tvar_wait_queue(cap, q);
546 unlock_tvar(trec, s, saw, FALSE);
550 /*......................................................................*/
552 static TRecEntry *get_new_entry(Capability *cap,
558 c = t -> current_chunk;
559 i = c -> next_entry_idx;
560 ASSERT(c != END_STM_CHUNK_LIST);
562 if (i < TREC_CHUNK_NUM_ENTRIES) {
563 // Continue to use current chunk
564 result = &(c -> entries[i]);
565 c -> next_entry_idx ++;
567 // Current chunk is full: allocate a fresh one
569 nc = alloc_stg_trec_chunk(cap);
570 nc -> prev_chunk = c;
571 nc -> next_entry_idx = 1;
572 t -> current_chunk = nc;
573 result = &(nc -> entries[0]);
579 /*......................................................................*/
581 static void merge_update_into(Capability *cap,
584 StgClosure *expected_value,
585 StgClosure *new_value) {
588 // Look for an entry in this trec
590 FOR_EACH_ENTRY(t, e, {
595 if (e -> expected_value != expected_value) {
596 // Must abort if the two entries start from different values
597 TRACE("%p : entries inconsistent at %p (%p vs %p)\n",
598 t, tvar, e -> expected_value, expected_value);
599 t -> state = TREC_CONDEMNED;
601 e -> new_value = new_value;
607 // No entry so far in this trec
609 ne = get_new_entry(cap, t);
611 ne -> expected_value = expected_value;
612 ne -> new_value = new_value;
616 /*......................................................................*/
618 static StgBool entry_is_update(TRecEntry *e) {
620 result = (e -> expected_value != e -> new_value);
624 #if defined(STM_FG_LOCKS)
625 static StgBool entry_is_read_only(TRecEntry *e) {
627 result = (e -> expected_value == e -> new_value);
631 static StgBool tvar_is_locked(StgTVar *s, StgTRecHeader *h) {
634 c = s -> current_value;
635 result = (c == (StgClosure *) h);
640 // revert_ownership : release a lock on a TVar, storing back
641 // the value that it held when the lock was acquired. "revert_all"
642 // is set in stmWait and stmReWait when we acquired locks on all of
643 // the TVars involved. "revert_all" is not set in commit operations
644 // where we don't lock TVars that have been read from but not updated.
646 static void revert_ownership(StgTRecHeader *trec STG_UNUSED,
647 StgBool revert_all STG_UNUSED) {
648 #if defined(STM_FG_LOCKS)
649 FOR_EACH_ENTRY(trec, e, {
650 if (revert_all || entry_is_update(e)) {
653 if (tvar_is_locked(s, trec)) {
654 unlock_tvar(trec, s, e -> expected_value, TRUE);
661 /*......................................................................*/
663 // validate_and_acquire_ownership : this performs the twin functions
664 // of checking that the TVars referred to by entries in trec hold the
665 // expected values and:
667 // - locking the TVar (on updated TVars during commit, or all TVars
670 // - recording the identity of the TRec who wrote the value seen in the
671 // TVar (on non-updated TVars during commit). These values are
672 // stashed in the TRec entries and are then checked in check_read_only
673 // to ensure that an atomic snapshot of all of these locations has been
676 static StgBool validate_and_acquire_ownership (StgTRecHeader *trec,
678 int retain_ownership) {
682 TRACE("%p : shake, pretending trec is invalid when it may not be\n", trec);
686 ASSERT ((trec -> state == TREC_ACTIVE) ||
687 (trec -> state == TREC_WAITING) ||
688 (trec -> state == TREC_CONDEMNED));
689 result = !((trec -> state) == TREC_CONDEMNED);
691 FOR_EACH_ENTRY(trec, e, {
694 if (acquire_all || entry_is_update(e)) {
695 TRACE("%p : trying to acquire %p\n", trec, s);
696 if (!cond_lock_tvar(trec, s, e -> expected_value)) {
697 TRACE("%p : failed to acquire %p\n", trec, s);
702 ASSERT(use_read_phase);
704 TRACE("%p : will need to check %p\n", trec, s);
705 if (s -> current_value != e -> expected_value) {
706 TRACE("%p : doesn't match\n", trec);
710 e -> num_updates = s -> num_updates;
711 if (s -> current_value != e -> expected_value) {
712 TRACE("%p : doesn't match (race)\n", trec);
716 TRACE("%p : need to check version %d\n", trec, e -> num_updates);
723 if ((!result) || (!retain_ownership)) {
724 revert_ownership(trec, acquire_all);
730 // check_read_only : check that we've seen an atomic snapshot of the
731 // non-updated TVars accessed by a trec. This checks that the last TRec to
732 // commit an update to the TVar is unchanged since the value was stashed in
733 // validate_and_acquire_ownership. If no udpate is seen to any TVar than
734 // all of them contained their expected values at the start of the call to
737 // The paper "Concurrent programming without locks" (under submission), or
738 // Keir Fraser's PhD dissertation "Practical lock-free programming" discuss
739 // this kind of algorithm.
741 static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
742 StgBool result = TRUE;
744 ASSERT (use_read_phase);
746 FOR_EACH_ENTRY(trec, e, {
749 if (entry_is_read_only(e)) {
750 TRACE("%p : check_read_only for TVar %p, saw %d\n", trec, s, e -> num_updates);
751 if (s -> num_updates != e -> num_updates) {
752 // ||s -> current_value != e -> expected_value) {
753 TRACE("%p : mismatch\n", trec);
765 /************************************************************************/
767 void stmPreGCHook() {
771 TRACE("stmPreGCHook\n");
772 for (i = 0; i < n_capabilities; i ++) {
773 Capability *cap = &capabilities[i];
774 cap -> free_tvar_wait_queues = END_STM_WAIT_QUEUE;
775 cap -> free_trec_chunks = END_STM_CHUNK_LIST;
776 cap -> free_trec_headers = NO_TREC;
781 /************************************************************************/
783 // check_read_only relies on version numbers held in TVars' "num_updates"
784 // fields not wrapping around while a transaction is committed. The version
785 // number is incremented each time an update is committed to the TVar
786 // This is unlikely to wrap around when 32-bit integers are used for the counts,
787 // but to ensure correctness we maintain a shared count on the maximum
788 // number of commit operations that may occur and check that this has
789 // not increased by more than 2^32 during a commit.
791 #define TOKEN_BATCH_SIZE 1024
793 static volatile StgInt64 max_commits = 0;
795 static volatile StgBool token_locked = FALSE;
798 static void getTokenBatch(Capability *cap) {
799 while (cas(&token_locked, FALSE, TRUE) == TRUE) { /* nothing */ }
800 max_commits += TOKEN_BATCH_SIZE;
801 cap -> transaction_tokens = TOKEN_BATCH_SIZE;
802 token_locked = FALSE;
805 static void getToken(Capability *cap) {
806 if (cap -> transaction_tokens == 0) {
809 cap -> transaction_tokens --;
812 static void getToken(Capability *cap STG_UNUSED) {
817 /*......................................................................*/
819 StgTRecHeader *stmStartTransaction(Capability *cap,
820 StgTRecHeader *outer) {
822 TRACE("%p : stmStartTransaction with %d tokens\n",
824 cap -> transaction_tokens);
828 t = alloc_stg_trec_header(cap, outer);
829 TRACE("%p : stmStartTransaction()=%p\n", outer, t);
833 /*......................................................................*/
835 void stmAbortTransaction(Capability *cap,
836 StgTRecHeader *trec) {
837 TRACE("%p : stmAbortTransaction\n", trec);
838 ASSERT (trec != NO_TREC);
839 ASSERT ((trec -> state == TREC_ACTIVE) ||
840 (trec -> state == TREC_WAITING) ||
841 (trec -> state == TREC_CONDEMNED));
844 if (trec -> state == TREC_WAITING) {
845 ASSERT (trec -> enclosing_trec == NO_TREC);
846 TRACE("%p : stmAbortTransaction aborting waiting transaction\n", trec);
847 remove_wait_queue_entries_for_trec(cap, trec);
849 trec -> state = TREC_ABORTED;
852 free_stg_trec_header(cap, trec);
854 TRACE("%p : stmAbortTransaction done\n", trec);
857 /*......................................................................*/
859 void stmCondemnTransaction(Capability *cap,
860 StgTRecHeader *trec) {
861 TRACE("%p : stmCondemnTransaction\n", trec);
862 ASSERT (trec != NO_TREC);
863 ASSERT ((trec -> state == TREC_ACTIVE) ||
864 (trec -> state == TREC_WAITING) ||
865 (trec -> state == TREC_CONDEMNED));
868 if (trec -> state == TREC_WAITING) {
869 ASSERT (trec -> enclosing_trec == NO_TREC);
870 TRACE("%p : stmCondemnTransaction condemning waiting transaction\n", trec);
871 remove_wait_queue_entries_for_trec(cap, trec);
873 trec -> state = TREC_CONDEMNED;
876 TRACE("%p : stmCondemnTransaction done\n", trec);
879 /*......................................................................*/
881 StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec) {
882 StgTRecHeader *outer;
883 TRACE("%p : stmGetEnclosingTRec\n", trec);
884 outer = trec -> enclosing_trec;
885 TRACE("%p : stmGetEnclosingTRec()=%p\n", trec, outer);
889 /*......................................................................*/
891 StgBool stmValidateNestOfTransactions(StgTRecHeader *trec) {
895 TRACE("%p : stmValidateNestOfTransactions\n", trec);
896 ASSERT(trec != NO_TREC);
897 ASSERT((trec -> state == TREC_ACTIVE) ||
898 (trec -> state == TREC_WAITING) ||
899 (trec -> state == TREC_CONDEMNED));
905 while (t != NO_TREC) {
906 result &= validate_and_acquire_ownership(t, TRUE, FALSE);
907 t = t -> enclosing_trec;
910 if (!result && trec -> state != TREC_WAITING) {
911 trec -> state = TREC_CONDEMNED;
916 TRACE("%p : stmValidateNestOfTransactions()=%d\n", trec, result);
920 /*......................................................................*/
922 StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
924 StgInt64 max_commits_at_start = max_commits;
926 TRACE("%p : stmCommitTransaction()\n", trec);
927 ASSERT (trec != NO_TREC);
931 ASSERT (trec -> enclosing_trec == NO_TREC);
932 ASSERT ((trec -> state == TREC_ACTIVE) ||
933 (trec -> state == TREC_CONDEMNED));
935 result = validate_and_acquire_ownership(trec, (!use_read_phase), TRUE);
937 // We now know that all the updated locations hold their expected values.
938 ASSERT (trec -> state == TREC_ACTIVE);
940 if (use_read_phase) {
941 TRACE("%p : doing read check\n", trec);
942 result = check_read_only(trec);
943 TRACE("%p : read-check %s\n", trec, result ? "succeeded" : "failed");
945 StgInt64 max_commits_at_end = max_commits;
946 StgInt64 max_concurrent_commits;
947 max_concurrent_commits = ((max_commits_at_end - max_commits_at_start) +
948 (n_capabilities * TOKEN_BATCH_SIZE));
949 if (((max_concurrent_commits >> 32) > 0) || shake()) {
955 // We now know that all of the read-only locations held their exepcted values
956 // at the end of the call to validate_and_acquire_ownership. This forms the
957 // linearization point of the commit.
959 FOR_EACH_ENTRY(trec, e, {
962 if (e -> new_value != e -> expected_value) {
963 // Entry is an update: write the value back to the TVar, unlocking it if
966 ACQ_ASSERT(tvar_is_locked(s, trec));
967 TRACE("%p : writing %p to %p, waking waiters\n", trec, e -> new_value, s);
968 unpark_waiters_on(cap,s);
972 unlock_tvar(trec, s, e -> new_value, TRUE);
974 ACQ_ASSERT(!tvar_is_locked(s, trec));
977 revert_ownership(trec, FALSE);
983 free_stg_trec_header(cap, trec);
985 TRACE("%p : stmCommitTransaction()=%d\n", trec, result);
990 /*......................................................................*/
992 StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) {
995 ASSERT (trec != NO_TREC && trec -> enclosing_trec != NO_TREC);
996 TRACE("%p : stmCommitNestedTransaction() into %p\n", trec, trec -> enclosing_trec);
997 ASSERT ((trec -> state == TREC_ACTIVE) || (trec -> state == TREC_CONDEMNED));
1001 et = trec -> enclosing_trec;
1002 result = validate_and_acquire_ownership(trec, FALSE, TRUE);
1004 // We now know that all the updated locations hold their expected values.
1006 if (use_read_phase) {
1007 TRACE("%p : doing read check\n", trec);
1008 result = check_read_only(trec);
1011 // We now know that all of the read-only locations held their exepcted values
1012 // at the end of the call to validate_and_acquire_ownership. This forms the
1013 // linearization point of the commit.
1016 TRACE("%p : read-check succeeded\n", trec);
1017 FOR_EACH_ENTRY(trec, e, {
1018 // Merge each entry into the enclosing transaction record, release all
1023 if (entry_is_update(e)) {
1024 unlock_tvar(trec, s, e -> expected_value, FALSE);
1026 merge_update_into(cap, et, s, e -> expected_value, e -> new_value);
1027 ACQ_ASSERT(s -> current_value != trec);
1030 revert_ownership(trec, FALSE);
1037 free_stg_trec_header(cap, trec);
1039 TRACE("%p : stmCommitNestedTransaction()=%d\n", trec, result);
1044 /*......................................................................*/
1046 StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
1048 TRACE("%p : stmWait(%p)\n", trec, tso);
1049 ASSERT (trec != NO_TREC);
1050 ASSERT (trec -> enclosing_trec == NO_TREC);
1051 ASSERT ((trec -> state == TREC_ACTIVE) ||
1052 (trec -> state == TREC_CONDEMNED));
1055 result = validate_and_acquire_ownership(trec, TRUE, TRUE);
1057 // The transaction is valid so far so we can actually start waiting.
1058 // (Otherwise the transaction was not valid and the thread will have to
1061 // Put ourselves to sleep. We retain locks on all the TVars involved
1062 // until we are sound asleep : (a) on the wait queues, (b) BlockedOnSTM
1063 // in the TSO, (c) TREC_WAITING in the Trec.
1064 build_wait_queue_entries_for_trec(cap, tso, trec);
1066 trec -> state = TREC_WAITING;
1068 // We haven't released ownership of the transaction yet. The TSO
1069 // has been put on the wait queue for the TVars it is waiting for,
1070 // but we haven't yet tidied up the TSO's stack and made it safe
1071 // to wake up the TSO. Therefore, we must wait until the TSO is
1072 // safe to wake up before we release ownership - when all is well,
1073 // the runtime will call stmWaitUnlock() below, with the same
1078 free_stg_trec_header(cap, trec);
1081 TRACE("%p : stmWait(%p)=%d\n", trec, tso, result);
1087 stmWaitUnlock(Capability *cap STG_UNUSED, StgTRecHeader *trec) {
1088 revert_ownership(trec, TRUE);
1092 /*......................................................................*/
1094 StgBool stmReWait(Capability *cap, StgTSO *tso) {
1096 StgTRecHeader *trec = tso->trec;
1098 TRACE("%p : stmReWait\n", trec);
1099 ASSERT (trec != NO_TREC);
1100 ASSERT (trec -> enclosing_trec == NO_TREC);
1101 ASSERT ((trec -> state == TREC_WAITING) ||
1102 (trec -> state == TREC_CONDEMNED));
1105 result = validate_and_acquire_ownership(trec, TRUE, TRUE);
1106 TRACE("%p : validation %s\n", trec, result ? "succeeded" : "failed");
1108 // The transaction remains valid -- do nothing because it is already on
1110 ASSERT (trec -> state == TREC_WAITING);
1112 revert_ownership(trec, TRUE);
1114 // The transcation has become invalid. We can now remove it from the wait
1116 if (trec -> state != TREC_CONDEMNED) {
1117 remove_wait_queue_entries_for_trec (cap, trec);
1119 free_stg_trec_header(cap, trec);
1123 TRACE("%p : stmReWait()=%d\n", trec, result);
1127 /*......................................................................*/
1129 static TRecEntry *get_entry_for(StgTRecHeader *trec, StgTVar *tvar, StgTRecHeader **in) {
1130 TRecEntry *result = NULL;
1132 TRACE("%p : get_entry_for TVar %p\n", trec, tvar);
1133 ASSERT(trec != NO_TREC);
1136 FOR_EACH_ENTRY(trec, e, {
1137 if (e -> tvar == tvar) {
1145 trec = trec -> enclosing_trec;
1146 } while (result == NULL && trec != NO_TREC);
1151 static StgClosure *read_current_value(StgTRecHeader *trec STG_UNUSED, StgTVar *tvar) {
1153 result = tvar -> current_value;
1155 #if defined(STM_FG_LOCKS)
1156 while (GET_INFO(result) == &stg_TREC_HEADER_info) {
1157 TRACE("%p : read_current_value(%p) saw %p\n", trec, tvar, result);
1158 result = tvar -> current_value;
1162 TRACE("%p : read_current_value(%p)=%p\n", trec, tvar, result);
1166 /*......................................................................*/
1168 StgClosure *stmReadTVar(Capability *cap,
1169 StgTRecHeader *trec,
1171 StgTRecHeader *entry_in;
1172 StgClosure *result = NULL;
1173 TRecEntry *entry = NULL;
1174 TRACE("%p : stmReadTVar(%p)\n", trec, tvar);
1175 ASSERT (trec != NO_TREC);
1176 ASSERT (trec -> state == TREC_ACTIVE ||
1177 trec -> state == TREC_CONDEMNED);
1179 entry = get_entry_for(trec, tvar, &entry_in);
1181 if (entry != NULL) {
1182 if (entry_in == trec) {
1183 // Entry found in our trec
1184 result = entry -> new_value;
1186 // Entry found in another trec
1187 TRecEntry *new_entry = get_new_entry(cap, trec);
1188 new_entry -> tvar = tvar;
1189 new_entry -> expected_value = entry -> expected_value;
1190 new_entry -> new_value = entry -> new_value;
1191 result = new_entry -> new_value;
1195 StgClosure *current_value = read_current_value(trec, tvar);
1196 TRecEntry *new_entry = get_new_entry(cap, trec);
1197 new_entry -> tvar = tvar;
1198 new_entry -> expected_value = current_value;
1199 new_entry -> new_value = current_value;
1200 result = current_value;
1203 TRACE("%p : stmReadTVar(%p)=%p\n", trec, tvar, result);
1207 /*......................................................................*/
1209 void stmWriteTVar(Capability *cap,
1210 StgTRecHeader *trec,
1212 StgClosure *new_value) {
1214 StgTRecHeader *entry_in;
1215 TRecEntry *entry = NULL;
1216 TRACE("%p : stmWriteTVar(%p, %p)\n", trec, tvar, new_value);
1217 ASSERT (trec != NO_TREC);
1218 ASSERT (trec -> state == TREC_ACTIVE ||
1219 trec -> state == TREC_CONDEMNED);
1221 entry = get_entry_for(trec, tvar, &entry_in);
1223 if (entry != NULL) {
1224 if (entry_in == trec) {
1225 // Entry found in our trec
1226 entry -> new_value = new_value;
1228 // Entry found in another trec
1229 TRecEntry *new_entry = get_new_entry(cap, trec);
1230 new_entry -> tvar = tvar;
1231 new_entry -> expected_value = entry -> expected_value;
1232 new_entry -> new_value = new_value;
1236 StgClosure *current_value = read_current_value(trec, tvar);
1237 TRecEntry *new_entry = get_new_entry(cap, trec);
1238 new_entry -> tvar = tvar;
1239 new_entry -> expected_value = current_value;
1240 new_entry -> new_value = new_value;
1243 TRACE("%p : stmWriteTVar done\n", trec);
1246 /*......................................................................*/
1248 StgTVar *stmNewTVar(Capability *cap,
1249 StgClosure *new_value) {
1251 result = (StgTVar *)allocateLocal(cap, sizeofW(StgTVar));
1252 SET_HDR (result, &stg_TVAR_info, CCS_SYSTEM);
1253 result -> current_value = new_value;
1254 result -> first_wait_queue_entry = END_STM_WAIT_QUEUE;
1256 result -> num_updates = 0;
1261 /*......................................................................*/