PPC NCG: Fix table jumpswip/T19931-ppc

If the width of the scrutinee of a table switch is smaller than
wordsize it must be zero extended to be usable as an index into
the jump table. This was first discovered on x86_64 in #19931.
The reproducer does not tickle the bug on PowerPC but the code
was still broken.

4 files changed, 67 insertions, 29 deletions

diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index c821ea71a2..b5724c6fdc 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -2053,56 +2053,55 @@ genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
 genSwitch config expr targets
   | OSAIX <- platformOS platform
   = do
-        (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
-        let fmt = archWordFormat $ target32Bit platform
-            sha = if target32Bit platform then 2 else 3
+        (e_reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
         tmp <- getNewRegNat fmt
         lbl <- getNewLabelNat
         dynRef <- cmmMakeDynamicReference config DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
-        let code = e_code `appOL` t_code `appOL` toOL [
-                            SL fmt tmp reg (RIImm (ImmInt sha)),
-                            LD fmt tmp (AddrRegReg tableReg tmp),
-                            MTCTR tmp,
-                            BCTR ids (Just lbl) []
-                    ]
+        let code = e_code `appOL` t_code `appOL` toOL
+                   [ RLWINM tmp e_reg sha mb me
+                   , LD fmt tmp (AddrRegReg tableReg tmp)
+                   , MTCTR tmp
+                   , BCTR ids (Just lbl) []
+                   ]
         return code
 
   | (ncgPIC config) || (not $ target32Bit platform)
   = do
-        (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
-        let fmt = archWordFormat $ target32Bit platform
-            sha = if target32Bit platform then 2 else 3
+        (e_reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
         tmp <- getNewRegNat fmt
         lbl <- getNewLabelNat
         dynRef <- cmmMakeDynamicReference config DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
-        let code = e_code `appOL` t_code `appOL` toOL [
-                            SL fmt tmp reg (RIImm (ImmInt sha)),
-                            LD fmt tmp (AddrRegReg tableReg tmp),
-                            ADD tmp tmp (RIReg tableReg),
-                            MTCTR tmp,
-                            BCTR ids (Just lbl) []
-                    ]
+        let code = e_code `appOL` t_code `appOL` toOL
+                   [ RLWINM tmp e_reg sha mb me
+                   , LD fmt tmp (AddrRegReg tableReg tmp)
+                   , ADD tmp tmp (RIReg tableReg)
+                   , MTCTR tmp
+                   , BCTR ids (Just lbl) []
+                   ]
         return code
   | otherwise
   = do
-        (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
-        let fmt = archWordFormat $ target32Bit platform
-            sha = if target32Bit platform then 2 else 3
+        (e_reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
         tmp <- getNewRegNat fmt
         lbl <- getNewLabelNat
-        let code = e_code `appOL` toOL [
-                            SL fmt tmp reg (RIImm (ImmInt sha)),
-                            ADDIS tmp tmp (HA (ImmCLbl lbl)),
-                            LD fmt tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
-                            MTCTR tmp,
-                            BCTR ids (Just lbl) []
-                    ]
+        let code = e_code `appOL` toOL
+                   [ RLWINM tmp e_reg sha mb me
+                   , ADDIS tmp tmp (HA (ImmCLbl lbl))
+                   , LD fmt tmp (AddrRegImm tmp (LO (ImmCLbl lbl)))
+                   , MTCTR tmp
+                   , BCTR ids (Just lbl) []
+                   ]
         return code
   where
     (offset, ids) = switchTargetsToTable targets
     platform      = ncgPlatform config
+    width         = widthInBits $ cmmExprWidth platform expr
+    sha           = if target32Bit platform then 2 else 3
+    mb            = max (32 - width - sha) 0
+    me            = 32 - sha
+    fmt           = archWordFormat $ target32Bit platform
 
 generateJumpTableForInstr :: NCGConfig -> Instr
                           -> Maybe (NatCmmDecl RawCmmStatics Instr)
diff --git a/testsuite/tests/codeGen/should_run/T19931.hs b/testsuite/tests/codeGen/should_run/T19931.hs
new file mode 100644
index 0000000000..2260f2325a
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T19931.hs
@@ -0,0 +1,36 @@
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module Main where
+
+import GHC.Exts
+import GHC.Types
+import GHC.Num
+
+data T = T Word8#
+
+instance Num T where
+  fromInteger i = T (wordToWord8# (integerToWord# i))
+
+instance Eq T where
+  (==) (T a) (T b) = isTrue# (a `eqWord8#` b)
+  (/=) (T a) (T b) = isTrue# (a `neWord8#` b)
+
+main :: IO ()
+main = do
+  let !addr = "\0\1\2\3\4\5\6\7\8"#
+
+  w8 <- IO (\s -> case readWord8OffAddr# (plusAddr# addr 5#) 0# s of
+                      (# s', w8 #) -> (# s', T w8 #))
+  -- w8 must be small enough for one of the branch to be taken.
+  -- we need several alternatives for a jump table to be used
+  print $ case w8 of
+      0 -> 1000
+      1 -> 1001
+      2 -> 1002
+      3 -> 1003
+      4 -> 1004
+      5 -> 1005
+      6 -> 1006
+      _ -> 1010
diff --git a/testsuite/tests/codeGen/should_run/T19931.stdout b/testsuite/tests/codeGen/should_run/T19931.stdout
new file mode 100644
index 0000000000..49bc2728c7
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T19931.stdout
@@ -0,0 +1 @@
+1005
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index b744ec97e9..a6e56a0fa0 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -216,3 +216,5 @@ test('CallConv', [when(unregisterised(), skip),
                   when(arch('x86_64'), extra_hc_opts('CallConv_x86_64.s')),
                   when(arch('aarch64'), extra_hc_opts('CallConv_aarch64.s'))],
      compile_and_run, [''])
+
+test('T19931', normal, compile_and_run, ['-O2'])