Skip to content

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.

To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information