touch# swapped with indexing primops
While debugging a segfault I found the following unfolding for headFS
(from GHC's FastString).
-- FastString.hs:
headFS :: FastString -> Char
headFS (FastString _ 0 _ _) = panic "headFS: Empty FastString"
headFS (FastString _ _ bs _) =
inlinePerformIO $ BS.unsafeUseAsCString bs $ \ptr ->
return (fst (utf8DecodeChar (castPtr ptr)))
-- Data.ByteString.Unsafe:
unsafeUseAsCString :: ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString (PS ps s _) ac = withForeignPtr ps $ \p -> ac (castPtr p `plusPtr` s)
-- Foreign.ForeignPtr
withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr fo io
= do r <- io (unsafeForeignPtrToPtr fo)
touchForeignPtr fo
return r
-- FastString.hi
-- Obtained with: ./_build/stage0/bin/ghc --show-iface _build/stage1/compiler/build/FastString.hi
$wheadFS ::
GHC.Prim.Int#
-> GHC.Prim.Addr#
-> GHC.ForeignPtr.ForeignPtrContents
-> GHC.Prim.Int#
-> GHC.Types.Char
[Arity: 4, Strictness: <S,1*U><L,U><L,U><L,U>, Inline: [2],
Unfolding: (\ (ww :: GHC.Prim.Int#)
(ww1 :: GHC.Prim.Addr#)
(ww2 :: GHC.ForeignPtr.ForeignPtrContents)
(ww3 :: GHC.Prim.Int#) ->
case ww of ds {
DEFAULT
-> FastFunctions.inlinePerformIO
@GHC.Types.Char
(\ (eta :: GHC.Prim.State# GHC.Prim.RealWorld) ->
case GHC.Prim.touch# -- BAD: touch# has crept all the way to the top of case-of-case
@'GHC.Types.LiftedRep
@GHC.ForeignPtr.ForeignPtrContents
ww2
eta of s' { DEFAULT ->
(# s',
let {
ww4 :: GHC.Prim.Addr# [] = GHC.Prim.plusAddr# ww1 ww3
} in
case GHC.Prim.indexWord8OffAddr# ww4 0# of wild { DEFAULT ->
let {
ch0 :: GHC.Prim.Int# [] = GHC.Prim.word2Int# wild
} in ...
As we can see touch#
has been swapped with the indexWord8OffAddr#
s used in utf8DecodeChar
. This can lead to segfaults.
It's similar to #17760 (closed) and #17746 but here touch#
isn't suppressed, just swapped with unsafe primops.