Code generation corrupts writes to Addr#

This issue affects at least GHC 8.4.4 and GHC 8.6.3. Here is a somewhat minimal example:

{-# 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 :(

Trac metadata

Trac field	Value
Version	8.6.3
Type	Bug
TypeOfFailure	OtherFailure
Priority	highest
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture