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

1 files changed, 8 insertions, 6 deletions

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)