exceptions: Bump submodule back to master
[ghc.git] / rts / STM.c
1 /* -----------------------------------------------------------------------------
2 * (c) The GHC Team 1998-2005
3 *
4 * STM implementation.
5 *
6 * Overview
7 * --------
8 *
9 * See the PPoPP 2005 paper "Composable memory transactions". In summary, each
10 * transaction has a TRec (transaction record) holding entries for each of the
11 * TVars (transactional variables) that it has accessed. Each entry records (a)
12 * the TVar, (b) the expected value seen in the TVar, (c) the new value that the
13 * transaction wants to write to the TVar, (d) during commit, the identity of
14 * the TRec that wrote the expected value.
15 *
16 * Separate TRecs are used for each level in a nest of transactions. This
17 * allows a nested transaction to be aborted without condemning its enclosing
18 * transactions. This is needed in the implementation of catchRetry. Note that
19 * the "expected value" in a nested transaction's TRec is the value expected to
20 * be *held in memory* if the transaction commits -- not the "new value" stored
21 * in one of the enclosing transactions. This means that validation can be done
22 * without searching through a nest of TRecs.
23 *
24 * Concurrency control
25 * -------------------
26 *
27 * Three different concurrency control schemes can be built according to the
28 * settings in STM.h:
29 *
30 * STM_UNIPROC assumes that the caller serialises invocations on the STM
31 * interface. In the Haskell RTS this means it is suitable only for
32 * non-THREADED_RTS builds.
33 *
34 * STM_CG_LOCK uses coarse-grained locking -- a single 'stm lock' is acquired
35 * during 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.
38 *
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.
42 *
43 * Concurrency control is implemented in the functions:
44 *
45 * lock_stm
46 * unlock_stm
47 * lock_tvar / cond_lock_tvar
48 * unlock_tvar
49 *
50 * The choice between STM_UNIPROC / STM_CG_LOCK / STM_FG_LOCKS affects the
51 * implementation of these functions.
52 *
53 * lock_stm & unlock_stm are straightforward : they acquire a simple spin-lock
54 * using STM_CG_LOCK, and otherwise they are no-ops.
55 *
56 * lock_tvar / cond_lock_tvar and unlock_tvar are more complex because they have
57 * other effects (present in STM_UNIPROC and STM_CG_LOCK builds) as well as the
58 * actual business of manipulating a lock (present only in STM_FG_LOCKS builds).
59 * This is because locking a TVar is implemented by writing the lock holder's
60 * TRec into the TVar's current_value field:
61 *
62 * lock_tvar - lock a specified TVar (STM_FG_LOCKS only), returning the value
63 * it contained.
64 *
65 * cond_lock_tvar - lock a specified TVar (STM_FG_LOCKS only) if it
66 * contains a specified value. Return true if this succeeds,
67 * false otherwise.
68 *
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.
71 *
72 * Using these operations, the typical pattern of a commit/validate/wait
73 * operation is to (a) lock the STM, (b) lock all the TVars being updated, (c)
74 * check that the TVars that were only read from still contain their expected
75 * values, (d) release the locks on the TVars, writing updates to them in the
76 * case of a commit, (e) unlock the STM.
77 *
78 * Queues of waiting threads hang off the first_watch_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 the
81 * TVar's lock until it has added itself to the wait queue and marked its TSO as
82 * BlockedOnSTM -- this makes sure that other threads will know to wake it.
83 *
84 * ---------------------------------------------------------------------------*/
85
86 #include "PosixSource.h"
87 #include "Rts.h"
88
89 #include "RtsUtils.h"
90 #include "Schedule.h"
91 #include "STM.h"
92 #include "Trace.h"
93 #include "Threads.h"
94 #include "sm/Storage.h"
95 #include "SMPClosureOps.h"
96
97 #include <stdio.h>
98
99 // ACQ_ASSERT is used for assertions which are only required for
100 // THREADED_RTS builds with fine-grained locking.
101
102 #if defined(STM_FG_LOCKS)
103 #define ACQ_ASSERT(_X) ASSERT(_X)
104 #define NACQ_ASSERT(_X) /*Nothing*/
105 #else
106 #define ACQ_ASSERT(_X) /*Nothing*/
107 #define NACQ_ASSERT(_X) ASSERT(_X)
108 #endif
109
110 /*......................................................................*/
111
112 #define TRACE(_x...) debugTrace(DEBUG_stm, "STM: " _x)
113
114 // If SHAKE is defined then validation will sometimes spuriously fail. They help test
115 // unusual code paths if genuine contention is rare
116 #if defined(SHAKE)
117 static int shake_ctr = 0;
118 static int shake_lim = 1;
119
120 static int shake(void) {
121 if (((shake_ctr++) % shake_lim) == 0) {
122 shake_ctr = 1;
123 shake_lim ++;
124 return true;
125 }
126 return false;
127 }
128 #else
129 static int shake(void) {
130 return false;
131 }
132 #endif
133
134 /*......................................................................*/
135
136 // Helper macros for iterating over entries within a transaction
137 // record
138
139 #define FOR_EACH_ENTRY(_t,_x,CODE) do { \
140 StgTRecHeader *__t = (_t); \
141 StgTRecChunk *__c = __t -> current_chunk; \
142 StgWord __limit = __c -> next_entry_idx; \
143 TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%ld", __t, __c, __limit); \
144 while (__c != END_STM_CHUNK_LIST) { \
145 StgWord __i; \
146 for (__i = 0; __i < __limit; __i ++) { \
147 TRecEntry *_x = &(__c -> entries[__i]); \
148 do { CODE } while (0); \
149 } \
150 __c = __c -> prev_chunk; \
151 __limit = TREC_CHUNK_NUM_ENTRIES; \
152 } \
153 exit_for_each: \
154 if (false) goto exit_for_each; \
155 } while (0)
156
157 #define BREAK_FOR_EACH goto exit_for_each
158
159 /*......................................................................*/
160
161 // if REUSE_MEMORY is defined then attempt to re-use descriptors, log chunks,
162 // and wait queue entries without GC
163
164 #define REUSE_MEMORY
165
166 /*......................................................................*/
167
168 #define IF_STM_UNIPROC(__X) do { } while (0)
169 #define IF_STM_CG_LOCK(__X) do { } while (0)
170 #define IF_STM_FG_LOCKS(__X) do { } while (0)
171
172 #if defined(STM_UNIPROC)
173 #undef IF_STM_UNIPROC
174 #define IF_STM_UNIPROC(__X) do { __X } while (0)
175 static const StgBool config_use_read_phase = false;
176
177 static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
178 TRACE("%p : lock_stm()", trec);
179 }
180
181 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
182 TRACE("%p : unlock_stm()", trec);
183 }
184
185 static StgClosure *lock_tvar(Capability *cap STG_UNUSED,
186 StgTRecHeader *trec STG_UNUSED,
187 StgTVar *s STG_UNUSED) {
188 StgClosure *result;
189 TRACE("%p : lock_tvar(%p)", trec, s);
190 result = s -> current_value;
191 return result;
192 }
193
194 static void unlock_tvar(Capability *cap,
195 StgTRecHeader *trec STG_UNUSED,
196 StgTVar *s,
197 StgClosure *c,
198 StgBool force_update) {
199 TRACE("%p : unlock_tvar(%p)", trec, s);
200 if (force_update) {
201 StgClosure *old_value = s -> current_value;
202 s -> current_value = c;
203 dirty_TVAR(cap, s, old_value);
204 }
205 }
206
207 static StgBool cond_lock_tvar(Capability *cap STG_UNUSED,
208 StgTRecHeader *trec STG_UNUSED,
209 StgTVar *s STG_UNUSED,
210 StgClosure *expected) {
211 StgClosure *result;
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);
216 }
217 #endif
218
219 #if defined(STM_CG_LOCK) /*........................................*/
220
221 #undef IF_STM_CG_LOCK
222 #define IF_STM_CG_LOCK(__X) do { __X } while (0)
223 static const StgBool config_use_read_phase = false;
224 static volatile StgTRecHeader *smp_locked = NULL;
225
226 static void lock_stm(StgTRecHeader *trec) {
227 while (cas(&smp_locked, NULL, trec) != NULL) { }
228 TRACE("%p : lock_stm()", trec);
229 }
230
231 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
232 TRACE("%p : unlock_stm()", trec);
233 ASSERT(smp_locked == trec);
234 smp_locked = 0;
235 }
236
237 static StgClosure *lock_tvar(Capability *cap STG_UNUSED,
238 StgTRecHeader *trec STG_UNUSED,
239 StgTVar *s STG_UNUSED) {
240 StgClosure *result;
241 TRACE("%p : lock_tvar(%p)", trec, s);
242 ASSERT(smp_locked == trec);
243 result = s -> current_value;
244 return result;
245 }
246
247 static void *unlock_tvar(Capability *cap,
248 StgTRecHeader *trec STG_UNUSED,
249 StgTVar *s,
250 StgClosure *c,
251 StgBool force_update) {
252 TRACE("%p : unlock_tvar(%p, %p)", trec, s, c);
253 ASSERT(smp_locked == trec);
254 if (force_update) {
255 StgClosure *old_value = s -> current_value;
256 s -> current_value = c;
257 dirty_TVAR(cap, s, old_value);
258 }
259 }
260
261 static StgBool cond_lock_tvar(Capability *cap STG_UNUSED,
262 StgTRecHeader *trec STG_UNUSED,
263 StgTVar *s STG_UNUSED,
264 StgClosure *expected) {
265 StgClosure *result;
266 TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
267 ASSERT(smp_locked == trec);
268 result = s -> current_value;
269 TRACE("%p : %d", result ? "success" : "failure");
270 return (result == expected);
271 }
272 #endif
273
274 #if defined(STM_FG_LOCKS) /*...................................*/
275
276 #undef IF_STM_FG_LOCKS
277 #define IF_STM_FG_LOCKS(__X) do { __X } while (0)
278 static const StgBool config_use_read_phase = true;
279
280 static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
281 TRACE("%p : lock_stm()", trec);
282 }
283
284 static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
285 TRACE("%p : unlock_stm()", trec);
286 }
287
288 static StgClosure *lock_tvar(Capability *cap,
289 StgTRecHeader *trec,
290 StgTVar *s STG_UNUSED) {
291 StgClosure *result;
292 TRACE("%p : lock_tvar(%p)", trec, s);
293 do {
294 do {
295 result = s -> current_value;
296 } while (GET_INFO(UNTAG_CLOSURE(result)) == &stg_TREC_HEADER_info);
297 } while (cas((void *)&(s -> current_value),
298 (StgWord)result, (StgWord)trec) != (StgWord)result);
299
300
301 IF_NONMOVING_WRITE_BARRIER_ENABLED {
302 if (result)
303 updateRemembSetPushClosure(cap, result);
304 }
305 return result;
306 }
307
308 static void unlock_tvar(Capability *cap,
309 StgTRecHeader *trec STG_UNUSED,
310 StgTVar *s,
311 StgClosure *c,
312 StgBool force_update STG_UNUSED) {
313 TRACE("%p : unlock_tvar(%p, %p)", trec, s, c);
314 ASSERT(s -> current_value == (StgClosure *)trec);
315 s -> current_value = c;
316 dirty_TVAR(cap, s, (StgClosure *) trec);
317 }
318
319 static StgBool cond_lock_tvar(Capability *cap,
320 StgTRecHeader *trec,
321 StgTVar *s,
322 StgClosure *expected) {
323 StgClosure *result;
324 StgWord w;
325 TRACE("%p : cond_lock_tvar(%p, %p)", trec, s, expected);
326 w = cas((void *)&(s -> current_value), (StgWord)expected, (StgWord)trec);
327 result = (StgClosure *)w;
328 IF_NONMOVING_WRITE_BARRIER_ENABLED {
329 if (result)
330 updateRemembSetPushClosure(cap, expected);
331 }
332 TRACE("%p : %s", trec, result ? "success" : "failure");
333 return (result == expected);
334 }
335 #endif
336
337 /*......................................................................*/
338
339 // Helper functions for thread blocking and unblocking
340
341 static void park_tso(StgTSO *tso) {
342 ASSERT(tso -> why_blocked == NotBlocked);
343 tso -> why_blocked = BlockedOnSTM;
344 tso -> block_info.closure = (StgClosure *) END_TSO_QUEUE;
345 TRACE("park_tso on tso=%p", tso);
346 }
347
348 static void unpark_tso(Capability *cap, StgTSO *tso) {
349 // We will continue unparking threads while they remain on one of the wait
350 // queues: it's up to the thread itself to remove it from the wait queues
351 // if it decides to do so when it is scheduled.
352
353 // Only the capability that owns this TSO may unblock it. We can
354 // call tryWakeupThread() which will either unblock it directly if
355 // it belongs to this cap, or send a message to the owning cap
356 // otherwise.
357
358 // TODO: This sends multiple messages if we write to the same TVar multiple
359 // times and the owning cap hasn't yet woken up the thread and removed it
360 // from the TVar's watch list. We tried to optimise this in D4961, but that
361 // patch was incorrect and broke other things, see #15544 comment:17. See
362 // #15626 for the tracking ticket.
363
364 // Safety Note: we hold the TVar lock at this point, so we know
365 // that this thread is definitely still blocked, since the first
366 // thing a thread will do when it runs is remove itself from the
367 // TVar watch queues, and to do that it would need to lock the
368 // TVar.
369
370 tryWakeupThread(cap,tso);
371 }
372
373 static void unpark_waiters_on(Capability *cap, StgTVar *s) {
374 StgTVarWatchQueue *q;
375 StgTVarWatchQueue *trail;
376 TRACE("unpark_waiters_on tvar=%p", s);
377 // unblock TSOs in reverse order, to be a bit fairer (#2319)
378 for (q = s -> first_watch_queue_entry, trail = q;
379 q != END_STM_WATCH_QUEUE;
380 q = q -> next_queue_entry) {
381 trail = q;
382 }
383 q = trail;
384 for (;
385 q != END_STM_WATCH_QUEUE;
386 q = q -> prev_queue_entry) {
387 unpark_tso(cap, (StgTSO *)(q -> closure));
388 }
389 }
390
391 /*......................................................................*/
392
393 // Helper functions for downstream allocation and initialization
394
395 static StgTVarWatchQueue *new_stg_tvar_watch_queue(Capability *cap,
396 StgClosure *closure) {
397 StgTVarWatchQueue *result;
398 result = (StgTVarWatchQueue *)allocate(cap, sizeofW(StgTVarWatchQueue));
399 SET_HDR (result, &stg_TVAR_WATCH_QUEUE_info, CCS_SYSTEM);
400 result -> closure = closure;
401 return result;
402 }
403
404 static StgTRecChunk *new_stg_trec_chunk(Capability *cap) {
405 StgTRecChunk *result;
406 result = (StgTRecChunk *)allocate(cap, sizeofW(StgTRecChunk));
407 SET_HDR (result, &stg_TREC_CHUNK_info, CCS_SYSTEM);
408 result -> prev_chunk = END_STM_CHUNK_LIST;
409 result -> next_entry_idx = 0;
410 return result;
411 }
412
413 static StgTRecHeader *new_stg_trec_header(Capability *cap,
414 StgTRecHeader *enclosing_trec) {
415 StgTRecHeader *result;
416 result = (StgTRecHeader *) allocate(cap, sizeofW(StgTRecHeader));
417 SET_HDR (result, &stg_TREC_HEADER_info, CCS_SYSTEM);
418
419 result -> enclosing_trec = enclosing_trec;
420 result -> current_chunk = new_stg_trec_chunk(cap);
421
422 if (enclosing_trec == NO_TREC) {
423 result -> state = TREC_ACTIVE;
424 } else {
425 ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
426 enclosing_trec -> state == TREC_CONDEMNED);
427 result -> state = enclosing_trec -> state;
428 }
429
430 return result;
431 }
432
433 /*......................................................................*/
434
435 // Allocation / deallocation functions that retain per-capability lists
436 // of closures that can be re-used
437
438 static StgTVarWatchQueue *alloc_stg_tvar_watch_queue(Capability *cap,
439 StgClosure *closure) {
440 StgTVarWatchQueue *result = NULL;
441 if (cap -> free_tvar_watch_queues == END_STM_WATCH_QUEUE) {
442 result = new_stg_tvar_watch_queue(cap, closure);
443 } else {
444 result = cap -> free_tvar_watch_queues;
445 result -> closure = closure;
446 cap -> free_tvar_watch_queues = result -> next_queue_entry;
447 }
448 return result;
449 }
450
451 static void free_stg_tvar_watch_queue(Capability *cap,
452 StgTVarWatchQueue *wq) {
453 #if defined(REUSE_MEMORY)
454 wq -> next_queue_entry = cap -> free_tvar_watch_queues;
455 cap -> free_tvar_watch_queues = wq;
456 #endif
457 }
458
459 static StgTRecChunk *alloc_stg_trec_chunk(Capability *cap) {
460 StgTRecChunk *result = NULL;
461 if (cap -> free_trec_chunks == END_STM_CHUNK_LIST) {
462 result = new_stg_trec_chunk(cap);
463 } else {
464 result = cap -> free_trec_chunks;
465 cap -> free_trec_chunks = result -> prev_chunk;
466 result -> prev_chunk = END_STM_CHUNK_LIST;
467 result -> next_entry_idx = 0;
468 }
469 return result;
470 }
471
472 static void free_stg_trec_chunk(Capability *cap,
473 StgTRecChunk *c) {
474 #if defined(REUSE_MEMORY)
475 c -> prev_chunk = cap -> free_trec_chunks;
476 cap -> free_trec_chunks = c;
477 #endif
478 }
479
480 static StgTRecHeader *alloc_stg_trec_header(Capability *cap,
481 StgTRecHeader *enclosing_trec) {
482 StgTRecHeader *result = NULL;
483 if (cap -> free_trec_headers == NO_TREC) {
484 result = new_stg_trec_header(cap, enclosing_trec);
485 } else {
486 result = cap -> free_trec_headers;
487 cap -> free_trec_headers = result -> enclosing_trec;
488 result -> enclosing_trec = enclosing_trec;
489 result -> current_chunk -> next_entry_idx = 0;
490 if (enclosing_trec == NO_TREC) {
491 result -> state = TREC_ACTIVE;
492 } else {
493 ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
494 enclosing_trec -> state == TREC_CONDEMNED);
495 result -> state = enclosing_trec -> state;
496 }
497 }
498 return result;
499 }
500
501 static void free_stg_trec_header(Capability *cap,
502 StgTRecHeader *trec) {
503 #if defined(REUSE_MEMORY)
504 StgTRecChunk *chunk = trec -> current_chunk -> prev_chunk;
505 while (chunk != END_STM_CHUNK_LIST) {
506 StgTRecChunk *prev_chunk = chunk -> prev_chunk;
507 free_stg_trec_chunk(cap, chunk);
508 chunk = prev_chunk;
509 }
510 trec -> current_chunk -> prev_chunk = END_STM_CHUNK_LIST;
511 trec -> enclosing_trec = cap -> free_trec_headers;
512 cap -> free_trec_headers = trec;
513 #endif
514 }
515
516 /*......................................................................*/
517
518 // Helper functions for managing waiting lists
519
520 static void build_watch_queue_entries_for_trec(Capability *cap,
521 StgTSO *tso,
522 StgTRecHeader *trec) {
523 ASSERT(trec != NO_TREC);
524 ASSERT(trec -> enclosing_trec == NO_TREC);
525 ASSERT(trec -> state == TREC_ACTIVE);
526
527 TRACE("%p : build_watch_queue_entries_for_trec()", trec);
528
529 FOR_EACH_ENTRY(trec, e, {
530 StgTVar *s;
531 StgTVarWatchQueue *q;
532 StgTVarWatchQueue *fq;
533 s = e -> tvar;
534 TRACE("%p : adding tso=%p to watch queue for tvar=%p", trec, tso, s);
535 ACQ_ASSERT(s -> current_value == (StgClosure *)trec);
536 NACQ_ASSERT(s -> current_value == e -> expected_value);
537 fq = s -> first_watch_queue_entry;
538 q = alloc_stg_tvar_watch_queue(cap, (StgClosure*) tso);
539 q -> next_queue_entry = fq;
540 q -> prev_queue_entry = END_STM_WATCH_QUEUE;
541 if (fq != END_STM_WATCH_QUEUE) {
542 fq -> prev_queue_entry = q;
543 }
544 s -> first_watch_queue_entry = q;
545 e -> new_value = (StgClosure *) q;
546 dirty_TVAR(cap, s, (StgClosure *) fq); // we modified first_watch_queue_entry
547 });
548 }
549
550 static void remove_watch_queue_entries_for_trec(Capability *cap,
551 StgTRecHeader *trec) {
552 ASSERT(trec != NO_TREC);
553 ASSERT(trec -> enclosing_trec == NO_TREC);
554 ASSERT(trec -> state == TREC_WAITING ||
555 trec -> state == TREC_CONDEMNED);
556
557 TRACE("%p : remove_watch_queue_entries_for_trec()", trec);
558
559 FOR_EACH_ENTRY(trec, e, {
560 StgTVar *s;
561 StgTVarWatchQueue *pq;
562 StgTVarWatchQueue *nq;
563 StgTVarWatchQueue *q;
564 StgClosure *saw;
565 s = e -> tvar;
566 saw = lock_tvar(cap, trec, s);
567 q = (StgTVarWatchQueue *) (e -> new_value);
568 TRACE("%p : removing tso=%p from watch queue for tvar=%p",
569 trec,
570 q -> closure,
571 s);
572 ACQ_ASSERT(s -> current_value == (StgClosure *)trec);
573 nq = q -> next_queue_entry;
574 pq = q -> prev_queue_entry;
575 if (nq != END_STM_WATCH_QUEUE) {
576 nq -> prev_queue_entry = pq;
577 }
578 if (pq != END_STM_WATCH_QUEUE) {
579 pq -> next_queue_entry = nq;
580 } else {
581 ASSERT(s -> first_watch_queue_entry == q);
582 s -> first_watch_queue_entry = nq;
583 dirty_TVAR(cap, s, (StgClosure *) q); // we modified first_watch_queue_entry
584 }
585 free_stg_tvar_watch_queue(cap, q);
586 unlock_tvar(cap, trec, s, saw, false);
587 });
588 }
589
590 /*......................................................................*/
591
592 static TRecEntry *get_new_entry(Capability *cap,
593 StgTRecHeader *t) {
594 TRecEntry *result;
595 StgTRecChunk *c;
596 int i;
597
598 c = t -> current_chunk;
599 i = c -> next_entry_idx;
600 ASSERT(c != END_STM_CHUNK_LIST);
601
602 if (i < TREC_CHUNK_NUM_ENTRIES) {
603 // Continue to use current chunk
604 result = &(c -> entries[i]);
605 c -> next_entry_idx ++;
606 } else {
607 // Current chunk is full: allocate a fresh one
608 StgTRecChunk *nc;
609 nc = alloc_stg_trec_chunk(cap);
610 nc -> prev_chunk = c;
611 nc -> next_entry_idx = 1;
612 t -> current_chunk = nc;
613 result = &(nc -> entries[0]);
614 }
615
616 return result;
617 }
618
619 /*......................................................................*/
620
621 static void merge_update_into(Capability *cap,
622 StgTRecHeader *t,
623 StgTVar *tvar,
624 StgClosure *expected_value,
625 StgClosure *new_value)
626 {
627 // Look for an entry in this trec
628 bool found = false;
629 FOR_EACH_ENTRY(t, e, {
630 StgTVar *s;
631 s = e -> tvar;
632 if (s == tvar) {
633 found = true;
634 if (e -> expected_value != expected_value) {
635 // Must abort if the two entries start from different values
636 TRACE("%p : update entries inconsistent at %p (%p vs %p)",
637 t, tvar, e -> expected_value, expected_value);
638 t -> state = TREC_CONDEMNED;
639 }
640 e -> new_value = new_value;
641 BREAK_FOR_EACH;
642 }
643 });
644
645 if (!found) {
646 // No entry so far in this trec
647 TRecEntry *ne;
648 ne = get_new_entry(cap, t);
649 ne -> tvar = tvar;
650 ne -> expected_value = expected_value;
651 ne -> new_value = new_value;
652 }
653 }
654
655 /*......................................................................*/
656
657 static void merge_read_into(Capability *cap,
658 StgTRecHeader *trec,
659 StgTVar *tvar,
660 StgClosure *expected_value)
661 {
662 StgTRecHeader *t;
663 bool found = false;
664
665 //
666 // See #7493
667 //
668 // We need to look for an existing entry *anywhere* in the stack of
669 // nested transactions. Otherwise, in stmCommitNestedTransaction()
670 // we can't tell the difference between
671 //
672 // (1) a read-only entry
673 // (2) an entry that writes back the original value
674 //
675 // Since in both cases e->new_value == e->expected_value. But in (1)
676 // we want to do nothing, and in (2) we want to update e->new_value
677 // in the outer transaction.
678 //
679 // Here we deal with the first possibility: we never create a
680 // read-only entry in an inner transaction if there is an existing
681 // outer entry; so we never have an inner read and an outer update.
682 // So then in stmCommitNestedTransaction() we know we can always
683 // write e->new_value over the outer entry, because the inner entry
684 // is the most up to date.
685 //
686 for (t = trec; !found && t != NO_TREC; t = t -> enclosing_trec)
687 {
688 FOR_EACH_ENTRY(t, e, {
689 if (e -> tvar == tvar) {
690 found = true;
691 if (e -> expected_value != expected_value) {
692 // Must abort if the two entries start from different values
693 TRACE("%p : read entries inconsistent at %p (%p vs %p)",
694 t, tvar, e -> expected_value, expected_value);
695 t -> state = TREC_CONDEMNED;
696 }
697 BREAK_FOR_EACH;
698 }
699 });
700 }
701
702 if (!found) {
703 // No entry found
704 TRecEntry *ne;
705 ne = get_new_entry(cap, trec);
706 ne -> tvar = tvar;
707 ne -> expected_value = expected_value;
708 ne -> new_value = expected_value;
709 }
710 }
711
712 /*......................................................................*/
713
714 static StgBool entry_is_update(TRecEntry *e) {
715 StgBool result;
716 result = (e -> expected_value != e -> new_value);
717 return result;
718 }
719
720 #if defined(STM_FG_LOCKS)
721 static StgBool entry_is_read_only(TRecEntry *e) {
722 StgBool result;
723 result = (e -> expected_value == e -> new_value);
724 return result;
725 }
726
727 static StgBool tvar_is_locked(StgTVar *s, StgTRecHeader *h) {
728 StgClosure *c;
729 StgBool result;
730 c = s -> current_value;
731 result = (c == (StgClosure *) h);
732 return result;
733 }
734 #endif
735
736 // revert_ownership : release a lock on a TVar, storing back
737 // the value that it held when the lock was acquired. "revert_all"
738 // is set in stmWait and stmReWait when we acquired locks on all of
739 // the TVars involved. "revert_all" is not set in commit operations
740 // where we don't lock TVars that have been read from but not updated.
741
742 static void revert_ownership(Capability *cap STG_UNUSED,
743 StgTRecHeader *trec STG_UNUSED,
744 StgBool revert_all STG_UNUSED) {
745 #if defined(STM_FG_LOCKS)
746 FOR_EACH_ENTRY(trec, e, {
747 if (revert_all || entry_is_update(e)) {
748 StgTVar *s;
749 s = e -> tvar;
750 if (tvar_is_locked(s, trec)) {
751 unlock_tvar(cap, trec, s, e -> expected_value, true);
752 }
753 }
754 });
755 #endif
756 }
757
758 /*......................................................................*/
759
760 // validate_and_acquire_ownership : this performs the twin functions
761 // of checking that the TVars referred to by entries in trec hold the
762 // expected values and:
763 //
764 // - locking the TVar (on updated TVars during commit, or all TVars
765 // during wait)
766 //
767 // - recording the identity of the TRec who wrote the value seen in the
768 // TVar (on non-updated TVars during commit). These values are
769 // stashed in the TRec entries and are then checked in check_read_only
770 // to ensure that an atomic snapshot of all of these locations has been
771 // seen.
772
773 static StgBool validate_and_acquire_ownership (Capability *cap,
774 StgTRecHeader *trec,
775 int acquire_all,
776 int retain_ownership) {
777 StgBool result;
778
779 if (shake()) {
780 TRACE("%p : shake, pretending trec is invalid when it may not be", trec);
781 return false;
782 }
783
784 ASSERT((trec -> state == TREC_ACTIVE) ||
785 (trec -> state == TREC_WAITING) ||
786 (trec -> state == TREC_CONDEMNED));
787 result = !((trec -> state) == TREC_CONDEMNED);
788 if (result) {
789 FOR_EACH_ENTRY(trec, e, {
790 StgTVar *s;
791 s = e -> tvar;
792 if (acquire_all || entry_is_update(e)) {
793 TRACE("%p : trying to acquire %p", trec, s);
794 if (!cond_lock_tvar(cap, trec, s, e -> expected_value)) {
795 TRACE("%p : failed to acquire %p", trec, s);
796 result = false;
797 BREAK_FOR_EACH;
798 }
799 } else {
800 ASSERT(config_use_read_phase);
801 IF_STM_FG_LOCKS({
802 TRACE("%p : will need to check %p", trec, s);
803 if (s -> current_value != e -> expected_value) {
804 TRACE("%p : doesn't match", trec);
805 result = false;
806 BREAK_FOR_EACH;
807 }
808 e -> num_updates = s -> num_updates;
809 if (s -> current_value != e -> expected_value) {
810 TRACE("%p : doesn't match (race)", trec);
811 result = false;
812 BREAK_FOR_EACH;
813 } else {
814 TRACE("%p : need to check version %ld", trec, e -> num_updates);
815 }
816 });
817 }
818 });
819 }
820
821 if ((!result) || (!retain_ownership)) {
822 revert_ownership(cap, trec, acquire_all);
823 }
824
825 return result;
826 }
827
828 // check_read_only : check that we've seen an atomic snapshot of the
829 // non-updated TVars accessed by a trec. This checks that the last TRec to
830 // commit an update to the TVar is unchanged since the value was stashed in
831 // validate_and_acquire_ownership. If no udpate is seen to any TVar than
832 // all of them contained their expected values at the start of the call to
833 // check_read_only.
834 //
835 // The paper "Concurrent programming without locks" (under submission), or
836 // Keir Fraser's PhD dissertation "Practical lock-free programming" discuss
837 // this kind of algorithm.
838
839 static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
840 StgBool result = true;
841
842 ASSERT(config_use_read_phase);
843 IF_STM_FG_LOCKS({
844 FOR_EACH_ENTRY(trec, e, {
845 StgTVar *s;
846 s = e -> tvar;
847 if (entry_is_read_only(e)) {
848 TRACE("%p : check_read_only for TVar %p, saw %ld", trec, s, e -> num_updates);
849
850 // Note we need both checks and in this order as the TVar could be
851 // locked by another transaction that is committing but has not yet
852 // incremented `num_updates` (See #7815).
853 if (s -> current_value != e -> expected_value ||
854 s -> num_updates != e -> num_updates) {
855 TRACE("%p : mismatch", trec);
856 result = false;
857 BREAK_FOR_EACH;
858 }
859 }
860 });
861 });
862
863 return result;
864 }
865
866
867 /************************************************************************/
868
869 void stmPreGCHook (Capability *cap) {
870 lock_stm(NO_TREC);
871 TRACE("stmPreGCHook");
872 cap->free_tvar_watch_queues = END_STM_WATCH_QUEUE;
873 cap->free_trec_chunks = END_STM_CHUNK_LIST;
874 cap->free_trec_headers = NO_TREC;
875 unlock_stm(NO_TREC);
876 }
877
878 /************************************************************************/
879
880 // check_read_only relies on version numbers held in TVars' "num_updates"
881 // fields not wrapping around while a transaction is committed. The version
882 // number is incremented each time an update is committed to the TVar
883 // This is unlikely to wrap around when 32-bit integers are used for the counts,
884 // but to ensure correctness we maintain a shared count on the maximum
885 // number of commit operations that may occur and check that this has
886 // not increased by more than 2^32 during a commit.
887
888 #define TOKEN_BATCH_SIZE 1024
889
890 static volatile StgInt64 max_commits = 0;
891
892 #if defined(THREADED_RTS)
893 static volatile StgWord token_locked = false;
894
895 static void getTokenBatch(Capability *cap) {
896 while (cas((void *)&token_locked, false, true) == true) { /* nothing */ }
897 max_commits += TOKEN_BATCH_SIZE;
898 TRACE("%p : cap got token batch, max_commits=%" FMT_Int64, cap, max_commits);
899 cap -> transaction_tokens = TOKEN_BATCH_SIZE;
900 token_locked = false;
901 }
902
903 static void getToken(Capability *cap) {
904 if (cap -> transaction_tokens == 0) {
905 getTokenBatch(cap);
906 }
907 cap -> transaction_tokens --;
908 }
909 #else
910 static void getToken(Capability *cap STG_UNUSED) {
911 // Nothing
912 }
913 #endif
914
915 /*......................................................................*/
916
917 StgTRecHeader *stmStartTransaction(Capability *cap,
918 StgTRecHeader *outer) {
919 StgTRecHeader *t;
920 TRACE("%p : stmStartTransaction with %d tokens",
921 outer,
922 cap -> transaction_tokens);
923
924 getToken(cap);
925
926 t = alloc_stg_trec_header(cap, outer);
927 TRACE("%p : stmStartTransaction()=%p", outer, t);
928 return t;
929 }
930
931 /*......................................................................*/
932
933 void stmAbortTransaction(Capability *cap,
934 StgTRecHeader *trec) {
935 StgTRecHeader *et;
936 TRACE("%p : stmAbortTransaction", trec);
937 ASSERT(trec != NO_TREC);
938 ASSERT((trec -> state == TREC_ACTIVE) ||
939 (trec -> state == TREC_WAITING) ||
940 (trec -> state == TREC_CONDEMNED));
941
942 lock_stm(trec);
943
944 et = trec -> enclosing_trec;
945 if (et == NO_TREC) {
946 // We're a top-level transaction: remove any watch queue entries that
947 // we may have.
948 TRACE("%p : aborting top-level transaction", trec);
949
950 if (trec -> state == TREC_WAITING) {
951 ASSERT(trec -> enclosing_trec == NO_TREC);
952 TRACE("%p : stmAbortTransaction aborting waiting transaction", trec);
953 remove_watch_queue_entries_for_trec(cap, trec);
954 }
955
956 } else {
957 // We're a nested transaction: merge our read set into our parent's
958 TRACE("%p : retaining read-set into parent %p", trec, et);
959
960 FOR_EACH_ENTRY(trec, e, {
961 StgTVar *s = e -> tvar;
962 merge_read_into(cap, et, s, e -> expected_value);
963 });
964 }
965
966 trec -> state = TREC_ABORTED;
967 unlock_stm(trec);
968
969 TRACE("%p : stmAbortTransaction done", trec);
970 }
971
972 /*......................................................................*/
973
974 void stmFreeAbortedTRec(Capability *cap,
975 StgTRecHeader *trec) {
976 TRACE("%p : stmFreeAbortedTRec", trec);
977 ASSERT(trec != NO_TREC);
978 ASSERT((trec -> state == TREC_CONDEMNED) ||
979 (trec -> state == TREC_ABORTED));
980
981 free_stg_trec_header(cap, trec);
982
983 TRACE("%p : stmFreeAbortedTRec done", trec);
984 }
985
986 /*......................................................................*/
987
988 void stmCondemnTransaction(Capability *cap,
989 StgTRecHeader *trec) {
990 TRACE("%p : stmCondemnTransaction", trec);
991 ASSERT(trec != NO_TREC);
992 ASSERT((trec -> state == TREC_ACTIVE) ||
993 (trec -> state == TREC_WAITING) ||
994 (trec -> state == TREC_CONDEMNED));
995
996 lock_stm(trec);
997 if (trec -> state == TREC_WAITING) {
998 ASSERT(trec -> enclosing_trec == NO_TREC);
999 TRACE("%p : stmCondemnTransaction condemning waiting transaction", trec);
1000 remove_watch_queue_entries_for_trec(cap, trec);
1001 }
1002 trec -> state = TREC_CONDEMNED;
1003 unlock_stm(trec);
1004
1005 TRACE("%p : stmCondemnTransaction done", trec);
1006 }
1007
1008 /*......................................................................*/
1009
1010 StgBool stmValidateNestOfTransactions(Capability *cap, StgTRecHeader *trec) {
1011 StgTRecHeader *t;
1012
1013 TRACE("%p : stmValidateNestOfTransactions", trec);
1014 ASSERT(trec != NO_TREC);
1015 ASSERT((trec -> state == TREC_ACTIVE) ||
1016 (trec -> state == TREC_WAITING) ||
1017 (trec -> state == TREC_CONDEMNED));
1018
1019 lock_stm(trec);
1020
1021 t = trec;
1022 StgBool result = true;
1023 while (t != NO_TREC) {
1024 result &= validate_and_acquire_ownership(cap, t, true, false);
1025 t = t -> enclosing_trec;
1026 }
1027
1028 if (!result && trec -> state != TREC_WAITING) {
1029 trec -> state = TREC_CONDEMNED;
1030 }
1031
1032 unlock_stm(trec);
1033
1034 TRACE("%p : stmValidateNestOfTransactions()=%d", trec, result);
1035 return result;
1036 }
1037
1038 /*......................................................................*/
1039
1040 static TRecEntry *get_entry_for(StgTRecHeader *trec, StgTVar *tvar, StgTRecHeader **in) {
1041 TRecEntry *result = NULL;
1042
1043 TRACE("%p : get_entry_for TVar %p", trec, tvar);
1044 ASSERT(trec != NO_TREC);
1045
1046 do {
1047 FOR_EACH_ENTRY(trec, e, {
1048 if (e -> tvar == tvar) {
1049 result = e;
1050 if (in != NULL) {
1051 *in = trec;
1052 }
1053 BREAK_FOR_EACH;
1054 }
1055 });
1056 trec = trec -> enclosing_trec;
1057 } while (result == NULL && trec != NO_TREC);
1058
1059 return result;
1060 }
1061
1062 /*......................................................................*/
1063
1064 StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
1065 StgInt64 max_commits_at_start = max_commits;
1066
1067 TRACE("%p : stmCommitTransaction()", trec);
1068 ASSERT(trec != NO_TREC);
1069
1070 lock_stm(trec);
1071
1072 ASSERT(trec -> enclosing_trec == NO_TREC);
1073 ASSERT((trec -> state == TREC_ACTIVE) ||
1074 (trec -> state == TREC_CONDEMNED));
1075
1076 // Use a read-phase (i.e. don't lock TVars we've read but not updated) if
1077 // the configuration lets us use a read phase.
1078
1079 bool result = validate_and_acquire_ownership(cap, trec, (!config_use_read_phase), true);
1080 if (result) {
1081 // We now know that all the updated locations hold their expected values.
1082 ASSERT(trec -> state == TREC_ACTIVE);
1083
1084 if (config_use_read_phase) {
1085 StgInt64 max_commits_at_end;
1086 StgInt64 max_concurrent_commits;
1087 TRACE("%p : doing read check", trec);
1088 result = check_read_only(trec);
1089 TRACE("%p : read-check %s", trec, result ? "succeeded" : "failed");
1090
1091 max_commits_at_end = max_commits;
1092 max_concurrent_commits = ((max_commits_at_end - max_commits_at_start) +
1093 (n_capabilities * TOKEN_BATCH_SIZE));
1094 if (((max_concurrent_commits >> 32) > 0) || shake()) {
1095 result = false;
1096 }
1097 }
1098
1099 if (result) {
1100 // We now know that all of the read-only locations held their expected values
1101 // at the end of the call to validate_and_acquire_ownership. This forms the
1102 // linearization point of the commit.
1103
1104 // Make the updates required by the transaction.
1105 FOR_EACH_ENTRY(trec, e, {
1106 StgTVar *s;
1107 s = e -> tvar;
1108 if ((!config_use_read_phase) || (e -> new_value != e -> expected_value)) {
1109 // Either the entry is an update or we're not using a read phase:
1110 // write the value back to the TVar, unlocking it if necessary.
1111
1112 ACQ_ASSERT(tvar_is_locked(s, trec));
1113 TRACE("%p : writing %p to %p, waking waiters", trec, e -> new_value, s);
1114 unpark_waiters_on(cap,s);
1115 IF_STM_FG_LOCKS({
1116 s -> num_updates ++;
1117 });
1118 unlock_tvar(cap, trec, s, e -> new_value, true);
1119 }
1120 ACQ_ASSERT(!tvar_is_locked(s, trec));
1121 });
1122 } else {
1123 revert_ownership(cap, trec, false);
1124 }
1125 }
1126
1127 unlock_stm(trec);
1128
1129 free_stg_trec_header(cap, trec);
1130
1131 TRACE("%p : stmCommitTransaction()=%d", trec, result);
1132
1133 return result;
1134 }
1135
1136 /*......................................................................*/
1137
1138 StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) {
1139 StgTRecHeader *et;
1140 ASSERT(trec != NO_TREC && trec -> enclosing_trec != NO_TREC);
1141 TRACE("%p : stmCommitNestedTransaction() into %p", trec, trec -> enclosing_trec);
1142 ASSERT((trec -> state == TREC_ACTIVE) || (trec -> state == TREC_CONDEMNED));
1143
1144 lock_stm(trec);
1145
1146 et = trec -> enclosing_trec;
1147 bool result = validate_and_acquire_ownership(cap, trec, (!config_use_read_phase), true);
1148 if (result) {
1149 // We now know that all the updated locations hold their expected values.
1150
1151 if (config_use_read_phase) {
1152 TRACE("%p : doing read check", trec);
1153 result = check_read_only(trec);
1154 }
1155 if (result) {
1156 // We now know that all of the read-only locations held their expected values
1157 // at the end of the call to validate_and_acquire_ownership. This forms the
1158 // linearization point of the commit.
1159
1160 TRACE("%p : read-check succeeded", trec);
1161 FOR_EACH_ENTRY(trec, e, {
1162 // Merge each entry into the enclosing transaction record, release all
1163 // locks.
1164
1165 StgTVar *s;
1166 s = e -> tvar;
1167 if (entry_is_update(e)) {
1168 unlock_tvar(cap, trec, s, e -> expected_value, false);
1169 }
1170 merge_update_into(cap, et, s, e -> expected_value, e -> new_value);
1171 ACQ_ASSERT(s -> current_value != (StgClosure *)trec);
1172 });
1173 } else {
1174 revert_ownership(cap, trec, false);
1175 }
1176 }
1177
1178 unlock_stm(trec);
1179
1180 free_stg_trec_header(cap, trec);
1181
1182 TRACE("%p : stmCommitNestedTransaction()=%d", trec, result);
1183
1184 return result;
1185 }
1186
1187 /*......................................................................*/
1188
1189 StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
1190 TRACE("%p : stmWait(%p)", trec, tso);
1191 ASSERT(trec != NO_TREC);
1192 ASSERT(trec -> enclosing_trec == NO_TREC);
1193 ASSERT((trec -> state == TREC_ACTIVE) ||
1194 (trec -> state == TREC_CONDEMNED));
1195
1196 lock_stm(trec);
1197 bool result = validate_and_acquire_ownership(cap, trec, true, true);
1198 if (result) {
1199 // The transaction is valid so far so we can actually start waiting.
1200 // (Otherwise the transaction was not valid and the thread will have to
1201 // retry it).
1202
1203 // Put ourselves to sleep. We retain locks on all the TVars involved
1204 // until we are sound asleep : (a) on the wait queues, (b) BlockedOnSTM
1205 // in the TSO, (c) TREC_WAITING in the Trec.
1206 build_watch_queue_entries_for_trec(cap, tso, trec);
1207 park_tso(tso);
1208 trec -> state = TREC_WAITING;
1209
1210 // We haven't released ownership of the transaction yet. The TSO
1211 // has been put on the wait queue for the TVars it is waiting for,
1212 // but we haven't yet tidied up the TSO's stack and made it safe
1213 // to wake up the TSO. Therefore, we must wait until the TSO is
1214 // safe to wake up before we release ownership - when all is well,
1215 // the runtime will call stmWaitUnlock() below, with the same
1216 // TRec.
1217
1218 } else {
1219 unlock_stm(trec);
1220 free_stg_trec_header(cap, trec);
1221 }
1222
1223 TRACE("%p : stmWait(%p)=%d", trec, tso, result);
1224 return result;
1225 }
1226
1227
1228 void
1229 stmWaitUnlock(Capability *cap, StgTRecHeader *trec) {
1230 revert_ownership(cap, trec, true);
1231 unlock_stm(trec);
1232 }
1233
1234 /*......................................................................*/
1235
1236 StgBool stmReWait(Capability *cap, StgTSO *tso) {
1237 StgTRecHeader *trec = tso->trec;
1238
1239 TRACE("%p : stmReWait", trec);
1240 ASSERT(trec != NO_TREC);
1241 ASSERT(trec -> enclosing_trec == NO_TREC);
1242 ASSERT((trec -> state == TREC_WAITING) ||
1243 (trec -> state == TREC_CONDEMNED));
1244
1245 lock_stm(trec);
1246 bool result = validate_and_acquire_ownership(cap, trec, true, true);
1247 TRACE("%p : validation %s", trec, result ? "succeeded" : "failed");
1248 if (result) {
1249 // The transaction remains valid -- do nothing because it is already on
1250 // the wait queues
1251 ASSERT(trec -> state == TREC_WAITING);
1252 park_tso(tso);
1253 revert_ownership(cap, trec, true);
1254 } else {
1255 // The transcation has become invalid. We can now remove it from the wait
1256 // queues.
1257 if (trec -> state != TREC_CONDEMNED) {
1258 remove_watch_queue_entries_for_trec (cap, trec);
1259 }
1260 free_stg_trec_header(cap, trec);
1261 }
1262 unlock_stm(trec);
1263
1264 TRACE("%p : stmReWait()=%d", trec, result);
1265 return result;
1266 }
1267
1268 /*......................................................................*/
1269
1270 static StgClosure *read_current_value(StgTRecHeader *trec STG_UNUSED, StgTVar *tvar) {
1271 StgClosure *result;
1272 result = tvar -> current_value;
1273
1274 #if defined(STM_FG_LOCKS)
1275 while (GET_INFO(UNTAG_CLOSURE(result)) == &stg_TREC_HEADER_info) {
1276 TRACE("%p : read_current_value(%p) saw %p", trec, tvar, result);
1277 result = tvar -> current_value;
1278 }
1279 #endif
1280
1281 TRACE("%p : read_current_value(%p)=%p", trec, tvar, result);
1282 return result;
1283 }
1284
1285 /*......................................................................*/
1286
1287 StgClosure *stmReadTVar(Capability *cap,
1288 StgTRecHeader *trec,
1289 StgTVar *tvar) {
1290 StgTRecHeader *entry_in = NULL;
1291 StgClosure *result = NULL;
1292 TRecEntry *entry = NULL;
1293 TRACE("%p : stmReadTVar(%p)", trec, tvar);
1294 ASSERT(trec != NO_TREC);
1295 ASSERT(trec -> state == TREC_ACTIVE ||
1296 trec -> state == TREC_CONDEMNED);
1297
1298 entry = get_entry_for(trec, tvar, &entry_in);
1299
1300 if (entry != NULL) {
1301 if (entry_in == trec) {
1302 // Entry found in our trec
1303 result = entry -> new_value;
1304 } else {
1305 // Entry found in another trec
1306 TRecEntry *new_entry = get_new_entry(cap, trec);
1307 new_entry -> tvar = tvar;
1308 new_entry -> expected_value = entry -> expected_value;
1309 new_entry -> new_value = entry -> new_value;
1310 result = new_entry -> new_value;
1311 }
1312 } else {
1313 // No entry found
1314 StgClosure *current_value = read_current_value(trec, tvar);
1315 TRecEntry *new_entry = get_new_entry(cap, trec);
1316 new_entry -> tvar = tvar;
1317 new_entry -> expected_value = current_value;
1318 new_entry -> new_value = current_value;
1319 result = current_value;
1320 }
1321
1322 TRACE("%p : stmReadTVar(%p)=%p", trec, tvar, result);
1323 return result;
1324 }
1325
1326 /*......................................................................*/
1327
1328 void stmWriteTVar(Capability *cap,
1329 StgTRecHeader *trec,
1330 StgTVar *tvar,
1331 StgClosure *new_value) {
1332
1333 StgTRecHeader *entry_in = NULL;
1334 TRecEntry *entry = NULL;
1335 TRACE("%p : stmWriteTVar(%p, %p)", trec, tvar, new_value);
1336 ASSERT(trec != NO_TREC);
1337 ASSERT(trec -> state == TREC_ACTIVE ||
1338 trec -> state == TREC_CONDEMNED);
1339
1340 entry = get_entry_for(trec, tvar, &entry_in);
1341
1342 if (entry != NULL) {
1343 if (entry_in == trec) {
1344 // Entry found in our trec
1345 entry -> new_value = new_value;
1346 } else {
1347 // Entry found in another trec
1348 TRecEntry *new_entry = get_new_entry(cap, trec);
1349 new_entry -> tvar = tvar;
1350 new_entry -> expected_value = entry -> expected_value;
1351 new_entry -> new_value = new_value;
1352 }
1353 } else {
1354 // No entry found
1355 StgClosure *current_value = read_current_value(trec, tvar);
1356 TRecEntry *new_entry = get_new_entry(cap, trec);
1357 new_entry -> tvar = tvar;
1358 new_entry -> expected_value = current_value;
1359 new_entry -> new_value = new_value;
1360 }
1361
1362 TRACE("%p : stmWriteTVar done", trec);
1363 }
1364
1365 /*......................................................................*/