[Git][ghc/ghc][wip/specialist-changes-9.6] 4 commits: rts/IPE: Don't expose helper in header
Finley McIlwaine (@FinleyMcIlwaine)
gitlab at gitlab.haskell.org
Wed Sep 27 17:55:29 UTC 2023
Finley McIlwaine pushed to branch wip/specialist-changes-9.6 at Glasgow Haskell Compiler / GHC
Commits:
2db5ad17 by Ben Gamari at 2023-09-27T10:53:26-07:00
rts/IPE: Don't expose helper in header
- - - - -
5ca4a8e5 by Ben Gamari at 2023-09-27T10:53:34-07:00
rts/IPE: Share module_name within a Node
This allows us to shave a 64-bit word off of the packed IPE entry size.
- - - - -
134209fc by Ben Gamari at 2023-09-27T10:54:17-07:00
IPE: Include unit id
- - - - -
d234d7af by Ben Gamari at 2023-09-27T10:55:15-07:00
rts: Refactor GHC.Stack.CloneStack.decode
Don't allocate a Ptr constructor per frame.
- - - - -
15 changed files:
- compiler/GHC/StgToCmm/InfoTableProv.hs
- libraries/base/GHC/InfoProv/Types.hsc
- libraries/base/GHC/Stack/CloneStack.hs
- rts/CloneStack.c
- rts/CloneStack.h
- rts/IPE.c
- rts/IPE.h
- rts/Trace.c
- rts/include/rts/IPE.h
- testsuite/tests/profiling/should_run/staticcallstack001.stdout
- testsuite/tests/profiling/should_run/staticcallstack002.stdout
- 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
Changes:
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -83,9 +83,11 @@ emitIpeBufferListNode this_mod ents = do
platform = stgToCmmPlatform cfg
int n = mkIntCLit platform n
- (cg_ipes, strtab) = flip runState emptyStringTable $ do
- module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod)
- mapM (toCgIPE platform ctx module_name) ents
+ ((cg_ipes, unit_id, module_name), strtab) = flip runState emptyStringTable $ do
+ unit_id <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr $ moduleName this_mod)
+ module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr $ moduleUnit this_mod)
+ cg_ipes <- mapM (toCgIPE platform ctx) ents
+ return (cg_ipes, unit_id, module_name)
tables :: [CmmStatic]
tables = map (CmmStaticLit . CmmLabel . ipeInfoTablePtr) cg_ipes
@@ -136,6 +138,12 @@ emitIpeBufferListNode this_mod ents = do
-- 'string_table_size' field (decompressed size)
, int $ BS.length uncompressed_strings
+
+ -- 'module_name' field
+ , CmmInt (fromIntegral module_name) W32
+
+ -- 'unit_id' field
+ , CmmInt (fromIntegral unit_id) W32
]
-- Emit the list of info table pointers
@@ -173,10 +181,8 @@ toIpeBufferEntries byte_order cg_ipes =
, ipeClosureDesc cg_ipe
, ipeTypeDesc cg_ipe
, ipeLabel cg_ipe
- , ipeModuleName cg_ipe
, ipeSrcFile cg_ipe
, ipeSrcSpan cg_ipe
- , 0 -- padding
]
word32Builder :: Word32 -> BSB.Builder
@@ -184,8 +190,8 @@ toIpeBufferEntries byte_order cg_ipes =
BigEndian -> BSB.word32BE
LittleEndian -> BSB.word32LE
-toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt
-toCgIPE platform ctx module_name ipe = do
+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
@@ -205,7 +211,6 @@ toCgIPE platform ctx module_name ipe = do
, ipeClosureDesc = closure_desc
, ipeTypeDesc = type_desc
, ipeLabel = label
- , ipeModuleName = module_name
, ipeSrcFile = src_file
, ipeSrcSpan = src_span
}
@@ -216,7 +221,6 @@ data CgInfoProvEnt = CgInfoProvEnt
, ipeClosureDesc :: !StrTabOffset
, ipeTypeDesc :: !StrTabOffset
, ipeLabel :: !StrTabOffset
- , ipeModuleName :: !StrTabOffset
, ipeSrcFile :: !StrTabOffset
, ipeSrcSpan :: !StrTabOffset
}
=====================================
libraries/base/GHC/InfoProv/Types.hsc
=====================================
@@ -30,6 +30,7 @@ data InfoProv = InfoProv {
ipDesc :: String,
ipTyDesc :: String,
ipLabel :: String,
+ ipUnitId :: String,
ipMod :: String,
ipSrcFile :: String,
ipSrcSpan :: String
@@ -62,10 +63,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, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
+peekIpName, peekIpDesc, peekIpLabel, peekIpUnitId, 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
+peekIpUnitId p = (# peek InfoProv, unit_id) p
peekIpModule p = (# peek InfoProv, module) p
peekIpSrcFile p = (# peek InfoProv, src_file) p
peekIpSrcSpan p = (# peek InfoProv, src_span) p
@@ -77,6 +79,7 @@ peekInfoProv infop = do
desc <- peekCString utf8 =<< peekIpDesc infop
tyDesc <- peekCString utf8 =<< peekIpTyDesc infop
label <- peekCString utf8 =<< peekIpLabel infop
+ unit_id <- peekCString utf8 =<< peekIpUnitId infop
mod <- peekCString utf8 =<< peekIpModule infop
file <- peekCString utf8 =<< peekIpSrcFile infop
span <- peekCString utf8 =<< peekIpSrcSpan infop
@@ -85,6 +88,7 @@ peekInfoProv infop = do
ipDesc = desc,
ipTyDesc = tyDesc,
ipLabel = label,
+ ipUnitId = unit_id,
ipMod = mod,
ipSrcFile = file,
ipSrcSpan = span
=====================================
libraries/base/GHC/Stack/CloneStack.hs
=====================================
@@ -26,7 +26,8 @@ import Control.Concurrent.MVar
import Data.Maybe (catMaybes)
import Foreign
import GHC.Conc.Sync
-import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#)
+import GHC.Ptr (Ptr(..))
+import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, ByteArray#, sizeofByteArray#, indexAddrArray#, State#, StablePtr#)
import GHC.IO (IO (..), unIO, unsafeInterleaveIO)
import GHC.InfoProv.Types (InfoProv (..), ipLoc, lookupIPE, StgInfoTable)
import GHC.Stable
@@ -36,7 +37,7 @@ import GHC.Stable
-- @since 4.17.0.0
data StackSnapshot = StackSnapshot !StackSnapshot#
-foreign import prim "stg_decodeStackzh" decodeStack# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, Array# (Ptr StgInfoTable) #)
+foreign import prim "stg_decodeStackzh" decodeStack# :: StackSnapshot# -> State# RealWorld -> (# State# RealWorld, ByteArray# #)
foreign import prim "stg_cloneMyStackzh" cloneMyStack# :: State# RealWorld -> (# State# RealWorld, StackSnapshot# #)
@@ -243,15 +244,16 @@ toStackEntry infoProv =
getDecodedStackArray :: StackSnapshot -> IO [Maybe StackEntry]
getDecodedStackArray (StackSnapshot s) =
IO $ \s0 -> case decodeStack# s s0 of
- (# s1, arr #) -> unIO (go arr (I# (sizeofArray# arr) - 1)) s1
+ (# s1, arr #) ->
+ let n = I# (sizeofByteArray# arr) `div` 8 - 1
+ in unIO (go arr n) s1
where
- go :: Array# (Ptr StgInfoTable) -> Int -> IO [Maybe StackEntry]
+ go :: ByteArray# -> Int -> IO [Maybe StackEntry]
go _stack (-1) = return []
go stack i = do
infoProv <- lookupIPE (stackEntryAt stack i)
rest <- unsafeInterleaveIO $ go stack (i-1)
return ((toStackEntry `fmap` infoProv) : rest)
- stackEntryAt :: Array# (Ptr StgInfoTable) -> Int -> Ptr StgInfoTable
- stackEntryAt stack (I# i) = case indexArray# stack i of
- (# se #) -> se
+ stackEntryAt :: ByteArray# -> Int -> Ptr StgInfoTable
+ stackEntryAt stack (I# i) = Ptr (indexAddrArray# stack i)
=====================================
rts/CloneStack.c
=====================================
@@ -27,9 +27,8 @@
static StgWord getStackFrameCount(StgStack* stack);
static StgWord getStackChunkClosureCount(StgStack* stack);
-static void copyPtrsToArray(Capability *cap, StgMutArrPtrs* arr, StgStack* stack);
-static StgClosure* createPtrClosure(Capability* cap, const StgInfoTable* itbl);
-static StgMutArrPtrs* allocateMutableArray(StgWord size);
+static StgArrBytes* allocateByteArray(Capability *cap, StgWord bytes);
+static void copyPtrsToArray(StgArrBytes* arr, StgStack* stack);
static StgStack* cloneStackChunk(Capability* capability, const StgStack* stack)
{
@@ -117,12 +116,12 @@ void sendCloneStackMessage(StgTSO *tso STG_UNUSED, HsStablePtr mvar STG_UNUSED)
// array is the count of stack frames.
// Each InfoProvEnt* is looked up by lookupIPE(). If there's no IPE for a stack
// frame it's represented by null.
-StgMutArrPtrs* decodeClonedStack(Capability *cap, StgStack* stack) {
+StgArrBytes* decodeClonedStack(Capability *cap, StgStack* stack) {
StgWord closureCount = getStackFrameCount(stack);
- StgMutArrPtrs* array = allocateMutableArray(closureCount);
+ StgArrBytes* array = allocateByteArray(cap, sizeof(StgInfoTable*) * closureCount);
- copyPtrsToArray(cap, array, stack);
+ copyPtrsToArray(array, stack);
return array;
}
@@ -158,36 +157,33 @@ StgWord getStackChunkClosureCount(StgStack* stack) {
return closureCount;
}
-// Allocate and initialize memory for a MutableArray# (Haskell representation).
-StgMutArrPtrs* allocateMutableArray(StgWord closureCount) {
+// Allocate and initialize memory for a ByteArray# (Haskell representation).
+StgArrBytes* allocateByteArray(Capability *cap, StgWord bytes) {
// Idea stolen from PrimOps.cmm:stg_newArrayzh()
- StgWord size = closureCount + mutArrPtrsCardTableSize(closureCount);
- StgWord words = sizeofW(StgMutArrPtrs) + size;
+ StgWord words = sizeofW(StgArrBytes) + bytes;
- StgMutArrPtrs* array = (StgMutArrPtrs*) allocate(myTask()->cap, words);
-
- SET_HDR(array, &stg_MUT_ARR_PTRS_DIRTY_info, CCS_SYSTEM);
- array->ptrs = closureCount;
- array->size = size;
+ StgArrBytes* array = (StgArrBytes*) allocate(cap, words);
+ SET_HDR(array, &stg_ARR_WORDS_info, CCS_SYSTEM);
+ array->bytes = bytes;
return array;
}
-
-void copyPtrsToArray(Capability *cap, StgMutArrPtrs* arr, StgStack* stack) {
+static void copyPtrsToArray(StgArrBytes* arr, StgStack* stack) {
StgWord index = 0;
StgStack *last_stack = stack;
+ const StgInfoTable **result = (const StgInfoTable **) arr->payload;
while (true) {
StgPtr sp = last_stack->sp;
StgPtr spBottom = last_stack->stack + last_stack->stack_size;
for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
const StgInfoTable* infoTable = ((StgClosure *)sp)->header.info;
- arr->payload[index] = createPtrClosure(cap, infoTable);
+ result[index] = infoTable;
index++;
}
// Ensure that we didn't overflow the result array
- ASSERT(index-1 < arr->ptrs);
+ ASSERT(index-1 < arr->bytes / sizeof(StgInfoTable*));
// check whether the stack ends in an underflow frame
StgUnderflowFrame *frame = (StgUnderflowFrame *) (last_stack->stack
@@ -199,12 +195,3 @@ void copyPtrsToArray(Capability *cap, StgMutArrPtrs* arr, StgStack* stack) {
}
}
}
-
-// Create a GHC.Ptr (Haskell constructor: `Ptr StgInfoTable`) pointing to the
-// info table.
-StgClosure* createPtrClosure(Capability *cap, const StgInfoTable* itbl) {
- StgClosure *p = (StgClosure *) allocate(cap, CONSTR_sizeW(0,1));
- SET_HDR(p, &base_GHCziPtr_Ptr_con_info, CCS_SYSTEM);
- p->payload[0] = (StgClosure*) itbl;
- return TAG_CLOSURE(1, p);
-}
=====================================
rts/CloneStack.h
=====================================
@@ -15,7 +15,7 @@ StgStack* cloneStack(Capability* capability, const StgStack* stack);
void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar);
-StgMutArrPtrs* decodeClonedStack(Capability *cap, StgStack* stack);
+StgArrBytes* decodeClonedStack(Capability *cap, StgStack* stack);
#include "BeginPrivate.h"
=====================================
rts/IPE.c
=====================================
@@ -76,6 +76,7 @@ static HashTable *ipeMap = NULL;
static IpeBufferListNode *ipeBufferList = NULL;
static void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode*);
+static void updateIpeMap(void);
#if defined(THREADED_RTS)
@@ -104,7 +105,8 @@ static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, uint32_t i
.closure_desc = &strings[ent->closure_desc],
.ty_desc = &strings[ent->ty_desc],
.label = &strings[ent->label],
- .module = &strings[ent->module_name],
+ .unit_id = &strings[node->unit_id],
+ .module = &strings[node->module_name],
.src_file = &strings[ent->src_file],
.src_span = &strings[ent->src_span]
}
=====================================
rts/IPE.h
=====================================
@@ -14,7 +14,6 @@
#include "BeginPrivate.h"
void dumpIPEToEventLog(void);
-void updateIpeMap(void);
void initIpe(void);
void exitIpe(void);
=====================================
rts/Trace.c
=====================================
@@ -689,9 +689,10 @@ void traceIPE(const InfoProvEnt *ipe)
ACQUIRE_LOCK(&trace_utx);
tracePreface();
- debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s:%s\n",
+ 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.label, ipe->prov.module, ipe->prov.src_file, ipe->prov.src_span);
+ ipe->prov.label, ipe->prov.unit_id, ipe->prov.module,
+ ipe->prov.src_file, ipe->prov.src_span);
RELEASE_LOCK(&trace_utx);
} else
=====================================
rts/include/rts/IPE.h
=====================================
@@ -18,6 +18,7 @@ typedef struct InfoProv_ {
const char *closure_desc;
const char *ty_desc;
const char *label;
+ const char *unit_id;
const char *module;
const char *src_file;
const char *src_span;
@@ -56,10 +57,8 @@ typedef struct {
StringIdx closure_desc;
StringIdx ty_desc;
StringIdx label;
- StringIdx module_name;
StringIdx src_file;
StringIdx src_span;
- uint32_t _padding;
} IpeBufferEntry;
GHC_STATIC_ASSERT(sizeof(IpeBufferEntry) % (WORD_SIZE_IN_BITS / 8) == 0, "sizeof(IpeBufferEntry) must be a multiple of the word size");
@@ -76,13 +75,16 @@ typedef struct IpeBufferListNode_ {
// When TNTC is enabled, these will point to the entry code
// not the info table itself.
- StgInfoTable **tables;
-
+ const StgInfoTable **tables;
IpeBufferEntry *entries;
StgWord entries_size; // decompressed size
char *string_table;
StgWord string_table_size; // decompressed size
+
+ // Shared by all entries
+ StringIdx unit_id;
+ StringIdx module_name;
} IpeBufferListNode;
void registerInfoProvList(IpeBufferListNode *node);
=====================================
testsuite/tests/profiling/should_run/staticcallstack001.stdout
=====================================
@@ -1,3 +1,3 @@
-Just (InfoProv {ipName = "D_Main_4_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "16:13-27"})
-Just (InfoProv {ipName = "D_Main_2_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "caf", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "13:1-9"})
-Just (InfoProv {ipName = "sat_s11M_info", ipDesc = "15", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "18:23-32"})
+Just (InfoProv {ipName = "D_Main_4_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "16:13-27"})
+Just (InfoProv {ipName = "D_Main_2_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "caf", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "13:1-9"})
+Just (InfoProv {ipName = "sat_s13S_info", ipDesc = "15", ipTyDesc = "D", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "18:23-32"})
=====================================
testsuite/tests/profiling/should_run/staticcallstack002.stdout
=====================================
@@ -1,4 +1,4 @@
-Just (InfoProv {ipName = "sat_s11p_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"})
-Just (InfoProv {ipName = "sat_s11F_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"})
-Just (InfoProv {ipName = "sat_s11V_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"})
-Just (InfoProv {ipName = "sat_s12b_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"})
+Just (InfoProv {ipName = "sat_s13u_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"})
+Just (InfoProv {ipName = "sat_s13O_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"})
+Just (InfoProv {ipName = "sat_s148_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"})
+Just (InfoProv {ipName = "sat_s14s_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipUnitId = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"})
=====================================
testsuite/tests/rts/ipe/ipeEventLog.stderr
=====================================
@@ -1,20 +1,20 @@
-7f5278bc0740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc src_file_000:src_span_000
-7f5278bc0740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc src_file_001:src_span_001
-7f5278bc0740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc src_file_002:src_span_002
-7f5278bc0740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc src_file_003:src_span_003
-7f5278bc0740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc src_file_004:src_span_004
-7f5278bc0740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc src_file_005:src_span_005
-7f5278bc0740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc src_file_006:src_span_006
-7f5278bc0740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc src_file_007:src_span_007
-7f5278bc0740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc src_file_008:src_span_008
-7f5278bc0740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc src_file_009:src_span_009
-7f5278bc0740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc src_file_000:src_span_000
-7f5278bc0740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc src_file_001:src_span_001
-7f5278bc0740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc src_file_002:src_span_002
-7f5278bc0740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc src_file_003:src_span_003
-7f5278bc0740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc src_file_004:src_span_004
-7f5278bc0740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc src_file_005:src_span_005
-7f5278bc0740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc src_file_006:src_span_006
-7f5278bc0740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc src_file_007:src_span_007
-7f5278bc0740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc src_file_008:src_span_008
-7f5278bc0740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, 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 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
=====================================
testsuite/tests/rts/ipe/ipeEventLog_fromMap.stderr
=====================================
@@ -1,68 +1,20 @@
-7f86c4be8740: created capset 0 of type 2
-7f86c4be8740: created capset 1 of type 3
-7f86c4be8740: cap 0: initialised
-7f86c4be8740: assigned cap 0 to capset 0
-7f86c4be8740: assigned cap 0 to capset 1
-7f86c4be8740: cap 0: created thread 1[""]
-7f86c4be8740: cap 0: running thread 1[""] (ThreadRunGHC)
-7f86c4be8740: cap 0: thread 1[""] stopped (stack overflow, size 109)
-7f86c4be8740: cap 0: running thread 1[""] (ThreadRunGHC)
-7f86c4be8740: cap 0: created thread 2[""]
-7f86c4be8740: cap 0: thread 2 has label IOManager on cap 0
-7f86c4be8740: cap 0: thread 1[""] stopped (yielding)
-7f86b67fc640: cap 0: running thread 2["IOManager on cap 0"] (ThreadRunGHC)
-7f86b67fc640: cap 0: thread 2["IOManager on cap 0"] stopped (yielding)
-7f86c4be8740: cap 0: running thread 1[""] (ThreadRunGHC)
-7f86c4be8740: cap 0: created thread 3[""]
-7f86c4be8740: cap 0: thread 3 has label TimerManager
-7f86c4be8740: cap 0: thread 1[""] stopped (finished)
-7f86c4be8740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc src_file_009:src_span_009
-7f86c4be8740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc src_file_008:src_span_008
-7f86c4be8740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc src_file_007:src_span_007
-7f86c4be8740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc src_file_006:src_span_006
-7f86c4be8740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc src_file_005:src_span_005
-7f86c4be8740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc src_file_004:src_span_004
-7f86c4be8740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc src_file_003:src_span_003
-7f86c4be8740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc src_file_002:src_span_002
-7f86c4be8740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc src_file_001:src_span_001
-7f86c4be8740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc src_file_000:src_span_000
-7f86c4be8740: IPE: table_name table_name_009, closure_desc closure_desc_009, ty_desc ty_desc_009, label label_009, module module_009, srcloc src_file_009:src_span_009
-7f86c4be8740: IPE: table_name table_name_008, closure_desc closure_desc_008, ty_desc ty_desc_008, label label_008, module module_008, srcloc src_file_008:src_span_008
-7f86c4be8740: IPE: table_name table_name_007, closure_desc closure_desc_007, ty_desc ty_desc_007, label label_007, module module_007, srcloc src_file_007:src_span_007
-7f86c4be8740: IPE: table_name table_name_006, closure_desc closure_desc_006, ty_desc ty_desc_006, label label_006, module module_006, srcloc src_file_006:src_span_006
-7f86c4be8740: IPE: table_name table_name_005, closure_desc closure_desc_005, ty_desc ty_desc_005, label label_005, module module_005, srcloc src_file_005:src_span_005
-7f86c4be8740: IPE: table_name table_name_004, closure_desc closure_desc_004, ty_desc ty_desc_004, label label_004, module module_004, srcloc src_file_004:src_span_004
-7f86c4be8740: IPE: table_name table_name_003, closure_desc closure_desc_003, ty_desc ty_desc_003, label label_003, module module_003, srcloc src_file_003:src_span_003
-7f86c4be8740: IPE: table_name table_name_002, closure_desc closure_desc_002, ty_desc ty_desc_002, label label_002, module module_002, srcloc src_file_002:src_span_002
-7f86c4be8740: IPE: table_name table_name_001, closure_desc closure_desc_001, ty_desc ty_desc_001, label label_001, module module_001, srcloc src_file_001:src_span_001
-7f86c4be8740: IPE: table_name table_name_000, closure_desc closure_desc_000, ty_desc ty_desc_000, label label_000, module module_000, srcloc src_file_000:src_span_000
-7f86c4be8740: cap 0: created thread 4[""]
-7f86b67fc640: cap 0: running thread 2["IOManager on cap 0"] (ThreadRunGHC)
-7f86b67fc640: cap 0: thread 2["IOManager on cap 0"] stopped (suspended while making a foreign call)
-7f86b5ffb640: cap 0: running thread 3["TimerManager"] (ThreadRunGHC)
-7f86b5ffb640: cap 0: thread 3["TimerManager"] stopped (suspended while making a foreign call)
-7f86c4be8740: cap 0: running thread 4[""] (ThreadRunGHC)
-7f86c4be8740: cap 0: thread 4[""] stopped (yielding)
-7f86c4be8740: cap 0: running thread 4[""] (ThreadRunGHC)
-7f86c4be8740: cap 0: thread 4[""] stopped (finished)
-7f86b57fa640: cap 0: requesting sequential GC
-7f86b57fa640: cap 0: starting GC
-7f86b57fa640: cap 0: GC working
-7f86b57fa640: cap 0: GC idle
-7f86b57fa640: cap 0: GC done
-7f86b57fa640: cap 0: GC idle
-7f86b57fa640: cap 0: GC done
-7f86b57fa640: cap 0: GC idle
-7f86b57fa640: cap 0: GC done
-7f86b57fa640: cap 0: Memory Return (Current: 6) (Needed: 8) (Returned: 0)
-7f86b57fa640: cap 0: all caps stopped for GC
-7f86b57fa640: cap 0: finished GC
-7f86b5ffb640: cap 0: running thread 3["TimerManager"] (ThreadRunGHC)
-7f86b5ffb640: cap 0: thread 3["TimerManager"] stopped (finished)
-7f86b67fc640: cap 0: running thread 2["IOManager on cap 0"] (ThreadRunGHC)
-7f86b67fc640: cap 0: thread 2["IOManager on cap 0"] stopped (finished)
-7f86c4be8740: removed cap 0 from capset 0
-7f86c4be8740: removed cap 0 from capset 1
-7f86c4be8740: cap 0: shutting down
-7f86c4be8740: deleted capset 0
-7f86c4be8740: deleted capset 1
+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
=====================================
testsuite/tests/rts/ipe/ipeMap.c
=====================================
@@ -53,6 +53,9 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) {
StringTable st;
init_string_table(&st);
+ node->unit_id = add_string(&st, "unit-id");
+ node->module_name = add_string(&st, "TheModule");
+
HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42));
node->next = NULL;
node->compressed = 0;
@@ -71,7 +74,8 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) {
assertStringsEqual(result.prov.closure_desc, "closure_desc_042");
assertStringsEqual(result.prov.ty_desc, "ty_desc_042");
assertStringsEqual(result.prov.label, "label_042");
- assertStringsEqual(result.prov.module, "module_042");
+ assertStringsEqual(result.prov.unit_id, "unit-id");
+ assertStringsEqual(result.prov.module, "TheModule");
assertStringsEqual(result.prov.src_file, "src_file_042");
assertStringsEqual(result.prov.src_span, "src_span_042");
@@ -88,6 +92,9 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap,
StringTable st;
init_string_table(&st);
+ node->unit_id = add_string(&st, "unit-id");
+ node->module_name = add_string(&st, "TheModule");
+
HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23));
node->next = NULL;
node->compressed = 0;
=====================================
testsuite/tests/rts/ipe/ipe_lib.c
=====================================
@@ -48,11 +48,6 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) {
snprintf(label, labelLength, "label_%03i", i);
provEnt.label = add_string(st, label);
- unsigned int moduleLength = strlen("module_") + 3 /* digits */ + 1 /* null character */;
- char *module = malloc(sizeof(char) * moduleLength);
- snprintf(module, moduleLength, "module_%03i", i);
- provEnt.module_name = add_string(st, module);
-
unsigned int srcFileLength = strlen("src_file_") + 3 /* digits */ + 1 /* null character */;
char *srcFile = malloc(sizeof(char) * srcFileLength);
snprintf(srcFile, srcFileLength, "src_file_%03i", i);
@@ -77,6 +72,16 @@ IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) {
StringTable st;
init_string_table(&st);
+ unsigned int unitIdLength = strlen("unit_id_") + 3 /* digits */ + 1 /* null character */;
+ char *unitId = malloc(sizeof(char) * unitIdLength);
+ snprintf(unitId, unitIdLength, "unit_id_%03i", start);
+ node->unit_id = add_string(&st, unitId);
+
+ unsigned int moduleLength = strlen("module_") + 3 /* digits */ + 1 /* null character */;
+ char *module = malloc(sizeof(char) * moduleLength);
+ snprintf(module, moduleLength, "module_%03i", start);
+ node->module_name = add_string(&st, module);
+
// Make the entries and fill the buffers
for (int i=start; i < end; i++) {
HaskellObj closure = rts_mkInt(cap, 42);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dee4e8d2305e64f8a1a7bb840c5df7833ef5f8c8...d234d7af71f4476d3acc297c53eee4e209c437b0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dee4e8d2305e64f8a1a7bb840c5df7833ef5f8c8...d234d7af71f4476d3acc297c53eee4e209c437b0
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/20230927/60dc9d62/attachment-0001.html>
More information about the ghc-commits
mailing list