GHC.ByteOrder is broken
GHC.ByteOrder.targetByteOrder
does not report endianness correctly.
Here is how to reproduce:
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE CPP #-}
import Data.ByteString.Short.Internal
import GHC.ByteOrder
import GHC.Exts
import GHC.IO
#include "MachDeps.h"
data MBA = MBA (MutableByteArray# RealWorld)
homeEndian :: ByteOrder
#ifdef WORDS_BIGENDIAN
homeEndian = BigEndian
#else
homeEndian = LittleEndian
#endif
makeSBS :: IO ShortByteString
makeSBS = do
MBA mba# <-
IO $ \s# ->
case newByteArray# 16# s# of
(# s'#, mba# #) -> (# s'#, MBA mba# #)
IO $ \s# -> (# writeWord64Array# mba# 0# 0x6162636465666768## s#, () #)
IO $ \s# -> (# writeWord64Array# mba# 1# 0x4142434445464748## s#, () #)
IO $ \s# ->
case unsafeFreezeByteArray# mba# s# of
(# s'#, ba# #) -> (# s'#, SBS ba# #)
main :: IO ()
main = do
putStrLn $ "GHC.ByteOrder.targetByteOrder: " ++ show targetByteOrder
putStrLn $ "homeEndian: " ++ show homeEndian
makeSBS >>= print
Running this on your regular little endian Intel CPU will produce expected output:
$ ghc endian.hs -fforce-recomp && ./endian
[1 of 1] Compiling Main ( endian.hs, endian.o )
Linking endian ...
GHC.ByteOrder.targetByteOrder: LittleEndian
homeEndian: LittleEndian
"hgfedcbaHGFEDCBA"
However when run on a big endian machine we get:
root@24bf49042aa4:/# ghc endian.hs -fforce-recomp && ./endian
[1 of 1] Compiling Main ( endian.hs, endian.o )
Linking endian ...
GHC.ByteOrder.targetByteOrder: LittleEndian
homeEndian: BigEndian
"abcdefghABCDEFGH"
As you can see from the output of homeEndian
and the actual byte order in ShortByteString
the endianness is indeed big endian as expected and targetByteOrder
reports it incorrectly.
ghc-byteorder
package works fine because it does the right thing and imports: <ghcautoconf.h>
-- Required for WORDS_BIGENDIAN
#include <ghcautoconf.h>
which I assume was forgotten when migrated to GHC codebase.
Adding this line to GHC.ByteOrder
should do a trick:
#include "MachDeps.h"
In order to debug and replicate this problem I used this project: https://github.com/multiarch/qemu-user-static#getting-started that was suggested to me by Leonhard Markert:
$ docker run --rm --privileged multiarch/qemu-user-static --reset -p yes
$ docker run --rm -it s390x/ubuntu bash
root@24bf49042aa4:/# apt update && apt install ghc