codeGen: Ensure that static datacon apps are included in SRTswip/T20959

When generating an SRT for a recursive group, GHC.Cmm.Info.Build.oneSRT
filters out recursive references, as described in Note [recursive SRTs].
However, doing so for static functions would be unsound, for the reason
described in Note [Invalid optimisation: shortcutting].

However, the same argument applies to static data constructor
applications, as we discovered in #20959. Fix this by ensuring that
static data constructor applications are included in recursive SRTs.

The approach here is not entirely satisfactory, but it is a starting
point.

Fixes #20959.

2 files changed, 92 insertions, 43 deletions

diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 71b7dd34bd..d450594ffe 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -391,9 +391,41 @@ Here we could use C = {A} and therefore [Inline] C = A.
 -}
 
 -- ---------------------------------------------------------------------
-{- Note [Invalid optimisation: shortcutting]
-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{-
+Note [No static object resurrection]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The "static flag" mechanism (see Note [STATIC_LINK fields] in smStorage.h) that
+the GC uses to track liveness of static objects assumes that unreachable
+objects will never become reachable again (i.e. are never "resurrected").
+Breaking this assumption can result in extremely subtle GC soundness issues
+(e.g. #15544, #20959).
+
+Guaranteeing that this assumption is not violated requires that all CAFfy
+static objects reachable from the object's code are reachable from its SRT.  In
+the past we have gotten this wrong in a few ways:
+
+ * shortcutting references to FUN_STATICs to instead point to the FUN_STATIC's
+   SRT. This lead to #15544 and is described in more detail in Note [Invalid
+   optimisation: shortcutting].
+
+ * omitting references to static data constructor applications. This previously
+   happened due to an oversight (#20959): when generating an SRT for a
+   recursive group we would drop references to the CAFfy static data
+   constructors.
+
+To see why we cannot allow object resurrection, see the examples in the
+above-mentioned Notes.
+
+If a static closure definitely does not transitively refer to any CAFs, then it
+*may* be advertised as not-CAFfy in the interface file and consequently *may*
+be omitted from SRTs. Regardless of whether the closure is advertised as CAFfy
+or non-CAFfy, its STATIC_LINK field *must* be set to 3, so that it never
+appears on the static closure list.
+-}
 
+{-
+Note [Invalid optimisation: shortcutting]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 You might think that if we have something like
 
 A's SRT = {B}
@@ -417,12 +449,12 @@ Consider these cases:
    point to B, so that it keeps B alive.
 
 2. B is a function.  This is the tricky one. The reason we can't
-shortcut in this case is that we aren't allowed to resurrect static
-objects.
+   shortcut in this case is that we aren't allowed to resurrect static
+   objects for the reason described in Note [No static object resurrection].
+   We noticed this in #15544.
 
-== How does this cause a problem? ==
+The particular case that cropped up when we tried this in #15544 was:
 
-The particular case that cropped up when we tried this was #15544.
 - A is a thunk
 - B is a static function
 - X is a CAF
@@ -439,16 +471,10 @@ The particular case that cropped up when we tried this was #15544.
 - In practice, the GC thinks that B has already been visited, and so
   doesn't visit X, and catastrophe ensues.
 
-== Isn't this caused by the RET_FUN business? ==
-
-Maybe, but could you prove that RET_FUN is the only way that
-resurrection can occur?
 
-So, no shortcutting.
 
 Note [Ticky labels in SRT analysis]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
 Raw Cmm data (CmmStaticsRaw) can't contain pointers so they're considered
 non-CAFFY in SRT analysis and we update the SRTMap mapping them to `Nothing`
 (meaning they're not CAFFY).
@@ -498,10 +524,13 @@ deriving newtype instance OutputableP env CLabel => OutputableP env CAFfyLabel
 type CAFSet = Set CAFfyLabel
 type CAFEnv = LabelMap CAFSet
 
+-- | Records the CAFfy references of a set of static data decls.
+type DataCAFEnv = Map CLabel CAFSet
+
+
 mkCAFfyLabel :: Platform -> CLabel -> CAFfyLabel
 mkCAFfyLabel platform lbl = CAFfyLabel (toClosureLbl platform lbl)
 
--- |
 -- This is a label that we can put in an SRT.  It *must* be a closure label,
 -- pointing to either a @FUN_STATIC@, @THUNK_STATIC@, or @CONSTR@.
 newtype SRTEntry = SRTEntry CLabel
@@ -828,7 +857,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
 
   -- Ignore the original grouping of decls, and combine all the
   -- CAFEnvs into a single CAFEnv.
-  let static_data_env :: Map CLabel CAFSet
+  let static_data_env :: DataCAFEnv
       static_data_env =
         Map.fromList $
         flip map data_ $
@@ -841,9 +870,6 @@ doSRTs cfg moduleSRTInfo procs data_ = do
                 CmmStatics lbl _ _ _ -> (lbl, set)
                 CmmStaticsRaw lbl _ -> (lbl, set)
 
-      static_data :: Set CLabel
-      static_data = Map.keysSet static_data_env
-
       (proc_envs, procss) = unzip procs
       cafEnv = mapUnions proc_envs
       decls = map snd data_ ++ concat procss
@@ -882,10 +908,10 @@ doSRTs cfg moduleSRTInfo procs data_ = do
       (result, moduleSRTInfo') =
         initUs_ us $
         flip runStateT moduleSRTInfo $ do
-          nonCAFs <- mapM (doSCC cfg staticFuns static_data) sccs
+          nonCAFs <- mapM (doSCC cfg staticFuns static_data_env) sccs
           cAFs <- forM cafsWithSRTs $ \(l, cafLbl, cafs) ->
             oneSRT cfg staticFuns [BlockLabel l] [cafLbl]
-                   True{-is a CAF-} cafs static_data
+                   True{-is a CAF-} cafs static_data_env
           return (nonCAFs ++ cAFs)
 
       (srt_declss, pairs, funSRTs, has_caf_refs) = unzip4 result
@@ -928,7 +954,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
 doSCC
   :: CmmConfig
   -> LabelMap CLabel -- ^ which blocks are static function entry points
-  -> Set CLabel -- ^ static data
+  -> DataCAFEnv      -- ^ static data
   -> SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)
   -> StateT ModuleSRTInfo UniqSM
         ( [CmmDeclSRTs]          -- generated SRTs
@@ -937,14 +963,14 @@ doSCC
         , CafInfo                -- Whether the group has CAF references
         )
 
-doSCC cfg staticFuns static_data (AcyclicSCC (l, cafLbl, cafs)) =
-  oneSRT cfg staticFuns [l] [cafLbl] False cafs static_data
+doSCC cfg staticFuns static_data_env (AcyclicSCC (l, cafLbl, cafs)) =
+  oneSRT cfg staticFuns [l] [cafLbl] False cafs static_data_env
 
-doSCC cfg staticFuns static_data (CyclicSCC nodes) = do
+doSCC cfg staticFuns static_data_env (CyclicSCC nodes) = do
   -- build a single SRT for the whole cycle, see Note [recursive SRTs]
   let (lbls, caf_lbls, cafsets) = unzip3 nodes
       cafs = Set.unions cafsets
-  oneSRT cfg staticFuns lbls caf_lbls False cafs static_data
+  oneSRT cfg staticFuns lbls caf_lbls False cafs static_data_env
 
 
 {- Note [recursive SRTs]
@@ -957,18 +983,23 @@ else, so we lose nothing by having a single SRT.
 However, there are a couple of wrinkles to be aware of.
 
 * The Set CAFfyLabel for this SRT will contain labels in the group
-itself. The SRTMap will therefore not contain entries for these labels
-yet, so we can't turn them into SRTEntries using resolveCAF. BUT we
-can just remove recursive references from the Set CAFfyLabel before
-generating the SRT - the SRT will still contain all the CAFfyLabels that
-we need to refer to from this group's SRT.
-
-* That is, EXCEPT for static function closures. For the same reason
-described in Note [Invalid optimisation: shortcutting], we cannot omit
-references to static function closures.
-  - But, since we will merge the SRT with one of the static function
-    closures (see [FUN]), we can omit references to *that* static
-    function closure from the SRT.
+  itself. The SRTMap will therefore not contain entries for these labels
+  yet, so we can't turn them into SRTEntries using resolveCAF. BUT we
+  can just remove recursive references from the Set CAFLabel before
+  generating the SRT - the group SRT will consist of the union of the SRTs of
+  each of group's constituents minus recursive references.
+
+* That is, EXCEPT for static function closures and static data constructor
+  applications. For the same reason described in Note [No static object
+  resurrection], we cannot omit references to static function closures and
+  constructor applications.
+
+  But, since we will merge the SRT with one of the static function
+  closures (see [FUN]), we can omit references to *that* static
+  function closure from the SRT.
+
+* Similarly, we must reintroduce recursive references to static data
+  constructor applications into the group's SRT.
 -}
 
 -- | Build an SRT for a set of blocks
@@ -979,7 +1010,7 @@ oneSRT
   -> [CAFfyLabel]               -- ^ labels for those blocks
   -> Bool                       -- ^ True <=> this SRT is for a CAF
   -> Set CAFfyLabel             -- ^ SRT for this set
-  -> Set CLabel                 -- ^ Static data labels in this group
+  -> DataCAFEnv                 -- Static data labels in this group
   -> StateT ModuleSRTInfo UniqSM
        ( [CmmDeclSRTs]                -- SRT objects we built
        , [(Label, CLabel)]            -- SRT fields for these blocks' itbls
@@ -987,7 +1018,7 @@ oneSRT
        , CafInfo                      -- Whether the group has CAF references
        )
 
-oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data = do
+oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data_env = do
   topSRT <- get
 
   let
@@ -1006,7 +1037,10 @@ oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data = do
         [] -> (Nothing, [])
         ((l,b):xs) -> (Just (l,b), map fst xs)
 
-    -- Remove recursive references from the SRT
+    -- Remove recursive references from the SRT as described in
+    -- Note [recursive SRTs]. We carefully reintroduce references to static
+    -- functions and data constructor applications below, as is necessary due
+    -- to Note [No static object resurrection].
     nonRec :: Set CAFfyLabel
     nonRec = cafs `Set.difference` Set.fromList caf_lbls
 
@@ -1028,7 +1062,7 @@ oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data = do
       text "nonRec:"          <+> pdoc platform nonRec $$
       text "lbls:"            <+> pdoc platform lbls $$
       text "caf_lbls:"        <+> pdoc platform caf_lbls $$
-      text "static_data:"     <+> pdoc platform static_data $$
+      text "static_data_env:" <+> pdoc platform static_data_env $$
       text "cafs:"            <+> pdoc platform cafs $$
       text "blockids:"        <+> ppr blockids $$
       text "maybeFunClosure:" <+> pdoc platform maybeFunClosure $$
@@ -1055,7 +1089,7 @@ oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data = do
                  foldl' (\srt_map cafLbl@(CAFfyLabel clbl) ->
                           -- Only map static data to Nothing (== not CAFFY). For CAFFY
                           -- statics we refer to the static itself instead of a SRT.
-                          if not (Set.member clbl static_data) || isNothing srtEntry then
+                          if not (Map.member clbl static_data_env) || isNothing srtEntry then
                             Map.insert cafLbl srtEntry srt_map
                           else
                             srt_map)
@@ -1065,7 +1099,7 @@ oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data = do
                state{ moduleSRTMap = srt_map }
 
     allStaticData =
-      all (\(CAFfyLabel clbl) -> Set.member clbl static_data) caf_lbls
+      all (\(CAFfyLabel clbl) -> Map.member clbl static_data_env) caf_lbls
 
   if Set.null filtered0 then do
     srtTraceM "oneSRT: empty" (pdoc platform caf_lbls)
@@ -1076,7 +1110,16 @@ oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data = do
     -- references in the group. See Note [recursive SRTs].
     let allBelow_funs =
           Set.fromList (map (SRTEntry . toClosureLbl platform) otherFunLabels)
-    let filtered = filtered0 `Set.union` allBelow_funs
+    -- We must also ensure that all CAFfy static data constructor applications
+    -- are included. See Note [recursive SRTs] and #20959.
+    let allBelow_data =
+          Set.fromList
+          [ SRTEntry $ toClosureLbl platform lbl
+          | DeclLabel lbl <- lbls
+          , Just refs <- pure $ Map.lookup lbl static_data_env
+          , not $ Set.null refs
+          ]
+    let filtered = filtered0 `Set.union` allBelow_funs `Set.union` allBelow_data
     srtTraceM "oneSRT" (text "filtered:"      <+> pdoc platform filtered $$
                         text "allBelow_funs:" <+> pdoc platform allBelow_funs)
     case Set.toList filtered of
diff --git a/rts/sm/Storage.h b/rts/sm/Storage.h
index 00f2943a51..0fecc50208 100644
--- a/rts/sm/Storage.h
+++ b/rts/sm/Storage.h
@@ -147,6 +147,12 @@ void move_STACK (StgStack *src, StgStack *dest);
   bits = link_field & 3;
   if ((bits | prev_static_flag) != 3) { ... }
 
+  However, this mechanism for tracking liveness has an important implication:
+  once a static object becomes unreachable it must never become reachable again.
+  One would think that this can by definition never happen but in the past SRT
+  generation bugs have caused precisely this behavior with disasterous results.
+  See Note [No static object resurrection] in GHC.Cmm.Info.Build for details.
+
   -------------------------------------------------------------------------- */
 
 #define STATIC_BITS 3