[Git][ghc/ghc][wip/tsan/codegen] 4 commits: TmpFs: Eliminate data race

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Tue Nov 15 21:07:21 UTC 2022



Ben Gamari pushed to branch wip/tsan/codegen at Glasgow Haskell Compiler / GHC


Commits:
72af74f5 by Ben Gamari at 2022-11-15T15:36:30-05:00
TmpFs: Eliminate data race

Previously we used readIORef concurrently on a IORef.

- - - - -
0dd2f66e by Ben Gamari at 2022-11-15T15:47:54-05:00
compiler: Use release store in eager blackholing

- - - - -
2dab1e51 by Ben Gamari at 2022-11-15T15:48:29-05:00
rts: Fix ordering of makeStableName

- - - - -
46683a0f by Ben Gamari at 2022-11-15T15:49:02-05:00
rts: Use ordered accesses instead of explicit barriers

- - - - -


4 changed files:

- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/Utils/TmpFs.hs
- rts/PrimOps.cmm
- rts/include/Cmm.h


Changes:

=====================================
compiler/GHC/StgToCmm/Bind.hs
=====================================
@@ -703,8 +703,8 @@ emitBlackHoleCode node = do
     whenUpdRemSetEnabled $ emitUpdRemSetPushThunk node
     emitStore (cmmOffsetW platform node (fixedHdrSizeW profile)) currentTSOExpr
     -- See Note [Heap memory barriers] in SMP.h.
-    emitPrimCall [] MO_WriteBarrier []
-    emitStore node (CmmReg (CmmGlobal EagerBlackholeInfo))
+    let w = wordWidth platform
+    emitPrimCall [] (MO_AtomicWrite w MemOrderCstSeq) [node, CmmReg (CmmGlobal EagerBlockholeInfo)]
 
 setupUpdate :: ClosureInfo -> LocalReg -> FCode () -> FCode ()
         -- Nota Bene: this function does not change Node (even if it's a CAF),


=====================================
compiler/GHC/Utils/TmpFs.hs
=====================================
@@ -196,7 +196,7 @@ changeTempFilesLifetime tmpfs lifetime files = do
   FilesToClean
     { ftcCurrentModule = cm_files
     , ftcGhcSession = gs_files
-    } <- readIORef (tmp_files_to_clean tmpfs)
+    } <- atomicReadIORef (tmp_files_to_clean tmpfs)
   let old_set = case lifetime of
         TFL_CurrentModule -> gs_files
         TFL_GhcSession -> cm_files
@@ -257,11 +257,14 @@ newTempLibName logger tmpfs tmp_dir lifetime extn
                         return (filename, dir, libname)
 
 
+atomicReadIORef :: IORef a -> IO a
+atomicReadIORef ref = atomicModifyIORef' ref $ \x -> (x,x)
+
 -- Return our temporary directory within tmp_dir, creating one if we
 -- don't have one yet.
 getTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath
 getTempDir logger tmpfs (TempDir tmp_dir) = do
-    mapping <- readIORef dir_ref
+    mapping <- atomicReadIORef dir_ref
     case Map.lookup tmp_dir mapping of
         Nothing -> do
             pid <- getProcessID


=====================================
rts/PrimOps.cmm
=====================================
@@ -1728,7 +1728,7 @@ stg_takeMVarzh ( P_ mvar /* :: MVar a */ )
         // Write barrier before we make the new MVAR_TSO_QUEUE
         // visible to other cores.
         // See Note [Heap memory barriers]
-        prim_write_barrier;
+        RELEASE_FENCE;
 
         if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
             StgMVar_head(mvar) = q;
@@ -1895,7 +1895,7 @@ stg_putMVarzh ( P_ mvar, /* :: MVar a */
 
         SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM);
         // See Note [Heap memory barriers]
-        prim_write_barrier;
+        RELEASE_FENCE;
 
         if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
             StgMVar_head(mvar) = q;
@@ -2104,7 +2104,7 @@ stg_readMVarzh ( P_ mvar, /* :: MVar a */ )
 
         SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM);
         // See Note [Heap memory barriers]
-        prim_write_barrier;
+        RELEASE_FENCE;
 
         StgTSO__link(CurrentTSO)       = q;
         StgTSO_block_info(CurrentTSO)  = mvar;
@@ -2237,7 +2237,7 @@ stg_readIOPortzh ( P_ ioport /* :: IOPort a */ )
 
         SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM);
         // See Note [Heap memory barriers]
-        prim_write_barrier;
+        RELEASE_FENCE;
 
         StgMVar_head(ioport) = q;
         StgTSO__link(CurrentTSO)       = q;
@@ -2389,7 +2389,8 @@ stg_makeStableNamezh ( P_ obj )
     /* Is there already a StableName for this heap object?
      *  stable_name_table is a pointer to an array of snEntry structs.
      */
-    if ( snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) == NULL ) {
+    sn_obj = %acquire snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry);
+    if (sn_obj  == NULL) {
         // At this point we have a snEntry, but it doesn't look as used to the
         // GC yet because we don't have a StableName object for the sn_obj field
         // (remember that sn_obj == NULL means the entry is free). So if we call
@@ -2406,10 +2407,7 @@ stg_makeStableNamezh ( P_ obj )
         // This will make the StableName# object visible to other threads;
         // be sure that its completely visible to other cores.
         // See Note [Heap memory barriers] in SMP.h.
-        prim_write_barrier;
-        snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) = sn_obj;
-    } else {
-        sn_obj = snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry);
+        %release snEntry_sn_obj(W_[stable_name_table] + index*SIZEOF_snEntry) = sn_obj;
     }
 
     return (sn_obj);


=====================================
rts/include/Cmm.h
=====================================
@@ -280,8 +280,7 @@
 // "used".
 
 #define LOAD_INFO_ACQUIRE(ret,x)                \
-    info = %INFO_PTR(UNTAG(x));                 \
-    prim_read_barrier;
+    info = %acquire StgHeader_info(UNTAG(x));
 
 #define UNTAG_IF_PROF(x) UNTAG(x)
 
@@ -291,8 +290,7 @@
   if (GETTAG(x) != 0) {                         \
       ret(x);                                   \
   }                                             \
-  info = %INFO_PTR(x);                          \
-  prim_read_barrier;
+  info = %acquire StgHeader_info(x);
 
 #define UNTAG_IF_PROF(x) (x) /* already untagged */
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/617a46d7005861fe2919403d87995f3f955d3b27...46683a0f6025c67522900c5460f2eb7bb7c3fdcb

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/617a46d7005861fe2919403d87995f3f955d3b27...46683a0f6025c67522900c5460f2eb7bb7c3fdcb
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221115/fc1cb81b/attachment-0001.html>


More information about the ghc-commits mailing list