Fix endian issues in ghc-heap
authorPeter Trommler <ptrommler@acm.org>
Thu, 26 Jul 2018 21:23:22 +0000 (17:23 -0400)
committerBen Gamari <ben@smart-cactus.org>
Mon, 30 Jul 2018 21:46:45 +0000 (17:46 -0400)
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

(cherry picked from commit d7cb1bbc26719cf6082abe0d91d80be466e25bfc)

compiler/ghci/RtClosureInspect.hs
libraries/ghc-heap/GHC/Exts/Heap.hs

index e8d5aab..fa9f520 100644 (file)
@@ -780,6 +780,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
@@ -788,7 +789,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 )
@@ -803,7 +804,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
@@ -814,7 +815,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
index 9dc1f94..535596f 100644 (file)
@@ -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