ghc 9.4.7 → 9.4.8

raw patch · 18 files changed

+294/−69 lines, 18 filesdep ~ghc-bootdep ~ghc-heapdep ~ghciPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc-boot, ghc-heap, ghci

API changes (from Hackage documentation)

Files

• GHC/Cmm/Lexer.hs +2/−2
• GHC/CmmToAsm.hs +13/−11
• GHC/CmmToAsm/AArch64.hs +2/−2
• GHC/CmmToAsm/AArch64/CodeGen.hs +192/−7
• GHC/CmmToAsm/AArch64/Cond.hs +8/−2
• GHC/CmmToAsm/AArch64/Instr.hs +1/−0
• GHC/CmmToAsm/AArch64/Ppr.hs +6/−3
• GHC/CmmToAsm/BlockLayout.hs +23/−19
• GHC/CmmToAsm/Monad.hs +3/−2
• GHC/CmmToAsm/PPC/Instr.hs +6/−5
• GHC/CmmToAsm/Ppr.hs +5/−0
• GHC/CmmToAsm/X86.hs +1/−1
• GHC/Driver/Pipeline.hs +13/−2
• GHC/Parser/HaddockLex.hs +2/−2
• GHC/Parser/Lexer.hs +2/−2
• GHC/Stg/InferTags/Rewrite.hs +4/−1
• GHC/StgToCmm/CgUtils.hs +7/−4
• ghc.cabal +4/−4

@@ -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.4.7-src/ghc-9.4.7/compiler/GHC/Cmm/Lexer.x" #-}+{-# LINE 13 "_build/source-dist/ghc-9.4.8-src/ghc-9.4.8/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.4.7-src/ghc-9.4.7/compiler/GHC/Cmm/Lexer.x" #-}+{-# LINE 133 "_build/source-dist/ghc-9.4.8-src/ghc-9.4.8/compiler/GHC/Cmm/Lexer.x" #-} data CmmToken   = CmmT_SpecChar  Char   | CmmT_DotDot

@@ -130,6 +130,7 @@ import GHC.Utils.BufHandle import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic+import GHC.Utils.Panic.Plain ( massert ) import GHC.Utils.Error import GHC.Utils.Exception (evaluate) import GHC.Utils.Constants (debugIsOn)@@ -648,14 +649,15 @@                                 text "cfg not in lockstep") ()          ---- sequence blocks-        let sequenced :: [NatCmmDecl statics instr]-            sequenced =-                checkLayout shorted $-                {-# SCC "sequenceBlocks" #-}-                map (BlockLayout.sequenceTop-                        ncgImpl optimizedCFG)-                    shorted+        -- sequenced :: [NatCmmDecl statics instr]+        let (sequenced, us_seq) =+                        {-# SCC "sequenceBlocks" #-}+                        initUs usAlloc $ mapM (BlockLayout.sequenceTop+                                ncgImpl optimizedCFG)+                            shorted +        massert (checkLayout shorted sequenced)+         let branchOpt :: [NatCmmDecl statics instr]             branchOpt =                 {-# SCC "invertCondBranches" #-}@@ -677,7 +679,7 @@                 addUnwind acc proc =                     acc `mapUnion` computeUnwinding config ncgImpl proc -        return  ( usAlloc+        return  ( us_seq                 , fileIds'                 , branchOpt                 , lastMinuteImports ++ imports@@ -697,10 +699,10 @@  -- | Make sure all blocks we want the layout algorithm to place have been placed. checkLayout :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]-            -> [NatCmmDecl statics instr]+            -> Bool checkLayout procsUnsequenced procsSequenced =-        assertPpr (setNull diff) (ppr "Block sequencing dropped blocks:" <> ppr diff)-        procsSequenced+        assertPpr (setNull diff) (text "Block sequencing dropped blocks:" <> ppr diff)+        True   where         blocks1 = foldl' (setUnion) setEmpty $                         map getBlockIds procsUnsequenced :: LabelSet

@@ -32,9 +32,9 @@        ,maxSpillSlots             = AArch64.maxSpillSlots config        ,allocatableRegs           = AArch64.allocatableRegs platform        ,ncgAllocMoreStack         = AArch64.allocMoreStack platform-       ,ncgMakeFarBranches        = const id+       ,ncgMakeFarBranches        = AArch64.makeFarBranches        ,extractUnwindPoints       = const []-       ,invertCondBranches        = \_ _ -> id+       ,invertCondBranches        = \_ _ blocks -> blocks   }     where       platform = ncgPlatform config

@@ -6,6 +6,7 @@ module GHC.CmmToAsm.AArch64.CodeGen (       cmmTopCodeGen     , generateJumpTableForInstr+    , makeFarBranches )  where@@ -42,9 +43,11 @@ import GHC.Cmm.Switch import GHC.Cmm.CLabel import GHC.Cmm.Dataflow.Block+import GHC.Cmm.Dataflow.Label import GHC.Cmm.Dataflow.Graph import GHC.Types.Tickish ( GenTickish(..) ) import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )+import GHC.Types.Unique.Supply  -- The rest: import GHC.Data.OrdList@@ -59,7 +62,10 @@ import GHC.Data.FastString import GHC.Utils.Misc import GHC.Utils.Panic+import GHC.Utils.Monad (mapAccumLM) +import GHC.Cmm.Dataflow.Collections+ -- Note [General layout of an NCG] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- @cmmTopCodeGen@ will be our main entry point to code gen.  Here we'll get@@ -158,15 +164,17 @@   let         (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs -        mkBlocks (NEWBLOCK id) (instrs,blocks,statics)-          = ([], BasicBlock id instrs : blocks, statics)-        mkBlocks (LDATA sec dat) (instrs,blocks,statics)-          = (instrs, blocks, CmmData sec dat:statics)-        mkBlocks instr (instrs,blocks,statics)-          = (instr:instrs, blocks, statics)   return (BasicBlock id top : other_blocks, statics) -+mkBlocks :: Instr+          -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])+          -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])+mkBlocks (NEWBLOCK id) (instrs,blocks,statics)+  = ([], BasicBlock id instrs : blocks, statics)+mkBlocks (LDATA sec dat) (instrs,blocks,statics)+  = (instrs, blocks, CmmData sec dat:statics)+mkBlocks instr (instrs,blocks,statics)+  = (instr:instrs, blocks, statics) -- ----------------------------------------------------------------------------- -- | Utilities ann :: SDoc -> Instr -> Instr@@ -1168,6 +1176,7 @@  -- ----------------------------------------------------------------------------- -- Jumps+ genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock genJump expr@(CmmLit (CmmLabel lbl))   = return $ unitOL (annExpr expr (J (TLabel lbl)))@@ -1253,7 +1262,23 @@           _ -> pprPanic "AArch64.genCondJump:case mop: " (text $ show expr)       _ -> pprPanic "AArch64.genCondJump: " (text $ show expr) +-- A conditional jump with at least +/-128M jump range+genCondFarJump :: MonadUnique m => Cond -> Target -> m InstrBlock+genCondFarJump cond far_target = do+  skip_lbl_id <- newBlockId+  jmp_lbl_id <- newBlockId +  -- TODO: We can improve this by inverting the condition+  -- but it's not quite trivial since we don't know if we+  -- need to consider float orderings.+  -- So we take the hit of the additional jump in the false+  -- case for now.+  return $ toOL [ BCOND cond (TBlock jmp_lbl_id)+                , B (TBlock skip_lbl_id)+                , NEWBLOCK jmp_lbl_id+                , B far_target+                , NEWBLOCK skip_lbl_id]+ genCondBranch     :: BlockId      -- the source of the jump     -> BlockId      -- the true branch target@@ -1743,3 +1768,163 @@       let dst = getRegisterReg platform (CmmLocal dest_reg)       let code = code_fx `appOL` op (OpReg w dst) (OpReg w reg_fx)       return (code, Nothing)++{- Note [AArch64 far jumps]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+AArch conditional jump instructions can only encode an offset of +/-1MB+which is usually enough but can be exceeded in edge cases. In these cases+we will replace:++  b.cond <cond> foo++with the sequence:++  b.cond <cond> <lbl_true>+  b <lbl_false>+  <lbl_true>:+  b foo+  <lbl_false>:++Note the encoding of the `b` instruction still limits jumps to++/-128M offsets, but that seems like an acceptable limitation.++Since AArch64 instructions are all of equal length we can reasonably estimate jumps+in range by counting the instructions between a jump and its target label.++We make some simplifications in the name of performance which can result in overestimating+jump <-> label offsets:++* To avoid having to recalculate the label offsets once we replaced a jump we simply+  assume all jumps will be expanded to a three instruction far jump sequence.+* For labels associated with a info table we assume the info table is 64byte large.+  Most info tables are smaller than that but it means we don't have to distinguish+  between multiple types of info tables.++In terms of implementation we walk the instruction stream at least once calculating+label offsets, and if we determine during this that the functions body is big enough+to potentially contain out of range jumps we walk the instructions a second time, replacing+out of range jumps with the sequence of instructions described above.++-}++-- See Note [AArch64 far jumps]+data BlockInRange = InRange | NotInRange Target++-- See Note [AArch64 far jumps]+makeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock Instr]+                -> UniqSM [NatBasicBlock Instr]+makeFarBranches {- only used when debugging -} _platform statics basic_blocks = do+  -- All offsets/positions are counted in multiples of 4 bytes (the size of AArch64 instructions)+  -- That is an offset of 1 represents a 4-byte/one instruction offset.+  let (func_size, lblMap) = foldl' calc_lbl_positions (0, mapEmpty) basic_blocks+  if func_size < max_jump_dist+    then pure basic_blocks+    else do+      (_,blocks) <- mapAccumLM (replace_blk lblMap) 0 basic_blocks+      pure $ concat blocks+      -- pprTrace "lblMap" (ppr lblMap) $ basic_blocks++  where+    -- 2^18, 19 bit immediate with one bit is reserved for the sign+    max_jump_dist = 2^(18::Int) - 1 :: Int+    -- Currently all inline info tables fit into 64 bytes.+    max_info_size     = 16 :: Int+    long_bc_jump_size =  3 :: Int+    long_bz_jump_size =  4 :: Int++    -- Replace out of range conditional jumps with unconditional jumps.+    replace_blk :: LabelMap Int -> Int -> GenBasicBlock Instr -> UniqSM (Int, [GenBasicBlock Instr])+    replace_blk !m !pos (BasicBlock lbl instrs) = do+      -- Account for a potential info table before the label.+      let !block_pos = pos + infoTblSize_maybe lbl+      (!pos', instrs') <- mapAccumLM (replace_jump m) block_pos instrs+      let instrs'' = concat instrs'+      -- We might have introduced new labels, so split the instructions into basic blocks again if neccesary.+      let (top, split_blocks, no_data) = foldr mkBlocks ([],[],[]) instrs''+      -- There should be no data in the instruction stream at this point+      massertPpr (null no_data) $ text "There should be no data in the instruction stream"++      let final_blocks = BasicBlock lbl top : split_blocks+      pure (pos', final_blocks)++    replace_jump :: LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])+    replace_jump !m !pos instr = do+      case instr of+        ANN ann instr -> do+          (idx,instr':instrs') <- replace_jump m pos instr+          pure (idx, ANN ann instr':instrs')+        BCOND cond t+          -> case target_in_range m t pos of+              InRange -> pure (pos+long_bc_jump_size,[instr])+              NotInRange far_target -> do+                jmp_code <- genCondFarJump cond far_target+                pure (pos+long_bc_jump_size, fromOL jmp_code)+        CBZ op t -> long_zero_jump op t EQ+        CBNZ op t -> long_zero_jump op t NE+        instr+          | isMetaInstr instr -> pure (pos,[instr])+          | otherwise -> pure (pos+1, [instr])++      where+        -- cmp_op: EQ = CBZ, NEQ = CBNZ+        long_zero_jump op t cmp_op =+          case target_in_range m t pos of+              InRange -> pure (pos+long_bz_jump_size,[instr])+              NotInRange far_target -> do+                jmp_code <- genCondFarJump cmp_op far_target+                -- TODO: Fix zero reg so we can use it here+                pure (pos + long_bz_jump_size, CMP op (OpImm (ImmInt 0)) : fromOL jmp_code)+++    target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange+    target_in_range m target src =+      case target of+        (TReg{}) -> InRange+        (TBlock bid) -> block_in_range m src bid+        (TLabel clbl)+          | Just bid <- maybeLocalBlockLabel clbl+          -> block_in_range m src bid+          | otherwise+          -- Maybe we should be pessimistic here, for now just fixing intra proc jumps+          -> InRange++    block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange+    block_in_range m src_pos dest_lbl =+      case mapLookup dest_lbl m of+        Nothing       ->+          -- pprTrace "not in range" (ppr dest_lbl) $+            NotInRange (TBlock dest_lbl)+        Just dest_pos -> if abs (dest_pos - src_pos) < max_jump_dist+          then InRange+          else NotInRange (TBlock dest_lbl)++    calc_lbl_positions :: (Int, LabelMap Int) -> GenBasicBlock Instr -> (Int, LabelMap Int)+    calc_lbl_positions (pos, m) (BasicBlock lbl instrs)+      = let !pos' = pos + infoTblSize_maybe lbl+        in foldl' instr_pos (pos',mapInsert lbl pos' m) instrs++    instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)+    instr_pos (pos, m) instr =+      case instr of+        ANN _ann instr -> instr_pos (pos, m) instr+        NEWBLOCK _bid -> panic "mkFarBranched - unexpected NEWBLOCK" -- At this point there should be no NEWBLOCK+                                                                     -- in the instruction stream+                                                                     -- (pos, mapInsert bid pos m)+        COMMENT{} -> (pos, m)+        instr+          | Just jump_size <- is_expandable_jump instr -> (pos+jump_size, m)+          | otherwise -> (pos+1, m)++    infoTblSize_maybe bid =+      case mapLookup bid statics of+        Nothing           -> 0 :: Int+        Just _info_static -> max_info_size++    -- These jumps have a 19bit immediate as offset which is quite+    -- limiting so we potentially have to expand them into+    -- multiple instructions.+    is_expandable_jump i = case i of+      CBZ{}   -> Just long_bz_jump_size+      CBNZ{}  -> Just long_bz_jump_size+      BCOND{} -> Just long_bc_jump_size+      _ -> Nothing

@@ -1,6 +1,6 @@ module GHC.CmmToAsm.AArch64.Cond  where -import GHC.Prelude+import GHC.Prelude hiding (EQ)  -- https://developer.arm.com/documentation/den0024/a/the-a64-instruction-set/data-processing-instructions/conditional-instructions @@ -60,7 +60,13 @@     | UOGE   -- b.pl     | UOGT   -- b.hi     -- others-    | NEVER  -- b.nv+    -- NEVER -- b.nv+             -- I removed never. According to the ARM spec:+             -- >   The Condition code NV exists only to provide a valid disassembly of+             -- >   the 0b1111 encoding, otherwise its behavior is identical to AL.+             -- This can only lead to disaster. Better to not have it than someone+             -- using it assuming it actually means never.+     | VS     -- oVerflow set     | VC     -- oVerflow clear     deriving Eq

@@ -713,6 +713,7 @@     = TBlock BlockId     | TLabel CLabel     | TReg   Reg+    deriving (Eq, Ord)   -- Extension

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-} -module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr) where+module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr, pprBasicBlock) where  import GHC.Prelude hiding (EQ) @@ -364,7 +364,10 @@   LOCATION file line col _name     -> text "\t.loc" <+> ppr file <+> ppr line <+> ppr col   DELTA d    -> asmComment $ text ("\tdelta = " ++ show d)-  NEWBLOCK _ -> panic "PprInstr: NEWBLOCK"+  NEWBLOCK blockid -> -- This is invalid assembly. But NEWBLOCK should never be contained+                      -- in the final instruction stream. But we still want to be able to+                      -- print it for debugging purposes.+                      text "BLOCK " <> pprLabel platform (blockLbl blockid)   LDATA _ _  -> panic "pprInstr: LDATA"    -- Pseudo Instructions -------------------------------------------------------@@ -560,7 +563,7 @@   UGE    -> text "hs" -- Carry set/unsigned higher or same ; Greater than or equal, or unordered   UGT    -> text "hi" -- Unsigned higher                   ; Greater than, or unordered -  NEVER  -> text "nv" -- Never+  -- NEVER  -> text "nv" -- Never   VS     -> text "vs" -- Overflow                          ; Unordered (at least one NaN operand)   VC     -> text "vc" -- No overflow                       ; Not unordered 

@@ -48,6 +48,7 @@ import Control.Monad.ST.Strict import Control.Monad (foldM, unless) import GHC.Data.UnionFind+import GHC.Types.Unique.Supply (UniqSM)  {-   Note [CFG based code layout]@@ -797,29 +798,32 @@     => NcgImpl statics instr jumpDest     -> Maybe CFG -- ^ CFG if we have one.     -> NatCmmDecl statics instr -- ^ Function to serialize-    -> NatCmmDecl statics instr+    -> UniqSM (NatCmmDecl statics instr) -sequenceTop _       _           top@(CmmData _ _) = top-sequenceTop ncgImpl edgeWeights (CmmProc info lbl live (ListGraph blocks))-  = let-      config     = ncgConfig ncgImpl-      platform   = ncgPlatform config+sequenceTop _       _           top@(CmmData _ _) = pure top+sequenceTop ncgImpl edgeWeights (CmmProc info lbl live (ListGraph blocks)) = do+    let config     = ncgConfig ncgImpl+        platform   = ncgPlatform config -    in CmmProc info lbl live $ ListGraph $ ncgMakeFarBranches ncgImpl info $-         if -- Chain based algorithm-            | ncgCfgBlockLayout config-            , backendMaintainsCfg platform-            , Just cfg <- edgeWeights-            -> {-# SCC layoutBlocks #-} sequenceChain info cfg blocks+        seq_blocks =+                  if -- Chain based algorithm+                      | ncgCfgBlockLayout config+                      , backendMaintainsCfg platform+                      , Just cfg <- edgeWeights+                      -> {-# SCC layoutBlocks #-} sequenceChain info cfg blocks -            -- Old algorithm without edge weights-            | ncgCfgWeightlessLayout config-               || not (backendMaintainsCfg platform)-            -> {-# SCC layoutBlocks #-} sequenceBlocks Nothing info blocks+                      -- Old algorithm without edge weights+                      | ncgCfgWeightlessLayout config+                        || not (backendMaintainsCfg platform)+                      -> {-# SCC layoutBlocks #-} sequenceBlocks Nothing info blocks -            -- Old algorithm with edge weights (if any)-            | otherwise-            -> {-# SCC layoutBlocks #-} sequenceBlocks edgeWeights info blocks+                      -- Old algorithm with edge weights (if any)+                      | otherwise+                      -> {-# SCC layoutBlocks #-} sequenceBlocks edgeWeights info blocks++    far_blocks <- (ncgMakeFarBranches ncgImpl) platform info seq_blocks+    pure $ CmmProc info lbl live $ ListGraph far_blocks+  -- The old algorithm: -- It is very simple (and stupid): We make a graph out of

@@ -92,7 +92,8 @@                               -> UniqSM (NatCmmDecl statics instr, [(BlockId,BlockId)]),     -- ^ The list of block ids records the redirected jumps to allow us to update     -- the CFG.-    ncgMakeFarBranches        :: LabelMap RawCmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr],+    ncgMakeFarBranches        :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock instr]+                              -> UniqSM [NatBasicBlock instr],     extractUnwindPoints       :: [instr] -> [UnwindPoint],     -- ^ given the instruction sequence of a block, produce a list of     -- the block's 'UnwindPoint's@@ -107,7 +108,7 @@ data NatM_State         = NatM_State {                 natm_us          :: UniqSupply,-                natm_delta       :: Int,+                natm_delta       :: Int, -- ^ Stack offset for unwinding information                 natm_imports     :: [(CLabel)],                 natm_pic         :: Maybe Reg,                 natm_config      :: NCGConfig,

@@ -675,12 +675,13 @@ -- big, we have to work around this limitation.  makeFarBranches-        :: LabelMap RawCmmStatics-        -> [NatBasicBlock Instr]+        :: Platform+        -> LabelMap RawCmmStatics         -> [NatBasicBlock Instr]-makeFarBranches info_env blocks-    | last blockAddresses < nearLimit = blocks-    | otherwise = zipWith handleBlock blockAddresses blocks+        -> UniqSM [NatBasicBlock Instr]+makeFarBranches _platform info_env blocks+    | last blockAddresses < nearLimit = return blocks+    | otherwise = return $ zipWith handleBlock blockAddresses blocks     where         blockAddresses = scanl (+) 0 $ map blockLen blocks         blockLen (BasicBlock _ instrs) = length instrs

@@ -242,6 +242,11 @@       OtherSection _ ->         panic "PprBase.pprGNUSectionHeader: unknown section type"     flags = case t of+      Text+        | OSMinGW32 <- platformOS platform, splitSections+                    -> text ",\"xr\""+        | splitSections+                    -> text ",\"ax\"," <> sectionType platform "progbits"       CString         | OSMinGW32 <- platformOS platform                     -> empty

@@ -37,7 +37,7 @@    , maxSpillSlots             = X86.maxSpillSlots config    , allocatableRegs           = X86.allocatableRegs platform    , ncgAllocMoreStack         = X86.allocMoreStack platform-   , ncgMakeFarBranches        = const id+   , ncgMakeFarBranches        = \_p _i bs -> pure bs    , extractUnwindPoints       = X86.extractUnwindPoints    , invertCondBranches        = X86.invertCondBranches    }

@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -122,6 +122,7 @@  import Data.Time        ( getCurrentTime ) import GHC.Iface.Recomp+import GHC.Types.Unique.DSet  -- Simpler type synonym for actions in the pipeline monad type P m = TPipelineClass TPhase m@@ -472,8 +473,18 @@          -- next, check libraries. XXX this only checks Haskell libraries,         -- not extra_libraries or -l things from the command line.+        -- pkg_deps is just the direct dependencies so take the transitive closure here+        -- to decide if we need to relink or not.+        let pkg_hslibs acc uid+              | uid `elementOfUniqDSet` acc = acc+              | Just c <- lookupUnitId unit_state uid =+                  foldl' @[] pkg_hslibs (addOneToUniqDSet acc uid) (unitDepends c)+              | otherwise = acc++            all_pkg_deps = foldl' @[] pkg_hslibs emptyUniqDSet pkg_deps+         let pkg_hslibs  = [ (collectLibraryDirs (ways dflags) [c], lib)-                          | Just c <- map (lookupUnitId unit_state) pkg_deps,+                          | Just c <- map (lookupUnitId unit_state) (uniqDSetToList all_pkg_deps),                             lib <- unitHsLibs (ghcNameVersion dflags) (ways dflags) c ]          pkg_libfiles <- mapM (uncurry (findHSLib platform (ways dflags))) pkg_hslibs

@@ -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.4.7-src/ghc-9.4.7/compiler/GHC/Parser/HaddockLex.x" #-}+{-# LINE 1 "_build/source-dist/ghc-9.4.8-src/ghc-9.4.8/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.4.7-src/ghc-9.4.7/compiler/GHC/Parser/HaddockLex.x" #-}+{-# LINE 87 "_build/source-dist/ghc-9.4.8-src/ghc-9.4.8/compiler/GHC/Parser/HaddockLex.x" #-} data AlexInput = AlexInput   { alexInput_position     :: !RealSrcLoc   , alexInput_string       :: !ByteString

@@ -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.4.7-src/ghc-9.4.7/compiler/GHC/Parser/Lexer.x" #-}+{-# LINE 43 "_build/source-dist/ghc-9.4.8-src/ghc-9.4.8/compiler/GHC/Parser/Lexer.x" #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}@@ -609,7 +609,7 @@   , (0,alex_action_84)   ] -{-# LINE 700 "_build/source-dist/ghc-9.4.7-src/ghc-9.4.7/compiler/GHC/Parser/Lexer.x" #-}+{-# LINE 700 "_build/source-dist/ghc-9.4.8-src/ghc-9.4.8/compiler/GHC/Parser/Lexer.x" #-} -- ----------------------------------------------------------------------------- -- The token type 

@@ -366,7 +366,10 @@             fvs <- fvArgs args             -- lcls <- getFVs             -- pprTraceM "RhsClosureConversion" (ppr (StgRhsClosure fvs ccs ReEntrant [] $! conExpr) $$ text "lcls:" <> ppr lcls)-            return $! (StgRhsClosure fvs ccs ReEntrant [] $! conExpr)++            -- We mark the closure updatable to retain sharing in the case that+            -- conExpr is an infinite recursive data type. See #23783.+            return $! (StgRhsClosure fvs ccs Updatable [] $! conExpr) rewriteRhs _binding (StgRhsClosure fvs ccs flag args body) = do     withBinders NotTopLevel args $         withClosureLcls fvs $

@@ -173,15 +173,18 @@                         BaseReg -> baseAddr                         _other  -> CmmLoad baseAddr (globalRegType platform reg) NaturallyAligned -        CmmRegOff (CmmGlobal reg) offset ->+        CmmRegOff greg@(CmmGlobal reg) offset ->             -- RegOf leaves are just a shorthand form. If the reg maps             -- to a real reg, we keep the shorthand, otherwise, we just             -- expand it and defer to the above code.+            -- NB: to ensure type correctness we need to ensure the Add+            --     as well as the Int need to be of the same size as the+            --     register.             case reg `elem` activeStgRegs platform of                 True  -> expr-                False -> CmmMachOp (MO_Add (wordWidth platform)) [-                                    fixExpr (CmmReg (CmmGlobal reg)),+                False -> CmmMachOp (MO_Add (cmmRegWidth platform greg)) [+                                    fixExpr (CmmReg greg),                                     CmmLit (CmmInt (fromIntegral offset)-                                                   (wordWidth platform))]+                                                   (cmmRegWidth platform greg))]          other_expr -> other_expr

@@ -3,7 +3,7 @@ -- ./configure.  Make sure you are editing ghc.cabal.in, not ghc.cabal.  Name: ghc-Version: 9.4.7+Version: 9.4.8 License: BSD-3-Clause License-File: LICENSE Author: The GHC Team@@ -91,9 +91,9 @@                    transformers == 0.5.*,                    exceptions == 0.10.*,                    stm,-                   ghc-boot   == 9.4.7,-                   ghc-heap   == 9.4.7,-                   ghci == 9.4.7+                   ghc-boot   == 9.4.8,+                   ghc-heap   == 9.4.8,+                   ghci == 9.4.8      if os(windows)         Build-Depends: Win32  >= 2.3 && < 2.13