[Git][ghc/ghc][wip/T22077] Separate IPE source file from span
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Aug 19 15:20:00 UTC 2022
Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC
Commits:
2f935f8d by Ben Gamari at 2022-08-19T11:19:44-04:00
Separate IPE source file from span
The source file name can very often be shared across many IPE entries
whereas the source coordinates are generally unique. Separate the two to
exploit sharing of the former.
- - - - -
8 changed files:
- compiler/GHC/StgToCmm/InfoTableProv.hs
- libraries/base/GHC/InfoProv.hsc
- rts/IPE.c
- rts/Trace.c
- rts/Trace.h
- rts/eventlog/EventLog.c
- rts/eventlog/EventLog.h
- rts/include/rts/IPE.h
Changes:
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -4,6 +4,8 @@ import GHC.Prelude
import GHC.Platform
import GHC.Unit.Module
import GHC.Utils.Outputable
+import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
+import GHC.Data.FastString (unpackFS)
import GHC.Cmm.CLabel
import GHC.Cmm.Expr
@@ -44,7 +46,8 @@ emitIpeBufferListNode this_mod ents = do
, strtab_offset (ipeTypeDesc cg_ipe)
, strtab_offset (ipeLabel cg_ipe)
, strtab_offset (ipeModuleName cg_ipe)
- , strtab_offset (ipeSrcLoc cg_ipe)
+ , strtab_offset (ipeSrcFile cg_ipe)
+ , strtab_offset (ipeSrcSpan cg_ipe)
]
int n = mkIntCLit platform n
@@ -63,16 +66,26 @@ toCgIPE platform ctx module_name ipe = do
table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (infoTablePtr ipe))
closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe)
type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe
+ let label_str = maybe "" snd (infoTableProv ipe)
+ let (src_loc_file, src_loc_span) =
+ case infoTableProv ipe of
+ Nothing -> ("", "")
+ Just (span, _) ->
+ let file = unpackFS $ srcSpanFile span
+ coords = renderWithContext ctx (pprUserRealSpan False span)
+ in (file, coords)
let (src_loc_str, label_str) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ipe)
label <- lookupStringTable $ ST.pack label_str
- src_loc <- lookupStringTable $ ST.pack src_loc_str
+ src_file <- lookupStringTable $ ST.pack src_loc_file
+ src_span <- lookupStringTable $ ST.pack src_loc_span
return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe
, ipeTableName = table_name
, ipeClosureDesc = closure_desc
, ipeTypeDesc = type_desc
, ipeLabel = label
, ipeModuleName = module_name
- , ipeSrcLoc = src_loc
+ , ipeSrcFile = src_file
+ , ipeSrcSpan = src_span
}
data CgInfoProvEnt = CgInfoProvEnt
@@ -82,7 +95,8 @@ data CgInfoProvEnt = CgInfoProvEnt
, ipeTypeDesc :: !StrTabOffset
, ipeLabel :: !StrTabOffset
, ipeModuleName :: !StrTabOffset
- , ipeSrcLoc :: !StrTabOffset
+ , ipeSrcFile :: !StrTabOffset
+ , ipeSrcSpan :: !StrTabOffset
}
data StringTable = StringTable { stStrings :: DList ShortText
=====================================
libraries/base/GHC/InfoProv.hsc
=====================================
@@ -20,6 +20,7 @@
module GHC.InfoProv
( InfoProv(..)
+ , ipLoc
, ipeProv
, whereFrom
-- * Internals
@@ -42,10 +43,15 @@ data InfoProv = InfoProv {
ipTyDesc :: String,
ipLabel :: String,
ipMod :: String,
- ipLoc :: String
+ ipSrcFile :: String,
+ ipSrcSpan :: String
} deriving (Eq, Show)
+
data InfoProvEnt
+ipLoc :: InfoProv -> String
+ipLoc ipe = ipSrcFile ipe ++ ":" ++ ipSrcSpan ipe
+
getIPE :: a -> IO (Ptr InfoProvEnt)
getIPE obj = IO $ \s ->
case whereFrom## obj s of
@@ -54,13 +60,14 @@ getIPE obj = IO $ \s ->
ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv
ipeProv p = (#ptr InfoProvEnt, prov) p
-peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcLoc, peekIpTyDesc :: Ptr InfoProv -> IO CString
-peekIpName p = (# peek InfoProv, table_name) p
-peekIpDesc p = (# peek InfoProv, closure_desc) p
-peekIpLabel p = (# peek InfoProv, label) p
-peekIpModule p = (# peek InfoProv, module) p
-peekIpSrcLoc p = (# peek InfoProv, srcloc) p
-peekIpTyDesc p = (# peek InfoProv, ty_desc) p
+peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
+peekIpName p = (# peek InfoProv, table_name) p
+peekIpDesc p = (# peek InfoProv, closure_desc) p
+peekIpLabel p = (# peek InfoProv, label) p
+peekIpModule p = (# peek InfoProv, module) p
+peekIpSrcFile p = (# peek InfoProv, src_file) p
+peekIpSrcSpan p = (# peek InfoProv, src_span) p
+peekIpTyDesc p = (# peek InfoProv, ty_desc) p
peekInfoProv :: Ptr InfoProv -> IO InfoProv
peekInfoProv infop = do
@@ -69,14 +76,16 @@ peekInfoProv infop = do
tyDesc <- peekCString utf8 =<< peekIpTyDesc infop
label <- peekCString utf8 =<< peekIpLabel infop
mod <- peekCString utf8 =<< peekIpModule infop
- loc <- peekCString utf8 =<< peekIpSrcLoc infop
+ file <- peekCString utf8 =<< peekIpSrcFile infop
+ span <- peekCString utf8 =<< peekIpSrcSpan infop
return InfoProv {
ipName = name,
ipDesc = desc,
ipTyDesc = tyDesc,
ipLabel = label,
ipMod = mod,
- ipLoc = loc
+ ipSrcFile = file,
+ ipSrcSpan = span
}
-- | Get information about where a value originated from.
=====================================
rts/IPE.c
=====================================
@@ -85,7 +85,7 @@ void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED,
traceIPE(ipe->info, ipe->prov.table_name, ipe->prov.closure_desc,
ipe->prov.ty_desc, ipe->prov.label, ipe->prov.module,
- ipe->prov.srcloc);
+ ipe->prov.src_file, ipe->prov.src_span);
}
#endif
@@ -144,7 +144,8 @@ void updateIpeMap() {
ip_ents[i].prov.ty_desc = &strings[ent->ty_desc];
ip_ents[i].prov.label = &strings[ent->label];
ip_ents[i].prov.module = &strings[ent->module_name];
- ip_ents[i].prov.srcloc = &strings[ent->srcloc];
+ ip_ents[i].prov.src_file = &strings[ent->src_file];
+ ip_ents[i].prov.src_span = &strings[ent->src_span];
insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]);
}
=====================================
rts/Trace.c
=====================================
@@ -681,21 +681,22 @@ void traceIPE(const StgInfoTable * info,
const char *ty_desc,
const char *label,
const char *module,
- const char *srcloc )
+ const char *src_file,
+ const char *src_span)
{
#if defined(DEBUG)
if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
ACQUIRE_LOCK(&trace_utx);
tracePreface();
- debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s\n",
- table_name, closure_desc, ty_desc, label, module, srcloc);
+ debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s:%s\n",
+ table_name, closure_desc, ty_desc, label, module, src_file, src_span);
RELEASE_LOCK(&trace_utx);
} else
#endif
if (eventlog_enabled) {
- postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, srcloc);
+ postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, src_file, src_span);
}
}
=====================================
rts/Trace.h
=====================================
@@ -331,12 +331,13 @@ void traceNonmovingHeapCensus(uint32_t log_blk_size,
const struct NonmovingAllocCensus *census);
void traceIPE(const StgInfoTable *info,
- const char *table_name,
- const char *closure_desc,
- const char *ty_desc,
- const char *label,
- const char *module,
- const char *srcloc );
+ const char *table_name,
+ const char *closure_desc,
+ const char *ty_desc,
+ const char *label,
+ const char *module,
+ const char *src_file,
+ const char *src_span);
void flushTrace(void);
#else /* !TRACING */
@@ -373,7 +374,7 @@ void flushTrace(void);
#define traceTaskDelete_(taskID) /* nothing */
#define traceHeapProfBegin(profile_id) /* nothing */
#define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */
-#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, srcloc) /* nothing */
+#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, src_file, src_span) /* nothing */
#define traceHeapProfSampleBegin(era) /* nothing */
#define traceHeapBioProfSampleBegin(era, time) /* nothing */
#define traceHeapProfSampleEnd(era) /* nothing */
=====================================
rts/eventlog/EventLog.c
=====================================
@@ -166,7 +166,7 @@ static inline void postWord64(EventsBuf *eb, StgWord64 i)
postWord32(eb, (StgWord32)i);
}
-static inline void postBuf(EventsBuf *eb, StgWord8 *buf, uint32_t size)
+static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size)
{
memcpy(eb->pos, buf, size);
eb->pos += size;
@@ -1417,7 +1417,8 @@ void postIPE(StgWord64 info,
const char *ty_desc,
const char *label,
const char *module,
- const char *srcloc)
+ const char *src_file,
+ const char *src_span)
{
ACQUIRE_LOCK(&eventBufMutex);
StgWord table_name_len = strlen(table_name);
@@ -1425,10 +1426,11 @@ void postIPE(StgWord64 info,
StgWord ty_desc_len = strlen(ty_desc);
StgWord label_len = strlen(label);
StgWord module_len = strlen(module);
- StgWord srcloc_len = strlen(srcloc);
+ StgWord src_file_len = strlen(src_file);
+ StgWord src_span_len = strlen(src_span);
// 8 for the info word
// 6 for the number of strings in the payload as postString adds 1 to the length
- StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+srcloc_len+6;
+ StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+src_file_len+1+src_span_len+6;
ensureRoomForVariableEvent(&eventBuf, len);
postEventHeader(&eventBuf, EVENT_IPE);
postPayloadSize(&eventBuf, len);
@@ -1438,7 +1440,13 @@ void postIPE(StgWord64 info,
postString(&eventBuf, ty_desc);
postString(&eventBuf, label);
postString(&eventBuf, module);
- postString(&eventBuf, srcloc);
+
+ // Manually construct the string "<file>:<span>\0"
+ postBuf(&eventBuf, (const StgWord8*) src_file, src_file_len);
+ StgWord8 colon = ':';
+ postBuf(&eventBuf, &colon, 1);
+ postString(&eventBuf, src_span);
+
RELEASE_LOCK(&eventBufMutex);
}
=====================================
rts/eventlog/EventLog.h
=====================================
@@ -196,7 +196,8 @@ void postIPE(StgWord64 info,
const char *ty_desc,
const char *label,
const char *module,
- const char *srcloc);
+ const char *src_file,
+ const char *src_span);
void postConcUpdRemSetFlush(Capability *cap);
void postConcMarkEnd(StgWord32 marked_obj_count);
=====================================
rts/include/rts/IPE.h
=====================================
@@ -19,7 +19,8 @@ typedef struct InfoProv_ {
const char *ty_desc;
const char *label;
const char *module;
- const char *srcloc;
+ const char *src_file;
+ const char *src_span;
} InfoProv;
typedef struct InfoProvEnt_ {
@@ -51,7 +52,8 @@ typedef struct {
StringIdx ty_desc;
StringIdx label;
StringIdx module_name;
- StringIdx srcloc;
+ StringIdx src_file;
+ StringIdx src_span;
} IpeBufferEntry;
typedef struct IpeBufferListNode_ {
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f935f8d52802a1331955a360bd58ec3d323e647
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2f935f8d52802a1331955a360bd58ec3d323e647
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/20220819/b85a9b09/attachment-0001.html>
More information about the ghc-commits
mailing list