Revert "Merge FUN_STATIC closure with its SRT"
authorBen Gamari <ben@smart-cactus.org>
Wed, 12 Sep 2018 19:09:20 +0000 (15:09 -0400)
committerBen Gamari <ben@smart-cactus.org>
Thu, 13 Sep 2018 17:44:31 +0000 (13:44 -0400)
This reverts commit 838b69032566ce6ab3918d70e8d5e098d0bcee02.

12 files changed:
compiler/cmm/Cmm.hs
compiler/cmm/CmmBuildInfoTables.hs
compiler/cmm/CmmInfo.hs
compiler/cmm/CmmParse.y
compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmClosure.hs
includes/rts/storage/ClosureMacros.h
rts/RetainerProfile.c
rts/sm/Compact.c
rts/sm/Evac.c
rts/sm/Sanity.c
rts/sm/Scav.c

index 4c8e528..f059a7b 100644 (file)
@@ -27,8 +27,6 @@ module Cmm (
 
 import GhcPrelude
 
-import Id
-import CostCentre
 import CLabel
 import BlockId
 import CmmNode
@@ -139,10 +137,7 @@ data CmmInfoTable
       cit_lbl  :: CLabel, -- Info table label
       cit_rep  :: SMRep,
       cit_prof :: ProfilingInfo,
-      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
+      cit_srt  :: Maybe CLabel   -- empty, or a closure address
     }
 
 data ProfilingInfo
index d9408df..043f62f 100644 (file)
@@ -1,5 +1,5 @@
 {-# LANGUAGE GADTs, BangPatterns, RecordWildCards,
-    GeneralizedNewtypeDeriving, NondecreasingIndentation, TupleSections #-}
+    GeneralizedNewtypeDeriving, NondecreasingIndentation #-}
 
 module CmmBuildInfoTables
   ( CAFSet, CAFEnv, cafAnal
@@ -8,7 +8,6 @@ module CmmBuildInfoTables
 
 import GhcPrelude hiding (succ)
 
-import Id
 import BlockId
 import Hoopl.Block
 import Hoopl.Graph
@@ -35,6 +34,7 @@ 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,47 +228,63 @@ implemented.
    optimisation and generate the singleton SRT, becase SRTs are in the
    data section and *can* have relocatable references.
 
-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.
+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.
 
    i.e. instead of
 
-   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.)
+   +---+---+---
+   |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!
 
 3. [Common] Identical SRTs can be commoned up.
 
@@ -277,6 +293,9 @@ 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
@@ -460,19 +479,6 @@ 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
@@ -535,7 +541,6 @@ 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
@@ -547,19 +552,14 @@ doSRTs dflags topSRT tops = do
 
   -- On each strongly-connected group of decls, construct the SRT
   -- closures and the SRT fields for info tables.
-  let ((result, _srtMap), topSRT') =
+  let (((declss, pairs), _srtMap), topSRT') =
         initUs_ us $
         flip runStateT topSRT $
         flip runStateT Map.empty $
-        mapM (doSCC dflags staticFuns) sccs
-
-      (declss, pairs, funSRTs) = unzip3 result
+        mapAndUnzipM (doSCC dflags) sccs
 
   -- Next, update the info tables with the SRTs
-  let
-    srtFieldMap = mapFromList (concat pairs)
-    funSRTMap = mapFromList (concat funSRTs)
-    decls' = concatMap (updInfoSRTs dflags srtFieldMap funSRTMap) decls
+  let decls' = map (updInfoSRTs (mapFromList (concat pairs))) decls
 
   return (topSRT', concat declss ++ decls')
 
@@ -567,29 +567,26 @@ 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
-        , [(Label, [SRTEntry])]  -- SRTs to attach to static functions
+        ( [CmmDecl]           -- generated SRTs
+        , [(Label, CLabel)] -- SRT fields for info tables
         )
 
-doSCC dflags staticFuns  (AcyclicSCC (l, cafLbl, cafs)) =
-  oneSRT dflags staticFuns [l] [cafLbl] cafs
+doSCC dflags  (AcyclicSCC (l, cafLbl, cafs)) =
+  oneSRT dflags [l] [cafLbl] cafs
 
-doSCC dflags staticFuns (CyclicSCC nodes) = do
+doSCC dflags (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 staticFuns blockids lbls cafs
+  oneSRT dflags 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
@@ -597,10 +594,9 @@ 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 staticFuns blockids lbls cafs = do
+oneSRT dflags blockids lbls cafs = do
   srtMap <- get
   topSRT <- lift get
   let
@@ -631,12 +627,12 @@ oneSRT dflags staticFuns 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 ([], map (,lbl) blockids, [])
+        return ([], [(l, lbl) | l <- blockids])
 
     cafList ->
       -- Check whether an SRT with the same entries has been emitted already.
@@ -645,21 +641,11 @@ oneSRT dflags staticFuns blockids lbls cafs = do
         Just srtEntry@(SRTEntry srtLbl)  -> do
           srtTrace "oneSRT [Common]" (ppr lbls <+> ppr srtLbl) $ return ()
           updateSRTMap (Just srtEntry)
-          return ([], map (,srtLbl) blockids, [])
+          return ([], [(l, srtLbl) | l <- blockids])
         Nothing -> do
           -- No duplicates: we have to build a new SRT object
           srtTrace "oneSRT: new" (ppr lbls <+> ppr filtered) $ return ()
-          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)
+          (decls, srtEntry) <- lift . lift $ buildSRTChain dflags cafList
           updateSRTMap (Just srtEntry)
           let allBelowThis = Set.union allBelow filtered
               oldFlatSRTs = flatSRTs topSRT
@@ -668,7 +654,7 @@ oneSRT dflags staticFuns blockids lbls cafs = do
           lift (put (topSRT { dedupSRTs = newDedupSRTs
                             , flatSRTs = newFlatSRTs }))
           let SRTEntry lbl = srtEntry
-          return (decls, map (,lbl) blockids, funSRTs)
+          return (decls, [(l, lbl) | l <- blockids])
 
 
 -- | build a static SRT object (or a chain of objects) from a list of
@@ -709,57 +695,21 @@ buildSRT dflags refs = do
   return (mkDataLits (Section Data lbl) lbl fields, SRTEntry lbl)
 
 
--- | 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]
+{- Note [reverse gs]
 
-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]
+   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
+-}
+
+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
 
 
 srtTrace :: String -> SDoc -> b -> b
--- srtTrace = pprTrace
 srtTrace _ _ b = b
index 3b2eea1..4201fda 100644 (file)
@@ -63,8 +63,7 @@ mkEmptyContInfoTable info_lbl
   = CmmInfoTable { cit_lbl  = info_lbl
                  , cit_rep  = mkStackRep []
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = Nothing
-                 , cit_clo  = Nothing }
+                 , cit_srt  = Nothing }
 
 cmmToRawCmm :: DynFlags -> Stream IO CmmGroup ()
             -> IO (Stream IO RawCmmGroup ())
index 4d7e288..140d79a 100644 (file)
@@ -470,7 +470,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_clo = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing },
                               []) }
         
         | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
@@ -486,7 +486,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_clo = Nothing },
+                                           , cit_prof = prof, cit_srt = 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.
@@ -504,7 +504,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_clo = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing },
                               []) }
 
                      -- If profiling is on, this string gets duplicated,
@@ -521,7 +521,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_clo = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing },
                               []) }
 
         | 'INFO_TABLE_RET' '(' NAME ',' INT ')'
@@ -532,7 +532,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_clo = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing },
                               []) }
 
         | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
@@ -547,7 +547,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_clo = Nothing },
+                                           , cit_prof = prof, cit_srt = Nothing },
                               live) }
 
 body    :: { CmmParse () }
index aa2b954..b29394d 100644 (file)
@@ -95,17 +95,19 @@ cgTopRhsClosure dflags rec id ccs _ upd_flag args body =
          emitDataLits closure_label closure_rep
          return ()
 
-  gen_code dflags lf_info _closure_label
-   = do { let name = idName id
+  gen_code dflags lf_info closure_label
+   = do {     -- LAY OUT THE OBJECT
+          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
 
-        -- 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.
+              caffy         = idCafInfo id
+              info_tbl      = mkCmmInfo closure_info -- XXX short-cut
+              closure_rep   = mkStaticClosureFields dflags info_tbl ccs caffy []
 
+                 -- 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 []
@@ -365,7 +367,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 bndr currentCCS
+        ; let info_tbl = mkCmmInfo closure_info
         ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info use_cc blame_cc
                                          (map toVarArg fv_details)
 
@@ -405,7 +407,7 @@ cgRhsStdThunk bndr lf_info payload
 
 
         -- BUILD THE OBJECT
-  ; let info_tbl = mkCmmInfo closure_info bndr currentCCS
+  ; let info_tbl = mkCmmInfo closure_info
   ; hp_plus_n <- allocDynClosure (Just bndr) info_tbl lf_info
                                    use_cc blame_cc payload_w_offsets
 
@@ -461,7 +463,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 bndr cc
+     info_tbl = mkCmmInfo cl_info
 
 closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
   = -- Note: args may be [], if all args are Void
@@ -472,7 +474,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
 
         ; let
              lf_info  = closureLFInfo cl_info
-             info_tbl = mkCmmInfo cl_info bndr cc
+             info_tbl = mkCmmInfo cl_info
 
         -- Emit the main entry code
         ; emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args $
index b598059..39d4362 100644 (file)
@@ -73,7 +73,6 @@ import SMRep
 import Cmm
 import PprCmmExpr()
 
-import CostCentre
 import BlockId
 import CLabel
 import Id
@@ -746,15 +745,12 @@ data ClosureInfo
     }
 
 -- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
-mkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable
-mkCmmInfo ClosureInfo {..} id ccs
+mkCmmInfo :: ClosureInfo -> CmmInfoTable
+mkCmmInfo ClosureInfo {..}
   = CmmInfoTable { cit_lbl  = closureInfoLabel
                  , cit_rep  = closureSMRep
                  , cit_prof = closureProf
-                 , cit_srt  = Nothing
-                 , cit_clo  = if isStaticRep closureSMRep
-                                then Just (id,ccs)
-                                else Nothing }
+                 , cit_srt  = Nothing }
 
 --------------------------------------
 --        Building ClosureInfos
@@ -1039,8 +1035,7 @@ 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_clo = Nothing }
+                , cit_srt  = Nothing }
  where
    name = dataConName data_con
    info_lbl = mkConInfoTableLabel name NoCafRefs
@@ -1063,16 +1058,14 @@ cafBlackHoleInfoTable
   = CmmInfoTable { cit_lbl  = mkCAFBlackHoleInfoTableLabel
                  , cit_rep  = blackHoleRep
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = Nothing
-                 , cit_clo  = Nothing }
+                 , cit_srt  = Nothing }
 
 indStaticInfoTable :: CmmInfoTable
 indStaticInfoTable
   = CmmInfoTable { cit_lbl  = mkIndStaticInfoLabel
                  , cit_rep  = indStaticRep
                  , cit_prof = NoProfilingInfo
-                 , cit_srt  = Nothing
-                 , cit_clo  = Nothing }
+                 , cit_srt  = Nothing }
 
 staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
 -- A static closure needs a link field to aid the GC when traversing
index 71d53ae..4f77ba7 100644 (file)
@@ -172,6 +172,7 @@ 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])
 
@@ -181,6 +182,8 @@ 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:
index 061925a..0816dd9 100644 (file)
@@ -1912,7 +1912,7 @@ resetStaticObjectForRetainerProfiling( StgClosure *static_objects )
             break;
         case FUN_STATIC:
             maybeInitRetainerSet(p);
-            p = (StgClosure*)*STATIC_LINK(p);
+            p = (StgClosure*)*FUN_STATIC_LINK(p);
             break;
         case CONSTR:
         case CONSTR_1_0:
index 10ad73c..a55ec44 100644 (file)
@@ -212,7 +212,7 @@ thread_static( StgClosure* p )
         p = *THUNK_STATIC_LINK(p);
         continue;
     case FUN_STATIC:
-        p = *STATIC_LINK(info,p);
+        p = *FUN_STATIC_LINK(p);
         continue;
     case CONSTR:
     case CONSTR_NOCAF:
index 2890319..8e0146b 100644 (file)
@@ -528,8 +528,8 @@ loop:
           return;
 
       case FUN_STATIC:
-          if (info->srt != 0 || info->layout.payload.ptrs != 0) {
-              evacuate_static_object(STATIC_LINK(info,(StgClosure *)q), q);
+          if (info->srt != 0) {
+              evacuate_static_object(FUN_STATIC_LINK((StgClosure *)q), q);
           }
           return;
 
index 8d4171b..f895058 100644 (file)
@@ -690,7 +690,7 @@ checkStaticObjects ( StgClosure* static_objects )
       break;
 
     case FUN_STATIC:
-      p = *STATIC_LINK(info,(StgClosure *)p);
+      p = *FUN_STATIC_LINK((StgClosure *)p);
       break;
 
     case CONSTR:
index 39374c0..4f5665b 100644 (file)
@@ -1707,11 +1707,7 @@ scavenge_static(void)
 
     case FUN_STATIC:
       scavenge_fun_srt(info);
-      /* fallthrough */
-
-      // a FUN_STATIC can also be an SRT, so it may have pointer
-      // fields.  See Note [SRTs] in CmmBuildInfoTables, specifically
-      // the [FUN] optimisation.
+      break;
 
     case CONSTR:
     case CONSTR_NOCAF: