[Git][ghc/ghc][wip/con-info] 3 commits: Improvements
Matthew Pickering
gitlab at gitlab.haskell.org
Wed Nov 18 10:42:08 UTC 2020
Matthew Pickering pushed to branch wip/con-info at Glasgow Haskell Compiler / GHC
Commits:
c7ca7abe by Matthew Pickering at 2020-11-18T10:17:51+00:00
Improvements
- - - - -
fb41817c by Matthew Pickering at 2020-11-18T10:30:31+00:00
refactoring
- - - - -
129de9a0 by Matthew Pickering at 2020-11-18T10:41:19+00:00
new module
- - - - -
19 changed files:
- compiler/GHC/CoreToStg.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/StgToCmm/DataCon.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Prof.hs
- compiler/GHC/StgToCmm/Utils.hs
- compiler/GHC/Types/CostCentre.hs
- + compiler/GHC/Types/IPE.hs
- compiler/ghc.cabal.in
- includes/rts/Flags.h
- includes/rts/IPE.h
- includes/rts/prof/CCS.h
- libraries/base/GHC/Stack/CCS.hsc
- rts/ProfHeap.c
- rts/Trace.c
Changes:
=====================================
compiler/GHC/CoreToStg.hs
=====================================
@@ -47,6 +47,7 @@ import GHC.Driver.Session
import GHC.Platform.Ways
import GHC.Driver.Ppr
import GHC.Types.ForeignCall
+import GHC.Types.IPE
import GHC.Types.Demand ( isUsedOnce )
import GHC.Builtin.PrimOps ( PrimCall(..) )
import GHC.Types.SrcLoc ( mkGeneralSrcSpan )
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -51,6 +51,7 @@ import GHC.Unit.Finder ( mkStubPaths )
import GHC.Types.SrcLoc
import GHC.Types.CostCentre
+import GHC.Types.IPE
import GHC.Types.ForeignStubs
import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
=====================================
compiler/GHC/Driver/Hooks.hs
=====================================
@@ -46,6 +46,7 @@ import GHC.Types.Id
import GHC.Types.SrcLoc
import GHC.Types.Basic
import GHC.Types.CostCentre
+import GHC.Types.IPE
import GHC.Types.Meta
import GHC.Types.HpcInfo
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -173,6 +173,7 @@ import GHC.Types.ForeignStubs
import GHC.Types.Var.Env ( emptyTidyEnv )
import GHC.Types.Fixity.Env
import GHC.Types.CostCentre
+import GHC.Types.IPE
import GHC.Types.Unique.Supply
import GHC.Types.SourceFile
import GHC.Types.SrcLoc
@@ -1468,6 +1469,8 @@ hscGenHardCode hsc_env cgguts location output_filename = do
| otherwise = empty
------------------ Code generation ------------------
+ -- This IORef records which info tables are used during
+ -- code generation.
lref <- newIORef []
-- The back-end is streamed: each top-level function goes
-- from Stg all the way to asm before dealing with the next
=====================================
compiler/GHC/Stg/Debug.hs
=====================================
@@ -11,7 +11,7 @@ import GHC.Stg.Syntax
import GHC.Types.Id
import GHC.Core.DataCon
-import GHC.Types.CostCentre
+import GHC.Types.IPE
import GHC.Unit.Module
import GHC.Types.Name ( getName, getOccName, occNameString, nameSrcSpan)
import GHC.Data.FastString
=====================================
compiler/GHC/StgToCmm.hs
=====================================
@@ -39,6 +39,7 @@ import GHC.Cmm.Graph
import GHC.Stg.Syntax
import GHC.Types.CostCentre
+import GHC.Types.IPE
import GHC.Types.HpcInfo
import GHC.Types.Id
import GHC.Types.Id.Info
=====================================
compiler/GHC/StgToCmm/DataCon.hs
=====================================
@@ -189,7 +189,7 @@ buildDynCon' _ binder mn actually_bound ccs con args
; profile <- getProfile
; let platform = profilePlatform profile
(tot_wds, ptr_wds, args_w_offsets)
- = mkVirtConstrOffsets profile (addArgReps args)
+ = mkVirtConstrOffsets profile (addArgReps args)
nonptr_wds = tot_wds - ptr_wds
info_tbl = mkDataConInfoTable profile con ((modu,) <$> mn) False
ptr_wds nonptr_wds
@@ -310,8 +310,6 @@ precomputedStaticConInfo_maybe dflags binder con []
| isNullaryRepDataCon con
= Just $ litIdInfo (targetPlatform dflags) binder (mkConLFInfo con)
(CmmLabel (mkClosureLabel (dataConName con) NoCafRefs))
- -- = Just $ litIdInfo dflags binder (mkConLFInfo con)
- -- (CmmLabel (mkClosureLabel (idName binder) NoCafRefs))
precomputedStaticConInfo_maybe dflags binder con [arg]
-- Int/Char values with existing closures in the RTS
| intClosure || charClosure
=====================================
compiler/GHC/StgToCmm/Expr.hs
=====================================
@@ -82,7 +82,7 @@ cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do
cgExpr (StgOpApp op args ty) = cgOpApp op args ty
cgExpr (StgConApp con mn args _)= cgConApp con mn args
-cgExpr (StgTick t e) = cgTick t (cgExpr e)
+cgExpr (StgTick t e) = cgTick t >> cgExpr e
cgExpr (StgLit lit) = do cmm_lit <- cgLit lit
emitReturn [CmmLit cmm_lit]
@@ -1084,12 +1084,12 @@ emitEnter fun = do
-- | Generate Cmm code for a tick. Depending on the type of Tickish,
-- this will either generate actual Cmm instrumentation code, or
-- simply pass on the annotation as a @CmmTickish at .
-cgTick :: Tickish Id -> FCode a -> FCode a
-cgTick tick k
+cgTick :: Tickish Id -> FCode ()
+cgTick tick
= do { platform <- getPlatform
; case tick of
- ProfNote cc t p -> emitSetCCC cc t p >> k
- HpcTick m n -> emit (mkTickBox platform m n) >> k
- SourceNote s n -> emitTick (SourceNote s n) >> k
- _other -> k
+ ProfNote cc t p -> emitSetCCC cc t p
+ HpcTick m n -> emit (mkTickBox platform m n)
+ SourceNote s n -> emitTick (SourceNote s n)
+ _other -> return ()
}
=====================================
compiler/GHC/StgToCmm/Prof.hs
=====================================
@@ -44,6 +44,7 @@ import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.Types.CostCentre
+import GHC.Types.IPE
import GHC.Data.FastString
import GHC.Unit.Module as Module
import GHC.Utils.Outputable
@@ -344,7 +345,6 @@ bumpSccCount platform ccs
= addToMem (rEP_CostCentreStack_scc_count platform)
(cmmOffsetB platform ccs (pc_OFFSET_CostCentreStack_scc_count (platformConstants platform))) 1
-
-----------------------------------------------------------------------------
--
-- Lag/drag/void stuff
=====================================
compiler/GHC/StgToCmm/Utils.hs
=====================================
@@ -81,6 +81,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.RepType
import GHC.Types.CostCentre
+import GHC.Types.IPE
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
=====================================
compiler/GHC/Types/CostCentre.hs
=====================================
@@ -2,7 +2,6 @@
module GHC.Types.CostCentre (
CostCentre(..), CcName, CCFlavour(..),
-- All abstract except to friend: ParseIface.y
- DCMap, ClosureMap, InfoTableProvMap(..), emptyInfoTableProvMap,
CostCentreStack,
CollectedCCs, emptyCollectedCCs, collectCC,
currentCCS, dontCareCCS,
@@ -31,8 +30,6 @@ import GHC.Utils.Outputable
import GHC.Types.SrcLoc
import GHC.Data.FastString
import GHC.Types.CostCentre.State
-import GHC.Core.DataCon
-import GHC.Types.Unique.Map
import Data.Data
@@ -190,16 +187,6 @@ data CostCentreStack
deriving (Eq, Ord) -- needed for Ord on CLabel
-type DCMap = UniqMap DataCon [(Int, Maybe (RealSrcSpan, String))]
-
-type ClosureMap = UniqMap Name (String, RealSrcSpan, String)
-
-data InfoTableProvMap = InfoTableProvMap
- { provDC :: DCMap
- , provClosure :: ClosureMap }
-
-emptyInfoTableProvMap :: InfoTableProvMap
-emptyInfoTableProvMap = InfoTableProvMap emptyUniqMap emptyUniqMap
-- synonym for triple which describes the cost centre info in the generated
-- code for a module.
=====================================
compiler/GHC/Types/IPE.hs
=====================================
@@ -0,0 +1,21 @@
+module GHC.Types.IPE(DCMap, ClosureMap, InfoTableProvMap(..)
+ , emptyInfoTableProvMap) where
+
+import GHC.Prelude
+
+import GHC.Types.Name
+import GHC.Types.SrcLoc
+
+import GHC.Core.DataCon
+import GHC.Types.Unique.Map
+
+type DCMap = UniqMap DataCon [(Int, Maybe (RealSrcSpan, String))]
+
+type ClosureMap = UniqMap Name (String, RealSrcSpan, String)
+
+data InfoTableProvMap = InfoTableProvMap
+ { provDC :: DCMap
+ , provClosure :: ClosureMap }
+
+emptyInfoTableProvMap :: InfoTableProvMap
+emptyInfoTableProvMap = InfoTableProvMap emptyUniqMap emptyUniqMap
\ No newline at end of file
=====================================
compiler/ghc.cabal.in
=====================================
@@ -624,6 +624,7 @@ Library
GHC.Types.ForeignStubs
GHC.Types.HpcInfo
GHC.Types.Id
+ GHC.Types.IPE
GHC.Types.Id.Info
GHC.Types.Id.Make
GHC.Types.Literal
=====================================
includes/rts/Flags.h
=====================================
@@ -132,16 +132,16 @@ typedef struct _COST_CENTRE_FLAGS {
/* See Note [Synchronization of flags and base APIs] */
typedef struct _PROFILING_FLAGS {
uint32_t doHeapProfile;
-# define NO_HEAP_PROFILING 0 /* N.B. Used as indexes into arrays */
-# define HEAP_BY_CCS 1
-# define HEAP_BY_MOD 2
-# define HEAP_BY_DESCR 4
-# define HEAP_BY_TYPE 5
+# define NO_HEAP_PROFILING 0 /* N.B. Used as indexes into arrays */
+# define HEAP_BY_CCS 1
+# define HEAP_BY_MOD 2
+# define HEAP_BY_DESCR 4
+# define HEAP_BY_TYPE 5
# define HEAP_BY_RETAINER 6
# define HEAP_BY_LDV 7
# define HEAP_BY_CLOSURE_TYPE 8
-# define HEAP_BY_INFO_TABLE 9
+# define HEAP_BY_INFO_TABLE 9
Time heapProfileInterval; /* time between samples */
uint32_t heapProfileIntervalTicks; /* ticks between samples (derived) */
=====================================
includes/rts/IPE.h
=====================================
@@ -13,5 +13,23 @@
#pragma once
+
+typedef struct InfoProv_{
+ char * table_name;
+ char * closure_desc;
+ char * ty_desc;
+ char * label;
+ char * module;
+ char * srcloc;
+} InfoProv;
+
+typedef struct InfoProvEnt_ {
+ StgInfoTable * info;
+ InfoProv prov;
+ struct InfoProvEnt_ *link;
+} InfoProvEnt;
+
+extern InfoProvEnt * RTS_VAR(IPE_LIST); // registered IP list
+
void registerInfoProvList(InfoProvEnt **cc_list);
-InfoProvEnt * lookupIPE(StgInfoTable *info);
\ No newline at end of file
+InfoProvEnt * lookupIPE(StgInfoTable *info);
=====================================
includes/rts/prof/CCS.h
=====================================
@@ -73,20 +73,6 @@ typedef struct CostCentreStack_ {
} CostCentreStack;
-typedef struct InfoProv_{
- char * table_name;
- char * closure_desc;
- char * ty_desc;
- char * label;
- char * module;
- char * srcloc;
-} InfoProv;
-
-typedef struct InfoProvEnt_ {
- StgInfoTable * info;
- InfoProv prov;
- struct InfoProvEnt_ *link;
-} InfoProvEnt;
/* -----------------------------------------------------------------------------
@@ -193,7 +179,6 @@ void enterFunCCS (StgRegTable *reg, CostCentreStack *);
CostCentre *mkCostCentre (char *label, char *module, char *srcloc);
extern CostCentre * RTS_VAR(CC_LIST); // registered CC list
-extern InfoProvEnt * RTS_VAR(IPE_LIST); // registered IP list
/* -----------------------------------------------------------------------------
* Declaring Cost Centres & Cost Centre Stacks.
=====================================
libraries/base/GHC/Stack/CCS.hsc
=====================================
@@ -149,8 +149,7 @@ getIPE obj = IO $ \s ->
(## s', addr ##) -> (## s', Ptr addr ##)
ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv
-ipeProv p = p `plusPtr` 8 --(#offsetof InfoProvEnt, prov) -- TODO, offset is to the "prov" field but not sure how to express this
- -- (# sizeOf * StgInfoTable)
+ipeProv p = (#ptr InfoProvEnt, prov) p
ipName, ipDesc, ipLabel, ipModule, ipSrcLoc, ipTyDesc :: Ptr InfoProv -> IO CString
ipName p = (# peek InfoProv, table_name) p
=====================================
rts/ProfHeap.c
=====================================
@@ -961,8 +961,6 @@ dumpCensus( Census *census )
break;
case HEAP_BY_INFO_TABLE:
fprintf(hp_file, "%p", ctr->identity);
- // TODO now all the types in this mode are just THUNK closures so
- // don't really need to add any more info
char str[100];
sprintf(str, "%p", ctr->identity);
traceHeapProfSampleString(0, str, count * sizeof(W_));
=====================================
rts/Trace.c
=====================================
@@ -663,7 +663,6 @@ void traceHeapProfCostCentre(StgWord32 ccID,
}
}
-
// This one is for .hp samples
void traceHeapProfSampleCostCentre(StgWord8 profile_id,
CostCentreStack *stack, StgWord residency)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ce72ae05f126285579a6d228c44bd6dedbee71e...129de9a0aa783114fbeabf557d3591d75f0aec0c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ce72ae05f126285579a6d228c44bd6dedbee71e...129de9a0aa783114fbeabf557d3591d75f0aec0c
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/20201118/a39723a9/attachment-0001.html>
More information about the ghc-commits
mailing list