diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-11-26 12:20:25 +0000 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2021-11-26 12:20:25 +0000 |
| commit | e05c9c65a9ca8f65789c405c439505ebc280a89f (patch) | |
| tree | a23b4428c16410f25d4b0aee35ee391fd902c6e6 | |
| parent | bad388c659a362245d9a6bdc24f41cb45d6f0a88 (diff) | |
| download | haskell-e05c9c65a9ca8f65789c405c439505ebc280a89f.tar.gz | |
Fix ticky counter info stuff
| -rw-r--r-- | compiler/GHC/StgToCmm/Ticky.hs | 19 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Utils.hs | 1 | ||||
| -rw-r--r-- | rts/eventlog/EventLog.c | 2 |
3 files changed, 17 insertions, 5 deletions
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs index 23a9992e78..2f45d1f278 100644 --- a/compiler/GHC/StgToCmm/Ticky.hs +++ b/compiler/GHC/StgToCmm/Ticky.hs @@ -141,6 +141,7 @@ import Data.Maybe import qualified Data.Char import Control.Monad ( when ) import GHC.Types.Id.Info +import GHC.Utils.Trace ----------------------------------------------------------------------------- -- @@ -247,11 +248,21 @@ emitTickyCounter cloType name args then n <+> parens (ppr mod_name) <+> ext <+> p else n <+> ext <+> p ; this_mod <- getModuleName + ; let t = case cloType of + TickyCon {} -> "C" + TickyFun {} -> "F" + TickyThunk {} -> "T" + TickyLNE {} -> "L" ; let info_lbl = case cloType of TickyCon dc mn -> case mn of - NoNumber -> mkConInfoTableLabel (dataConName dc) DefinitionSite - (Numbered n) -> mkConInfoTableLabel (dataConName dc) (UsageSite this_mod n) - _ -> mkClosureLabel name NoCafRefs + NoNumber -> CmmLabel $ mkConInfoTableLabel (dataConName dc) DefinitionSite + (Numbered n) -> CmmLabel $ mkConInfoTableLabel (dataConName dc) (UsageSite this_mod n) + TickyFun {} -> + pprTrace "tickyF" (text t <> colon <> ppr name <+> ppr (mkInfoTableLabel name NoCafRefs) $$ ppr mod_name) $ + CmmLabel $ mkInfoTableLabel name NoCafRefs + + _ -> pprTrace "ticky" (text t <> colon <> ppr name <+> ppr (mkInfoTableLabel name NoCafRefs)) $ zeroCLit platform + _ -> CmmLabel $ mkInfoTableLabel name NoCafRefs ; let ctx = (initSDocContext dflags defaultDumpStyle) @@ -269,7 +280,7 @@ emitTickyCounter cloType name args mkIntCLit platform 0, -- Heap allocated for this thing fun_descr_lit, arg_descr_lit, - CmmLabel info_lbl, + info_lbl, zeroCLit platform, -- Entries into this thing zeroCLit platform, -- Heap allocated by this thing zeroCLit platform -- Link to next StgEntCounter diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs index 3d79193de1..809c38bc8b 100644 --- a/compiler/GHC/StgToCmm/Utils.hs +++ b/compiler/GHC/StgToCmm/Utils.hs @@ -91,6 +91,7 @@ import GHC.Types.Unique.FM import GHC.Data.Maybe import Control.Monad import qualified Data.Map.Strict as Map +import GHC.Utils.Trace -------------------------------------------------------------------------- -- diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c index b6a0a48ca8..8b88f6fea7 100644 --- a/rts/eventlog/EventLog.c +++ b/rts/eventlog/EventLog.c @@ -1686,7 +1686,7 @@ static void postTickyCounterDef(EventsBuf *eb, StgEntCounter *p) postWord16(eb, (uint16_t) p->arity); postString(eb, p->arg_kinds); postString(eb, p->str); - postWord64(eb, (HsWord64)(p->info)); + postWord64(eb, (W_) (INFO_PTR_TO_STRUCT(p->info))); } void postTickyCounterDefs(StgEntCounter *counters) |