[Git][ghc/ghc][wip/ipe-sharing] IPE: Include unit id

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/ipe-sharing at Glasgow Haskell Compiler / GHC


Commits:
d0e5d6f2 by Ben Gamari at 2023-09-26T21:57:28-04:00
IPE: Include unit id

- - - - -


6 changed files:

- compiler/GHC/StgToCmm/InfoTableProv.hs
- libraries/base/GHC/InfoProv/Types.hsc
- rts/IPE.c
- rts/Trace.c
- rts/include/rts/IPE.h
- testsuite/tests/rts/ipe/ipe_lib.c


Changes:

=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -83,10 +83,11 @@ emitIpeBufferListNode this_mod ents = do
         platform = stgToCmmPlatform cfg
         int n    = mkIntCLit platform n
 
-        ((cg_ipes, module_name), strtab) = flip runState emptyStringTable $ do
-          module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod)
+        ((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, module_name)
+          return (cg_ipes, unit_id, module_name)
 
         tables :: [CmmStatic]
         tables = map (CmmStaticLit . CmmLabel . ipeInfoTablePtr) cg_ipes
@@ -140,6 +141,9 @@ emitIpeBufferListNode this_mod ents = do
 
             -- 'module_name' field
           , CmmInt (fromIntegral module_name) W32
+
+            -- 'unit_id' field
+          , CmmInt (fromIntegral unit_id) W32
           ]
 
     -- Emit the list of info table pointers


=====================================
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


=====================================
rts/IPE.c
=====================================
@@ -105,6 +105,7 @@ 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],
+                .unit_id = &strings[node->unit_id],
                 .module = &strings[node->module_name],
                 .src_file = &strings[ent->src_file],
                 .src_span = &strings[ent->src_span]


=====================================
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;
@@ -75,7 +76,6 @@ typedef struct IpeBufferListNode_ {
     // When TNTC is enabled, these will point to the entry code
     // not the info table itself.
     const StgInfoTable **tables;
-
     IpeBufferEntry *entries;
     StgWord entries_size; // decompressed size
 
@@ -83,6 +83,7 @@ typedef struct IpeBufferListNode_ {
     StgWord string_table_size; // decompressed size
 
     // Shared by all entries
+    StringIdx unit_id;
     StringIdx module_name;
 } IpeBufferListNode;
 


=====================================
testsuite/tests/rts/ipe/ipe_lib.c
=====================================
@@ -72,6 +72,11 @@ 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);



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0e5d6f27b1fa52e9dccc3b2fdc6bf135e6c7bd8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0e5d6f27b1fa52e9dccc3b2fdc6bf135e6c7bd8
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/20230926/834e534c/attachment-0001.html>