Fix GHCi :print on big-endian platforms

On big-endian platforms executing

  import GHC.Exts
  data Foo = Foo Float# deriving Show
  foo = Foo 42.0#
  foo
  :print foo

results in an arithmetic overflow exception which is caused by function
index where moveBytes equals
  word_size - (r + item_size_b) * 8
Here we have a mixture of units. Both, word_size and item_size_b have
unit bytes whereas r has unit bits.  On 64-bit platforms moveBytes
equals then
  8 - (0 + 4) * 8
which results in a negative and therefore invalid second parameter for a
shiftL operation.

In order to make things more clear the expression
  (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes
is equivalent to
  (word `shiftR` moveBytes) .&. mask
On big-endian platforms the shift must be a left shift instead of a
right shift. For symmetry reasons not a mask is used but two shifts in
order to zero out bits. Thus the fixed version equals
  case endian of
    BigEndian    -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits
    LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits

Fixes #16548 and #14455

2 files changed, 16 insertions, 17 deletions

diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 73f11a98d0..b7e9a1b104 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -870,20 +870,21 @@ 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 endian =
-        (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes
-      where
-        mask :: Word
-        mask = case item_size_b of
-            1 -> 0xFF
-            2 -> 0xFFFF
-            4 -> 0xFFFFFFFF
-            _ -> panic ("Weird byte-index: " ++ show index_b)
-        (q,r) = index_b `quotRem` word_size
-        word = array!!q
-        moveBytes = case endian of
-         BigEndian    -> word_size - (r + item_size_b) * 8
-         LittleEndian -> r * 8
+    -- A sub word is aligned to the left-most part of a word on big-endian
+    -- platforms, and to the right-most part of a word on little-endian
+    -- platforms.  This allows to write and read it back from memory
+    -- independent of endianness.  Bits not belonging to a sub word are zeroed
+    -- out, although, this is strictly speaking not necessary since a sub word
+    -- is read back from memory by appropriately casted pointers (see e.g.
+    -- ppr_float of cPprTermBase).
+    index size_b aligned_idx word_size endian = case endian of
+      BigEndian    -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits
+      LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits
+     where
+      (q, r) = aligned_idx `quotRem` word_size
+      word = array!!q
+      moveBits = r * 8
+      zeroOutBits = (word_size - size_b) * 8
 
 
 -- | Fast, breadth-first Type reconstruction
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index bd92d0ffa8..30e5c4312c 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -28,9 +28,7 @@ test('print020', [extra_files(['../HappyTest.hs']),
                   omit_ways(['ghci-ext'])], ghci_script, ['print020.script'])
 
 test('print021', normal, ghci_script, ['print021.script'])
-test('print022',
-     [when(arch('powerpc64'), expect_broken(14455))],
-     ghci_script, ['print022.script'])
+test('print022', normal, ghci_script, ['print022.script'])
 test('print023', extra_files(['../Test.hs']), ghci_script, ['print023.script'])
 test('print024', extra_files(['../Test.hs']), ghci_script, ['print024.script'])
 test('print025', normal, ghci_script, ['print025.script'])