diff options
author | Ben Gamari <ben@smart-cactus.org> | 2023-03-09 09:44:39 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2023-03-23 22:31:18 -0400 |
commit | 038e0e89b0f604bad2c69c29e9b86ffd8103516a (patch) | |
tree | 8e6bc235e725c417cf553b1a7fb37712a1ca2cbd | |
parent | a5afc8ab3c5518aebf8823ed418d404853929147 (diff) | |
download | haskell-wip/T23096.tar.gz |
codeGen/tsan: Disable instrumentation of unaligned storeswip/T23096
There is some disagreement regarding the prototype of
`__tsan_unaligned_write` (specifically whether it takes just the written
address, or the address and the value as an argument). Moreover, I have
observed crashes which appear to be due to it. Disable instrumentation
of unaligned stores as a temporary mitigation.
Fixes #23096.
-rw-r--r-- | compiler/GHC/Cmm/ThreadSanitizer.hs | 15 |
1 files changed, 7 insertions, 8 deletions
diff --git a/compiler/GHC/Cmm/ThreadSanitizer.hs b/compiler/GHC/Cmm/ThreadSanitizer.hs index ab4e16edb7..f202c1dc43 100644 --- a/compiler/GHC/Cmm/ThreadSanitizer.hs +++ b/compiler/GHC/Cmm/ThreadSanitizer.hs @@ -54,11 +54,13 @@ annotateNode env node = CmmTick{} -> BMiddle node CmmUnwind{} -> BMiddle node CmmAssign{} -> annotateNodeOO env node - CmmStore lhs rhs align -> + -- TODO: Track unaligned stores + CmmStore _ _ Unaligned -> annotateNodeOO env node + CmmStore lhs rhs NaturallyAligned -> let ty = cmmExprType (platform env) rhs rhs_nodes = annotateLoads env (collectExprLoads rhs) lhs_nodes = annotateLoads env (collectExprLoads lhs) - st = tsanStore env align ty lhs + st = tsanStore env ty lhs in rhs_nodes `blockAppend` lhs_nodes `blockAppend` st `blockSnoc` node CmmUnsafeForeignCall (PrimTarget op) formals args -> let node' = fromMaybe (BMiddle node) (annotatePrim env op formals args) @@ -197,17 +199,14 @@ tsanTarget fn formals args = lbl = mkForeignLabel fn Nothing ForeignLabelInExternalPackage IsFunction tsanStore :: Env - -> AlignmentSpec -> CmmType -> CmmExpr + -> CmmType -> CmmExpr -> Block CmmNode O O -tsanStore env align ty addr = +tsanStore env ty addr = mkUnsafeCall env ftarget [] [addr] where ftarget = tsanTarget fn [] [AddrHint] w = widthInBytes (typeWidth ty) - fn = case align of - Unaligned - | w > 1 -> fsLit $ "__tsan_unaligned_write" ++ show w - _ -> fsLit $ "__tsan_write" ++ show w + fn = fsLit $ "__tsan_write" ++ show w tsanLoad :: Env -> AlignmentSpec -> CmmType -> CmmExpr |