[commit: ghc] master: Fix endian issues in ghc-heap (d7cb1bb)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d7cb1bbc26719cf6082abe0d91d80be466e25bfc/ghc

>---------------------------------------------------------------

commit d7cb1bbc26719cf6082abe0d91d80be466e25bfc
Author: Peter Trommler <ptrommler at acm.org>
Date:   Thu Jul 26 17:23:22 2018 -0400

    Fix endian issues in ghc-heap
    
    In test heap_all arity and n_args were swapped on big endian
    systems.
    
    Take care of endianness when reading parts of a machine word
    from a `Word`.
    
    This fixes one out of 36 failing tests reported in #15399.
    
    Test Plan: validate
    
    Reviewers: simonmar, bgamari, hvr, erikd
    
    Reviewed By: simonmar
    
    Subscribers: rwbarton, thomie, carter
    
    GHC Trac Issues: #15399
    
    Differential Revision: https://phabricator.haskell.org/D5001


>---------------------------------------------------------------

d7cb1bbc26719cf6082abe0d91d80be466e25bfc
 compiler/ghci/RtClosureInspect.hs   |  9 ++++++---
 libraries/ghc-heap/GHC/Exts/Heap.hs | 17 +++++++++++++++++
 2 files changed, 23 insertions(+), 3 deletions(-)

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index b761407..5b4a10f 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -818,6 +818,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
           -- StgCmmLayout.mkVirtHeapOffsetsWithPadding
           dflags <- getDynFlags
           let word_size = wORD_SIZE dflags
+              big_endian = wORDS_BIGENDIAN dflags
               size_b = primRepSizeB dflags rep
               -- Align the start offset (eg, 2-byte value should be 2-byte
               -- aligned). But not more than to a word. The offset calculation
@@ -826,7 +827,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
               !aligned_idx = roundUpTo arr_i (min word_size size_b)
               !new_arr_i = aligned_idx + size_b
               ws | size_b < word_size =
-                     [index size_b aligned_idx word_size]
+                     [index size_b aligned_idx word_size big_endian]
                  | otherwise =
                      let (q, r) = size_b `quotRem` word_size
                      in ASSERT( r == 0 )
@@ -841,7 +842,7 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
                 (error "unboxedTupleTerm: no HValue for unboxed tuple") terms
 
     -- Extract a sub-word sized field from a word
-    index item_size_b index_b word_size =
+    index item_size_b index_b word_size big_endian =
         (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes
       where
         mask :: Word
@@ -852,7 +853,9 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
             _ -> panic ("Weird byte-index: " ++ show index_b)
         (q,r) = index_b `quotRem` word_size
         word = array!!q
-        moveBytes = r * 8
+        moveBytes = if big_endian
+                    then word_size - (r + item_size_b) * 8
+                    else r * 8
 
 
 -- | Fast, breadth-first Type reconstruction
diff --git a/libraries/ghc-heap/GHC/Exts/Heap.hs b/libraries/ghc-heap/GHC/Exts/Heap.hs
index 9dc1f94..535596f 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap.hs
@@ -62,6 +62,8 @@ import GHC.Exts
 import GHC.Int
 import GHC.Word
 
+#include "ghcconfig.h"
+
 class HasHeapRep (a :: TYPE rep) where
     getClosureData :: a -> IO Closure
 
@@ -169,8 +171,13 @@ getClosure x = do
                 fail $ "Expected at least 2 raw words to AP"
             let splitWord = rawWds !! 0
             pure $ APClosure itbl
+#if defined(WORDS_BIGENDIAN)
+                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+                (fromIntegral splitWord)
+#else
                 (fromIntegral splitWord)
                 (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+#endif
                 (head pts) (tail pts)
 
         PAP -> do
@@ -181,8 +188,13 @@ getClosure x = do
                 fail "Expected at least 2 raw words to PAP"
             let splitWord = rawWds !! 0
             pure $ PAPClosure itbl
+#if defined(WORDS_BIGENDIAN)
+                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+                (fromIntegral splitWord)
+#else
                 (fromIntegral splitWord)
                 (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+#endif
                 (head pts) (tail pts)
 
         AP_STACK -> do
@@ -214,8 +226,13 @@ getClosure x = do
                         ++ show (length rawWds)
             let splitWord = rawWds !! 3
             pure $ BCOClosure itbl (pts !! 0) (pts !! 1) (pts !! 2)
+#if defined(WORDS_BIGENDIAN)
+                (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+                (fromIntegral splitWord)
+#else
                 (fromIntegral splitWord)
                 (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+#endif
                 (drop 4 rawWds)
 
         ARR_WORDS -> do