diff --git a/GHC/ByteCode/Instr.hs b/GHC/ByteCode/Instr.hs
--- a/GHC/ByteCode/Instr.hs
+++ b/GHC/ByteCode/Instr.hs
@@ -82,7 +82,7 @@
    | PUSH16_W !Word16
    | PUSH32_W !Word16
 
-   -- Push a ptr  (these all map to PUSH_G really)
+   -- Push a (heap) ptr  (these all map to PUSH_G really)
    | PUSH_G       Name
    | PUSH_PRIMOP  PrimOp
    | PUSH_BCO     (ProtoBCO Name)
diff --git a/GHC/Cmm/Lexer.hs b/GHC/Cmm/Lexer.hs
--- a/GHC/Cmm/Lexer.hs
+++ b/GHC/Cmm/Lexer.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE MagicHash #-}
-{-# LINE 13 "_build/source-dist/ghc-9.6.5-src/ghc-9.6.5/compiler/GHC/Cmm/Lexer.x" #-}
+{-# LINE 13 "_build/source-dist/ghc-9.6.6-src/ghc-9.6.6/compiler/GHC/Cmm/Lexer.x" #-}
 module GHC.Cmm.Lexer (
    CmmToken(..), cmmlex,
   ) where
@@ -385,7 +385,7 @@
   , (0,alex_action_20)
   ]
 
-{-# LINE 133 "_build/source-dist/ghc-9.6.5-src/ghc-9.6.5/compiler/GHC/Cmm/Lexer.x" #-}
+{-# LINE 133 "_build/source-dist/ghc-9.6.6-src/ghc-9.6.6/compiler/GHC/Cmm/Lexer.x" #-}
 data CmmToken
   = CmmT_SpecChar  Char
   | CmmT_DotDot
diff --git a/GHC/CmmToAsm/AArch64.hs b/GHC/CmmToAsm/AArch64.hs
--- a/GHC/CmmToAsm/AArch64.hs
+++ b/GHC/CmmToAsm/AArch64.hs
@@ -47,6 +47,7 @@
         patchRegsOfInstr        = AArch64.patchRegsOfInstr
         isJumpishInstr          = AArch64.isJumpishInstr
         jumpDestsOfInstr        = AArch64.jumpDestsOfInstr
+        canFallthroughTo        = AArch64.canFallthroughTo
         patchJumpInstr          = AArch64.patchJumpInstr
         mkSpillInstr            = AArch64.mkSpillInstr
         mkLoadInstr             = AArch64.mkLoadInstr
diff --git a/GHC/CmmToAsm/AArch64/Instr.hs b/GHC/CmmToAsm/AArch64/Instr.hs
--- a/GHC/CmmToAsm/AArch64/Instr.hs
+++ b/GHC/CmmToAsm/AArch64/Instr.hs
@@ -324,6 +324,12 @@
 jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]]
 jumpDestsOfInstr _ = []
 
+canFallthroughTo :: Instr -> BlockId -> Bool
+canFallthroughTo (ANN _ i) bid = canFallthroughTo i bid
+canFallthroughTo (J (TBlock target)) bid = bid == target
+canFallthroughTo (B (TBlock target)) bid = bid == target
+canFallthroughTo _ _ = False
+
 -- | Change the destination of this jump instruction.
 -- Used in the linear allocator when adding fixup blocks for join
 -- points.
diff --git a/GHC/CmmToAsm/BlockLayout.hs b/GHC/CmmToAsm/BlockLayout.hs
--- a/GHC/CmmToAsm/BlockLayout.hs
+++ b/GHC/CmmToAsm/BlockLayout.hs
@@ -777,10 +777,9 @@
 dropJumps _    [] = []
 dropJumps info (BasicBlock lbl ins:todo)
     | Just ins <- nonEmpty ins --This can happen because of shortcutting
-    , [dest] <- jumpDestsOfInstr (NE.last ins)
     , BasicBlock nextLbl _ : _ <- todo
-    , not (mapMember dest info)
-    , nextLbl == dest
+    , canFallthroughTo (NE.last ins) nextLbl
+    , not (mapMember nextLbl info)
     = BasicBlock lbl (NE.init ins) : dropJumps info todo
     | otherwise
     = BasicBlock lbl ins : dropJumps info todo
diff --git a/GHC/CmmToAsm/Instr.hs b/GHC/CmmToAsm/Instr.hs
--- a/GHC/CmmToAsm/Instr.hs
+++ b/GHC/CmmToAsm/Instr.hs
@@ -71,10 +71,16 @@
                 :: instr -> Bool
 
 
-        -- | Give the possible destinations of this jump instruction.
+        -- | Give the possible *local block* destinations of this jump instruction.
         --      Must be defined for all jumpish instructions.
         jumpDestsOfInstr
                 :: instr -> [BlockId]
+
+        -- | Check if the instr always transfers control flow
+        -- to the given block. Used by code layout to eliminate
+        -- jumps that can be replaced by fall through.
+        canFallthroughTo
+                :: instr -> BlockId -> Bool
 
 
         -- | Change the destination of this jump instruction.
diff --git a/GHC/CmmToAsm/Monad.hs b/GHC/CmmToAsm/Monad.hs
--- a/GHC/CmmToAsm/Monad.hs
+++ b/GHC/CmmToAsm/Monad.hs
@@ -79,8 +79,15 @@
     cmmTopCodeGen             :: RawCmmDecl -> NatM [NatCmmDecl statics instr],
     generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr),
     getJumpDestBlockId        :: jumpDest -> Maybe BlockId,
+    -- | Does this jump always jump to a single destination and is shortcutable?
+    --
+    -- We use this to determine shortcutable instructions - See Note [What is shortcutting]
+    -- Note that if we return a destination here we *most* support the relevant shortcutting in
+    -- shortcutStatics for jump tables and shortcutJump for the instructions itself.
     canShortcut               :: instr -> Maybe jumpDest,
+    -- | Replace references to blockIds with other destinations - used to update jump tables.
     shortcutStatics           :: (BlockId -> Maybe jumpDest) -> statics -> statics,
+    -- | Change the jump destination(s) of an instruction.
     shortcutJump              :: (BlockId -> Maybe jumpDest) -> instr -> instr,
     -- | 'Module' is only for printing internal labels. See Note [Internal proc
     -- labels] in CLabel.
@@ -105,6 +112,25 @@
     -- ^ Turn the sequence of @jcc l1; jmp l2@ into @jncc l2; \<block_l1>@
     -- when possible.
     }
+
+{- Note [supporting shortcutting]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For the concept of shortcutting see Note [What is shortcutting].
+
+In order to support shortcutting across multiple backends uniformly we
+use canShortcut, shortcutStatics and shortcutJump.
+
+canShortcut tells us if the backend support shortcutting of a instruction
+and if so what destination we should retarget instruction to instead.
+
+shortcutStatics exists to allow us to update jump destinations in jump tables.
+
+shortcutJump updates the instructions itself.
+
+A backend can opt out of those by always returning Nothing for canShortcut
+and implementing shortcutStatics/shortcutJump as \_ x -> x
+
+-}
 
 {- Note [pprNatCmmDeclS and pprNatCmmDeclH]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/GHC/CmmToAsm/PPC.hs b/GHC/CmmToAsm/PPC.hs
--- a/GHC/CmmToAsm/PPC.hs
+++ b/GHC/CmmToAsm/PPC.hs
@@ -46,6 +46,7 @@
    patchRegsOfInstr    = PPC.patchRegsOfInstr
    isJumpishInstr      = PPC.isJumpishInstr
    jumpDestsOfInstr    = PPC.jumpDestsOfInstr
+   canFallthroughTo    = PPC.canFallthroughTo
    patchJumpInstr      = PPC.patchJumpInstr
    mkSpillInstr        = PPC.mkSpillInstr
    mkLoadInstr         = PPC.mkLoadInstr
diff --git a/GHC/CmmToAsm/PPC/CodeGen.hs b/GHC/CmmToAsm/PPC/CodeGen.hs
--- a/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -1752,7 +1752,7 @@
                                 _ -> panic "genCall': unknown calling conv."
 
         argReps = map (cmmExprType platform) args
-        (argHints, _) = foreignTargetHints target
+        (_, argHints) = foreignTargetHints target
 
         roundTo a x | x `mod` a == 0 = x
                     | otherwise = x + a - (x `mod` a)
diff --git a/GHC/CmmToAsm/PPC/Instr.hs b/GHC/CmmToAsm/PPC/Instr.hs
--- a/GHC/CmmToAsm/PPC/Instr.hs
+++ b/GHC/CmmToAsm/PPC/Instr.hs
@@ -22,6 +22,7 @@
    , patchJumpInstr
    , patchRegsOfInstr
    , jumpDestsOfInstr
+   , canFallthroughTo
    , takeRegRegMoveInstr
    , takeDeltaInstr
    , mkRegRegMoveInstr
@@ -498,6 +499,13 @@
     BL{}        -> True
     JMP{}       -> True
     _           -> False
+
+canFallthroughTo :: Instr -> BlockId -> Bool
+canFallthroughTo instr bid
+ = case instr of
+        BCC _ target _      -> target == bid
+        BCCFAR _ target _   -> target == bid
+        _                   -> False
 
 
 -- | Checks whether this instruction is a jump/branch instruction.
diff --git a/GHC/CmmToAsm/Reg/Liveness.hs b/GHC/CmmToAsm/Reg/Liveness.hs
--- a/GHC/CmmToAsm/Reg/Liveness.hs
+++ b/GHC/CmmToAsm/Reg/Liveness.hs
@@ -133,6 +133,11 @@
                 Instr instr     -> isJumpishInstr instr
                 _               -> False
 
+        canFallthroughTo i bid
+         = case i of
+                Instr instr     -> canFallthroughTo instr bid
+                _               -> False
+
         jumpDestsOfInstr i
          = case i of
                 Instr instr     -> jumpDestsOfInstr instr
diff --git a/GHC/CmmToAsm/X86.hs b/GHC/CmmToAsm/X86.hs
--- a/GHC/CmmToAsm/X86.hs
+++ b/GHC/CmmToAsm/X86.hs
@@ -51,6 +51,7 @@
    patchRegsOfInstr        = X86.patchRegsOfInstr
    isJumpishInstr          = X86.isJumpishInstr
    jumpDestsOfInstr        = X86.jumpDestsOfInstr
+   canFallthroughTo        = X86.canFallthroughTo
    patchJumpInstr          = X86.patchJumpInstr
    mkSpillInstr            = X86.mkSpillInstr
    mkLoadInstr             = X86.mkLoadInstr
diff --git a/GHC/CmmToAsm/X86/Instr.hs b/GHC/CmmToAsm/X86/Instr.hs
--- a/GHC/CmmToAsm/X86/Instr.hs
+++ b/GHC/CmmToAsm/X86/Instr.hs
@@ -30,6 +30,7 @@
    , mkSpillInstr
    , mkRegRegMoveInstr
    , jumpDestsOfInstr
+   , canFallthroughTo
    , patchRegsOfInstr
    , patchJumpInstr
    , isMetaInstr
@@ -642,6 +643,17 @@
         CALL{}          -> True
         _               -> False
 
+canFallthroughTo :: Instr -> BlockId -> Bool
+canFallthroughTo insn bid
+  = case insn of
+    JXX _ target          -> bid == target
+    JMP_TBL _ targets _ _ -> all isTargetBid targets
+    _                     -> False
+  where
+    isTargetBid target = case target of
+      Nothing                      -> True
+      Just (DestBlockId target) -> target == bid
+      _                  -> False
 
 jumpDestsOfInstr
         :: Instr
diff --git a/GHC/Core/Utils.hs b/GHC/Core/Utils.hs
--- a/GHC/Core/Utils.hs
+++ b/GHC/Core/Utils.hs
@@ -23,9 +23,9 @@
         -- * Properties of expressions
         exprType, coreAltType, coreAltsType, mkLamType, mkLamTypes,
         mkFunctionType,
-        exprIsDupable, exprIsTrivial, getIdFromTrivialExpr,
-        getIdFromTrivialExpr_maybe,
-        exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
+        exprIsTrivial, getIdFromTrivialExpr, getIdFromTrivialExpr_maybe,
+        trivial_expr_fold,
+        exprIsDupable, exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
         exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprOkForSpecEval,
         exprIsWorkFree, exprIsConLike,
         isCheapApp, isExpandableApp, isSaturatedConApp,
@@ -1047,20 +1047,37 @@
 it off at source.
 -}
 
+{-# INLINE trivial_expr_fold #-}
+trivial_expr_fold :: (Id -> r) -> (Literal -> r) -> r -> r -> CoreExpr -> r
+-- ^ The worker function for Note [exprIsTrivial] and Note [getIdFromTrivialExpr]
+-- This is meant to have the code of both functions in one place and make it
+-- easy to derive custom predicates.
+--
+-- (trivial_expr_fold k_id k_triv k_not_triv e)
+-- * returns (k_id x) if `e` is a variable `x` (with trivial wrapping)
+-- * returns (k_lit x) if `e` is a trivial literal `l` (with trivial wrapping)
+-- * returns k_triv if `e` is a literal, type, or coercion (with trivial wrapping)
+-- * returns k_not_triv otherwise
+--
+-- where "trivial wrapping" is
+-- * Type application or abstraction
+-- * Ticks other than `tickishIsCode`
+-- * `case e of {}` an empty case
+trivial_expr_fold k_id k_lit k_triv k_not_triv = go
+  where
+    go (Var v)                            = k_id v  -- See Note [Variables are trivial]
+    go (Lit l)    | litIsTrivial l        = k_lit l
+    go (Type _)                           = k_triv
+    go (Coercion _)                       = k_triv
+    go (App f t)  | not (isRuntimeArg t)  = go f
+    go (Lam b e)  | not (isRuntimeVar b)  = go e
+    go (Tick t e) | not (tickishIsCode t) = go e              -- See Note [Tick trivial]
+    go (Cast e _)                         = go e
+    go (Case e _ _ [])                    = go e              -- See Note [Empty case is trivial]
+    go _                                  = k_not_triv
+
 exprIsTrivial :: CoreExpr -> Bool
--- If you modify this function, you may also
--- need to modify getIdFromTrivialExpr
-exprIsTrivial (Var _)          = True        -- See Note [Variables are trivial]
-exprIsTrivial (Type _)         = True
-exprIsTrivial (Coercion _)     = True
-exprIsTrivial (Lit lit)        = litIsTrivial lit
-exprIsTrivial (App e arg)      = not (isRuntimeArg arg) && exprIsTrivial e
-exprIsTrivial (Lam b e)        = not (isRuntimeVar b) && exprIsTrivial e
-exprIsTrivial (Tick t e)       = not (tickishIsCode t) && exprIsTrivial e
-                                 -- See Note [Tick trivial]
-exprIsTrivial (Cast e _)       = exprIsTrivial e
-exprIsTrivial (Case e _ _ [])  = exprIsTrivial e  -- See Note [Empty case is trivial]
-exprIsTrivial _                = False
+exprIsTrivial e = trivial_expr_fold (const True) (const True) True False e
 
 {-
 Note [getIdFromTrivialExpr]
@@ -1080,24 +1097,13 @@
 -}
 
 getIdFromTrivialExpr :: HasDebugCallStack => CoreExpr -> Id
-getIdFromTrivialExpr e
-    = fromMaybe (pprPanic "getIdFromTrivialExpr" (ppr e))
-                (getIdFromTrivialExpr_maybe e)
-
-getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
 -- See Note [getIdFromTrivialExpr]
--- Th equations for this should line up with those for exprIsTrivial
-getIdFromTrivialExpr_maybe e
-  = go e
+getIdFromTrivialExpr e = trivial_expr_fold id (const panic) panic panic e
   where
-    go (App f t) | not (isRuntimeArg t)   = go f
-    go (Tick t e) | not (tickishIsCode t) = go e
-    go (Cast e _)                         = go e
-    go (Lam b e) | not (isRuntimeVar b)   = go e
-    go (Case e _ _ [])                    = go e
-    go (Var v) = Just v
-    go _       = Nothing
+    panic = pprPanic "getIdFromTrivialExpr" (ppr e)
 
+getIdFromTrivialExpr_maybe :: CoreExpr -> Maybe Id
+getIdFromTrivialExpr_maybe e = trivial_expr_fold Just (const Nothing) Nothing Nothing e
 
 {- *********************************************************************
 *                                                                      *
diff --git a/GHC/CoreToStg.hs b/GHC/CoreToStg.hs
--- a/GHC/CoreToStg.hs
+++ b/GHC/CoreToStg.hs
@@ -19,8 +19,7 @@
 import GHC.Prelude
 
 import GHC.Core
-import GHC.Core.Utils   ( exprType, findDefault, isJoinBind
-                        , exprIsTickedString_maybe )
+import GHC.Core.Utils
 import GHC.Core.Opt.Arity   ( manifestArity )
 import GHC.Core.Type
 import GHC.Core.TyCon
@@ -49,7 +48,7 @@
 import GHC.Data.FastString
 import GHC.Platform        ( Platform )
 import GHC.Platform.Ways
-import GHC.Builtin.PrimOps ( PrimCall(..), primOpWrapperId )
+import GHC.Builtin.PrimOps
 
 import GHC.Utils.Outputable
 import GHC.Utils.Monad
@@ -574,6 +573,19 @@
 -- This is the guy that turns applications into A-normal form
 -- ---------------------------------------------------------------------------
 
+getStgArgFromTrivialArg :: HasDebugCallStack => CoreArg -> StgArg
+-- A (non-erased) trivial CoreArg corresponds to an atomic StgArg.
+-- CoreArgs may not immediately look trivial, e.g., `case e of {}` or
+-- `case unsafeequalityProof of UnsafeRefl -> e` might intervene.
+-- Good thing we can just call `trivial_expr_fold` here.
+getStgArgFromTrivialArg e
+  | Just s <- exprIsTickedString_maybe e -- This case is just for backport to GHC 9.8,
+  = StgLitArg (LitString s)              -- where we used to treat strings as valid StgArgs
+  | otherwise
+  = trivial_expr_fold StgVarArg StgLitArg panic panic e
+  where
+    panic = pprPanic "getStgArgFromTrivialArg" (ppr e)
+
 coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [StgTickish])
 coreToStgArgs []
   = return ([], [])
@@ -586,42 +598,29 @@
   = do { (args', ts) <- coreToStgArgs args
        ; return (StgVarArg coercionTokenId : args', ts) }
 
-coreToStgArgs (Tick t e : args)
-  = assert (not (tickishIsCode t)) $
-    do { (args', ts) <- coreToStgArgs (e : args)
-       ; let !t' = coreToStgTick (exprType e) t
-       ; return (args', t':ts) }
-
 coreToStgArgs (arg : args) = do         -- Non-type argument
     (stg_args, ticks) <- coreToStgArgs args
-    arg' <- coreToStgExpr arg
-    let
-        (aticks, arg'') = stripStgTicksTop tickishFloatable arg'
-        stg_arg = case arg'' of
-           StgApp v []                  -> StgVarArg v
-           StgConApp con _ [] _         -> StgVarArg (dataConWorkId con)
-           StgOpApp (StgPrimOp op) [] _ -> StgVarArg (primOpWrapperId op)
-           StgLit lit                   -> StgLitArg lit
-           _ -> pprPanic "coreToStgArgs" (ppr arg $$ pprStgExpr panicStgPprOpts arg' $$ pprStgExpr panicStgPprOpts arg'')
-
-        -- WARNING: what if we have an argument like (v `cast` co)
-        --          where 'co' changes the representation type?
-        --          (This really only happens if co is unsafe.)
-        -- Then all the getArgAmode stuff in CgBindery will set the
-        -- cg_rep of the CgIdInfo based on the type of v, rather
-        -- than the type of 'co'.
-        -- This matters particularly when the function is a primop
-        -- or foreign call.
-        -- Wanted: a better solution than this hacky warning
-
+    -- We know that `arg` must be trivial, but it may contain Ticks.
+    -- Example from test case `decodeMyStack`:
+    --   $ @... ((src<decodeMyStack.hs:18:26-28> Data.Tuple.snd) @Int @[..])
+    -- Note that unfortunately the Tick is not at the top.
+    -- So we'll traverse the expression twice:
+    --   * Once with `stripTicksT` (which collects *all* ticks from the expression)
+    --   * and another time with `getStgArgFromTrivialArg`.
+    -- Since the argument is trivial, the only place the Tick can occur is
+    -- somehow wrapping a variable (give or take type args, as above).
     platform <- getPlatform
-    let
-        arg_rep = typePrimRep (exprType arg)
-        stg_arg_rep = typePrimRep (stgArgType stg_arg)
+    let arg_ty = exprType arg
+        ticks' = map (coreToStgTick arg_ty) (stripTicksT (not . tickishIsCode) arg)
+        arg' = getStgArgFromTrivialArg arg
+        arg_rep = typePrimRep arg_ty
+        stg_arg_rep = typePrimRep (stgArgType arg')
         bad_args = not (primRepsCompatible platform arg_rep stg_arg_rep)
 
-    warnPprTrace bad_args "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" (ppr arg) $
-     return (stg_arg : stg_args, ticks ++ aticks)
+    massertPpr (length ticks' <= 1) (text "More than one Tick in trivial arg:" <+> ppr arg)
+    warnPprTrace bad_args "Dangerous-looking argument. Probable cause: bad unsafeCoerce#" (ppr arg) (return ())
+
+    return (arg' : stg_args, ticks' ++ ticks)
 
 coreToStgTick :: Type -- type of the ticked expression
               -> CoreTickish
diff --git a/GHC/Driver/Make.hs b/GHC/Driver/Make.hs
--- a/GHC/Driver/Make.hs
+++ b/GHC/Driver/Make.hs
@@ -149,6 +149,7 @@
 import GHC.Rename.Names
 import GHC.Utils.Constants
 import GHC.Types.Unique.DFM (udfmRestrictKeysSet)
+import GHC.Types.Unique.Map
 import qualified Data.IntSet as I
 import GHC.Types.Unique
 
@@ -307,16 +308,16 @@
 
 -- Note [Missing home modules]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- Sometimes user doesn't want GHC to pick up modules, not explicitly listed
--- in a command line. For example, cabal may want to enable this warning
--- when building a library, so that GHC warns user about modules, not listed
--- neither in `exposed-modules`, nor in `other-modules`.
+-- Sometimes we don't want GHC to process modules that weren't specified as
+-- explicit targets. For example, cabal may want to enable this warning
+-- when building a library, so that GHC warns the user about modules listed
+-- neither in `exposed-modules` nor in `other-modules`.
 --
--- Here "home module" means a module, that doesn't come from an other package.
+-- Here "home module" means a module that doesn't come from another package.
 --
 -- For example, if GHC is invoked with modules "A" and "B" as targets,
 -- but "A" imports some other module "C", then GHC will issue a warning
--- about module "C" not being listed in a command line.
+-- about module "C" not being listed in the command line.
 --
 -- The warning in enabled by `-Wmissing-home-modules`. See #13129
 warnMissingHomeModules ::  DynFlags -> [Target] -> ModuleGraph -> DriverMessages
@@ -327,8 +328,6 @@
   where
     diag_opts = initDiagOpts dflags
 
-    is_known_module mod = any (is_my_target mod) targets
-
     -- We need to be careful to handle the case where (possibly
     -- path-qualified) filenames (aka 'TargetFile') rather than module
     -- names are being passed on the GHC command-line.
@@ -337,28 +336,30 @@
     -- `ghc --make -isrc-exe Main` are supposed to be equivalent.
     -- Note also that we can't always infer the associated module name
     -- directly from the filename argument.  See #13727.
-    is_my_target mod target =
-      let tuid = targetUnitId target
-      in case targetId target of
-          TargetModule name
-            -> moduleName (ms_mod mod) == name
-                && tuid == ms_unitid mod
-          TargetFile target_file _
-            | Just mod_file <- ml_hs_file (ms_location mod)
-            ->
-             augmentByWorkingDirectory dflags target_file == mod_file ||
+    is_known_module mod =
+      (Map.lookup (moduleName (ms_mod mod)) mod_targets == Just (ms_unitid mod))
+      ||
+      maybe False is_file_target (ml_hs_file (ms_location mod))
 
-             --  Don't warn on B.hs-boot if B.hs is specified (#16551)
-             addBootSuffix target_file == mod_file ||
+    is_file_target file = Set.member (withoutExt file) file_targets
 
-             --  We can get a file target even if a module name was
-             --  originally specified in a command line because it can
-             --  be converted in guessTarget (by appending .hs/.lhs).
-             --  So let's convert it back and compare with module name
-             mkModuleName (fst $ splitExtension target_file)
-              == moduleName (ms_mod mod)
-          _ -> False
+    file_targets = Set.fromList (mapMaybe file_target targets)
 
+    file_target Target {targetId} =
+      case targetId of
+        TargetModule _ -> Nothing
+        TargetFile file _ ->
+          Just (withoutExt (augmentByWorkingDirectory dflags file))
+
+    mod_targets = Map.fromList (mod_target <$> targets)
+
+    mod_target Target {targetUnitId, targetId} =
+      case targetId of
+        TargetModule name -> (name, targetUnitId)
+        TargetFile file _ -> (mkModuleName (withoutExt file), targetUnitId)
+
+    withoutExt = fst . splitExtension
+
     missing = map (moduleName . ms_mod) $
       filter (not . is_known_module) $
         (filter (\ms -> ms_unitid ms == homeUnitId_ dflags)
@@ -1544,8 +1545,8 @@
        let (root_errs, rootSummariesOk) = partitionEithers rootSummaries -- #17549
            root_map = mkRootMap rootSummariesOk
        checkDuplicates root_map
-       (deps, pkg_deps, map0) <- loopSummaries rootSummariesOk (M.empty, Set.empty, root_map)
-       let closure_errs = checkHomeUnitsClosed (hsc_unit_env hsc_env) (hsc_all_home_unit_ids hsc_env) (Set.toList pkg_deps)
+       (deps, map0) <- loopSummaries rootSummariesOk (M.empty, root_map)
+       let closure_errs = checkHomeUnitsClosed (hsc_unit_env hsc_env)
        let unit_env = hsc_unit_env hsc_env
        let tmpfs    = hsc_tmpfs    hsc_env
 
@@ -1639,19 +1640,19 @@
 
         -- This loops over all the mod summaries in the dependency graph, accumulates the actual dependencies for each module/unit
         loopSummaries :: [ModSummary]
-              -> (M.Map NodeKey ModuleGraphNode, Set.Set (UnitId, UnitId),
+              -> (M.Map NodeKey ModuleGraphNode,
                     DownsweepCache)
-              -> IO ((M.Map NodeKey ModuleGraphNode), Set.Set (UnitId, UnitId), DownsweepCache)
+              -> IO ((M.Map NodeKey ModuleGraphNode), DownsweepCache)
         loopSummaries [] done = return done
-        loopSummaries (ms:next) (done, pkgs, summarised)
+        loopSummaries (ms:next) (done, summarised)
           | Just {} <- M.lookup k done
-          = loopSummaries next (done, pkgs, summarised)
+          = loopSummaries next (done, summarised)
           -- Didn't work out what the imports mean yet, now do that.
           | otherwise = do
-             (final_deps, pkgs1, done', summarised') <- loopImports (calcDeps ms) done summarised
+             (final_deps, done', summarised') <- loopImports (calcDeps ms) done summarised
              -- This has the effect of finding a .hs file if we are looking at the .hs-boot file.
-             (_, _, done'', summarised'') <- loopImports (maybeToList hs_file_for_boot) done' summarised'
-             loopSummaries next (M.insert k (ModuleNode final_deps ms) done'', pkgs1 `Set.union` pkgs, summarised'')
+             (_, done'', summarised'') <- loopImports (maybeToList hs_file_for_boot) done' summarised'
+             loopSummaries next (M.insert k (ModuleNode final_deps ms) done'', summarised'')
           where
             k = NodeKey_Module (msKey ms)
 
@@ -1669,18 +1670,17 @@
                         -- Visited set; the range is a list because
                         -- the roots can have the same module names
                         -- if allow_dup_roots is True
-             -> IO ([NodeKey], Set.Set (UnitId, UnitId),
-
+             -> IO ([NodeKey],
                   M.Map NodeKey ModuleGraphNode, DownsweepCache)
                         -- The result is the completed NodeMap
-        loopImports [] done summarised = return ([], Set.empty, done, summarised)
+        loopImports [] done summarised = return ([], done, summarised)
         loopImports ((home_uid,mb_pkg, gwib) : ss) done summarised
           | Just summs <- M.lookup cache_key summarised
           = case summs of
               [Right ms] -> do
                 let nk = NodeKey_Module (msKey ms)
-                (rest, pkgs, summarised', done') <- loopImports ss done summarised
-                return (nk: rest, pkgs, summarised', done')
+                (rest, summarised', done') <- loopImports ss done summarised
+                return (nk: rest, summarised', done')
               [Left _err] ->
                 loopImports ss done summarised
               _errs ->  do
@@ -1692,69 +1692,79 @@
                                        Nothing excl_mods
                case mb_s of
                    NotThere -> loopImports ss done summarised
-                   External uid -> do
-                    (other_deps, pkgs, done', summarised') <- loopImports ss done summarised
-                    return (other_deps, Set.insert (homeUnitId home_unit, uid) pkgs, done', summarised')
+                   External _ -> do
+                    (other_deps, done', summarised') <- loopImports ss done summarised
+                    return (other_deps, done', summarised')
                    FoundInstantiation iud -> do
-                    (other_deps, pkgs, done', summarised') <- loopImports ss done summarised
-                    return (NodeKey_Unit iud : other_deps, pkgs, done', summarised')
+                    (other_deps, done', summarised') <- loopImports ss done summarised
+                    return (NodeKey_Unit iud : other_deps, done', summarised')
                    FoundHomeWithError (_uid, e) ->  loopImports ss done (Map.insert cache_key [(Left e)] summarised)
                    FoundHome s -> do
-                     (done', pkgs1, summarised') <-
-                       loopSummaries [s] (done, Set.empty, Map.insert cache_key [Right s] summarised)
-                     (other_deps, pkgs2, final_done, final_summarised) <- loopImports ss done' summarised'
+                     (done', summarised') <-
+                       loopSummaries [s] (done, Map.insert cache_key [Right s] summarised)
+                     (other_deps, final_done, final_summarised) <- loopImports ss done' summarised'
 
                      -- MP: This assumes that we can only instantiate non home units, which is probably fair enough for now.
-                     return (NodeKey_Module (msKey s) : other_deps, pkgs1 `Set.union` pkgs2, final_done, final_summarised)
+                     return (NodeKey_Module (msKey s) : other_deps, final_done, final_summarised)
           where
             cache_key = (home_uid, mb_pkg, unLoc <$> gwib)
             home_unit = ue_unitHomeUnit home_uid (hsc_unit_env hsc_env)
             GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
             wanted_mod = L loc mod
 
--- This function checks then important property that if both p and q are home units
+-- | This function checks then important property that if both p and q are home units
 -- then any dependency of p, which transitively depends on q is also a home unit.
-checkHomeUnitsClosed ::  UnitEnv -> Set.Set UnitId -> [(UnitId, UnitId)] -> [DriverMessages]
--- Fast path, trivially closed.
-checkHomeUnitsClosed ue home_id_set home_imp_ids
-  | Set.size home_id_set == 1 = []
-  | otherwise =
-  let res = foldMap loop home_imp_ids
-  -- Now check whether everything which transitively depends on a home_unit is actually a home_unit
-  -- These units are the ones which we need to load as home packages but failed to do for some reason,
-  -- it's a bug in the tool invoking GHC.
-      bad_unit_ids = Set.difference res home_id_set
-  in if Set.null bad_unit_ids
-        then []
-        else [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)]
-
+--
+-- See Note [Multiple Home Units], section 'Closure Property'.
+checkHomeUnitsClosed ::  UnitEnv -> [DriverMessages]
+checkHomeUnitsClosed ue
+    | Set.null bad_unit_ids = []
+    | otherwise = [singleMessage $ mkPlainErrorMsgEnvelope rootLoc $ DriverHomePackagesNotClosed (Set.toList bad_unit_ids)]
   where
+    home_id_set = unitEnv_keys $ ue_home_unit_graph ue
+    bad_unit_ids = upwards_closure Set.\\ home_id_set
     rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
-    -- TODO: This could repeat quite a bit of work but I struggled to write this function.
-    -- Which units transitively depend on a home unit
-    loop :: (UnitId, UnitId) -> Set.Set UnitId -- The units which transitively depend on a home unit
-    loop (from_uid, uid) =
-      let us = ue_findHomeUnitEnv from_uid ue in
-      let um = unitInfoMap (homeUnitEnv_units us) in
-      case Map.lookup uid um of
-        Nothing -> pprPanic "uid not found" (ppr uid)
-        Just ui ->
-          let depends = unitDepends ui
-              home_depends = Set.fromList depends `Set.intersection` home_id_set
-              other_depends = Set.fromList depends `Set.difference` home_id_set
-          in
-            -- Case 1: The unit directly depends on a home_id
-            if not (null home_depends)
-              then
-                let res = foldMap (loop . (from_uid,)) other_depends
-                in Set.insert uid res
-             -- Case 2: Check the rest of the dependencies, and then see if any of them depended on
-              else
-                let res = foldMap (loop . (from_uid,)) other_depends
-                in
-                  if not (Set.null res)
-                    then Set.insert uid res
-                    else res
+
+    graph :: Graph (Node UnitId UnitId)
+    graph = graphFromEdgedVerticesUniq graphNodes
+
+    -- downwards closure of graph
+    downwards_closure
+      = graphFromEdgedVerticesUniq [ DigraphNode uid uid (Set.toList deps)
+                                   | (uid, deps) <- M.toList (allReachable graph node_key)]
+
+    inverse_closure = transposeG downwards_closure
+
+    upwards_closure = Set.fromList $ map node_key $ reachablesG inverse_closure [DigraphNode uid uid [] | uid <- Set.toList home_id_set]
+
+    all_unit_direct_deps :: UniqMap UnitId (Set.Set UnitId)
+    all_unit_direct_deps
+      = unitEnv_foldWithKey go emptyUniqMap $ ue_home_unit_graph ue
+      where
+        go rest this this_uis =
+           plusUniqMap_C Set.union
+             (addToUniqMap_C Set.union external_depends this (Set.fromList $ this_deps))
+             rest
+           where
+             external_depends = mapUniqMap (Set.fromList . unitDepends)
+                              $ listToUniqMap $ Map.toList
+                              $ unitInfoMap this_units
+             this_units = homeUnitEnv_units this_uis
+             this_deps = [ toUnitId unit | (unit,Just _) <- explicitUnits this_units]
+
+    graphNodes :: [Node UnitId UnitId]
+    graphNodes = go Set.empty home_id_set
+      where
+        go done todo
+          = case Set.minView todo of
+              Nothing -> []
+              Just (uid, todo')
+                | Set.member uid done -> go done todo'
+                | otherwise -> case lookupUniqMap all_unit_direct_deps uid of
+                    Nothing -> pprPanic "uid not found" (ppr (uid, all_unit_direct_deps))
+                    Just depends ->
+                      let todo'' = (depends Set.\\ done) `Set.union` todo'
+                      in DigraphNode uid uid (Set.toList depends) : go (Set.insert uid done) todo''
 
 -- | Update the every ModSummary that is depended on
 -- by a module that needs template haskell. We enable codegen to
diff --git a/GHC/Driver/Pipeline/Execute.hs b/GHC/Driver/Pipeline/Execute.hs
--- a/GHC/Driver/Pipeline/Execute.hs
+++ b/GHC/Driver/Pipeline/Execute.hs
@@ -1094,14 +1094,18 @@
 The command used for object linking is set using the -pgmlm and -optlm
 command-line options.
 
-Sadly, the LLD linker that we use on Windows does not support the `-r` flag
-needed to support object merging (see #21068). For this reason on Windows we do
-not support GHCi objects.  To deal with foreign stubs we build a static archive
-of all of a module's object files instead merging them. Consequently, we can
-end up producing `.o` files which are in fact static archives. However,
-toolchains generally don't have a problem with this as they use file headers,
-not the filename, to determine the nature of inputs.
+However, `ld -r` is broken in some cases:
 
+ * The LLD linker that we use on Windows does not support the `-r`
+   flag needed to support object merging (see #21068). For this reason
+   on Windows we do not support GHCi objects.
+
+In these cases, we bundle a module's own object file with its foreign
+stub's object file, instead of merging them. Consequently, we can end
+up producing `.o` files which are in fact static archives. This can
+only work if `ar -L` is supported, so the archive `.o` files can be
+properly added to the final static library.
+
 Note that this has somewhat non-obvious consequences when producing
 initializers and finalizers. See Note [Initializers and finalizers in Cmm]
 in GHC.Cmm.InitFini for details.
@@ -1126,7 +1130,7 @@
 -- | See Note [Object merging].
 joinObjectFiles :: HscEnv -> [FilePath] -> FilePath -> IO ()
 joinObjectFiles hsc_env o_files output_fn
-  | can_merge_objs && not dashLSupported = do
+  | can_merge_objs = do
   let toolSettings' = toolSettings dflags
       ldIsGnuLd = toolSettings_ldIsGnuLd toolSettings'
       ld_r args = GHC.SysTools.runMergeObjects (hsc_logger hsc_env) (hsc_tmpfs hsc_env) (hsc_dflags hsc_env) (
diff --git a/GHC/Parser/HaddockLex.hs b/GHC/Parser/HaddockLex.hs
--- a/GHC/Parser/HaddockLex.hs
+++ b/GHC/Parser/HaddockLex.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE MagicHash #-}
-{-# LINE 1 "_build/source-dist/ghc-9.6.5-src/ghc-9.6.5/compiler/GHC/Parser/HaddockLex.x" #-}
+{-# LINE 1 "_build/source-dist/ghc-9.6.6-src/ghc-9.6.6/compiler/GHC/Parser/HaddockLex.x" #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
@@ -110,7 +110,7 @@
   , (0,alex_action_1)
   ]
 
-{-# LINE 87 "_build/source-dist/ghc-9.6.5-src/ghc-9.6.5/compiler/GHC/Parser/HaddockLex.x" #-}
+{-# LINE 87 "_build/source-dist/ghc-9.6.6-src/ghc-9.6.6/compiler/GHC/Parser/HaddockLex.x" #-}
 data AlexInput = AlexInput
   { alexInput_position     :: !RealSrcLoc
   , alexInput_string       :: !ByteString
diff --git a/GHC/Parser/Lexer.hs b/GHC/Parser/Lexer.hs
--- a/GHC/Parser/Lexer.hs
+++ b/GHC/Parser/Lexer.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-missing-signatures #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE MagicHash #-}
-{-# LINE 43 "_build/source-dist/ghc-9.6.5-src/ghc-9.6.5/compiler/GHC/Parser/Lexer.x" #-}
+{-# LINE 43 "_build/source-dist/ghc-9.6.6-src/ghc-9.6.6/compiler/GHC/Parser/Lexer.x" #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
@@ -592,7 +592,7 @@
   , (0,alex_action_86)
   ]
 
-{-# LINE 704 "_build/source-dist/ghc-9.6.5-src/ghc-9.6.5/compiler/GHC/Parser/Lexer.x" #-}
+{-# LINE 704 "_build/source-dist/ghc-9.6.6-src/ghc-9.6.6/compiler/GHC/Parser/Lexer.x" #-}
 -- Operator whitespace occurrence. See Note [Whitespace-sensitive operator parsing].
 data OpWs
   = OpWsPrefix         -- a !b
diff --git a/GHC/StgToCmm/Prim.hs b/GHC/StgToCmm/Prim.hs
--- a/GHC/StgToCmm/Prim.hs
+++ b/GHC/StgToCmm/Prim.hs
@@ -2026,8 +2026,8 @@
                    -> CmmType  -- ^ index type
                    -> AlignmentSpec
 alignmentFromTypes ty idx_ty
-  | typeWidth ty < typeWidth idx_ty = NaturallyAligned
-  | otherwise                       = Unaligned
+  | typeWidth ty <= typeWidth idx_ty = NaturallyAligned
+  | otherwise                        = Unaligned
 
 doIndexOffAddrOp :: Maybe MachOp
                  -> CmmType
diff --git a/GHC/ThToHs.hs b/GHC/ThToHs.hs
--- a/GHC/ThToHs.hs
+++ b/GHC/ThToHs.hs
@@ -1442,7 +1442,8 @@
                             ; return
                                    $ ListPat noAnn ps'}
 cvtp (SigP p t)        = do { p' <- cvtPat p; t' <- cvtType t
-                            ; return $ SigPat noAnn p' (mkHsPatSigType noAnn t') }
+                            ; let pp = parenthesizePat sigPrec p'
+                            ; return $ SigPat noAnn pp (mkHsPatSigType noAnn t') }
 cvtp (ViewP e p)       = do { e' <- cvtl e; p' <- cvtPat p
                             ; return $ ViewPat noAnn e' p'}
 
diff --git a/ghc.cabal b/ghc.cabal
--- a/ghc.cabal
+++ b/ghc.cabal
@@ -3,7 +3,7 @@
 -- ./configure.  Make sure you are editing ghc.cabal.in, not ghc.cabal.
 
 Name: ghc
-Version: 9.6.5
+Version: 9.6.6
 License: BSD-3-Clause
 License-File: LICENSE
 Author: The GHC Team
@@ -86,9 +86,9 @@
                    transformers >= 0.5 && < 0.7,
                    exceptions == 0.10.*,
                    stm,
-                   ghc-boot   == 9.6.5,
-                   ghc-heap   == 9.6.5,
-                   ghci == 9.6.5
+                   ghc-boot   == 9.6.6,
+                   ghc-heap   == 9.6.6,
+                   ghci == 9.6.6
 
     if os(windows)
         Build-Depends: Win32  >= 2.3 && < 2.14