[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Document NcgImpl methods
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri May 10 14:56:54 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
b2682534 by Rodrigo Mesquita at 2024-05-10T01:47:51-04:00
Document NcgImpl methods
Fixes #19914
- - - - -
4d3acbcf by Zejun Wu at 2024-05-10T01:48:28-04:00
Make renamer to be more flexible with parens in the LHS of the rules
We used to reject LHS like `(f a) b` in RULES and requires it to be written as
`f a b`. It will be handy to allow both as the expression may be more
readable with extra parens in some cases when infix operator is involved.
Espceially when TemplateHaskell is used, extra parens may be added out of
user's control and result in "valid" rules being rejected and there
are not always ways to workaround it.
Fixes #24621
- - - - -
ab840ce6 by Ben Gamari at 2024-05-10T01:49:04-04:00
IPE: Eliminate dependency on Read
Instead of encoding the closure type as decimal string we now simply
represent it as an integer, eliminating the need for `Read` in
`GHC.Internal.InfoProv.Types.peekInfoProv`.
Closes #24504.
-------------------------
Metric Decrease:
T24602_perf_size
size_hello_artifact
-------------------------
- - - - -
a9979f55 by Cheng Shao at 2024-05-10T01:49:43-04:00
testsuite: fix testwsdeque with recent clang
This patch fixes compilation of testwsdeque.c with recent versions of
clang, which will fail with the error below:
```
testwsdeque.c:95:33: error:
warning: format specifies type 'long' but the argument has type 'void *' [-Wformat]
95 | barf("FAIL: %ld %d %d", p, n, val);
| ~~~ ^
testwsdeque.c:95:39: error:
warning: format specifies type 'int' but the argument has type 'StgWord' (aka 'unsigned long') [-Wformat]
95 | barf("FAIL: %ld %d %d", p, n, val);
| ~~ ^~~
| %lu
testwsdeque.c:133:42: error:
error: incompatible function pointer types passing 'void (void *)' to parameter of type 'OSThreadProc *' (aka 'void *(*)(void *)') [-Wincompatible-function-pointer-types]
133 | createOSThread(&ids[n], "thief", thief, (void*)(StgWord)n);
| ^~~~~
/workspace/ghc/_build/stage1/lib/../lib/x86_64-linux-ghc-9.11.20240502/rts-1.0.2/include/rts/OSThreads.h:193:51: error:
note: passing argument to parameter 'startProc' here
193 | OSThreadProc *startProc, void *param);
| ^
2 warnings and 1 error generated.
```
- - - - -
c2b33fc9 by Rodrigo Mesquita at 2024-05-10T01:50:20-04:00
Rename pre-processor invocation args
Small clean up. Uses proper names for the various groups of arguments
that make up the pre-processor invocation.
- - - - -
2b1af08b by Cheng Shao at 2024-05-10T01:50:55-04:00
ghc-heap: fix typo in ghc-heap cbits
- - - - -
c84c2fae by Jade at 2024-05-10T10:56:36-04:00
Improve performance of Data.List.sort(By)
This patch improves the algorithm to sort lists in base.
It does so using two strategies:
1) Use a four-way-merge instead of the 'default' two-way-merge.
This is able to save comparisons and allocations.
2) Use `(>) a b` over `compare a b == GT` and allow inlining and specialization.
This mainly benefits types with a fast (>).
Note that this *may* break instances with a *malformed* Ord instance
where `a > b` is *not* equal to `compare a b == GT`.
CLC proposal: https://github.com/haskell/core-libraries-committee/issues/236
Fixes #24280
-------------------------
Metric Decrease:
MultiLayerModulesTH_Make
T10421
T13719
T15164
T18698a
T18698b
T1969
T9872a
T9961
T18730
WWRec
T12425
T15703
-------------------------
- - - - -
3335cc0b by Matthew Pickering at 2024-05-10T10:56:37-04:00
Revert "ghcup-metadata: Drop output_name field"
This reverts commit ecbf22a6ac397a791204590f94c0afa82e29e79f.
This breaks the ghcup metadata generation on the nightly jobs.
- - - - -
28 changed files:
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/Cmm.hs
- compiler/GHC/CmmToAsm/AArch64/RegInfo.hs
- compiler/GHC/CmmToAsm/Monad.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/StgToCmm/InfoTableProv.hs
- compiler/GHC/SysTools/Tasks.hs
- libraries/base/changelog.md
- libraries/ghc-heap/cbits/Stack.cmm
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- rts/IPE.c
- rts/Trace.c
- rts/eventlog/EventLog.c
- rts/include/rts/Constants.h
- rts/include/rts/IPE.h
- + testsuite/tests/lib/base/Sort.hs
- + testsuite/tests/lib/base/Sort.stdout
- testsuite/tests/lib/base/all.T
- + testsuite/tests/rename/should_compile/T24621_normal.hs
- + testsuite/tests/rename/should_compile/T24621_th.hs
- testsuite/tests/rename/should_compile/all.T
- testsuite/tests/rts/ipe/ipeEventLog.stderr
- testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr
- testsuite/tests/rts/ipe/ipeMap.c
- testsuite/tests/rts/ipe/ipe_lib.c
- testsuite/tests/rts/testwsdeque.c
Changes:
=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -65,6 +65,7 @@ eprint(f"Supported platforms: {job_mapping.keys()}")
class Artifact(NamedTuple):
job_name: str
download_name: str
+ output_name: str
subdir: str
# Platform spec provides a specification which is agnostic to Job
@@ -74,9 +75,11 @@ class PlatformSpec(NamedTuple):
subdir: str
source_artifact = Artifact('source-tarball'
+ , 'ghc-{version}-src.tar.xz'
, 'ghc-{version}-src.tar.xz'
, 'ghc-{version}' )
test_artifact = Artifact('source-tarball'
+ , 'ghc-{version}-testsuite.tar.xz'
, 'ghc-{version}-testsuite.tar.xz'
, 'ghc-{version}/testsuite' )
@@ -161,6 +164,11 @@ def mk_one_metadata(release_mode, version, job_map, artifact):
, "dlSubdir": artifact.subdir.format(version=version)
, "dlHash" : h }
+ # Only add dlOutput if it is inconsistent with the filename inferred from the URL
+ output = artifact.output_name.format(version=version)
+ if Path(urlparse(final_url).path).name != output:
+ res["dlOutput"] = output
+
eprint(res)
return res
=====================================
compiler/GHC/Cmm.hs
=====================================
@@ -304,7 +304,7 @@ instance Outputable CmmStatic where
ppr (CmmString _) = text "CmmString"
ppr (CmmFileEmbed fp _) = text "CmmFileEmbed" <+> text fp
--- Static data before SRT generation
+-- | Static data before or after SRT generation
data GenCmmStatics (rawOnly :: Bool) where
CmmStatics
:: CLabel -- Label of statics
=====================================
compiler/GHC/CmmToAsm/AArch64/RegInfo.hs
=====================================
@@ -14,18 +14,16 @@ data JumpDest = DestBlockId BlockId
instance Outputable JumpDest where
ppr (DestBlockId bid) = text "jd<blk>:" <> ppr bid
--- TODO: documen what this does. See Ticket 19914
+-- Implementations of the methods of 'NgcImpl'
+
getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId (DestBlockId bid) = Just bid
--- TODO: document what this does. See Ticket 19914
canShortcut :: Instr -> Maybe JumpDest
canShortcut _ = Nothing
--- TODO: document what this does. See Ticket 19914
shortcutStatics :: (BlockId -> Maybe JumpDest) -> RawCmmStatics -> RawCmmStatics
shortcutStatics _ other_static = other_static
--- TODO: document what this does. See Ticket 19914
shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
shortcutJump _ other = other
=====================================
compiler/GHC/CmmToAsm/Monad.hs
=====================================
@@ -73,20 +73,33 @@ import GHC.Utils.Misc
import GHC.CmmToAsm.CFG
import GHC.CmmToAsm.CFG.Weight
+-- | A Native Code Generator implementation is parametrised over
+-- * The type of static data (typically related to 'CmmStatics')
+-- * The type of instructions
+-- * The type of jump destinations
data NcgImpl statics instr jumpDest = NcgImpl {
ncgConfig :: !NCGConfig,
cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl statics instr],
generateJumpTableForInstr :: instr -> Maybe (NatCmmDecl statics instr),
+ -- | Given a jump destination, if it refers to a block, return the block id of the destination.
getJumpDestBlockId :: jumpDest -> Maybe BlockId,
-- | Does this jump always jump to a single destination and is shortcutable?
--
- -- We use this to determine shortcutable instructions - See Note [What is shortcutting]
+ -- We use this to determine whether the given instruction is a shortcutable
+ -- jump to some destination - See Note [supporting shortcutting]
-- Note that if we return a destination here we *most* support the relevant shortcutting in
-- shortcutStatics for jump tables and shortcutJump for the instructions itself.
canShortcut :: instr -> Maybe jumpDest,
-- | Replace references to blockIds with other destinations - used to update jump tables.
shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics,
-- | Change the jump destination(s) of an instruction.
+ --
+ -- Rewrites the destination of a jump instruction to another
+ -- destination, if the given function returns a new jump destination for
+ -- the 'BlockId' of the original destination.
+ --
+ -- For instance, for a mapping @block_a -> dest_b@ and a instruction @goto block_a@ we would
+ -- rewrite the instruction to @goto dest_b@
shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr,
-- | 'Module' is only for printing internal labels. See Note [Internal proc
-- labels] in CLabel.
=====================================
compiler/GHC/CmmToAsm/X86/Instr.hs
=====================================
@@ -1033,6 +1033,7 @@ instance Outputable JumpDest where
ppr (DestBlockId bid) = text "jd<blk>:" <> ppr bid
ppr (DestImm _imm) = text "jd<imm>:noShow"
+-- Implementations of the methods of 'NgcImpl'
getJumpDestBlockId :: JumpDest -> Maybe BlockId
getJumpDestBlockId (DestBlockId bid) = Just bid
@@ -1043,7 +1044,6 @@ canShortcut (JXX ALWAYS id) = Just (DestBlockId id)
canShortcut (JMP (OpImm imm) _) = Just (DestImm imm)
canShortcut _ = Nothing
-
-- This helper shortcuts a sequence of branches.
-- The blockset helps avoid following cycles.
shortcutJump :: (BlockId -> Maybe JumpDest) -> Instr -> Instr
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -1226,6 +1226,15 @@ with LHSs with a complicated desugaring (and hence unlikely to match);
But there are legitimate non-trivial args ei, like sections and
lambdas. So it seems simpler not to check at all, and that is why
check_e is commented out.
+
+Note [Parens on the LHS of a RULE]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+You may think that no one would write
+
+ {-# RULES "foo" (f True) = blah #-}
+
+with the LHS wrapped in parens. But Template Haskell does (#24621)!
+So we should accommodate them.
-}
checkValidRule :: FastString -> [Name] -> LHsExpr GhcRn -> NameSet -> RnM ()
@@ -1253,6 +1262,8 @@ validRuleLhs foralls lhs
check (HsAppType _ e _) = checkl e
check (HsVar _ lv)
| (unLoc lv) `notElem` foralls = Nothing
+ -- See Note [Parens on the LHS of a RULE]
+ check (HsPar _ e) = checkl e
check other = Just other -- Failure
-- Check an argument
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -178,7 +178,7 @@ toIpeBufferEntries byte_order cg_ipes =
to_ipe_buf_ent :: CgInfoProvEnt -> [Word32]
to_ipe_buf_ent cg_ipe =
[ ipeTableName cg_ipe
- , ipeClosureDesc cg_ipe
+ , fromIntegral $ ipeClosureDesc cg_ipe
, ipeTypeDesc cg_ipe
, ipeLabel cg_ipe
, ipeSrcFile cg_ipe
@@ -193,7 +193,6 @@ toIpeBufferEntries byte_order cg_ipes =
toCgIPE :: Platform -> SDocContext -> InfoProvEnt -> State StringTable CgInfoProvEnt
toCgIPE platform ctx ipe = do
table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform (infoTablePtr ipe))
- closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe)
type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe
let label_str = maybe "" ((\(LexicalFastString s) -> unpackFS s) . snd) (infoTableProv ipe)
let (src_loc_file, src_loc_span) =
@@ -208,7 +207,7 @@ toCgIPE platform ctx ipe = do
src_span <- lookupStringTable $ ST.pack src_loc_span
return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe
, ipeTableName = table_name
- , ipeClosureDesc = closure_desc
+ , ipeClosureDesc = fromIntegral (infoProvEntClosureType ipe)
, ipeTypeDesc = type_desc
, ipeLabel = label
, ipeSrcFile = src_file
@@ -218,7 +217,7 @@ toCgIPE platform ctx ipe = do
data CgInfoProvEnt = CgInfoProvEnt
{ ipeInfoTablePtr :: !CLabel
, ipeTableName :: !StrTabOffset
- , ipeClosureDesc :: !StrTabOffset
+ , ipeClosureDesc :: !Word32
, ipeTypeDesc :: !StrTabOffset
, ipeLabel :: !StrTabOffset
, ipeSrcFile :: !StrTabOffset
=====================================
compiler/GHC/SysTools/Tasks.hs
=====================================
@@ -131,15 +131,15 @@ runSourceCodePreprocessor
runSourceCodePreprocessor logger tmpfs dflags preprocessor args =
traceSystoolCommand logger logger_name $ do
let
- (p, args0) = pgm_getter dflags
- args1 = Option <$> (augmentImports dflags $ getOpts dflags opt_getter)
- args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags]
- ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags]
- all_args = args0 ++ args1 ++ args2 ++ args
+ (program, configured_args) = pgm_getter dflags
+ runtime_args = Option <$> (augmentImports dflags $ getOpts dflags opt_getter)
+ extra_warns = [Option "-Werror" | gopt Opt_WarnIsError dflags]
+ ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags]
+ all_args = configured_args ++ runtime_args ++ extra_warns ++ args
- mb_env <- getGccEnv (args0 ++ args1)
+ mb_env <- getGccEnv (configured_args ++ runtime_args)
- runSomething readable_name p all_args mb_env
+ runSomething readable_name program all_args mb_env
where
toolSettings' = toolSettings dflags
@@ -155,7 +155,8 @@ runSourceCodePreprocessor logger tmpfs dflags preprocessor args =
optCFiltered = filter (`notElem` g3Flags) . opt_c
-- In the wild (and GHC), there is lots of code assuming that -optc gets
-- passed to the C-- preprocessor too. Note that the arguments are
- -- reversed by getOpts.
+ -- reversed by getOpts. That is, in the invocation, first come the runtime
+ -- C opts, then -g0, then the runtime CmmP opts.
cAndCmmOpt dflags = opt_CmmP dflags ++ cmmG0 ++ optCFiltered dflags
(logger_name, pgm_getter, opt_getter, readable_name)
= case preprocessor of
=====================================
libraries/base/changelog.md
=====================================
@@ -4,6 +4,7 @@
* Add the `MonadFix` instance for `(,) a`, similar to the one for `Writer a` ([CLC proposal #238](https://github.com/haskell/core-libraries-committee/issues/238))
* Improve `toInteger :: Word32 -> Integer` on 64-bit platforms ([CLC proposal #259](https://github.com/haskell/core-libraries-committee/issues/259))
* Make `read` accept binary integer notation ([CLC proposal #177](https://github.com/haskell/core-libraries-committee/issues/177))
+ * Improve the performance of `Data.List.sort` using an improved merging strategy. Instead of `compare`, `sort` now uses `(>)` which may break *malformed* `Ord` instances ([CLC proposal #236](https://github.com/haskell/core-libraries-committee/issues/236))
## 4.20.0.0 *TBA*
* Deprecate `GHC.Pack` ([#21461](https://gitlab.haskell.org/ghc/ghc/-/issues/21461))
=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -127,11 +127,11 @@ getWordzh(P_ stack, W_ offsetWords) {
getUnderflowFrameNextChunkzh(P_ stack, W_ offsetWords) {
P_ closurePtr;
closurePtr = (StgStack_sp(stack) + WDS(offsetWords));
- ASSERT(LOOKS_LIKE_CLOURE_PTR(closurePtr));
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
P_ next_chunk;
(next_chunk) = ccall getUnderflowFrameNextChunk(closurePtr);
- ASSERT(LOOKS_LIKE_CLOURE_PTR(next_chunk));
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(next_chunk));
return (next_chunk);
}
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
=====================================
@@ -1640,37 +1640,98 @@ and possibly to bear similarities to a 1982 paper by Richard O'Keefe:
Benchmarks show it to be often 2x the speed of the previous implementation.
Fixes ticket https://gitlab.haskell.org/ghc/ghc/issues/2143
+
+Further improved using a four-way merge, with an additional performance increase of ~20%
+https://gitlab.haskell.org/ghc/ghc/issues/24280
-}
-sort = sortBy compare
-sortBy cmp = mergeAll . sequences
+{-# INLINEABLE sort #-} -- allows specialization for the ord instance
+sort = actualSort (>)
+
+{-# INLINEABLE sortBy #-}
+sortBy cmp = actualSort (\x y -> cmp x y == GT)
+
+actualSort :: (a -> a -> Bool) -> [a] -> [a]
+actualSort gt ns
+ | [] <- ns = []
+ | [a] <- ns = [a]
+ | [a,b] <- ns = merge [a] [b]
+ | [a,b,c] <- ns = merge3 [a] [b] [c]
+ | [a,b,c,d] <- ns = merge4 [a] [b] [c] [d]
+ | otherwise = merge_all (sequences ns)
where
sequences (a:b:xs)
- | a `cmp` b == GT = descending b [a] xs
- | otherwise = ascending b (a:) xs
+ | a `gt` b = descending b [a] xs
+ | otherwise = ascending b (a:) xs
sequences xs = [xs]
descending a as (b:bs)
- | a `cmp` b == GT = descending b (a:as) bs
- descending a as bs = (a:as): sequences bs
+ | a `gt` b = descending b (a:as) bs
+ descending a as bs = (a:as): sequences bs
ascending a as (b:bs)
- | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs
- ascending a as bs = let !x = as [a]
- in x : sequences bs
-
- mergeAll [x] = x
- mergeAll xs = mergeAll (mergePairs xs)
-
- mergePairs (a:b:xs) = let !x = merge a b
- in x : mergePairs xs
- mergePairs xs = xs
+ | not (a `gt` b) = ascending b (\ys -> as (a:ys)) bs
+ ascending a as bs = let !x = as [a]
+ in x : sequences bs
+
+ merge_all [x] = x
+ merge_all xs = merge_all (reduce_once xs)
+
+ reduce_once [] = []
+ reduce_once [a] = [a]
+ reduce_once [a,b] = [merge a b]
+ reduce_once [a,b,c] = [merge3 a b c]
+ reduce_once [a,b,c,d,e] = [merge a b, merge3 c d e]
+ reduce_once [a,b,c,d,e,f] = [merge3 a b c, merge3 d e f]
+ reduce_once (a:b:c:d:xs) = let !x = merge4 a b c d
+ in x : reduce_once xs
merge as@(a:as') bs@(b:bs')
- | a `cmp` b == GT = b:merge as bs'
- | otherwise = a:merge as' bs
- merge [] bs = bs
- merge as [] = as
+ | a `gt` b = b : merge as bs'
+ | otherwise = a : merge as' bs
+ merge [] bs = bs
+ merge as [] = as
+
+ -- `merge3` is a manually fused version of `merge (merge as bs) cs`
+ merge3 as@(a:as') bs@(b:bs') cs
+ | a `gt` b = merge3X b as bs' cs
+ | otherwise = merge3X a as' bs cs
+ merge3 [] bs cs = merge bs cs
+ merge3 as [] cs = merge as cs
+
+ merge3X x as bs cs@(c:cs')
+ | x `gt` c = c : merge3X x as bs cs'
+ | otherwise = x : merge3 as bs cs
+ merge3X x as bs [] = x : merge as bs
+
+ merge3Y as@(a:as') y bs cs
+ | a `gt` y = y : merge3 as bs cs
+ | otherwise = a : merge3Y as' y bs cs
+ merge3Y [] x bs cs = x : merge bs cs
+
+ -- `merge4 as bs cs ds` is (essentially) a manually fused version of
+ -- `merge (merge as bs) (merge cs ds)`
+ merge4 as@(a:as') bs@(b:bs') cs ds
+ | a `gt` b = merge4X b as bs' cs ds
+ | otherwise = merge4X a as' bs cs ds
+ merge4 [] bs cs ds = merge3 bs cs ds
+ merge4 as [] cs ds = merge3 as cs ds
+
+ merge4X x as bs cs@(c:cs') ds@(d:ds')
+ | c `gt` d = merge4XY x as bs d cs ds'
+ | otherwise = merge4XY x as bs c cs' ds
+ merge4X x as bs [] ds = merge3X x as bs ds
+ merge4X x as bs cs [] = merge3X x as bs cs
+
+ merge4Y as@(a:as') bs@(b:bs') y cs ds
+ | a `gt` b = merge4XY b as bs' y cs ds
+ | otherwise = merge4XY a as' bs y cs ds
+ merge4Y as [] y cs ds = merge3Y as y cs ds
+ merge4Y [] bs y cs ds = merge3Y bs y cs ds
+
+ merge4XY x as bs y cs ds
+ | x `gt` y = y : merge4X x as bs cs ds
+ | otherwise = x : merge4Y as bs y cs ds
{-
sortBy cmp l = mergesort cmp l
=====================================
libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
=====================================
@@ -18,8 +18,9 @@ module GHC.Internal.InfoProv.Types
) where
import GHC.Internal.Base
-import GHC.Internal.Data.Maybe
import GHC.Internal.Enum
+import GHC.Internal.Real (fromIntegral)
+import GHC.Internal.Word (Word32)
import GHC.Internal.Show (Show)
import GHC.Internal.Ptr (Ptr(..), plusPtr)
import GHC.Internal.Foreign.C.String.Encoding (CString, peekCString)
@@ -28,7 +29,6 @@ import GHC.Internal.Foreign.Marshal.Alloc (allocaBytes)
import GHC.Internal.IO.Encoding (utf8)
import GHC.Internal.Foreign.Storable (peekByteOff)
import GHC.Internal.ClosureTypes
-import GHC.Internal.Text.Read
import GHC.Prim (whereFrom##)
data InfoProv = InfoProv {
@@ -70,9 +70,11 @@ getIPE obj fail k = allocaBytes (#size InfoProvEnt) $ \p -> IO $ \s ->
ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv
ipeProv p = (#ptr InfoProvEnt, prov) p
-peekIpName, peekIpDesc, peekIpLabel, peekIpUnitId, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
-peekIpName p = (# peek InfoProv, table_name) p
+peekIpDesc :: Ptr InfoProv -> IO Word32
peekIpDesc p = (# peek InfoProv, closure_desc) p
+
+peekIpName, peekIpLabel, peekIpUnitId, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
+peekIpName p = (# peek InfoProv, table_name) p
peekIpLabel p = (# peek InfoProv, label) p
peekIpUnitId p = (# peek InfoProv, unit_id) p
peekIpModule p = (# peek InfoProv, module) p
@@ -83,7 +85,7 @@ peekIpTyDesc p = (# peek InfoProv, ty_desc) p
peekInfoProv :: Ptr InfoProv -> IO InfoProv
peekInfoProv infop = do
name <- peekCString utf8 =<< peekIpName infop
- desc <- peekCString utf8 =<< peekIpDesc infop
+ desc <- peekIpDesc infop
tyDesc <- peekCString utf8 =<< peekIpTyDesc infop
label <- peekCString utf8 =<< peekIpLabel infop
unit_id <- peekCString utf8 =<< peekIpUnitId infop
@@ -94,7 +96,7 @@ peekInfoProv infop = do
ipName = name,
-- The INVALID_OBJECT case should be impossible as we
-- control the C code generating these values.
- ipDesc = maybe INVALID_OBJECT toEnum . readMaybe @Int $ desc,
+ ipDesc = toEnum $ fromIntegral desc,
ipTyDesc = tyDesc,
ipLabel = label,
ipUnitId = unit_id,
=====================================
rts/IPE.c
=====================================
@@ -105,7 +105,7 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, uint32_t i
.info = node->tables[idx],
.prov = {
.table_name = &strings[ent->table_name],
- .closure_desc = &strings[ent->closure_desc],
+ .closure_desc = ent->closure_desc,
.ty_desc = &strings[ent->ty_desc],
.label = &strings[ent->label],
.unit_id = &strings[node->unit_id],
@@ -176,6 +176,10 @@ void registerInfoProvList(IpeBufferListNode *node) {
}
}
+void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf) {
+ snprintf(str_buf, CLOSURE_DESC_BUFFER_SIZE, "%u", ipe_buf->prov.closure_desc);
+}
+
bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out) {
updateIpeMap();
IpeMapEntry *map_ent = (IpeMapEntry *) lookupHashTable(ipeMap, (StgWord)info);
=====================================
rts/Trace.c
=====================================
@@ -688,9 +688,12 @@ void traceIPE(const InfoProvEnt *ipe)
if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
ACQUIRE_LOCK(&trace_utx);
+ char closure_desc_buf[CLOSURE_DESC_BUFFER_SIZE] = {};
+ formatClosureDescIpe(ipe, closure_desc_buf);
+
tracePreface();
debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, unit %s, module %s, srcloc %s:%s\n",
- ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc,
+ ipe->prov.table_name, closure_desc_buf, ipe->prov.ty_desc,
ipe->prov.label, ipe->prov.unit_id, ipe->prov.module,
ipe->prov.src_file, ipe->prov.src_span);
=====================================
rts/eventlog/EventLog.c
=====================================
@@ -1441,11 +1441,14 @@ void postTickyCounterSamples(StgEntCounter *counters)
#endif /* TICKY_TICKY */
void postIPE(const InfoProvEnt *ipe)
{
+ char closure_desc_buf[CLOSURE_DESC_BUFFER_SIZE] = {};
+ formatClosureDescIpe(ipe, closure_desc_buf);
+
// See Note [Maximum event length].
const StgWord MAX_IPE_STRING_LEN = 65535;
ACQUIRE_LOCK(&eventBufMutex);
StgWord table_name_len = MIN(strlen(ipe->prov.table_name), MAX_IPE_STRING_LEN);
- StgWord closure_desc_len = MIN(strlen(ipe->prov.closure_desc), MAX_IPE_STRING_LEN);
+ StgWord closure_desc_len = MIN(strlen(closure_desc_buf), MAX_IPE_STRING_LEN);
StgWord ty_desc_len = MIN(strlen(ipe->prov.ty_desc), MAX_IPE_STRING_LEN);
StgWord label_len = MIN(strlen(ipe->prov.label), MAX_IPE_STRING_LEN);
StgWord module_len = MIN(strlen(ipe->prov.module), MAX_IPE_STRING_LEN);
@@ -1462,7 +1465,7 @@ void postIPE(const InfoProvEnt *ipe)
postPayloadSize(&eventBuf, len);
postWord64(&eventBuf, (StgWord) INFO_PTR_TO_STRUCT(ipe->info));
postStringLen(&eventBuf, ipe->prov.table_name, table_name_len);
- postStringLen(&eventBuf, ipe->prov.closure_desc, closure_desc_len);
+ postStringLen(&eventBuf, closure_desc_buf, closure_desc_len);
postStringLen(&eventBuf, ipe->prov.ty_desc, ty_desc_len);
postStringLen(&eventBuf, ipe->prov.label, label_len);
postStringLen(&eventBuf, ipe->prov.module, module_len);
=====================================
rts/include/rts/Constants.h
=====================================
@@ -347,3 +347,10 @@
* we can have static arrays of this size in the RTS for speed.
*/
#define MAX_NUMA_NODES 16
+
+/*
+ * closure_desc of InfoProv is now uint32_t at all platforms, but
+ * we have to keep its stringified representation.
+ * It is known that maximum length of uint32_t in string is 10 chars (4294967295) + 1 NULL.
+ */
+#define CLOSURE_DESC_BUFFER_SIZE 11
=====================================
rts/include/rts/IPE.h
=====================================
@@ -15,7 +15,7 @@
typedef struct InfoProv_ {
const char *table_name;
- const char *closure_desc;
+ uint32_t closure_desc; // closure type
const char *ty_desc;
const char *label;
const char *unit_id;
@@ -54,7 +54,7 @@ typedef uint32_t StringIdx;
// to ensure correct packing.
typedef struct {
StringIdx table_name;
- StringIdx closure_desc;
+ uint32_t closure_desc; // closure type
StringIdx ty_desc;
StringIdx label;
StringIdx src_file;
@@ -89,5 +89,11 @@ typedef struct IpeBufferListNode_ {
void registerInfoProvList(IpeBufferListNode *node);
+// We leave it in old format to keep compatibility with existing https://github.com/haskell/ghc-events
+// See: https://github.com/haskell/ghc-events/commit/cce6a35677f5f99b44c21d86febd295b909ef1ce
+// The format depends on tooling. At the moment of commit all tooling expects a stringified unsigned int.
+// I.e. 10 -> "10". No padding zeroes. No prefixes.
+void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf);
+
// Returns true on success, initializes `out`.
bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out);
=====================================
testsuite/tests/lib/base/Sort.hs
=====================================
@@ -0,0 +1,18 @@
+module Main where
+
+import Data.List (sort)
+import Data.Semigroup (Arg(..))
+
+main :: IO ()
+main = do
+ -- correctness
+ test @Int []
+ test [0]
+ test [8, 0, 2, 3, 6, 1, 5, 10, 4, 7, 9]
+
+ -- stability
+ test [Arg 1 0, Arg 0 0, Arg 0 1, Arg 1 1, Arg 0 2]
+ test [Arg 0 0, Arg 0 1, Arg 0 2]
+
+test :: (Ord a, Show a) => [a] -> IO ()
+test = print . sort
=====================================
testsuite/tests/lib/base/Sort.stdout
=====================================
@@ -0,0 +1,5 @@
+[]
+[0]
+[0,1,2,3,4,5,6,7,8,9,10]
+[Arg 0 0,Arg 0 1,Arg 0 2,Arg 1 0,Arg 1 1]
+[Arg 0 0,Arg 0 1,Arg 0 2]
=====================================
testsuite/tests/lib/base/all.T
=====================================
@@ -11,3 +11,4 @@ test('Monoid_ByteArray', normal, compile_and_run, [''])
test('Unsnoc', normal, compile_and_run, [''])
test('First-Semigroup-sconcat', normal, compile_and_run, [''])
test('First-Monoid-sconcat', normal, compile_and_run, [''])
+test('Sort', normal, compile_and_run, [''])
=====================================
testsuite/tests/rename/should_compile/T24621_normal.hs
=====================================
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
+module T24621_normal where
+
+import Data.Function
+
+foo :: a -> a
+foo x = x
+
+{-# RULES "" forall a b c. a * c + b * c = (a + b) * c :: Int #-}
+{-# RULES "." forall f g. (f . g) foo = f (g foo) #-}
+{-# RULES "foo" forall a b. (foo a) b = a b #-}
+{-# RULES "on" forall a b. (flip compare `on` foo) a b = compare b a #-}
=====================================
testsuite/tests/rename/should_compile/T24621_th.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
+module T24621_th where
+
+import Data.Function
+
+foo :: a -> a
+foo x = x
+
+$( [d| {-# RULES "" forall a b c. a * c + b * c = (a + b) * c :: Int #-} |] )
+$( [d| {-# RULES "." forall a b. (.) a b foo = a (b foo) #-} |] )
+$( [d| {-# RULES "foo" forall a b. foo a b = a b #-} |] )
=====================================
testsuite/tests/rename/should_compile/all.T
=====================================
@@ -223,4 +223,6 @@ test('T22478a', req_th, compile, [''])
test('RecordWildCardDeprecation', normal, multimod_compile, ['RecordWildCardDeprecation', '-Wno-duplicate-exports'])
test('T14032b', normal, compile_and_run, [''])
test('T14032d', normal, compile, [''])
+test('T24621_normal', normal, compile, [''])
+test('T24621_th', req_th, compile, [''])
test('T24732', normal, compile_and_run, ['-package "base(Prelude, Text.Printf as P\')"'])
=====================================
testsuite/tests/rts/ipe/ipeEventLog.stderr
=====================================
@@ -1,20 +1,20 @@
-7ffff7a4d740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
-7ffff7a4d740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
-7ffff7a4d740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
-7ffff7a4d740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
-7ffff7a4d740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
-7ffff7a4d740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
-7ffff7a4d740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
-7ffff7a4d740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
-7ffff7a4d740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
-7ffff7a4d740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
-7ffff7a4d740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
-7ffff7a4d740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
-7ffff7a4d740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
-7ffff7a4d740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
-7ffff7a4d740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
-7ffff7a4d740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
-7ffff7a4d740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
-7ffff7a4d740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
-7ffff7a4d740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
-7ffff7a4d740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
+7ffff7a4d740: IPE: table_name table_name_000, closure_desc 0, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
+7ffff7a4d740: IPE: table_name table_name_001, closure_desc 1, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
+7ffff7a4d740: IPE: table_name table_name_002, closure_desc 2, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
+7ffff7a4d740: IPE: table_name table_name_003, closure_desc 3, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
+7ffff7a4d740: IPE: table_name table_name_004, closure_desc 4, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
+7ffff7a4d740: IPE: table_name table_name_005, closure_desc 5, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
+7ffff7a4d740: IPE: table_name table_name_006, closure_desc 6, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
+7ffff7a4d740: IPE: table_name table_name_007, closure_desc 7, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
+7ffff7a4d740: IPE: table_name table_name_008, closure_desc 8, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
+7ffff7a4d740: IPE: table_name table_name_009, closure_desc 9, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
+7ffff7a4d740: IPE: table_name table_name_000, closure_desc 0, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
+7ffff7a4d740: IPE: table_name table_name_001, closure_desc 1, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
+7ffff7a4d740: IPE: table_name table_name_002, closure_desc 2, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
+7ffff7a4d740: IPE: table_name table_name_003, closure_desc 3, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
+7ffff7a4d740: IPE: table_name table_name_004, closure_desc 4, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
+7ffff7a4d740: IPE: table_name table_name_005, closure_desc 5, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
+7ffff7a4d740: IPE: table_name table_name_006, closure_desc 6, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
+7ffff7a4d740: IPE: table_name table_name_007, closure_desc 7, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
+7ffff7a4d740: IPE: table_name table_name_008, closure_desc 8, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
+7ffff7a4d740: IPE: table_name table_name_009, closure_desc 9, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
=====================================
testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr
=====================================
@@ -1,20 +1,20 @@
-7ffff7a4d740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
-7ffff7a4d740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
-7ffff7a4d740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
-7ffff7a4d740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
-7ffff7a4d740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
-7ffff7a4d740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
-7ffff7a4d740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
-7ffff7a4d740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
-7ffff7a4d740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
-7ffff7a4d740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
-7ffff7a4d740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
-7ffff7a4d740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
-7ffff7a4d740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
-7ffff7a4d740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
-7ffff7a4d740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
-7ffff7a4d740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
-7ffff7a4d740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
-7ffff7a4d740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
-7ffff7a4d740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
-7ffff7a4d740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
+7ffff7a4d740: IPE: table_name table_name_009, closure_desc 9, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
+7ffff7a4d740: IPE: table_name table_name_008, closure_desc 8, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
+7ffff7a4d740: IPE: table_name table_name_007, closure_desc 7, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
+7ffff7a4d740: IPE: table_name table_name_006, closure_desc 6, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
+7ffff7a4d740: IPE: table_name table_name_005, closure_desc 5, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
+7ffff7a4d740: IPE: table_name table_name_004, closure_desc 4, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
+7ffff7a4d740: IPE: table_name table_name_003, closure_desc 3, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
+7ffff7a4d740: IPE: table_name table_name_002, closure_desc 2, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
+7ffff7a4d740: IPE: table_name table_name_001, closure_desc 1, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
+7ffff7a4d740: IPE: table_name table_name_000, closure_desc 0, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
+7ffff7a4d740: IPE: table_name table_name_009, closure_desc 9, ty_desc ty_desc_009, label label_009, unit unit_id_000, module module_000, srcloc src_file_009:src_span_009
+7ffff7a4d740: IPE: table_name table_name_008, closure_desc 8, ty_desc ty_desc_008, label label_008, unit unit_id_000, module module_000, srcloc src_file_008:src_span_008
+7ffff7a4d740: IPE: table_name table_name_007, closure_desc 7, ty_desc ty_desc_007, label label_007, unit unit_id_000, module module_000, srcloc src_file_007:src_span_007
+7ffff7a4d740: IPE: table_name table_name_006, closure_desc 6, ty_desc ty_desc_006, label label_006, unit unit_id_000, module module_000, srcloc src_file_006:src_span_006
+7ffff7a4d740: IPE: table_name table_name_005, closure_desc 5, ty_desc ty_desc_005, label label_005, unit unit_id_000, module module_000, srcloc src_file_005:src_span_005
+7ffff7a4d740: IPE: table_name table_name_004, closure_desc 4, ty_desc ty_desc_004, label label_004, unit unit_id_000, module module_000, srcloc src_file_004:src_span_004
+7ffff7a4d740: IPE: table_name table_name_003, closure_desc 3, ty_desc ty_desc_003, label label_003, unit unit_id_000, module module_000, srcloc src_file_003:src_span_003
+7ffff7a4d740: IPE: table_name table_name_002, closure_desc 2, ty_desc ty_desc_002, label label_002, unit unit_id_000, module module_000, srcloc src_file_002:src_span_002
+7ffff7a4d740: IPE: table_name table_name_001, closure_desc 1, ty_desc ty_desc_001, label label_001, unit unit_id_000, module module_000, srcloc src_file_001:src_span_001
+7ffff7a4d740: IPE: table_name table_name_000, closure_desc 0, ty_desc ty_desc_000, label label_000, unit unit_id_000, module module_000, srcloc src_file_000:src_span_000
=====================================
testsuite/tests/rts/ipe/ipeMap.c
=====================================
@@ -68,10 +68,13 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) {
registerInfoProvList(node);
- InfoProvEnt result = lookupIPE_("shouldFindOneIfItHasBeenRegistered", get_itbl(fortyTwo));
+ const InfoProvEnt result = lookupIPE_("shouldFindOneIfItHasBeenRegistered", get_itbl(fortyTwo));
+
+ char closure_desc_buf[CLOSURE_DESC_BUFFER_SIZE] = {};
+ formatClosureDescIpe(&result, closure_desc_buf);
assertStringsEqual(result.prov.table_name, "table_name_042");
- assertStringsEqual(result.prov.closure_desc, "closure_desc_042");
+ assertStringsEqual(closure_desc_buf, "42");
assertStringsEqual(result.prov.ty_desc, "ty_desc_042");
assertStringsEqual(result.prov.label, "label_042");
assertStringsEqual(result.prov.unit_id, "unit-id");
=====================================
testsuite/tests/rts/ipe/ipe_lib.c
=====================================
@@ -33,10 +33,7 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) {
snprintf(tableName, tableNameLength, "table_name_%03i", i);
provEnt.table_name = add_string(st, tableName);
- unsigned int closureDescLength = strlen("closure_desc_") + 3 /* digits */ + 1 /* null character */;
- char *closureDesc = malloc(sizeof(char) * closureDescLength);
- snprintf(closureDesc, closureDescLength, "closure_desc_%03i", i);
- provEnt.closure_desc = add_string(st, closureDesc);
+ provEnt.closure_desc = i;
unsigned int tyDescLength = strlen("ty_desc_") + 3 /* digits */ + 1 /* null character */;
char *tyDesc = malloc(sizeof(char) * tyDescLength);
=====================================
testsuite/tests/rts/testwsdeque.c
=====================================
@@ -34,16 +34,16 @@ void *
myStealWSDeque_ (WSDeque *q, uint32_t n)
{
void * stolen;
-
+
// Can't do this on someone else's spark pool:
-// ASSERT_WSDEQUE_INVARIANTS(q);
-
+// ASSERT_WSDEQUE_INVARIANTS(q);
+
// NB. these loads must be ordered, otherwise there is a race
// between steal and pop.
StgWord t = ACQUIRE_LOAD(&q->top);
SEQ_CST_FENCE();
StgWord b = ACQUIRE_LOAD(&q->bottom);
-
+
void *result = NULL;
if (t < b) {
/* Non-empty queue */
@@ -59,11 +59,11 @@ void *
myStealWSDeque (WSDeque *q, uint32_t n)
{
void *stolen;
-
- do {
+
+ do {
stolen = myStealWSDeque_(q,n);
} while (stolen == NULL && !looksEmptyWSDeque(q));
-
+
return stolen;
}
@@ -89,15 +89,15 @@ void work(void *p, uint32_t n)
// debugBelch("work %ld %d\n", p, n);
val = *(StgWord *)p;
- if (val != 0) {
- fflush(stdout);
- fflush(stderr);
- barf("FAIL: %ld %d %d", p, n, val);
+ if (val != 0) {
+ fflush(stdout);
+ fflush(stderr);
+ barf("FAIL: %p %" FMT_Word32 " %" FMT_Word, p, n, val);
}
*(StgWord*)p = n+10;
}
-
-void OSThreadProcAttr thief(void *info)
+
+void* OSThreadProcAttr thief(void *info)
{
void *p;
StgWord n;
@@ -114,6 +114,7 @@ void OSThreadProcAttr thief(void *info)
if (p != NULL) { work(p,n+1); count++; }
}
debugBelch("thread %ld finished, stole %d", n, count);
+ return NULL;
}
int main(int argc, char*argv[])
@@ -124,13 +125,13 @@ int main(int argc, char*argv[])
q = newWSDeque(1024);
done = 0;
-
+
for (n=0; n < SCRATCH_SIZE; n++) {
scratch[n] = 0;
}
for (n=0; n < THREADS; n++) {
- createOSThread(&ids[n], "thief", thief, (void*)(StgWord)n);
+ createOSThread(&ids[n], "thief", (OSThreadProc*)thief, (void*)(StgWord)n);
}
for (n=0; n < SCRATCH_SIZE; n++) {
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ded5312a893ca971fe306094bc75cf5365640d1...3335cc0bef6c495453e63d33f01f6ca40836da08
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ded5312a893ca971fe306094bc75cf5365640d1...3335cc0bef6c495453e63d33f01f6ca40836da08
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/20240510/6b05db5e/attachment-0001.html>
More information about the ghc-commits
mailing list