
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Consider `PromotedDataCon` in `tyConStupidTheta`
by Marge Bot (@marge-bot) 01 Jul '25
by Marge Bot (@marge-bot) 01 Jul '25
01 Jul '25
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
fa31bae9 by Berk Özkütük at 2025-07-01T18:26:56-04:00
Consider `PromotedDataCon` in `tyConStupidTheta`
Haddock checks data declarations for the stupid theta so as not to
pretty-print them as empty contexts. Type data declarations end up as
`PromotedDataCon`s by the time Haddock performs this check, causing a
panic. This commit extends `tyConStupidTheta` so that it returns an
empty list for `PromotedDataCon`s. This decision was guided by the fact
that type data declarations never have data type contexts (see (R1) in
Note [Type data declarations]).
Fixes #25739.
- - - - -
659cdd02 by Ryan Hendrickson at 2025-07-01T18:27:01-04:00
haddock: Document instances from other packages
When attaching instances to `Interface`s, it isn't enough just to look
for instances in the list of `Interface`s being processed. We also need
to look in the modules on which they depend, including those outside of
this package.
Fixes #25147.
Fixes #26079.
- - - - -
a4333bb1 by Rodrigo Mesquita at 2025-07-01T18:27:02-04:00
hadrian: Fallback logic for internal interpreter
When determining whether to build the internal interpreter, the `make`
build system had a fallback case for platforms not in the list of
explicitly-supported operating systems and architectures.
This fallback says we should try to build the internal interpreter if
building dynamic GHC programs (if the architecture is unknown).
Fixes #24098
- - - - -
b1927b0b by meooow25 at 2025-07-01T18:27:10-04:00
Keep scanl' strict in the head on rewrite
`scanl'` forces elements to WHNF when the corresponding `(:)`s are
forced. The rewrite rule for `scanl'` missed forcing the first element,
which is fixed here with a `seq`.
- - - - -
16 changed files:
- compiler/GHC/Core/TyCon.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Packages.hs
- hadrian/src/Settings/Program.hs
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/List.hs
- utils/haddock/CHANGES.md
- utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/haddock/haddock-test/src/Test/Haddock/Config.hs
- utils/haddock/html-test/ref/Bug1004.html
- + utils/haddock/html-test/ref/Bug25739.html
- + utils/haddock/html-test/src/Bug25739.hs
Changes:
=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -2709,6 +2709,7 @@ tyConStupidTheta :: TyCon -> [PredType]
tyConStupidTheta tc@(TyCon { tyConDetails = details })
| AlgTyCon {algTcStupidTheta = stupid} <- details = stupid
| PrimTyCon {} <- details = []
+ | PromotedDataCon {} <- details = []
| otherwise = pprPanic "tyConStupidTheta" (ppr tc)
-- | Extract the 'TyVar's bound by a vanilla type synonym
=====================================
hadrian/src/Oracles/Flag.hs
=====================================
@@ -7,7 +7,6 @@ module Oracles.Flag (
targetRTSLinkerOnlySupportsSharedLibs,
targetSupportsThreadedRts,
targetSupportsSMP,
- ghcWithInterpreter,
useLibffiForAdjustors,
arSupportsDashL,
arSupportsAtFile
@@ -146,31 +145,5 @@ targetSupportsSMP = do
| goodArch -> return True
| otherwise -> return False
-
--- | When cross compiling, enable for stage0 to get ghci
--- support. But when not cross compiling, disable for
--- stage0, otherwise we introduce extra dependencies
--- like haskeline etc, and mixing stageBoot/stage0 libs
--- can cause extra trouble (e.g. #25406)
---
--- Also checks whether the target supports GHCi.
-ghcWithInterpreter :: Stage -> Action Bool
-ghcWithInterpreter stage = do
- is_cross <- flag CrossCompiling
- goodOs <- anyTargetOs [ OSMinGW32, OSLinux, OSSolaris2 -- TODO "cygwin32"?,
- , OSFreeBSD, OSDragonFly, OSNetBSD, OSOpenBSD
- , OSDarwin, OSKFreeBSD
- , OSWasi ]
- goodArch <- (||) <$>
- anyTargetArch [ ArchX86, ArchX86_64, ArchPPC
- , ArchAArch64, ArchS390X
- , ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2
- , ArchRISCV64, ArchLoongArch64
- , ArchWasm32 ]
- <*> isArmTarget
- -- Maybe this should just be false for cross compilers. But for now
- -- I've kept the old behaviour where it will say yes. (See #25939)
- return $ goodOs && goodArch && (stage >= Stage1 || is_cross)
-
useLibffiForAdjustors :: Action Bool
useLibffiForAdjustors = queryTargetTarget tgtUseLibffiForAdjustors
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -26,6 +26,7 @@ import Utilities
import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp))
import GHC.Toolchain.Program
import GHC.Platform.ArchOS
+import Settings.Program (ghcWithInterpreter)
-- | Track this file to rebuild generated files whenever it changes.
trackGenerateHs :: Expr ()
=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -11,7 +11,7 @@ import Settings.Builders.Common
import qualified Settings.Builders.Common as S
import Control.Exception (assert)
import qualified Data.Set as Set
-import Settings.Program (programContext)
+import Settings.Program (programContext, ghcWithInterpreter)
import GHC.Toolchain (ccLinkProgram, tgtCCompilerLink)
import GHC.Toolchain.Program (prgFlags)
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -11,6 +11,7 @@ import Settings.Builders.Common (wayCcArgs)
import GHC.Toolchain.Target
import GHC.Platform.ArchOS
import Data.Version.Extra
+import Settings.Program (ghcWithInterpreter)
-- | Package-specific command-line arguments.
packageArgs :: Args
=====================================
hadrian/src/Settings/Program.hs
=====================================
@@ -1,12 +1,17 @@
module Settings.Program
( programContext
+ , ghcWithInterpreter
) where
import Base
import Context
import Oracles.Flavour
+import Oracles.Flag
import Packages
+import GHC.Platform.ArchOS
+import Settings.Builders.Common (anyTargetOs, anyTargetArch, isArmTarget)
+
-- TODO: there is duplication and inconsistency between this and
-- Rules.Program.getProgramContexts. There should only be one way to
-- get a context/contexts for a given stage and package.
@@ -24,3 +29,33 @@ programContext stage pkg = do
notStage0 (Stage0 {}) = False
notStage0 _ = True
+
+-- | When cross compiling, enable for stage0 to get ghci
+-- support. But when not cross compiling, disable for
+-- stage0, otherwise we introduce extra dependencies
+-- like haskeline etc, and mixing stageBoot/stage0 libs
+-- can cause extra trouble (e.g. #25406)
+--
+-- Also checks whether the target supports GHCi.
+ghcWithInterpreter :: Stage -> Action Bool
+ghcWithInterpreter stage = do
+ is_cross <- flag CrossCompiling
+ goodOs <- anyTargetOs [ OSMinGW32, OSLinux, OSSolaris2 -- TODO "cygwin32"?,
+ , OSFreeBSD, OSDragonFly, OSNetBSD, OSOpenBSD
+ , OSDarwin, OSKFreeBSD
+ , OSWasi ]
+ goodArch <- (||) <$>
+ anyTargetArch [ ArchX86, ArchX86_64, ArchPPC
+ , ArchAArch64, ArchS390X
+ , ArchPPC_64 ELF_V1, ArchPPC_64 ELF_V2
+ , ArchRISCV64, ArchLoongArch64
+ , ArchWasm32 ]
+ <*> isArmTarget
+ -- The explicit support list is essentially a list of platforms for which
+ -- the RTS linker has support. If the RTS linker is not supported then we
+ -- fall back on dynamic linking:
+ dynamicGhcProgs <- askDynGhcPrograms
+
+ -- Maybe this should just be false for cross compilers. But for now
+ -- I've kept the old behaviour where it will say yes. (See #25939)
+ return $ ((goodOs && goodArch) || dynamicGhcProgs) && (stage >= Stage1 || is_cross)
=====================================
libraries/base/changelog.md
=====================================
@@ -26,6 +26,7 @@
* Expose constructor and field of `Backtraces` from `Control.Exception.Backtrace`, as per [CLC #199](https://github.com/haskell/core-libraries-committee/issues/199#issuecomment-1954662391)
* Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)).
+ * Fix the rewrite rule for `scanl'` not being strict in the first element of the output list ([#26143](https://gitlab.haskell.org/ghc/ghc/-/issues/26143)).
## 4.21.0.0 *December 2024*
=====================================
libraries/ghc-internal/src/GHC/Internal/List.hs
=====================================
@@ -601,7 +601,7 @@ scanl' = scanlGo'
-- See Note [scanl rewrite rules]
{-# RULES
"scanl'" [~1] forall f a bs . scanl' f a bs =
- build (\c n -> a `c` foldr (scanlFB' f c) (flipSeq n) bs a)
+ build (\c n -> a `seq` (a `c` foldr (scanlFB' f c) (flipSeq n) bs a))
"scanlList'" [1] forall f a bs .
foldr (scanlFB' f (:)) (flipSeq []) bs a = tail (scanl' f a bs)
#-}
=====================================
utils/haddock/CHANGES.md
=====================================
@@ -1,6 +1,8 @@
## Changes in 2.32.0
* Add highlighting for inline-code-blocks (sections enclosed in @'s)
+ * Fix missing documentation for orphan instances from other packages.
+
* Add incremental mode to support rendering documentation one module at a time.
* The flag `--no-compilation` has been added. This flag causes Haddock to avoid
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
=====================================
@@ -88,7 +88,10 @@ attachInstances expInfo ifaces instIfaceMap isOneShot = do
, fromOrig == Just True || not (null reExp)
]
mods_to_load = moduleSetElts mods
- mods_visible = mkModuleSet $ map ifaceMod ifaces
+ -- We need to ensure orphans in modules outside of this package are included.
+ -- See https://gitlab.haskell.org/ghc/ghc/-/issues/25147
+ -- and https://gitlab.haskell.org/ghc/ghc/-/issues/26079
+ mods_visible = mkModuleSet $ concatMap (liftA2 (:) ifaceMod ifaceOrphanDeps) ifaces
(_msgs, mb_index) <- do
hsc_env <- getSession
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
=====================================
@@ -59,6 +59,7 @@ import GHC.Types.Name.Set
import GHC.Types.SafeHaskell
import qualified GHC.Types.SrcLoc as SrcLoc
import qualified GHC.Types.Unique.Map as UniqMap
+import GHC.Unit.Module.Deps (dep_orphs)
import GHC.Unit.Module.ModIface
import GHC.Unit.State (PackageName (..), UnitState)
import GHC.Utils.Outputable (SDocContext)
@@ -270,6 +271,7 @@ createInterface1' flags unit_state dflags hie_file mod_iface ifaces inst_ifaces
, ifaceVisibleExports = visible_names
, ifaceFixMap = fixities
, ifaceInstances = instances
+ , ifaceOrphanDeps = dep_orphs $ mi_deps mod_iface
, ifaceOrphanInstances = [] -- Filled in attachInstances
, ifaceRnOrphanInstances = [] -- Filled in renameInterfaceRn
, ifaceHaddockCoverage = coverage
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -134,6 +134,9 @@ data Interface = Interface
-- Names from modules that are entirely re-exported don't count as visible.
, ifaceInstances :: [ClsInst]
-- ^ Instances exported by the module.
+ , ifaceOrphanDeps :: [Module]
+ -- ^ The list of modules to check for orphan instances if this module is
+ -- imported.
, ifaceOrphanInstances :: [DocInstance GhcRn]
-- ^ Orphan instances
, ifaceRnOrphanInstances :: [DocInstance DocNameI]
=====================================
utils/haddock/haddock-test/src/Test/Haddock/Config.hs
=====================================
@@ -262,6 +262,7 @@ baseDependencies ghcPath = do
pkgs =
[ "array"
, "base"
+ , "deepseq"
, "ghc-prim"
, "process"
, "template-haskell"
=====================================
utils/haddock/html-test/ref/Bug1004.html
=====================================
@@ -833,7 +833,61 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Alternative:8"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:NFData1:8"
+ ></span
+ > <span class="breakable"
+ >(<span class="unbreakable"
+ ><a href="#" title="Control.DeepSeq"
+ >NFData1</a
+ > f</span
+ >, <span class="unbreakable"
+ ><a href="#" title="Control.DeepSeq"
+ >NFData1</a
+ > g</span
+ >)</span
+ > => <a href="#" title="Control.DeepSeq"
+ >NFData1</a
+ > (<a href="#" title="Bug1004"
+ >Product</a
+ > f g)</span
+ > <a href="#" class="selflink"
+ >#</a
+ ></td
+ ><td class="doc"
+ ><p
+ ><em
+ >Since: deepseq-1.4.3.0</em
+ ></p
+ ></td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><details id="i:id:Product:NFData1:8"
+ ><summary class="hide-when-js-enabled"
+ >Instance details</summary
+ ><p
+ >Defined in <a href="#"
+ >Control.DeepSeq</a
+ ></p
+ > <div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a href="#"
+ >liftRnf</a
+ > :: (a -> ()) -> <a href="#" title="Bug1004"
+ >Product</a
+ > f g a -> () <a href="#" class="selflink"
+ >#</a
+ ></p
+ ></div
+ ></details
+ ></td
+ ></tr
+ ><tr
+ ><td class="src clearfix"
+ ><span class="inst-left"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Alternative:9"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -862,7 +916,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Alternative:8"
+ ><details id="i:id:Product:Alternative:9"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -919,7 +973,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Applicative:9"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Applicative:10"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -948,7 +1002,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Applicative:9"
+ ><details id="i:id:Product:Applicative:10"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1021,7 +1075,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Functor:10"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Functor:11"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1050,7 +1104,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Functor:10"
+ ><details id="i:id:Product:Functor:11"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1087,7 +1141,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Monad:11"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Monad:12"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1116,7 +1170,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Monad:11"
+ ><details id="i:id:Product:Monad:12"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1165,7 +1219,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:MonadPlus:12"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:MonadPlus:13"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1194,7 +1248,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:MonadPlus:12"
+ ><details id="i:id:Product:MonadPlus:13"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1231,7 +1285,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:MonadFix:13"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:MonadFix:14"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1260,7 +1314,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:MonadFix:13"
+ ><details id="i:id:Product:MonadFix:14"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1287,7 +1341,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:MonadZip:14"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:MonadZip:15"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1316,7 +1370,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:MonadZip:14"
+ ><details id="i:id:Product:MonadZip:15"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1369,7 +1423,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Foldable:15"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Foldable:16"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1398,7 +1452,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Foldable:15"
+ ><details id="i:id:Product:Foldable:16"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1573,7 +1627,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Traversable:16"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Traversable:17"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1602,7 +1656,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Traversable:16"
+ ><details id="i:id:Product:Traversable:17"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1667,7 +1721,65 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Monoid:17"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:NFData:18"
+ ></span
+ > <span class="breakable"
+ >(<span class="unbreakable"
+ ><a href="#" title="Control.DeepSeq"
+ >NFData</a
+ > (f a)</span
+ >, <span class="unbreakable"
+ ><a href="#" title="Control.DeepSeq"
+ >NFData</a
+ > (g a)</span
+ >)</span
+ > => <a href="#" title="Control.DeepSeq"
+ >NFData</a
+ > (<a href="#" title="Bug1004"
+ >Product</a
+ > f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Note: in <code class="inline-code"
+ >deepseq-1.5.0.0</code
+ > this instance's superclasses were changed.</p
+ ><p
+ ><em
+ >Since: deepseq-1.4.3.0</em
+ ></p
+ ></td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><details id="i:id:Product:NFData:18"
+ ><summary class="hide-when-js-enabled"
+ >Instance details</summary
+ ><p
+ >Defined in <a href="#"
+ >Control.DeepSeq</a
+ ></p
+ > <div class="subs methods"
+ ><p class="caption"
+ >Methods</p
+ ><p class="src"
+ ><a href="#"
+ >rnf</a
+ > :: <a href="#" title="Bug1004"
+ >Product</a
+ > f g a -> () <a href="#" class="selflink"
+ >#</a
+ ></p
+ ></div
+ ></details
+ ></td
+ ></tr
+ ><tr
+ ><td class="src clearfix"
+ ><span class="inst-left"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Monoid:19"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1696,7 +1808,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Monoid:17"
+ ><details id="i:id:Product:Monoid:19"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1743,7 +1855,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Semigroup:18"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Semigroup:20"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1772,7 +1884,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Semigroup:18"
+ ><details id="i:id:Product:Semigroup:20"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1825,7 +1937,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Eq:19"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Eq:21"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1854,7 +1966,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Eq:19"
+ ><details id="i:id:Product:Eq:21"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -1895,7 +2007,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Ord:20"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Ord:22"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -1924,7 +2036,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Ord:20"
+ ><details id="i:id:Product:Ord:22"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -2025,7 +2137,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Data:21"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Data:23"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -2070,7 +2182,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Data:21"
+ ><details id="i:id:Product:Data:23"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -2293,7 +2405,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Generic:22"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Generic:24"
></span
> <a href="#" title="GHC.Generics"
>Generic</a
@@ -2308,7 +2420,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Generic:22"
+ ><details id="i:id:Product:Generic:24"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -2447,7 +2559,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Read:23"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Read:25"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -2476,7 +2588,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Read:23"
+ ><details id="i:id:Product:Read:25"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -2535,7 +2647,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Show:24"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Show:26"
></span
> <span class="breakable"
>(<span class="unbreakable"
@@ -2564,7 +2676,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Show:24"
+ ><details id="i:id:Product:Show:26"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -2613,7 +2725,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Rep1:25"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Rep1:27"
></span
> <span class="keyword"
>type</span
@@ -2636,7 +2748,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Rep1:25"
+ ><details id="i:id:Product:Rep1:27"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
@@ -2711,7 +2823,7 @@
><tr
><td class="src clearfix"
><span class="inst-left"
- ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Rep:26"
+ ><span class="instance details-toggle-control details-toggle" data-details-id="i:id:Product:Rep:28"
></span
> <span class="keyword"
>type</span
@@ -2732,7 +2844,7 @@
></tr
><tr
><td colspan="2"
- ><details id="i:id:Product:Rep:26"
+ ><details id="i:id:Product:Rep:28"
><summary class="hide-when-js-enabled"
>Instance details</summary
><p
=====================================
utils/haddock/html-test/ref/Bug25739.html
=====================================
@@ -0,0 +1,62 @@
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+ ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+ /><meta name="viewport" content="width=device-width, initial-scale=1"
+ /><title
+ >Bug25739</title
+ ><link href="#" rel="stylesheet" type="text/css" title="Linuwial"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><link rel="stylesheet" type="text/css" href="#"
+ /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
+ ></script
+ ><script type="text/x-mathjax-config"
+ >MathJax.Hub.Config({ tex2jax: { processClass: "mathjax", ignoreClass: ".*" } });</script
+ ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-…" type="text/javascript"
+ ></script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><span class="caption empty"
+ > </span
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href="#"
+ >Contents</a
+ ></li
+ ><li
+ ><a href="#"
+ >Index</a
+ ></li
+ ></ul
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >None</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >Bug25739</p
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >data</span
+ > <a id="t:Bar" class="def"
+ >Bar</a
+ > :: Foo <a href="#" class="selflink"
+ >#</a
+ ></p
+ ></div
+ ></div
+ ></div
+ ></body
+ ></html
+>
=====================================
utils/haddock/html-test/src/Bug25739.hs
=====================================
@@ -0,0 +1,5 @@
+{-# LANGUAGE TypeData #-}
+
+module Bug25739 (Bar) where
+
+type data Foo = Bar
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe959cd44ed4c81a106ea479591541…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fe959cd44ed4c81a106ea479591541…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

01 Jul '25
Matthew Pickering pushed to branch wip/stable-ipe-info at Glasgow Haskell Compiler / GHC
Commits:
0317f061 by Matthew Pickering at 2025-07-01T19:29:46+01:00
IPE fix
- - - - -
3 changed files:
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/CmmToLlvm/Data.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/PPC/Ppr.hs
=====================================
@@ -285,6 +285,9 @@ pprAlignForSection platform seg = line $
Data
| ppc64 -> text ".align 3"
| otherwise -> text ".align 2"
+ IPE
+ | ppc64 -> text ".align 3"
+ | otherwise -> text ".align 2"
ReadOnlyData
| ppc64 -> text ".align 3"
| otherwise -> text ".align 2"
=====================================
compiler/GHC/CmmToAsm/Ppr.hs
=====================================
@@ -270,6 +270,7 @@ pprXcoffSectionHeader t = case t of
RelocatableReadOnlyData -> text ".csect .text[PR] # RelocatableReadOnlyData"
CString -> text ".csect .text[PR] # CString"
UninitialisedData -> text ".csect .data[BS]"
+ IPE -> text ".csect .text[PR] #IPE"
_ -> panic "pprXcoffSectionHeader: unknown section type"
{-# SPECIALIZE pprXcoffSectionHeader :: SectionType -> SDoc #-}
{-# SPECIALIZE pprXcoffSectionHeader :: SectionType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
@@ -284,6 +285,7 @@ pprDarwinSectionHeader t = case t of
InitArray -> text ".section\t__DATA,__mod_init_func,mod_init_funcs"
FiniArray -> panic "pprDarwinSectionHeader: fini not supported"
CString -> text ".section\t__TEXT,__cstring,cstring_literals"
+ IPE -> text ".const"
OtherSection _ -> panic "pprDarwinSectionHeader: unknown section type"
{-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> SDoc #-}
{-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
=====================================
compiler/GHC/CmmToLlvm/Data.hs
=====================================
@@ -145,7 +145,7 @@ llvmSectionType p t = case t of
CString -> case platformOS p of
OSMinGW32 -> fsLit ".rdata$str"
_ -> fsLit ".rodata.str"
-
+ IPE -> fsLit ".ipe"
InitArray -> panic "llvmSectionType: InitArray"
FiniArray -> panic "llvmSectionType: FiniArray"
OtherSection _ -> panic "llvmSectionType: unknown section type"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0317f0612514d1c4cf9dfcfe526380c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0317f0612514d1c4cf9dfcfe526380c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/romes/step-out-9] 2 commits: cleanup: Use BreakpointIds in bytecode gen
by Rodrigo Mesquita (@alt-romes) 01 Jul '25
by Rodrigo Mesquita (@alt-romes) 01 Jul '25
01 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC
Commits:
5fcbe16a by Rodrigo Mesquita at 2025-07-01T17:22:38+01:00
cleanup: Use BreakpointIds in bytecode gen
Small clean up to use BreakpointId and InternalBreakpointId more
uniformly in bytecode generation rather than using Module + Ix pairs
- - - - -
3d02f5a3 by Rodrigo Mesquita at 2025-07-01T18:10:09+01:00
ghci: Allocate BreakArrays at link time only
Previously, a BreakArray would be allocated with a slot for every tick
in a module at `mkModBreaks`, in HsToCore. However, this approach has
a few downsides:
- It interleaves interpreter behaviour (allocating arrays for
breakpoints) within the desugarer
- It is inflexible in the sense it is impossible for the bytecode
generator to add "internal" breakpoints that can be triggered at
runtime, because those wouldn't have a source tick. (This is relevant
for our intended implementation plan of step-out in #26042)
- It ties the BreakArray indices to the *tick* indexes, while at runtime
we would rather just have the *info* indexes (currently we have both
because BreakArrays are indexed by the *tick* one).
Paving the way for #26042 and #26064, this commit moves the allocation
of BreakArrays to bytecode-loading time -- akin to what is done for CCS
arrays.
Since a BreakArray is allocated only when bytecode is linked, if a
breakpoint is set (e.g. `:break 10`) before the bytecode is linked,
there will exist no BreakArray to trigger the breakpoint in.
Therefore, the function to allocate break arrays (`allocateBreakArrays`)
is exposed and also used in GHC.Runtime.Eval to allocate a break array
when a breakpoint is set, if it doesn't exist yet (in the linker env).
- - - - -
11 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Runtime/Eval.hs
- − compiler/GHC/Runtime/Interpreter.hs-boot
- − compiler/GHC/Runtime/Interpreter/Types.hs-boot
- compiler/GHC/StgToByteCode.hs
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -841,19 +841,24 @@ assembleI platform i = case i of
W8 -> emit_ bci_OP_INDEX_ADDR_08 []
_ -> unsupported_width
- BRK_FUN tick_mod tickx info_mod infox ->
- do p1 <- ptr $ BCOPtrBreakArray tick_mod
- tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
- info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
- tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
- info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
- np <- lit1 $ BCONPtrCostCentre tick_mod $ fromIntegral tickx
- emit_ bci_BRK_FUN [ Op p1
- , Op tick_addr, Op info_addr
- , Op tick_unitid_addr, Op info_unitid_addr
- , SmallOp tickx, SmallOp infox
- , Op np
- ]
+ BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox) -> do
+ let -- cast that checks that round-tripping through Word16 doesn't change the value
+ toW16 x = let r = fromIntegral x :: Word16
+ in if fromIntegral r == x
+ then r
+ else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
+ p1 <- ptr $ BCOPtrBreakArray tick_mod
+ tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
+ info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
+ tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
+ info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
+ np <- lit1 $ BCONPtrCostCentre (BreakpointId tick_mod tickx)
+ emit_ bci_BRK_FUN [ Op p1
+ , Op tick_addr, Op info_addr
+ , Op tick_unitid_addr, Op info_unitid_addr
+ , SmallOp (toW16 tickx), SmallOp (toW16 infox)
+ , Op np
+ ]
BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp active]
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -17,7 +17,6 @@ import GHC.ByteCode.Types
import GHC.Cmm.Type (Width)
import GHC.StgToCmm.Layout ( ArgRep(..) )
import GHC.Utils.Outputable
-import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Literal
import GHC.Types.Unique
@@ -259,10 +258,7 @@ data BCInstr
-- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode
-- Breakpoints
- | BRK_FUN !Module -- breakpoint tick module
- !Word16 -- breakpoint tick index
- !Module -- breakpoint info module
- !Word16 -- breakpoint info index
+ | BRK_FUN !InternalBreakpointId
-- An internal breakpoint for triggering a break on any case alternative
-- See Note [Debugger: BRK_ALTS]
@@ -458,10 +454,10 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN _tick_mod tickx _info_mod infox)
+ ppr (BRK_FUN (InternalBreakpointId tick_mod tickx info_mod infox))
= text "BRK_FUN" <+> text "<breakarray>"
- <+> text "<tick_module>" <+> text "<tick_module_unitid>" <+> ppr tickx
- <+> text "<info_module>" <+> text "<info_module_unitid>" <+> ppr infox
+ <+> ppr tick_mod <+> ppr tickx
+ <+> ppr info_mod <+> ppr infox
<+> text "<cc>"
ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
#if MIN_VERSION_rts(1,0,3)
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -97,9 +97,9 @@ lookupLiteral interp pkgs_loaded le ptr = case ptr of
BCONPtrFFIInfo (FFIInfo {..}) -> do
RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
pure $ fromIntegral p
- BCONPtrCostCentre tick_mod tick_no
- | interpreterProfiled interp ->
- case expectJust (lookupModuleEnv (ccs_env le) tick_mod) ! tick_no of
+ BCONPtrCostCentre BreakpointId{..}
+ | interpreterProfiled interp -> do
+ case expectJust (lookupModuleEnv (ccs_env le) bi_tick_mod) ! bi_tick_index of
RemotePtr p -> pure $ fromIntegral p
| otherwise ->
case toRemotePtr nullPtr of
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -284,8 +284,8 @@ data BCONPtr
| BCONPtrFS !FastString
-- | A libffi ffi_cif function prototype.
| BCONPtrFFIInfo !FFIInfo
- -- | A 'CostCentre' remote pointer array's respective 'Module' and index
- | BCONPtrCostCentre !Module !BreakTickIndex
+ -- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
+ | BCONPtrCostCentre !BreakpointId
instance NFData BCONPtr where
rnf x = x `seq` ()
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -97,8 +97,8 @@ import GHC.Unit.Module.Deps
import Data.List (partition)
import Data.IORef
-import Data.Traversable (for)
import GHC.Iface.Make (mkRecompUsageInfo)
+import GHC.Runtime.Interpreter (interpreterProfiled)
{-
************************************************************************
@@ -162,13 +162,12 @@ deSugar hsc_env
mod mod_loc
export_set (typeEnvTyCons type_env) binds
else return (binds, Nothing)
- ; modBreaks <- for
- [ (i, s)
- | i <- hsc_interp hsc_env
- , (_, s) <- m_tickInfo
- , breakpointsAllowed dflags
- ]
- $ \(interp, specs) -> mkModBreaks interp mod specs
+ ; let modBreaks
+ | Just (_, specs) <- m_tickInfo
+ , breakpointsAllowed dflags
+ = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs
+ | otherwise
+ = Nothing
; ds_hpc_info <- case m_tickInfo of
Just (orig_file2, ticks)
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -33,14 +33,6 @@ import GHC.Unit.Module (Module)
import GHC.Utils.Outputable
import Data.List (intersperse)
-import GHCi.BreakArray (BreakArray)
-import GHCi.RemoteTypes (ForeignRef)
-
--- TODO: Break this cycle
-import {-# SOURCE #-} GHC.Runtime.Interpreter.Types (Interp, interpreterProfiled)
-import {-# SOURCE #-} qualified GHC.Runtime.Interpreter as GHCi (newBreakArray)
-import Data.Array.Base (numElements)
-
--------------------------------------------------------------------------------
-- ModBreaks
--------------------------------------------------------------------------------
@@ -58,10 +50,7 @@ import Data.Array.Base (numElements)
-- and 'modBreaks_decls'.
data ModBreaks
= ModBreaks
- { modBreaks_flags :: ForeignRef BreakArray
- -- ^ The array of flags, one per breakpoint,
- -- indicating which breakpoints are enabled.
- , modBreaks_locs :: !(Array BreakTickIndex SrcSpan)
+ { modBreaks_locs :: !(Array BreakTickIndex SrcSpan)
-- ^ An array giving the source span of each breakpoint.
, modBreaks_vars :: !(Array BreakTickIndex [OccName])
-- ^ An array giving the names of the free variables at each breakpoint.
@@ -83,40 +72,31 @@ data ModBreaks
-- generator needs to encode this information for each expression, the data is
-- allocated remotely in GHCi's address space and passed to the codegen as
-- foreign pointers.
-mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks
-mkModBreaks interp mod extendedMixEntries
- = do
- let count = fromIntegral $ sizeSS extendedMixEntries
+mkModBreaks :: Bool {-^ Whether the interpreter is profiled and thus if we should include store a CCS array -}
+ -> Module -> SizedSeq Tick -> ModBreaks
+mkModBreaks interpreterProfiled modl extendedMixEntries
+ = let count = fromIntegral $ sizeSS extendedMixEntries
entries = ssElts extendedMixEntries
- let
- locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
- varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
- declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
- ccs
- | interpreterProfiled interp =
- listArray
- (0, count - 1)
- [ ( concat $ intersperse "." $ tick_path t,
- renderWithContext defaultSDocContext $ ppr $ tick_loc t
- )
- | t <- entries
- ]
- | otherwise = listArray (0, -1) []
- hydrateModBreaks interp $
- ModBreaks
- { modBreaks_flags = undefined,
- modBreaks_locs = locsTicks,
- modBreaks_vars = varsTicks,
- modBreaks_decls = declsTicks,
- modBreaks_ccs = ccs,
- modBreaks_module = mod
- }
-
-hydrateModBreaks :: Interp -> ModBreaks -> IO ModBreaks
-hydrateModBreaks interp ModBreaks {..} = do
- let count = numElements modBreaks_locs
- modBreaks_flags <- GHCi.newBreakArray interp count
- pure ModBreaks {..}
+ locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
+ varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
+ declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
+ ccs
+ | interpreterProfiled =
+ listArray
+ (0, count - 1)
+ [ ( concat $ intersperse "." $ tick_path t,
+ renderWithContext defaultSDocContext $ ppr $ tick_loc t
+ )
+ | t <- entries
+ ]
+ | otherwise = listArray (0, -1) []
+ in ModBreaks
+ { modBreaks_locs = locsTicks
+ , modBreaks_vars = varsTicks
+ , modBreaks_decls = declsTicks
+ , modBreaks_ccs = ccs
+ , modBreaks_module = modl
+ }
{-
Note [Field modBreaks_decls]
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -28,6 +28,7 @@ module GHC.Linker.Loader
, extendLoadedEnv
, deleteFromLoadedEnv
-- * Internals
+ , allocateBreakArrays
, rmDupLinkables
, modifyLoaderState
, initLinkDepsOpts
@@ -122,8 +123,8 @@ import System.Win32.Info (getSystemDirectory)
import GHC.Utils.Exception
import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
import GHC.Driver.Downsweep
-
-
+import qualified GHC.Runtime.Interpreter as GHCi
+import Data.Array.Base (numElements)
-- Note [Linkers and loaders]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -696,16 +697,8 @@ loadDecls interp hsc_env span linkable = do
let le = linker_env pls
le2_itbl_env <- linkITbls interp (itbl_env le) (concat $ map bc_itbls cbcs)
le2_addr_env <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le) cbcs
- le2_breakarray_env <-
- allocateBreakArrays
- interp
- (catMaybes $ map bc_breaks cbcs)
- (breakarray_env le)
- le2_ccs_env <-
- allocateCCS
- interp
- (catMaybes $ map bc_breaks cbcs)
- (ccs_env le)
+ le2_breakarray_env <- allocateBreakArrays interp (breakarray_env le) (catMaybes $ map bc_breaks cbcs)
+ le2_ccs_env <- allocateCCS interp (ccs_env le) (catMaybes $ map bc_breaks cbcs)
let le2 = le { itbl_env = le2_itbl_env
, addr_env = le2_addr_env
, breakarray_env = le2_breakarray_env
@@ -933,12 +926,8 @@ dynLinkBCOs interp pls bcos = do
le1 = linker_env pls
ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs)
ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs
- be2 <-
- allocateBreakArrays
- interp
- (catMaybes $ map bc_breaks cbcs)
- (breakarray_env le1)
- ce2 <- allocateCCS interp (catMaybes $ map bc_breaks cbcs) (ccs_env le1)
+ be2 <- allocateBreakArrays interp (breakarray_env le1) (catMaybes $ map bc_breaks cbcs)
+ ce2 <- allocateCCS interp (ccs_env le1) (catMaybes $ map bc_breaks cbcs)
let le2 = le1 { itbl_env = ie2, addr_env = ae2, breakarray_env = be2, ccs_env = ce2 }
names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs
@@ -1656,30 +1645,31 @@ allocateTopStrings interp topStrings prev_env = do
where
mk_entry nm ptr = (nm, (nm, AddrPtr ptr))
--- | Given a list of 'ModBreaks' collected from a list of
--- 'CompiledByteCode', allocate the 'BreakArray'.
+-- | Given a list of 'InternalModBreaks' collected from a list of
+-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints.
allocateBreakArrays ::
Interp ->
- [InternalModBreaks] ->
ModuleEnv (ForeignRef BreakArray) ->
+ [InternalModBreaks] ->
IO (ModuleEnv (ForeignRef BreakArray))
-allocateBreakArrays _interp mbs be =
+allocateBreakArrays interp =
foldlM
- ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} ->
- evaluate $ extendModuleEnv be0 modBreaks_module modBreaks_flags
+ ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
+ -- If no BreakArray is assigned to this module yet, create one
+ let count = numElements modBreaks_locs
+ breakArray <- GHCi.newBreakArray interp count
+ evaluate $ extendModuleEnv be0 modBreaks_module breakArray
)
- be
- mbs
--- | Given a list of 'ModBreaks' collected from a list of
--- 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling
--- is enabled.
+-- | Given a list of 'InternalModBreaks' collected from a list
+-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
+-- enabled.
allocateCCS ::
Interp ->
- [InternalModBreaks] ->
ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
+ [InternalModBreaks] ->
IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
-allocateCCS interp mbs ce
+allocateCCS interp ce mbss
| interpreterProfiled interp =
foldlM
( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
@@ -1688,12 +1678,15 @@ allocateCCS interp mbs ce
interp
(moduleNameString $ moduleName modBreaks_module)
(elems modBreaks_ccs)
- evaluate $
- extendModuleEnv ce0 modBreaks_module $
- listArray
- (0, length ccs - 1)
- ccs
+ if not $ elemModuleEnv modBreaks_module ce0 then do
+ evaluate $
+ extendModuleEnv ce0 modBreaks_module $
+ listArray
+ (0, length ccs - 1)
+ ccs
+ else
+ return ce0
)
ce
- mbs
+ mbss
| otherwise = pure ce
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -64,6 +64,7 @@ import GHCi.RemoteTypes
import GHC.ByteCode.Types
import GHC.Linker.Loader as Loader
+import GHC.Linker.Types (LinkerEnv(..))
import GHC.Hs
@@ -126,6 +127,7 @@ import GHC.Tc.Utils.Instantiate (instDFunType)
import GHC.Tc.Utils.Monad
import GHC.IfaceToCore
+import GHC.ByteCode.Breakpoints
import Control.Monad
import Data.Dynamic
@@ -134,7 +136,7 @@ import Data.List (find,intercalate)
import Data.List.NonEmpty (NonEmpty)
import Unsafe.Coerce ( unsafeCoerce )
import qualified GHC.Unit.Home.Graph as HUG
-import GHC.ByteCode.Breakpoints
+import GHCi.BreakArray (BreakArray)
-- -----------------------------------------------------------------------------
-- running a statement interactively
@@ -348,13 +350,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
let ibi = evalBreakpointToId eval_break
let hug = hsc_HUG hsc_env
- tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
+ tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
+ breakArray <- getBreakArray interp (toBreakpointId ibi) tick_brks
let
span = getBreakLoc ibi tick_brks
decl = intercalate "." $ getBreakDecls ibi tick_brks
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
- bactive <- liftIO $ breakpointStatus interp (modBreaks_flags $ imodBreaks_modBreaks tick_brks) (ibi_tick_index ibi)
+ bactive <- liftIO $ breakpointStatus interp breakArray (ibi_info_index ibi)
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
@@ -462,9 +465,24 @@ setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #191
setupBreakpoint interp bi cnt = do
hug <- hsc_HUG <$> getSession
modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
- let breakarray = modBreaks_flags $ imodBreaks_modBreaks modBreaks
- _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt
- pure ()
+ breakArray <- getBreakArray interp bi modBreaks
+ liftIO $ GHCi.storeBreakpoint interp breakArray (bi_tick_index bi) cnt
+
+getBreakArray :: GhcMonad m => Interp -> BreakpointId -> InternalModBreaks -> m (ForeignRef BreakArray)
+getBreakArray interp BreakpointId{bi_tick_mod} imbs = do
+
+ liftIO $ modifyLoaderState interp $ \ld_st -> do
+ let le = linker_env ld_st
+
+ -- Recall that BreakArrays are allocated only at BCO link time, so if we
+ -- haven't linked the BCOs we intend to break at yet, we allocate the arrays here.
+ ba_env <- allocateBreakArrays interp (breakarray_env le) [imbs]
+
+ return
+ ( ld_st { linker_env = le{breakarray_env = ba_env} }
+ , expectJust {- just computed -} $
+ lookupModuleEnv ba_env bi_tick_mod
+ )
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
back n = moveHist (+n)
=====================================
compiler/GHC/Runtime/Interpreter.hs-boot deleted
=====================================
@@ -1,10 +0,0 @@
-module GHC.Runtime.Interpreter where
-
-import {-# SOURCE #-} GHC.Runtime.Interpreter.Types
-import Data.Int (Int)
-import GHC.Base (IO)
-import GHCi.BreakArray (BreakArray)
-import GHCi.RemoteTypes (ForeignRef)
-
-newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray)
-
=====================================
compiler/GHC/Runtime/Interpreter/Types.hs-boot deleted
=====================================
@@ -1,6 +0,0 @@
-module GHC.Runtime.Interpreter.Types where
-
-import Data.Bool
-
-data Interp
-interpreterProfiled :: Interp -> Bool
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -416,12 +416,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fv
let info_mod = modBreaks_module current_mod_breaks
infox <- newBreakInfo breakInfo
- let -- cast that checks that round-tripping through Word16 doesn't change the value
- toW16 x = let r = fromIntegral x :: Word16
- in if fromIntegral r == x
- then r
- else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- breakInstr = BRK_FUN tick_mod (toW16 tick_no) info_mod (toW16 infox)
+ let breakInstr = BRK_FUN (InternalBreakpointId tick_mod tick_no info_mod infox)
return $ breakInstr `consOL` code
schemeER_wrk d p rhs = schemeE d 0 p rhs
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13ad4e54bd28fa7e31c6e3bcee2658…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13ad4e54bd28fa7e31c6e3bcee2658…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/romes/step-out-10] 3 commits: cleanup: Use BreakpointIds in bytecode gen
by Rodrigo Mesquita (@alt-romes) 01 Jul '25
by Rodrigo Mesquita (@alt-romes) 01 Jul '25
01 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-10 at Glasgow Haskell Compiler / GHC
Commits:
5fcbe16a by Rodrigo Mesquita at 2025-07-01T17:22:38+01:00
cleanup: Use BreakpointIds in bytecode gen
Small clean up to use BreakpointId and InternalBreakpointId more
uniformly in bytecode generation rather than using Module + Ix pairs
- - - - -
3d02f5a3 by Rodrigo Mesquita at 2025-07-01T18:10:09+01:00
ghci: Allocate BreakArrays at link time only
Previously, a BreakArray would be allocated with a slot for every tick
in a module at `mkModBreaks`, in HsToCore. However, this approach has
a few downsides:
- It interleaves interpreter behaviour (allocating arrays for
breakpoints) within the desugarer
- It is inflexible in the sense it is impossible for the bytecode
generator to add "internal" breakpoints that can be triggered at
runtime, because those wouldn't have a source tick. (This is relevant
for our intended implementation plan of step-out in #26042)
- It ties the BreakArray indices to the *tick* indexes, while at runtime
we would rather just have the *info* indexes (currently we have both
because BreakArrays are indexed by the *tick* one).
Paving the way for #26042 and #26064, this commit moves the allocation
of BreakArrays to bytecode-loading time -- akin to what is done for CCS
arrays.
Since a BreakArray is allocated only when bytecode is linked, if a
breakpoint is set (e.g. `:break 10`) before the bytecode is linked,
there will exist no BreakArray to trigger the breakpoint in.
Therefore, the function to allocate break arrays (`allocateBreakArrays`)
is exposed and also used in GHC.Runtime.Eval to allocate a break array
when a breakpoint is set, if it doesn't exist yet (in the linker env).
- - - - -
5f9d327d by Rodrigo Mesquita at 2025-07-01T18:29:14+01:00
THE LAST PART
- - - - -
23 changed files:
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Interpreter.hs
- − compiler/GHC/Runtime/Interpreter.hs-boot
- − compiler/GHC/Runtime/Interpreter/Types.hs-boot
- compiler/GHC/StgToByteCode.hs
- ghc/GHCi/UI.hs
- libraries/ghci/GHCi/Debugger.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs
- rts/Disassembler.c
- rts/Exception.cmm
- rts/Interpreter.c
Changes:
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -841,19 +841,14 @@ assembleI platform i = case i of
W8 -> emit_ bci_OP_INDEX_ADDR_08 []
_ -> unsupported_width
- BRK_FUN tick_mod tickx info_mod infox ->
- do p1 <- ptr $ BCOPtrBreakArray tick_mod
- tick_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName tick_mod
- info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
- tick_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ tick_mod
- info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId $ info_mod
- np <- lit1 $ BCONPtrCostCentre tick_mod $ fromIntegral tickx
- emit_ bci_BRK_FUN [ Op p1
- , Op tick_addr, Op info_addr
- , Op tick_unitid_addr, Op info_unitid_addr
- , SmallOp tickx, SmallOp infox
- , Op np
- ]
+ BRK_FUN ibi@(InternalBreakpointId info_mod infox) -> do
+ p1 <- ptr $ BCOPtrBreakArray info_mod
+ info_addr <- lit1 $ BCONPtrFS $ moduleNameFS $ moduleName info_mod
+ info_unitid_addr <- lit1 $ BCONPtrFS $ unitIdFS $ moduleUnitId info_mod
+ info_wix <- int infox
+ np <- lit1 $ BCONPtrCostCentre ibi
+ emit_ bci_BRK_FUN [ Op p1, Op info_addr, Op info_unitid_addr
+ , Op info_wix, Op np ]
BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp active]
=====================================
compiler/GHC/ByteCode/Breakpoints.hs
=====================================
@@ -7,7 +7,7 @@
-- 'InternalModBreaks', and is uniquely identified at runtime by an
-- 'InternalBreakpointId'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.ByteCode.Breakpoints
( -- * Internal Mod Breaks
InternalModBreaks(..), CgBreakInfo(..)
@@ -17,7 +17,6 @@ module GHC.ByteCode.Breakpoints
, InternalBreakpointId(..), BreakInfoIndex
-- * Operations
- , toBreakpointId
-- ** Internal-level operations
, getInternalBreak, addInternalBreak
@@ -47,6 +46,31 @@ import GHC.Utils.Panic
import Data.Array
{-
+Note [ModBreaks vs InternalModBreaks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'ModBreaks' and 'BreakpointId's must not to be confused with
+'InternalModBreaks' and 'InternalBreakId's.
+
+'ModBreaks' is constructed once during HsToCore from the information attached
+to source-level breakpoint ticks and is never changed afterwards. A 'ModBreaks'
+can be queried using 'BreakpointId's, which uniquely identifies a breakpoint
+within the list of breakpoint information for a given module's 'ModBreaks'.
+
+'InternalModBreaks' are constructed during bytecode generation and are indexed
+by a 'InternalBreakpointId'. They contain all the information relevant to a
+breakpoint for code generation that can be accessed during runtime execution
+(such as a 'BreakArray' for triggering breakpoints). 'InternalBreakpointId's
+are used at runtime to trigger and inspect breakpoints -- a 'BRK_FUN'
+instruction receives 'InternalBreakpointId' as an argument.
+
+We keep a mapping from 'InternalModBreaks' to a 'BreakpointId', which can then be used
+to get source-level information about a breakpoint via the corresponding 'ModBreaks'.
+
+Notably, 'InternalModBreaks' can contain entries for so-called internal
+breakpoints, which do not necessarily have a source-level location attached to
+it (i.e. do not have a matching entry in 'ModBreaks'). We may leverage this to
+introduce breakpoints during code generation for features such as stepping-out.
+
Note [Breakpoint identifiers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Before optimization a breakpoint is identified uniquely with a tick module
@@ -64,6 +88,10 @@ So every breakpoint occurrence gets assigned a module-unique *info index* and
we store it alongside the occurrence module (*info module*) in the
'InternalBreakpointId' datatype. This is the index that we use at runtime to
identify a breakpoint.
+
+When the internal breakpoint has a matching tick-level breakpoint we can fetch
+the related tick-level information by first looking up a mapping
+@'InternalBreakpointId' -> 'BreakpointId'@. See `internalBreakIdToBreakId`
-}
--------------------------------------------------------------------------------
@@ -78,19 +106,11 @@ type BreakInfoIndex = Int
-- Indexes into the structures in the @'InternalModBreaks'@ produced during ByteCode generation.
-- See Note [Breakpoint identifiers]
data InternalBreakpointId = InternalBreakpointId
- { ibi_tick_mod :: !Module -- ^ Breakpoint tick module
- , ibi_tick_index :: !Int -- ^ Breakpoint tick index
- , ibi_info_mod :: !Module -- ^ Breakpoint tick module
+ { ibi_info_mod :: !Module -- ^ Breakpoint tick module
, ibi_info_index :: !BreakInfoIndex -- ^ Breakpoint tick index
}
deriving (Eq, Ord)
-toBreakpointId :: InternalBreakpointId -> BreakpointId
-toBreakpointId ibi = BreakpointId
- { bi_tick_mod = ibi_tick_mod ibi
- , bi_tick_index = ibi_tick_index ibi
- }
-
--------------------------------------------------------------------------------
-- * Internal Mod Breaks
--------------------------------------------------------------------------------
@@ -128,20 +148,23 @@ data CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint
, cgb_vars :: ![Maybe (IfaceIdBndr, Word)]
, cgb_resty :: !IfaceType
+ , cgb_tick_id :: !BreakpointId
+ -- ^ This field records the original breakpoint tick identifier for this
+ -- internal breakpoint info. See Note [Breakpoint identifiers].
}
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval
-- | Get an internal breakpoint info by 'InternalBreakpointId'
getInternalBreak :: InternalBreakpointId -> InternalModBreaks -> CgBreakInfo
-getInternalBreak (InternalBreakpointId _ _ info_mod info_ix) imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imodBreaks_breakInfo imbs IM.! info_ix
+getInternalBreak (InternalBreakpointId mod ix) imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imodBreaks_breakInfo imbs IM.! ix
-- | Add a CgBreakInfo to an 'InternalModBreaks' at 'InternalBreakpointId'
addInternalBreak :: InternalBreakpointId -> CgBreakInfo -> InternalModBreaks -> InternalModBreaks
-addInternalBreak (InternalBreakpointId _ _ info_mod info_ix) info imbs =
- assert_modules_match info_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $
- imbs{imodBreaks_breakInfo = IM.insert info_ix info (imodBreaks_breakInfo imbs)}
+addInternalBreak (InternalBreakpointId mod ix) info imbs =
+ assert_modules_match mod (imodBreaks_module imbs) $
+ imbs{imodBreaks_breakInfo = IM.insert ix info (imodBreaks_breakInfo imbs)}
-- | Assert that the module in the 'InternalBreakpointId' and in
-- 'InternalModBreaks' match.
@@ -156,26 +179,28 @@ assert_modules_match ibi_mod imbs_mod =
--------------------------------------------------------------------------------
-- | Get the source span for this breakpoint
-getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> SrcSpan
+getBreakLoc :: InternalBreakpointId -> InternalModBreaks -> Maybe SrcSpan
getBreakLoc = getBreakXXX modBreaks_locs
-- | Get the vars for this breakpoint
-getBreakVars :: InternalBreakpointId -> InternalModBreaks -> [OccName]
+getBreakVars :: InternalBreakpointId -> InternalModBreaks -> Maybe [OccName]
getBreakVars = getBreakXXX modBreaks_vars
-- | Get the decls for this breakpoint
-getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> [String]
+getBreakDecls :: InternalBreakpointId -> InternalModBreaks -> Maybe [String]
getBreakDecls = getBreakXXX modBreaks_decls
-- | Get the decls for this breakpoint
-getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> (String, String)
+getBreakCCS :: InternalBreakpointId -> InternalModBreaks -> Maybe (String, String)
getBreakCCS = getBreakXXX modBreaks_ccs
-- | Internal utility to access a ModBreaks field at a particular breakpoint index
-getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> a
-getBreakXXX view (InternalBreakpointId tick_mod tick_id _ _) imbs =
- assert_modules_match tick_mod (modBreaks_module $ imodBreaks_modBreaks imbs) $ do
- view (imodBreaks_modBreaks imbs) ! tick_id
+getBreakXXX :: (ModBreaks -> Array BreakTickIndex a) -> InternalBreakpointId -> InternalModBreaks -> Maybe a
+getBreakXXX view (InternalBreakpointId ibi_mod ibi_ix) imbs =
+ assert_modules_match ibi_mod (imodBreaks_module imbs) $ do
+ let cgb = imodBreaks_breakInfo imbs IM.! ibi_ix
+ mbs <- imodBreaks_modBreaks imbs
+ Just $ view mbs ! bi_tick_index (cgb_tick_id cgb)
--------------------------------------------------------------------------------
-- Instances
@@ -190,7 +215,8 @@ seqInternalModBreaks InternalModBreaks{..} =
seqCgBreakInfo CgBreakInfo{..} =
rnf cgb_tyvars `seq`
rnf cgb_vars `seq`
- rnf cgb_resty
+ rnf cgb_resty `seq`
+ rnf cgb_tick_id
instance Outputable InternalBreakpointId where
ppr InternalBreakpointId{..} =
@@ -203,4 +229,5 @@ instance NFData InternalBreakpointId where
instance Outputable CgBreakInfo where
ppr info = text "CgBreakInfo" <+>
parens (ppr (cgb_vars info) <+>
- ppr (cgb_resty info))
+ ppr (cgb_resty info) <+>
+ ppr (cgb_tick_id info))
=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -17,7 +17,6 @@ import GHC.ByteCode.Types
import GHC.Cmm.Type (Width)
import GHC.StgToCmm.Layout ( ArgRep(..) )
import GHC.Utils.Outputable
-import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Literal
import GHC.Types.Unique
@@ -259,10 +258,7 @@ data BCInstr
-- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode
-- Breakpoints
- | BRK_FUN !Module -- breakpoint tick module
- !Word16 -- breakpoint tick index
- !Module -- breakpoint info module
- !Word16 -- breakpoint info index
+ | BRK_FUN !InternalBreakpointId
-- An internal breakpoint for triggering a break on any case alternative
-- See Note [Debugger: BRK_ALTS]
@@ -458,10 +454,9 @@ instance Outputable BCInstr where
ppr ENTER = text "ENTER"
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (RETURN_TUPLE) = text "RETURN_TUPLE"
- ppr (BRK_FUN _tick_mod tickx _info_mod infox)
+ ppr (BRK_FUN (InternalBreakpointId info_mod infox))
= text "BRK_FUN" <+> text "<breakarray>"
- <+> text "<tick_module>" <+> text "<tick_module_unitid>" <+> ppr tickx
- <+> text "<info_module>" <+> text "<info_module_unitid>" <+> ppr infox
+ <+> ppr info_mod <+> ppr infox
<+> text "<cc>"
ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active
#if MIN_VERSION_rts(1,0,3)
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -97,9 +97,9 @@ lookupLiteral interp pkgs_loaded le ptr = case ptr of
BCONPtrFFIInfo (FFIInfo {..}) -> do
RemotePtr p <- interpCmd interp $ PrepFFI ffiInfoArgs ffiInfoRet
pure $ fromIntegral p
- BCONPtrCostCentre tick_mod tick_no
- | interpreterProfiled interp ->
- case expectJust (lookupModuleEnv (ccs_env le) tick_mod) ! tick_no of
+ BCONPtrCostCentre InternalBreakpointId{..}
+ | interpreterProfiled interp -> do
+ case expectJust (lookupModuleEnv (ccs_env le) ibi_info_mod) ! ibi_info_index of
RemotePtr p -> pure $ fromIntegral p
| otherwise ->
case toRemotePtr nullPtr of
=====================================
compiler/GHC/ByteCode/Types.hs
=====================================
@@ -284,8 +284,8 @@ data BCONPtr
| BCONPtrFS !FastString
-- | A libffi ffi_cif function prototype.
| BCONPtrFFIInfo !FFIInfo
- -- | A 'CostCentre' remote pointer array's respective 'Module' and index
- | BCONPtrCostCentre !Module !BreakTickIndex
+ -- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
+ | BCONPtrCostCentre !BreakpointId
instance NFData BCONPtr where
rnf x = x `seq` ()
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -704,12 +704,13 @@ toIfaceLFInfo nm lfi = case lfi of
-- Dehydrating CgBreakInfo
-dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo
-dehydrateCgBreakInfo ty_vars idOffSets tick_ty =
+dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> BreakpointId -> CgBreakInfo
+dehydrateCgBreakInfo ty_vars idOffSets tick_ty bid =
CgBreakInfo
{ cgb_tyvars = map toIfaceTvBndr ty_vars
, cgb_vars = map (fmap (\(i, offset) -> (toIfaceIdBndr i, offset))) idOffSets
, cgb_resty = toIfaceType tick_ty
+ , cgb_tick_id = bid
}
{- Note [Inlining and hs-boot files]
=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -97,8 +97,8 @@ import GHC.Unit.Module.Deps
import Data.List (partition)
import Data.IORef
-import Data.Traversable (for)
import GHC.Iface.Make (mkRecompUsageInfo)
+import GHC.Runtime.Interpreter (interpreterProfiled)
{-
************************************************************************
@@ -162,13 +162,12 @@ deSugar hsc_env
mod mod_loc
export_set (typeEnvTyCons type_env) binds
else return (binds, Nothing)
- ; modBreaks <- for
- [ (i, s)
- | i <- hsc_interp hsc_env
- , (_, s) <- m_tickInfo
- , breakpointsAllowed dflags
- ]
- $ \(interp, specs) -> mkModBreaks interp mod specs
+ ; let modBreaks
+ | Just (_, specs) <- m_tickInfo
+ , breakpointsAllowed dflags
+ = Just $ mkModBreaks (interpreterProfiled $ hscInterp hsc_env) mod specs
+ | otherwise
+ = Nothing
; ds_hpc_info <- case m_tickInfo of
Just (orig_file2, ticks)
=====================================
compiler/GHC/HsToCore/Breakpoints.hs
=====================================
@@ -12,7 +12,7 @@
-- 'InternalModBreaks' and 'InternalBreakId's. The latter are constructed
-- during bytecode generation and can be found in 'GHC.ByteCode.Breakpoints'.
--
--- See Note [Breakpoint identifiers]
+-- See Note [ModBreaks vs InternalModBreaks] and Note [Breakpoint identifiers]
module GHC.HsToCore.Breakpoints
( -- * ModBreaks
mkModBreaks, ModBreaks(..)
@@ -33,14 +33,6 @@ import GHC.Unit.Module (Module)
import GHC.Utils.Outputable
import Data.List (intersperse)
-import GHCi.BreakArray (BreakArray)
-import GHCi.RemoteTypes (ForeignRef)
-
--- TODO: Break this cycle
-import {-# SOURCE #-} GHC.Runtime.Interpreter.Types (Interp, interpreterProfiled)
-import {-# SOURCE #-} qualified GHC.Runtime.Interpreter as GHCi (newBreakArray)
-import Data.Array.Base (numElements)
-
--------------------------------------------------------------------------------
-- ModBreaks
--------------------------------------------------------------------------------
@@ -58,10 +50,7 @@ import Data.Array.Base (numElements)
-- and 'modBreaks_decls'.
data ModBreaks
= ModBreaks
- { modBreaks_flags :: ForeignRef BreakArray
- -- ^ The array of flags, one per breakpoint,
- -- indicating which breakpoints are enabled.
- , modBreaks_locs :: !(Array BreakTickIndex SrcSpan)
+ { modBreaks_locs :: !(Array BreakTickIndex SrcSpan)
-- ^ An array giving the source span of each breakpoint.
, modBreaks_vars :: !(Array BreakTickIndex [OccName])
-- ^ An array giving the names of the free variables at each breakpoint.
@@ -83,40 +72,31 @@ data ModBreaks
-- generator needs to encode this information for each expression, the data is
-- allocated remotely in GHCi's address space and passed to the codegen as
-- foreign pointers.
-mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks
-mkModBreaks interp mod extendedMixEntries
- = do
- let count = fromIntegral $ sizeSS extendedMixEntries
+mkModBreaks :: Bool {-^ Whether the interpreter is profiled and thus if we should include store a CCS array -}
+ -> Module -> SizedSeq Tick -> ModBreaks
+mkModBreaks interpreterProfiled modl extendedMixEntries
+ = let count = fromIntegral $ sizeSS extendedMixEntries
entries = ssElts extendedMixEntries
- let
- locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
- varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
- declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
- ccs
- | interpreterProfiled interp =
- listArray
- (0, count - 1)
- [ ( concat $ intersperse "." $ tick_path t,
- renderWithContext defaultSDocContext $ ppr $ tick_loc t
- )
- | t <- entries
- ]
- | otherwise = listArray (0, -1) []
- hydrateModBreaks interp $
- ModBreaks
- { modBreaks_flags = undefined,
- modBreaks_locs = locsTicks,
- modBreaks_vars = varsTicks,
- modBreaks_decls = declsTicks,
- modBreaks_ccs = ccs,
- modBreaks_module = mod
- }
-
-hydrateModBreaks :: Interp -> ModBreaks -> IO ModBreaks
-hydrateModBreaks interp ModBreaks {..} = do
- let count = numElements modBreaks_locs
- modBreaks_flags <- GHCi.newBreakArray interp count
- pure ModBreaks {..}
+ locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
+ varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
+ declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
+ ccs
+ | interpreterProfiled =
+ listArray
+ (0, count - 1)
+ [ ( concat $ intersperse "." $ tick_path t,
+ renderWithContext defaultSDocContext $ ppr $ tick_loc t
+ )
+ | t <- entries
+ ]
+ | otherwise = listArray (0, -1) []
+ in ModBreaks
+ { modBreaks_locs = locsTicks
+ , modBreaks_vars = varsTicks
+ , modBreaks_decls = declsTicks
+ , modBreaks_ccs = ccs
+ , modBreaks_module = modl
+ }
{-
Note [Field modBreaks_decls]
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -28,6 +28,7 @@ module GHC.Linker.Loader
, extendLoadedEnv
, deleteFromLoadedEnv
-- * Internals
+ , allocateBreakArrays
, rmDupLinkables
, modifyLoaderState
, initLinkDepsOpts
@@ -122,6 +123,11 @@ import System.Win32.Info (getSystemDirectory)
import GHC.Utils.Exception
import GHC.Unit.Home.Graph (lookupHug, unitEnv_foldWithKey)
import GHC.Driver.Downsweep
+import GHC.HsToCore.Breakpoints
+import qualified Data.IntMap.Strict as IM
+import qualified GHC.Runtime.Interpreter as GHCi
+import GHC.Data.Maybe (expectJust)
+import Foreign.Ptr (nullPtr)
@@ -699,13 +705,13 @@ loadDecls interp hsc_env span linkable = do
le2_breakarray_env <-
allocateBreakArrays
interp
- (catMaybes $ map bc_breaks cbcs)
(breakarray_env le)
+ (map bc_breaks cbcs)
le2_ccs_env <-
allocateCCS
interp
- (catMaybes $ map bc_breaks cbcs)
(ccs_env le)
+ (map bc_breaks cbcs)
let le2 = le { itbl_env = le2_itbl_env
, addr_env = le2_addr_env
, breakarray_env = le2_breakarray_env
@@ -933,12 +939,8 @@ dynLinkBCOs interp pls bcos = do
le1 = linker_env pls
ie2 <- linkITbls interp (itbl_env le1) (concatMap bc_itbls cbcs)
ae2 <- foldlM (\env cbc -> allocateTopStrings interp (bc_strs cbc) env) (addr_env le1) cbcs
- be2 <-
- allocateBreakArrays
- interp
- (catMaybes $ map bc_breaks cbcs)
- (breakarray_env le1)
- ce2 <- allocateCCS interp (catMaybes $ map bc_breaks cbcs) (ccs_env le1)
+ be2 <- allocateBreakArrays interp (breakarray_env le1) (map bc_breaks cbcs)
+ ce2 <- allocateCCS interp (ccs_env le1) (map bc_breaks cbcs)
let le2 = le1 { itbl_env = ie2, addr_env = ae2, breakarray_env = be2, ccs_env = ce2 }
names_and_refs <- linkSomeBCOs interp (pkgs_loaded pls) le2 cbcs
@@ -1656,44 +1658,80 @@ allocateTopStrings interp topStrings prev_env = do
where
mk_entry nm ptr = (nm, (nm, AddrPtr ptr))
--- | Given a list of 'ModBreaks' collected from a list of
--- 'CompiledByteCode', allocate the 'BreakArray'.
+-- | Given a list of 'InternalModBreaks and 'ModBreaks' collected from a list of
+-- 'CompiledByteCode', allocate the 'BreakArray' used to trigger breakpoints.
allocateBreakArrays ::
Interp ->
- [InternalModBreaks] ->
ModuleEnv (ForeignRef BreakArray) ->
+ [InternalModBreaks] ->
IO (ModuleEnv (ForeignRef BreakArray))
-allocateBreakArrays _interp mbs be =
+allocateBreakArrays interp =
foldlM
- ( \be0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} ->
- evaluate $ extendModuleEnv be0 modBreaks_module modBreaks_flags
+ ( \be0 imbs -> do
+ let bi = imodBreaks_breakInfo imbs
+ hi = maybe 0 fst (IM.lookupMax bi) -- allocate as many slots as internal breakpoints
+ if not $ elemModuleEnv (imodBreaks_module imbs) be0 then do
+ -- If no BreakArray is assigned to this module yet, create one
+ breakArray <- GHCi.newBreakArray interp hi
+ evaluate $ extendModuleEnv be0 (imodBreaks_module imbs) breakArray
+ else
+ return be0
)
- be
- mbs
--- | Given a list of 'ModBreaks' collected from a list of
--- 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling
--- is enabled.
+-- | Given a list of 'InternalModBreaks' and 'ModBreaks' collected from a list
+-- of 'CompiledByteCode', allocate the 'CostCentre' arrays when profiling is
+-- enabled.
+--
+-- Note that the resulting CostCenter is indexed by the 'InternalBreakpointId',
+-- not by 'BreakpointId'. At runtime, BRK_FUN instructions are annotated with
+-- internal ids -- we'll look them up in the array and push the corresponding
+-- cost center.
allocateCCS ::
Interp ->
- [InternalModBreaks] ->
ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)) ->
+ [InternalModBreaks] ->
IO (ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre)))
-allocateCCS interp mbs ce
- | interpreterProfiled interp =
+allocateCCS interp ce mbss
+ | interpreterProfiled interp = do
+ -- First construct the CCSs for each module, using the 'ModBreaks'
+ ccs_map <- foldlM
+ ( \(ccs_map :: ModuleEnv (Array BreakTickIndex (RemotePtr CostCentre))) imbs -> do
+ case imodBreaks_modBreaks imbs of
+ Nothing -> return ccs_map -- don't add it
+ Just mbs -> do
+ ccs <-
+ mkCostCentres
+ interp
+ (moduleNameString $ moduleName $ modBreaks_module mbs)
+ (elems $ modBreaks_ccs mbs)
+ evaluate $
+ extendModuleEnv ccs_map (modBreaks_module mbs) $
+ listArray (0, length ccs - 1) ccs
+ ) emptyModuleEnv mbss
+ -- Now, construct an array indexed by an 'InternalBreakpointId' index by first
+ -- finding the matching 'BreakpointId' and then looking it up in the ccs_map
foldlM
- ( \ce0 InternalModBreaks{imodBreaks_modBreaks=ModBreaks {..}} -> do
- ccs <-
- mkCostCentres
- interp
- (moduleNameString $ moduleName modBreaks_module)
- (elems modBreaks_ccs)
+ ( \ce0 imbs -> do
+ let breakModl = imodBreaks_module imbs
+ breakInfoMap = imodBreaks_breakInfo imbs
+ hi = maybe 0 fst (IM.lookupMax breakInfoMap) -- as many slots as internal breaks
+ ccss = expectJust $ lookupModuleEnv ccs_map breakModl
+ ccs_im <- foldlM
+ (\(bids :: IM.IntMap (RemotePtr CostCentre)) cgi -> do
+ let tickBreakId = bi_tick_index $ cgb_tick_id cgi
+ pure $ IM.insert tickBreakId (ccss ! tickBreakId) bids
+ ) mempty breakInfoMap
+ if not $ elemModuleEnv breakModl ce0 then do
evaluate $
- extendModuleEnv ce0 modBreaks_module $
- listArray
- (0, length ccs - 1)
- ccs
+ extendModuleEnv ce0 breakModl $
+ listArray (0, hi-1) $
+ map (\i -> case IM.lookup i ccs_im of
+ Nothing -> toRemotePtr nullPtr
+ Just ccs -> ccs
+ ) [0..hi-1]
+ else
+ return ce0
)
ce
- mbs
+ mbss
| otherwise = pure ce
=====================================
compiler/GHC/Linker/Types.hs
=====================================
@@ -72,6 +72,7 @@ import GHC.Unit.Module.WholeCoreBindings
import Data.Maybe (mapMaybe)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import qualified Data.List.NonEmpty as NE
+import GHC.HsToCore.Breakpoints (BreakTickIndex)
{- **********************************************************************
=====================================
compiler/GHC/Runtime/Debugger/Breakpoints.hs
=====================================
@@ -197,7 +197,7 @@ type TickArray = Array Int [(BreakTickIndex,RealSrcSpan)]
makeModuleLineMap :: GhcMonad m => Module -> m (Maybe TickArray)
makeModuleLineMap m = do
mi <- getModuleInfo m
- return $ mkTickArray . assocs . modBreaks_locs . imodBreaks_modBreaks <$> (modInfoModBreaks =<< mi)
+ return $ mkTickArray . assocs . modBreaks_locs <$> (imodBreaks_modBreaks =<< modInfoModBreaks =<< mi)
where
mkTickArray :: [(BreakTickIndex, SrcSpan)] -> TickArray
mkTickArray ticks
@@ -211,7 +211,7 @@ makeModuleLineMap m = do
getModBreak :: GhcMonad m => Module -> m (Maybe ModBreaks)
getModBreak m = do
mod_info <- fromMaybe (panic "getModBreak") <$> getModuleInfo m
- pure $ imodBreaks_modBreaks <$> modInfoModBreaks mod_info
+ pure $ imodBreaks_modBreaks =<< modInfoModBreaks mod_info
--------------------------------------------------------------------------------
-- Getting current breakpoint information
@@ -238,6 +238,6 @@ getCurrentBreakModule = do
return $ case resumes of
[] -> Nothing
(r:_) -> case resumeHistoryIx r of
- 0 -> ibi_tick_mod <$> resumeBreakpointId r
+ 0 -> ibi_info_mod <$> resumeBreakpointId r
ix -> Just $ getHistoryModule $ resumeHistory r !! (ix-1)
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -64,6 +64,7 @@ import GHCi.RemoteTypes
import GHC.ByteCode.Types
import GHC.Linker.Loader as Loader
+import GHC.Linker.Types (LinkerEnv(..))
import GHC.Hs
@@ -126,6 +127,7 @@ import GHC.Tc.Utils.Instantiate (instDFunType)
import GHC.Tc.Utils.Monad
import GHC.IfaceToCore
+import GHC.ByteCode.Breakpoints
import Control.Monad
import Data.Dynamic
@@ -134,7 +136,7 @@ import Data.List (find,intercalate)
import Data.List.NonEmpty (NonEmpty)
import Unsafe.Coerce ( unsafeCoerce )
import qualified GHC.Unit.Home.Graph as HUG
-import GHC.ByteCode.Breakpoints
+import GHCi.BreakArray (BreakArray)
-- -----------------------------------------------------------------------------
-- running a statement interactively
@@ -146,13 +148,13 @@ mkHistory :: HUG.HomeUnitGraph -> ForeignHValue -> InternalBreakpointId -> IO Hi
mkHistory hug hval ibi = History hval ibi <$> findEnclosingDecls hug ibi
getHistoryModule :: History -> Module
-getHistoryModule = ibi_tick_mod . historyBreakpointId
+getHistoryModule = ibi_info_mod . historyBreakpointId
getHistorySpan :: HUG.HomeUnitGraph -> History -> IO SrcSpan
getHistorySpan hug hist = do
let ibi = historyBreakpointId hist
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ brks <- expectJust <$> readModBreaks hug ibi
+ return $ expectJust $ getBreakLoc ibi brks
{- | Finds the enclosing top level function name -}
-- ToDo: a better way to do this would be to keep hold of the decl_path computed
@@ -160,8 +162,10 @@ getHistorySpan hug hist = do
-- for each tick.
findEnclosingDecls :: HUG.HomeUnitGraph -> InternalBreakpointId -> IO [String]
findEnclosingDecls hug ibi = do
- brks <- readModBreaks hug (ibi_tick_mod ibi)
- return $ getBreakDecls ibi brks
+ readModBreaks hug ibi >>= \case
+ Nothing -> return []
+ Just brks -> return $
+ fromMaybe [] (getBreakDecls ibi brks)
-- | Update fixity environment in the current interactive context.
updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
@@ -346,15 +350,17 @@ handleRunStatus step expr bindings final_ids status history0 = do
-- - the breakpoint was explicitly enabled (in @BreakArray@)
-- - or one of the stepping options in @EvalOpts@ caused us to stop at one
EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
- let ibi = evalBreakpointToId eval_break
let hug = hsc_HUG hsc_env
- tick_brks <- liftIO $ readModBreaks hug (ibi_tick_mod ibi)
+ let ibi@InternalBreakpointId{ibi_info_index}
+ = evalBreakpointToId eval_break
+ brks <- liftIO $ readModBreaks hug ibi
+ breakArray <- getBreakArray interp ibi (expectJust brks)
let
- span = getBreakLoc ibi tick_brks
- decl = intercalate "." $ getBreakDecls ibi tick_brks
+ span = fromMaybe noSrcSpan $ getBreakLoc ibi =<< brks
+ decl = intercalate "." $ fromMaybe [] $ getBreakDecls ibi =<< brks
-- Was this breakpoint explicitly enabled (ie. in @BreakArray@)?
- bactive <- liftIO $ breakpointStatus interp (modBreaks_flags $ imodBreaks_modBreaks tick_brks) (ibi_tick_index ibi)
+ bactive <- liftIO $ breakpointStatus interp breakArray ibi_info_index
apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
@@ -442,7 +448,8 @@ resumeExec step mbCnt
-- When the user specified a break ignore count, set it
-- in the interpreter
case (mb_brkpt, mbCnt) of
- (Just brkpt, Just cnt) -> setupBreakpoint interp (toBreakpointId brkpt) cnt
+ (Just ibi, Just cnt) ->
+ setupBreakpoint interp ibi cnt
_ -> return ()
let eval_opts = initEvalOpts dflags (enableGhcStepMode step)
@@ -451,20 +458,35 @@ resumeExec step mbCnt
hug = hsc_HUG hsc_env
hist' = case mb_brkpt of
Nothing -> pure prevHistoryLst
- Just bi
+ Just ibi
| breakHere False step span -> do
- hist1 <- liftIO (mkHistory hug apStack bi)
+ hist1 <- liftIO (mkHistory hug apStack ibi)
return $ hist1 `consBL` fromListBL 50 hist
| otherwise -> pure prevHistoryLst
handleRunStatus step expr bindings final_ids status =<< hist'
-setupBreakpoint :: GhcMonad m => Interp -> BreakpointId -> Int -> m () -- #19157
-setupBreakpoint interp bi cnt = do
+setupBreakpoint :: GhcMonad m => Interp -> InternalBreakpointId -> Int -> m () -- #19157
+setupBreakpoint interp ibi cnt = do
hug <- hsc_HUG <$> getSession
- modBreaks <- liftIO $ readModBreaks hug (bi_tick_mod bi)
- let breakarray = modBreaks_flags $ imodBreaks_modBreaks modBreaks
- _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt
- pure ()
+ ims <- liftIO $ readModBreaks hug ibi
+ breakArray <- getBreakArray interp ibi (expectJust ims)
+ liftIO $ GHCi.storeBreakpoint interp breakArray (ibi_info_index ibi) cnt
+
+getBreakArray :: GhcMonad m => Interp -> InternalBreakpointId -> InternalModBreaks -> m (ForeignRef BreakArray)
+getBreakArray interp InternalBreakpointId{ibi_info_mod} imbs = do
+
+ liftIO $ modifyLoaderState interp $ \ld_st -> do
+ let le = linker_env ld_st
+
+ -- Recall that BreakArrays are allocated only at BCO link time, so if we
+ -- haven't linked the BCOs we intend to break at yet, we allocate the arrays here.
+ ba_env <- allocateBreakArrays interp (breakarray_env le) [imbs]
+
+ return
+ ( ld_st { linker_env = le{breakarray_env = ba_env} }
+ , expectJust {- just computed -} $
+ lookupModuleEnv ba_env ibi_info_mod
+ )
back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan)
back n = moveHist (+n)
@@ -493,8 +515,8 @@ moveHist fn = do
span <- case mb_info of
Nothing -> return $ mkGeneralSrcSpan (fsLit "<unknown>")
Just ibi -> liftIO $ do
- brks <- readModBreaks (hsc_HUG hsc_env) (ibi_tick_mod ibi)
- return $ getBreakLoc ibi brks
+ brks <- readModBreaks (hsc_HUG hsc_env) ibi
+ return $ fromMaybe noSrcSpan $ getBreakLoc ibi =<< brks
(hsc_env1, names) <-
liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info
let ic = hsc_IC hsc_env1
@@ -555,11 +577,10 @@ bindLocalsAtBreakpoint hsc_env apStack span Nothing = do
-- of the breakpoint and the free variables of the expression.
bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do
let hug = hsc_HUG hsc_env
- info_brks <- readModBreaks hug (ibi_info_mod ibi)
- tick_brks <- readModBreaks hug (ibi_tick_mod ibi)
- let info = getInternalBreak ibi (info_brks)
+ info_brks <- readModBreaks hug ibi
+ let info = getInternalBreak ibi (expectJust info_brks)
interp = hscInterp hsc_env
- occs = getBreakVars ibi tick_brks
+ occs = fromMaybe [] $ getBreakVars ibi =<< info_brks
-- Rehydrate to understand the breakpoint info relative to the current environment.
-- This design is critical to preventing leaks (#22530)
@@ -699,6 +720,7 @@ pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
{-
Note [Syncing breakpoint info]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+ ROMES:TODO: Update
To display the values of the free variables for a single breakpoint, the
function `GHC.Runtime.Eval.bindLocalsAtBreakpoint` pulls
out the information from the fields `modBreaks_breakInfo` and
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -107,7 +107,6 @@ import Data.Binary
import Data.ByteString (ByteString)
import Foreign hiding (void)
import qualified GHC.Exts.Heap as Heap
-import GHC.Stack.CCS (CostCentre,CostCentreStack)
import System.Directory
import System.Process
import qualified GHC.InfoProv as InfoProv
@@ -411,15 +410,10 @@ evalBreakpointToId :: EvalBreakpoint -> InternalBreakpointId
evalBreakpointToId eval_break =
let
mkUnitId u = fsToUnit $ mkFastStringShortByteString u
-
toModule u n = mkModule (mkUnitId u) (mkModuleName n)
- tickl = toModule (eb_tick_mod_unit eval_break) (eb_tick_mod eval_break)
- infol = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
in
InternalBreakpointId
- { ibi_tick_mod = tickl
- , ibi_tick_index = eb_tick_index eval_break
- , ibi_info_mod = infol
+ { ibi_info_mod = toModule (eb_info_mod_unit eval_break) (eb_info_mod eval_break)
, ibi_info_index = eb_info_index eval_break
}
@@ -440,17 +434,17 @@ handleSeqHValueStatus interp unit_env eval_status =
-- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
Just break -> do
- let bi = evalBreakpointToId break
+ let ibi = evalBreakpointToId break
+ hug = ue_home_unit_graph unit_env
-- Just case: Stopped at a breakpoint, extract SrcSpan information
-- from the breakpoint.
- mb_modbreaks <- getModBreaks . expectJust <$>
- lookupHugByModule (ibi_tick_mod bi) (ue_home_unit_graph unit_env)
+ mb_modbreaks <- readModBreaks hug ibi
case mb_modbreaks of
-- Nothing case - should not occur! We should have the appropriate
-- breakpoint information
Nothing -> nothing_case
- Just modbreaks -> put $ brackets . ppr $ getBreakLoc bi modbreaks
+ Just modbreaks -> put $ brackets . ppr $ getBreakLoc ibi modbreaks
-- resume the seq (:force) processing in the iserv process
withForeignRef resume_ctxt_fhv $ \hval -> do
@@ -741,14 +735,14 @@ getModBreaks hmi
| Just linkable <- homeModInfoByteCode hmi,
-- The linkable may have 'DotO's as well; only consider BCOs. See #20570.
[cbc] <- linkableBCOs linkable
- = bc_breaks cbc
+ = Just $ bc_breaks cbc
| otherwise
= Nothing -- probably object code
-- | Read the 'InternalModBreaks' and 'ModBreaks' of the given home 'Module'
-- from the 'HomeUnitGraph'.
-readModBreaks :: HomeUnitGraph -> Module -> IO InternalModBreaks
-readModBreaks hug modl = expectJust . getModBreaks . expectJust <$> HUG.lookupHugByModule modl hug
+readModBreaks :: HasCallStack => HomeUnitGraph -> InternalBreakpointId -> IO (Maybe InternalModBreaks)
+readModBreaks hug ibi = getModBreaks . expectJust <$> HUG.lookupHugByModule (ibi_info_mod ibi) hug
-- -----------------------------------------------------------------------------
-- Misc utils
=====================================
compiler/GHC/Runtime/Interpreter.hs-boot deleted
=====================================
@@ -1,10 +0,0 @@
-module GHC.Runtime.Interpreter where
-
-import {-# SOURCE #-} GHC.Runtime.Interpreter.Types
-import Data.Int (Int)
-import GHC.Base (IO)
-import GHCi.BreakArray (BreakArray)
-import GHCi.RemoteTypes (ForeignRef)
-
-newBreakArray :: Interp -> Int -> IO (ForeignRef BreakArray)
-
=====================================
compiler/GHC/Runtime/Interpreter/Types.hs-boot deleted
=====================================
@@ -1,6 +0,0 @@
-module GHC.Runtime.Interpreter.Types where
-
-import Data.Bool
-
-data Interp
-interpreterProfiled :: Interp -> Bool
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -134,10 +134,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks spt_entries
"Proto-BCOs" FormatByteCode
(vcat (intersperse (char ' ') (map ppr $ elemsFlatBag proto_bcos)))
- let mod_breaks = case mb_modBreaks of
- Nothing -> Nothing
- Just mb -> Just $ mkInternalModBreaks this_mod breakInfo mb
- cbc <- assembleBCOs profile proto_bcos tycs strings mod_breaks spt_entries
+ cbc <- assembleBCOs profile proto_bcos tycs strings internalBreaks spt_entries
-- Squash space leaks in the CompiledByteCode. This is really
-- important, because when loading a set of modules into GHCi
@@ -394,69 +391,22 @@ schemeR_wrk fvs nm original_body (args, body)
-- | Introduce break instructions for ticked expressions.
-- If no breakpoint information is available, the instruction is omitted.
schemeER_wrk :: StackDepth -> BCEnv -> CgStgExpr -> BcM BCInstrList
-schemeER_wrk d p (StgTick (Breakpoint tick_ty (BreakpointId tick_mod tick_no) fvs) rhs) = do
+schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_id fvs) rhs) = do
code <- schemeE d 0 p rhs
- hsc_env <- getHscEnv
- current_mod <- getCurrentModule
- mb_current_mod_breaks <- getCurrentModBreaks
- case mb_current_mod_breaks of
- -- if we're not generating ModBreaks for this module for some reason, we
- -- can't store breakpoint occurrence information.
- Nothing -> pure code
- Just current_mod_breaks -> break_info hsc_env tick_mod current_mod mb_current_mod_breaks >>= \case
- Nothing -> pure code
- Just ModBreaks{modBreaks_module = tick_mod} -> do
- platform <- profilePlatform <$> getProfile
- let idOffSets = getVarOffSets platform d p fvs
- ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
- toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
- toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
- breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty
-
- let info_mod = modBreaks_module current_mod_breaks
- infox <- newBreakInfo breakInfo
-
- let -- cast that checks that round-tripping through Word16 doesn't change the value
- toW16 x = let r = fromIntegral x :: Word16
- in if fromIntegral r == x
- then r
- else pprPanic "schemeER_wrk: breakpoint tick/info index too large!" (ppr x)
- breakInstr = BRK_FUN tick_mod (toW16 tick_no) info_mod (toW16 infox)
- return $ breakInstr `consOL` code
-schemeER_wrk d p rhs = schemeE d 0 p rhs
+ platform <- profilePlatform <$> getProfile
+ let idOffSets = getVarOffSets platform d p fvs
+ ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs)
+ toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word)
+ toWord = fmap (\(i, wo) -> (i, fromIntegral wo))
+ breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty tick_id
+
+ -- TODO: Lookup tick_id in InternalBreakMods and if it returns Nothing then
+ -- we don't have Breakpoint information for this Breakpoint so might as well
+ -- not emit the instruction.
+ ibi <- newBreakInfo breakInfo
+ return $ BRK_FUN ibi `consOL` code
--- | Determine the GHCi-allocated 'BreakArray' and module pointer for the module
--- from which the breakpoint originates.
--- These are stored in 'ModBreaks' as remote pointers in order to allow the BCOs
--- to refer to pointers in GHCi's address space.
--- They are initialized in 'GHC.HsToCore.Breakpoints.mkModBreaks', called by
--- 'GHC.HsToCore.deSugar'.
---
--- Breakpoints might be disabled because we're in TH, because
--- @-fno-break-points@ was specified, or because a module was reloaded without
--- reinitializing 'ModBreaks'.
---
--- If the module stored in the breakpoint is the currently processed module, use
--- the 'ModBreaks' from the state.
--- If that is 'Nothing', consider breakpoints to be disabled and skip the
--- instruction.
---
--- If the breakpoint is inlined from another module, look it up in the HUG (home unit graph).
--- If the module doesn't exist there, or if the 'ModBreaks' value is
--- uninitialized, skip the instruction (i.e. return Nothing).
-break_info ::
- HscEnv ->
- Module ->
- Module ->
- Maybe ModBreaks ->
- BcM (Maybe ModBreaks)
-break_info hsc_env mod current_mod current_mod_breaks
- | mod == current_mod
- = pure current_mod_breaks
- | otherwise
- = liftIO (HUG.lookupHugByModule mod (hsc_HUG hsc_env)) >>= \case
- Just hp -> pure $ imodBreaks_modBreaks <$> getModBreaks hp
- Nothing -> pure Nothing
+schemeER_wrk d p rhs = schemeE d 0 p rhs
getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)]
getVarOffSets platform depth env = map getOffSet
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -1572,9 +1572,9 @@ afterRunStmt step run_result = do
Right names -> do
show_types <- isOptionSet ShowType
when show_types $ printTypeOfNames names
- GHC.ExecBreak names mb_info
+ GHC.ExecBreak names mibi
| first_resume : _ <- resumes
- -> do mb_id_loc <- toBreakIdAndLocation mb_info
+ -> do mb_id_loc <- toBreakIdAndLocation mibi
let bCmd = maybe "" ( \(_,l) -> onBreakCmd l ) mb_id_loc
if (null bCmd)
then printStoppedAtBreakInfo first_resume names
@@ -1612,8 +1612,8 @@ toBreakIdAndLocation Nothing = return Nothing
toBreakIdAndLocation (Just inf) = do
st <- getGHCiState
return $ listToMaybe [ id_loc | id_loc@(_,loc) <- IntMap.assocs (breaks st),
- breakModule loc == ibi_tick_mod inf,
- breakTick loc == ibi_tick_index inf ]
+ breakModule loc == ibi_info_mod inf,
+ breakTick loc == ibi_info_index inf ]
printStoppedAtBreakInfo :: GHC.GhcMonad m => Resume -> [Name] -> m ()
printStoppedAtBreakInfo res names = do
@@ -3793,7 +3793,7 @@ pprStopped res =
<> text (GHC.resumeDecl res))
<> char ',' <+> ppr (GHC.resumeSpan res)
where
- mb_mod_name = moduleName <$> ibi_tick_mod <$> GHC.resumeBreakpointId res
+ mb_mod_name = moduleName . ibi_info_mod <$> GHC.resumeBreakpointId res
showUnits :: GHC.GhcMonad m => m ()
showUnits = mapNonInteractiveHomeUnitsM $ \dflags -> do
@@ -4348,11 +4348,11 @@ ignoreCmd argLine = withSandboxOnly ":ignore" $ do
case result of
Left sdoc -> printForUser sdoc
Right (loc, count) -> do
- let bi = GHC.BreakpointId
- { bi_tick_mod = breakModule loc
- , bi_tick_index = breakTick loc
+ let ibi = GHC.InternalBreakpointId
+ { ibi_info_mod = breakModule loc
+ , ibi_info_index = breakTick loc
}
- setupBreakpoint bi count
+ setupBreakpoint ibi count
ignoreSwitch :: GhciMonad m => [String] -> m (Either SDoc (BreakLocation, Int))
ignoreSwitch [break, count] = do
@@ -4369,7 +4369,7 @@ getIgnoreCount str =
where
sdocIgnore = text "Ignore count" <+> quotes (text str)
-setupBreakpoint :: GhciMonad m => GHC.BreakpointId -> Int -> m()
+setupBreakpoint :: GhciMonad m => GHC.InternalBreakpointId -> Int -> m()
setupBreakpoint loc count = do
hsc_env <- GHC.getSession
GHC.setupBreakpoint (hscInterp hsc_env) loc count
@@ -4448,7 +4448,7 @@ breakById inp = do
Left sdoc -> printForUser sdoc
Right (mod, mod_info, fun_str) -> do
let modBreaks = expectJust (GHC.modInfoModBreaks mod_info)
- findBreakAndSet mod $ \_ -> findBreakForBind fun_str (imodBreaks_modBreaks modBreaks)
+ findBreakAndSet mod $ \_ -> maybe [] (findBreakForBind fun_str) (imodBreaks_modBreaks modBreaks)
breakSyntax :: a
breakSyntax = throwGhcException $ CmdLineError ("Syntax: :break [<mod>.]<func>[.<func>]\n"
@@ -4727,10 +4727,10 @@ turnBreakOnOff onOff loc
return loc { breakEnabled = onOff }
setBreakFlag :: GhciMonad m => Module -> Int -> Bool ->m ()
-setBreakFlag md ix enaDisa = do
+setBreakFlag md ix enaDisa = do
let enaDisaToCount True = breakOn
enaDisaToCount False = breakOff
- setupBreakpoint (GHC.BreakpointId md ix) $ enaDisaToCount enaDisa
+ setupBreakpoint (GHC.InternalBreakpointId md ix) $ enaDisaToCount enaDisa
-- ---------------------------------------------------------------------------
-- User code exception handling
=====================================
libraries/ghci/GHCi/Debugger.hs
=====================================
@@ -65,10 +65,7 @@ foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
--------------------------------------------------------------------------------
type BreakpointCallback
- = Addr# -- pointer to the breakpoint tick module name
- -> Addr# -- pointer to the breakpoint tick module unit id
- -> Int# -- breakpoint tick index
- -> Addr# -- pointer to the breakpoint info module name
+ = Addr# -- pointer to the breakpoint info module name
-> Addr# -- pointer to the breakpoint info module unit id
-> Int# -- breakpoint info index
-> Bool -- exception?
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -418,10 +418,7 @@ data EvalStatus_ a b
instance Binary a => Binary (EvalStatus_ a b)
data EvalBreakpoint = EvalBreakpoint
- { eb_tick_mod :: String -- ^ Breakpoint tick module
- , eb_tick_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
- , eb_tick_index :: Int -- ^ Breakpoint tick index
- , eb_info_mod :: String -- ^ Breakpoint info module
+ { eb_info_mod :: String -- ^ Breakpoint info module
, eb_info_mod_unit :: BS.ShortByteString -- ^ Breakpoint tick module unit id
, eb_info_index :: Int -- ^ Breakpoint info index
}
=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -342,7 +342,7 @@ withBreakAction opts breakMVar statusMVar mtid act
-- as soon as it is hit, or in resetBreakAction below.
onBreak :: BreakpointCallback
- onBreak tick_mod# tick_mod_uid# tickx# info_mod# info_mod_uid# infox# is_exception apStack = do
+ onBreak info_mod# info_mod_uid# infox# is_exception apStack = do
tid <- myThreadId
let resume = ResumeContext
{ resumeBreakMVar = breakMVar
@@ -355,11 +355,9 @@ withBreakAction opts breakMVar statusMVar mtid act
if is_exception
then pure Nothing
else do
- tick_mod <- peekCString (Ptr tick_mod#)
- tick_mod_uid <- BS.packCString (Ptr tick_mod_uid#)
info_mod <- peekCString (Ptr info_mod#)
info_mod_uid <- BS.packCString (Ptr info_mod_uid#)
- pure (Just (EvalBreakpoint tick_mod tick_mod_uid (I# tickx#) info_mod info_mod_uid (I# infox#)))
+ pure (Just (EvalBreakpoint info_mod info_mod_uid (I# infox#)))
putMVar statusMVar $ EvalBreak apStack_r breakpoint resume_r ccs
takeMVar breakMVar
@@ -406,8 +404,8 @@ noBreakStablePtr :: StablePtr BreakpointCallback
noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
noBreakAction :: BreakpointCallback
-noBreakAction _ _ _ _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
-noBreakAction _ _ _ _ _ _ True _ = return () -- exception: just continue
+noBreakAction _ _ _ False _ = putStrLn "*** Ignoring breakpoint"
+noBreakAction _ _ _ True _ = return () -- exception: just continue
-- Malloc and copy the bytes. We don't have any way to monitor the
-- lifetime of this memory, so it just leaks.
=====================================
rts/Disassembler.c
=====================================
@@ -84,16 +84,23 @@ disInstr ( StgBCO *bco, int pc )
switch (instr & 0xff) {
- case bci_BRK_FUN:
- debugBelch ("BRK_FUN " ); printPtr( ptrs[instrs[pc]] );
- debugBelch (" %d ", instrs[pc+1]); printPtr( ptrs[instrs[pc+2]] );
- CostCentre* cc = (CostCentre*)literals[instrs[pc+5]];
+ case bci_BRK_FUN: {
+ W_ p1, info_mod, info_unit_id, info_wix, np;
+ p1 = BCO_GET_LARGE_ARG;
+ info_mod = BCO_GET_LARGE_ARG;
+ info_unit_id = BCO_GET_LARGE_ARG;
+ info_wix = BCO_GET_LARGE_ARG;
+ np = BCO_GET_LARGE_ARG;
+ debugBelch ("BRK_FUN " ); printPtr( ptrs[p1] );
+ debugBelch("%" FMT_Word, literals[info_mod] );
+ debugBelch("%" FMT_Word, literals[info_unit_id] );
+ debugBelch("%" FMT_Word, literals[info_wix] );
+ CostCentre* cc = (CostCentre*)literals[np];
if (cc) {
debugBelch(" %s", cc->label);
}
debugBelch("\n");
- pc += 6;
- break;
+ break; }
case bci_BRK_ALTS:
debugBelch ("BRK_ALTS %d\n", BCO_NEXT);
break;
=====================================
rts/Exception.cmm
=====================================
@@ -535,23 +535,17 @@ retry_pop_stack:
// be per-thread.
CInt[rts_stop_on_exception] = 0;
("ptr" ioAction) = ccall deRefStablePtr (W_[rts_breakpoint_io_action] "ptr");
- Sp = Sp - WDS(17);
- Sp(16) = exception;
- Sp(15) = stg_raise_ret_info;
- Sp(14) = exception;
- Sp(13) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
- Sp(12) = stg_ap_ppv_info;
- Sp(11) = 0;
- Sp(10) = stg_ap_n_info;
- Sp(9) = 0;
- Sp(8) = stg_ap_n_info;
- Sp(7) = 0;
- Sp(6) = stg_ap_n_info;
- Sp(5) = 0;
- Sp(4) = stg_ap_n_info;
- Sp(3) = 0;
- Sp(2) = stg_ap_n_info;
- Sp(1) = 0;
+ Sp = Sp - WDS(11);
+ Sp(10) = exception;
+ Sp(9) = stg_raise_ret_info;
+ Sp(8) = exception;
+ Sp(7) = ghczminternal_GHCziInternalziTypes_True_closure; // True <=> an exception
+ Sp(6) = stg_ap_ppv_info;
+ Sp(5) = 0;
+ Sp(4) = stg_ap_n_info;
+ Sp(3) = 0;
+ Sp(2) = stg_ap_n_info;
+ Sp(1) = 0;
R1 = ioAction;
jump RET_LBL(stg_ap_n) [R1];
}
=====================================
rts/Interpreter.c
=====================================
@@ -1454,9 +1454,9 @@ run_BCO:
/* check for a breakpoint on the beginning of a let binding */
case bci_BRK_FUN:
{
- int arg1_brk_array, arg2_tick_mod, arg3_info_mod, arg4_tick_mod_id, arg5_info_mod_id, arg6_tick_index, arg7_info_index;
+ W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index;
#if defined(PROFILING)
- int arg8_cc;
+ W_ arg5_cc;
#endif
StgArrBytes *breakPoints;
int returning_from_break, stop_next_breakpoint;
@@ -1471,14 +1471,11 @@ run_BCO:
int size_words;
arg1_brk_array = BCO_GET_LARGE_ARG;
- arg2_tick_mod = BCO_GET_LARGE_ARG;
- arg3_info_mod = BCO_GET_LARGE_ARG;
- arg4_tick_mod_id = BCO_GET_LARGE_ARG;
- arg5_info_mod_id = BCO_GET_LARGE_ARG;
- arg6_tick_index = BCO_NEXT;
- arg7_info_index = BCO_NEXT;
+ arg2_info_mod_name = BCO_GET_LARGE_ARG;
+ arg3_info_mod_id = BCO_GET_LARGE_ARG;
+ arg4_info_index = BCO_LIT(BCO_GET_LARGE_ARG);
#if defined(PROFILING)
- arg8_cc = BCO_GET_LARGE_ARG;
+ arg5_cc = BCO_GET_LARGE_ARG;
#else
BCO_GET_LARGE_ARG;
#endif
@@ -1498,7 +1495,7 @@ run_BCO:
#if defined(PROFILING)
cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
- (CostCentre*)BCO_LIT(arg8_cc));
+ (CostCentre*)BCO_LIT(arg5_cc));
#endif
// if we are returning from a break then skip this section
@@ -1509,11 +1506,11 @@ run_BCO:
// stop the current thread if either `stop_next_breakpoint` is
// true OR if the ignore count for this particular breakpoint is zero
- StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg6_tick_index];
+ StgInt ignore_count = ((StgInt*)breakPoints->payload)[arg4_info_index];
if (stop_next_breakpoint == false && ignore_count > 0)
{
// decrement and write back ignore count
- ((StgInt*)breakPoints->payload)[arg6_tick_index] = --ignore_count;
+ ((StgInt*)breakPoints->payload)[arg4_info_index] = --ignore_count;
}
else if (stop_next_breakpoint == true || ignore_count == 0)
{
@@ -1547,10 +1544,7 @@ run_BCO:
// Arrange the stack to call the breakpoint IO action, and
// continue execution of this BCO when the IO action returns.
//
- // ioAction :: Addr# -- the breakpoint tick module
- // -> Addr# -- the breakpoint tick module unit id
- // -> Int# -- the breakpoint tick index
- // -> Addr# -- the breakpoint info module
+ // ioAction :: Addr# -- the breakpoint info module
// -> Addr# -- the breakpoint info module unit id
// -> Int# -- the breakpoint info index
// -> Bool -- exception?
@@ -1560,23 +1554,17 @@ run_BCO:
ioAction = (StgClosure *) deRefStablePtr (
rts_breakpoint_io_action);
- Sp_subW(19);
- SpW(18) = (W_)obj;
- SpW(17) = (W_)&stg_apply_interp_info;
- SpW(16) = (W_)new_aps;
- SpW(15) = (W_)False_closure; // True <=> an exception
- SpW(14) = (W_)&stg_ap_ppv_info;
- SpW(13) = (W_)arg7_info_index;
- SpW(12) = (W_)&stg_ap_n_info;
- SpW(11) = (W_)BCO_LIT(arg5_info_mod_id);
- SpW(10) = (W_)&stg_ap_n_info;
- SpW(9) = (W_)BCO_LIT(arg3_info_mod);
- SpW(8) = (W_)&stg_ap_n_info;
- SpW(7) = (W_)arg6_tick_index;
+ Sp_subW(13);
+ SpW(12) = (W_)obj;
+ SpW(11) = (W_)&stg_apply_interp_info;
+ SpW(10) = (W_)new_aps;
+ SpW(9) = (W_)False_closure; // True <=> an exception
+ SpW(8) = (W_)&stg_ap_ppv_info;
+ SpW(7) = (W_)arg4_info_index;
SpW(6) = (W_)&stg_ap_n_info;
- SpW(5) = (W_)BCO_LIT(arg4_tick_mod_id);
+ SpW(5) = (W_)BCO_LIT(arg3_info_mod_id);
SpW(4) = (W_)&stg_ap_n_info;
- SpW(3) = (W_)BCO_LIT(arg2_tick_mod);
+ SpW(3) = (W_)BCO_LIT(arg2_info_mod_name);
SpW(2) = (W_)&stg_ap_n_info;
SpW(1) = (W_)ioAction;
SpW(0) = (W_)&stg_enter_info;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d116ee0b222db687bd6acb58114cb9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d116ee0b222db687bd6acb58114cb9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/T26151] rts/posix: Hold on to low reservations when reserving heap
by Ben Gamari (@bgamari) 01 Jul '25
by Ben Gamari (@bgamari) 01 Jul '25
01 Jul '25
Ben Gamari pushed to branch wip/T26151 at Glasgow Haskell Compiler / GHC
Commits:
1028f02f by Ben Gamari at 2025-07-01T12:47:27-04:00
rts/posix: Hold on to low reservations when reserving heap
Previously when the OS gave us an address space reservation in low
memory we would immediately release it and try again. However, on some
platforms this meant that we would get the same allocation again in the
next iteration (since mmap's `hint` argument is just that, a hint).
Instead we now hold on to low reservations until we have found a
suitable heap reservation.
Fixes #26151.
- - - - -
1 changed file:
- rts/posix/OSMem.c
Changes:
=====================================
rts/posix/OSMem.c
=====================================
@@ -585,6 +585,10 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len)
}
#endif
+ const int MAX_ATTEMPTS = 8;
+ void *bad_allocs[MAX_ATTEMPTS] = {};
+ size_t bad_alloc_lens[MAX_ATTEMPTS] = {};
+
attempt = 0;
while (attempt < MAX_ATTEMPTS) {
*len &= ~MBLOCK_MASK;
@@ -611,18 +615,31 @@ void *osReserveHeapMemory(void *startAddressPtr, W_ *len)
} else if ((W_)at >= minimumAddress) {
// Success! We were given a block of memory starting above the 8 GB
// mark, which is what we were looking for.
-
break;
} else {
// We got addressing space but it wasn't above the 8GB mark.
- // Try again.
- if (munmap(at, *len) < 0) {
- sysErrorBelch("unable to release reserved heap");
+ // Free any portion *above* 8GB and hang on to the rest to increase
+ // the likelihood that we get a suitable allocation next iteration.
+ uintptr_t end = (W_) at + *len;
+ bad_allocs[attempt] = at;
+ if (end > minimumAddress) {
+ if (munmap((void *) minimumAddress, end - minimumAddress) < 0) {
+ sysErrorBelch("unable to release high portion of low memory reservation");
+ }
+ bad_alloc_lens[attempt] = minimumAddress - (W_) at;
+ } else {
+ bad_alloc_lens[attempt] = *len;
}
}
attempt++;
}
+ for (int i=0; i < MAX_ATTEMPTS; i++) {
+ if (bad_allocs[i] != NULL && munmap(bad_allocs[i], bad_alloc_lens[i]) < 0) {
+ sysErrorBelch("unable to release reserved heap");
+ }
+ }
+
if (at == NULL) {
sysErrorBelch("failed to reserve heap memory");
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1028f02fb6bff3af71cb7863f93bb3d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1028f02fb6bff3af71cb7863f93bb3d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
Ben Gamari pushed new branch wip/T26151 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T26151
You're receiving this email because of your account on gitlab.haskell.org.
1
0

01 Jul '25
Rodrigo Mesquita pushed new branch wip/romes/step-out-10 at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/step-out-10
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/romes/step-out-9] 3 commits: refactor: Use BreakpointId in Core and Ifaces
by Rodrigo Mesquita (@alt-romes) 01 Jul '25
by Rodrigo Mesquita (@alt-romes) 01 Jul '25
01 Jul '25
Rodrigo Mesquita pushed to branch wip/romes/step-out-9 at Glasgow Haskell Compiler / GHC
Commits:
7fb36f92 by Rodrigo Mesquita at 2025-07-01T16:55:19+01:00
refactor: Use BreakpointId in Core and Ifaces
- - - - -
77823b78 by Rodrigo Mesquita at 2025-07-01T16:55:19+01:00
stg2bc: Derive BcM via ReaderT StateT
A small refactor that simplifies GHC.StgToByteCode by deriving-via the
Monad instances for BcM. This is done along the lines of previous
similar refactors like 72b54c0760bbf85be1f73c1a364d4701e5720465.
- - - - -
13ad4e54 by Rodrigo Mesquita at 2025-07-01T16:55:19+01:00
refact: Split InternalModBreaks out of ModBreaks
There are currently two competing ways of referring to a Breakpoint:
1. Using the Tick module + Tick index
2. Using the Info module + Info index
1. The Tick index is allocated during desugaring in `mkModBreaks`. It is
used to refer to a breakpoint associated to a Core Tick. For a given
Tick module, there are N Ticks indexed by Tick index.
2. The Info index is allocated during code generation (in StgToByteCode)
and uniquely identifies the breakpoints at runtime (and is indeed used
to determine which breakpoint was hit at runtime).
Why we need both is described by Note [Breakpoint identifiers].
For every info index we used to keep a `CgBreakInfo`, a datatype containing
information relevant to ByteCode Generation, in `ModBreaks`.
This commit splits out the `IntMap CgBreakInfo` out of `ModBreaks` into
a new datatype `InternalModBreaks`.
- The purpose is to separate the `ModBreaks` datatype, which stores
data associated from tick-level information which is fixed after
desugaring, from the unrelated `IntMap CgBreakInfo` information
accumulated during bytecode generation.
- We move `ModBreaks` to GHC.HsToCore.Breakpoints
The new `InternalModBreaks` simply combines the `IntMap CgBreakInfo`
with `ModBreaks`. After code generation we construct an
`InternalModBreaks` with the `CgBreakInfo`s we accumulated and the
existing `ModBreaks` and store that in the compiled BCO in `bc_breaks`.
- Note that we previously only updated the `modBreaks_breakInfo`
field of `ModBreaks` at this exact location, and then stored the
updated `ModBreaks` in the same `bc_breaks`.
- We put this new datatype in GHC.ByteCode.Breakpoints
The rest of the pipeline for which CgBreakInfo is relevant is
accordingly updated to also use `InternalModBreaks`
- - - - -
40 changed files:
- compiler/GHC.hs
- compiler/GHC/ByteCode/Asm.hs
- + compiler/GHC/ByteCode/Breakpoints.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Map/Expr.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Session/Inspect.hs
- compiler/GHC/HsToCore/Breakpoints.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Eval/Types.hs
- compiler/GHC/Runtime/Interpreter.hs
- + compiler/GHC/Runtime/Interpreter.hs-boot
- + compiler/GHC/Runtime/Interpreter/Types.hs-boot
- compiler/GHC/Stg/BcPrep.hs
- compiler/GHC/Stg/FVs.hs
- compiler/GHC/StgToByteCode.hs
- − compiler/GHC/Types/Breakpoint.hs
- compiler/GHC/Types/Tickish.hs
- compiler/GHC/Unit/Module/ModGuts.hs
- compiler/ghc.cabal.in
- ghc/GHCi/UI.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/819bb93fe685b957caf8dfa656ae88…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/819bb93fe685b957caf8dfa656ae88…
You're receiving this email because of your account on gitlab.haskell.org.
1
0

01 Jul '25
Matthew Pickering pushed new branch wip/stable-ipe-info at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/stable-ipe-info
You're receiving this email because of your account on gitlab.haskell.org.
1
0

[Git][ghc/ghc][wip/T26160] 11 commits: template-haskell: improve changelog
by Ben Gamari (@bgamari) 01 Jul '25
by Ben Gamari (@bgamari) 01 Jul '25
01 Jul '25
Ben Gamari pushed to branch wip/T26160 at Glasgow Haskell Compiler / GHC
Commits:
4b748a99 by Teo Camarasu at 2025-06-24T15:31:07-04:00
template-haskell: improve changelog
stable -> more stable, just to clarify that this interface isn't fully stable.
errornously -> mistakenly: I typod this and also let's go for a simpler word
- - - - -
e358e477 by Sylvain Henry at 2025-06-24T15:31:58-04:00
Bump stack resolver to use GHC 9.6.7
Cf #26139
- - - - -
4bf5eb63 by fendor at 2025-06-25T17:05:43-04:00
Teach `:reload` about multiple home units
`:reload` needs to lookup the `ModuleName` and must not assume the given
`ModuleName` is in the current `HomeUnit`.
We add a new utility function which allows us to find a `HomeUnitModule`
instead of a `Module`.
Further, we introduce the `GhciCommandError` type which can be used to
abort the execution of a GHCi command.
This error is caught and printed in a human readable fashion.
- - - - -
b3d97bb3 by fendor at 2025-06-25T17:06:25-04:00
Implement `-fno-load-initial-targets` flag
We add the new flag `-fno-load-initial-targets` which doesn't load all `Target`s
immediately but only computes the module graph for all `Target`s.
The user can then decide to load modules from that module graph using
the syntax:
ghci> :reload <Mod>
This will load everything in the module graph up to `Mod`.
The user can return to the initial state by using the builtin target
`none` to unload all modules.
ghci> :reload none
Is in principle identical to starting a new session with the
`-fno-load-initial-targets` flag.
The `-fno-load-initial-targets` flag allows for faster startup time of GHCi when a
user has lots of `Target`s.
We additionally extend the `:reload` command to accept multiple
`ModuleName`s. For example:
ghci> :reload <Mod1> <Mod2>
Loads all modules up to the modules `Mod1` and `Mod2`.
- - - - -
49f44e52 by Teo Camarasu at 2025-06-26T04:19:51-04:00
Expose ghc-internal unit id through the settings file
This in combination with the unit id of the compiler library allows
cabal to know of the two unit ids that should not be reinstalled (in
specific circumstances) as:
- when using plugins, we want to link against exactly the compiler unit
id
- when using TemplateHaskell we want to link against exactly the package
that contains the TemplateHaskell interfaces, which is `ghc-internal`
See: <https://github.com/haskell/cabal/issues/10087>
Resolves #25282
- - - - -
499c4efe by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Fix and clean up capture of timings
* Fixes the typo that caused 'cat ci-timings' to report "no such file or
directory"
* Gave ci_timings.txt a file extension so it may play better with other
systems
* Fixed the use of time_it so all times are recorded
* Fixed time_it to print name along with timing
- - - - -
86c90c9e by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Update collapsible section usage
The syntax apparently changed at some point.
- - - - -
04308ee4 by Bryan Richter at 2025-06-26T04:20:33-04:00
CI: Add more collapsible sections
- - - - -
43b606bb by Florian Ragwitz at 2025-06-27T16:31:26-04:00
Tick uses of wildcard/pun field binds as if using the record selector function
Fixes #17834.
See Note [Record-selector ticks] for additional reasoning behind this as well
as an overview of the implementation details and future improvements.
- - - - -
d4952549 by Ben Gamari at 2025-06-27T16:32:08-04:00
testsuite/caller-cc: Make CallerCc[123] less sensitive
These were previously sensitive to irrelevant changes in program
structure. To avoid this we filter out all by lines emitted by the
-fcaller-cc from the profile.
- - - - -
69cc65a7 by Ben Gamari at 2025-07-01T11:00:47-04:00
gitlab-ci: Pass -q by default
Reduces verbosity, making it more likely that the log size will fall
under GitLab's truncation limit.
Addresses #26160.
- - - - -
59 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- .gitlab/common.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Unit/Module/Graph.hs
- compiler/Setup.hs
- docs/users_guide/9.14.1-notes.rst
- docs/users_guide/ghci.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Exception.hs
- ghc/GHCi/UI/Print.hs
- hadrian/src/Rules/Generate.hs
- hadrian/stack.yaml
- hadrian/stack.yaml.lock
- libraries/template-haskell/changelog.md
- testsuite/tests/ghc-e/should_fail/T18441fail5.stderr
- testsuite/tests/ghci/prog-mhu003/prog-mhu003.stderr
- testsuite/tests/ghci/prog-mhu004/prog-mhu004a.stderr
- + testsuite/tests/ghci/prog-mhu005/Makefile
- + testsuite/tests/ghci/prog-mhu005/a/A.hs
- + testsuite/tests/ghci/prog-mhu005/all.T
- + testsuite/tests/ghci/prog-mhu005/b/B.hs
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.script
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stderr
- + testsuite/tests/ghci/prog-mhu005/prog-mhu005a.stdout
- + testsuite/tests/ghci/prog-mhu005/unitA
- + testsuite/tests/ghci/prog-mhu005/unitB
- + testsuite/tests/ghci/prog021/A.hs
- + testsuite/tests/ghci/prog021/B.hs
- + testsuite/tests/ghci/prog021/Makefile
- + testsuite/tests/ghci/prog021/all.T
- + testsuite/tests/ghci/prog021/prog021a.script
- + testsuite/tests/ghci/prog021/prog021a.stderr
- + testsuite/tests/ghci/prog021/prog021a.stdout
- + testsuite/tests/ghci/prog021/prog021b.script
- + testsuite/tests/ghci/prog021/prog021b.stderr
- + testsuite/tests/ghci/prog021/prog021b.stdout
- + testsuite/tests/ghci/prog022/A.hs
- + testsuite/tests/ghci/prog022/B.hs
- + testsuite/tests/ghci/prog022/Makefile
- + testsuite/tests/ghci/prog022/all.T
- + testsuite/tests/ghci/prog022/ghci.prog022a.script
- + testsuite/tests/ghci/prog022/ghci.prog022a.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022a.stdout
- + testsuite/tests/ghci/prog022/ghci.prog022b.script
- + testsuite/tests/ghci/prog022/ghci.prog022b.stderr
- + testsuite/tests/ghci/prog022/ghci.prog022b.stdout
- testsuite/tests/ghci/scripts/ghci021.stderr
- + testsuite/tests/hpc/recsel/Makefile
- + testsuite/tests/hpc/recsel/recsel.hs
- + testsuite/tests/hpc/recsel/recsel.stdout
- + testsuite/tests/hpc/recsel/test.T
- testsuite/tests/profiling/should_run/caller-cc/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf220bde02c3f54411acf78a921547…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf220bde02c3f54411acf78a921547…
You're receiving this email because of your account on gitlab.haskell.org.
1
0