Commit 7da13762 authored by Simon Marlow's avatar Simon Marlow

Code-size optimisation for top-level indirections (#7308)

Top-level indirections are often generated when there is a cast, e.g.

foo :: T
foo = bar `cast` (some coercion)

For these we were generating a full-blown CAF, which is a fair chunk
of code.

This patch makes these indirections generate a single IND_STATIC
closure (4 words) instead.  This is exactly what the CAF would
evaluate to eventually anyway, we're just shortcutting the whole
process.
parent 5874a66b
......@@ -29,6 +29,7 @@ import Panic
import UniqSupply
import MonadUtils
import Util
import Outputable
import Data.Bits
import Data.Word
......@@ -221,7 +222,7 @@ mkInfoTableContents dflags
[] -> mkIntCLit dflags 0
(lit:_rest) -> ASSERT( null _rest ) lit
mk_pieces BlackHole _ = panic "mk_pieces: BlackHole"
mk_pieces other _ = pprPanic "mk_pieces" (ppr other)
mkInfoTableContents _ _ _ = panic "mkInfoTableContents" -- NonInfoTable dealt with earlier
......
......@@ -23,7 +23,7 @@ module SMRep (
ConstrDescription,
-- ** Construction
mkHeapRep, blackHoleRep, mkStackRep, mkRTSRep,
mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep,
-- ** Predicates
isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
......@@ -163,6 +163,7 @@ data ClosureTypeInfo
| Thunk
| ThunkSelector SelectorOffset
| BlackHole
| IndStatic
type ConstrTag = Int
type ConstrDescription = [Word8] -- result of dataConIdentity
......@@ -219,6 +220,9 @@ mkStackRep liveness = StackRep liveness
blackHoleRep :: SMRep
blackHoleRep = HeapRep False 0 0 BlackHole
indStaticRep :: SMRep
indStaticRep = HeapRep True 1 0 IndStatic
-----------------------------------------------------------------------------
-- Predicates
......@@ -240,6 +244,7 @@ isThunkRep :: SMRep -> Bool
isThunkRep (HeapRep _ _ _ Thunk{}) = True
isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
isThunkRep (HeapRep _ _ _ BlackHole{}) = True
isThunkRep (HeapRep _ _ _ IndStatic{}) = True
isThunkRep _ = False
isFunRep :: SMRep -> Bool
......@@ -302,6 +307,7 @@ closureTypeHdrSize dflags ty = case ty of
Thunk{} -> thunkHdrSize dflags
ThunkSelector{} -> thunkHdrSize dflags
BlackHole{} -> thunkHdrSize dflags
IndStatic{} -> thunkHdrSize dflags
_ -> fixedHdrSize dflags
-- All thunks use thunkHdrSize, even if they are non-updatable.
-- this is because we don't have separate closure types for
......@@ -354,6 +360,8 @@ rtsClosureType rep
HeapRep False _ _ BlackHole{} -> BLACKHOLE
HeapRep False _ _ IndStatic{} -> IND_STATIC
_ -> panic "rtsClosureType"
-- We export these ones
......@@ -421,6 +429,7 @@ pprTypeInfo (ThunkSelector offset)
pprTypeInfo Thunk = ptext (sLit "Thunk")
pprTypeInfo BlackHole = ptext (sLit "BlackHole")
pprTypeInfo IndStatic = ptext (sLit "IndStatic")
-- XXX Does not belong here!!
stringToWord8s :: String -> [Word8]
......
......@@ -40,6 +40,7 @@ import Module
import ErrUtils
import Outputable
import Stream
import BasicTypes
import OrdList
import MkGraph
......@@ -117,7 +118,7 @@ variable. -}
cgTopBinding :: DynFlags -> StgBinding -> FCode ()
cgTopBinding dflags (StgNonRec id rhs)
= do { id' <- maybeExternaliseId dflags id
; (info, fcode) <- cgTopRhs id' rhs
; (info, fcode) <- cgTopRhs NonRecursive id' rhs
; fcode
; addBindC (cg_id info) info -- Add the *un-externalised* Id to the envt,
-- so we find it when we look up occurrences
......@@ -127,23 +128,23 @@ cgTopBinding dflags (StgRec pairs)
= do { let (bndrs, rhss) = unzip pairs
; bndrs' <- Prelude.mapM (maybeExternaliseId dflags) bndrs
; let pairs' = zip bndrs' rhss
; r <- sequence $ unzipWith cgTopRhs pairs'
; r <- sequence $ unzipWith (cgTopRhs Recursive) pairs'
; let (infos, fcodes) = unzip r
; addBindsC infos
; sequence_ fcodes
}
cgTopRhs :: Id -> StgRhs -> FCode (CgIdInfo, FCode ())
cgTopRhs :: RecFlag -> Id -> StgRhs -> FCode (CgIdInfo, FCode ())
-- The Id is passed along for setting up a binding...
-- It's already been externalised if necessary
cgTopRhs bndr (StgRhsCon _cc con args)
cgTopRhs _rec bndr (StgRhsCon _cc con args)
= forkStatics (cgTopRhsCon bndr con args)
cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
cgTopRhs rec bndr (StgRhsClosure cc bi fvs upd_flag _srt args body)
= ASSERT(null fvs) -- There should be no free variables
forkStatics (cgTopRhsClosure bndr cc bi upd_flag args body)
forkStatics (cgTopRhsClosure rec bndr cc bi upd_flag args body)
---------------------------------------------------------------
......
......@@ -37,6 +37,7 @@ import CLabel
import StgSyn
import CostCentre
import Id
import IdInfo
import Name
import Module
import ListSetOps
......@@ -56,7 +57,8 @@ import Control.Monad
-- For closures bound at top level, allocate in static space.
-- They should have no free variables.
cgTopRhsClosure :: Id
cgTopRhsClosure :: RecFlag -- member of a recursive group?
-> Id
-> CostCentreStack -- Optional cost centre annotation
-> StgBinderInfo
-> UpdateFlag
......@@ -64,19 +66,39 @@ cgTopRhsClosure :: Id
-> StgExpr
-> FCode (CgIdInfo, FCode ())
cgTopRhsClosure id ccs _ upd_flag args body
cgTopRhsClosure rec id ccs _ upd_flag args body
= do { dflags <- getDynFlags
; lf_info <- mkClosureLFInfo id TopLevel [] upd_flag args
; let closure_label = mkLocalClosureLabel (idName id) (idCafInfo id)
cg_id_info = litIdInfo dflags id lf_info (CmmLabel closure_label)
; return (cg_id_info, gen_code lf_info closure_label)
; return (cg_id_info, gen_code dflags lf_info closure_label)
}
where
gen_code lf_info closure_label
-- special case for a indirection (f = g). We create an IND_STATIC
-- closure pointing directly to the indirectee. This is exactly
-- what the CAF will eventually evaluate to anyway, we're just
-- shortcutting the whole process, and generating a lot less code
-- (#7308)
--
-- Note: we omit the optimisation when this binding is part of a
-- recursive group, because the optimisation would inhibit the black
-- hole detection from working in that case. Test
-- concurrent/should_run/4030 fails, for instance.
--
gen_code dflags _ closure_label
| StgApp f [] <- body, null args, isNonRec rec
= do
cg_info <- getCgIdInfo f
let closure_rep = mkStaticClosureFields dflags
indStaticInfoTable ccs MayHaveCafRefs
[unLit (idInfoToAmode cg_info)]
emitDataLits closure_label closure_rep
return ()
gen_code dflags lf_info closure_label
= do { -- LAY OUT THE OBJECT
let name = idName id
; mod_name <- getModuleName
; dflags <- getDynFlags
; let descr = closureDescription dflags mod_name name
closure_info = mkClosureInfo dflags True id lf_info 0 0 descr
......@@ -95,6 +117,9 @@ cgTopRhsClosure id ccs _ upd_flag args body
; return () }
unLit (CmmLit l) = l
unLit _ = panic "unLit"
------------------------------------------------------------------------
-- Non-top-level bindings
------------------------------------------------------------------------
......@@ -719,15 +744,12 @@ link_caf node _is_upd = do
(CmmReg (CmmLocal node), AddrHint),
(hp_rel, AddrHint) ]
False
-- node is live, so save it.
-- see Note [atomic CAF entry] in rts/sm/Storage.c
; updfr <- getUpdFrameOff
; emit =<< mkCmmIfThen
(CmmMachOp (mo_wordEq dflags) [ CmmReg (CmmLocal ret), CmmLit (zeroCLit dflags)])
-- re-enter R1. Doing this directly is slightly dodgy; we're
-- assuming lots of things, like the stack pointer hasn't
-- moved since we entered the CAF.
-- re-enter the CAF
(let target = entryCode dflags (closureInfoPtr dflags (CmmReg (CmmLocal node))) in
mkJump dflags NativeNodeCall target [] updfr)
......
......@@ -63,6 +63,7 @@ module StgCmmClosure (
-- * InfoTables
mkDataConInfoTable,
cafBlackHoleInfoTable,
indStaticInfoTable,
staticClosureNeedsLink,
) where
......@@ -915,6 +916,13 @@ cafBlackHoleInfoTable
, cit_prof = NoProfilingInfo
, cit_srt = NoC_SRT }
indStaticInfoTable :: CmmInfoTable
indStaticInfoTable
= CmmInfoTable { cit_lbl = mkIndStaticInfoLabel
, cit_rep = indStaticRep
, cit_prof = NoProfilingInfo
, cit_srt = NoC_SRT }
staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
-- A static closure needs a link field to aid the GC when traversing
-- the static closure graph. But it only needs such a field if either
......
......@@ -41,12 +41,10 @@ import SMRep
import Cmm
import CmmUtils
import CostCentre
import Outputable
import IdInfo( CafInfo(..), mayHaveCafRefs )
import Module
import DynFlags
import FastString( mkFastString, fsLit )
import Util
import Control.Monad (when)
import Data.Maybe (isJust)
......@@ -182,8 +180,8 @@ mkStaticClosureFields dflags info_tbl ccs caf_refs payload
is_caf = isThunkRep (cit_rep info_tbl)
padding
| not is_caf = []
| otherwise = ASSERT(null payload) [mkIntCLit dflags 0]
| is_caf && null payload = [mkIntCLit dflags 0]
| otherwise = []
static_link_field
| is_caf || staticClosureNeedsLink (mayHaveCafRefs caf_refs) info_tbl
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment