From 769ddfdf37df79fc6a14ec7030a1eff4d5f51d6b Mon Sep 17 00:00:00 2001 From: Peter Trommler Date: Sun, 13 Jun 2021 13:00:27 +0200 Subject: PPC NCG: Fix table jumps 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. --- compiler/GHC/CmmToAsm/PPC/CodeGen.hs | 57 ++++++++++++------------ testsuite/tests/codeGen/should_run/T19931.hs | 36 +++++++++++++++ testsuite/tests/codeGen/should_run/T19931.stdout | 1 + testsuite/tests/codeGen/should_run/all.T | 2 + 4 files changed, 67 insertions(+), 29 deletions(-) create mode 100644 testsuite/tests/codeGen/should_run/T19931.hs create mode 100644 testsuite/tests/codeGen/should_run/T19931.stdout 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']) -- cgit v1.2.1