[Git][ghc/ghc][wip/T22077] Refactor IPE initialization

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Fri Aug 19 14:32:22 UTC 2022



Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC


Commits:
3b3e4230 by Ben Gamari at 2022-08-19T10:32:07-04:00
Refactor IPE initialization

Here we refactor the representation of info table provenance information
in object code to significantly reduce its size and link-time impact.
Specifically, we deduplicate strings and represent them as 32-bit
offsets into a common string table.

In addition, we rework the registration logic to eliminate allocation
from the registration path, which is run from a static initializer where
things like allocation are technically undefined behavior (although it
did previously seem to work). For similar reasons we eliminate lock
usage from registration path, instead relying on atomic CAS.

Closes #22077.

- - - - -


13 changed files:

- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- + compiler/GHC/StgToCmm/InfoTableProv.hs
- compiler/GHC/StgToCmm/Prof.hs
- compiler/ghc.cabal.in
- rts/IPE.c
- rts/IPE.h
- rts/Trace.c
- rts/Trace.h
- rts/include/rts/IPE.h
- rts/include/stg/SMP.h


Changes:

=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -299,6 +299,7 @@ data ModuleLabelKind
     | MLK_InitializerArray
     | MLK_Finalizer String
     | MLK_FinalizerArray
+    | MLK_IPEBuffer
     deriving (Eq, Ord)
 
 instance Outputable ModuleLabelKind where
@@ -306,6 +307,7 @@ instance Outputable ModuleLabelKind where
     ppr (MLK_Initializer s)  = text ("init__" ++ s)
     ppr MLK_FinalizerArray   = text "fini_arr"
     ppr (MLK_Finalizer s)    = text ("fini__" ++ s)
+    ppr MLK_IPEBuffer        = text "ipe_buf"
 
 isIdLabel :: CLabel -> Bool
 isIdLabel IdLabel{} = True
@@ -830,10 +832,10 @@ instance OutputableP Platform InfoProvEnt where
 -- Constructing Cost Center Labels
 mkCCLabel  :: CostCentre      -> CLabel
 mkCCSLabel :: CostCentreStack -> CLabel
-mkIPELabel :: InfoProvEnt -> CLabel
+mkIPELabel :: Module          -> CLabel
 mkCCLabel           cc          = CC_Label cc
 mkCCSLabel          ccs         = CCS_Label ccs
-mkIPELabel          ipe         = IPE_Label ipe
+mkIPELabel          mod         = ModuleLabel mod MLK_IPEBuffer
 
 mkRtsApFastLabel :: FastString -> CLabel
 mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str))
@@ -1011,6 +1013,7 @@ modLabelNeedsCDecl :: ModuleLabelKind -> Bool
 -- Code for finalizers and initializers are emitted in stub objects
 modLabelNeedsCDecl (MLK_Initializer _)  = True
 modLabelNeedsCDecl (MLK_Finalizer   _)  = True
+modLabelNeedsCDecl MLK_IPEBuffer        = True
 -- The finalizer and initializer arrays are emitted in the code of the module
 modLabelNeedsCDecl MLK_InitializerArray = False
 modLabelNeedsCDecl MLK_FinalizerArray   = False
@@ -1208,6 +1211,7 @@ moduleLabelKindType kind =
     MLK_InitializerArray -> DataLabel
     MLK_Finalizer _      -> CodeLabel
     MLK_FinalizerArray   -> DataLabel
+    MLK_IPEBuffer        -> DataLabel
 
 idInfoLabelType :: IdLabelInfo -> CLabelType
 idInfoLabelType info =


=====================================
compiler/GHC/Cmm/Parser.y
=====================================
@@ -224,6 +224,7 @@ import GHC.StgToCmm.Layout     hiding (ArgRep(..))
 import GHC.StgToCmm.Ticky
 import GHC.StgToCmm.Prof
 import GHC.StgToCmm.Bind  ( emitBlackHoleCode, emitUpdateFrame )
+import GHC.StgToCmm.InfoTableProv
 
 import GHC.Cmm.Opt
 import GHC.Cmm.Graph
@@ -1518,9 +1519,8 @@ parseCmmFile cmmpConfig this_mod home_unit filename = do
         let fcode = do
               ((), cmm) <- getCmm $ unEC code "global" (initEnv (pdProfile pdConfig)) [] >> return ()
               -- See Note [Mapping Info Tables to Source Positions] (IPE Maps)
-              let used_info = map (cmmInfoTableToInfoProvEnt this_mod)
-                                              (mapMaybe topInfoTable cmm)
-              ((), cmm2) <- getCmm $ mapM_ emitInfoTableProv used_info
+              let used_info = map (cmmInfoTableToInfoProvEnt this_mod) (mapMaybe topInfoTable cmm)
+              ((), cmm2) <- getCmm $ emitIpeBufferListNode this_mod used_info
               return (cmm ++ cmm2, used_info)
             (cmm, _) = runC (cmmpStgToCmmConfig cmmpConfig) fstate st fcode
             (warnings,errors) = getPsMessages pst


=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -368,24 +368,17 @@ ipInitCode
   :: Bool            -- is Opt_InfoTableMap enabled or not
   -> Platform
   -> Module
-  -> [InfoProvEnt]
   -> CStub
-ipInitCode do_info_table platform this_mod ents
+ipInitCode do_info_table platform this_mod
   | not do_info_table = mempty
-  | otherwise = initializerCStub platform fn_nm decls body
+  | otherwise = initializerCStub platform fn_nm ipe_buffer_decl body
  where
    fn_nm = mkInitializerStubLabel this_mod "ip_init"
-   decls = vcat
-        $  map emit_ipe_decl ents
-        ++ [emit_ipe_list ents]
-   body = text "registerInfoProvList" <> parens local_ipe_list_label <> semi
-   emit_ipe_decl ipe =
-       text "extern InfoProvEnt" <+> ipe_lbl <> text "[];"
-     where ipe_lbl = pprCLabel platform CStyle (mkIPELabel ipe)
-   local_ipe_list_label = text "local_ipe_" <> ppr this_mod
-   emit_ipe_list ipes =
-      text "static InfoProvEnt *" <> local_ipe_list_label <> text "[] ="
-      <+> braces (vcat $ [ pprCLabel platform CStyle (mkIPELabel ipe) <> comma
-                         | ipe <- ipes
-                         ] ++ [text "NULL"])
-      <> semi
+
+   body = text "registerInfoProvList" <> parens (text "&" <> ipe_buffer_label) <> semi
+
+   ipe_buffer_label = pprCLabel platform CStyle (mkIPELabel this_mod)
+
+   ipe_buffer_decl =
+       text "extern IpeBufferListNode" <+> ipe_buffer_label <> text ";"
+


=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1830,7 +1830,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
         mod_name = mkModuleName $ "Cmm$" ++ original_filename
         cmm_mod = mkHomeModule home_unit mod_name
         cmmpConfig = initCmmParserConfig dflags
-    (cmm, ents) <- ioMsgMaybe
+    (cmm, _ents) <- ioMsgMaybe
                $ do
                   (warns,errs,cmm) <- withTiming logger (text "ParseCmm"<+>brackets (text filename)) (\_ -> ())
                                        $ parseCmmFile cmmpConfig cmm_mod home_unit filename
@@ -1857,7 +1857,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
           Just h  -> h           dflags Nothing (Stream.yield cmmgroup)
 
         let foreign_stubs _ =
-              let ip_init   = ipInitCode do_info_table platform cmm_mod ents
+              let ip_init = ipInitCode do_info_table platform cmm_mod
               in NoStubs `appendStubC` ip_init
 
         (_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos)


=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -0,0 +1,130 @@
+module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where
+
+import GHC.Prelude
+import GHC.Platform
+import GHC.Unit.Module
+import GHC.Utils.Outputable
+
+import GHC.Cmm.CLabel
+import GHC.Cmm.Expr
+import GHC.Cmm.Utils
+import GHC.StgToCmm.Config
+import GHC.StgToCmm.Lit (newByteStringCLit)
+import GHC.StgToCmm.Monad
+import GHC.StgToCmm.Utils
+
+import GHC.Data.ShortText (ShortText)
+import qualified GHC.Data.ShortText as ST
+
+import Data.Bifunctor (first)
+import qualified Data.Map.Strict as M
+import Control.Monad.Trans.State.Strict
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BSB
+import qualified Data.ByteString.Lazy as BSL
+
+emitIpeBufferListNode :: Module
+                      -> [InfoProvEnt]
+                      -> FCode ()
+emitIpeBufferListNode this_mod ents = do
+    cfg <- getStgToCmmConfig
+    let ctx      = stgToCmmContext  cfg
+        platform = stgToCmmPlatform cfg
+
+    let (cg_ipes, strtab) = flip runState emptyStringTable $ do
+            module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod)
+            mapM (toCgIPE platform ctx module_name) ents
+
+    let -- Emit the fields of an IpeBufferEntry struct.
+        toIpeBufferEntry :: CgInfoProvEnt -> [CmmLit]
+        toIpeBufferEntry cg_ipe =
+            [ CmmLabel (ipeInfoTablePtr cg_ipe)
+            , strtab_offset (ipeTableName cg_ipe)
+            , strtab_offset (ipeClosureDesc cg_ipe)
+            , strtab_offset (ipeTypeDesc cg_ipe)
+            , strtab_offset (ipeLabel cg_ipe)
+            , strtab_offset (ipeModuleName cg_ipe)
+            , strtab_offset (ipeSrcLoc cg_ipe)
+            ]
+
+        int n = mkIntCLit platform n
+        int32 n = CmmInt n W32
+        strtab_offset (StrTabOffset n) = int32 (fromIntegral n)
+
+    strings <- newByteStringCLit (getStringTableStrings strtab)
+    let lits = [ zeroCLit platform     -- 'next' field
+               , strings               -- 'strings' field
+               , int $ length cg_ipes  -- 'count' field
+               ] ++ concatMap toIpeBufferEntry cg_ipes
+    emitDataLits (mkIPELabel this_mod) lits
+
+toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt
+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 (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
+    return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe
+                           , ipeTableName = table_name
+                           , ipeClosureDesc = closure_desc
+                           , ipeTypeDesc = type_desc
+                           , ipeLabel = label
+                           , ipeModuleName = module_name
+                           , ipeSrcLoc = src_loc
+                           }
+
+data CgInfoProvEnt = CgInfoProvEnt
+                               { ipeInfoTablePtr :: !CLabel
+                               , ipeTableName :: !StrTabOffset
+                               , ipeClosureDesc :: !StrTabOffset
+                               , ipeTypeDesc :: !StrTabOffset
+                               , ipeLabel :: !StrTabOffset
+                               , ipeModuleName :: !StrTabOffset
+                               , ipeSrcLoc :: !StrTabOffset
+                               }
+
+data StringTable = StringTable { stStrings :: DList ShortText
+                               , stLength :: !Int
+                               , stLookup :: !(M.Map ShortText StrTabOffset)
+                               }
+
+newtype StrTabOffset = StrTabOffset Int
+
+emptyStringTable :: StringTable
+emptyStringTable =
+    StringTable { stStrings = emptyDList
+                , stLength = 0
+                , stLookup = M.empty
+                }
+
+getStringTableStrings :: StringTable -> BS.ByteString
+getStringTableStrings st =
+    BSL.toStrict $ BSB.toLazyByteString
+    $ foldMap f $ dlistToList (stStrings st)
+  where
+    f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0
+
+lookupStringTable :: ShortText -> State StringTable StrTabOffset
+lookupStringTable str = state $ \st ->
+    case M.lookup str (stLookup st) of
+      Just off -> (off, st)
+      Nothing ->
+          let !st' = st { stStrings = stStrings st `snoc` str
+                        , stLength  = stLength st + ST.byteLength str + 1
+                        , stLookup  = M.insert str res (stLookup st)
+                        }
+              res = StrTabOffset (stLength st)
+          in (res, st')
+
+newtype DList a = DList ([a] -> [a])
+
+emptyDList :: DList a
+emptyDList = DList id
+
+snoc :: DList a -> a -> DList a
+snoc (DList f) x = DList (f . (x:))
+
+dlistToList :: DList a -> [a]
+dlistToList (DList f) = f []


=====================================
compiler/GHC/StgToCmm/Prof.hs
=====================================
@@ -11,7 +11,7 @@ module GHC.StgToCmm.Prof (
         mkCCostCentre, mkCCostCentreStack,
 
         -- infoTablePRov
-        initInfoTableProv, emitInfoTableProv,
+        initInfoTableProv,
 
         -- Cost-centre Profiling
         dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf,
@@ -32,6 +32,7 @@ import GHC.Platform
 import GHC.Platform.Profile
 import GHC.StgToCmm.Closure
 import GHC.StgToCmm.Config
+import GHC.StgToCmm.InfoTableProv
 import GHC.StgToCmm.Utils
 import GHC.StgToCmm.Monad
 import GHC.StgToCmm.Lit
@@ -55,7 +56,6 @@ import GHC.Utils.Encoding
 
 import Control.Monad
 import Data.Char       (ord)
-import Data.Bifunctor  (first)
 import GHC.Utils.Monad (whenM)
 
 -----------------------------------------------------------------------------
@@ -274,9 +274,8 @@ sizeof_ccs_words platform
   where
    (ws,ms) = pc_SIZEOF_CostCentreStack (platformConstants platform) `divMod` platformWordSizeInBytes platform
 
-
+-- | Emit info-table provenance declarations
 initInfoTableProv ::  [CmmInfoTable] -> InfoTableProvMap -> FCode CStub
--- Emit the declarations
 initInfoTableProv infos itmap
   = do
        cfg <- getStgToCmmConfig
@@ -284,42 +283,16 @@ initInfoTableProv infos itmap
            info_table = stgToCmmInfoTableMap cfg
            platform   = stgToCmmPlatform     cfg
            this_mod   = stgToCmmThisModule   cfg
-       -- Output the actual IPE data
-       mapM_ emitInfoTableProv ents
-       -- Create the C stub which initialises the IPE map
-       return (ipInitCode info_table platform this_mod ents)
-
---- Info Table Prov stuff
-emitInfoTableProv :: InfoProvEnt  -> FCode ()
-emitInfoTableProv ip = do
-  { cfg <- getStgToCmmConfig
-  ; let mod      = infoProvModule ip
-        ctx      = stgToCmmContext  cfg
-        platform = stgToCmmPlatform cfg
-  ; let (src, label) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ip)
-        mk_string    = newByteStringCLit . utf8EncodeByteString
-  ; label <- mk_string label
-  ; modl  <- newByteStringCLit (bytesFS $ moduleNameFS
-                                        $ moduleName mod)
-
-  ; ty_string  <- mk_string (infoTableType ip)
-  ; loc        <- mk_string src
-  ; table_name <- mk_string (renderWithContext ctx
-                             (pprCLabel platform CStyle (infoTablePtr ip)))
-  ; closure_type <- mk_string (renderWithContext ctx
-                               (text $ show $ infoProvEntClosureType ip))
-  ; let
-     lits = [ CmmLabel (infoTablePtr ip), -- Info table pointer
-              table_name,     -- char *table_name
-              closure_type,   -- char *closure_desc -- Filled in from the InfoTable
-              ty_string,      -- char *ty_string
-              label,          -- char *label,
-              modl,           -- char *module,
-              loc,            -- char *srcloc,
-              zero platform   -- struct _InfoProvEnt *link
-            ]
-  ; emitDataLits (mkIPELabel ip) lits
-  }
+
+       case ents of
+         [] -> return mempty
+         _  -> do
+           -- Emit IPE buffer
+           emitIpeBufferListNode this_mod ents
+
+           -- Create the C stub which initialises the IPE map
+           return (ipInitCode info_table platform this_mod)
+
 -- ---------------------------------------------------------------------------
 -- Set the current cost centre stack
 


=====================================
compiler/ghc.cabal.in
=====================================
@@ -615,6 +615,7 @@ Library
         GHC.StgToCmm.Foreign
         GHC.StgToCmm.Heap
         GHC.StgToCmm.Hpc
+        GHC.StgToCmm.InfoTableProv
         GHC.StgToCmm.Layout
         GHC.StgToCmm.Lit
         GHC.StgToCmm.Monad


=====================================
rts/IPE.c
=====================================
@@ -34,17 +34,22 @@ Unfortunately, inserting into the hash map is relatively expensive. To keep
 startup times low, there's a temporary data structure that is optimized for
 collecting IPE lists on registration.
 
-It's a singly linked list of IPE list buffers. Each buffer contains space for
-126 IPE lists. This number is a bit arbitrary, but leaves a few bytes so that
-the whole structure might fit into 1024 bytes.
-
-On registering a new IPE list, there are three cases:
-
-- It's the first entry at all: Allocate a new IpeBufferListNode and make it the
-  buffer's first entry.
-- The current IpeBufferListNode has space in it's buffer: Add it to the buffer.
-- The current IpeBufferListNode's buffer is full: Allocate a new one and link it
-to the previous one, making this one the new current.
+It's a singly linked list of IPE list buffers (IpeBufferListNode). These are
+emitted by the code generator, with generally one produced per module. Each
+contains an array of IPE entries and a link field (which is used to link
+buffers onto the pending list.
+
+For reasons of space efficiency, IPE entries are represented slightly
+differently in the object file than the InfoProvEnt which we ultimately expose
+to the user. Specifically, the IPEs in IpeBufferListNode are represented by
+IpeBufferEntrys, along with a corresponding string table. The string fields
+of InfoProvEnt are represented in IpeBufferEntry as 32-bit offsets into the
+string table. This allows us to halve the size of the buffer entries on
+64-bit machines while significantly reducing the number of needed
+relocations, reducing linking cost. Moreover, the code generator takes care
+to deduplicate strings when generating the string table. When we inserting a
+set of IpeBufferEntrys into the IPE hash-map we convert them to InfoProvEnts,
+which contain proper string pointers.
 
 Building the hash map is done lazily, i.e. on first lookup or traversal. For
 this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs.
@@ -52,12 +57,12 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs.
 After the content of a IpeBufferListNode has been inserted, it's freed.
 */
 
+static Mutex ipeMapLock;
 static HashTable *ipeMap = NULL;
 
+// Accessed atomically
 static IpeBufferListNode *ipeBufferList = NULL;
 
-static Mutex ipeMapLock;
-
 void initIpeMapLock(void) { initMutex(&ipeMapLock); }
 
 void closeIpeMapLock(void) { closeMutex(&ipeMapLock); }
@@ -66,25 +71,7 @@ void dumpIPEToEventLog(void) {
 #if defined(TRACING)
     ACQUIRE_LOCK(&ipeMapLock);
 
-    IpeBufferListNode *cursor = ipeBufferList;
-    while (cursor != NULL) {
-        for (int i = 0; i < cursor->count; i++) {
-            for (InfoProvEnt **ipeList = cursor->buffer[i]; *ipeList != NULL;
-                 ipeList++) {
-                InfoProvEnt *ipe = *ipeList;
-
-                traceIPE(ipe->info, ipe->prov.table_name,
-                         ipe->prov.closure_desc, ipe->prov.ty_desc,
-                         ipe->prov.label, ipe->prov.module, ipe->prov.srcloc);
-            }
-        }
-
-        cursor = cursor->next;
-    }
-
-    if (ipeMap != NULL) {
-        mapHashTable(ipeMap, NULL, &traceIPEFromHashTable);
-    }
+    // TODO
 
     RELEASE_LOCK(&ipeMapLock);
 #endif
@@ -109,50 +96,20 @@ Note [The Info Table Provenance Entry (IPE) Map].
 
 Statically initialized IPE lists are registered at startup by a C constructor
 function generated by the compiler (CodeOutput.hs) in a *.c file for each
-module.
+module. Since this is called in a static initializer we cannot rely on
+ipeMapLock; we instead use atomic CAS operations to add to the list.
 
 A performance test for IPE registration and lookup can be found here:
 https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806
 */
-void registerInfoProvList(InfoProvEnt **ent_list) {
-    // The list must be dereferenceable.
-    ASSERT(ent_list[0] == NULL || ent_list[0] != NULL);
-
-    // Ignore empty lists
-    if (ent_list[0] == NULL) {
-        return;
-    }
-
-    ACQUIRE_LOCK(&ipeMapLock);
-
-    if (ipeBufferList == NULL) {
-        ASSERT(ipeBufferList == NULL);
-
-        ipeBufferList = stgMallocBytes(sizeof(IpeBufferListNode),
-                                       "registerInfoProvList-firstNode");
-        ipeBufferList->buffer[0] = ent_list;
-        ipeBufferList->count = 1;
-        ipeBufferList->next = NULL;
-    } else {
-        if (ipeBufferList->count < IPE_LIST_NODE_BUFFER_SIZE) {
-            ipeBufferList->buffer[ipeBufferList->count] = ent_list;
-            ipeBufferList->count = ipeBufferList->count + 1;
-
-            ASSERT(ipeBufferList->next == NULL ||
-                   ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE);
-        } else {
-            IpeBufferListNode *newNode = stgMallocBytes(
-                sizeof(IpeBufferListNode), "registerInfoProvList-nextNode");
-            newNode->buffer[0] = ent_list;
-            newNode->count = 1;
-            newNode->next = ipeBufferList;
-            ipeBufferList = newNode;
-
-            ASSERT(ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE);
+void registerInfoProvList(IpeBufferListNode *node) {
+    while (true) {
+        IpeBufferListNode *old = RELAXED_LOAD(&ipeBufferList);
+        node->next = old;
+        if (cas_ptr((volatile void **) &ipeBufferList, old, node) == (void *) old) {
+            return;
         }
     }
-
-    RELEASE_LOCK(&ipeMapLock);
 }
 
 InfoProvEnt *lookupIPE(const StgInfoTable *info) {
@@ -163,7 +120,8 @@ InfoProvEnt *lookupIPE(const StgInfoTable *info) {
 void updateIpeMap() {
     // Check if there's any work at all. If not so, we can circumvent locking,
     // which decreases performance.
-    if (ipeMap != NULL && ipeBufferList == NULL) {
+    IpeBufferListNode *pending = xchg_ptr((void **) &ipeBufferList, NULL);
+    if (ipeMap != NULL && pending == NULL) {
         return;
     }
 
@@ -173,23 +131,25 @@ void updateIpeMap() {
         ipeMap = allocHashTable();
     }
 
-    while (ipeBufferList != NULL) {
-        ASSERT(ipeBufferList->next == NULL ||
-               ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE);
-        ASSERT(ipeBufferList->count > 0 &&
-               ipeBufferList->count <= IPE_LIST_NODE_BUFFER_SIZE);
-
-        IpeBufferListNode *currentNode = ipeBufferList;
-
-        for (int i = 0; i < currentNode->count; i++) {
-            for (InfoProvEnt **ipeList = currentNode->buffer[i];
-                 *ipeList != NULL; ipeList++) {
-                insertHashTable(ipeMap, (StgWord)(*ipeList)->info, *ipeList);
-            }
+    while (pending != NULL) {
+        IpeBufferListNode *currentNode = pending;
+        InfoProvEnt *ip_ents = stgMallocBytes(sizeof(InfoProvEnt) * currentNode->count, "updateIpeMap");
+        const char *strings = currentNode->string_table;
+
+        for (uint32_t i = 0; i < currentNode->count; i++) {
+            const IpeBufferEntry *ent = &currentNode->entries[i];
+            ip_ents[i].info = ent->info;
+            ip_ents[i].prov.table_name = &strings[ent->table_name];
+            ip_ents[i].prov.closure_desc = &strings[ent->closure_desc];
+            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];
+
+            insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]);
         }
 
-        ipeBufferList = currentNode->next;
-        stgFree(currentNode);
+        pending = currentNode->next;
     }
 
     RELEASE_LOCK(&ipeMapLock);


=====================================
rts/IPE.h
=====================================
@@ -13,14 +13,6 @@
 
 #include "BeginPrivate.h"
 
-#define IPE_LIST_NODE_BUFFER_SIZE 126
-
-typedef struct IpeBufferListNode_ {
-    InfoProvEnt **buffer[IPE_LIST_NODE_BUFFER_SIZE];
-    StgWord8 count;
-    struct IpeBufferListNode_ *next;
-} IpeBufferListNode;
-
 void dumpIPEToEventLog(void);
 void updateIpeMap(void);
 void initIpeMapLock(void);


=====================================
rts/Trace.c
=====================================
@@ -675,7 +675,7 @@ void traceHeapProfSampleString(StgWord8 profile_id,
     }
 }
 
-void traceIPE(StgInfoTable * info,
+void traceIPE(const StgInfoTable * info,
               const char *table_name,
               const char *closure_desc,
               const char *ty_desc,


=====================================
rts/Trace.h
=====================================
@@ -330,7 +330,7 @@ void traceConcUpdRemSetFlush(Capability *cap);
 void traceNonmovingHeapCensus(uint32_t log_blk_size,
                               const struct NonmovingAllocCensus *census);
 
-void traceIPE(StgInfoTable *info,
+void traceIPE(const StgInfoTable *info,
                const char *table_name,
                const char *closure_desc,
                const char *ty_desc,


=====================================
rts/include/rts/IPE.h
=====================================
@@ -14,18 +14,53 @@
 #pragma once
 
 typedef struct InfoProv_ {
-    char *table_name;
-    char *closure_desc;
-    char *ty_desc;
-    char *label;
-    char *module;
-    char *srcloc;
+    const char *table_name;
+    const char *closure_desc;
+    const char *ty_desc;
+    const char *label;
+    const char *module;
+    const char *srcloc;
 } InfoProv;
 
 typedef struct InfoProvEnt_ {
-    StgInfoTable *info;
+    const StgInfoTable *info;
     InfoProv prov;
 } InfoProvEnt;
 
-void registerInfoProvList(InfoProvEnt **cc_list);
+
+/*
+ * On-disk representation
+ */
+
+/*
+ * A byte offset into the string table.
+ * We use offsets rather than pointers as:
+ *
+ *  a. they are smaller than pointers on 64-bit platforms
+ *  b. they are easier on the linker since they do not need
+ *     to be relocated
+ */
+typedef uint32_t StringIdx;
+
+// The size of this must be a multiple of the word size
+// to ensure correct packing.
+typedef struct {
+    const StgInfoTable *info;
+    StringIdx table_name;
+    StringIdx closure_desc;
+    StringIdx ty_desc;
+    StringIdx label;
+    StringIdx module_name;
+    StringIdx srcloc;
+} IpeBufferEntry;
+
+typedef struct IpeBufferListNode_ {
+    struct IpeBufferListNode_ *next;
+    // Everything below is read-only and generated by the codegen
+    const char *string_table;
+    const StgWord count;
+    const IpeBufferEntry entries[];
+} IpeBufferListNode;
+
+void registerInfoProvList(IpeBufferListNode *node);
 InfoProvEnt *lookupIPE(const StgInfoTable *info);


=====================================
rts/include/stg/SMP.h
=====================================
@@ -568,3 +568,20 @@ atomic_dec(StgVolatilePtr p)
 #define VOLATILE_LOAD(p) ((StgWord)*((StgWord*)(p)))
 
 #endif /* !THREADED_RTS */
+
+/* Helpers implemented in terms of the above */
+#if !IN_STG_CODE || IN_STGCRUN
+
+INLINE_HEADER void *
+xchg_ptr(void **p, void *w)
+{
+    return (void *) xchg((StgPtr) p, (StgWord) w);
+}
+
+INLINE_HEADER void *
+cas_ptr(volatile void **p, void *o, void *n)
+{
+    return (void *) cas((StgVolatilePtr) p, (StgWord) o, (StgWord) n);
+}
+
+#endif



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b3e42301b34cd12e511102a2e0a1e1545f36c78
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/6c8d70e8/attachment-0001.html>


More information about the ghc-commits mailing list