[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: interpreter: Always print unit and module name in BCO_NAME instruction
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Feb 4 05:12:59 UTC 2025
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
cbbb64fb by Matthew Pickering at 2025-02-03T23:40:33-05:00
interpreter: Always print unit and module name in BCO_NAME instruction
Currently the BCO_Name instruction is a bit difficult to use since the
names are not qualified by the module they come from. When you have a
very generic name such as "wildX4", it becomes impossible to work out
which module the identifier comes from.
Fixes #25694
- - - - -
764a43ac by Ben Gamari at 2025-02-03T23:41:10-05:00
upload-ghc-libs: Drop more references to ghc-internal from ghc-boot-th
(cherry picked from commit afec4b75c2d0e9f5c462a86d9f3697acf30355c7)
Co-authored-by: Ben Gamari <bgamari.foss at gmail.com>
- - - - -
eaf8e17b by Ben Gamari at 2025-02-04T00:12:44-05:00
ghc-toolchain: Parse i686 triples
This is a moniker used for later 32-bit x86 implementations
(Pentium Pro and later).
Fixes #25691.
- - - - -
7d020938 by Cheng Shao at 2025-02-04T00:12:45-05:00
compiler: remove unused assembleOneBCO function
This patch removes the unused assembleOneBCO function from the
bytecode assembler.
- - - - -
4 changed files:
- .gitlab/rel_eng/upload_ghc_libs.py
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/StgToByteCode.hs
- utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs
Changes:
=====================================
.gitlab/rel_eng/upload_ghc_libs.py
=====================================
@@ -94,9 +94,23 @@ def prep_ghc():
build_copy_file(PACKAGES['ghc'], 'GHC/Settings/Config.hs')
def prep_ghc_boot_th():
- # Drop ghc-internal from `hs-source-dirs` as Hackage rejects this
+ # Drop references to `ghc-internal` from `hs-source-dirs` as Hackage rejects
+ # out-of-sdist references and this packages is only uploaded for documentation
+ # purposes.
modify_file(PACKAGES['ghc-boot-th'], 'ghc-boot-th.cabal',
- lambda s: s.replace('../ghc-internal/src', ''))
+ lambda s: s.replace('../ghc-internal/src', '')
+ .replace('GHC.Internal.TH.Lib.Map', '')
+ .replace('GHC.Internal.TH.PprLib', '')
+ .replace('GHC.Internal.TH.Ppr', '')
+ .replace('GHC.Internal.TH.Lib,', '')
+ .replace('GHC.Internal.TH.Lib', '')
+ .replace('GHC.Internal.TH.Lift,', '')
+ .replace('GHC.Internal.TH.Quote,', '')
+ .replace('GHC.Internal.TH.Syntax', '')
+ .replace('GHC.Internal.ForeignSrcLang', '')
+ .replace('GHC.Internal.LanguageExtensions', '')
+ .replace('GHC.Internal.Lexeme', '')
+ )
PACKAGES = {
pkg.name: pkg
=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -8,7 +8,7 @@
-- | Bytecode assembler and linker
module GHC.ByteCode.Asm (
- assembleBCOs, assembleOneBCO,
+ assembleBCOs,
bcoFreeNames,
SizedSeq, sizeSS, ssElts,
iNTERP_STACK_CHECK_THRESH,
@@ -34,7 +34,6 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Core.TyCon
-import GHC.Data.FlatBag
import GHC.Data.SizedSeq
import GHC.StgToCmm.Layout ( ArgRep(..) )
@@ -168,15 +167,6 @@ mallocStrings interp ulbcos = do
collectPtr (BCOPtrBCO bco) = collect bco
collectPtr _ = return ()
-
-assembleOneBCO :: Interp -> Profile -> ProtoBCO Name -> IO UnlinkedBCO
-assembleOneBCO interp profile pbco = do
- -- TODO: the profile should be bundled with the interpreter: the rts ways are
- -- fixed for an interpreter
- ubco <- assembleBCO (profilePlatform profile) pbco
- UnitFlatBag ubco' <- mallocStrings interp (UnitFlatBag ubco)
- return ubco'
-
assembleBCO :: Platform -> ProtoBCO Name -> IO UnlinkedBCO
assembleBCO platform
(ProtoBCO { protoBCOName = nm
=====================================
compiler/GHC/StgToByteCode.hs
=====================================
@@ -240,11 +240,12 @@ ppBCEnv p
-- Create a BCO and do a spot of peephole optimisation on the insns
-- at the same time.
mkProtoBCO
- :: (Outputable name)
- => Platform
- -> Bool -- ^ True <=> label with @BCO_NAME@ instruction
- -- see Note [BCO_NAME]
- -> name
+ ::
+ Platform
+ -> Maybe Module
+ -- ^ Just cur_mod <=> label with @BCO_NAME@ instruction
+ -- see Note [BCO_NAME]
+ -> Name
-> BCInstrList
-> Either [CgStgAlt] (CgStgRhs)
-- ^ original expression; for debugging only
@@ -253,7 +254,7 @@ mkProtoBCO
-> [StgWord] -- ^ bitmap
-> Bool -- ^ True <=> is a return point, rather than a function
-> [FFIInfo]
- -> ProtoBCO name
+ -> ProtoBCO Name
mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis
= ProtoBCO {
protoBCOName = nm,
@@ -267,9 +268,9 @@ mkProtoBCO platform _add_bco_name nm instrs_ordlist origin arity bitmap_size bit
where
#if MIN_VERSION_rts(1,0,3)
maybe_add_bco_name instrs
- | _add_bco_name = BCO_NAME str : instrs
- where
- str = BS.pack $ showSDocOneLine defaultSDocContext (ppr nm)
+ | Just cur_mod <- _add_bco_name =
+ let str = BS.pack $ showSDocOneLine defaultSDocContext (pprFullName cur_mod nm)
+ in BCO_NAME str : instrs
#endif
maybe_add_bco_name instrs = instrs
@@ -1398,7 +1399,7 @@ Note [unboxed tuple bytecodes and tuple_BCO]
tupleBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
tupleBCO platform args_info args =
- mkProtoBCO platform False invented_name body_code (Left [])
+ mkProtoBCO platform Nothing invented_name body_code (Left [])
0{-no arity-} bitmap_size bitmap False{-is alts-}
where
{-
@@ -1419,7 +1420,7 @@ tupleBCO platform args_info args =
primCallBCO :: Platform -> NativeCallInfo -> [(PrimRep, ByteOff)] -> [FFIInfo] -> ProtoBCO Name
primCallBCO platform args_info args =
- mkProtoBCO platform False invented_name body_code (Left [])
+ mkProtoBCO platform Nothing invented_name body_code (Left [])
0{-no arity-} bitmap_size bitmap False{-is alts-}
where
{-
@@ -2359,8 +2360,12 @@ getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st)
getProfile :: BcM Profile
getProfile = targetProfile <$> getDynFlags
-shouldAddBcoName :: BcM Bool
-shouldAddBcoName = gopt Opt_AddBcoName <$> getDynFlags
+shouldAddBcoName :: BcM (Maybe Module)
+shouldAddBcoName = do
+ add <- gopt Opt_AddBcoName <$> getDynFlags
+ if add
+ then Just <$> getCurrentModule
+ else return Nothing
emitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name)
emitBc bco
=====================================
utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs
=====================================
@@ -36,6 +36,7 @@ parseArch :: Cc -> String -> M Arch
parseArch cc arch =
case arch of
"i386" -> pure ArchX86
+ "i686" -> pure ArchX86
"x86_64" -> pure ArchX86_64
"amd64" -> pure ArchX86_64
"powerpc" -> pure ArchPPC
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efec7a7055433151e4672bf3cf3d56a492f811dd...7d02093878a7cdf7a4e5ad7c8187e7d4f37f3f68
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efec7a7055433151e4672bf3cf3d56a492f811dd...7d02093878a7cdf7a4e5ad7c8187e7d4f37f3f68
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250204/cf6022c6/attachment-0001.html>
More information about the ghc-commits
mailing list