summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2023-03-09 09:44:39 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-03-24 13:10:20 -0400
commit509d1f11bf4e7eb4b916ae1c33abc48047b3be0e (patch)
tree68dc77bee89a344531f5d5bd6a84debb3c306187
parent46120bb637452be6e16e5dd7091c0b469a5adcd5 (diff)
downloadhaskell-509d1f11bf4e7eb4b916ae1c33abc48047b3be0e.tar.gz
codeGen/tsan: Disable instrumentation of unaligned stores
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.hs15
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