Merge FUN_STATIC closure with its SRT

Summary:
The idea here is to save a little code size and some work in the GC,
by collapsing FUN_STATIC closures and their SRTs.

This is (4) in a series; see D4632 for more details.

There's a tradeoff here: more complexity in the compiler in exchange
for a modest code size reduction (probably around 0.5%).

Results:
* GHC binary itself (statically linked) is 1% smaller
* -0.2% binary sizes in nofib (-0.5% module sizes)

Full nofib results comparing D4634 with this: P177 (ignore runtimes,
these aren't stable on my laptop)

Test Plan: validate, nofib

Reviewers: bgamari, niteria, simonpj, erikd

Subscribers: thomie, carter

Differential Revision: https://phabricator.haskell.org/D4637

12 files changed, 182 insertions, 122 deletions

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index f059a7b3a8..4c8e528250 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -27,6 +27,8 @@ module Cmm (
 
 import GhcPrelude
 
+import Id
+import CostCentre
 import CLabel
 import BlockId
 import CmmNode
@@ -137,7 +139,10 @@ data CmmInfoTable
       cit_lbl  :: CLabel, -- Info table label
       cit_rep  :: SMRep,
       cit_prof :: ProfilingInfo,
-      cit_srt  :: Maybe CLabel   -- empty, or a closure address
+      cit_srt  :: Maybe CLabel,   -- empty, or a closure address
+      cit_clo  :: Maybe (Id, CostCentreStack)
+        -- Just (id,ccs) <=> build a static closure later
+        -- Nothing <=> don't build a static closure
     }
 
 data ProfilingInfo
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 043f62f811..d9408df202 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE GADTs, BangPatterns, RecordWildCards,
-    GeneralizedNewtypeDeriving, NondecreasingIndentation #-}
+    GeneralizedNewtypeDeriving, NondecreasingIndentation, TupleSections #-}
 
 module CmmBuildInfoTables
   ( CAFSet, CAFEnv, cafAnal
@@ -8,6 +8,7 @@ module CmmBuildInfoTables
 
 import GhcPrelude hiding (succ)
 
+import Id
 import BlockId
 import Hoopl.Block
 import Hoopl.Graph
@@ -34,7 +35,6 @@ import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Tuple
-import Control.Monad
 import Control.Monad.Trans.State
 import Control.Monad.Trans.Class
 
@@ -228,63 +228,47 @@ implemented.
    optimisation and generate the singleton SRT, becase SRTs are in the
    data section and *can* have relocatable references.
 
-2. [FUN] If an SRT refers to a top-level function (a FUN_STATIC), then
-   we can shortcut the reference to point directly to the function's
-   SRT instead.
+2. [FUN] A static function closure can also be an SRT, we simply put
+   the SRT entries as fields in the static closure.  This makes a lot
+   of sense: the static references are just like the free variables of
+   the FUN closure.
 
    i.e. instead of
 
-   +---+---+---
-   |SRT| | |
-   +---+-|-+---
-         |
-         v
-       +---+---+
-       | | | 0 |
-       +-|-+---+
-         |
-         |      +------+
-         |      | info |
-         |      |      |     +-----+---+---+
-         |      |   -------->|SRT_1| | | 0 |
-         `----->|------|     +-----+-|-+---+
-                |      |             |
-                | code |             |
-                |      |             v
-                                  closure
-
-   we can generate
-
-   +---+---+---
-   |SRT| | |
-   +---+-|-+---
-         `----------------------,
-                                |
-       +---+---+                |
-       | | | 0 |                |
-       +-|-+---+                |
-         |                      |
-         |      +------+        |
-         |      | info |        v
-         |      |      |     +-----+---+---+
-         |      |   -------->|SRT_1| | | 0 |
-         `----->|------|     +-----+-|-+---+
-                |      |             |
-                | code |             |
-                |      |             v
-                                  closure
-
-   This is quicker for the garbage collector to traverse, and avoids
-   setting the static link field on the function's closure.
-
-   Of course we can only do this if we know what the function's SRT
-   is. Due to [Shortcut] the function's SRT can be an arbitrary
-   closure, so this optimisation only applies within a module.
-
-   Note: we can *not* do this optimisation for top-level thunks
-   (CAFs), because we want the SRT to point directly to the
-   CAF. Otherwise the SRT would keep the CAF's static references alive
-   even after the CAF had been evaluated!
+   f_closure:
+   +-----+---+
+   |  |  | 0 |
+   +- |--+---+
+      |            +------+
+      |            | info |     f_srt:
+      |            |      |     +-----+---+---+---+
+      |            |   -------->|SRT_2| | | | + 0 |
+      `----------->|------|     +-----+-|-+-|-+---+
+                   |      |             |   |
+                   | code |             |   |
+                   |      |             v   v
+
+
+   We can generate:
+
+   f_closure:
+   +-----+---+---+---+
+   |  |  | | | | | 0 |
+   +- |--+-|-+-|-+---+
+      |    |   |   +------+
+      |    v   v   | info |
+      |            |      |
+      |            |   0  |
+      `----------->|------|
+                   |      |
+                   | code |
+                   |      |
+
+
+   (note: we can't do this for THUNKs, because the thunk gets
+   overwritten when it is entered, so we wouldn't be able to share
+   this SRT with other info tables that want to refer to it (see
+   [Common] below). FUNs are immutable so don't have this problem.)
 
 3. [Common] Identical SRTs can be commoned up.
 
@@ -293,9 +277,6 @@ implemented.
    to C from A.
 
 
-As an alternative to [FUN]: we could merge the FUN's SRT with the FUN
-object itself.
-
 Note that there are many other optimisations that we could do, but
 aren't implemented. In general, we could omit any reference from an
 SRT if everything reachable from it is also reachable from the other
@@ -479,6 +460,19 @@ getCAFs (CmmProc top_info topLbl _ g)
   , isStaticRep rep && isThunkRep rep = [(g_entry g, mkCAFLabel topLbl)]
   | otherwise = []
 
+-- | Get the list of blocks that correspond to the entry points for
+-- FUN_STATIC closures.  These are the blocks for which if we have an
+-- SRT we can merge it with the static closure. [FUN]
+getStaticFuns :: CmmDecl -> [(BlockId, CLabel)]
+getStaticFuns (CmmData _ _) = []
+getStaticFuns (CmmProc top_info _ _ g)
+  | Just info <- mapLookup (g_entry g) (info_tbls top_info)
+  , let rep = cit_rep info
+  , Just (id, _) <- cit_clo info
+  , let lbl = mkLocalClosureLabel (idName id) (idCafInfo id)
+  , isStaticRep rep && isFunRep rep = [(g_entry g, lbl)]
+  | otherwise = []
+
 
 -- | Put the labelled blocks that we will be annotating with SRTs into
 -- dependency order.  This is so that we can process them one at a
@@ -541,6 +535,7 @@ doSRTs dflags topSRT tops = do
   let (cafEnvs, declss) = unzip tops
       cafEnv = mapUnions cafEnvs
       decls = concat declss
+      staticFuns = mapFromList (concatMap getStaticFuns decls)
 
   -- Put the decls in dependency order. Why? So that we can implement
   -- [Shortcut] and [Filter].  If we need to refer to an SRT that has
@@ -552,14 +547,19 @@ doSRTs dflags topSRT tops = do
 
   -- On each strongly-connected group of decls, construct the SRT
   -- closures and the SRT fields for info tables.
-  let (((declss, pairs), _srtMap), topSRT') =
+  let ((result, _srtMap), topSRT') =
         initUs_ us $
         flip runStateT topSRT $
         flip runStateT Map.empty $
-        mapAndUnzipM (doSCC dflags) sccs
+        mapM (doSCC dflags staticFuns) sccs
+
+      (declss, pairs, funSRTs) = unzip3 result
 
   -- Next, update the info tables with the SRTs
-  let decls' = map (updInfoSRTs (mapFromList (concat pairs))) decls
+  let
+    srtFieldMap = mapFromList (concat pairs)
+    funSRTMap = mapFromList (concat funSRTs)
+    decls' = concatMap (updInfoSRTs dflags srtFieldMap funSRTMap) decls
 
   return (topSRT', concat declss ++ decls')
 
@@ -567,26 +567,29 @@ doSRTs dflags topSRT tops = do
 -- | Build the SRT for a strongly-connected component of blocks
 doSCC
   :: DynFlags
+  -> LabelMap CLabel           -- which blocks are static function entry points
   -> SCC (Label, CAFLabel, Set CAFLabel)
   -> StateT SRTMap
         (StateT ModuleSRTInfo UniqSM)
-        ( [CmmDecl]           -- generated SRTs
-        , [(Label, CLabel)] -- SRT fields for info tables
+        ( [CmmDecl]              -- generated SRTs
+        , [(Label, CLabel)]      -- SRT fields for info tables
+        , [(Label, [SRTEntry])]  -- SRTs to attach to static functions
         )
 
-doSCC dflags  (AcyclicSCC (l, cafLbl, cafs)) =
-  oneSRT dflags [l] [cafLbl] cafs
+doSCC dflags staticFuns  (AcyclicSCC (l, cafLbl, cafs)) =
+  oneSRT dflags staticFuns [l] [cafLbl] cafs
 
-doSCC dflags (CyclicSCC nodes) = do
+doSCC dflags staticFuns (CyclicSCC nodes) = do
   -- build a single SRT for the whole cycle
   let (blockids, lbls, cafsets) = unzip3 nodes
       cafs = Set.unions cafsets `Set.difference` Set.fromList lbls
-  oneSRT dflags blockids lbls cafs
+  oneSRT dflags staticFuns blockids lbls cafs
 
 
 -- | Build an SRT for a set of blocks
 oneSRT
   :: DynFlags
+  -> LabelMap CLabel            -- which blocks are static function entry points
   -> [Label]                    -- blocks in this set
   -> [CAFLabel]                 -- labels for those blocks
   -> Set CAFLabel               -- SRT for this set
@@ -594,9 +597,10 @@ oneSRT
        (StateT ModuleSRTInfo UniqSM)
        ( [CmmDecl]                    -- SRT objects we built
        , [(Label, CLabel)]            -- SRT fields for these blocks' itbls
+       , [(Label, [SRTEntry])]        -- SRTs to attach to static functions
        )
 
-oneSRT dflags blockids lbls cafs = do
+oneSRT dflags staticFuns blockids lbls cafs = do
   srtMap <- get
   topSRT <- lift get
   let
@@ -627,12 +631,12 @@ oneSRT dflags blockids lbls cafs = do
     [] -> do
       srtTrace "oneSRT: empty" (ppr lbls) $ return ()
       updateSRTMap Nothing
-      return ([], [])
+      return ([], [], [])
 
     [one@(SRTEntry lbl)]
       | not (labelDynamic dflags (thisModule topSRT) lbl) -> do
         updateSRTMap (Just one)
-        return ([], [(l, lbl) | l <- blockids])
+        return ([], map (,lbl) blockids, [])
 
     cafList ->
       -- Check whether an SRT with the same entries has been emitted already.
@@ -641,11 +645,21 @@ oneSRT dflags blockids lbls cafs = do
         Just srtEntry@(SRTEntry srtLbl)  -> do
           srtTrace "oneSRT [Common]" (ppr lbls <+> ppr srtLbl) $ return ()
           updateSRTMap (Just srtEntry)
-          return ([], [(l, srtLbl) | l <- blockids])
+          return ([], map (,srtLbl) blockids, [])
         Nothing -> do
           -- No duplicates: we have to build a new SRT object
           srtTrace "oneSRT: new" (ppr lbls <+> ppr filtered) $ return ()
-          (decls, srtEntry) <- lift . lift $ buildSRTChain dflags cafList
+          let
+            -- Can we merge this SRT with a FUN_STATIC closure?
+            maybeFunClosure = listToMaybe
+              [ (l,b) | b <- blockids, Just l <- [mapLookup b staticFuns] ]
+          (decls, funSRTs, srtEntry) <-
+            case maybeFunClosure of
+              Just (fun,block) ->
+                return ( [], [(block, cafList)], SRTEntry fun )
+              Nothing -> do
+                (decls, entry) <- lift . lift $ buildSRTChain dflags cafList
+                return (decls, [], entry)
           updateSRTMap (Just srtEntry)
           let allBelowThis = Set.union allBelow filtered
               oldFlatSRTs = flatSRTs topSRT
@@ -654,7 +668,7 @@ oneSRT dflags blockids lbls cafs = do
           lift (put (topSRT { dedupSRTs = newDedupSRTs
                             , flatSRTs = newFlatSRTs }))
           let SRTEntry lbl = srtEntry
-          return (decls, [(l, lbl) | l <- blockids])
+          return (decls, map (,lbl) blockids, funSRTs)
 
 
 -- | build a static SRT object (or a chain of objects) from a list of
@@ -695,21 +709,57 @@ buildSRT dflags refs = do
   return (mkDataLits (Section Data lbl) lbl fields, SRTEntry lbl)
 
 
-{- Note [reverse gs]
-
-   It is important to keep the code blocks in the same order,
-   otherwise binary sizes get slightly bigger.  I'm not completely
-   sure why this is, perhaps the assembler generates bigger jump
-   instructions for forward refs.  --SDM
--}
+-- | Update info tables with references to their SRTs. Also generate
+-- static closures, splicing in SRT fields as necessary.
+updInfoSRTs
+  :: DynFlags
+  -> LabelMap CLabel               -- SRT labels for each block
+  -> LabelMap [SRTEntry]           -- SRTs to merge into FUN_STATIC closures
+  -> CmmDecl
+  -> [CmmDecl]
 
-updInfoSRTs :: LabelMap CLabel -> CmmDecl -> CmmDecl
-updInfoSRTs srt_env (CmmProc top_info top_l live g) =
-  CmmProc (top_info {info_tbls = mapMapWithKey updInfoTbl (info_tbls top_info)}) top_l live g
-  where updInfoTbl l info_tbl
-             = info_tbl { cit_srt = mapLookup l srt_env }
-updInfoSRTs _ t = t
+updInfoSRTs dflags srt_env funSRTEnv (CmmProc top_info top_l live g)
+  | Just (_,closure) <- maybeStaticClosure = [ proc, closure ]
+  | otherwise = [ proc ]
+  where
+    proc = CmmProc top_info { info_tbls = newTopInfo } top_l live g
+    newTopInfo = mapMapWithKey updInfoTbl (info_tbls top_info)
+    updInfoTbl l info_tbl
+      | l == g_entry g, Just (inf, _) <- maybeStaticClosure = inf
+      | otherwise  = info_tbl { cit_srt = mapLookup l srt_env }
+
+    -- Generate static closures [FUN].  Note that this also generates
+    -- static closures for thunks (CAFs), because it's easier to treat
+    -- them uniformly in the code generator.
+    maybeStaticClosure :: Maybe (CmmInfoTable, CmmDecl)
+    maybeStaticClosure
+      | Just info_tbl@CmmInfoTable{..} <-
+           mapLookup (g_entry g) (info_tbls top_info)
+      , Just (id, ccs) <- cit_clo
+      , isStaticRep cit_rep =
+        let
+          (newInfo, srtEntries) = case mapLookup (g_entry g) funSRTEnv of
+            Nothing ->
+              -- if we don't add SRT entries to this closure, then we
+              -- want to set the srt field in its info table as usual
+              (info_tbl { cit_srt = mapLookup (g_entry g) srt_env }, [])
+            Just srtEntries -> srtTrace "maybeStaticFun" (ppr res)
+              (info_tbl { cit_rep = new_rep }, res)
+              where res = [ CmmLabel lbl | SRTEntry lbl <- srtEntries ]
+          fields = mkStaticClosureFields dflags info_tbl ccs (idCafInfo id)
+            srtEntries
+          new_rep = case cit_rep of
+             HeapRep sta ptrs nptrs ty ->
+               HeapRep sta (ptrs + length srtEntries) nptrs ty
+             _other -> panic "maybeStaticFun"
+          lbl = mkLocalClosureLabel (idName id) (idCafInfo id)
+        in
+          Just (newInfo, mkDataLits (Section Data lbl) lbl fields)
+      | otherwise = Nothing
+
+updInfoSRTs _ _ _ t = [t]
 
 
 srtTrace :: String -> SDoc -> b -> b
+-- srtTrace = pprTrace
 srtTrace _ _ b = b
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 4201fda36a..3b2eea1a5e 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -63,7 +63,8 @@ mkEmptyContInfoTable info_lbl
   = CmmInfoTable { cit_lbl  = info_lbl
                  , cit_rep  = mkStackRep []
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = Nothing }
+                 , cit_srt  = Nothing
+                 , cit_clo  = Nothing }
 
 cmmToRawCmm :: DynFlags -> Stream IO CmmGroup ()
             -> IO (Stream IO RawCmmGroup ())
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 1bdf0e6a7e..2113f20a0f 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -472,7 +472,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
                       return (mkCmmEntryLabel pkg $3,
                               Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
                                            , cit_rep = rep
-                                           , cit_prof = prof, cit_srt = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
                               []) }
         
         | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
@@ -488,7 +488,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
                       return (mkCmmEntryLabel pkg $3,
                               Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
                                            , cit_rep = rep
-                                           , cit_prof = prof, cit_srt = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
                               []) }
                 -- we leave most of the fields zero here.  This is only used
                 -- to generate the BCO info table in the RTS at the moment.
@@ -506,7 +506,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
                       return (mkCmmEntryLabel pkg $3,
                               Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
                                            , cit_rep = rep
-                                           , cit_prof = prof, cit_srt = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing,cit_clo = Nothing },
                               []) }
 
                      -- If profiling is on, this string gets duplicated,
@@ -523,7 +523,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
                       return (mkCmmEntryLabel pkg $3,
                               Just $ CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
                                            , cit_rep = rep
-                                           , cit_prof = prof, cit_srt = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
                               []) }
 
         | 'INFO_TABLE_RET' '(' NAME ',' INT ')'
@@ -534,7 +534,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
                       return (mkCmmRetLabel pkg $3,
                               Just $ CmmInfoTable { cit_lbl = mkCmmRetInfoLabel pkg $3
                                            , cit_rep = rep
-                                           , cit_prof = prof, cit_srt = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
                               []) }
 
         | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
@@ -549,7 +549,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
                       return (mkCmmRetLabel pkg $3,
                               Just $ CmmInfoTable { cit_lbl = mkCmmRetInfoLabel pkg $3
                                            , cit_rep = rep
-                                           , cit_prof = prof, cit_srt = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing },
                               live) }
 
 body    :: { CmmParse () }
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index b29394da6f..aa2b954a95 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -95,19 +95,17 @@ cgTopRhsClosure dflags rec id ccs _ upd_flag args body =
          emitDataLits closure_label closure_rep
          return ()
 
-  gen_code dflags lf_info closure_label
-   = do {     -- LAY OUT THE OBJECT
-          let name = idName id
+  gen_code dflags lf_info _closure_label
+   = do { let name = idName id
         ; mod_name <- getModuleName
         ; let descr         = closureDescription dflags mod_name name
               closure_info  = mkClosureInfo dflags True id lf_info 0 0 descr
 
-              caffy         = idCafInfo id
-              info_tbl      = mkCmmInfo closure_info -- XXX short-cut
-              closure_rep   = mkStaticClosureFields dflags info_tbl ccs caffy []
+        -- We don't generate the static closure here, because we might
+        -- want to add references to static closures to it later.  The
+        -- static closure is generated by CmmBuildInfoTables.updInfoSRTs,
+        -- See Note [SRTs], specifically the [FUN] optimisation.
 
-                 -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
-        ; emitDataLits closure_label closure_rep
         ; let fv_details :: [(NonVoid Id, ByteOff)]
               header = if isLFThunk lf_info then ThunkHeader else StdHeader
               (_, _, fv_details) = mkVirtHeapOffsets dflags header []
@@ -367,7 +365,7 @@ mkRhsClosure dflags bndr cc _ fvs upd_flag args body
         ; let use_cc = cccsExpr; blame_cc = cccsExpr
         ; emit (mkComment $ mkFastString "calling allocDynClosure")
         ; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off)
-        ; let info_tbl = mkCmmInfo closure_info
+        ; let info_tbl = mkCmmInfo closure_info bndr currentCCS
         ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info use_cc blame_cc
                                          (map toVarArg fv_details)
 
@@ -407,7 +405,7 @@ cgRhsStdThunk bndr lf_info payload
 
 
         -- BUILD THE OBJECT
-  ; let info_tbl = mkCmmInfo closure_info
+  ; let info_tbl = mkCmmInfo closure_info bndr currentCCS
   ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info
                                    use_cc blame_cc payload_w_offsets
 
@@ -463,7 +461,7 @@ closureCodeBody top_lvl bndr cl_info cc _args arity body fv_details
       \(_, node, _) -> thunkCode cl_info fv_details cc node arity body
    where
      lf_info  = closureLFInfo cl_info
-     info_tbl = mkCmmInfo cl_info
+     info_tbl = mkCmmInfo cl_info bndr cc
 
 closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
   = -- Note: args may be [], if all args are Void
@@ -474,7 +472,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
 
         ; let
              lf_info  = closureLFInfo cl_info
-             info_tbl = mkCmmInfo cl_info
+             info_tbl = mkCmmInfo cl_info bndr cc
 
         -- Emit the main entry code
         ; emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args $
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index d58e9f6f88..e0306eeba3 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -73,6 +73,7 @@ import SMRep
 import Cmm
 import PprCmmExpr()
 
+import CostCentre
 import BlockId
 import CLabel
 import Id
@@ -750,12 +751,15 @@ data ClosureInfo
     }
 
 -- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
-mkCmmInfo :: ClosureInfo -> CmmInfoTable
-mkCmmInfo ClosureInfo {..}
+mkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
+mkCmmInfo ClosureInfo {..} id ccs
   = CmmInfoTable { cit_lbl  = closureInfoLabel
                  , cit_rep  = closureSMRep
                  , cit_prof = closureProf
-                 , cit_srt  = Nothing }
+                 , cit_srt  = Nothing
+                 , cit_clo  = if isStaticRep closureSMRep
+                                then Just (id,ccs)
+                                else Nothing }
 
 --------------------------------------
 --        Building ClosureInfos
@@ -1040,7 +1044,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
  = CmmInfoTable { cit_lbl  = info_lbl
                 , cit_rep  = sm_rep
                 , cit_prof = prof
-                , cit_srt  = Nothing }
+                , cit_srt  = Nothing
+                , cit_clo = Nothing }
  where
    name = dataConName data_con
    info_lbl = mkConInfoTableLabel name NoCafRefs
@@ -1063,14 +1068,16 @@ cafBlackHoleInfoTable
   = CmmInfoTable { cit_lbl  = mkCAFBlackHoleInfoTableLabel
                  , cit_rep  = blackHoleRep
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = Nothing }
+                 , cit_srt  = Nothing
+                 , cit_clo  = Nothing }
 
 indStaticInfoTable :: CmmInfoTable
 indStaticInfoTable
   = CmmInfoTable { cit_lbl  = mkIndStaticInfoLabel
                  , cit_rep  = indStaticRep
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = Nothing }
+                 , cit_srt  = Nothing
+                 , cit_clo  = Nothing }
 
 staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
 -- A static closure needs a link field to aid the GC when traversing
diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h
index 7a3ecaa1d2..dcbc95b31b 100644
--- a/includes/rts/storage/ClosureMacros.h
+++ b/includes/rts/storage/ClosureMacros.h
@@ -172,7 +172,6 @@ INLINE_HEADER StgHalfWord GET_TAG(const StgClosure *con)
    -------------------------------------------------------------------------- */
 
 /* These are hard-coded. */
-#define FUN_STATIC_LINK(p)   (&(p)->payload[0])
 #define THUNK_STATIC_LINK(p) (&(p)->payload[1])
 #define IND_STATIC_LINK(p)   (&(p)->payload[1])
 
@@ -182,8 +181,6 @@ STATIC_LINK(const StgInfoTable *info, StgClosure *p)
     switch (info->type) {
     case THUNK_STATIC:
         return THUNK_STATIC_LINK(p);
-    case FUN_STATIC:
-        return FUN_STATIC_LINK(p);
     case IND_STATIC:
         return IND_STATIC_LINK(p);
     default:
diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 67a6da93cd..5a4530a8aa 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -1908,7 +1908,7 @@ resetStaticObjectForRetainerProfiling( StgClosure *static_objects )
             break;
         case FUN_STATIC:
             maybeInitRetainerSet(p);
-            p = (StgClosure*)*FUN_STATIC_LINK(p);
+            p = (StgClosure*)*STATIC_LINK(p);
             break;
         case CONSTR:
         case CONSTR_1_0:
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index 0e2fea8990..f252e89161 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -212,7 +212,7 @@ thread_static( StgClosure* p )
         p = *THUNK_STATIC_LINK(p);
         continue;
     case FUN_STATIC:
-        p = *FUN_STATIC_LINK(p);
+        p = *STATIC_LINK(info,p);
         continue;
     case CONSTR:
     case CONSTR_NOCAF:
diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index a8559e7e00..e8baebe553 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -542,8 +542,8 @@ loop:
           return;
 
       case FUN_STATIC:
-          if (info->srt != 0) {
-              evacuate_static_object(FUN_STATIC_LINK((StgClosure *)q), q);
+          if (info->srt != 0 || info->layout.payload.ptrs != 0) {
+              evacuate_static_object(STATIC_LINK(info,(StgClosure *)q), q);
           }
           return;
 
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index 7a0ad1672f..defefa3f01 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -677,7 +677,7 @@ checkStaticObjects ( StgClosure* static_objects )
       break;
 
     case FUN_STATIC:
-      p = *FUN_STATIC_LINK((StgClosure *)p);
+      p = *STATIC_LINK(info,(StgClosure *)p);
       break;
 
     case CONSTR:
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 79adcaa826..5db0acbbee 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -1722,7 +1722,9 @@ scavenge_static(void)
 
     case FUN_STATIC:
       scavenge_fun_srt(info);
-      break;
+      // fallthrough: a FUN_STATIC can also be an SRT, so it may have pointer
+      // fields.  See Note [SRTs] in CmmBuildInfoTables, specifically the [FUN]
+      // optimisation.
 
     case CONSTR:
     case CONSTR_NOCAF: