diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index 92dd7abba5848ecf07d04279462d0e293e9e4856..606da02969a8d33e515876fb42b80efc724bb75f 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -18,7 +18,7 @@ import Hoopl.Label
 import BlockId
 import Cmm
 import CmmUtils
-import CmmSwitch (mapSwitchTargets)
+import CmmSwitch (mapSwitchTargets, switchTargetsToList)
 import Maybes
 import Panic
 import Util
@@ -295,6 +295,13 @@ blockConcat splitting_procs g@CmmGraph { g_entry = entry_id }
             , Just cond' <- maybeInvertCmmExpr cond
             = CmmCondBranch cond' f t (invertLikeliness l)
 
+            -- If all jump destinations of a switch go to the
+            -- same target eliminate the switch.
+            | CmmSwitch _expr targets <- shortcut_last
+            , (t:ts) <- switchTargetsToList targets
+            , all (== t) ts
+            = CmmBranch t
+
             | otherwise
             = shortcut_last
 
diff --git a/compiler/cmm/CmmImplementSwitchPlans.hs b/compiler/cmm/CmmImplementSwitchPlans.hs
index 2e2da5d3051e0868d539fd891c5bebb100080732..84ff007bef60007837a1f89efed2a4df6e432e5e 100644
--- a/compiler/cmm/CmmImplementSwitchPlans.hs
+++ b/compiler/cmm/CmmImplementSwitchPlans.hs
@@ -32,6 +32,7 @@ import DynFlags
 -- code generation.
 cmmImplementSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph
 cmmImplementSwitchPlans dflags g
+    -- Switch generation done by backend (LLVM/C)
     | targetSupportsSwitch (hscTarget dflags) = return g
     | otherwise = do
     blocks' <- concat `fmap` mapM (visitSwitches dflags) (toBlockList g)
@@ -39,19 +40,42 @@ cmmImplementSwitchPlans dflags g
 
 visitSwitches :: DynFlags -> CmmBlock -> UniqSM [CmmBlock]
 visitSwitches dflags block
-  | (entry@(CmmEntry _ scope), middle, CmmSwitch expr ids) <- blockSplit block
+  | (entry@(CmmEntry _ scope), middle, CmmSwitch vanillaExpr ids) <- blockSplit block
   = do
     let plan = createSwitchPlan ids
+    -- See Note [Floating switch expressions]
+    (assignSimple, simpleExpr) <- floatSwitchExpr dflags vanillaExpr
 
-    (newTail, newBlocks) <- implementSwitchPlan dflags scope expr plan
+    (newTail, newBlocks) <- implementSwitchPlan dflags scope simpleExpr plan
 
-    let block' = entry `blockJoinHead` middle `blockAppend` newTail
+    let block' = entry `blockJoinHead` middle `blockAppend` assignSimple `blockAppend` newTail
 
     return $ block' : newBlocks
 
   | otherwise
   = return [block]
 
+-- Note [Floating switch expressions]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+-- When we translate a sparse switch into a search tree we would like
+-- to compute the value we compare against only once.
+
+-- For this purpose we assign the switch expression to a local register
+-- and then use this register when constructing the actual binary tree.
+
+-- This is important as the expression could contain expensive code like
+-- memory loads or divisions which we REALLY don't want to duplicate.
+
+-- This happend in parts of the handwritten RTS Cmm code. See also #16933
+
+-- See Note [Floating switch expressions]
+floatSwitchExpr :: DynFlags -> CmmExpr -> UniqSM (Block CmmNode O O, CmmExpr)
+floatSwitchExpr _      reg@(CmmReg {})  = return (emptyBlock, reg)
+floatSwitchExpr dflags expr             = do
+  (assign, expr') <- cmmMkAssign dflags expr <$> getUniqueM
+  return (BMiddle assign, expr')
+
 
 -- Implementing a switch plan (returning a tail block)
 implementSwitchPlan :: DynFlags -> CmmTickScope -> CmmExpr -> SwitchPlan -> UniqSM (Block CmmNode O C, [CmmBlock])
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index 2f481c272a03f4b7deddfadaa06974d3ba7650c5..b8ae2b57ab732cd0f4f791924d388c1d703adf8a 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -75,6 +75,7 @@ cpsTop hsc_env proc =
        -- Any work storing block Labels must be performed _after_
        -- elimCommonBlocks
 
+       ----------- Implement switches ------------------------------------------
        g <- {-# SCC "createSwitchPlans" #-}
             runUniqSM $ cmmImplementSwitchPlans dflags g
        dump Opt_D_dump_cmm_switch "Post switch plan" g
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 8a3b857ed994dfceec6ce4a2216ad3ecc95ee307..c6e647f75efd9ad6718496d00ecc02101d8efdc5 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GADTs, RankNTypes #-}
+{-# LANGUAGE BangPatterns #-}
 
 -----------------------------------------------------------------------------
 --
@@ -35,6 +36,8 @@ module CmmUtils(
         cmmSubWord, cmmAddWord, cmmMulWord, cmmQuotWord,
         cmmToWord,
 
+        cmmMkAssign,
+
         isTrivialCmmExpr, hasNoGlobalRegs, isLit, isComparisonExpr,
 
         baseExpr, spExpr, hpExpr, spLimExpr, hpLimExpr,
@@ -76,6 +79,7 @@ import BlockId
 import CLabel
 import Outputable
 import DynFlags
+import Unique
 import CodeGen.Platform
 
 import Data.ByteString (ByteString)
@@ -372,6 +376,13 @@ cmmToWord dflags e
     w = cmmExprWidth dflags e
     word = wordWidth dflags
 
+cmmMkAssign :: DynFlags -> CmmExpr -> Unique -> (CmmNode O O, CmmExpr)
+cmmMkAssign dflags expr uq =
+  let !ty = cmmExprType dflags expr
+      reg = (CmmLocal (LocalReg uq ty))
+  in  (CmmAssign reg expr, CmmReg reg)
+
+
 ---------------------------------------------------
 --
 --      CmmExpr predicates