[GHC] #16294: Code generation corrupts writes to Addr#

[GHC]

#16294: Code generation corrupts writes to Addr#
-------------------------------------+-------------------------------------
           Reporter:  andrewthad     |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  highest        |         Milestone:
          Component:  Compiler       |           Version:  8.6.3
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 This issue affects at least GHC 8.4.4 and GHC 8.6.3. Here is a somewhat
 minimal example:

 {{{#!hs
 {-# language BangPatterns #-}
 {-# language MagicHash #-}
 {-# language UnboxedTuples #-}

 {-# options_ghc -Wall -Werror -O2 #-}

 import Data.Primitive
 import Data.Void
 import Data.Word
 import Data.Monoid
 import GHC.IO (IO(..))
 import Foreign.Storable
 import Numeric (showHex)

 import qualified GHC.Exts as E
 import qualified Data.Primitive as PM

 main :: IO ()
 main = do
   arr <- compute 0xABCD 0x79
   putStrLn (showString "raw packet: " . appEndo (foldMap (Endo . showHex)
 (E.toList arr)) $ "")

 compute :: Word16 -> Word8 -> IO ByteArray
 compute totlen prot = do
   buf <- PM.newPinnedByteArray 28
   PM.setByteArray buf 0 28 (0 :: Word8)
   let !(Addr addr) = PM.mutableByteArrayContents buf
       !ptr = E.Ptr addr :: E.Ptr Void
   pokeByteOff ptr 0 (0x45 :: Word8)
   pokeByteOff ptr 1 (0 :: Word8)
   pokeByteOff ptr 2 (totlen :: Word16)
   pokeByteOff ptr 4 (0 :: Word16)
   pokeByteOff ptr 6 (0 :: Word16)
   pokeByteOff ptr 8 (0x40 :: Word8)
   pokeByteOff ptr 9 (prot :: Word8)
   touchMutableByteArray buf
   PM.unsafeFreezeByteArray buf

 touchMutableByteArray :: MutableByteArray E.RealWorld -> IO ()
 touchMutableByteArray (MutableByteArray x) = touchMutableByteArray# x

 touchMutableByteArray# :: E.MutableByteArray# E.RealWorld -> IO ()
 touchMutableByteArray# x = IO $ \s -> case E.touch# x s of s' -> (# s', ()
 #)
 }}}

 For those curious about the particular interleaving of 8-bit and 16-bit
 writes, this was adapted from code that fills out an `iphdr` for use with
 raw sockets. The output will be dependent on your platform's endianness.
 On my little-endian architecture, I get:

 {{{
 raw packet: 450cdab00004079000000000000000000
 }}}

 As we expect, the `abcd` from the source gets flipped to `cdab` because of
 the little endian architecture this ran on. However, it starts in an
 unusual place. It's not even byte-aligned. Something, possible a cmm
 optimization or a codegen optimization, makes the `writeWord16OffAddr#`
 end up straddling three bytes.

 Someone will probably want to write a more minimal example that eliminates
 the use of the `primitive` library.

 Sorry to be the bearer of bad news :(

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/16294>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler