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