1{-# LANGUAGE CPP, RecordWildCards #-} 2 3----------------------------------------------------------------------------- 4-- 5-- Stg to C-- code generation: 6-- 7-- The types LambdaFormInfo 8-- ClosureInfo 9-- 10-- Nothing monadic in here! 11-- 12----------------------------------------------------------------------------- 13 14module GHC.StgToCmm.Closure ( 15 DynTag, tagForCon, isSmallFamily, 16 17 idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps, 18 argPrimRep, 19 20 NonVoid(..), fromNonVoid, nonVoidIds, nonVoidStgArgs, 21 assertNonVoidIds, assertNonVoidStgArgs, 22 23 -- * LambdaFormInfo 24 LambdaFormInfo, -- Abstract 25 StandardFormInfo, -- ...ditto... 26 mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo, 27 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape, 28 mkLFStringLit, 29 lfDynTag, 30 isLFThunk, isLFReEntrant, lfUpdatable, 31 32 -- * Used by other modules 33 CgLoc(..), SelfLoopInfo, CallMethod(..), 34 nodeMustPointToIt, isKnownFun, funTag, tagForArity, getCallMethod, 35 36 -- * ClosureInfo 37 ClosureInfo, 38 mkClosureInfo, 39 mkCmmInfo, 40 41 -- ** Inspection 42 closureLFInfo, closureName, 43 44 -- ** Labels 45 -- These just need the info table label 46 closureInfoLabel, staticClosureLabel, 47 closureSlowEntryLabel, closureLocalEntryLabel, 48 49 -- ** Predicates 50 -- These are really just functions on LambdaFormInfo 51 closureUpdReqd, closureSingleEntry, 52 closureReEntrant, closureFunInfo, 53 isToplevClosure, 54 55 blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep 56 isStaticClosure, -- Needs SMPre 57 58 -- * InfoTables 59 mkDataConInfoTable, 60 cafBlackHoleInfoTable, 61 indStaticInfoTable, 62 staticClosureNeedsLink, 63 ) where 64 65#include "HsVersions.h" 66 67import GhcPrelude 68 69import StgSyn 70import SMRep 71import Cmm 72import PprCmmExpr() -- For Outputable instances 73 74import CostCentre 75import BlockId 76import CLabel 77import Id 78import IdInfo 79import DataCon 80import Name 81import Type 82import TyCoRep 83import TcType 84import TyCon 85import RepType 86import BasicTypes 87import Outputable 88import DynFlags 89import Util 90 91import Data.Coerce (coerce) 92import qualified Data.ByteString.Char8 as BS8 93 94----------------------------------------------------------------------------- 95-- Data types and synonyms 96----------------------------------------------------------------------------- 97 98-- These data types are mostly used by other modules, especially 99-- GHC.StgToCmm.Monad, but we define them here because some functions in this 100-- module need to have access to them as well 101 102data CgLoc 103 = CmmLoc CmmExpr -- A stable CmmExpr; that is, one not mentioning 104 -- Hp, so that it remains valid across calls 105 106 | LneLoc BlockId [LocalReg] -- A join point 107 -- A join point (= let-no-escape) should only 108 -- be tail-called, and in a saturated way. 109 -- To tail-call it, assign to these locals, 110 -- and branch to the block id 111 112instance Outputable CgLoc where 113 ppr (CmmLoc e) = text "cmm" <+> ppr e 114 ppr (LneLoc b rs) = text "lne" <+> ppr b <+> ppr rs 115 116type SelfLoopInfo = (Id, BlockId, [LocalReg]) 117 118-- used by ticky profiling 119isKnownFun :: LambdaFormInfo -> Bool 120isKnownFun LFReEntrant{} = True 121isKnownFun LFLetNoEscape = True 122isKnownFun _ = False 123 124 125------------------------------------- 126-- Non-void types 127------------------------------------- 128-- We frequently need the invariant that an Id or a an argument 129-- is of a non-void type. This type is a witness to the invariant. 130 131newtype NonVoid a = NonVoid a 132 deriving (Eq, Show) 133 134fromNonVoid :: NonVoid a -> a 135fromNonVoid (NonVoid a) = a 136 137instance (Outputable a) => Outputable (NonVoid a) where 138 ppr (NonVoid a) = ppr a 139 140nonVoidIds :: [Id] -> [NonVoid Id] 141nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidTy (idType id))] 142 143-- | Used in places where some invariant ensures that all these Ids are 144-- non-void; e.g. constructor field binders in case expressions. 145-- See Note [Post-unarisation invariants] in UnariseStg. 146assertNonVoidIds :: [Id] -> [NonVoid Id] 147assertNonVoidIds ids = ASSERT(not (any (isVoidTy . idType) ids)) 148 coerce ids 149 150nonVoidStgArgs :: [StgArg] -> [NonVoid StgArg] 151nonVoidStgArgs args = [NonVoid arg | arg <- args, not (isVoidTy (stgArgType arg))] 152 153-- | Used in places where some invariant ensures that all these arguments are 154-- non-void; e.g. constructor arguments. 155-- See Note [Post-unarisation invariants] in UnariseStg. 156assertNonVoidStgArgs :: [StgArg] -> [NonVoid StgArg] 157assertNonVoidStgArgs args = ASSERT(not (any (isVoidTy . stgArgType) args)) 158 coerce args 159 160 161----------------------------------------------------------------------------- 162-- Representations 163----------------------------------------------------------------------------- 164 165-- Why are these here? 166 167-- | Assumes that there is precisely one 'PrimRep' of the type. This assumption 168-- holds after unarise. 169-- See Note [Post-unarisation invariants] 170idPrimRep :: Id -> PrimRep 171idPrimRep id = typePrimRep1 (idType id) 172 -- See also Note [VoidRep] in RepType 173 174-- | Assumes that Ids have one PrimRep, which holds after unarisation. 175-- See Note [Post-unarisation invariants] 176addIdReps :: [NonVoid Id] -> [NonVoid (PrimRep, Id)] 177addIdReps = map (\id -> let id' = fromNonVoid id 178 in NonVoid (idPrimRep id', id')) 179 180-- | Assumes that arguments have one PrimRep, which holds after unarisation. 181-- See Note [Post-unarisation invariants] 182addArgReps :: [NonVoid StgArg] -> [NonVoid (PrimRep, StgArg)] 183addArgReps = map (\arg -> let arg' = fromNonVoid arg 184 in NonVoid (argPrimRep arg', arg')) 185 186-- | Assumes that the argument has one PrimRep, which holds after unarisation. 187-- See Note [Post-unarisation invariants] 188argPrimRep :: StgArg -> PrimRep 189argPrimRep arg = typePrimRep1 (stgArgType arg) 190 191 192----------------------------------------------------------------------------- 193-- LambdaFormInfo 194----------------------------------------------------------------------------- 195 196-- Information about an identifier, from the code generator's point of 197-- view. Every identifier is bound to a LambdaFormInfo in the 198-- environment, which gives the code generator enough info to be able to 199-- tail call or return that identifier. 200 201data LambdaFormInfo 202 = LFReEntrant -- Reentrant closure (a function) 203 TopLevelFlag -- True if top level 204 OneShotInfo 205 !RepArity -- Arity. Invariant: always > 0 206 !Bool -- True <=> no fvs 207 ArgDescr -- Argument descriptor (should really be in ClosureInfo) 208 209 | LFThunk -- Thunk (zero arity) 210 TopLevelFlag 211 !Bool -- True <=> no free vars 212 !Bool -- True <=> updatable (i.e., *not* single-entry) 213 StandardFormInfo 214 !Bool -- True <=> *might* be a function type 215 216 | LFCon -- A saturated constructor application 217 DataCon -- The constructor 218 219 | LFUnknown -- Used for function arguments and imported things. 220 -- We know nothing about this closure. 221 -- Treat like updatable "LFThunk"... 222 -- Imported things which we *do* know something about use 223 -- one of the other LF constructors (eg LFReEntrant for 224 -- known functions) 225 !Bool -- True <=> *might* be a function type 226 -- The False case is good when we want to enter it, 227 -- because then we know the entry code will do 228 -- For a function, the entry code is the fast entry point 229 230 | LFUnlifted -- A value of unboxed type; 231 -- always a value, needs evaluation 232 233 | LFLetNoEscape -- See LetNoEscape module for precise description 234 235 236------------------------- 237-- StandardFormInfo tells whether this thunk has one of 238-- a small number of standard forms 239 240data StandardFormInfo 241 = NonStandardThunk 242 -- The usual case: not of the standard forms 243 244 | SelectorThunk 245 -- A SelectorThunk is of form 246 -- case x of 247 -- con a1,..,an -> ak 248 -- and the constructor is from a single-constr type. 249 WordOff -- 0-origin offset of ak within the "goods" of 250 -- constructor (Recall that the a1,...,an may be laid 251 -- out in the heap in a non-obvious order.) 252 253 | ApThunk 254 -- An ApThunk is of form 255 -- x1 ... xn 256 -- The code for the thunk just pushes x2..xn on the stack and enters x1. 257 -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled 258 -- in the RTS to save space. 259 RepArity -- Arity, n 260 261 262------------------------------------------------------ 263-- Building LambdaFormInfo 264------------------------------------------------------ 265 266mkLFArgument :: Id -> LambdaFormInfo 267mkLFArgument id 268 | isUnliftedType ty = LFUnlifted 269 | might_be_a_function ty = LFUnknown True 270 | otherwise = LFUnknown False 271 where 272 ty = idType id 273 274------------- 275mkLFLetNoEscape :: LambdaFormInfo 276mkLFLetNoEscape = LFLetNoEscape 277 278------------- 279mkLFReEntrant :: TopLevelFlag -- True of top level 280 -> [Id] -- Free vars 281 -> [Id] -- Args 282 -> ArgDescr -- Argument descriptor 283 -> LambdaFormInfo 284 285mkLFReEntrant _ _ [] _ 286 = pprPanic "mkLFReEntrant" empty 287mkLFReEntrant top fvs args arg_descr 288 = LFReEntrant top os_info (length args) (null fvs) arg_descr 289 where os_info = idOneShotInfo (head args) 290 291------------- 292mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo 293mkLFThunk thunk_ty top fvs upd_flag 294 = ASSERT( not (isUpdatable upd_flag) || not (isUnliftedType thunk_ty) ) 295 LFThunk top (null fvs) 296 (isUpdatable upd_flag) 297 NonStandardThunk 298 (might_be_a_function thunk_ty) 299 300-------------- 301might_be_a_function :: Type -> Bool 302-- Return False only if we are *sure* it's a data type 303-- Look through newtypes etc as much as poss 304might_be_a_function ty 305 | [LiftedRep] <- typePrimRep ty 306 , Just tc <- tyConAppTyCon_maybe (unwrapType ty) 307 , isDataTyCon tc 308 = False 309 | otherwise 310 = True 311 312------------- 313mkConLFInfo :: DataCon -> LambdaFormInfo 314mkConLFInfo con = LFCon con 315 316------------- 317mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo 318mkSelectorLFInfo id offset updatable 319 = LFThunk NotTopLevel False updatable (SelectorThunk offset) 320 (might_be_a_function (idType id)) 321 322------------- 323mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo 324mkApLFInfo id upd_flag arity 325 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) 326 (might_be_a_function (idType id)) 327 328------------- 329mkLFImported :: Id -> LambdaFormInfo 330mkLFImported id 331 | Just con <- isDataConWorkId_maybe id 332 , isNullaryRepDataCon con 333 = LFCon con -- An imported nullary constructor 334 -- We assume that the constructor is evaluated so that 335 -- the id really does point directly to the constructor 336 337 | arity > 0 338 = LFReEntrant TopLevel noOneShotInfo arity True (panic "arg_descr") 339 340 | otherwise 341 = mkLFArgument id -- Not sure of exact arity 342 where 343 arity = idFunRepArity id 344 345------------- 346mkLFStringLit :: LambdaFormInfo 347mkLFStringLit = LFUnlifted 348 349----------------------------------------------------- 350-- Dynamic pointer tagging 351----------------------------------------------------- 352 353type DynTag = Int -- The tag on a *pointer* 354 -- (from the dynamic-tagging paper) 355 356-- Note [Data constructor dynamic tags] 357-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 358-- 359-- The family size of a data type (the number of constructors 360-- or the arity of a function) can be either: 361-- * small, if the family size < 2**tag_bits 362-- * big, otherwise. 363-- 364-- Small families can have the constructor tag in the tag bits. 365-- Big families always use the tag values 1..mAX_PTR_TAG to represent 366-- evaluatedness, the last one lumping together all overflowing ones. 367-- We don't have very many tag bits: for example, we have 2 bits on 368-- x86-32 and 3 bits on x86-64. 369-- 370-- Also see Note [Tagging big families] in GHC.StgToCmm.Expr 371 372isSmallFamily :: DynFlags -> Int -> Bool 373isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags 374 375tagForCon :: DynFlags -> DataCon -> DynTag 376tagForCon dflags con = min (dataConTag con) (mAX_PTR_TAG dflags) 377-- NB: 1-indexed 378 379tagForArity :: DynFlags -> RepArity -> DynTag 380tagForArity dflags arity 381 | isSmallFamily dflags arity = arity 382 | otherwise = 0 383 384lfDynTag :: DynFlags -> LambdaFormInfo -> DynTag 385-- Return the tag in the low order bits of a variable bound 386-- to this LambdaForm 387lfDynTag dflags (LFCon con) = tagForCon dflags con 388lfDynTag dflags (LFReEntrant _ _ arity _ _) = tagForArity dflags arity 389lfDynTag _ _other = 0 390 391 392----------------------------------------------------------------------------- 393-- Observing LambdaFormInfo 394----------------------------------------------------------------------------- 395 396------------ 397isLFThunk :: LambdaFormInfo -> Bool 398isLFThunk (LFThunk {}) = True 399isLFThunk _ = False 400 401isLFReEntrant :: LambdaFormInfo -> Bool 402isLFReEntrant (LFReEntrant {}) = True 403isLFReEntrant _ = False 404 405----------------------------------------------------------------------------- 406-- Choosing SM reps 407----------------------------------------------------------------------------- 408 409lfClosureType :: LambdaFormInfo -> ClosureTypeInfo 410lfClosureType (LFReEntrant _ _ arity _ argd) = Fun arity argd 411lfClosureType (LFCon con) = Constr (dataConTagZ con) 412 (dataConIdentity con) 413lfClosureType (LFThunk _ _ _ is_sel _) = thunkClosureType is_sel 414lfClosureType _ = panic "lfClosureType" 415 416thunkClosureType :: StandardFormInfo -> ClosureTypeInfo 417thunkClosureType (SelectorThunk off) = ThunkSelector off 418thunkClosureType _ = Thunk 419 420-- We *do* get non-updatable top-level thunks sometimes. eg. f = g 421-- gets compiled to a jump to g (if g has non-zero arity), instead of 422-- messing around with update frames and PAPs. We set the closure type 423-- to FUN_STATIC in this case. 424 425----------------------------------------------------------------------------- 426-- nodeMustPointToIt 427----------------------------------------------------------------------------- 428 429nodeMustPointToIt :: DynFlags -> LambdaFormInfo -> Bool 430-- If nodeMustPointToIt is true, then the entry convention for 431-- this closure has R1 (the "Node" register) pointing to the 432-- closure itself --- the "self" argument 433 434nodeMustPointToIt _ (LFReEntrant top _ _ no_fvs _) 435 = not no_fvs -- Certainly if it has fvs we need to point to it 436 || isNotTopLevel top -- See Note [GC recovery] 437 -- For lex_profiling we also access the cost centre for a 438 -- non-inherited (i.e. non-top-level) function. 439 -- The isNotTopLevel test above ensures this is ok. 440 441nodeMustPointToIt dflags (LFThunk top no_fvs updatable NonStandardThunk _) 442 = not no_fvs -- Self parameter 443 || isNotTopLevel top -- Note [GC recovery] 444 || updatable -- Need to push update frame 445 || gopt Opt_SccProfilingOn dflags 446 -- For the non-updatable (single-entry case): 447 -- 448 -- True if has fvs (in which case we need access to them, and we 449 -- should black-hole it) 450 -- or profiling (in which case we need to recover the cost centre 451 -- from inside it) ToDo: do we need this even for 452 -- top-level thunks? If not, 453 -- isNotTopLevel subsumes this 454 455nodeMustPointToIt _ (LFThunk {}) -- Node must point to a standard-form thunk 456 = True 457 458nodeMustPointToIt _ (LFCon _) = True 459 460 -- Strictly speaking, the above two don't need Node to point 461 -- to it if the arity = 0. But this is a *really* unlikely 462 -- situation. If we know it's nil (say) and we are entering 463 -- it. Eg: let x = [] in x then we will certainly have inlined 464 -- x, since nil is a simple atom. So we gain little by not 465 -- having Node point to known zero-arity things. On the other 466 -- hand, we do lose something; Patrick's code for figuring out 467 -- when something has been updated but not entered relies on 468 -- having Node point to the result of an update. SLPJ 469 -- 27/11/92. 470 471nodeMustPointToIt _ (LFUnknown _) = True 472nodeMustPointToIt _ LFUnlifted = False 473nodeMustPointToIt _ LFLetNoEscape = False 474 475{- Note [GC recovery] 476~~~~~~~~~~~~~~~~~~~~~ 477If we a have a local let-binding (function or thunk) 478 let f = <body> in ... 479AND <body> allocates, then the heap-overflow check needs to know how 480to re-start the evaluation. It uses the "self" pointer to do this. 481So even if there are no free variables in <body>, we still make 482nodeMustPointToIt be True for non-top-level bindings. 483 484Why do any such bindings exist? After all, let-floating should have 485floated them out. Well, a clever optimiser might leave one there to 486avoid a space leak, deliberately recomputing a thunk. Also (and this 487really does happen occasionally) let-floating may make a function f smaller 488so it can be inlined, so now (f True) may generate a local no-fv closure. 489This actually happened during bootstrapping GHC itself, with f=mkRdrFunBind 490in TcGenDeriv.) -} 491 492----------------------------------------------------------------------------- 493-- getCallMethod 494----------------------------------------------------------------------------- 495 496{- The entry conventions depend on the type of closure being entered, 497whether or not it has free variables, and whether we're running 498sequentially or in parallel. 499 500Closure Node Argument Enter 501Characteristics Par Req'd Passing Via 502--------------------------------------------------------------------------- 503Unknown & no & yes & stack & node 504Known fun (>1 arg), no fvs & no & no & registers & fast entry (enough args) 505 & slow entry (otherwise) 506Known fun (>1 arg), fvs & no & yes & registers & fast entry (enough args) 5070 arg, no fvs \r,\s & no & no & n/a & direct entry 5080 arg, no fvs \u & no & yes & n/a & node 5090 arg, fvs \r,\s,selector & no & yes & n/a & node 5100 arg, fvs \r,\s & no & yes & n/a & direct entry 5110 arg, fvs \u & no & yes & n/a & node 512Unknown & yes & yes & stack & node 513Known fun (>1 arg), no fvs & yes & no & registers & fast entry (enough args) 514 & slow entry (otherwise) 515Known fun (>1 arg), fvs & yes & yes & registers & node 5160 arg, fvs \r,\s,selector & yes & yes & n/a & node 5170 arg, no fvs \r,\s & yes & no & n/a & direct entry 5180 arg, no fvs \u & yes & yes & n/a & node 5190 arg, fvs \r,\s & yes & yes & n/a & node 5200 arg, fvs \u & yes & yes & n/a & node 521 522When black-holing, single-entry closures could also be entered via node 523(rather than directly) to catch double-entry. -} 524 525data CallMethod 526 = EnterIt -- No args, not a function 527 528 | JumpToIt BlockId [LocalReg] -- A join point or a header of a local loop 529 530 | ReturnIt -- It's a value (function, unboxed value, 531 -- or constructor), so just return it. 532 533 | SlowCall -- Unknown fun, or known fun with 534 -- too few args. 535 536 | DirectEntry -- Jump directly, with args in regs 537 CLabel -- The code label 538 RepArity -- Its arity 539 540getCallMethod :: DynFlags 541 -> Name -- Function being applied 542 -> Id -- Function Id used to chech if it can refer to 543 -- CAF's and whether the function is tail-calling 544 -- itself 545 -> LambdaFormInfo -- Its info 546 -> RepArity -- Number of available arguments 547 -> RepArity -- Number of them being void arguments 548 -> CgLoc -- Passed in from cgIdApp so that we can 549 -- handle let-no-escape bindings and self-recursive 550 -- tail calls using the same data constructor, 551 -- JumpToIt. This saves us one case branch in 552 -- cgIdApp 553 -> Maybe SelfLoopInfo -- can we perform a self-recursive tail call? 554 -> CallMethod 555 556getCallMethod dflags _ id _ n_args v_args _cg_loc 557 (Just (self_loop_id, block_id, args)) 558 | gopt Opt_Loopification dflags 559 , id == self_loop_id 560 , args `lengthIs` (n_args - v_args) 561 -- If these patterns match then we know that: 562 -- * loopification optimisation is turned on 563 -- * function is performing a self-recursive call in a tail position 564 -- * number of non-void parameters of the function matches functions arity. 565 -- See Note [Self-recursive tail calls] and Note [Void arguments in 566 -- self-recursive tail calls] in GHC.StgToCmm.Expr for more details 567 = JumpToIt block_id args 568 569getCallMethod dflags name id (LFReEntrant _ _ arity _ _) n_args _v_args _cg_loc 570 _self_loop_info 571 | n_args == 0 -- No args at all 572 && not (gopt Opt_SccProfilingOn dflags) 573 -- See Note [Evaluating functions with profiling] in rts/Apply.cmm 574 = ASSERT( arity /= 0 ) ReturnIt 575 | n_args < arity = SlowCall -- Not enough args 576 | otherwise = DirectEntry (enterIdLabel dflags name (idCafInfo id)) arity 577 578getCallMethod _ _name _ LFUnlifted n_args _v_args _cg_loc _self_loop_info 579 = ASSERT( n_args == 0 ) ReturnIt 580 581getCallMethod _ _name _ (LFCon _) n_args _v_args _cg_loc _self_loop_info 582 = ASSERT( n_args == 0 ) ReturnIt 583 -- n_args=0 because it'd be ill-typed to apply a saturated 584 -- constructor application to anything 585 586getCallMethod dflags name id (LFThunk _ _ updatable std_form_info is_fun) 587 n_args _v_args _cg_loc _self_loop_info 588 | is_fun -- it *might* be a function, so we must "call" it (which is always safe) 589 = SlowCall -- We cannot just enter it [in eval/apply, the entry code 590 -- is the fast-entry code] 591 592 -- Since is_fun is False, we are *definitely* looking at a data value 593 | updatable || gopt Opt_Ticky dflags -- to catch double entry 594 {- OLD: || opt_SMP 595 I decided to remove this, because in SMP mode it doesn't matter 596 if we enter the same thunk multiple times, so the optimisation 597 of jumping directly to the entry code is still valid. --SDM 598 -} 599 = EnterIt 600 601 -- even a non-updatable selector thunk can be updated by the garbage 602 -- collector, so we must enter it. (#8817) 603 | SelectorThunk{} <- std_form_info 604 = EnterIt 605 606 -- We used to have ASSERT( n_args == 0 ), but actually it is 607 -- possible for the optimiser to generate 608 -- let bot :: Int = error Int "urk" 609 -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3 610 -- This happens as a result of the case-of-error transformation 611 -- So the right thing to do is just to enter the thing 612 613 | otherwise -- Jump direct to code for single-entry thunks 614 = ASSERT( n_args == 0 ) 615 DirectEntry (thunkEntryLabel dflags name (idCafInfo id) std_form_info 616 updatable) 0 617 618getCallMethod _ _name _ (LFUnknown True) _n_arg _v_args _cg_locs _self_loop_info 619 = SlowCall -- might be a function 620 621getCallMethod _ name _ (LFUnknown False) n_args _v_args _cg_loc _self_loop_info 622 = ASSERT2( n_args == 0, ppr name <+> ppr n_args ) 623 EnterIt -- Not a function 624 625getCallMethod _ _name _ LFLetNoEscape _n_args _v_args (LneLoc blk_id lne_regs) 626 _self_loop_info 627 = JumpToIt blk_id lne_regs 628 629getCallMethod _ _ _ _ _ _ _ _ = panic "Unknown call method" 630 631----------------------------------------------------------------------------- 632-- Data types for closure information 633----------------------------------------------------------------------------- 634 635 636{- ClosureInfo: information about a binding 637 638 We make a ClosureInfo for each let binding (both top level and not), 639 but not bindings for data constructors: for those we build a CmmInfoTable 640 directly (see mkDataConInfoTable). 641 642 To a first approximation: 643 ClosureInfo = (LambdaFormInfo, CmmInfoTable) 644 645 A ClosureInfo has enough information 646 a) to construct the info table itself, and build other things 647 related to the binding (e.g. slow entry points for a function) 648 b) to allocate a closure containing that info pointer (i.e. 649 it knows the info table label) 650-} 651 652data ClosureInfo 653 = ClosureInfo { 654 closureName :: !Name, -- The thing bound to this closure 655 -- we don't really need this field: it's only used in generating 656 -- code for ticky and profiling, and we could pass the information 657 -- around separately, but it doesn't do much harm to keep it here. 658 659 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon 660 -- this tells us about what the closure contains: it's right-hand-side. 661 662 -- the rest is just an unpacked CmmInfoTable. 663 closureInfoLabel :: !CLabel, 664 closureSMRep :: !SMRep, -- representation used by storage mgr 665 closureProf :: !ProfilingInfo 666 } 667 668-- | Convert from 'ClosureInfo' to 'CmmInfoTable'. 669mkCmmInfo :: ClosureInfo -> Id -> CostCentreStack -> CmmInfoTable 670mkCmmInfo ClosureInfo {..} id ccs 671 = CmmInfoTable { cit_lbl = closureInfoLabel 672 , cit_rep = closureSMRep 673 , cit_prof = closureProf 674 , cit_srt = Nothing 675 , cit_clo = if isStaticRep closureSMRep 676 then Just (id,ccs) 677 else Nothing } 678 679-------------------------------------- 680-- Building ClosureInfos 681-------------------------------------- 682 683mkClosureInfo :: DynFlags 684 -> Bool -- Is static 685 -> Id 686 -> LambdaFormInfo 687 -> Int -> Int -- Total and pointer words 688 -> String -- String descriptor 689 -> ClosureInfo 690mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr 691 = ClosureInfo { closureName = name 692 , closureLFInfo = lf_info 693 , closureInfoLabel = info_lbl -- These three fields are 694 , closureSMRep = sm_rep -- (almost) an info table 695 , closureProf = prof } -- (we don't have an SRT yet) 696 where 697 name = idName id 698 sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType lf_info) 699 prof = mkProfilingInfo dflags id val_descr 700 nonptr_wds = tot_wds - ptr_wds 701 702 info_lbl = mkClosureInfoTableLabel id lf_info 703 704-------------------------------------- 705-- Other functions over ClosureInfo 706-------------------------------------- 707 708-- Eager blackholing is normally disabled, but can be turned on with 709-- -feager-blackholing. When it is on, we replace the info pointer of 710-- the thunk with stg_EAGER_BLACKHOLE_info on entry. 711 712-- If we wanted to do eager blackholing with slop filling, 713-- we'd need to do it at the *end* of a basic block, otherwise 714-- we overwrite the free variables in the thunk that we still 715-- need. We have a patch for this from Andy Cheadle, but not 716-- incorporated yet. --SDM [6/2004] 717-- 718-- Previously, eager blackholing was enabled when ticky-ticky 719-- was on. But it didn't work, and it wasn't strictly necessary 720-- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING 721-- is unconditionally disabled. -- krc 1/2007 722-- 723-- Static closures are never themselves black-holed. 724 725blackHoleOnEntry :: ClosureInfo -> Bool 726blackHoleOnEntry cl_info 727 | isStaticRep (closureSMRep cl_info) 728 = False -- Never black-hole a static closure 729 730 | otherwise 731 = case closureLFInfo cl_info of 732 LFReEntrant {} -> False 733 LFLetNoEscape -> False 734 LFThunk _ _no_fvs upd _ _ -> upd -- See Note [Black-holing non-updatable thunks] 735 _other -> panic "blackHoleOnEntry" 736 737{- Note [Black-holing non-updatable thunks] 738~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 739We must not black-hole non-updatable (single-entry) thunks otherwise 740we run into issues like #10414. Specifically: 741 742 * There is no reason to black-hole a non-updatable thunk: it should 743 not be competed for by multiple threads 744 745 * It could, conceivably, cause a space leak if we don't black-hole 746 it, if there was a live but never-followed pointer pointing to it. 747 Let's hope that doesn't happen. 748 749 * It is dangerous to black-hole a non-updatable thunk because 750 - is not updated (of course) 751 - hence, if it is black-holed and another thread tries to evaluate 752 it, that thread will block forever 753 This actually happened in #10414. So we do not black-hole 754 non-updatable thunks. 755 756 * How could two threads evaluate the same non-updatable (single-entry) 757 thunk? See Reid Barton's example below. 758 759 * Only eager blackholing could possibly black-hole a non-updatable 760 thunk, because lazy black-holing only affects thunks with an 761 update frame on the stack. 762 763Here is and example due to Reid Barton (#10414): 764 x = \u [] concat [[1], []] 765with the following definitions, 766 767 concat x = case x of 768 [] -> [] 769 (:) x xs -> (++) x (concat xs) 770 771 (++) xs ys = case xs of 772 [] -> ys 773 (:) x rest -> (:) x ((++) rest ys) 774 775Where we use the syntax @\u []@ to denote an updatable thunk and @\s []@ to 776denote a single-entry (i.e. non-updatable) thunk. After a thread evaluates @x@ 777to WHNF and calls @(++)@ the heap will contain the following thunks, 778 779 x = 1 : y 780 y = \u [] (++) [] z 781 z = \s [] concat [] 782 783Now that the stage is set, consider the follow evaluations by two racing threads 784A and B, 785 786 1. Both threads enter @y@ before either is able to replace it with an 787 indirection 788 789 2. Thread A does the case analysis in @(++)@ and consequently enters @z@, 790 replacing it with a black-hole 791 792 3. At some later point thread B does the same case analysis and also attempts 793 to enter @z@. However, it finds that it has been replaced with a black-hole 794 so it blocks. 795 796 4. Thread A eventually finishes evaluating @z@ (to @[]@) and updates @y@ 797 accordingly. It does *not* update @z@, however, as it is single-entry. This 798 leaves Thread B blocked forever on a black-hole which will never be 799 updated. 800 801To avoid this sort of condition we never black-hole non-updatable thunks. 802-} 803 804isStaticClosure :: ClosureInfo -> Bool 805isStaticClosure cl_info = isStaticRep (closureSMRep cl_info) 806 807closureUpdReqd :: ClosureInfo -> Bool 808closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info 809 810lfUpdatable :: LambdaFormInfo -> Bool 811lfUpdatable (LFThunk _ _ upd _ _) = upd 812lfUpdatable _ = False 813 814closureSingleEntry :: ClosureInfo -> Bool 815closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd 816closureSingleEntry (ClosureInfo { closureLFInfo = LFReEntrant _ OneShotLam _ _ _}) = True 817closureSingleEntry _ = False 818 819closureReEntrant :: ClosureInfo -> Bool 820closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant {} }) = True 821closureReEntrant _ = False 822 823closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr) 824closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info 825 826lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr) 827lfFunInfo (LFReEntrant _ _ arity _ arg_desc) = Just (arity, arg_desc) 828lfFunInfo _ = Nothing 829 830funTag :: DynFlags -> ClosureInfo -> DynTag 831funTag dflags (ClosureInfo { closureLFInfo = lf_info }) 832 = lfDynTag dflags lf_info 833 834isToplevClosure :: ClosureInfo -> Bool 835isToplevClosure (ClosureInfo { closureLFInfo = lf_info }) 836 = case lf_info of 837 LFReEntrant TopLevel _ _ _ _ -> True 838 LFThunk TopLevel _ _ _ _ -> True 839 _other -> False 840 841-------------------------------------- 842-- Label generation 843-------------------------------------- 844 845staticClosureLabel :: ClosureInfo -> CLabel 846staticClosureLabel = toClosureLbl . closureInfoLabel 847 848closureSlowEntryLabel :: ClosureInfo -> CLabel 849closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel 850 851closureLocalEntryLabel :: DynFlags -> ClosureInfo -> CLabel 852closureLocalEntryLabel dflags 853 | tablesNextToCode dflags = toInfoLbl . closureInfoLabel 854 | otherwise = toEntryLbl . closureInfoLabel 855 856mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel 857mkClosureInfoTableLabel id lf_info 858 = case lf_info of 859 LFThunk _ _ upd_flag (SelectorThunk offset) _ 860 -> mkSelectorInfoLabel upd_flag offset 861 862 LFThunk _ _ upd_flag (ApThunk arity) _ 863 -> mkApInfoTableLabel upd_flag arity 864 865 LFThunk{} -> std_mk_lbl name cafs 866 LFReEntrant{} -> std_mk_lbl name cafs 867 _other -> panic "closureInfoTableLabel" 868 869 where 870 name = idName id 871 872 std_mk_lbl | is_local = mkLocalInfoTableLabel 873 | otherwise = mkInfoTableLabel 874 875 cafs = idCafInfo id 876 is_local = isDataConWorkId id 877 -- Make the _info pointer for the implicit datacon worker 878 -- binding local. The reason we can do this is that importing 879 -- code always either uses the _closure or _con_info. By the 880 -- invariants in CorePrep anything else gets eta expanded. 881 882 883thunkEntryLabel :: DynFlags -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel 884-- thunkEntryLabel is a local help function, not exported. It's used from 885-- getCallMethod. 886thunkEntryLabel dflags _thunk_id _ (ApThunk arity) upd_flag 887 = enterApLabel dflags upd_flag arity 888thunkEntryLabel dflags _thunk_id _ (SelectorThunk offset) upd_flag 889 = enterSelectorLabel dflags upd_flag offset 890thunkEntryLabel dflags thunk_id c _ _ 891 = enterIdLabel dflags thunk_id c 892 893enterApLabel :: DynFlags -> Bool -> Arity -> CLabel 894enterApLabel dflags is_updatable arity 895 | tablesNextToCode dflags = mkApInfoTableLabel is_updatable arity 896 | otherwise = mkApEntryLabel is_updatable arity 897 898enterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel 899enterSelectorLabel dflags upd_flag offset 900 | tablesNextToCode dflags = mkSelectorInfoLabel upd_flag offset 901 | otherwise = mkSelectorEntryLabel upd_flag offset 902 903enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel 904enterIdLabel dflags id c 905 | tablesNextToCode dflags = mkInfoTableLabel id c 906 | otherwise = mkEntryLabel id c 907 908 909-------------------------------------- 910-- Profiling 911-------------------------------------- 912 913-- Profiling requires two pieces of information to be determined for 914-- each closure's info table --- description and type. 915 916-- The description is stored directly in the @CClosureInfoTable@ when the 917-- info table is built. 918 919-- The type is determined from the type information stored with the @Id@ 920-- in the closure info using @closureTypeDescr@. 921 922mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo 923mkProfilingInfo dflags id val_descr 924 | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo 925 | otherwise = ProfilingInfo ty_descr_w8 (BS8.pack val_descr) 926 where 927 ty_descr_w8 = BS8.pack (getTyDescription (idType id)) 928 929getTyDescription :: Type -> String 930getTyDescription ty 931 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) -> 932 case tau_ty of 933 TyVarTy _ -> "*" 934 AppTy fun _ -> getTyDescription fun 935 TyConApp tycon _ -> getOccString tycon 936 FunTy {} -> '-' : fun_result tau_ty 937 ForAllTy _ ty -> getTyDescription ty 938 LitTy n -> getTyLitDescription n 939 CastTy ty _ -> getTyDescription ty 940 CoercionTy co -> pprPanic "getTyDescription" (ppr co) 941 } 942 where 943 fun_result (FunTy { ft_res = res }) = '>' : fun_result res 944 fun_result other = getTyDescription other 945 946getTyLitDescription :: TyLit -> String 947getTyLitDescription l = 948 case l of 949 NumTyLit n -> show n 950 StrTyLit n -> show n 951 952-------------------------------------- 953-- CmmInfoTable-related things 954-------------------------------------- 955 956mkDataConInfoTable :: DynFlags -> DataCon -> Bool -> Int -> Int -> CmmInfoTable 957mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds 958 = CmmInfoTable { cit_lbl = info_lbl 959 , cit_rep = sm_rep 960 , cit_prof = prof 961 , cit_srt = Nothing 962 , cit_clo = Nothing } 963 where 964 name = dataConName data_con 965 info_lbl = mkConInfoTableLabel name NoCafRefs 966 sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type 967 cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con) 968 -- We keep the *zero-indexed* tag in the srt_len field 969 -- of the info table of a data constructor. 970 971 prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo 972 | otherwise = ProfilingInfo ty_descr val_descr 973 974 ty_descr = BS8.pack $ occNameString $ getOccName $ dataConTyCon data_con 975 val_descr = BS8.pack $ occNameString $ getOccName data_con 976 977-- We need a black-hole closure info to pass to @allocDynClosure@ when we 978-- want to allocate the black hole on entry to a CAF. 979 980cafBlackHoleInfoTable :: CmmInfoTable 981cafBlackHoleInfoTable 982 = CmmInfoTable { cit_lbl = mkCAFBlackHoleInfoTableLabel 983 , cit_rep = blackHoleRep 984 , cit_prof = NoProfilingInfo 985 , cit_srt = Nothing 986 , cit_clo = Nothing } 987 988indStaticInfoTable :: CmmInfoTable 989indStaticInfoTable 990 = CmmInfoTable { cit_lbl = mkIndStaticInfoLabel 991 , cit_rep = indStaticRep 992 , cit_prof = NoProfilingInfo 993 , cit_srt = Nothing 994 , cit_clo = Nothing } 995 996staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool 997-- A static closure needs a link field to aid the GC when traversing 998-- the static closure graph. But it only needs such a field if either 999-- a) it has an SRT 1000-- b) it's a constructor with one or more pointer fields 1001-- In case (b), the constructor's fields themselves play the role 1002-- of the SRT. 1003staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep } 1004 | isConRep smrep = not (isStaticNoCafCon smrep) 1005 | otherwise = has_srt 1006