summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs12
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/CodeGen.hs12
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs11
-rw-r--r--compiler/GHC/CmmToC.hs6
-rw-r--r--testsuite/tests/numeric/should_run/T19931.hs35
-rw-r--r--testsuite/tests/numeric/should_run/T19931.stdout1
-rw-r--r--testsuite/tests/numeric/should_run/all.T1
7 files changed, 69 insertions, 9 deletions
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 8ee20e06f5..67bc3d9bdb 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -2086,7 +2086,7 @@ genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch config expr targets
| OSAIX <- platformOS platform
= do
- (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
+ (reg,e_code) <- getSomeReg indexExpr
let fmt = archWordFormat $ target32Bit platform
sha = if target32Bit platform then 2 else 3
tmp <- getNewRegNat fmt
@@ -2103,7 +2103,7 @@ genSwitch config expr targets
| (ncgPIC config) || (not $ target32Bit platform)
= do
- (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
+ (reg,e_code) <- getSomeReg indexExpr
let fmt = archWordFormat $ target32Bit platform
sha = if target32Bit platform then 2 else 3
tmp <- getNewRegNat fmt
@@ -2120,7 +2120,7 @@ genSwitch config expr targets
return code
| otherwise
= do
- (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
+ (reg,e_code) <- getSomeReg indexExpr
let fmt = archWordFormat $ target32Bit platform
sha = if target32Bit platform then 2 else 3
tmp <- getNewRegNat fmt
@@ -2134,6 +2134,12 @@ genSwitch config expr targets
]
return code
where
+ indexExpr = cmmOffset platform exprWidened offset
+ -- We widen to a native-width register to santize the high bits
+ exprWidened = CmmMachOp
+ (MO_UU_Conv (cmmExprWidth platform expr)
+ (platformWordWidth platform))
+ [expr]
(offset, ids) = switchTargetsToTable targets
platform = ncgPlatform config
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
index 56f764560c..aeaaf1c9d3 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
@@ -313,7 +313,7 @@ genSwitch config expr targets
= error "MachCodeGen: sparc genSwitch PIC not finished\n"
| otherwise
- = do (e_reg, e_code) <- getSomeReg (cmmOffset (ncgPlatform config) expr offset)
+ = do (e_reg, e_code) <- getSomeReg indexExpr
base_reg <- getNewRegNat II32
offset_reg <- getNewRegNat II32
@@ -334,7 +334,15 @@ genSwitch config expr targets
, LD II32 (AddrRegReg base_reg offset_reg) dst
, JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label
, NOP ]
- where (offset, ids) = switchTargetsToTable targets
+ where
+ indexExpr = cmmOffset platform exprWidened offset
+ -- We widen to a native-width register to santize the high bits
+ exprWidened = CmmMachOp
+ (MO_UU_Conv (cmmExprWidth platform expr)
+ (platformWordWidth platform))
+ [expr]
+ (offset, ids) = switchTargetsToTable targets
+ platform = ncgPlatform config
generateJumpTableForInstr :: Platform -> Instr
-> Maybe (NatCmmDecl RawCmmStatics Instr)
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index ff25a2e53f..5e7c261cbb 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -3476,9 +3476,16 @@ genSwitch :: CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch expr targets = do
config <- getConfig
let platform = ncgPlatform config
+ -- We widen to a native-width register because we cannot use arbitry sizes
+ -- in x86 addressing modes.
+ exprWidened = CmmMachOp
+ (MO_UU_Conv (cmmExprWidth platform expr)
+ (platformWordWidth platform))
+ [expr]
+ indexExpr = cmmOffset platform exprWidened offset
if ncgPIC config
then do
- (reg,e_code) <- getNonClobberedReg (cmmOffset platform expr offset)
+ (reg,e_code) <- getNonClobberedReg indexExpr
-- getNonClobberedReg because it needs to survive across t_code
lbl <- getNewLabelNat
let is32bit = target32Bit platform
@@ -3519,7 +3526,7 @@ genSwitch expr targets = do
JMP_TBL (OpReg tableReg) ids rosection lbl
]
else do
- (reg,e_code) <- getSomeReg (cmmOffset platform expr offset)
+ (reg,e_code) <- getSomeReg indexExpr
lbl <- getNewLabelNat
let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (platformWordSizeInBytes platform)) (ImmCLbl lbl))
code = e_code `appOL` toOL [
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index 8349393f0d..f662f7d996 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -341,15 +341,17 @@ pprSwitch platform e ids
where
(pairs, mbdef) = switchTargetsFallThrough ids
+ rep = typeWidth (cmmExprType platform e)
+
-- fall through case
caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
where
do_fallthrough ix =
- hsep [ text "case" , pprHexVal platform ix (wordWidth platform) <> colon ,
+ hsep [ text "case" , pprHexVal platform ix rep <> colon ,
text "/* fall through */" ]
final_branch ix =
- hsep [ text "case" , pprHexVal platform ix (wordWidth platform) <> colon ,
+ hsep [ text "case" , pprHexVal platform ix rep <> colon ,
text "goto" , (pprBlockId ident) <> semi ]
caseify (_ , _ ) = panic "pprSwitch: switch with no cases!"
diff --git a/testsuite/tests/numeric/should_run/T19931.hs b/testsuite/tests/numeric/should_run/T19931.hs
new file mode 100644
index 0000000000..1ab9002d2e
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/T19931.hs
@@ -0,0 +1,35 @@
+{-# 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/numeric/should_run/T19931.stdout b/testsuite/tests/numeric/should_run/T19931.stdout
new file mode 100644
index 0000000000..49bc2728c7
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/T19931.stdout
@@ -0,0 +1 @@
+1005
diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T
index 028677e52d..1123984bdd 100644
--- a/testsuite/tests/numeric/should_run/all.T
+++ b/testsuite/tests/numeric/should_run/all.T
@@ -74,5 +74,6 @@ test('T18499', normal, compile_and_run, [''])
test('T18509', normal, compile_and_run, [''])
test('T18515', normal, compile_and_run, [''])
test('T18604', normal, compile_and_run, [''])
+test('T19931', normal, compile_and_run, ['-O2'])
test('IntegerToFloat', normal, compile_and_run, [''])
View Lorry Controller Status