diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2015-03-30 10:20:14 +0200 |
|---|---|---|
| committer | Joachim Breitner <mail@joachim-breitner.de> | 2015-03-30 10:22:27 +0200 |
| commit | de1160be047790afde4ec76de0a81ba3be0c73fa (patch) | |
| tree | 269bbb98b8451d2cf1ccf1a86dfaae69f2acb50e | |
| parent | e24f638158f96f80e476000cd7ce8555987d84f2 (diff) | |
| download | haskell-de1160be047790afde4ec76de0a81ba3be0c73fa.tar.gz | |
Refactor the story around switches (#10137)
This re-implements the code generation for case expressions at the Stg →
Cmm level, both for data type cases as well as for integral literal
cases. (Cases on float are still treated as before).
The goal is to allow for fancier strategies in implementing them, for a
cleaner separation of the strategy from the gritty details of Cmm, and
to run this later than the Common Block Optimization, allowing for one
way to attack #10124. The new module CmmSwitch contains a number of
notes explaining this changes. For example, it creates larger
consecutive jump tables than the previous code, if possible.
nofib shows little significant overall improvement of runtime. The
rather large wobbling comes from changes in the code block order
(see #8082, not much we can do about it). But the decrease in code size
alone makes this worthwhile.
```
Program Size Allocs Runtime Elapsed TotalMem
Min -1.8% 0.0% -6.1% -6.1% -2.9%
Max -0.7% +0.0% +5.6% +5.7% +7.8%
Geometric Mean -1.4% -0.0% -0.3% -0.3% +0.0%
```
Compilation time increases slightly:
```
-1 s.d. ----- -2.0%
+1 s.d. ----- +2.5%
Average ----- +0.3%
```
The test case T783 regresses a lot, but it is the only one exhibiting
any regression. The cause is the changed order of branches in an
if-then-else tree, which makes the hoople data flow analysis traverse
the blocks in a suboptimal order. Reverting that gets rid of this
regression, but has a consistent, if only very small (+0.2%), negative
effect on runtime. So I conclude that this test is an extreme outlier
and no reason to change the code.
Differential Revision: https://phabricator.haskell.org/D720
26 files changed, 1323 insertions, 293 deletions
diff --git a/compiler/basicTypes/Literal.hs b/compiler/basicTypes/Literal.hs index 2c71be499b..ced05a4d2f 100644 --- a/compiler/basicTypes/Literal.hs +++ b/compiler/basicTypes/Literal.hs @@ -30,7 +30,7 @@ module Literal , inIntRange, inWordRange, tARGET_MAX_INT, inCharRange , isZeroLit , litFitsInChar - , onlyWithinBounds + , litValue -- ** Coercions , word2IntLit, int2WordLit @@ -271,6 +271,17 @@ isZeroLit (MachFloat 0) = True isZeroLit (MachDouble 0) = True isZeroLit _ = False +-- | Returns the 'Integer' contained in the 'Literal', for when that makes +-- sense, i.e. for 'Char', 'Int', 'Word' and 'LitInteger'. +litValue :: Literal -> Integer +litValue (MachChar c) = toInteger $ ord c +litValue (MachInt i) = i +litValue (MachInt64 i) = i +litValue (MachWord i) = i +litValue (MachWord64 i) = i +litValue (LitInteger i _) = i +litValue l = pprPanic "litValue" (ppr l) + {- Coercions ~~~~~~~~~ @@ -360,16 +371,6 @@ litIsLifted :: Literal -> Bool litIsLifted (LitInteger {}) = True litIsLifted _ = False --- | x `onlyWithinBounds` (l,h) is true if l <= y < h ==> x = y -onlyWithinBounds :: Literal -> (Literal, Literal) -> Bool -onlyWithinBounds (MachChar x) (MachChar l, MachChar h) = x == l && succ x == h -onlyWithinBounds (MachInt x) (MachInt l, MachInt h) = x == l && succ x == h -onlyWithinBounds (MachWord x) (MachWord l, MachWord h) = x == l && succ x == h -onlyWithinBounds (MachInt64 x) (MachInt64 l, MachInt64 h) = x == l && succ x == h -onlyWithinBounds (MachWord64 x) (MachWord64 l, MachWord64 h) = x == l && succ x == h -onlyWithinBounds _ _ = False - - {- Types ~~~~~ diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs index 95910d16d5..09124106d5 100644 --- a/compiler/cmm/CmmCommonBlockElim.hs +++ b/compiler/cmm/CmmCommonBlockElim.hs @@ -8,6 +8,7 @@ where import BlockId import Cmm import CmmUtils +import CmmSwitch (eqSwitchTargetWith) import CmmContFlowOpt import Prelude hiding (iterate, succ, unzip, zip) @@ -203,13 +204,10 @@ eqLastWith eqBid (CmmCondBranch c1 t1 f1) (CmmCondBranch c2 t2 f2) = c1 == c2 && eqBid t1 t2 && eqBid f1 f2 eqLastWith eqBid (CmmCall t1 c1 g1 a1 r1 u1) (CmmCall t2 c2 g2 a2 r2 u2) = t1 == t2 && eqMaybeWith eqBid c1 c2 && a1 == a2 && r1 == r2 && u1 == u2 && g1 == g2 -eqLastWith eqBid (CmmSwitch e1 bs1) (CmmSwitch e2 bs2) = - e1 == e2 && eqListWith (eqMaybeWith eqBid) bs1 bs2 +eqLastWith eqBid (CmmSwitch e1 ids1) (CmmSwitch e2 ids2) = + e1 == e2 && eqSwitchTargetWith eqBid ids1 ids2 eqLastWith _ _ _ = False -eqListWith :: (a -> b -> Bool) -> [a] -> [b] -> Bool -eqListWith eltEq es es' = all (uncurry eltEq) (List.zip es es') - eqMaybeWith :: (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool eqMaybeWith eltEq (Just e) (Just e') = eltEq e e' eqMaybeWith _ Nothing Nothing = True diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs index bcb4cf97b3..95c195078f 100644 --- a/compiler/cmm/CmmContFlowOpt.hs +++ b/compiler/cmm/CmmContFlowOpt.hs @@ -12,6 +12,7 @@ import Hoopl import BlockId import Cmm import CmmUtils +import CmmSwitch (mapSwitchTargets) import Maybes import Panic @@ -355,7 +356,7 @@ replaceLabels env g txnode :: CmmNode e x -> CmmNode e x txnode (CmmBranch bid) = CmmBranch (lookup bid) txnode (CmmCondBranch p t f) = mkCmmCondBranch (exp p) (lookup t) (lookup f) - txnode (CmmSwitch e arms) = CmmSwitch (exp e) (map (liftM lookup) arms) + txnode (CmmSwitch e ids) = CmmSwitch (exp e) (mapSwitchTargets lookup ids) txnode (CmmCall t k rg a res r) = CmmCall (exp t) (liftM lookup k) rg a res r txnode fc@CmmForeignCall{} = fc{ args = map exp (args fc) , succ = lookup (succ fc) } diff --git a/compiler/cmm/CmmImplementSwitchPlans.hs b/compiler/cmm/CmmImplementSwitchPlans.hs new file mode 100644 index 0000000000..9fb68d8131 --- /dev/null +++ b/compiler/cmm/CmmImplementSwitchPlans.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE GADTs #-} +module CmmImplementSwitchPlans + ( cmmImplementSwitchPlans + ) +where + +import Hoopl +import BlockId +import Cmm +import CmmUtils +import CmmSwitch +import UniqSupply +import DynFlags + +-- +-- This module replaces Switch statements as generated by the Stg -> Cmm +-- transformation, which might be huge and sparse and hence unsuitable for +-- assembly code, by proper constructs (if-then-else trees, dense jump tables). +-- +-- The actual, abstract strategy is determined by createSwitchPlan in +-- CmmSwitch and returned as a SwitchPlan; here is just the implementation in +-- terms of Cmm code. See Note [Cmm Switches, the general plan] in CmmSwitch. +-- +-- This division into different modules is both to clearly separte concerns, +-- but also because createSwitchPlan needs access to the constructors of +-- SwitchTargets, a data type exported abstractly by CmmSwitch. +-- + +-- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for +-- code generation. +cmmImplementSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph +cmmImplementSwitchPlans dflags g + | targetSupportsSwitch (hscTarget dflags) = return g + | otherwise = do + blocks' <- concat `fmap` mapM (visitSwitches dflags) (toBlockList g) + return $ ofBlockList (g_entry g) blocks' + +visitSwitches :: DynFlags -> CmmBlock -> UniqSM [CmmBlock] +visitSwitches dflags block + | (entry@(CmmEntry _ scope), middle, CmmSwitch expr ids) <- blockSplit block + = do + let plan = createSwitchPlan ids + + (newTail, newBlocks) <- implementSwitchPlan dflags scope expr plan + + let block' = entry `blockJoinHead` middle `blockAppend` newTail + + return $ block' : newBlocks + + | otherwise + = return [block] + + +-- Implementing a switch plan (returning a tail block) +implementSwitchPlan :: DynFlags -> CmmTickScope -> CmmExpr -> SwitchPlan -> UniqSM (Block CmmNode O C, [CmmBlock]) +implementSwitchPlan dflags scope expr = go + where + go (Unconditionally l) + = return (emptyBlock `blockJoinTail` CmmBranch l, []) + go (JumpTable ids) + = return (emptyBlock `blockJoinTail` CmmSwitch expr ids, []) + go (IfLT signed i ids1 ids2) + = do + (bid1, newBlocks1) <- go' ids1 + (bid2, newBlocks2) <- go' ids2 + + let lt | signed = cmmSLtWord + | otherwise = cmmULtWord + scrut = lt dflags expr $ CmmLit $ mkWordCLit dflags i + lastNode = CmmCondBranch scrut bid1 bid2 + lastBlock = emptyBlock `blockJoinTail` lastNode + return (lastBlock, newBlocks1++newBlocks2) + go (IfEqual i l ids2) + = do + (bid2, newBlocks2) <- go' ids2 + + let scrut = cmmNeWord dflags expr $ CmmLit $ mkWordCLit dflags i + lastNode = CmmCondBranch scrut bid2 l + lastBlock = emptyBlock `blockJoinTail` lastNode + return (lastBlock, newBlocks2) + + -- Same but returning a label to branch to + go' (Unconditionally l) + = return (l, []) + go' p + = do + bid <- mkBlockId `fmap` getUniqueM + (last, newBlocks) <- go p + let block = CmmEntry bid scope `blockJoinHead` last + return (bid, block: newBlocks) diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs index e5938150e7..edce2e97bc 100644 --- a/compiler/cmm/CmmLint.hs +++ b/compiler/cmm/CmmLint.hs @@ -14,13 +14,13 @@ import Hoopl import Cmm import CmmUtils import CmmLive +import CmmSwitch (switchTargetsToList) import PprCmm () import BlockId import FastString import Outputable import DynFlags -import Data.Maybe import Control.Monad (liftM, ap) #if __GLASGOW_HASKELL__ < 709 import Control.Applicative (Applicative(..)) @@ -171,9 +171,9 @@ lintCmmLast labels node = case node of _ <- lintCmmExpr e checkCond dflags e - CmmSwitch e branches -> do + CmmSwitch e ids -> do dflags <- getDynFlags - mapM_ checkTarget $ catMaybes branches + mapM_ checkTarget $ switchTargetsToList ids erep <- lintCmmExpr e if (erep `cmmEqType_ignoring_ptrhood` bWord dflags) then return () diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs index 73f997168e..45538d3886 100644 --- a/compiler/cmm/CmmNode.hs +++ b/compiler/cmm/CmmNode.hs @@ -23,6 +23,7 @@ module CmmNode ( import CodeGen.Platform import CmmExpr +import CmmSwitch import DynFlags import FastString import ForeignCall @@ -89,11 +90,10 @@ data CmmNode e x where cml_true, cml_false :: ULabel } -> CmmNode O C - CmmSwitch :: CmmExpr -> [Maybe Label] -> CmmNode O C -- Table branch - -- The scrutinee is zero-based; - -- zero -> first block - -- one -> second block etc - -- Undefined outside range, and when there's a Nothing + CmmSwitch + :: CmmExpr -- Scrutinee, of some integral type + -> SwitchTargets -- Cases. See [Note SwitchTargets] + -> CmmNode O C CmmCall :: { -- A native call or tail call cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp! @@ -228,7 +228,7 @@ instance NonLocal CmmNode where successors (CmmBranch l) = [l] successors (CmmCondBranch {cml_true=t, cml_false=f}) = [f, t] -- meets layout constraint - successors (CmmSwitch _ ls) = catMaybes ls + successors (CmmSwitch _ ids) = switchTargetsToList ids successors (CmmCall {cml_cont=l}) = maybeToList l successors (CmmForeignCall {succ=l}) = [l] @@ -464,7 +464,7 @@ mapExp f (CmmStore addr e) = CmmStore (f addr) (f e) mapExp f (CmmUnsafeForeignCall tgt fs as) = CmmUnsafeForeignCall (mapForeignTarget f tgt) fs (map f as) mapExp _ l@(CmmBranch _) = l mapExp f (CmmCondBranch e ti fi) = CmmCondBranch (f e) ti fi -mapExp f (CmmSwitch e tbl) = CmmSwitch (f e) tbl +mapExp f (CmmSwitch e ids) = CmmSwitch (f e) ids mapExp f n@CmmCall {cml_target=tgt} = n{cml_target = f tgt} mapExp f (CmmForeignCall tgt fs as succ ret_args updfr intrbl) = CmmForeignCall (mapForeignTarget f tgt) fs (map f as) succ ret_args updfr intrbl @@ -560,7 +560,7 @@ foldExpDeep f = foldExp (wrapRecExpf f) mapSuccessors :: (Label -> Label) -> CmmNode O C -> CmmNode O C mapSuccessors f (CmmBranch bid) = CmmBranch (f bid) mapSuccessors f (CmmCondBranch p y n) = CmmCondBranch p (f y) (f n) -mapSuccessors f (CmmSwitch e arms) = CmmSwitch e (map (fmap f) arms) +mapSuccessors f (CmmSwitch e ids) = CmmSwitch e (mapSwitchTargets f ids) mapSuccessors _ n = n -- ----------------------------------------------------------------------------- diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index 916c161647..6c4b835fc3 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -226,6 +226,7 @@ import CmmOpt import MkGraph import Cmm import CmmUtils +import CmmSwitch ( mkSwitchTargets ) import CmmInfo import BlockId import CmmLex @@ -258,6 +259,7 @@ import Data.Array import Data.Char ( ord ) import System.Exit import Data.Maybe +import qualified Data.Map as M #include "HsVersions.h" } @@ -676,24 +678,24 @@ globals :: { [GlobalReg] } : GLOBALREG { [$1] } | GLOBALREG ',' globals { $1 : $3 } -maybe_range :: { Maybe (Int,Int) } - : '[' INT '..' INT ']' { Just (fromIntegral $2, fromIntegral $4) } +maybe_range :: { Maybe (Integer,Integer) } + : '[' INT '..' INT ']' { Just ($2, $4) } | {- empty -} { Nothing } -arms :: { [CmmParse ([Int],Either BlockId (CmmParse ()))] } +arms :: { [CmmParse ([Integer],Either BlockId (CmmParse ()))] } : {- empty -} { [] } | arm arms { $1 : $2 } -arm :: { CmmParse ([Int],Either BlockId (CmmParse ())) } +arm :: { CmmParse ([Integer],Either BlockId (CmmParse ())) } : 'case' ints ':' arm_body { do b <- $4; return ($2, b) } arm_body :: { CmmParse (Either BlockId (CmmParse ())) } : '{' body '}' { return (Right (withSourceNote $1 $3 $2)) } | 'goto' NAME ';' { do l <- lookupLabel $2; return (Left l) } -ints :: { [Int] } - : INT { [ fromIntegral $1 ] } - | INT ',' ints { fromIntegral $1 : $3 } +ints :: { [Integer] } + : INT { [ $1 ] } + | INT ',' ints { $1 : $3 } default :: { Maybe (CmmParse ()) } : 'default' ':' '{' body '}' { Just (withSourceNote $3 $5 $4) } @@ -1307,7 +1309,9 @@ withSourceNote a b parse = do -- optional range on the switch (eg. switch [0..7] {...}), or by -- the minimum/maximum values from the branches. -doSwitch :: Maybe (Int,Int) -> CmmParse CmmExpr -> [([Int],Either BlockId (CmmParse ()))] +doSwitch :: Maybe (Integer,Integer) + -> CmmParse CmmExpr + -> [([Integer],Either BlockId (CmmParse ()))] -> Maybe (CmmParse ()) -> CmmParse () doSwitch mb_range scrut arms deflt = do @@ -1319,22 +1323,16 @@ doSwitch mb_range scrut arms deflt -- Compile each case branch table_entries <- mapM emitArm arms + let table = M.fromList (concat table_entries) - -- Construct the table - let - all_entries = concat table_entries - ixs = map fst all_entries - (min,max) - | Just (l,u) <- mb_range = (l,u) - | otherwise = (minimum ixs, maximum ixs) + dflags <- getDynFlags + let range = fromMaybe (0, tARGET_MAX_WORD dflags) mb_range - entries = elems (accumArray (\_ a -> Just a) dflt_entry (min,max) - all_entries) expr <- scrut -- ToDo: check for out of range and jump to default if necessary - emit (mkSwitch expr entries) + emit $ mkSwitch expr (mkSwitchTargets False range dflt_entry table) where - emitArm :: ([Int],Either BlockId (CmmParse ())) -> CmmParse [(Int,BlockId)] + emitArm :: ([Integer],Either BlockId (CmmParse ())) -> CmmParse [(Integer,BlockId)] emitArm (ints,Left blockid) = return [ (i,blockid) | i <- ints ] emitArm (ints,Right code) = do blockid <- forkLabelledCode code diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index af4f62a4a8..37dbd12525 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -11,6 +11,7 @@ import Cmm import CmmLint import CmmBuildInfoTables import CmmCommonBlockElim +import CmmImplementSwitchPlans import CmmProcPoint import CmmContFlowOpt import CmmLayoutStack @@ -71,6 +72,10 @@ cpsTop hsc_env proc = -- Any work storing block Labels must be performed _after_ -- elimCommonBlocks + g <- {-# SCC "createSwitchPlans" #-} + runUniqSM $ cmmImplementSwitchPlans dflags g + dump Opt_D_dump_cmm_switch "Post switch plan" g + ----------- Proc points ------------------------------------------------- let call_pps = {-# SCC "callProcPoints" #-} callProcPoints g proc_points <- diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs index 2add4741ef..a31048206b 100644 --- a/compiler/cmm/CmmProcPoint.hs +++ b/compiler/cmm/CmmProcPoint.hs @@ -18,6 +18,7 @@ import PprCmm () import CmmUtils import CmmInfo import CmmLive (cmmGlobalLiveness) +import CmmSwitch import Data.List (sortBy) import Maybes import Control.Monad @@ -295,7 +296,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap case lastNode block of CmmBranch id -> add_if_pp id rst CmmCondBranch _ ti fi -> add_if_pp ti (add_if_pp fi rst) - CmmSwitch _ tbl -> foldr add_if_pp rst (catMaybes tbl) + CmmSwitch _ ids -> foldr add_if_pp rst $ switchTargetsToList ids _ -> rst -- when jumping to a PP that has an info table, if @@ -382,7 +383,7 @@ replaceBranches env cmmg last :: CmmNode O C -> CmmNode O C last (CmmBranch id) = CmmBranch (lookup id) last (CmmCondBranch e ti fi) = CmmCondBranch e (lookup ti) (lookup fi) - last (CmmSwitch e tbl) = CmmSwitch e (map (fmap lookup) tbl) + last (CmmSwitch e ids) = CmmSwitch e (mapSwitchTargets lookup ids) last l@(CmmCall {}) = l { cml_cont = Nothing } -- NB. remove the continuation of a CmmCall, since this -- label will now be in a different CmmProc. Not only diff --git a/compiler/cmm/CmmSwitch.hs b/compiler/cmm/CmmSwitch.hs new file mode 100644 index 0000000000..95e57c70af --- /dev/null +++ b/compiler/cmm/CmmSwitch.hs @@ -0,0 +1,415 @@ +{-# LANGUAGE GADTs #-} +module CmmSwitch ( + SwitchTargets, + mkSwitchTargets, + switchTargetsCases, switchTargetsDefault, switchTargetsRange, switchTargetsSigned, + mapSwitchTargets, switchTargetsToTable, switchTargetsFallThrough, + switchTargetsToList, eqSwitchTargetWith, + + SwitchPlan(..), + targetSupportsSwitch, + createSwitchPlan, + ) where + +import Outputable +import DynFlags +import Compiler.Hoopl (Label) + +import Data.Maybe +import Data.List (groupBy) +import Data.Function (on) +import qualified Data.Map as M + +-- Note [Cmm Switches, the general plan] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Compiling a high-level switch statement, as it comes out of a STG case +-- expression, for example, allows for a surprising amount of design decisions. +-- Therefore, we cleanly separated this from the Stg → Cmm transformation, as +-- well as from the actual code generation. +-- +-- The overall plan is: +-- * The Stg → Cmm transformation creates a single `SwitchTargets` in +-- emitSwitch and emitCmmLitSwitch in StgCmmUtils.hs. +-- At this stage, they are unsuitable for code generation. +-- * A dedicated Cmm transformation (CmmImplementSwitchPlans) replaces these +-- switch statements with code that is suitable for code generation, i.e. +-- a nice balanced tree of decisions with dense jump tables in the leafs. +-- The actual planning of this tree is performed in pure code in createSwitchPlan +-- in this module. See Note [createSwitchPlan]. +-- * The actual code generation will not do any further processing and +-- implement each CmmSwitch with a jump tables. +-- +-- When compiling to LLVM or C, CmmImplementSwitchPlans leaves the switch +-- statements alone, as we can turn a SwitchTargets value into a nice +-- switch-statement in LLVM resp. C, and leave the rest to the compiler. +-- +-- See Note [CmmSwitch vs. CmmImplementSwitchPlans] why the two module are +-- separated. + +----------------------------------------------------------------------------- +-- Magic Constants +-- +-- There are a lot of heuristics here that depend on magic values where it is +-- hard to determine the "best" value (for whatever that means). These are the +-- magic values: + +-- | Number of consecutive default values allowed in a jump table. If there are +-- more of them, the jump tables are split. +-- +-- Currently 7, as it costs 7 words of additional code when a jump table is +-- split (at least on x64, determined experimentally). +maxJumpTableHole :: Integer +maxJumpTableHole = 7 + +-- | Minimum size of a jump table. If the number is smaller, the switch is +-- implemented using conditionals. +-- Currently 5, because an if-then-else tree of 4 values is nice and compact. +minJumpTableSize :: Int +minJumpTableSize = 5 + +-- | Minimum non-zero offset for a jump table. See Note [Jump Table Offset]. +minJumpTableOffset :: Integer +minJumpTableOffset = 2 + + +----------------------------------------------------------------------------- +-- Switch Targets + +-- Note [SwitchTargets]: +-- ~~~~~~~~~~~~~~~~~~~~~ +-- +-- The branches of a switch are stored in a SwitchTargets, which consists of an +-- (optional) default jump target, and a map from values to jump targets. +-- +-- If the default jump target is absent, the behaviour of the switch outside the +-- values of the map is undefined. +-- +-- We use an Integer for the keys the map so that it can be used in switches on +-- unsigned as well as signed integers. +-- +-- The map must not be empty. +-- +-- Before code generation, the table needs to be brought into a form where all +-- entries are non-negative, so that it can be compiled into a jump table. +-- See switchTargetsToTable. + + +-- | A value of type SwitchTargets contains the alternatives for a 'CmmSwitch' +-- value, and knows whether the value is signed, the possible range, an +-- optional default value and a map from values to jump labels. +data SwitchTargets = + SwitchTargets + Bool -- Signed values + (Integer, Integer) -- Range + (Maybe Label) -- Default value + (M.Map Integer Label) -- The branches + deriving (Show, Eq) + +-- | The smart constructr mkSwitchTargets normalises the map a bit: +-- * No entries outside the range +-- * No entries equal to the default +-- * No default if all elements have explicit values +mkSwitchTargets :: Bool -> (Integer, Integer) -> Maybe Label -> M.Map Integer Label -> SwitchTargets +mkSwitchTargets signed range@(lo,hi) mbdef ids + = SwitchTargets signed range mbdef' ids' + where + ids' = dropDefault $ restrict ids + mbdef' | defaultNeeded = mbdef + | otherwise = Nothing + + -- Drop entries outside the range, if there is a range + restrict = M.filterWithKey (\x _ -> lo <= x && x <= hi) + + -- Drop entries that equal the default, if there is a default + dropDefault | Just l <- mbdef = M.filter (/= l) + | otherwise = id + + -- Check if the default is still needed + defaultNeeded = fromIntegral (M.size ids') /= hi-lo+1 + + +-- | Changes all labels mentioned in the SwitchTargets value +mapSwitchTargets :: (Label -> Label) -> SwitchTargets -> SwitchTargets +mapSwitchTargets f (SwitchTargets signed range mbdef branches) + = SwitchTargets signed range (fmap f mbdef) (fmap f branches) + +-- | Returns the list of non-default branches of the SwitchTargets value +switchTargetsCases :: SwitchTargets -> [(Integer, Label)] +switchTargetsCases (SwitchTargets _ _ _ branches) = M.toList branches + +-- | Return the default label of the SwitchTargets value +switchTargetsDefault :: SwitchTargets -> Maybe Label +switchTargetsDefault (SwitchTargets _ _ mbdef _) = mbdef + +-- | Return the range of the SwitchTargets value +switchTargetsRange :: SwitchTargets -> (Integer, Integer) +switchTargetsRange (SwitchTargets _ range _ _) = range + +-- | Return whether this is used for a signed value +switchTargetsSigned :: SwitchTargets -> Bool +switchTargetsSigned (SwitchTargets signed _ _ _) = signed + +-- | switchTargetsToTable creates a dense jump table, usable for code generation. +-- Returns an offset to add to the value; the list is 0-based on the result. +-- The conversion from Integer to Int is a bit of a wart, but works due to +-- wrap-around arithmetic (as verified by the CmmSwitchTest test case). +switchTargetsToTable :: SwitchTargets -> (Int, [Maybe Label]) +switchTargetsToTable (SwitchTargets _ (lo,hi) mbdef branches) + = (fromIntegral (-start), [ labelFor i | i <- [start..hi] ]) + where + labelFor i = case M.lookup i branches of Just l -> Just l + Nothing -> mbdef + start | lo >= 0 && lo < minJumpTableOffset = 0 -- See Note [Jump Table Offset] + | otherwise = lo + +-- Note [Jump Table Offset] +-- ~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Usually, the code for a jump table starting at x will first subtract x from +-- the value, to avoid a large amount of empty entries. But if x is very small, +-- the extra entries are no worse than the subtraction in terms of code size, and +-- not having to do the subtraction is quicker. +-- +-- I.e. instead of +-- _u20N: +-- leaq -1(%r14),%rax +-- jmp *_n20R(,%rax,8) +-- _n20R: +-- .quad _c20p +-- .quad _c20q +-- do +-- _u20N: +-- jmp *_n20Q(,%r14,8) +-- +-- _n20Q: +-- .quad 0 +-- .quad _c20p +-- .quad _c20q +-- .quad _c20r + +-- | The list of all labels occuring in the SwitchTargets value. +switchTargetsToList :: SwitchTargets -> [Label] +switchTargetsToList (SwitchTargets _ _ mbdef branches) + = maybeToList mbdef ++ M.elems branches + +-- | Groups cases with equal targets, suitable for pretty-printing to a +-- c-like switch statement with fall-through semantics. +switchTargetsFallThrough :: SwitchTargets -> ([([Integer], Label)], Maybe Label) +switchTargetsFallThrough (SwitchTargets _ _ mbdef branches) = (groups, mbdef) + where + groups = map (\xs -> (map fst xs, snd (head xs))) $ + groupBy ((==) `on` snd) $ + M.toList branches + +-- | Custom equality helper, needed for "CmmCommonBlockElim" +eqSwitchTargetWith :: (Label -> Label -> Bool) -> SwitchTargets -> SwitchTargets -> Bool +eqSwitchTargetWith eq (SwitchTargets signed1 range1 mbdef1 ids1) (SwitchTargets signed2 range2 mbdef2 ids2) = + signed1 == signed2 && range1 == range2 && goMB mbdef1 mbdef2 && goList (M.toList ids1) (M.toList ids2) + where + goMB Nothing Nothing = True + goMB (Just l1) (Just l2) = l1 `eq` l2 + goMB _ _ = False + goList [] [] = True + goList ((i1,l1):ls1) ((i2,l2):ls2) = i1 == i2 && l1 `eq` l2 && goList ls1 ls2 + goList _ _ = False + +----------------------------------------------------------------------------- +-- Code generation for Switches + + +-- | A SwitchPlan abstractly descries how a Switch statement ought to be +-- implemented. See Note [createSwitchPlan] +data SwitchPlan + = Unconditionally Label + | IfEqual Integer Label SwitchPlan + | IfLT Bool Integer SwitchPlan SwitchPlan + | JumpTable SwitchTargets + deriving Show +-- +-- Note [createSwitchPlan] +-- ~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- A SwitchPlan describes how a Switch statement is to be broken down into +-- smaller pieces suitable for code generation. +-- +-- createSwitchPlan creates such a switch plan, in these steps: +-- 1. it splits the switch statement at segments of non-default values that +-- are too large. See splitAtHoles and Note [When to split SwitchTargets] +-- 2. Too small jump tables should be avoided, so we break up smaller pieces +-- in breakTooSmall. +-- 3. We will in the segments between those pieces with a jump to the default +-- label (if there is one), returning a SeparatedList in mkFlatSwitchPlan +-- 4. We find replace two less-than branches by a single equal-to-test in +-- findSingleValues +-- 5. The thus collected pieces are assembled to a balanced binary tree. + + +type FlatSwitchPlan = SeparatedList Integer SwitchPlan + +-- | Does the target support switch out of the box? Then leave this to the +-- target! +targetSupportsSwitch :: HscTarget -> Bool +targetSupportsSwitch HscC = True +targetSupportsSwitch HscLlvm = True +targetSupportsSwitch _ = False + +-- | This function creates a SwitchPlan from a SwitchTargets value, breaking it +-- down into smaller pieces suitable for code generation. +createSwitchPlan :: SwitchTargets -> SwitchPlan +createSwitchPlan (SwitchTargets signed mbdef range m) = + -- pprTrace "createSwitchPlan" (text (show ids) $$ text (show (range,m)) $$ text (show pieces) $$ text (show flatPlan) $$ text (show plan)) $ + plan + where + pieces = concatMap breakTooSmall $ splitAtHoles maxJumpTableHole m + flatPlan = findSingleValues $ mkFlatSwitchPlan signed range mbdef pieces + plan = buildTree signed $ flatPlan + + +--- +--- Step 1: Splitting at large holes +--- +splitAtHoles :: Integer -> M.Map Integer a -> [M.Map Integer a] +splitAtHoles holeSize m = map (\range -> restrictMap range m) nonHoles + where + holes = filter (\(l,h) -> h - l > holeSize) $ zip (M.keys m) (tail (M.keys m)) + nonHoles = reassocTuples lo holes hi + + (lo,_) = M.findMin m + (hi,_) = M.findMax m + +--- +--- Step 2: Avoid small jump tables +--- +-- We do not want jump tables below a certain size. This breaks them up +-- (into singleton maps, for now) +breakTooSmall :: M.Map Integer a -> [M.Map Integer a] +breakTooSmall m + | M.size m > minJumpTableSize = [m] + | otherwise = [M.singleton k v | (k,v) <- M.toList m] + +--- +--- Step 3: Fill in the blanks +--- + +-- A FlatSwitchPlan is a list of SwitchPlans, seperated by a integer dividing the range. +-- So if we have [plan1] n [plan2], then we use plan1 if the expression is < +-- n, and plan2 otherwise. + +mkFlatSwitchPlan :: Bool -> Maybe Label -> (Integer, Integer) -> [M.Map Integer Label] -> FlatSwitchPlan + +-- If we have no default (i.e. undefined where there is no entry), we can +-- branch at the minimum of each map +mkFlatSwitchPlan _ Nothing _ [] = pprPanic "mkFlatSwitchPlan with nothing left to do" empty +mkFlatSwitchPlan signed Nothing _ (m:ms) + = (mkLeafPlan signed Nothing m , [ (fst (M.findMin m'), mkLeafPlan signed Nothing m') | m' <- ms ]) + +-- If we have a default, we have to interleave segments that jump +-- to the default between the maps +mkFlatSwitchPlan signed (Just l) r ms = let ((_,p1):ps) = go r ms in (p1, ps) + where + go (lo,hi) [] + | lo > hi = [] + | otherwise = [(lo, Unconditionally l)] + go (lo,hi) (m:ms) + | lo < min + = (lo, Unconditionally l) : go (min,hi) (m:ms) + | lo == min + = (lo, mkLeafPlan signed (Just l) m) : go (max+1,hi) ms + | otherwise + = pprPanic "mkFlatSwitchPlan" (integer lo <+> integer min) + where + min = fst (M.findMin m) + max = fst (M.findMax m) + + +mkLeafPlan :: Bool -> Maybe Label -> M.Map Integer Label -> SwitchPlan +mkLeafPlan signed mbdef m + | [(_,l)] <- M.toList m -- singleton map + = Unconditionally l + | otherwise + = JumpTable $ mkSwitchTargets signed (min,max) mbdef m + where + min = fst (M.findMin m) + max = fst (M.findMax m) + +--- +--- Step 4: Reduce the number of branches using == +--- + +-- A seqence of three unconditional jumps, with the outer two pointing to the +-- same value and the bounds off by exactly one can be improved +findSingleValues :: FlatSwitchPlan -> FlatSwitchPlan +findSingleValues (Unconditionally l, (i, Unconditionally l2) : (i', Unconditionally l3) : xs) + | l == l3 && i + 1 == i' + = findSingleValues (IfEqual i l2 (Unconditionally l), xs) +findSingleValues (p, (i,p'):xs) + = (p,i) `consSL` findSingleValues (p', xs) +findSingleValues (p, []) + = (p, []) + +--- +--- Step 5: Actually build the tree +--- + +-- Build a balanced tree from a separated list +buildTree :: Bool -> FlatSwitchPlan -> SwitchPlan +buildTree _ (p,[]) = p +buildTree signed sl = IfLT signed m (buildTree signed sl1) (buildTree signed sl2) + where + (sl1, m, sl2) = divideSL sl + + + +-- +-- Utility data type: Non-empty lists with extra markers in between each +-- element: +-- + +type SeparatedList b a = (a, [(b,a)]) + +consSL :: (a, b) -> SeparatedList b a -> SeparatedList b a +consSL (a, b) (a', xs) = (a, (b,a'):xs) + +divideSL :: SeparatedList b a -> (SeparatedList b a, b, SeparatedList b a) +divideSL (_,[]) = error "divideSL: Singleton SeparatedList" +divideSL (p,xs) = ((p, xs1), m, (p', xs2)) + where + (xs1, (m,p'):xs2) = splitAt (length xs `div` 2) xs + +-- +-- Other Utilities +-- + +restrictMap :: Integral a => (a,a) -> M.Map a b -> M.Map a b +restrictMap (lo,hi) m = mid + where (_, mid_hi) = M.split (lo-1) m + (mid, _) = M.split (hi+1) mid_hi + +-- for example: reassocTuples a [(b,c),(d,e)] f == [(a,b),(c,d),(e,f)] +reassocTuples :: a -> [(a,a)] -> a -> [(a,a)] +reassocTuples initial [] last + = [(initial,last)] +reassocTuples initial ((a,b):tuples) last + = (initial,a) : reassocTuples b tuples last + +-- Note [CmmSwitch vs. CmmImplementSwitchPlans] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- I (Joachim) separated the two somewhat closely related modules +-- +-- - CmmSwitch, which provides the CmmSwitchTargets type and contains the strategy +-- for implementing a Cmm switch (createSwitchPlan), and +-- - CmmImplementSwitchPlans, which contains the actuall Cmm graph modification, +-- +-- for these reasons: +-- +-- * CmmSwitch is very low in the dependency tree, i.e. does not depend on any +-- GHC specific modules at all (with the exception of Output and Hoople +-- (Literal)). CmmImplementSwitchPlans is the Cmm transformation and hence very +-- high in the dependency tree. +-- * CmmSwitch provides the CmmSwitchTargets data type, which is abstract, but +-- used in CmmNodes. +-- * Because CmmSwitch is low in the dependency tree, the separation allows +-- for more parallelism when building GHC. +-- * The interaction between the modules is very explicit and easy to +-- understand, due to the small and simple interface. diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index 3ddb9ec002..d21d703e58 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -28,9 +28,11 @@ module CmmUtils( cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW, cmmIndex, cmmIndexExpr, cmmLoadIndex, cmmLoadIndexW, cmmNegate, - cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord, - cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord, - cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord, + cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord, + cmmSLtWord, + cmmNeWord, cmmEqWord, + cmmOrWord, cmmAndWord, + cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord, cmmToWord, isTrivialCmmExpr, hasNoGlobalRegs, @@ -304,9 +306,11 @@ cmmLoadIndexW :: DynFlags -> CmmExpr -> Int -> CmmType -> CmmExpr cmmLoadIndexW dflags base off ty = CmmLoad (cmmOffsetW dflags base off) ty ----------------------- -cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord, - cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord, - cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord +cmmULtWord, cmmUGeWord, cmmUGtWord, cmmUShrWord, + cmmSLtWord, + cmmNeWord, cmmEqWord, + cmmOrWord, cmmAndWord, + cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord :: DynFlags -> CmmExpr -> CmmExpr -> CmmExpr cmmOrWord dflags e1 e2 = CmmMachOp (mo_wordOr dflags) [e1, e2] cmmAndWord dflags e1 e2 = CmmMachOp (mo_wordAnd dflags) [e1, e2] @@ -316,6 +320,7 @@ cmmULtWord dflags e1 e2 = CmmMachOp (mo_wordULt dflags) [e1, e2] cmmUGeWord dflags e1 e2 = CmmMachOp (mo_wordUGe dflags) [e1, e2] cmmUGtWord dflags e1 e2 = CmmMachOp (mo_wordUGt dflags) [e1, e2] --cmmShlWord dflags e1 e2 = CmmMachOp (mo_wordShl dflags) [e1, e2] +cmmSLtWord dflags e1 e2 = CmmMachOp (mo_wordSLt dflags) [e1, e2] cmmUShrWord dflags e1 e2 = CmmMachOp (mo_wordUShr dflags) [e1, e2] cmmAddWord dflags e1 e2 = CmmMachOp (mo_wordAdd dflags) [e1, e2] cmmSubWord dflags e1 e2 = CmmMachOp (mo_wordSub dflags) [e1, e2] diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs index 064577cd0a..d2aa4aa057 100644 --- a/compiler/cmm/MkGraph.hs +++ b/compiler/cmm/MkGraph.hs @@ -22,6 +22,7 @@ where import BlockId import Cmm import CmmCallConv +import CmmSwitch (SwitchTargets) import Compiler.Hoopl hiding (Unique, (<*>), mkFirst, mkMiddle, mkLast, mkLabel, mkBranch, Shape(..)) import DynFlags @@ -223,7 +224,7 @@ mkJumpExtra dflags conv e actuals updfr_off extra_stack = mkCbranch :: CmmExpr -> BlockId -> BlockId -> CmmAGraph mkCbranch pred ifso ifnot = mkLast (CmmCondBranch pred ifso ifnot) -mkSwitch :: CmmExpr -> [Maybe BlockId] -> CmmAGraph +mkSwitch :: CmmExpr -> SwitchTargets -> CmmAGraph mkSwitch e tbl = mkLast $ CmmSwitch e tbl mkReturn :: DynFlags -> CmmExpr -> [CmmActual] -> UpdFrameOffset diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index a2c3abf320..92c818242d 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -33,6 +33,7 @@ import Cmm hiding (pprBBlock) import PprCmm () import Hoopl import CmmUtils +import CmmSwitch -- Utils import CPrim @@ -299,21 +300,12 @@ pprCondBranch expr yes no -- -- we find the fall-through cases -- --- N.B. we remove Nothing's from the list of branches, as they are --- 'undefined'. However, they may be defined one day, so we better --- document this behaviour. --- -pprSwitch :: DynFlags -> CmmExpr -> [ Maybe BlockId ] -> SDoc -pprSwitch dflags e maybe_ids - = let pairs = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ] - pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ] - in - (hang (ptext (sLit "switch") <+> parens ( pprExpr e ) <+> lbrace) - 4 (vcat ( map caseify pairs2 ))) - $$ rbrace - +pprSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> SDoc +pprSwitch dflags e ids + = (hang (ptext (sLit "switch") <+> parens ( pprExpr e ) <+> lbrace) + 4 (vcat ( map caseify pairs ) $$ def)) $$ rbrace where - sndEq (_,x) (_,y) = x == y + (pairs, mbdef) = switchTargetsFallThrough ids -- fall through case caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix @@ -326,7 +318,10 @@ pprSwitch dflags e maybe_ids hsep [ ptext (sLit "case") , pprHexVal ix (wordWidth dflags) <> colon , ptext (sLit "goto") , (pprBlockId ident) <> semi ] - caseify (_ , _ ) = panic "pprSwtich: swtich with no cases!" + caseify (_ , _ ) = panic "pprSwitch: switch with no cases!" + + def | Just l <- mbdef = ptext (sLit "default: goto") <+> pprBlockId l <> semi + | otherwise = empty -- --------------------------------------------------------------------- -- Expressions. diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index 9d9f3081dc..d5999f53fa 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -43,6 +43,7 @@ import BlockId () import CLabel import Cmm import CmmUtils +import CmmSwitch import DynFlags import FastString import Outputable @@ -228,25 +229,31 @@ pprNode node = pp_node <+> pp_debug , ppr f <> semi ] - CmmSwitch expr maybe_ids -> - hang (hcat [ ptext (sLit "switch [0 .. ") - , int (length maybe_ids - 1) - , ptext (sLit "] ") + CmmSwitch expr ids -> + hang (hsep [ ptext (sLit "switch") + , range , if isTrivialCmmExpr expr then ppr expr else parens (ppr expr) - , ptext (sLit " {") + , ptext (sLit "{") ]) - 4 (vcat ( map caseify pairs )) $$ rbrace - where pairs = groupBy snds (zip [0 .. ] maybe_ids ) - snds a b = (snd a) == (snd b) - caseify ixs@((_,Nothing):_) = ptext (sLit "/* impossible: ") - <> hcat (intersperse comma (map (int.fst) ixs)) <> ptext (sLit " */") - caseify as = let (is,ids) = unzip as - in hsep [ ptext (sLit "case") - , hcat (punctuate comma (map int is)) - , ptext (sLit ": goto") - , ppr (head [ id | Just id <- ids]) <> semi ] + 4 (vcat (map ppCase cases) $$ def) $$ rbrace + where + (cases, mbdef) = switchTargetsFallThrough ids + ppCase (is,l) = hsep + [ ptext (sLit "case") + , commafy $ map integer is + , ptext (sLit ": goto") + , ppr l <> semi + ] + def | Just l <- mbdef = hsep + [ ptext (sLit "default: goto") + , ppr l <> semi + ] + | otherwise = empty + + range = brackets $ hsep [integer lo, ptext (sLit ".."), integer hi] + where (lo,hi) = switchTargetsRange ids CmmCall tgt k regs out res updfr_off -> hcat [ ptext (sLit "call"), space diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 98295c9836..9e056582f3 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -51,6 +51,7 @@ import MkGraph import CodeGen.Platform import CLabel import CmmUtils +import CmmSwitch import ForeignCall import IdInfo @@ -60,7 +61,6 @@ import SMRep import Module import Literal import Digraph -import ListSetOps import Util import Unique import DynFlags @@ -68,11 +68,11 @@ import FastString import Outputable import qualified Data.ByteString as BS +import qualified Data.Map as M import Data.Char import Data.List import Data.Ord import Data.Word -import Data.Maybe ------------------------------------------------------------------------- @@ -87,14 +87,6 @@ cgLit (MachStr s) = newByteStringCLit (BS.unpack s) cgLit other_lit = do dflags <- getDynFlags return (mkSimpleLit dflags other_lit) -mkLtOp :: DynFlags -> Literal -> MachOp --- On signed literals we must do a signed comparison -mkLtOp dflags (MachInt _) = MO_S_Lt (wordWidth dflags) -mkLtOp _ (MachFloat _) = MO_F_Lt W32 -mkLtOp _ (MachDouble _) = MO_F_Lt W64 -mkLtOp dflags lit = MO_U_Lt (typeWidth (cmmLitType dflags (mkSimpleLit dflags lit))) - -- ToDo: seems terribly indirect! - mkSimpleLit :: DynFlags -> Literal -> CmmLit mkSimpleLit dflags (MachChar c) = CmmInt (fromIntegral (ord c)) (wordWidth dflags) mkSimpleLit dflags MachNullAddr = zeroCLit dflags @@ -460,174 +452,52 @@ emitSwitch :: CmmExpr -- Tag to switch on -- behaviour outside this range is -- undefined -> FCode () -emitSwitch tag_expr branches mb_deflt lo_tag hi_tag - = do { dflags <- getDynFlags - ; mkCmmSwitch (via_C dflags) tag_expr branches mb_deflt lo_tag hi_tag } - where - via_C dflags | HscC <- hscTarget dflags = True - | otherwise = False - - -mkCmmSwitch :: Bool -- True <=> never generate a - -- conditional tree - -> CmmExpr -- Tag to switch on - -> [(ConTagZ, CmmAGraphScoped)] -- Tagged branches - -> Maybe CmmAGraphScoped -- Default branch (if any) - -> ConTagZ -> ConTagZ -- Min and Max possible values; - -- behaviour outside this range is - -- undefined - -> FCode () -- First, two rather common cases in which there is no work to do -mkCmmSwitch _ _ [] (Just code) _ _ = emit (fst code) -mkCmmSwitch _ _ [(_,code)] Nothing _ _ = emit (fst code) +emitSwitch _ [] (Just code) _ _ = emit (fst code) +emitSwitch _ [(_,code)] Nothing _ _ = emit (fst code) -- Right, off we go -mkCmmSwitch via_C tag_expr branches mb_deflt lo_tag hi_tag = do +emitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do join_lbl <- newLabelC mb_deflt_lbl <- label_default join_lbl mb_deflt branches_lbls <- label_branches join_lbl branches tag_expr' <- assignTemp' tag_expr - emit =<< mk_switch tag_expr' (sortBy (comparing fst) branches_lbls) - mb_deflt_lbl lo_tag hi_tag via_C + -- Sort the branches before calling mk_discrete_switch + let branches_lbls' = [ (fromIntegral i, l) | (i,l) <- sortBy (comparing fst) branches_lbls ] + let range = (fromIntegral lo_tag, fromIntegral hi_tag) - -- Sort the branches before calling mk_switch + emit $ mk_discrete_switch False tag_expr' branches_lbls' mb_deflt_lbl range emitLabel join_lbl -mk_switch :: CmmExpr -> [(ConTagZ, BlockId)] +mk_discrete_switch :: Bool -- ^ Use signed comparisons + -> CmmExpr + -> [(Integer, BlockId)] -> Maybe BlockId - -> ConTagZ -> ConTagZ -> Bool - -> FCode CmmAGraph + -> (Integer, Integer) + -> CmmAGraph -- SINGLETON TAG RANGE: no case analysis to do -mk_switch _tag_expr [(tag, lbl)] _ lo_tag hi_tag _via_C +mk_discrete_switch _ _tag_expr [(tag, lbl)] _ (lo_tag, hi_tag) | lo_tag == hi_tag = ASSERT( tag == lo_tag ) - return (mkBranch lbl) + mkBranch lbl -- SINGLETON BRANCH, NO DEFAULT: no case analysis to do -mk_switch _tag_expr [(_tag,lbl)] Nothing _ _ _ - = return (mkBranch lbl) +mk_discrete_switch _ _tag_expr [(_tag,lbl)] Nothing _ + = mkBranch lbl -- The simplifier might have eliminated a case -- so we may have e.g. case xs of -- [] -> e -- In that situation we can be sure the (:) case -- can't happen, so no need to test --- SINGLETON BRANCH: one equality check to do -mk_switch tag_expr [(tag,lbl)] (Just deflt) _ _ _ - = do dflags <- getDynFlags - let cond = cmmNeWord dflags tag_expr (mkIntExpr dflags tag) - -- We have lo_tag < hi_tag, but there's only one branch, - -- so there must be a default - return (mkCbranch cond deflt lbl) - --- ToDo: we might want to check for the two branch case, where one of --- the branches is the tag 0, because comparing '== 0' is likely to be --- more efficient than other kinds of comparison. - --- DENSE TAG RANGE: use a switch statment. --- --- We also use a switch uncoditionally when compiling via C, because --- this will get emitted as a C switch statement and the C compiler --- should do a good job of optimising it. Also, older GCC versions --- (2.95 in particular) have problems compiling the complicated --- if-trees generated by this code, so compiling to a switch every --- time works around that problem. --- -mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C - | use_switch -- Use a switch - = do let - find_branch :: ConTagZ -> Maybe BlockId - find_branch i = case (assocMaybe branches i) of - Just lbl -> Just lbl - Nothing -> mb_deflt - - -- NB. we have eliminated impossible branches at - -- either end of the range (see below), so the first - -- tag of a real branch is real_lo_tag (not lo_tag). - arms :: [Maybe BlockId] - arms = [ find_branch i | i <- [real_lo_tag..real_hi_tag]] - dflags <- getDynFlags - return (mkSwitch (cmmOffset dflags tag_expr (- real_lo_tag)) arms) - - -- if we can knock off a bunch of default cases with one if, then do so - | Just deflt <- mb_deflt, (lowest_branch - lo_tag) >= n_branches - = do dflags <- getDynFlags - stmts <- mk_switch tag_expr branches mb_deflt - lowest_branch hi_tag via_C - mkCmmIfThenElse - (cmmULtWord dflags tag_expr (mkIntExpr dflags lowest_branch)) - (mkBranch deflt) - stmts - - | Just deflt <- mb_deflt, (hi_tag - highest_branch) >= n_branches - = do dflags <- getDynFlags - stmts <- mk_switch tag_expr branches mb_deflt - lo_tag highest_branch via_C - mkCmmIfThenElse - (cmmUGtWord dflags tag_expr (mkIntExpr dflags highest_branch)) - (mkBranch deflt) - stmts - - | otherwise -- Use an if-tree - = do dflags <- getDynFlags - lo_stmts <- mk_switch tag_expr lo_branches mb_deflt - lo_tag (mid_tag-1) via_C - hi_stmts <- mk_switch tag_expr hi_branches mb_deflt - mid_tag hi_tag via_C - mkCmmIfThenElse - (cmmUGeWord dflags tag_expr (mkIntExpr dflags mid_tag)) - hi_stmts - lo_stmts - -- we test (e >= mid_tag) rather than (e < mid_tag), because - -- the former works better when e is a comparison, and there - -- are two tags 0 & 1 (mid_tag == 1). In this case, the code - -- generator can reduce the condition to e itself without - -- having to reverse the sense of the comparison: comparisons - -- can't always be easily reversed (eg. floating - -- pt. comparisons). - where - use_switch = {- pprTrace "mk_switch" ( - ppr tag_expr <+> text "n_tags:" <+> int n_tags <+> - text "branches:" <+> ppr (map fst branches) <+> - text "n_branches:" <+> int n_branches <+> - text "lo_tag:" <+> int lo_tag <+> - text "hi_tag:" <+> int hi_tag <+> - text "real_lo_tag:" <+> int real_lo_tag <+> - text "real_hi_tag:" <+> int real_hi_tag) $ -} - ASSERT( n_branches > 1 && n_tags > 1 ) - n_tags > 2 && (via_C || (dense && big_enough)) - -- up to 4 branches we use a decision tree, otherwise - -- a switch (== jump table in the NCG). This seems to be - -- optimal, and corresponds with what gcc does. - big_enough = n_branches > 4 - dense = n_branches > (n_tags `div` 2) - n_branches = length branches - - -- ignore default slots at each end of the range if there's - -- no default branch defined. - lowest_branch = fst (head branches) - highest_branch = fst (last branches) - - real_lo_tag - | isNothing mb_deflt = lowest_branch - | otherwise = lo_tag - - real_hi_tag - | isNothing mb_deflt = highest_branch - | otherwise = hi_tag - - n_tags = real_hi_tag - real_lo_tag + 1 - - -- INVARIANT: Provided hi_tag > lo_tag (which is true) - -- lo_tag <= mid_tag < hi_tag - -- lo_branches have tags < mid_tag - -- hi_branches have tags >= mid_tag - (lo_branches, mid_tag, hi_branches) = divideBranches branches - +-- SOMETHING MORE COMPLICATED: defer to CmmImplementSwitchPlans +-- See Note [Cmm Switches, the general plan] in CmmSwitch +mk_discrete_switch signed tag_expr branches mb_deflt range + = mkSwitch tag_expr $ mkSwitchTargets signed range mb_deflt (M.fromList branches) divideBranches :: Ord a => [(a,b)] -> ([(a,b)], a, [(a,b)]) divideBranches branches = (lo_branches, mid, hi_branches) @@ -644,20 +514,34 @@ emitCmmLitSwitch :: CmmExpr -- Tag to switch on -> [(Literal, CmmAGraphScoped)] -- Tagged branches -> CmmAGraphScoped -- Default branch (always) -> FCode () -- Emit the code --- Used for general literals, whose size might not be a word, --- where there is always a default case, and where we don't know --- the range of values for certain. For simplicity we always generate a tree. --- --- ToDo: for integers we could do better here, perhaps by generalising --- mk_switch and using that. --SDM 15/09/2004 emitCmmLitSwitch _scrut [] deflt = emit $ fst deflt emitCmmLitSwitch scrut branches deflt = do scrut' <- assignTemp' scrut join_lbl <- newLabelC deflt_lbl <- label_code join_lbl deflt branches_lbls <- label_branches join_lbl branches - emit =<< mk_lit_switch scrut' deflt_lbl noBound - (sortBy (comparing fst) branches_lbls) + + dflags <- getDynFlags + let cmm_ty = cmmExprType dflags scrut + rep = typeWidth cmm_ty + + -- We find the necessary type information in the literals in the branches + let signed = case head branches of + (MachInt _, _) -> True + (MachInt64 _, _) -> True + _ -> False + + let range | signed = (tARGET_MIN_INT dflags, tARGET_MAX_INT dflags) + | otherwise = (0, tARGET_MAX_WORD dflags) + + if isFloatType cmm_ty + then emit =<< mk_float_switch rep scrut' deflt_lbl noBound branches_lbls + else emit $ mk_discrete_switch + signed + scrut' + [(litValue lit,l) | (lit,l) <- branches_lbls] + (Just deflt_lbl) + range emitLabel join_lbl -- | lower bound (inclusive), upper bound (exclusive) @@ -666,31 +550,23 @@ type LitBound = (Maybe Literal, Maybe Literal) noBound :: LitBound noBound = (Nothing, Nothing) -mk_lit_switch :: CmmExpr -> BlockId +mk_float_switch :: Width -> CmmExpr -> BlockId -> LitBound -> [(Literal,BlockId)] -> FCode CmmAGraph -mk_lit_switch scrut deflt bounds [(lit,blk)] - = do - dflags <- getDynFlags - let - cmm_lit = mkSimpleLit dflags lit - cmm_ty = cmmLitType dflags cmm_lit - rep = typeWidth cmm_ty - ne = if isFloatType cmm_ty then MO_F_Ne rep else MO_Ne rep - - return $ if lit `onlyWithinBounds'` bounds - then mkBranch blk - else mkCbranch (CmmMachOp ne [scrut, CmmLit cmm_lit]) deflt blk +mk_float_switch rep scrut deflt _bounds [(lit,blk)] + = do dflags <- getDynFlags + return $ mkCbranch (cond dflags) deflt blk where - -- If the bounds already imply scrut == lit, then we can skip the final check (#10129) - l `onlyWithinBounds'` (Just lo, Just hi) = l `onlyWithinBounds` (lo, hi) - _ `onlyWithinBounds'` _ = False + cond dflags = CmmMachOp ne [scrut, CmmLit cmm_lit] + where + cmm_lit = mkSimpleLit dflags lit + ne = MO_F_Ne rep -mk_lit_switch scrut deflt_blk_id (lo_bound, hi_bound) branches +mk_float_switch rep scrut deflt_blk_id (lo_bound, hi_bound) branches = do dflags <- getDynFlags - lo_blk <- mk_lit_switch scrut deflt_blk_id bounds_lo lo_branches - hi_blk <- mk_lit_switch scrut deflt_blk_id bounds_hi hi_branches + lo_blk <- mk_float_switch rep scrut deflt_blk_id bounds_lo lo_branches + hi_blk <- mk_float_switch rep scrut deflt_blk_id bounds_hi hi_branches mkCmmIfThenElse (cond dflags) lo_blk hi_blk where (lo_branches, mid_lit, hi_branches) = divideBranches branches @@ -698,8 +574,10 @@ mk_lit_switch scrut deflt_blk_id (lo_bound, hi_bound) branches bounds_lo = (lo_bound, Just mid_lit) bounds_hi = (Just mid_lit, hi_bound) - cond dflags = CmmMachOp (mkLtOp dflags mid_lit) - [scrut, CmmLit (mkSimpleLit dflags mid_lit)] + cond dflags = CmmMachOp lt [scrut, CmmLit cmm_lit] + where + cmm_lit = mkSimpleLit dflags mid_lit + lt = MO_F_Lt rep -------------- diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 684ee6bfaf..c39c83e22c 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -197,6 +197,7 @@ Library CmmPipeline CmmCallConv CmmCommonBlockElim + CmmImplementSwitchPlans CmmContFlowOpt CmmExpr CmmInfo @@ -204,6 +205,7 @@ Library CmmLint CmmLive CmmMachOp + CmmSwitch CmmNode CmmOpt CmmParse diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 132a4dd67a..6f396fa514 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -601,6 +601,7 @@ compiler_stage2_dll0_MODULES += \ CmmInfo \ CmmMachOp \ CmmNode \ + CmmSwitch \ CmmUtils \ CodeGen.Platform \ CodeGen.Platform.ARM \ diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index c7be2c3194..4f864b6904 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -18,6 +18,7 @@ import Cmm import CPrim import PprCmm import CmmUtils +import CmmSwitch import Hoopl import DynFlags @@ -824,18 +825,16 @@ For a real example of this, see ./rts/StgStdThunks.cmm -- | Switch branch --- --- N.B. We remove Nothing's from the list of branches, as they are 'undefined'. --- However, they may be defined one day, so we better document this behaviour. -genSwitch :: CmmExpr -> [Maybe BlockId] -> LlvmM StmtData -genSwitch cond maybe_ids = do +genSwitch :: CmmExpr -> SwitchTargets -> LlvmM StmtData +genSwitch cond ids = do (vc, stmts, top) <- exprToVar cond let ty = getVarType vc - let pairs = [ (ix, id) | (ix,Just id) <- zip [0..] maybe_ids ] - let labels = map (\(ix, b) -> (mkIntLit ty ix, blockIdToLlvm b)) pairs + let labels = [ (mkIntLit ty ix, blockIdToLlvm b) + | (ix, b) <- switchTargetsCases ids ] -- out of range is undefined, so let's just branch to first label - let (_, defLbl) = head labels + let defLbl | Just l <- switchTargetsDefault ids = blockIdToLlvm l + | otherwise = snd (head labels) let s1 = Switch vc defLbl labels return $ (stmts `snocOL` s1, top) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 8e3733f5b6..0dc25e382d 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -243,6 +243,7 @@ data DumpFlag -- enabled if you run -ddump-cmm | Opt_D_dump_cmm_cfg | Opt_D_dump_cmm_cbe + | Opt_D_dump_cmm_switch | Opt_D_dump_cmm_proc | Opt_D_dump_cmm_sink | Opt_D_dump_cmm_sp @@ -2441,6 +2442,7 @@ dynamic_flags = [ , defGhcFlag "ddump-cmm-raw" (setDumpFlag Opt_D_dump_cmm_raw) , defGhcFlag "ddump-cmm-cfg" (setDumpFlag Opt_D_dump_cmm_cfg) , defGhcFlag "ddump-cmm-cbe" (setDumpFlag Opt_D_dump_cmm_cbe) + , defGhcFlag "ddump-cmm-switch" (setDumpFlag Opt_D_dump_cmm_switch) , defGhcFlag "ddump-cmm-proc" (setDumpFlag Opt_D_dump_cmm_proc) , defGhcFlag "ddump-cmm-sink" (setDumpFlag Opt_D_dump_cmm_sink) , defGhcFlag "ddump-cmm-sp" (setDumpFlag Opt_D_dump_cmm_sp) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index e547ab6c95..a115980183 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -45,6 +45,7 @@ import BlockId import PprCmm ( pprExpr ) import Cmm import CmmUtils +import CmmSwitch import CLabel import Hoopl @@ -152,8 +153,8 @@ stmtToInstrs stmt = do CmmCondBranch arg true false -> do b1 <- genCondJump true arg b2 <- genBranch false return (b1 `appOL` b2) - CmmSwitch arg ids -> do dflags <- getDynFlags - genSwitch dflags arg ids + CmmSwitch arg ids -> do dflags <- getDynFlags + genSwitch dflags arg ids CmmCall { cml_target = arg } -> genJump arg _ -> panic "stmtToInstrs: statement should have been cps'd away" @@ -1201,11 +1202,11 @@ genCCall' dflags gcp target dest_regs args0 -- ----------------------------------------------------------------------------- -- Generating a table-branch -genSwitch :: DynFlags -> CmmExpr -> [Maybe BlockId] -> NatM InstrBlock -genSwitch dflags expr ids +genSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock +genSwitch dflags expr targets | gopt Opt_PIC dflags = do - (reg,e_code) <- getSomeReg expr + (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset) tmp <- getNewRegNat II32 lbl <- getNewLabelNat dflags <- getDynFlags @@ -1221,7 +1222,7 @@ genSwitch dflags expr ids return code | otherwise = do - (reg,e_code) <- getSomeReg expr + (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset) tmp <- getNewRegNat II32 lbl <- getNewLabelNat let code = e_code `appOL` toOL [ @@ -1232,6 +1233,7 @@ genSwitch dflags expr ids BCTR ids (Just lbl) ] return code + where (offset, ids) = switchTargetsToTable targets generateJumpTableForInstr :: DynFlags -> Instr -> Maybe (NatCmmDecl CmmStatics Instr) diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs index bba849da61..a9d861946e 100644 --- a/compiler/nativeGen/SPARC/CodeGen.hs +++ b/compiler/nativeGen/SPARC/CodeGen.hs @@ -43,6 +43,7 @@ import NCGMonad import BlockId import Cmm import CmmUtils +import CmmSwitch import Hoopl import PIC import Reg @@ -150,8 +151,8 @@ stmtToInstrs stmt = do CmmCondBranch arg true false -> do b1 <- genCondJump true arg b2 <- genBranch false return (b1 `appOL` b2) - CmmSwitch arg ids -> do dflags <- getDynFlags - genSwitch dflags arg ids + CmmSwitch arg ids -> do dflags <- getDynFlags + genSwitch dflags arg ids CmmCall { cml_target = arg } -> genJump arg _ @@ -308,13 +309,13 @@ genCondJump bid bool = do -- ----------------------------------------------------------------------------- -- Generating a table-branch -genSwitch :: DynFlags -> CmmExpr -> [Maybe BlockId] -> NatM InstrBlock -genSwitch dflags expr ids +genSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock +genSwitch dflags expr targets | gopt Opt_PIC dflags = error "MachCodeGen: sparc genSwitch PIC not finished\n" | otherwise - = do (e_reg, e_code) <- getSomeReg expr + = do (e_reg, e_code) <- getSomeReg (cmmOffset dflags expr offset) base_reg <- getNewRegNat II32 offset_reg <- getNewRegNat II32 @@ -335,6 +336,7 @@ genSwitch dflags expr ids , LD II32 (AddrRegReg base_reg offset_reg) dst , JMP_TBL (AddrRegImm dst (ImmInt 0)) ids label , NOP ] + where (offset, ids) = switchTargetsToTable targets generateJumpTableForInstr :: DynFlags -> Instr -> Maybe (NatCmmDecl CmmStatics Instr) diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 531213dc7f..7b7cc54bbe 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -45,6 +45,7 @@ import BlockId import Module ( primPackageKey ) import PprCmm () import CmmUtils +import CmmSwitch import Cmm import Hoopl import CLabel @@ -180,8 +181,8 @@ stmtToInstrs stmt = do CmmCondBranch arg true false -> do b1 <- genCondJump true arg b2 <- genBranch false return (b1 `appOL` b2) - CmmSwitch arg ids -> do dflags <- getDynFlags - genSwitch dflags arg ids + CmmSwitch arg ids -> do dflags <- getDynFlags + genSwitch dflags arg ids CmmCall { cml_target = arg , cml_args_regs = gregs } -> do dflags <- getDynFlags @@ -2584,12 +2585,12 @@ outOfLineCmmOp mop res args -- ----------------------------------------------------------------------------- -- Generating a table-branch -genSwitch :: DynFlags -> CmmExpr -> [Maybe BlockId] -> NatM InstrBlock +genSwitch :: DynFlags -> CmmExpr -> SwitchTargets -> NatM InstrBlock -genSwitch dflags expr ids +genSwitch dflags expr targets | gopt Opt_PIC dflags = do - (reg,e_code) <- getSomeReg expr + (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset) lbl <- getNewLabelNat dflags <- getDynFlags dynRef <- cmmMakeDynamicReference dflags DataReference lbl @@ -2631,13 +2632,14 @@ genSwitch dflags expr ids ] | otherwise = do - (reg,e_code) <- getSomeReg expr + (reg,e_code) <- getSomeReg (cmmOffset dflags expr offset) lbl <- getNewLabelNat let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (wORD_SIZE dflags)) (ImmCLbl lbl)) code = e_code `appOL` toOL [ JMP_TBL op ids ReadOnlyData lbl ] return code + where (offset, ids) = switchTargetsToTable targets generateJumpTableForInstr :: DynFlags -> Instr -> Maybe (NatCmmDecl (Alignment, CmmStatics) Instr) generateJumpTableForInstr dflags (JMP_TBL _ ids section lbl) diff --git a/testsuite/tests/codeGen/should_run/CmmSwitchTest.hs b/testsuite/tests/codeGen/should_run/CmmSwitchTest.hs new file mode 100644 index 0000000000..4fbe822b3b --- /dev/null +++ b/testsuite/tests/codeGen/should_run/CmmSwitchTest.hs @@ -0,0 +1,505 @@ +{-# LANGUAGE MagicHash #-} +import Control.Monad (unless, forM_) +import GHC.Exts +{-# NOINLINE aa #-} +aa :: Int# -> Int# +aa 1# = 42# +aa 2# = 43# +aa 3# = 43# +aa 4# = 44# +aa 5# = 44# +aa 6# = 45# +aa 7# = 45# +aa 8# = 46# +aa 9# = 46# +aa 10# = 47# +aa _ = 1337# + +{-# NOINLINE ab #-} +ab :: Int# -> Int# +ab 0# = 42# +ab 1# = 42# +ab 2# = 43# +ab 3# = 43# +ab 4# = 44# +ab 5# = 44# +ab 6# = 45# +ab 7# = 45# +ab 8# = 46# +ab 9# = 46# +ab 10# = 47# +ab _ = 1337# + +{-# NOINLINE ac #-} +ac :: Int# -> Int# +ac 1# = 42# +ac 2# = 43# +ac 3# = 43# +ac _ = 1337# + +{-# NOINLINE ad #-} +ad :: Int# -> Int# +ad 1# = 42# +ad 2# = 43# +ad 3# = 43# +ad 4# = 44# +ad _ = 1337# + +{-# NOINLINE ae #-} +ae :: Int# -> Int# +ae 1# = 42# +ae 2# = 43# +ae 3# = 43# +ae 4# = 44# +ae 5# = 44# +ae _ = 1337# + +{-# NOINLINE af #-} +af :: Int# -> Int# +af -1# = 41# +af 0# = 42# +af 1# = 42# +af 2# = 43# +af 3# = 43# +af 4# = 44# +af 5# = 44# +af 6# = 45# +af 7# = 45# +af 8# = 46# +af 9# = 46# +af 10# = 47# +af _ = 1337# + +{-# NOINLINE ag #-} +ag :: Int# -> Int# +ag -10# = 37# +ag -9# = 37# +ag -8# = 38# +ag -7# = 38# +ag -6# = 39# +ag -5# = 39# +ag -4# = 40# +ag -3# = 40# +ag -2# = 41# +ag -1# = 41# +ag 0# = 42# +ag 1# = 42# +ag 2# = 43# +ag 3# = 43# +ag 4# = 44# +ag 5# = 44# +ag 6# = 45# +ag 7# = 45# +ag 8# = 46# +ag 9# = 46# +ag 10# = 47# +ag _ = 1337# + +{-# NOINLINE ah #-} +ah :: Int# -> Int# +ah -20# = 32# +ah -19# = 32# +ah -18# = 33# +ah -17# = 33# +ah -16# = 34# +ah -15# = 34# +ah -14# = 35# +ah -13# = 35# +ah -12# = 36# +ah -11# = 36# +ah -10# = 37# +ah 0# = 42# +ah 1# = 42# +ah 2# = 43# +ah 3# = 43# +ah 4# = 44# +ah 5# = 44# +ah 6# = 45# +ah 7# = 45# +ah 8# = 46# +ah 9# = 46# +ah 10# = 47# +ah _ = 1337# + +{-# NOINLINE ai #-} +ai :: Int# -> Int# +ai -20# = 32# +ai -19# = 32# +ai -18# = 33# +ai -17# = 33# +ai -16# = 34# +ai -15# = 34# +ai -14# = 35# +ai -13# = 35# +ai -12# = 36# +ai -11# = 36# +ai -10# = 37# +ai 1# = 42# +ai 2# = 43# +ai 3# = 43# +ai 4# = 44# +ai 5# = 44# +ai 6# = 45# +ai 7# = 45# +ai 8# = 46# +ai 9# = 46# +ai 10# = 47# +ai _ = 1337# + +{-# NOINLINE aj #-} +aj :: Int# -> Int# +aj -9223372036854775808# = -4611686018427387862# +aj 0# = 42# +aj 9223372036854775807# = 4611686018427387945# +aj _ = 1337# + +{-# NOINLINE ak #-} +ak :: Int# -> Int# +ak 9223372036854775797# = 4611686018427387940# +ak 9223372036854775798# = 4611686018427387941# +ak 9223372036854775799# = 4611686018427387941# +ak 9223372036854775800# = 4611686018427387942# +ak 9223372036854775801# = 4611686018427387942# +ak 9223372036854775802# = 4611686018427387943# +ak 9223372036854775803# = 4611686018427387943# +ak 9223372036854775804# = 4611686018427387944# +ak 9223372036854775805# = 4611686018427387944# +ak 9223372036854775806# = 4611686018427387945# +ak 9223372036854775807# = 4611686018427387945# +ak _ = 1337# + +{-# NOINLINE al #-} +al :: Int# -> Int# +al -9223372036854775808# = -4611686018427387862# +al -9223372036854775807# = -4611686018427387862# +al -9223372036854775806# = -4611686018427387861# +al -9223372036854775805# = -4611686018427387861# +al -9223372036854775804# = -4611686018427387860# +al -9223372036854775803# = -4611686018427387860# +al -9223372036854775802# = -4611686018427387859# +al -9223372036854775801# = -4611686018427387859# +al -9223372036854775800# = -4611686018427387858# +al -9223372036854775799# = -4611686018427387858# +al -9223372036854775798# = -4611686018427387857# +al 9223372036854775797# = 4611686018427387940# +al 9223372036854775798# = 4611686018427387941# +al 9223372036854775799# = 4611686018427387941# +al 9223372036854775800# = 4611686018427387942# +al 9223372036854775801# = 4611686018427387942# +al 9223372036854775802# = 4611686018427387943# +al 9223372036854775803# = 4611686018427387943# +al 9223372036854775804# = 4611686018427387944# +al 9223372036854775805# = 4611686018427387944# +al 9223372036854775806# = 4611686018427387945# +al 9223372036854775807# = 4611686018427387945# +al _ = 1337# + +{-# NOINLINE am #-} +am :: Word# -> Word# +am 0## = 42## +am 1## = 42## +am 2## = 43## +am 3## = 43## +am 4## = 44## +am 5## = 44## +am 6## = 45## +am 7## = 45## +am 8## = 46## +am 9## = 46## +am 10## = 47## +am _ = 1337## + +{-# NOINLINE an #-} +an :: Word# -> Word# +an 1## = 42## +an 2## = 43## +an 3## = 43## +an 4## = 44## +an 5## = 44## +an 6## = 45## +an 7## = 45## +an 8## = 46## +an 9## = 46## +an 10## = 47## +an _ = 1337## + +{-# NOINLINE ao #-} +ao :: Word# -> Word# +ao 0## = 42## +ao _ = 1337## + +{-# NOINLINE ap #-} +ap :: Word# -> Word# +ap 0## = 42## +ap 1## = 42## +ap _ = 1337## + +{-# NOINLINE aq #-} +aq :: Word# -> Word# +aq 0## = 42## +aq 1## = 42## +aq 2## = 43## +aq _ = 1337## + +{-# NOINLINE ar #-} +ar :: Word# -> Word# +ar 0## = 42## +ar 1## = 42## +ar 2## = 43## +ar 3## = 43## +ar _ = 1337## + +{-# NOINLINE as #-} +as :: Word# -> Word# +as 0## = 42## +as 1## = 42## +as 2## = 43## +as 3## = 43## +as 4## = 44## +as _ = 1337## + +{-# NOINLINE at #-} +at :: Word# -> Word# +at 1## = 42## +at _ = 1337## + +{-# NOINLINE au #-} +au :: Word# -> Word# +au 1## = 42## +au 2## = 43## +au _ = 1337## + +{-# NOINLINE av #-} +av :: Word# -> Word# +av 1## = 42## +av 2## = 43## +av 3## = 43## +av _ = 1337## + +{-# NOINLINE aw #-} +aw :: Word# -> Word# +aw 1## = 42## +aw 2## = 43## +aw 3## = 43## +aw 4## = 44## +aw _ = 1337## + +{-# NOINLINE ax #-} +ax :: Word# -> Word# +ax 1## = 42## +ax 2## = 43## +ax 3## = 43## +ax 4## = 44## +ax 5## = 44## +ax _ = 1337## + +{-# NOINLINE ay #-} +ay :: Word# -> Word# +ay 0## = 42## +ay 18446744073709551615## = 9223372036854775849## +ay _ = 1337## + +{-# NOINLINE az #-} +az :: Word# -> Word# +az 18446744073709551605## = 9223372036854775844## +az 18446744073709551606## = 9223372036854775845## +az 18446744073709551607## = 9223372036854775845## +az 18446744073709551608## = 9223372036854775846## +az 18446744073709551609## = 9223372036854775846## +az 18446744073709551610## = 9223372036854775847## +az 18446744073709551611## = 9223372036854775847## +az 18446744073709551612## = 9223372036854775848## +az 18446744073709551613## = 9223372036854775848## +az 18446744073709551614## = 9223372036854775849## +az 18446744073709551615## = 9223372036854775849## +az _ = 1337## + +{-# NOINLINE ba #-} +ba :: Word# -> Word# +ba 0## = 42## +ba 1## = 42## +ba 2## = 43## +ba 3## = 43## +ba 4## = 44## +ba 5## = 44## +ba 6## = 45## +ba 7## = 45## +ba 8## = 46## +ba 9## = 46## +ba 10## = 47## +ba 18446744073709551605## = 9223372036854775844## +ba 18446744073709551606## = 9223372036854775845## +ba 18446744073709551607## = 9223372036854775845## +ba 18446744073709551608## = 9223372036854775846## +ba 18446744073709551609## = 9223372036854775846## +ba 18446744073709551610## = 9223372036854775847## +ba 18446744073709551611## = 9223372036854775847## +ba 18446744073709551612## = 9223372036854775848## +ba 18446744073709551613## = 9223372036854775848## +ba 18446744073709551614## = 9223372036854775849## +ba 18446744073709551615## = 9223372036854775849## +ba _ = 1337## + +aa_check :: IO () +aa_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do + let r = I# (aa i) + unless (r == o) $ putStrLn $ "ERR: aa (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ab_check :: IO () +ab_check = forM_ [(-1,1337), (0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do + let r = I# (ab i) + unless (r == o) $ putStrLn $ "ERR: ab (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ac_check :: IO () +ac_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,1337)] $ \(I# i,o) -> do + let r = I# (ac i) + unless (r == o) $ putStrLn $ "ERR: ac (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ad_check :: IO () +ad_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,1337)] $ \(I# i,o) -> do + let r = I# (ad i) + unless (r == o) $ putStrLn $ "ERR: ad (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ae_check :: IO () +ae_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,1337)] $ \(I# i,o) -> do + let r = I# (ae i) + unless (r == o) $ putStrLn $ "ERR: ae (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +af_check :: IO () +af_check = forM_ [(-2,1337), (-1,41), (0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do + let r = I# (af i) + unless (r == o) $ putStrLn $ "ERR: af (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ag_check :: IO () +ag_check = forM_ [(-11,1337), (-10,37), (-9,37), (-8,38), (-7,38), (-6,39), (-5,39), (-4,40), (-3,40), (-2,41), (-1,41), (0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do + let r = I# (ag i) + unless (r == o) $ putStrLn $ "ERR: ag (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ah_check :: IO () +ah_check = forM_ [(-21,1337), (-20,32), (-19,32), (-18,33), (-17,33), (-16,34), (-15,34), (-14,35), (-13,35), (-12,36), (-11,36), (-10,37), (-9,1337), (-1,1337), (0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do + let r = I# (ah i) + unless (r == o) $ putStrLn $ "ERR: ah (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ai_check :: IO () +ai_check = forM_ [(-21,1337), (-20,32), (-19,32), (-18,33), (-17,33), (-16,34), (-15,34), (-14,35), (-13,35), (-12,36), (-11,36), (-10,37), (-9,1337), (0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(I# i,o) -> do + let r = I# (ai i) + unless (r == o) $ putStrLn $ "ERR: ai (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +aj_check :: IO () +aj_check = forM_ [(-9223372036854775808,-4611686018427387862), (-9223372036854775807,1337), (-1,1337), (0,42), (1,1337), (9223372036854775806,1337), (9223372036854775807,4611686018427387945)] $ \(I# i,o) -> do + let r = I# (aj i) + unless (r == o) $ putStrLn $ "ERR: aj (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ak_check :: IO () +ak_check = forM_ [(9223372036854775796,1337), (9223372036854775797,4611686018427387940), (9223372036854775798,4611686018427387941), (9223372036854775799,4611686018427387941), (9223372036854775800,4611686018427387942), (9223372036854775801,4611686018427387942), (9223372036854775802,4611686018427387943), (9223372036854775803,4611686018427387943), (9223372036854775804,4611686018427387944), (9223372036854775805,4611686018427387944), (9223372036854775806,4611686018427387945), (9223372036854775807,4611686018427387945)] $ \(I# i,o) -> do + let r = I# (ak i) + unless (r == o) $ putStrLn $ "ERR: ak (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +al_check :: IO () +al_check = forM_ [(-9223372036854775808,-4611686018427387862), (-9223372036854775807,-4611686018427387862), (-9223372036854775806,-4611686018427387861), (-9223372036854775805,-4611686018427387861), (-9223372036854775804,-4611686018427387860), (-9223372036854775803,-4611686018427387860), (-9223372036854775802,-4611686018427387859), (-9223372036854775801,-4611686018427387859), (-9223372036854775800,-4611686018427387858), (-9223372036854775799,-4611686018427387858), (-9223372036854775798,-4611686018427387857), (-9223372036854775797,1337), (9223372036854775796,1337), (9223372036854775797,4611686018427387940), (9223372036854775798,4611686018427387941), (9223372036854775799,4611686018427387941), (9223372036854775800,4611686018427387942), (9223372036854775801,4611686018427387942), (9223372036854775802,4611686018427387943), (9223372036854775803,4611686018427387943), (9223372036854775804,4611686018427387944), (9223372036854775805,4611686018427387944), (9223372036854775806,4611686018427387945), (9223372036854775807,4611686018427387945)] $ \(I# i,o) -> do + let r = I# (al i) + unless (r == o) $ putStrLn $ "ERR: al (" ++ show (I# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +am_check :: IO () +am_check = forM_ [(0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(W# i,o) -> do + let r = W# (am i) + unless (r == o) $ putStrLn $ "ERR: am (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +an_check :: IO () +an_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337)] $ \(W# i,o) -> do + let r = W# (an i) + unless (r == o) $ putStrLn $ "ERR: an (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ao_check :: IO () +ao_check = forM_ [(0,42), (1,1337)] $ \(W# i,o) -> do + let r = W# (ao i) + unless (r == o) $ putStrLn $ "ERR: ao (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ap_check :: IO () +ap_check = forM_ [(0,42), (1,42), (2,1337)] $ \(W# i,o) -> do + let r = W# (ap i) + unless (r == o) $ putStrLn $ "ERR: ap (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +aq_check :: IO () +aq_check = forM_ [(0,42), (1,42), (2,43), (3,1337)] $ \(W# i,o) -> do + let r = W# (aq i) + unless (r == o) $ putStrLn $ "ERR: aq (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ar_check :: IO () +ar_check = forM_ [(0,42), (1,42), (2,43), (3,43), (4,1337)] $ \(W# i,o) -> do + let r = W# (ar i) + unless (r == o) $ putStrLn $ "ERR: ar (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +as_check :: IO () +as_check = forM_ [(0,42), (1,42), (2,43), (3,43), (4,44), (5,1337)] $ \(W# i,o) -> do + let r = W# (as i) + unless (r == o) $ putStrLn $ "ERR: as (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +at_check :: IO () +at_check = forM_ [(0,1337), (1,42), (2,1337)] $ \(W# i,o) -> do + let r = W# (at i) + unless (r == o) $ putStrLn $ "ERR: at (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +au_check :: IO () +au_check = forM_ [(0,1337), (1,42), (2,43), (3,1337)] $ \(W# i,o) -> do + let r = W# (au i) + unless (r == o) $ putStrLn $ "ERR: au (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +av_check :: IO () +av_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,1337)] $ \(W# i,o) -> do + let r = W# (av i) + unless (r == o) $ putStrLn $ "ERR: av (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +aw_check :: IO () +aw_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,1337)] $ \(W# i,o) -> do + let r = W# (aw i) + unless (r == o) $ putStrLn $ "ERR: aw (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ax_check :: IO () +ax_check = forM_ [(0,1337), (1,42), (2,43), (3,43), (4,44), (5,44), (6,1337)] $ \(W# i,o) -> do + let r = W# (ax i) + unless (r == o) $ putStrLn $ "ERR: ax (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ay_check :: IO () +ay_check = forM_ [(0,42), (1,1337), (18446744073709551614,1337), (18446744073709551615,9223372036854775849)] $ \(W# i,o) -> do + let r = W# (ay i) + unless (r == o) $ putStrLn $ "ERR: ay (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +az_check :: IO () +az_check = forM_ [(18446744073709551604,1337), (18446744073709551605,9223372036854775844), (18446744073709551606,9223372036854775845), (18446744073709551607,9223372036854775845), (18446744073709551608,9223372036854775846), (18446744073709551609,9223372036854775846), (18446744073709551610,9223372036854775847), (18446744073709551611,9223372036854775847), (18446744073709551612,9223372036854775848), (18446744073709551613,9223372036854775848), (18446744073709551614,9223372036854775849), (18446744073709551615,9223372036854775849)] $ \(W# i,o) -> do + let r = W# (az i) + unless (r == o) $ putStrLn $ "ERR: az (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +ba_check :: IO () +ba_check = forM_ [(0,42), (1,42), (2,43), (3,43), (4,44), (5,44), (6,45), (7,45), (8,46), (9,46), (10,47), (11,1337), (18446744073709551604,1337), (18446744073709551605,9223372036854775844), (18446744073709551606,9223372036854775845), (18446744073709551607,9223372036854775845), (18446744073709551608,9223372036854775846), (18446744073709551609,9223372036854775846), (18446744073709551610,9223372036854775847), (18446744073709551611,9223372036854775847), (18446744073709551612,9223372036854775848), (18446744073709551613,9223372036854775848), (18446744073709551614,9223372036854775849), (18446744073709551615,9223372036854775849)] $ \(W# i,o) -> do + let r = W# (ba i) + unless (r == o) $ putStrLn $ "ERR: ba (" ++ show (W# i)++ ") is " ++ show r ++ " and not " ++ show o ++"." + +main = do + aa_check + ab_check + ac_check + ad_check + ae_check + af_check + ag_check + ah_check + ai_check + aj_check + ak_check + al_check + am_check + an_check + ao_check + ap_check + aq_check + ar_check + as_check + at_check + au_check + av_check + aw_check + ax_check + ay_check + az_check + ba_check diff --git a/testsuite/tests/codeGen/should_run/CmmSwitchTestGen.hs b/testsuite/tests/codeGen/should_run/CmmSwitchTestGen.hs new file mode 100644 index 0000000000..61af0decac --- /dev/null +++ b/testsuite/tests/codeGen/should_run/CmmSwitchTestGen.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE TupleSections #-} + +-- Generates CmmSwitch.hs + +import qualified Data.Set as S +import Data.Word +import Data.List + +output :: Integer -> Integer +output n = n`div`2 + 42 + +def :: Integer +def = 1337 + +type Spec = (String, Bool, [Integer]) + +primtyp True = "Int#" +primtyp False = "Word#" + +con True = "I#" +con False = "W#" + +hash True = "#" +hash False = "##" + +primLit s v = show v ++ hash s + +genSwitch :: Spec -> String +genSwitch (name, signed, values) = unlines $ + [ "{-# NOINLINE " ++ name ++ " #-}" ] ++ + [ name ++ " :: " ++ primtyp signed ++ " -> " ++ primtyp signed ] ++ + [ name ++ " " ++ primLit signed v ++ " = " ++ primLit signed (output v) + | v <- values] ++ + [ name ++ " _ = " ++ primLit signed def ] + +genCheck :: Spec -> String +genCheck (name, signed, values) = unlines $ + [ checkName name ++ " :: IO ()" + , checkName name ++ " = forM_ [" ++ pairs ++ "] $ \\(" ++ con signed ++ " i,o) -> do" + , " let r = " ++ con signed ++ " (" ++ name ++ " i)" + , " unless (r == o) $ putStrLn $ \"ERR: " ++ name ++ " (\" ++ show (" ++ con signed ++ " i)++ \") is \" ++ show r ++ \" and not \" ++ show o ++\".\"" + ] + where + f x | x `S.member` range = output x + | otherwise = def + range = S.fromList values + checkValues = S.toList $ S.fromList $ + [ v' | v <- values, v' <- [v-1,v,v+1], + if signed then v' >= minS && v' <= maxS else v' >= minU && v' <= maxU ] + pairs = intercalate ", " ["(" ++ show v ++ "," ++ show (f v) ++ ")" | v <- checkValues ] + +checkName :: String -> String +checkName f = f ++ "_check" + +genMain :: [Spec] -> String +genMain specs = unlines $ "main = do" : [ " " ++ checkName n | (n,_,_) <- specs ] + +genMod :: [Spec] -> String +genMod specs = unlines $ + "-- This file is generated from CmmSwitchGen!" : + "{-# LANGUAGE MagicHash, NegativeLiterals #-}" : + "import Control.Monad (unless, forM_)" : + "import GHC.Exts" : + map genSwitch specs ++ + map genCheck specs ++ + [ genMain specs ] + +main = putStrLn $ + genMod $ zipWith (\n (s,v) -> (n,s,v)) names $ signedChecks ++ unsignedChecks + + +signedChecks :: [(Bool, [Integer])] +signedChecks = map (True,) + [ [1..10] + , [0..10] + , [1..3] + , [1..4] + , [1..5] + , [-1..10] + , [-10..10] + , [-20.. -10]++[0..10] + , [-20.. -10]++[1..10] + , [minS,0,maxS] + , [maxS-10 .. maxS] + , [minS..minS+10]++[maxS-10 .. maxS] + ] + +minU, maxU, minS, maxS :: Integer +minU = 0 +maxU = fromIntegral (maxBound :: Word) +minS = fromIntegral (minBound :: Int) +maxS = fromIntegral (maxBound :: Int) + + +unsignedChecks :: [(Bool, [Integer])] +unsignedChecks = map (False,) + [ [0..10] + , [1..10] + , [0] + , [0..1] + , [0..2] + , [0..3] + , [0..4] + , [1] + , [1..2] + , [1..3] + , [1..4] + , [1..5] + , [minU,maxU] + , [maxU-10 .. maxU] + , [minU..minU+10]++[maxU-10 .. maxU] + ] + +names :: [String] +names = [ c1:c2:[] | c1 <- ['a'..'z'], c2 <- ['a'..'z']] diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index d193834c6b..15c3476cc5 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -127,3 +127,4 @@ test('T9013', omit_ways(['ghci']), # ghci doesn't support unboxed tuples compile_and_run, ['']) test('T9340', normal, compile_and_run, ['']) test('cgrun074', normal, compile_and_run, ['']) +test('CmmSwitchTest', when(fast(), skip), compile_and_run, ['']) diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 4a6ab3e49f..2963834650 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -391,7 +391,7 @@ test('T783', # 2014-09-03: 223377364 (Windows) better specialisation, raft of core-to-core optimisations # 2014-12-22: 235002220 (Windows) not sure why - (wordsize(64), 441932632, 10)]), + (wordsize(64), 719814352, 10)]), # prev: 349263216 (amd64/Linux) # 07/08/2012: 384479856 (amd64/Linux) # 29/08/2012: 436927840 (amd64/Linux) @@ -406,6 +406,10 @@ test('T783', # (general round of updates) # 2014-08-29: 441932632 (amd64/Linux) # (better specialisation, raft of core-to-core optimisations) + # 2014-08-29: 719814352 (amd64/Linux) + # (changed order of cmm block causes analyses to allocate much more, + # but the changed order is slighly better in terms of runtime, and + # this test seems to be an extreme outlier.) extra_hc_opts('-static') ], compile,['']) |