Commit eb1a86bb authored by John Ericson's avatar John Ericson Committed by Marge Bot

Allow C-- to scrutinize non-native-size words

parent b699c4fb
......@@ -187,10 +187,9 @@ lintCmmLast labels node = case node of
platform <- getPlatform
mapM_ checkTarget $ switchTargetsToList ids
erep <- lintCmmExpr e
if (erep `cmmEqType_ignoring_ptrhood` bWord platform)
then return ()
else cmmLintErr (text "switch scrutinee is not a word: " <>
pdoc platform e <> text " :: " <> ppr erep)
unless (isWordAny erep) $
cmmLintErr (text "switch scrutinee is not a word (of any size): " <>
pdoc platform e <> text " :: " <> ppr erep)
CmmCall { cml_target = target, cml_cont = cont } -> do
_ <- lintCmmExpr target
......
......@@ -83,6 +83,8 @@ floatSwitchExpr platform expr = do
implementSwitchPlan :: Platform -> CmmTickScope -> CmmExpr -> SwitchPlan -> UniqSM (Block CmmNode O C, [CmmBlock])
implementSwitchPlan platform scope expr = go
where
width = typeWidth $ cmmExprType platform expr
go (Unconditionally l)
= return (emptyBlock `blockJoinTail` CmmBranch l, [])
go (JumpTable ids)
......@@ -92,9 +94,9 @@ implementSwitchPlan platform scope expr = go
(bid1, newBlocks1) <- go' ids1
(bid2, newBlocks2) <- go' ids2
let lt | signed = cmmSLtWord
| otherwise = cmmULtWord
scrut = lt platform expr $ CmmLit $ mkWordCLit platform i
let lt | signed = MO_S_Lt
| otherwise = MO_U_Lt
scrut = CmmMachOp (lt width) [expr, CmmLit $ CmmInt i width]
lastNode = CmmCondBranch scrut bid1 bid2 Nothing
lastBlock = emptyBlock `blockJoinTail` lastNode
return (lastBlock, newBlocks1++newBlocks2)
......@@ -102,7 +104,7 @@ implementSwitchPlan platform scope expr = go
= do
(bid2, newBlocks2) <- go' ids2
let scrut = cmmNeWord platform expr $ CmmLit $ mkWordCLit platform i
let scrut = CmmMachOp (MO_Ne width) [expr, CmmLit $ CmmInt i width]
lastNode = CmmCondBranch scrut bid2 l Nothing
lastBlock = emptyBlock `blockJoinTail` lastNode
return (lastBlock, newBlocks2)
......
......@@ -5,7 +5,8 @@ module GHC.Cmm.Type
, cmmBits, cmmFloat
, typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
, isFloatType, isGcPtrType, isBitsType
, isWord32, isWord64, isFloat64, isFloat32
, isWordAny, isWord32, isWord64
, isFloat64, isFloat32
, Width(..)
, widthInBits, widthInBytes, widthInLog, widthFromBytes
......@@ -144,10 +145,15 @@ isGcPtrType _other = False
isBitsType (CmmType BitsCat _) = True
isBitsType _ = False
isWord32, isWord64, isFloat32, isFloat64 :: CmmType -> Bool
isWordAny, isWord32, isWord64,
isFloat32, isFloat64 :: CmmType -> Bool
-- isWord64 is true of 64-bit non-floats (both gc-ptrs and otherwise)
-- isFloat32 and 64 are obvious
isWordAny (CmmType BitsCat _) = True
isWordAny (CmmType GcPtrCat _) = True
isWordAny _other = False
isWord64 (CmmType BitsCat W64) = True
isWord64 (CmmType GcPtrCat W64) = True
isWord64 _other = False
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment