diff options
| author | John Ericson <John.Ericson@Obsidian.Systems> | 2021-04-02 05:41:53 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-04-10 05:31:49 -0400 |
| commit | eb1a86bbbb622c557fadf2fb33188c6724c7eaab (patch) | |
| tree | a343d8c3202549d4e62068977a1084e633236fd3 | |
| parent | b699c4fb0d23616a20d160f04a893f514fc7e38c (diff) | |
| download | haskell-eb1a86bbbb622c557fadf2fb33188c6724c7eaab.tar.gz | |
Allow C-- to scrutinize non-native-size words
| -rw-r--r-- | compiler/GHC/Cmm/Lint.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Cmm/Switch/Implement.hs | 10 | ||||
| -rw-r--r-- | compiler/GHC/Cmm/Type.hs | 10 |
3 files changed, 17 insertions, 10 deletions
diff --git a/compiler/GHC/Cmm/Lint.hs b/compiler/GHC/Cmm/Lint.hs index 2fd19ec507..7225a64141 100644 --- a/compiler/GHC/Cmm/Lint.hs +++ b/compiler/GHC/Cmm/Lint.hs @@ -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 diff --git a/compiler/GHC/Cmm/Switch/Implement.hs b/compiler/GHC/Cmm/Switch/Implement.hs index bc132a2efc..7b0ad6107a 100644 --- a/compiler/GHC/Cmm/Switch/Implement.hs +++ b/compiler/GHC/Cmm/Switch/Implement.hs @@ -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) diff --git a/compiler/GHC/Cmm/Type.hs b/compiler/GHC/Cmm/Type.hs index 067dc9de47..954fc5fe80 100644 --- a/compiler/GHC/Cmm/Type.hs +++ b/compiler/GHC/Cmm/Type.hs @@ -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 |