[project @ 2004-11-18 09:56:07 by tharris]

Support for atomic memory transactions and associated regression tests conc041-048

ghc/compiler/codeGen/CgPrimOp.hs

@@ -486,6 +486,7 @@ translateOp SameMutVarOp           = Just mo_wordEq
 translateOp SameMVarOp             = Just mo_wordEq
 translateOp SameMutableArrayOp     = Just mo_wordEq
 translateOp SameMutableByteArrayOp = Just mo_wordEq
+translateOp SameTVarOp             = Just mo_wordEq
 translateOp EqForeignObj           = Just mo_wordEq
 translateOp EqStablePtrOp          = Just mo_wordEq
 

ghc/compiler/prelude/PrelNames.lhs

@@ -789,6 +789,7 @@ threadIdPrimTyConKey			= mkPreludeTyConUnique 72
 bcoPrimTyConKey				= mkPreludeTyConUnique 73
 ptrTyConKey				= mkPreludeTyConUnique 74
 funPtrTyConKey				= mkPreludeTyConUnique 75
+tVarPrimTyConKey		    	= mkPreludeTyConUnique 76
 
 -- Generic Type Constructors
 crossTyConKey		      		= mkPreludeTyConUnique 79

ghc/compiler/prelude/TysPrim.lhs

@@ -28,6 +28,7 @@ module TysPrim(
 	mutVarPrimTyCon,		mkMutVarPrimTy,
 
 	mVarPrimTyCon,			mkMVarPrimTy,	
+        tVarPrimTyCon,                  mkTVarPrimTy,
 	stablePtrPrimTyCon,		mkStablePtrPrimTy,
 	stableNamePrimTyCon,		mkStableNamePrimTy,
 	bcoPrimTyCon,			bcoPrimTy,
@@ -87,6 +88,7 @@ primTyCons
     , mutableArrayPrimTyCon
     , mutableByteArrayPrimTyCon
     , mVarPrimTyCon
+    , tVarPrimTyCon
     , mutVarPrimTyCon
     , realWorldTyCon
     , stablePtrPrimTyCon
@@ -124,6 +126,7 @@ mutableArrayPrimTyConName     = mkPrimTc FSLIT("MutableArray#") mutableArrayPrim
 mutableByteArrayPrimTyConName = mkPrimTc FSLIT("MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
 mutVarPrimTyConName	      = mkPrimTc FSLIT("MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
 mVarPrimTyConName	      = mkPrimTc FSLIT("MVar#") mVarPrimTyConKey mVarPrimTyCon
+tVarPrimTyConName	      = mkPrimTc FSLIT("TVar#") tVarPrimTyConKey tVarPrimTyCon
 stablePtrPrimTyConName        = mkPrimTc FSLIT("StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon
 stableNamePrimTyConName       = mkPrimTc FSLIT("StableName#") stableNamePrimTyConKey stableNamePrimTyCon
 foreignObjPrimTyConName       = mkPrimTc FSLIT("ForeignObj#") foreignObjPrimTyConKey foreignObjPrimTyCon
@@ -312,6 +315,18 @@ mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep
 mkMVarPrimTy s elt 	    = mkTyConApp mVarPrimTyCon [s, elt]
 \end{code}
 
+%************************************************************************
+%*									*
+\subsection[TysPrim-stm-var]{The transactional variable type}
+%*									*
+%************************************************************************
+
+\begin{code}
+tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName vrcsZP PtrRep
+
+mkTVarPrimTy s elt 	    = mkTyConApp tVarPrimTyCon [s, elt]
+\end{code}
+
 %************************************************************************
 %*									*
 \subsection[TysPrim-stable-ptrs]{The stable-pointer type}

ghc/compiler/prelude/primops.txt.pp

 -----------------------------------------------------------------------
--- $Id: primops.txt.pp,v 1.30 2003/10/01 10:57:39 wolfgang Exp $
+-- $Id: primops.txt.pp,v 1.31 2004/11/18 09:56:15 tharris Exp $
 --
 -- Primitive Operations
 --
@@ -1333,6 +1333,66 @@ primop  UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp
    with
    out_of_line = True
 
+------------------------------------------------------------------------
+section "STM-accessible Mutable Variables"
+------------------------------------------------------------------------
+
+primop	AtomicallyOp "atomically#" GenPrimOp
+      (State# RealWorld -> (# State# RealWorld, a #) )
+   -> State# RealWorld -> (# State# RealWorld, a #)
+   with
+   out_of_line = True
+   has_side_effects = True
+
+primop  RetryOp "retry#" GenPrimOp
+   State# RealWorld -> (# State# RealWorld, a #)
+   with 
+   out_of_line = True
+   has_side_effects = True
+
+primop  CatchRetryOp "catchRetry#" GenPrimOp
+      (State# RealWorld -> (# State# RealWorld, a #) )
+   -> (State# RealWorld -> (# State# RealWorld, a #) )
+   -> (State# RealWorld -> (# State# RealWorld, a #) )
+   with 
+   out_of_line = True
+   has_side_effects = True
+
+primop  CatchSTMOp "catchSTM#" GenPrimOp
+      (State# RealWorld -> (# State# RealWorld, a #) )
+   -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
+   -> (State# RealWorld -> (# State# RealWorld, a #) )
+   with 
+   out_of_line = True
+   has_side_effects = True
+
+primop	NewTVarOp "newTVar#" GenPrimOp
+       a
+    -> State# s -> (# State# s, TVar# s a #)
+   {Create a new Tar\# holding a specified initial value.}
+   with
+   out_of_line  = True
+
+primop	ReadTVarOp "readTVar#" GenPrimOp
+       TVar# s a
+    -> State# s -> (# State# s, a #)
+   {Read contents of TVar\#.  Result is not yet evaluated.}
+   with
+   out_of_line	= True
+
+primop	WriteTVarOp "writeTVar#" GenPrimOp
+       TVar# s a
+    -> a
+    -> State# s -> State# s
+   {Write contents of TVar\#.}
+   with
+   out_of_line	    = True
+   has_side_effects = True
+
+primop  SameTVarOp "sameTVar#" GenPrimOp
+   TVar# s a -> TVar# s a -> Bool
+
+
 ------------------------------------------------------------------------
 section "Synchronized Mutable Variables"
 	{Operations on MVar\#s, which are shared mutable variables

ghc/includes/ClosureTypes.h

 /* ----------------------------------------------------------------------------
- * $Id: ClosureTypes.h,v 1.18 2002/12/11 15:36:37 simonmar Exp $
+ * $Id: ClosureTypes.h,v 1.19 2004/11/18 09:56:17 tharris Exp $
  * 
  * (c) The GHC Team, 1998-1999
  *
@@ -79,6 +79,13 @@
 #define RBH                     63
 #define EVACUATED               64
 #define REMOTE_REF              65
-#define N_CLOSURE_TYPES         66
+#define TVAR_WAIT_QUEUE         66
+#define TVAR                    67
+#define TREC_CHUNK              68
+#define TREC_HEADER             69
+#define ATOMICALLY_FRAME        70
+#define CATCH_RETRY_FRAME       71
+#define CATCH_STM_FRAME         72
+#define N_CLOSURE_TYPES         73
 				
 #endif /* CLOSURETYPES_H */

ghc/includes/Closures.h

@@ -308,6 +308,93 @@ typedef struct {
   StgClosure*     value;
 } StgMVar;
 
+/* STM data structures
+ *
+ *  StgTVar defines the only type that can be updated through the STM
+ *  interface.
+ * 
+ *  Note that various optimisations may be possible in order to use less
+ *  space for these data structures at the cost of more complexity in the
+ *  implementation:
+ *
+ *   - In StgTVar, current_value and first_wait_queue_entry could be held in
+ *     the same field: if any thread is waiting then its expected_value for
+ *     the tvar is the current value.  
+ *
+ *   - In StgTRecHeader, it might be worthwhile having separate chunks
+ *     of read-only and read-write locations.  This would save a
+ *     new_value field in the read-only locations.
+ */
+
+typedef struct StgTVarWaitQueue_ {
+  StgHeader                  header;
+  struct StgTSO_            *waiting_tso;
+  StgMutClosure             *mut_link;
+  struct StgTVarWaitQueue_  *next_queue_entry;
+  struct StgTVarWaitQueue_  *prev_queue_entry;
+} StgTVarWaitQueue;
+
+typedef struct {
+  StgHeader                  header;
+  StgClosure                *current_value;
+  StgMutClosure             *mut_link;
+  StgTVarWaitQueue          *first_wait_queue_entry;
+} StgTVar;
+
+// new_value == expected_value for read-only accesses
+// new_value is a StgTVarWaitQueue entry when trec in state TREC_WAITING
+typedef struct {
+  StgTVar                   *tvar;
+  StgClosure                *expected_value;
+  StgClosure                *new_value; 
+} TRecEntry;
+
+#define TREC_CHUNK_NUM_ENTRIES 256
+
+typedef struct StgTRecChunk_ {
+  StgHeader                  header;
+  struct StgTRecChunk_      *prev_chunk;
+  StgMutClosure             *mut_link;
+  StgWord                    next_entry_idx;
+  TRecEntry                  entries[TREC_CHUNK_NUM_ENTRIES];
+} StgTRecChunk;
+
+typedef enum { 
+  TREC_ACTIVE,        // Transaction in progress, outcome undecided
+  TREC_CANNOT_COMMIT, // Transaction in progress, inconsistent writes performed
+  TREC_MUST_ABORT,    // Transaction in progress, inconsistent / out of date reads
+  TREC_COMMITTED,     // Transaction has committed, now updating tvars
+  TREC_ABORTED,       // Transaction has aborted, now reverting tvars
+  TREC_WAITING,       // Transaction currently waiting
+} TRecState;
+
+typedef struct StgTRecHeader_ {
+  StgHeader                  header;
+  TRecState                  state;
+  StgMutClosure             *mut_link;
+  struct StgTRecHeader_     *enclosing_trec;
+  StgTRecChunk              *current_chunk;
+} StgTRecHeader;
+
+typedef struct {
+    StgHeader   header;
+    StgBool     waiting;
+    StgClosure *code;
+} StgAtomicallyFrame;
+
+typedef struct {
+    StgHeader   header;
+    StgClosure *handler;
+} StgCatchSTMFrame;
+
+typedef struct {
+    StgHeader      header;
+    StgBool        running_alt_code;
+    StgClosure    *first_code;
+    StgClosure    *alt_code;
+    StgTRecHeader *first_code_trec;
+} StgCatchRetryFrame;
+
 #if defined(PAR) || defined(GRAN)
 /*
   StgBlockingQueueElement is a ``collective type'' representing the types

ghc/includes/Constants.h

 /* ----------------------------------------------------------------------------
- * $Id: Constants.h,v 1.26 2004/08/13 13:09:13 simonmar Exp $
+ * $Id: Constants.h,v 1.27 2004/11/18 09:56:19 tharris Exp $
  *
  * (c) The GHC Team, 1998-2002
  *
@@ -222,18 +222,19 @@
 #define BlockedOnRead       4
 #define BlockedOnWrite      5
 #define BlockedOnDelay      6
+#define BlockedOnSTM        7
 
 /* Win32 only: */
-#define BlockedOnDoProc     7
+#define BlockedOnDoProc     8
 
 /* Only relevant for PAR: */
   /* blocked on a remote closure represented by a Global Address: */
-#define BlockedOnGA         8
+#define BlockedOnGA         9
   /* same as above but without sending a Fetch message */
-#define BlockedOnGA_NoSend  9
+#define BlockedOnGA_NoSend  10
 /* Only relevant for RTS_SUPPORTS_THREADS: */
-#define BlockedOnCCall      10
-#define BlockedOnCCall_NoUnblockExc 11
+#define BlockedOnCCall      11
+#define BlockedOnCCall_NoUnblockExc 12
    /* same as above but don't unblock async exceptions in resumeThread() */
 
 /*

ghc/includes/RtsFlags.h

 /* -----------------------------------------------------------------------------
- * $Id: RtsFlags.h,v 1.46 2004/08/13 13:09:29 simonmar Exp $
+ * $Id: RtsFlags.h,v 1.47 2004/11/18 09:56:20 tharris Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -60,6 +60,7 @@ struct DEBUG_FLAGS {
     rtsBool par;            // 'P'
     rtsBool linker;         // 'l'   the object linker
     rtsBool apply;          // 'a'
+    rtsBool stm;            // 'm'
 };
 
 struct COST_CENTRE_FLAGS {

ghc/includes/STM.h

+/*----------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2004
+ *
+ * STM interface definition
+ *
+ *----------------------------------------------------------------------
+
+  STM.h defines the C-level interface to the STM.  
+
+  The interface is designed so that all of the operations return
+  directly: if the specified StgTSO should block then the Haskell
+  scheduler's data structures are updated within the STM
+  implementation, rather than blocking the native thread.
+
+  This interface can be supported by many different implementations,
+  in particular it is left unspecified:
+
+   - Whether nested transactions are fully supported.
+ 
+     A simple implementation would count the number of
+     stmStartTransaction operations that a thread invokes and only
+     attempt to really commit it to the heap when the corresponding
+     number of stmCommitTransaction calls have been made.  This
+     prevents enclosed transactions from being aborted without also
+     aborting all of the outer ones.  
+ 
+     The current implementation does support proper nesting.
+
+   - Whether stmWait and stmReWait are blocking.
+
+     A simple implementation would always return 'false' from these
+     operations, signalling that the calling thread should immediately
+     retry its transaction.
+
+     A fuller implementation would block the thread and return 'True'
+     when it is safe for the thread to block.
+
+     The current implementation does provide stmWait and stmReWait 
+     operations which can block the caller's TSO.
+
+   - Whether the transactional read, write, commit and validate
+     operations are blocking or non-blocking.
+
+     A simple implementation would use an internal lock to prevent
+     concurrent execution of any STM operations.  (This does not
+     prevent multiple threads having concurrent transactions, merely
+     the concurrent execution of say stmCommitTransaction by two
+     threads at the same time). 
+
+     A fuller implementation would offer obstruction-free or lock-free
+     progress guarantees, as in our OOPSLA 2003 paper.
+
+     The current implementation is lock-free for simple uncontended
+     operations, but uses an internal lock on SMP systems in some
+     cases.  This aims to provide good performance on uniprocessors:
+     it substantially streamlines the design, when compared with the
+     OOPSLA paper, and on a uniprocessor we can be sure that threads
+     are never pre-empted within STM operations.
+*/
+
+#ifndef STM_H
+#define STM_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*----------------------------------------------------------------------
+
+   Start of day
+   ------------
+
+*/
+
+extern void initSTM(void);
+
+extern void stmPreGCHook(void);
+
+/*----------------------------------------------------------------------
+
+   Transaction context management
+   ------------------------------
+
+*/
+
+// Create and enter a new transaction context
+
+extern StgTRecHeader *stmStartTransaction(StgTRecHeader *outer);
+
+// Exit the current transaction context, abandoning any read/write
+// operations performed within it and removing the thread from any
+// tvar wait queues if it was waitin.  Note that if nested transactions
+// are not fully supported then this may leave the enclosing
+// transaction contexts doomed to abort.
+
+extern void stmAbortTransaction(StgTRecHeader *trec);
+
+// Return the trec within which the specified trec was created (not
+// valid if trec==NO_TREC).
+
+extern StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec);
+
+/*----------------------------------------------------------------------
+
+   Validate/commit/wait/rewait operations
+   --------------------------------------
+
+
+   These four operations return boolean results which should be interpreted
+   as follows:
+
+   true  => The transaction context was definitely valid 
+
+   false => The transaction context may not have been valid
+
+   The user of the STM should ensure that it is always safe to assume that a
+   transaction context is not valid when in fact it is (i.e. to return false in
+   place of true, with side-effects as defined below).  This may cause
+   needless retries of transactions (in the case of validate and commit), or it
+   may cause needless spinning instead of blocking (in the case of wait and
+   rewait).
+
+   In defining the behaviour of wait and rewait we distinguish between two
+   different aspects of a thread's runnability:
+
+    - We say that a thread is "blocked" when it is not running or
+      runnable as far as the scheduler is concerned.
+
+    - We say that a thread is "waiting" when its StgTRecHeader is linked on an
+      tvar's wait queue.
+
+   Considering only STM operations, (blocked) => (waiting).  The user of the STM
+   should ensure that they are prepared for threads to be unblocked spuriously
+   and for wait/reWait to return false even when the previous transaction context
+   is actually still valid.
+*/
+
+// Test whether the current transaction context is valid, i.e. whether
+// it is still possible for it to commit successfully.  Note: we assume that
+// once stmValidateTransaction has returned FALSE for a given transaction then
+// that transaction will never again be valid -- we rely on this in Schedule.c when
+// kicking invalid threads at GC (in case they are stuck looping)
+
+extern StgBool stmValidateTransaction(StgTRecHeader *trec);
+
+// Test whether the current transaction context is valid and, if so,
+// commit its memory accesses to the heap.  stmCommitTransaction must
+// unblock any threads which are waiting on tvars that updates have
+// been committed to.
+
+extern StgBool stmCommitTransaction(StgTRecHeader *trec);
+
+// Test whether the current transaction context is valid and, if so,
+// start the thread waiting for updates to any of the tvars it has
+// ready from and mark it as blocked.  It is an error to call stmWait
+// if the thread is already waiting.
+
+extern StgBool stmWait(StgTSO *tso, StgTRecHeader *trec);
+
+// Test whether the current transaction context is valid and, if so,
+// leave the thread waiting and mark it as blocked again.  If the
+// transaction context is no longer valid then stop the thread waiting
+// and leave it as unblocked.  It is an error to call stmReWait if the
+// thread is not waiting.
+
+extern StgBool stmReWait(StgTRecHeader *trec);
+
+// Merge the accesses made so far in the second trec into the first trec.
+// Note that the resulting trec is only intended to be used in wait operations.
+// This avoids defining what happens if "trec" and "other" contain conflicting
+// updates.
+
+extern StgBool stmMergeForWaiting(StgTRecHeader *trec, StgTRecHeader *other);
+
+
+/*----------------------------------------------------------------------
+
+   Data access operations
+   ----------------------
+*/
+
+// Return the logical contents of 'tvar' within the context of the
+// thread's current transaction.
+
+extern StgClosure *stmReadTVar(StgTRecHeader *trec, 
+			       StgTVar *tvar);
+
+// Update the logical contents of 'tvar' within the context of the
+// thread's current transaction.
+
+extern void stmWriteTVar(StgTRecHeader *trec,
+			 StgTVar *tvar, 
+			 StgClosure *new_value);
+
+/*----------------------------------------------------------------------*/
+
+// NULLs
+
+#define END_STM_WAIT_QUEUE ((StgTVarWaitQueue *)(void *)&stg_END_STM_WAIT_QUEUE_closure)
+#define END_STM_CHUNK_LIST ((StgTRecChunk *)(void *)&stg_END_STM_CHUNK_LIST_closure)
+#define NO_TREC ((StgTRecHeader *)(void *)&stg_NO_TREC_closure)
+
+/*----------------------------------------------------------------------*/
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* STM_H */
+

ghc/includes/StgMiscClosures.h

@@ -129,6 +129,13 @@ RTS_INFO(stg_AP_info);
 RTS_INFO(stg_AP_STACK_info);
 RTS_INFO(stg_dummy_ret_info);
 RTS_INFO(stg_raise_info);
+RTS_INFO(stg_TVAR_WAIT_QUEUE_info);
+RTS_INFO(stg_TVAR_info);
+RTS_INFO(stg_TREC_CHUNK_info);
+RTS_INFO(stg_TREC_HEADER_info);
+RTS_INFO(stg_END_STM_WAIT_QUEUE_info);
+RTS_INFO(stg_END_STM_CHUNK_LIST_info);
+RTS_INFO(stg_NO_TREC_info);
 
 RTS_ENTRY(stg_IND_entry);
 RTS_ENTRY(stg_IND_direct_entry);
@@ -182,6 +189,9 @@ RTS_ENTRY(stg_AP_entry);
 RTS_ENTRY(stg_AP_STACK_entry);
 RTS_ENTRY(stg_dummy_ret_entry);
 RTS_ENTRY(stg_raise_entry);
+RTS_ENTRY(stg_END_STM_WAIT_QUEUE_entry);
+RTS_ENTRY(stg_END_STM_CHUNK_LIST_entry);
+RTS_ENTRY(stg_NO_TREC_entry);
 
 
 RTS_ENTRY(stg_unblockAsyncExceptionszh_ret_ret);
@@ -198,6 +208,10 @@ RTS_CLOSURE(stg_NO_FINALIZER_closure);
 RTS_CLOSURE(stg_dummy_ret_closure);
 RTS_CLOSURE(stg_forceIO_closure);
 
+RTS_CLOSURE(stg_END_STM_WAIT_QUEUE_closure);
+RTS_CLOSURE(stg_END_STM_CHUNK_LIST_closure);
+RTS_CLOSURE(stg_NO_TREC_closure);
+
 RTS_ENTRY(stg_NO_FINALIZER_entry);
 RTS_ENTRY(stg_END_EXCEPTION_LIST_entry);
 RTS_ENTRY(stg_EXCEPTION_CONS_entry);
@@ -544,4 +558,12 @@ RTS_FUN(mkForeignObjzh_fast);
 RTS_FUN(newBCOzh_fast);
 RTS_FUN(mkApUpd0zh_fast);
 
+RTS_FUN(retryzh_fast);
+RTS_FUN(catchRetryzh_fast);
+RTS_FUN(catchSTMzh_fast);
+RTS_FUN(atomicallyzh_fast);
+RTS_FUN(newTVarzh_fast);
+RTS_FUN(readTVarzh_fast);
+RTS_FUN(writeTVarzh_fast);
+
 #endif /* STGMISCCLOSURES_H */

ghc/includes/TSO.h

 /* -----------------------------------------------------------------------------
- * $Id: TSO.h,v 1.38 2004/11/10 02:13:12 wolfgang Exp $
+ * $Id: TSO.h,v 1.39 2004/11/18 09:56:22 tharris Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -136,6 +136,7 @@ typedef struct StgTSO_ {
   StgThreadID        id;
   int                saved_errno;
   struct StgMainThread_* main;
+  struct StgTRecHeader_ *trec;       // STM transaction record 
   
 #ifdef TICKY_TICKY
   // TICKY-specific stuff would go here.
@@ -183,6 +184,8 @@ typedef struct StgTSO_ {
         BlockedOnBlackHole     the BLACKHOLE_BQ     the BLACKHOLE_BQ's queue
 	
         BlockedOnMVar          the MVAR             the MVAR's queue
+
+	BlockedOnSTM           END_TSO_QUEUE        STM wait queue(s)
 	
         BlockedOnException     the TSO              TSO->blocked_exception
 

ghc/includes/mkDerivedConstants.c

@@ -253,6 +253,7 @@ main(int argc, char *argv[])
     closure_field(StgTSO, blocked_exceptions);
     closure_field(StgTSO, id);
     closure_field(StgTSO, saved_errno);
+    closure_field(StgTSO, trec);
     closure_field_("StgTSO_CCCS", StgTSO, prof.CCCS);
     tso_field(StgTSO, sp);
     tso_offset(StgTSO, stack);
@@ -298,6 +299,19 @@ main(int argc, char *argv[])
     closure_size(StgMutVar);
     closure_field(StgMutVar, var);
 
+    closure_size(StgAtomicallyFrame);
+    closure_field(StgAtomicallyFrame, waiting);
+    closure_field(StgAtomicallyFrame, code);
+
+    closure_size(StgCatchSTMFrame);
+    closure_field(StgCatchSTMFrame, handler);
+
+    closure_size(StgCatchRetryFrame);
+    closure_field(StgCatchRetryFrame, running_alt_code);
+    closure_field(StgCatchRetryFrame, first_code);
+    closure_field(StgCatchRetryFrame, alt_code);
+    closure_field(StgCatchRetryFrame, first_code_trec);
+
     closure_size(StgForeignObj);
     closure_field(StgForeignObj,data);
 
@@ -315,6 +329,10 @@ main(int argc, char *argv[])
     closure_field(StgMVar,tail);
     closure_field(StgMVar,value);
 
+    closure_size(StgTVar);
+    closure_field(StgTVar,current_value);
+    closure_field(StgTVar,first_wait_queue_entry);
+
     closure_size(StgBCO);
     closure_field(StgBCO, instrs);
     closure_field(StgBCO, literals);

ghc/rts/ClosureFlags.c

@@ -92,5 +92,12 @@ StgWord16 closure_flags[] = {
 /* RBH                  = */ ( 	        _NS|         _MUT|_UPT           ),
 /* EVACUATED		= */ ( 0                                         ),
 /* REMOTE_REF		= */ (_HNF|     _NS|              _UPT           ),
+/* TVAR_WAIT_QUEUE      = */ (          _NS|         _MUT|_UPT           ),
+/* TVAR                 = */ (_HNF|     _NS|         _MUT|_UPT           ), 
+/* TREC_CHUNK           = */ (          _NS|         _MUT|_UPT           ),
+/* TREC_HEADER          = */ (          _NS|         _MUT|_UPT           ),
+/* ATOMICALLY_FRAME     = */ (     _BTM                                  ),
+/* CATCH_RETRY_FRAME    = */ (     _BTM                                  ),
+/* CATCH_STM_FRAME      = */ (     _BTM                                  ),
 /* STACK		= */ (_HNF|     _NS|         _MUT                )