Refactor handling of global initializers

GHC uses global initializers for a number of things including
cost-center registration, info-table provenance registration, and setup
of foreign exports. Previously, the global initializer arrays which
referenced these initializers would live in the object file of the C
stub, which would then be merged into the main object file of the
module.

Unfortunately, this approach is no longer tenable with the move to
Clang/LLVM on Windows (see #21019). Specifically, lld's PE backend does
not support object merging (that is, the -r flag). Instead we are now
rather packaging a module's object files into a static library. However,
this is problematic in the case of initializers as there are no
references to the C stub object in the archive, meaning that the linker
may drop the object from the final link.

This patch refactors our handling of global initializers to instead
place initializer arrays within the object file of the module to which
they belong. We do this by introducing a Cmm data declaration containing
the initializer array in the module's Cmm stream. While the initializer
functions themselves remain in separate C stub objects, the reference
from the module's object ensures that they are not dropped from the
final link.

In service of #21068.

1 files changed, 58 insertions, 2 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index c6f29ece0b..6d0870e281 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -39,6 +39,11 @@ module GHC.Cmm.CLabel (
         mkBitmapLabel,
         mkStringLitLabel,
 
+        mkInitializerStubLabel,
+        mkInitializerArrayLabel,
+        mkFinalizerStubLabel,
+        mkFinalizerArrayLabel,
+
         mkAsmTempLabel,
         mkAsmTempDerivedLabel,
         mkAsmTempEndLabel,
@@ -255,6 +260,8 @@ data CLabel
   | CCS_Label CostCentreStack
   | IPE_Label InfoProvEnt
 
+    -- | A per-module metadata label.
+  | ModuleLabel !Module ModuleLabelKind
 
   -- | These labels are generated and used inside the NCG only.
   --    They are special variants of a label used for dynamic linking
@@ -271,7 +278,6 @@ data CLabel
   -- | A label before an info table to prevent excessive dead-stripping on darwin
   | DeadStripPreventer CLabel
 
-
   -- | Per-module table of tick locations
   | HpcTicksLabel Module
 
@@ -291,6 +297,19 @@ instance Show CLabel where
 instance Outputable CLabel where
   ppr = text . show
 
+data ModuleLabelKind
+    = MLK_Initializer String
+    | MLK_InitializerArray
+    | MLK_Finalizer String
+    | MLK_FinalizerArray
+    deriving (Eq, Ord)
+
+instance Outputable ModuleLabelKind where
+    ppr MLK_InitializerArray = text "init_arr"
+    ppr (MLK_Initializer s)  = text ("init__" ++ s)
+    ppr MLK_FinalizerArray   = text "fini_arr"
+    ppr (MLK_Finalizer s)    = text ("fini__" ++ s)
+
 isIdLabel :: CLabel -> Bool
 isIdLabel IdLabel{} = True
 isIdLabel _ = False
@@ -355,6 +374,9 @@ instance Ord CLabel where
     compare a1 a2
   compare (IPE_Label a1) (IPE_Label a2) =
     compare a1 a2
+  compare (ModuleLabel m1 k1) (ModuleLabel m2 k2) =
+    compare m1 m2 `thenCmp`
+    compare k1 k2
   compare (DynamicLinkerLabel a1 b1) (DynamicLinkerLabel a2 b2) =
     compare a1 a2 `thenCmp`
     compare b1 b2
@@ -399,6 +421,8 @@ instance Ord CLabel where
   compare _ SRTLabel{} = GT
   compare (IPE_Label {}) _ = LT
   compare  _ (IPE_Label{}) = GT
+  compare (ModuleLabel {}) _ = LT
+  compare  _ (ModuleLabel{}) = GT
 
 -- | Record where a foreign label is stored.
 data ForeignLabelSource
@@ -842,6 +866,19 @@ mkDeadStripPreventer lbl        = DeadStripPreventer lbl
 mkStringLitLabel :: Unique -> CLabel
 mkStringLitLabel                = StringLitLabel
 
+mkInitializerStubLabel :: Module -> String -> CLabel
+mkInitializerStubLabel mod s    = ModuleLabel mod (MLK_Initializer s)
+
+mkInitializerArrayLabel :: Module -> CLabel
+mkInitializerArrayLabel mod     = ModuleLabel mod MLK_InitializerArray
+
+
+mkFinalizerStubLabel :: Module -> String -> CLabel
+mkFinalizerStubLabel mod s      = ModuleLabel mod (MLK_Finalizer s)
+
+mkFinalizerArrayLabel :: Module -> CLabel
+mkFinalizerArrayLabel mod       = ModuleLabel mod MLK_FinalizerArray
+
 mkAsmTempLabel :: Uniquable a => a -> CLabel
 mkAsmTempLabel a                = AsmTempLabel (getUnique a)
 
@@ -964,11 +1001,20 @@ needsCDecl l@(ForeignLabel{})           = not (isMathFun l)
 needsCDecl (CC_Label _)                 = True
 needsCDecl (CCS_Label _)                = True
 needsCDecl (IPE_Label {})               = True
+needsCDecl (ModuleLabel _ kind)         = modLabelNeedsCDecl kind
 needsCDecl (HpcTicksLabel _)            = True
 needsCDecl (DynamicLinkerLabel {})      = panic "needsCDecl DynamicLinkerLabel"
 needsCDecl PicBaseLabel                 = panic "needsCDecl PicBaseLabel"
 needsCDecl (DeadStripPreventer {})      = panic "needsCDecl DeadStripPreventer"
 
+modLabelNeedsCDecl :: ModuleLabelKind -> Bool
+-- Code for finalizers and initializers are emitted in stub objects
+modLabelNeedsCDecl (MLK_Initializer _)  = True
+modLabelNeedsCDecl (MLK_Finalizer   _)  = True
+-- The finalizer and initializer arrays are emitted in the code of the module
+modLabelNeedsCDecl MLK_InitializerArray = False
+modLabelNeedsCDecl MLK_FinalizerArray   = False
+
 -- | If a label is a local block label then return just its 'BlockId', otherwise
 -- 'Nothing'.
 maybeLocalBlockLabel :: CLabel -> Maybe BlockId
@@ -1087,6 +1133,7 @@ externallyVisibleCLabel (IdLabel name _ info)   = isExternalName name && externa
 externallyVisibleCLabel (CC_Label _)            = True
 externallyVisibleCLabel (CCS_Label _)           = True
 externallyVisibleCLabel (IPE_Label {})          = True
+externallyVisibleCLabel (ModuleLabel {})        = True
 externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
 externallyVisibleCLabel (HpcTicksLabel _)       = True
 externallyVisibleCLabel (LargeBitmapLabel _)    = False
@@ -1147,12 +1194,21 @@ labelType (StringLitLabel _)                    = DataLabel
 labelType (CC_Label _)                          = DataLabel
 labelType (CCS_Label _)                         = DataLabel
 labelType (IPE_Label {})                        = DataLabel
+labelType (ModuleLabel _ kind)                  = moduleLabelKindType kind
 labelType (DynamicLinkerLabel _ _)              = DataLabel -- Is this right?
 labelType PicBaseLabel                          = DataLabel
 labelType (DeadStripPreventer _)                = DataLabel
 labelType (HpcTicksLabel _)                     = DataLabel
 labelType (LargeBitmapLabel _)                  = DataLabel
 
+moduleLabelKindType :: ModuleLabelKind -> CLabelType
+moduleLabelKindType kind =
+  case kind of
+    MLK_Initializer _    -> CodeLabel
+    MLK_InitializerArray -> DataLabel
+    MLK_Finalizer _      -> CodeLabel
+    MLK_FinalizerArray   -> DataLabel
+
 idInfoLabelType :: IdLabelInfo -> CLabelType
 idInfoLabelType info =
   case info of
@@ -1467,7 +1523,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
    CC_Label cc   -> maybe_underscore $ ppr cc
    CCS_Label ccs -> maybe_underscore $ ppr ccs
    IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe")
-
+   ModuleLabel mod kind        -> maybe_underscore $ ppr mod <> text "_" <> ppr kind
 
    CmmLabel _ _ fs CmmCode     -> maybe_underscore $ ftext fs
    CmmLabel _ _ fs CmmData     -> maybe_underscore $ ftext fs