[Git][ghc/ghc][wip/romes/12935] 2 commits: X
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Wed Jun 26 09:11:16 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
3b384ea9 by Rodrigo Mesquita at 2024-06-25T16:25:12+01:00
X
- - - - -
56226ec2 by Rodrigo Mesquita at 2024-06-26T10:11:08+01:00
UPDATE
- - - - -
8 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/ContFlowOpt.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/LayoutStack.hs
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Cmm/UniqueRenamer.hs
- + failing.txt
- testsuite/tests/primops/should_run/T11296.hs
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -1852,6 +1852,7 @@ returns True.
-- Note that not all Uniques are mapped over. Only those that can be safely alpha
-- renamed, eg uniques of local symbols or of system names.
-- See Note [....TODO]
+-- ROMES:TODO: We can do less work here, like, do we really need to rename AsmTempLabel, SRTLabel, LocalBlockLabel?
mapInternalNonDetUniques :: Applicative m => (Unique -> m Unique) -> CLabel -> m CLabel
mapInternalNonDetUniques f = \case
il@(IdLabel name cafInfo idLabelInfo)
=====================================
compiler/GHC/Cmm/ContFlowOpt.hs
=====================================
@@ -156,7 +156,8 @@ cmmCfgOptsProc _ top = top
blockConcat :: Bool -> CmmGraph -> (CmmGraph, LabelMap BlockId)
blockConcat splitting_procs g at CmmGraph { g_entry = entry_id }
- = (replaceLabels shortcut_map $ ofBlockMap new_entry new_blocks, shortcut_map')
+ = pprTrace "blockConcat" (ppr entry_id) $
+ (replaceLabels shortcut_map $ ofBlockMap new_entry new_blocks, shortcut_map')
where
-- We might be able to shortcut the entry BlockId itself.
-- Remember to update the shortcut_map, since we also have to
@@ -208,7 +209,8 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id }
| CmmBranch b' <- last
, hasOnePredecessor b'
, Just blk' <- mapLookup b' blocks
- = let bid' = entryLabel blk'
+ = pprTrace "case 1" (ppr $ entryLabel block) $
+ let bid' = entryLabel blk'
in ( mapDelete bid' $ mapInsert bid (splice head blk') blocks
, shortcut_map
, mapDelete b' backEdges )
@@ -231,7 +233,8 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id }
, Just b' <- callContinuation_maybe last
, Just blk' <- mapLookup b' blocks
, Just dest <- canShortcut blk'
- = ( mapInsert bid (blockJoinTail head (update_cont dest)) blocks
+ = pprTrace "case 2" (ppr $ entryLabel block) $
+ ( mapInsert bid (blockJoinTail head (update_cont dest)) blocks
, mapInsert b' dest shortcut_map
, decPreds b' $ incPreds dest backEdges )
@@ -247,7 +250,8 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id }
-- A special case of this is a situation when a block ends with an
-- unconditional jump to a block that can be shortcut.
| Nothing <- callContinuation_maybe last
- = let oldSuccs = successors last
+ = pprTrace "case 3" (ppr $ entryLabel block) $
+ let oldSuccs = successors last
newSuccs = successors rewrite_last
in ( mapInsert bid (blockJoinTail head rewrite_last) blocks
, shortcut_map
@@ -257,7 +261,8 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id }
-- Otherwise don't do anything
| otherwise
- = ( blocks, shortcut_map, backEdges )
+ = pprTrace "case 4" (ppr $ entryLabel block) $
+ ( blocks, shortcut_map, backEdges )
where
(head, last) = blockSplitTail block
bid = entryLabel block
=====================================
compiler/GHC/Cmm/Info/Build.hs
=====================================
@@ -887,7 +887,7 @@ doSRTs
-> IO (ModuleSRTInfo, [CmmDeclSRTs])
doSRTs cfg moduleSRTInfo procs data_ = do
- us <- mkSplitUniqSupply 'u' -- ROMES:TODO: We could use a deterministic supply here? All names from here on out should be deterministic. Perhaps I could also grep for all supplies created after this point in its closure or somethinkg...
+ us <- mkSplitUniqSupply 'u'
let profile = cmmProfile cfg
=====================================
compiler/GHC/Cmm/LayoutStack.hs
=====================================
@@ -245,6 +245,7 @@ cmmLayoutStack cfg procpoints entry_args
blocks = revPostorder graph
profile = cmmProfile cfg
platform = profilePlatform profile
+ pprTraceM "cmmLayoutStack" (ppr liveness)
(final_stackmaps, _final_high_sp, new_blocks) <-
mfix $ \ ~(rec_stackmaps, rec_high_sp, _new_blocks) ->
=====================================
compiler/GHC/Cmm/Pipeline.hs
=====================================
@@ -78,7 +78,7 @@ cpsTop logger platform cfg proc =
--
CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-}
return $ cmmCfgOptsProc splitting_proc_points proc
- dump Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
+ dump Opt_D_dump_cmm_cfg "Post control-flow optimisations (1)" g
let !TopInfo {stack_info=StackInfo { arg_space = entry_off
, do_layout = do_layout }} = h
@@ -127,6 +127,7 @@ cpsTop logger platform cfg proc =
then runUniqSM $ cmmLayoutStack cfg proc_points entry_off g
else return (g, mapEmpty)
dump Opt_D_dump_cmm_sp "Layout Stack" g
+ dumpWith logger Opt_D_dump_cmm_sp "Layout Stack Maps" FormatCMM (ppr stackmaps)
----------- Sink and inline assignments --------------------------------
g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout]
@@ -168,7 +169,7 @@ cpsTop logger platform cfg proc =
else g
g <- return $ map (removeUnreachableBlocksProc platform) g
-- See Note [unreachable blocks]
- dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
+ -- dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations (2)" g
return (Left (cafEnv, g))
=====================================
compiler/GHC/Cmm/UniqueRenamer.hs
=====================================
@@ -68,8 +68,8 @@ renameDetUniq uq = do
case lookupUFM m uq of
Nothing -> do
new_w <- gets supply -- New deterministic unique in this `DetRnM`
- let (tag, _) = unpkUnique uq
- det_uniq = mkUnique tag new_w
+ let (please_use_me_tag, _) = unpkUnique uq
+ det_uniq = mkUnique 'Q' new_w
modify' (\DetUniqFM{mapping, supply} ->
-- Update supply and mapping
DetUniqFM
=====================================
failing.txt
=====================================
@@ -0,0 +1 @@
+TEST="10queens AtomicPrimops CarryOverflow FMA_Primops IOManager ListTuplePunsPpr Monoid_ByteArray ShrinkSmallMutableArrayA T11223_link_order_a_b_2_fail T11223_simple_duplicate_lib T11296 T14163 T14702 T15136 T15894 T16992 T17574 T1861 T18832 T2047 T21305 T21575 T21575b T21651 T21839r T22488_docHead T22798 T23400 T23821 T23832 T23832_invalid T3231 T3245 T3429 T3674 T3994 T4809 T5644 T6146 T7636 T7815 T8726 T9340 T9532 andy_cherry arith011 arr017 arr020 cgrun015 cloneMyStack compact_append compact_bench compact_huge_array compact_largemap compact_serialize compact_share compareByteArrays conc004 conc007 conc064 decodeMyStack decodeMyStack_underflowFrames determ003 determ017 drvrun014 encoding001 executablePath ffi014 ffi023 foundation galois_raytrace hGetChar001 haddockHoogleTest haddockHtmlTest haddockHypsrcTest haddockLatexTest heapprof002 if_name inits inits1tails1 ipe_stats joao-circular jspace keep-cafs-fail lex notes numa001 nursery-chunks1 openFile008 pause_resume_via_safe_ffi plugins-external process009 qsemn001 queens rts_clearMemory setByteArray seward-space-leak simplrun004 stablename001 stack_misc_closures static-plugins staticcallstack001 staticcallstack002 stm048 test-defaulting-plugin test-defaulting-plugin-fail unboxedsums1 while"
=====================================
testsuite/tests/primops/should_run/T11296.hs
=====================================
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -ddump-to-file -ddump-asm -ddump-cmm-verbose -ddump-cmm -ddump-cmm-from-stg -ddump-stg-final -dno-typeable-binds #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bc583d3268afd77fd3b03a102d94b45dc0549ee...56226ec23e89047a7e7566b5f52ac6b1b3fa28ce
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bc583d3268afd77fd3b03a102d94b45dc0549ee...56226ec23e89047a7e7566b5f52ac6b1b3fa28ce
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/20240626/4005ae60/attachment-0001.html>
More information about the ghc-commits
mailing list