[Git][ghc/ghc][wip/con-info] Split IPE stuff into separate file - separate from profiling
Matthew Pickering
gitlab at gitlab.haskell.org
Tue Nov 3 16:03:10 UTC 2020
Matthew Pickering pushed to branch wip/con-info at Glasgow Haskell Compiler / GHC
Commits:
3bc500f5 by Matthew Pickering at 2020-11-03T16:02:54+00:00
Split IPE stuff into separate file - separate from profiling
- - - - -
12 changed files:
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- includes/Rts.h
- includes/rts/Profiling.h
- libraries/base/GHC/Stack/CCS.hsc
- + rts/IPE.c
- + rts/IPE.h
- rts/Profiling.c
- rts/RtsStartup.c
- rts/RtsSymbols.c
- rts/rts.cabal.in
Changes:
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -314,7 +314,7 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs)
-- See note [Mapping Info Tables to Source Positions]
ipInitCode :: [CmmInfoTable] -> DynFlags -> Module -> InfoTableProvMap -> SDoc
ipInitCode used_info dflags this_mod (InfoTableProvMap dcmap closure_map)
- = if not (sccProfilingEnabled dflags)
+ = if not (gopt Opt_InfoTableMap dflags)
then empty
else withPprStyle (PprCode CStyle) $ pprTraceIt "ipInitCode" $ vcat
$ map emit_ipe_decl ents
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -131,6 +131,7 @@ data GeneralFlag
| Opt_NoTypeableBinds
| Opt_DistinctConstructorTables
+ | Opt_InfoTableMap
| Opt_WarnIsError -- -Werror; makes warnings fatal
| Opt_ShowWarnGroups -- Show the group a warning belongs to
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2916,6 +2916,9 @@ dynamic_flags_deps = [
, make_ord_flag defGhcFlag "fdistinct-constructor-tables"
(NoArg (setGeneralFlag Opt_DistinctConstructorTables))
+
+ , make_ord_flag defGhcFlag "finfo-table-map"
+ (NoArg (setGeneralFlag Opt_InfoTableMap))
------ Compiler flags -----------------------------------------------
, make_ord_flag defGhcFlag "fasm" (NoArg (setObjBackend NCG))
=====================================
includes/Rts.h
=====================================
@@ -235,6 +235,7 @@ void _assertFail(const char *filename, unsigned int linenum)
#include "rts/PrimFloat.h"
#include "rts/Main.h"
#include "rts/Profiling.h"
+#include "rts/IPE.h"
#include "rts/StaticPtrTable.h"
#include "rts/Libdw.h"
#include "rts/LibdwPool.h"
=====================================
includes/rts/Profiling.h
=====================================
@@ -14,6 +14,4 @@
#pragma once
void registerCcList(CostCentre **cc_list);
-void registerInfoProvList(InfoProvEnt **cc_list);
-void registerCcsList(CostCentreStack **cc_list);
-InfoProvEnt * lookupIPE(StgClosure *info);
\ No newline at end of file
+void registerCcsList(CostCentreStack **cc_list);
\ No newline at end of file
=====================================
libraries/base/GHC/Stack/CCS.hsc
=====================================
@@ -45,7 +45,6 @@ import GHC.Ptr
import GHC.Foreign as GHC
import GHC.IO.Encoding
import GHC.List ( concatMap, reverse )
-import Prelude (putStrLn, print)
#define PROFILING
#include "Rts.h"
@@ -161,12 +160,12 @@ ipModule p = (# peek InfoProv, module) p
ipSrcLoc p = (# peek InfoProv, srcloc) p
infoProvToStrings :: Ptr InfoProv -> IO [String]
-infoProvToStrings ip = do
- name <- GHC.peekCString utf8 =<< ipName ip
- desc <- GHC.peekCString utf8 =<< ipDesc ip
- label <- GHC.peekCString utf8 =<< ipLabel ip
- mod <- GHC.peekCString utf8 =<< ipModule ip
- loc <- GHC.peekCString utf8 =<< ipSrcLoc ip
+infoProvToStrings infop = do
+ name <- GHC.peekCString utf8 =<< ipName infop
+ desc <- GHC.peekCString utf8 =<< ipDesc infop
+ label <- GHC.peekCString utf8 =<< ipLabel infop
+ mod <- GHC.peekCString utf8 =<< ipModule infop
+ loc <- GHC.peekCString utf8 =<< ipSrcLoc infop
return [name, desc, label, mod, loc]
-- TODO: Add structured output of whereFrom
=====================================
rts/IPE.c
=====================================
@@ -0,0 +1,82 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2000
+ *
+ * Support for mapping info table pointers to source locations
+ *
+ * ---------------------------------------------------------------------------*/
+
+
+#include "PosixSource.h"
+#include "Rts.h"
+
+#include "RtsUtils.h"
+#include "Profiling.h"
+#include "Arena.h"
+#include "Printer.h"
+#include "Capability.h"
+
+#include <fs_rts.h>
+#include <string.h>
+
+#if defined(DEBUG) || defined(PROFILING)
+#include "Trace.h"
+#endif
+
+InfoProvEnt *IPE_LIST = NULL;
+
+static void
+dumpIPEToEventLog(void)
+{
+ InfoProvEnt *ip, *next;
+ for (ip = IPE_LIST; ip != NULL; ip = next) {
+ next = ip->link;
+ traceIPE(ip->info, ip->prov.table_name, ip->prov.closure_desc, ip->prov.label,
+ ip->prov.module, ip->prov.srcloc);
+ }
+}
+
+/* -----------------------------------------------------------------------------
+ Registering IPEs
+
+ Registering a IPE consists of linking it onto the list of registered IPEs
+
+ IPEs are registered at startup by a C constructor function
+ generated by the compiler (ProfInit.hs) in the _stub.c file for each module.
+ -------------------------------------------------------------------------- */
+
+static void
+registerInfoProvEnt(InfoProvEnt *ipe)
+{
+ //if (ipe->link == NULL) {
+ //
+ ipe->link = IPE_LIST;
+ IPE_LIST = ipe;
+ //}
+}
+
+void registerInfoProvList(InfoProvEnt **ent_list)
+{
+ for (InfoProvEnt **i = ent_list; *i != NULL; i++) {
+ registerInfoProvEnt(*i);
+ }
+}
+
+
+// MP: TODO: This should not be a linear search, need to improve
+// the IPE_LIST structure
+InfoProvEnt * lookupIPE(StgClosure *clos)
+{
+ StgInfoTable * info;
+ info = GET_INFO(clos);
+ InfoProvEnt *ip, *next;
+ //printf("%p\n", info);
+ //printf("%p\n\n", clos);
+ for (ip = IPE_LIST; ip != NULL; ip = next) {
+ if (ip->info == info) {
+ //printf("Found %p\n", ip->info);
+ return ip;
+ }
+ next = ip->link;
+ }
+}
\ No newline at end of file
=====================================
rts/IPE.h
=====================================
@@ -0,0 +1,12 @@
+/* -----------------------------------------------------------------------------
+ *
+ * (c) The GHC Team, 1998-2005
+ *
+ * Support for IPE
+ *
+ * ---------------------------------------------------------------------------*/
+
+#pragma once
+
+#include <stdio.h>
+
=====================================
rts/Profiling.c
=====================================
@@ -7,6 +7,7 @@
* ---------------------------------------------------------------------------*/
+#if defined(PROFILING)
#include "PosixSource.h"
#include "Rts.h"
@@ -23,9 +24,6 @@
#include <fs_rts.h>
#include <string.h>
-// TODO: These above includes are only used for lookupIPE when profiling is
-// not enabled.
-#if defined(PROFILING)
#if defined(DEBUG) || defined(PROFILING)
#include "Trace.h"
@@ -59,7 +57,6 @@ CostCentre *CC_LIST = NULL;
// parent of all cost centres stacks (done in initProfiling2()).
static CostCentreStack *CCS_LIST = NULL;
-InfoProvEnt *IPE_LIST = NULL;
#if defined(THREADED_RTS)
static Mutex ccs_mutex;
@@ -149,18 +146,6 @@ dumpCostCentresToEventLog(void)
#endif
}
-static void
-dumpIPEToEventLog(void)
-{
-#if defined(PROFILING)
- InfoProvEnt *ip, *next;
- for (ip = IPE_LIST; ip != NULL; ip = next) {
- next = ip->link;
- traceIPE(ip->info, ip->prov.table_name, ip->prov.closure_desc, ip->prov.label,
- ip->prov.module, ip->prov.srcloc);
- }
-#endif
-}
void initProfiling (void)
{
@@ -219,7 +204,6 @@ void initProfiling (void)
}
dumpCostCentresToEventLog();
- dumpIPEToEventLog();
}
@@ -356,16 +340,6 @@ static void registerCCS(CostCentreStack *ccs)
}
}
-static void
-registerInfoProvEnt(InfoProvEnt *ipe)
-{
- //if (ipe->link == NULL) {
- //
- ipe->link = IPE_LIST;
- IPE_LIST = ipe;
- //}
-}
-
void registerCcList(CostCentre **cc_list)
{
for (CostCentre **i = cc_list; *i != NULL; i++) {
@@ -380,13 +354,6 @@ void registerCcsList(CostCentreStack **cc_list)
}
}
-void registerInfoProvList(InfoProvEnt **ent_list)
-{
- for (InfoProvEnt **i = ent_list; *i != NULL; i++) {
- registerInfoProvEnt(*i);
- }
-}
-
/* -----------------------------------------------------------------------------
Set CCCS when entering a function.
@@ -1056,28 +1023,3 @@ debugCCS( CostCentreStack *ccs )
#endif /* DEBUG */
#endif /* PROFILING */
-
-// MP: TODO: This should not be a linear search, need to improve
-// the IPE_LIST structure
-#if defined(PROFILING)
-InfoProvEnt * lookupIPE(StgClosure *clos)
-{
- StgInfoTable * info;
- info = GET_INFO(clos);
- InfoProvEnt *ip, *next;
- //printf("%p\n", info);
- //printf("%p\n\n", clos);
- for (ip = IPE_LIST; ip != NULL; ip = next) {
- if (ip->info == info) {
- //printf("Found %p\n", ip->info);
- return ip;
- }
- next = ip->link;
- }
-}
-#else
-InfoProvEnt * lookupIPE(StgClosure *info STG_UNUSED)
-{
- return ;
-}
-#endif
\ No newline at end of file
=====================================
rts/RtsStartup.c
=====================================
@@ -32,6 +32,7 @@
#include "StaticPtrTable.h"
#include "Hash.h"
#include "Profiling.h"
+#include "IPE.h"
#include "ProfHeap.h"
#include "Timer.h"
#include "Globals.h"
=====================================
rts/RtsSymbols.c
=====================================
@@ -544,9 +544,7 @@
SymI_HasProto(pushCostCentre) \
SymI_HasProto(mkCostCentre) \
SymI_HasProto(registerCcList) \
- SymI_HasProto(registerInfoProvList) \
SymI_HasProto(registerCcsList) \
- SymI_HasProto(lookupIPE) \
SymI_HasProto(era)
#else
#define RTS_PROF_SYMBOLS /* empty */
@@ -1002,6 +1000,8 @@
SymI_HasProto(cas) \
SymI_HasProto(_assertFail) \
SymI_HasProto(keepCAFs) \
+ SymI_HasProto(registerInfoProvList) \
+ SymI_HasProto(lookupIPE) \
RTS_USER_SIGNALS_SYMBOLS \
RTS_INTCHAR_SYMBOLS
=====================================
rts/rts.cabal.in
=====================================
@@ -155,6 +155,7 @@ library
rts/Parallel.h
rts/PrimFloat.h
rts/Profiling.h
+ rts/IPE.h
rts/Signals.h
rts/SpinLock.h
rts/StableName.h
@@ -434,6 +435,7 @@ library
ProfilerReport.c
ProfilerReportJson.c
Profiling.c
+ IPE.c
Proftimer.c
RaiseAsync.c
RetainerProfile.c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bc500f5bc4e8cba0dad6efcf258fa4955cd10bc
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bc500f5bc4e8cba0dad6efcf258fa4955cd10bc
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/20201103/427e10e0/attachment-0001.html>
More information about the ghc-commits
mailing list