[Git][ghc/ghc][wip/romes/rts-linker-direct-symbol-lookup] 5 commits: Simplify MVar operations used
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Mar 25 17:23:25 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/rts-linker-direct-symbol-lookup at Glasgow Haskell Compiler / GHC
Commits:
8f8cb6da by Rodrigo Mesquita at 2024-03-25T14:49:51+00:00
Simplify MVar operations used
- - - - -
2986b01d by Rodrigo Mesquita at 2024-03-25T14:49:51+00:00
Improve debug message
- - - - -
e8320e18 by Rodrigo Mesquita at 2024-03-25T16:26:53+00:00
Revert "NCG: Fix a bug in jump shortcutting."
This reverts commit 5bd8ed53dcefe10b72acb5729789e19ceb22df66.
- - - - -
fe89edb1 by Rodrigo Mesquita at 2024-03-25T16:26:53+00:00
fix: Qualify problematic names in lexer
With alex 3.5.1.0, the commit 7dfdf3d9fbc216653fe2cf95cc52c35900bdc8b4
makes GHC fail to build.
Fixes #24585
- - - - -
ba972f7d by Rodrigo Mesquita at 2024-03-25T17:23:06+00:00
Write Note [Looking up symbols in the relevant objects]
- - - - -
16 changed files:
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/BlockLayout.hs
- compiler/GHC/CmmToAsm/Instr.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
- compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
- compiler/GHC/CmmToAsm/Reg/Liveness.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Runtime/Interpreter.hs
- − testsuite/tests/codeGen/should_run/T24507.hs
- − testsuite/tests/codeGen/should_run/T24507.stdout
- − testsuite/tests/codeGen/should_run/T24507_cmm.cmm
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
compiler/GHC/ByteCode/Linker.hs
=====================================
@@ -180,7 +180,13 @@ lookupHsSymbol interp pkgs_loaded nm sym_suffix = do
case mb_ptr of
Just ptr -> pure (Just ptr)
Nothing -> go dlls
- go [] = panic "lookupHsSymbol: symbol not found in the loaded_dlls associated with this pkg_id"
+ go [] = pprPanic "GHC.ByteCode.Linker.lookupHsSymbol" $
+ text "name"
+ <+> ppr nm
+ <+> parens (text "symbol" <+> ppr sym_to_find)
+ <+> text "not found in the loaded_dlls associated with this pkg_id"
+ <+> parens (ppr pkg_id) <> text ":"
+ $$ ppr (lookupUDFM pkgs_loaded pkg_id)
go loaded_dlls
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -301,20 +301,15 @@ isJumpishInstr instr = case instr of
-- | Checks whether this instruction is a jump/branch instruction.
-- One that can change the flow of control in a way that the
-- register allocator needs to worry about.
-jumpDestsOfInstr :: Instr -> [Maybe BlockId]
+jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
-jumpDestsOfInstr i = case i of
- (CBZ _ t) -> [ mkDest t ]
- (CBNZ _ t) -> [ mkDest t ]
- (J t) -> [ mkDest t ]
- (B t) -> [ mkDest t ]
- (BL t _ _) -> [ mkDest t ]
- (BCOND _ t) -> [ mkDest t ]
- _ -> []
- where
- mkDest (TBlock id) = Just id
- mkDest TLabel{} = Nothing
- mkDest TReg{} = Nothing
+jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
+jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
+jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr _ = []
-- | Change the destination of this jump instruction.
-- Used in the linear allocator when adding fixup blocks for join
=====================================
compiler/GHC/CmmToAsm/BlockLayout.hs
=====================================
@@ -771,7 +771,7 @@ dropJumps :: forall a i. Instruction i => LabelMap a -> [GenBasicBlock i]
dropJumps _ [] = []
dropJumps info (BasicBlock lbl ins:todo)
| Just ins <- nonEmpty ins --This can happen because of shortcutting
- , [Just dest] <- jumpDestsOfInstr (NE.last ins)
+ , [dest] <- jumpDestsOfInstr (NE.last ins)
, BasicBlock nextLbl _ : _ <- todo
, not (mapMember dest info)
, nextLbl == dest
@@ -870,7 +870,7 @@ mkNode edgeWeights block@(BasicBlock id instrs) =
| length successors > 2 || edgeWeight info <= 0 -> []
| otherwise -> [target]
| Just instr <- lastMaybe instrs
- , [one] <- jumpBlockDestsOfInstr instr
+ , [one] <- jumpDestsOfInstr instr
= [one]
| otherwise = []
=====================================
compiler/GHC/CmmToAsm/Instr.hs
=====================================
@@ -17,8 +17,6 @@ import GHC.Cmm.BlockId
import GHC.CmmToAsm.Config
import GHC.Data.FastString
-import Data.Maybe (catMaybes)
-
-- | Holds a list of source and destination registers used by a
-- particular instruction.
--
@@ -75,17 +73,9 @@ class Instruction instr where
-- | Give the possible destinations of this jump instruction.
-- Must be defined for all jumpish instructions.
- -- Returns Nothing for non BlockId destinations.
jumpDestsOfInstr
- :: instr -> [Maybe BlockId]
-
- -- | Give the possible block destinations of this jump instruction.
- -- Must be defined for all jumpish instructions.
- jumpBlockDestsOfInstr
:: instr -> [BlockId]
- jumpBlockDestsOfInstr = catMaybes . jumpDestsOfInstr
-
-- | Change the destination of this jump instruction.
-- Used in the linear allocator when adding fixup blocks for join
=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -513,15 +513,12 @@ isJumpishInstr instr
-- | Checks whether this instruction is a jump/branch instruction.
-- One that can change the flow of control in a way that the
-- register allocator needs to worry about.
-jumpDestsOfInstr :: Instr -> [Maybe BlockId]
+jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr insn
= case insn of
- BCC _ id _ -> [Just id]
- BCCFAR _ id _ -> [Just id]
- BCTR targets _ _ -> targets
- BCTRL{} -> [Nothing]
- BL{} -> [Nothing]
- JMP{} -> [Nothing]
+ BCC _ id _ -> [id]
+ BCCFAR _ id _ -> [id]
+ BCTR targets _ _ -> [id | Just id <- targets]
_ -> []
=====================================
compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
=====================================
@@ -207,7 +207,7 @@ cleanForward platform blockId assoc acc (li : instrs)
-- Remember the association over a jump.
| LiveInstr instr _ <- li
- , targets <- jumpBlockDestsOfInstr instr
+ , targets <- jumpDestsOfInstr instr
, not $ null targets
= do mapM_ (accJumpValid assoc) targets
cleanForward platform blockId assoc (li : acc) instrs
@@ -386,7 +386,7 @@ cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
-- it always does, but if those reloads are cleaned the slot
-- liveness map doesn't get updated.
| LiveInstr instr _ <- li
- , targets <- jumpBlockDestsOfInstr instr
+ , targets <- jumpDestsOfInstr instr
= do
let slotsReloadedByTargets
= IntSet.unions
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
=====================================
@@ -57,7 +57,7 @@ joinToTargets block_live id instr
= return ([], instr)
| otherwise
- = joinToTargets' block_live [] id instr (jumpBlockDestsOfInstr instr)
+ = joinToTargets' block_live [] id instr (jumpDestsOfInstr instr)
-----
joinToTargets'
=====================================
compiler/GHC/CmmToAsm/Reg/Liveness.hs
=====================================
@@ -468,7 +468,7 @@ slurpReloadCoalesce live
-- if we hit a jump, remember the current slotMap
| LiveInstr (Instr instr) _ <- li
- , targets <- jumpBlockDestsOfInstr instr
+ , targets <- jumpDestsOfInstr instr
, not $ null targets
= do mapM_ (accSlotMap slotMap) targets
return (slotMap, Nothing)
@@ -760,7 +760,7 @@ sccBlocks blocks entries mcfg = map (fmap node_payload) sccs
sccs = stronglyConnCompG g2
getOutEdges :: Instruction instr => [instr] -> [BlockId]
- getOutEdges instrs = concatMap jumpBlockDestsOfInstr instrs
+ getOutEdges instrs = concatMap jumpDestsOfInstr instrs
-- This is truly ugly, but I don't see a good alternative.
-- Digraph just has the wrong API. We want to identify nodes
@@ -837,7 +837,7 @@ checkIsReverseDependent sccs'
slurpJumpDestsOfBlock (BasicBlock _ instrs)
= unionManyUniqSets
- $ map (mkUniqSet . jumpBlockDestsOfInstr)
+ $ map (mkUniqSet . jumpDestsOfInstr)
[ i | LiveInstr i _ <- instrs]
@@ -1047,7 +1047,7 @@ liveness1 platform liveregs blockmap (LiveInstr instr _)
-- union in the live regs from all the jump destinations of this
-- instruction.
- targets = jumpBlockDestsOfInstr instr -- where we go from here
+ targets = jumpDestsOfInstr instr -- where we go from here
not_a_branch = null targets
targetLiveRegs target
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -672,16 +672,13 @@ isJumpishInstr instr
jumpDestsOfInstr
:: Instr
- -> [Maybe BlockId]
+ -> [BlockId]
jumpDestsOfInstr insn
= case insn of
- JXX _ id -> [Just id]
- JMP_TBL _ ids _ _ -> [(mkDest dest) | Just dest <- ids]
+ JXX _ id -> [id]
+ JMP_TBL _ ids _ _ -> [id | Just (DestBlockId id) <- ids]
_ -> []
- where
- mkDest (DestBlockId id) = Just id
- mkDest _ = Nothing
patchJumpInstr
=====================================
compiler/GHC/Linker/Types.hs
=====================================
@@ -76,6 +76,29 @@ initialised.
The LinkerEnv maps Names to actual closures (for interpreted code only), for
use during linking.
+
+Note [Looking up symbols in the relevant objects]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In #23415, we determined that a lot of time (>10s, or even up to >35s!) was
+being spent on dynamically loading symbols before actually interpreting code
+when `:main` was run in GHCi. The root cause was that for each symbol we wanted
+to lookup, we would traverse the list of loaded objects and try find the symbol
+in each of them with dlsym (i.e. looking up a symbol was, worst case, linear in
+the amount of loaded objects).
+
+To drastically improve load time (XXX(TODO:get better measure against 10s
+baseline rather than 35second one) to <3s), we now:
+
+1. For every of the native objects loaded for a given unit, store the handles returned by `dlopen`.
+ - In `pkgs_loaded` of the `LoaderState`, which maps `UnitId`s to
+ `LoadedPkgInfo`s, where the handles live in its field `loaded_pkg_hs_dlls`.
+
+2. When looking up a Name (e.g. `lookupHsSymbol`), find that name's `UnitId` in
+ the `pkgs_loaded` mapping,
+
+3. And only look for the symbol (with `dlsym`) on the /handles relevant to that
+ unit/, rather than in every loaded object.
+
-}
newtype Loader = Loader { loader_state :: MVar (Maybe LoaderState) }
@@ -148,7 +171,7 @@ data LoadedPkgInfo
, loaded_pkg_hs_objs :: ![LibrarySpec]
, loaded_pkg_non_hs_objs :: ![LibrarySpec]
, loaded_pkg_hs_dlls :: ![RemotePtr LoadedDLL]
- -- ^ TODO: write Note
+ -- ^ See Note [Looking up symbols in the relevant objects]
, loaded_pkg_trans_deps :: UniqDSet UnitId
}
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -2870,7 +2870,7 @@ alexInputPrevChar (AI _ buf) = unsafeChr (fromIntegral (adjustChar pc))
where pc = prevChar buf '\n'
unsafeChr :: Int -> Char
-unsafeChr (I# c) = C# (chr# c)
+unsafeChr (I# c) = GHC.Exts.C# (GHC.Exts.chr# c)
-- backwards compatibility for Alex 2.x
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
=====================================
compiler/GHC/Runtime/Interpreter.hs
=====================================
@@ -500,12 +500,12 @@ withSymbolCache interp str determine_addr = do
case maddr of
Nothing -> return Nothing
Just p -> do
- let cache' = addToUFM cache str p
- modifyMVar_ (interpLookupSymbolCache interp) (const (pure cache'))
+ let upd_cache cache' = addToUFM cache' str p
+ modifyMVar_ (interpLookupSymbolCache interp) (pure . upd_cache)
return (Just p)
purgeLookupSymbolCache :: Interp -> IO ()
-purgeLookupSymbolCache interp = modifyMVar_ (interpLookupSymbolCache interp) (const (pure emptyUFM))
+purgeLookupSymbolCache interp = putMVar (interpLookupSymbolCache interp) emptyUFM
-- | loadDLL loads a dynamic library using the OS's native linker
-- (i.e. dlopen() on Unix, LoadLibrary() on Windows). It takes either
=====================================
testsuite/tests/codeGen/should_run/T24507.hs deleted
=====================================
@@ -1,15 +0,0 @@
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE GHCForeignImportPrim #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-
-module Main where
-
-import GHC.Exts
-
-foreign import prim "foo" foo :: Int# -> Int#
-
-main = do
-
- let f x = case x of I# x' -> case foo x' of x -> print (I# x)
- mapM_ f [1..7]
\ No newline at end of file
=====================================
testsuite/tests/codeGen/should_run/T24507.stdout deleted
=====================================
@@ -1,7 +0,0 @@
-1
-2
-2
-2
-2
-2
-2
=====================================
testsuite/tests/codeGen/should_run/T24507_cmm.cmm deleted
=====================================
@@ -1,35 +0,0 @@
-#include "Cmm.h"
-
-bar() {
- return (2);
-}
-
-foo(W_ x) {
-
- switch(x) {
- case 1: goto a;
- case 2: goto b;
- case 3: goto c;
- case 4: goto d;
- case 5: goto e;
- case 6: goto f;
- case 7: goto g;
- }
- return (1);
-
- a:
- return (1);
- b:
- jump bar();
- c:
- jump bar();
- d:
- jump bar();
- e:
- jump bar();
- f:
- jump bar();
- g:
- jump bar();
-
-}
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -243,6 +243,3 @@ test('MulMayOflo_full',
test('T24264run', normal, compile_and_run, [''])
test('T24295a', normal, compile_and_run, ['-O -floopification'])
test('T24295b', normal, compile_and_run, ['-O -floopification -fpedantic-bottoms'])
-
-test('T24507', [req_cmm], multi_compile_and_run,
- ['T24507', [('T24507_cmm.cmm', '')], '-O2'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdc1bc89f31e87ff201e9d8825202b4a7eb43727...ba972f7d77b75941b19d44ad7c505c28d14dc8ac
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bdc1bc89f31e87ff201e9d8825202b4a7eb43727...ba972f7d77b75941b19d44ad7c505c28d14dc8ac
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/20240325/236ff8a2/attachment-0001.html>
More information about the ghc-commits
mailing list