ghc/compiler/codeGen/ClosureInfo.lhs

   1 %
   2 % (c) The Univserity of Glasgow 1992-2004
   3 %
   4
   5         Data structures which describe closures, and
   6         operations over those data structures
   7
   8                 Nothing monadic in here
   9
  10 Much of the rationale for these things is in the ``details'' part of
  11 the STG paper.
  12
  13 \begin{code}
  14 module ClosureInfo (
  15         ClosureInfo, LambdaFormInfo, SMRep,     -- all abstract
  16         StandardFormInfo,
  17
  18         ArgDescr(..), Liveness(..),
  19         C_SRT(..), needsSRT,
  20
  21         mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
  22         mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
  23
  24         mkClosureInfo, mkConInfo,
  25
  26         closureSize, closureNonHdrSize,
  27         closureGoodStuffSize, closurePtrsSize,
  28         slopSize,
  29
  30         closureName, infoTableLabelFromCI,
  31         closureLabelFromCI, closureSRT,
  32         closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd,
  33         closureNeedsUpdSpace, closureIsThunk,
  34         closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
  35         closureFunInfo, isStandardFormThunk, isKnownFun,
  36
  37         enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
  38
  39         nodeMustPointToIt,
  40         CallMethod(..), getCallMethod,
  41
  42         blackHoleOnEntry,
  43
  44         staticClosureRequired,
  45         getClosureType,
  46
  47         isToplevClosure,
  48         closureValDescr, closureTypeDescr,      -- profiling
  49
  50         isStaticClosure,
  51         cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
  52
  53         staticClosureNeedsLink,
  54     ) where
  55
  56 #include "../includes/MachDeps.h"
  57 #include "HsVersions.h"
  58
  59 import StgSyn
  60 import SMRep            -- all of it
  61
  62 import CLabel
  63
  64 import Constants        ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
  65 import Packages         ( isDllName, HomeModules )
  66 import StaticFlags      ( opt_SccProfilingOn, opt_OmitBlackHoling,
  67                           opt_Parallel, opt_DoTickyProfiling,
  68                           opt_SMP )
  69 import Id               ( Id, idType, idArity, idName )
  70 import DataCon          ( DataCon, dataConTyCon, isNullaryRepDataCon, dataConName )
  71 import Name             ( Name, nameUnique, getOccName, getOccString )
  72 import OccName          ( occNameString )
  73 import Type             ( isUnLiftedType, Type, repType, splitTyConApp_maybe )
  74 import TcType           ( tcSplitSigmaTy )
  75 import TyCon            ( isFunTyCon, isAbstractTyCon )
  76 import BasicTypes       ( TopLevelFlag(..), isNotTopLevel, isTopLevel, ipNameName )
  77 import FastString
  78 import Outputable
  79 import Constants
  80
  81 import TypeRep  -- TEMP
  82 \end{code}
  83
  84
  85 %************************************************************************
  86 %*                                                                      *
  87 \subsection[ClosureInfo-datatypes]{Data types for closure information}
  88 %*                                                                      *
  89 %************************************************************************
  90
  91 Information about a closure, from the code generator's point of view.
  92
  93 A ClosureInfo decribes the info pointer of a closure.  It has
  94 enough information
  95   a) to construct the info table itself
  96   b) to allocate a closure containing that info pointer (i.e.
  97         it knows the info table label)
  98
  99 We make a ClosureInfo for
 100         - each let binding (both top level and not)
 101         - each data constructor (for its shared static and
 102                 dynamic info tables)
 103
 104 \begin{code}
 105 data ClosureInfo
 106   = ClosureInfo {
 107         closureName   :: !Name,           -- The thing bound to this closure
 108         closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
 109         closureSMRep  :: !SMRep,          -- representation used by storage mgr
 110         closureSRT    :: !C_SRT,          -- What SRT applies to this closure
 111         closureType   :: !Type,           -- Type of closure (ToDo: remove)
 112         closureDescr  :: !String          -- closure description (for profiling)
 113     }
 114
 115   -- Constructor closures don't have a unique info table label (they use
 116   -- the constructor's info table), and they don't have an SRT.
 117   | ConInfo {
 118         closureCon       :: !DataCon,
 119         closureSMRep     :: !SMRep,
 120         closureDllCon    :: !Bool       -- is in a separate DLL
 121     }
 122
 123 -- C_SRT is what StgSyn.SRT gets translated to...
 124 -- we add a label for the table, and expect only the 'offset/length' form
 125
 126 data C_SRT = NoC_SRT
 127            | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
 128
 129 needsSRT :: C_SRT -> Bool
 130 needsSRT NoC_SRT       = False
 131 needsSRT (C_SRT _ _ _) = True
 132 \end{code}
 133
 134 %************************************************************************
 135 %*                                                                      *
 136 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
 137 %*                                                                      *
 138 %************************************************************************
 139
 140 Information about an identifier, from the code generator's point of
 141 view.  Every identifier is bound to a LambdaFormInfo in the
 142 environment, which gives the code generator enough info to be able to
 143 tail call or return that identifier.
 144
 145 Note that a closure is usually bound to an identifier, so a
 146 ClosureInfo contains a LambdaFormInfo.
 147
 148 \begin{code}
 149 data LambdaFormInfo
 150   = LFReEntrant         -- Reentrant closure (a function)
 151         TopLevelFlag    -- True if top level
 152         !Int            -- Arity. Invariant: always > 0
 153         !Bool           -- True <=> no fvs
 154         ArgDescr        -- Argument descriptor (should reall be in ClosureInfo)
 155
 156   | LFCon               -- A saturated constructor application
 157         DataCon         -- The constructor
 158
 159   | LFThunk             -- Thunk (zero arity)
 160         TopLevelFlag
 161         !Bool           -- True <=> no free vars
 162         !Bool           -- True <=> updatable (i.e., *not* single-entry)
 163         StandardFormInfo
 164         !Bool           -- True <=> *might* be a function type
 165
 166   | LFUnknown           -- Used for function arguments and imported things.
 167                         --  We know nothing about  this closure.  Treat like
 168                         -- updatable "LFThunk"...
 169                         -- Imported things which we do know something about use
 170                         -- one of the other LF constructors (eg LFReEntrant for
 171                         -- known functions)
 172         !Bool           -- True <=> *might* be a function type
 173
 174   | LFLetNoEscape       -- See LetNoEscape module for precise description of
 175                         -- these "lets".
 176         !Int            -- arity;
 177
 178   | LFBlackHole         -- Used for the closures allocated to hold the result
 179                         -- of a CAF.  We want the target of the update frame to
 180                         -- be in the heap, so we make a black hole to hold it.
 181         CLabel          -- Flavour (info label, eg CAF_BLACKHOLE_info).
 182
 183
 184 -------------------------
 185 -- An ArgDsecr describes the argument pattern of a function
 186
 187 data ArgDescr
 188   = ArgSpec             -- Fits one of the standard patterns
 189         !Int            -- RTS type identifier ARG_P, ARG_N, ...
 190
 191   | ArgGen              -- General case
 192         Liveness        -- Details about the arguments
 193
 194
 195 -------------------------
 196 -- We represent liveness bitmaps as a Bitmap (whose internal
 197 -- representation really is a bitmap).  These are pinned onto case return
 198 -- vectors to indicate the state of the stack for the garbage collector.
 199 --
 200 -- In the compiled program, liveness bitmaps that fit inside a single
 201 -- word (StgWord) are stored as a single word, while larger bitmaps are
 202 -- stored as a pointer to an array of words.
 203
 204 data Liveness
 205   = SmallLiveness       -- Liveness info that fits in one word
 206         StgWord         -- Here's the bitmap
 207
 208   | BigLiveness         -- Liveness info witha a multi-word bitmap
 209         CLabel          -- Label for the bitmap
 210
 211
 212 -------------------------
 213 -- StandardFormInfo tells whether this thunk has one of
 214 -- a small number of standard forms
 215
 216 data StandardFormInfo
 217   = NonStandardThunk
 218         -- Not of of the standard forms
 219
 220   | SelectorThunk
 221         -- A SelectorThunk is of form
 222         --      case x of
 223         --             con a1,..,an -> ak
 224         -- and the constructor is from a single-constr type.
 225        WordOff                  -- 0-origin offset of ak within the "goods" of
 226                         -- constructor (Recall that the a1,...,an may be laid
 227                         -- out in the heap in a non-obvious order.)
 228
 229   | ApThunk
 230         -- An ApThunk is of form
 231         --      x1 ... xn
 232         -- The code for the thunk just pushes x2..xn on the stack and enters x1.
 233         -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
 234         -- in the RTS to save space.
 235         Int             -- Arity, n
 236 \end{code}
 237
 238 %************************************************************************
 239 %*                                                                      *
 240 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
 241 %*                                                                      *
 242 %************************************************************************
 243
 244 \begin{code}
 245 mkLFReEntrant :: TopLevelFlag   -- True of top level
 246               -> [Id]           -- Free vars
 247               -> [Id]           -- Args
 248               -> ArgDescr       -- Argument descriptor
 249               -> LambdaFormInfo
 250
 251 mkLFReEntrant top fvs args arg_descr
 252   = LFReEntrant top (length args) (null fvs) arg_descr
 253
 254 mkLFThunk thunk_ty top fvs upd_flag
 255   = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) )
 256     LFThunk top (null fvs)
 257             (isUpdatable upd_flag)
 258             NonStandardThunk
 259             (might_be_a_function thunk_ty)
 260
 261 might_be_a_function :: Type -> Bool
 262 might_be_a_function ty
 263   | Just (tc,_) <- splitTyConApp_maybe (repType ty),
 264     not (isFunTyCon tc)  && not (isAbstractTyCon tc) = False
 265         -- don't forget to check for abstract types, which might
 266         -- be functions too.
 267   | otherwise = True
 268 \end{code}
 269
 270 @mkConLFInfo@ is similar, for constructors.
 271
 272 \begin{code}
 273 mkConLFInfo :: DataCon -> LambdaFormInfo
 274 mkConLFInfo con = LFCon con
 275
 276 mkSelectorLFInfo id offset updatable
 277   = LFThunk NotTopLevel False updatable (SelectorThunk offset)
 278         (might_be_a_function (idType id))
 279
 280 mkApLFInfo id upd_flag arity
 281   = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
 282         (might_be_a_function (idType id))
 283 \end{code}
 284
 285 Miscellaneous LF-infos.
 286
 287 \begin{code}
 288 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
 289
 290 mkLFLetNoEscape = LFLetNoEscape
 291
 292 mkLFImported :: Id -> LambdaFormInfo
 293 mkLFImported id
 294   = case idArity id of
 295       n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr")  -- n > 0
 296       other -> mkLFArgument id -- Not sure of exact arity
 297 \end{code}
 298
 299 \begin{code}
 300 isLFThunk :: LambdaFormInfo -> Bool
 301 isLFThunk (LFThunk _ _ _ _ _)  = True
 302 isLFThunk (LFBlackHole _)      = True
 303         -- return True for a blackhole: this function is used to determine
 304         -- whether to use the thunk header in SMP mode, and a blackhole
 305         -- must have one.
 306 isLFThunk _ = False
 307 \end{code}
 308
 309 %************************************************************************
 310 %*                                                                      *
 311         Building ClosureInfos
 312 %*                                                                      *
 313 %************************************************************************
 314
 315 \begin{code}
 316 mkClosureInfo :: Bool           -- Is static
 317               -> Id
 318               -> LambdaFormInfo
 319               -> Int -> Int     -- Total and pointer words
 320               -> C_SRT
 321               -> String         -- String descriptor
 322               -> ClosureInfo
 323 mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
 324   = ClosureInfo { closureName = name,
 325                   closureLFInfo = lf_info,
 326                   closureSMRep = sm_rep,
 327                   closureSRT = srt_info,
 328                   closureType = idType id,
 329                   closureDescr = descr }
 330   where
 331     name   = idName id
 332     sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
 333
 334 mkConInfo :: HomeModules
 335           -> Bool       -- Is static
 336           -> DataCon
 337           -> Int -> Int -- Total and pointer words
 338           -> ClosureInfo
 339 mkConInfo hmods is_static data_con tot_wds ptr_wds
 340    = ConInfo {  closureSMRep = sm_rep,
 341                 closureCon = data_con,
 342                 closureDllCon = isDllName hmods (dataConName data_con) }
 343   where
 344     sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
 345 \end{code}
 346
 347 %************************************************************************
 348 %*                                                                      *
 349 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
 350 %*                                                                      *
 351 %************************************************************************
 352
 353 \begin{code}
 354 closureSize :: ClosureInfo -> WordOff
 355 closureSize cl_info = hdr_size + closureNonHdrSize cl_info
 356   where hdr_size  | closureIsThunk cl_info = thunkHdrSize
 357                   | otherwise              = fixedHdrSize
 358         -- All thunks use thunkHdrSize, even if they are non-updatable.
 359         -- this is because we don't have separate closure types for
 360         -- updatable vs. non-updatable thunks, so the GC can't tell the
 361         -- difference.  If we ever have significant numbers of non-
 362         -- updatable thunks, it might be worth fixing this.
 363
 364 closureNonHdrSize :: ClosureInfo -> WordOff
 365 closureNonHdrSize cl_info
 366   = tot_wds + computeSlopSize tot_wds cl_info
 367   where
 368     tot_wds = closureGoodStuffSize cl_info
 369
 370 closureGoodStuffSize :: ClosureInfo -> WordOff
 371 closureGoodStuffSize cl_info
 372   = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
 373     in  ptrs + nonptrs
 374
 375 closurePtrsSize :: ClosureInfo -> WordOff
 376 closurePtrsSize cl_info
 377   = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
 378     in  ptrs
 379
 380 -- not exported:
 381 sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
 382 sizes_from_SMRep (GenericRep _ ptrs nonptrs _)   = (ptrs, nonptrs)
 383 sizes_from_SMRep BlackHoleRep                    = (0, 0)
 384 \end{code}
 385
 386 Computing slop size.  WARNING: this looks dodgy --- it has deep
 387 knowledge of what the storage manager does with the various
 388 representations...
 389
 390 Slop Requirements:
 391
 392  - Updatable closures must be mIN_UPD_SIZE.
 393
 394  - Heap-resident Closures must be mIN_SIZE_NonUpdHeapObject
 395    (to make room for an StgEvacuated during GC).
 396
 397 In SMP mode, we don't play the mIN_UPD_SIZE game.  Instead, every
 398 thunk gets an extra padding word in the header, which takes the
 399 the updated value.
 400
 401 \begin{code}
 402 slopSize cl_info = computeSlopSize payload_size cl_info
 403   where payload_size = closureGoodStuffSize cl_info
 404
 405 computeSlopSize :: WordOff -> ClosureInfo -> WordOff
 406 computeSlopSize payload_size cl_info
 407   = max 0 (minPayloadSize smrep updatable - payload_size)
 408   where
 409         smrep        = closureSMRep cl_info
 410         updatable    = closureNeedsUpdSpace cl_info
 411
 412 -- we leave space for an update if either (a) the closure is updatable
 413 -- or (b) it is a static thunk.  This is because a static thunk needs
 414 -- a static link field in a predictable place (after the slop), regardless
 415 -- of whether it is updatable or not.
 416 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
 417                                         LFThunk TopLevel _ _ _ _ }) = True
 418 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
 419
 420 minPayloadSize :: SMRep -> Bool -> WordOff
 421 minPayloadSize smrep updatable
 422   = case smrep of
 423         BlackHoleRep                            -> min_upd_size
 424         GenericRep _ _ _ _      | updatable     -> min_upd_size
 425         GenericRep True _ _ _                   -> 0 -- static
 426         GenericRep False _ _ _                  -> mIN_SIZE_NonUpdHeapObject
 427           --       ^^^^^___ dynamic
 428   where
 429    min_upd_size
 430         | opt_SMP   = ASSERT(mIN_SIZE_NonUpdHeapObject <=
 431                                 sIZEOF_StgSMPThunkHeader)
 432                       0         -- check that we already have enough
 433                                 -- room for mIN_SIZE_NonUpdHeapObject,
 434                                 -- due to the extra header word in SMP
 435         | otherwise = mIN_UPD_SIZE
 436 \end{code}
 437
 438 %************************************************************************
 439 %*                                                                      *
 440 \subsection[SMreps]{Choosing SM reps}
 441 %*                                                                      *
 442 %************************************************************************
 443
 444 \begin{code}
 445 chooseSMRep
 446         :: Bool                 -- True <=> static closure
 447         -> LambdaFormInfo
 448         -> WordOff -> WordOff   -- Tot wds, ptr wds
 449         -> SMRep
 450
 451 chooseSMRep is_static lf_info tot_wds ptr_wds
 452   = let
 453          nonptr_wds   = tot_wds - ptr_wds
 454          closure_type = getClosureType is_static ptr_wds lf_info
 455     in
 456     GenericRep is_static ptr_wds nonptr_wds closure_type
 457
 458 -- We *do* get non-updatable top-level thunks sometimes.  eg. f = g
 459 -- gets compiled to a jump to g (if g has non-zero arity), instead of
 460 -- messing around with update frames and PAPs.  We set the closure type
 461 -- to FUN_STATIC in this case.
 462
 463 getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
 464 getClosureType is_static ptr_wds lf_info
 465   = case lf_info of
 466         LFCon con | is_static && ptr_wds == 0   -> ConstrNoCaf
 467                   | otherwise                   -> Constr
 468         LFReEntrant _ _ _ _                     -> Fun
 469         LFThunk _ _ _ (SelectorThunk _) _       -> ThunkSelector
 470         LFThunk _ _ _ _ _                       -> Thunk
 471         _ -> panic "getClosureType"
 472 \end{code}
 473
 474 %************************************************************************
 475 %*                                                                      *
 476 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
 477 %*                                                                      *
 478 %************************************************************************
 479
 480 Be sure to see the stg-details notes about these...
 481
 482 \begin{code}
 483 nodeMustPointToIt :: LambdaFormInfo -> Bool
 484 nodeMustPointToIt (LFReEntrant top _ no_fvs _)
 485   = not no_fvs ||   -- Certainly if it has fvs we need to point to it
 486     isNotTopLevel top
 487                     -- If it is not top level we will point to it
 488                     --   We can have a \r closure with no_fvs which
 489                     --   is not top level as special case cgRhsClosure
 490                     --   has been dissabled in favour of let floating
 491
 492                 -- For lex_profiling we also access the cost centre for a
 493                 -- non-inherited function i.e. not top level
 494                 -- the  not top  case above ensures this is ok.
 495
 496 nodeMustPointToIt (LFCon _) = True
 497
 498         -- Strictly speaking, the above two don't need Node to point
 499         -- to it if the arity = 0.  But this is a *really* unlikely
 500         -- situation.  If we know it's nil (say) and we are entering
 501         -- it. Eg: let x = [] in x then we will certainly have inlined
 502         -- x, since nil is a simple atom.  So we gain little by not
 503         -- having Node point to known zero-arity things.  On the other
 504         -- hand, we do lose something; Patrick's code for figuring out
 505         -- when something has been updated but not entered relies on
 506         -- having Node point to the result of an update.  SLPJ
 507         -- 27/11/92.
 508
 509 nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
 510   = updatable || not no_fvs || opt_SccProfilingOn
 511           -- For the non-updatable (single-entry case):
 512           --
 513           -- True if has fvs (in which case we need access to them, and we
 514           --                should black-hole it)
 515           -- or profiling (in which case we need to recover the cost centre
 516           --             from inside it)
 517
 518 nodeMustPointToIt (LFThunk _ no_fvs updatable some_standard_form_thunk _)
 519   = True  -- Node must point to any standard-form thunk
 520
 521 nodeMustPointToIt (LFUnknown _)     = True
 522 nodeMustPointToIt (LFBlackHole _)   = True    -- BH entry may require Node to point
 523 nodeMustPointToIt (LFLetNoEscape _) = False
 524 \end{code}
 525
 526 The entry conventions depend on the type of closure being entered,
 527 whether or not it has free variables, and whether we're running
 528 sequentially or in parallel.
 529
 530 \begin{tabular}{lllll}
 531 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
 532 Unknown                         & no & yes & stack      & node \\
 533 Known fun ($\ge$ 1 arg), no fvs         & no & no  & registers  & fast entry (enough args) \\
 534 \ & \ & \ & \                                           & slow entry (otherwise) \\
 535 Known fun ($\ge$ 1 arg), fvs    & no & yes & registers  & fast entry (enough args) \\
 536 0 arg, no fvs @\r,\s@           & no & no  & n/a        & direct entry \\
 537 0 arg, no fvs @\u@              & no & yes & n/a        & node \\
 538 0 arg, fvs @\r,\s@              & no & yes & n/a        & direct entry \\
 539 0 arg, fvs @\u@                 & no & yes & n/a        & node \\
 540
 541 Unknown                         & yes & yes & stack     & node \\
 542 Known fun ($\ge$ 1 arg), no fvs         & yes & no  & registers & fast entry (enough args) \\
 543 \ & \ & \ & \                                           & slow entry (otherwise) \\
 544 Known fun ($\ge$ 1 arg), fvs    & yes & yes & registers & node \\
 545 0 arg, no fvs @\r,\s@           & yes & no  & n/a       & direct entry \\
 546 0 arg, no fvs @\u@              & yes & yes & n/a       & node \\
 547 0 arg, fvs @\r,\s@              & yes & yes & n/a       & node \\
 548 0 arg, fvs @\u@                 & yes & yes & n/a       & node\\
 549 \end{tabular}
 550
 551 When black-holing, single-entry closures could also be entered via node
 552 (rather than directly) to catch double-entry.
 553
 554 \begin{code}
 555 data CallMethod
 556   = EnterIt                             -- no args, not a function
 557
 558   | JumpToIt CLabel                     -- no args, not a function, but we
 559                                         -- know what its entry code is
 560
 561   | ReturnIt                            -- it's a function, but we have
 562                                         -- zero args to apply to it, so just
 563                                         -- return it.
 564
 565   | ReturnCon DataCon                   -- It's a data constructor, just return it
 566
 567   | SlowCall                            -- Unknown fun, or known fun with
 568                                         -- too few args.
 569
 570   | DirectEntry                         -- Jump directly, with args in regs
 571         CLabel                          --   The code label
 572         Int                             --   Its arity
 573
 574 getCallMethod :: HomeModules
 575               -> Name           -- Function being applied
 576               -> LambdaFormInfo -- Its info
 577               -> Int            -- Number of available arguments
 578               -> CallMethod
 579
 580 getCallMethod hmods name lf_info n_args
 581   | nodeMustPointToIt lf_info && opt_Parallel
 582   =     -- If we're parallel, then we must always enter via node.
 583         -- The reason is that the closure may have been
 584         -- fetched since we allocated it.
 585     EnterIt
 586
 587 getCallMethod hmods name (LFReEntrant _ arity _ _) n_args
 588   | n_args == 0    = ASSERT( arity /= 0 )
 589                      ReturnIt   -- No args at all
 590   | n_args < arity = SlowCall   -- Not enough args
 591   | otherwise      = DirectEntry (enterIdLabel hmods name) arity
 592
 593 getCallMethod hmods name (LFCon con) n_args
 594   = ASSERT( n_args == 0 )
 595     ReturnCon con
 596
 597 getCallMethod hmods name (LFThunk _ _ updatable std_form_info is_fun) n_args
 598   | is_fun      -- Must always "call" a function-typed
 599   = SlowCall    -- thing, cannot just enter it [in eval/apply, the entry code
 600                 -- is the fast-entry code]
 601
 602   | updatable || opt_DoTickyProfiling  -- to catch double entry
 603               || opt_SMP    -- Always enter via node on SMP, since the
 604                             -- thunk might have been blackholed in the
 605                             -- meantime.
 606   = ASSERT( n_args == 0 ) EnterIt
 607
 608   | otherwise   -- Jump direct to code for single-entry thunks
 609   = ASSERT( n_args == 0 )
 610     JumpToIt (thunkEntryLabel hmods name std_form_info updatable)
 611
 612 getCallMethod hmods name (LFUnknown True) n_args
 613   = SlowCall -- might be a function
 614
 615 getCallMethod hmods name (LFUnknown False) n_args
 616   = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args )
 617     EnterIt -- Not a function
 618
 619 getCallMethod hmods name (LFBlackHole _) n_args
 620   = SlowCall    -- Presumably the black hole has by now
 621                 -- been updated, but we don't know with
 622                 -- what, so we slow call it
 623
 624 getCallMethod hmods name (LFLetNoEscape 0) n_args
 625   = JumpToIt (enterReturnPtLabel (nameUnique name))
 626
 627 getCallMethod hmods name (LFLetNoEscape arity) n_args
 628   | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
 629   | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
 630
 631 blackHoleOnEntry :: ClosureInfo -> Bool
 632 -- Static closures are never themselves black-holed.
 633 -- Updatable ones will be overwritten with a CAFList cell, which points to a
 634 -- black hole;
 635 -- Single-entry ones have no fvs to plug, and we trust they don't form part
 636 -- of a loop.
 637
 638 blackHoleOnEntry ConInfo{} = False
 639 blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
 640   | isStaticRep rep
 641   = False       -- Never black-hole a static closure
 642
 643   | otherwise
 644   = case lf_info of
 645         LFReEntrant _ _ _ _       -> False
 646         LFLetNoEscape _           -> False
 647         LFThunk _ no_fvs updatable _ _
 648           -> if updatable
 649              then not opt_OmitBlackHoling
 650              else opt_DoTickyProfiling || not no_fvs
 651                   -- the former to catch double entry,
 652                   -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
 653
 654         other -> panic "blackHoleOnEntry"       -- Should never happen
 655
 656 isStandardFormThunk :: LambdaFormInfo -> Bool
 657 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
 658 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _)       = True
 659 isStandardFormThunk other_lf_info                       = False
 660
 661 isKnownFun :: LambdaFormInfo -> Bool
 662 isKnownFun (LFReEntrant _ _ _ _) = True
 663 isKnownFun (LFLetNoEscape _) = True
 664 isKnownFun _ = False
 665 \end{code}
 666
 667 -----------------------------------------------------------------------------
 668 SRT-related stuff
 669
 670 \begin{code}
 671 staticClosureNeedsLink :: ClosureInfo -> Bool
 672 -- A static closure needs a link field to aid the GC when traversing
 673 -- the static closure graph.  But it only needs such a field if either
 674 --      a) it has an SRT
 675 --      b) it's a constructor with one or more pointer fields
 676 -- In case (b), the constructor's fields themselves play the role
 677 -- of the SRT.
 678 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
 679   = needsSRT srt
 680 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
 681   = not (isNullaryRepDataCon con) && not_nocaf_constr
 682   where
 683     not_nocaf_constr =
 684         case sm_rep of
 685            GenericRep _ _ _ ConstrNoCaf -> False
 686            _other                       -> True
 687 \end{code}
 688
 689 Avoiding generating entries and info tables
 690 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 691 At present, for every function we generate all of the following,
 692 just in case.  But they aren't always all needed, as noted below:
 693
 694 [NB1: all of this applies only to *functions*.  Thunks always
 695 have closure, info table, and entry code.]
 696
 697 [NB2: All are needed if the function is *exported*, just to play safe.]
 698
 699
 700 * Fast-entry code  ALWAYS NEEDED
 701
 702 * Slow-entry code
 703         Needed iff (a) we have any un-saturated calls to the function
 704         OR         (b) the function is passed as an arg
 705         OR         (c) we're in the parallel world and the function has free vars
 706                         [Reason: in parallel world, we always enter functions
 707                         with free vars via the closure.]
 708
 709 * The function closure
 710         Needed iff (a) we have any un-saturated calls to the function
 711         OR         (b) the function is passed as an arg
 712         OR         (c) if the function has free vars (ie not top level)
 713
 714   Why case (a) here?  Because if the arg-satis check fails,
 715   UpdatePAP stuffs a pointer to the function closure in the PAP.
 716   [Could be changed; UpdatePAP could stuff in a code ptr instead,
 717    but doesn't seem worth it.]
 718
 719   [NB: these conditions imply that we might need the closure
 720   without the slow-entry code.  Here's how.
 721
 722         f x y = let g w = ...x..y..w...
 723                 in
 724                 ...(g t)...
 725
 726   Here we need a closure for g which contains x and y,
 727   but since the calls are all saturated we just jump to the
 728   fast entry point for g, with R1 pointing to the closure for g.]
 729
 730
 731 * Standard info table
 732         Needed iff (a) we have any un-saturated calls to the function
 733         OR         (b) the function is passed as an arg
 734         OR         (c) the function has free vars (ie not top level)
 735
 736         NB.  In the sequential world, (c) is only required so that the function closure has
 737         an info table to point to, to keep the storage manager happy.
 738         If (c) alone is true we could fake up an info table by choosing
 739         one of a standard family of info tables, whose entry code just
 740         bombs out.
 741
 742         [NB In the parallel world (c) is needed regardless because
 743         we enter functions with free vars via the closure.]
 744
 745         If (c) is retained, then we'll sometimes generate an info table
 746         (for storage mgr purposes) without slow-entry code.  Then we need
 747         to use an error label in the info table to substitute for the absent
 748         slow entry code.
 749
 750 \begin{code}
 751 staticClosureRequired
 752         :: Name
 753         -> StgBinderInfo
 754         -> LambdaFormInfo
 755         -> Bool
 756 staticClosureRequired binder bndr_info
 757                       (LFReEntrant top_level _ _ _)     -- It's a function
 758   = ASSERT( isTopLevel top_level )
 759         -- Assumption: it's a top-level, no-free-var binding
 760         not (satCallsOnly bndr_info)
 761
 762 staticClosureRequired binder other_binder_info other_lf_info = True
 763 \end{code}
 764
 765 %************************************************************************
 766 %*                                                                      *
 767 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
 768 %*                                                                      *
 769 %************************************************************************
 770
 771 \begin{code}
 772
 773 isStaticClosure :: ClosureInfo -> Bool
 774 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
 775
 776 closureUpdReqd :: ClosureInfo -> Bool
 777 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
 778 closureUpdReqd ConInfo{} = False
 779
 780 lfUpdatable :: LambdaFormInfo -> Bool
 781 lfUpdatable (LFThunk _ _ upd _ _)  = upd
 782 lfUpdatable (LFBlackHole _)        = True
 783         -- Black-hole closures are allocated to receive the results of an
 784         -- alg case with a named default... so they need to be updated.
 785 lfUpdatable _ = False
 786
 787 closureIsThunk :: ClosureInfo -> Bool
 788 closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
 789 closureIsThunk ConInfo{} = False
 790
 791 closureSingleEntry :: ClosureInfo -> Bool
 792 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
 793 closureSingleEntry other_closure = False
 794
 795 closureReEntrant :: ClosureInfo -> Bool
 796 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
 797 closureReEntrant other_closure = False
 798
 799 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
 800 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
 801 isConstrClosure_maybe _                                   = Nothing
 802
 803 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
 804 closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc})
 805   = Just (arity, arg_desc)
 806 closureFunInfo _
 807   = Nothing
 808 \end{code}
 809
 810 \begin{code}
 811 isToplevClosure :: ClosureInfo -> Bool
 812 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
 813   = case lf_info of
 814       LFReEntrant TopLevel _ _ _ -> True
 815       LFThunk TopLevel _ _ _ _   -> True
 816       other -> False
 817 isToplevClosure _ = False
 818 \end{code}
 819
 820 Label generation.
 821
 822 \begin{code}
 823 infoTableLabelFromCI :: ClosureInfo -> CLabel
 824 infoTableLabelFromCI (ClosureInfo { closureName = name,
 825                                     closureLFInfo = lf_info,
 826                                     closureSMRep = rep })
 827   = case lf_info of
 828         LFBlackHole info -> info
 829
 830         LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
 831                 mkSelectorInfoLabel upd_flag offset
 832
 833         LFThunk _ _ upd_flag (ApThunk arity) _ ->
 834                 mkApInfoTableLabel upd_flag arity
 835
 836         LFThunk{}      -> mkLocalInfoTableLabel name
 837
 838         LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name
 839
 840         other -> panic "infoTableLabelFromCI"
 841
 842 infoTableLabelFromCI (ConInfo { closureCon = con,
 843                                 closureSMRep = rep,
 844                                 closureDllCon = dll })
 845   | isStaticRep rep = mkStaticInfoTableLabel  name dll
 846   | otherwise       = mkConInfoTableLabel     name dll
 847   where
 848     name = dataConName con
 849
 850 -- ClosureInfo for a closure (as opposed to a constructor) is always local
 851 closureLabelFromCI (ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm
 852 closureLabelFromCI _ = panic "closureLabelFromCI"
 853
 854 -- thunkEntryLabel is a local help function, not exported.  It's used from both
 855 -- entryLabelFromCI and getCallMethod.
 856
 857 thunkEntryLabel hmods thunk_id (ApThunk arity) is_updatable
 858   = enterApLabel is_updatable arity
 859 thunkEntryLabel hmods thunk_id (SelectorThunk offset) upd_flag
 860   = enterSelectorLabel upd_flag offset
 861 thunkEntryLabel hmods thunk_id _ is_updatable
 862   = enterIdLabel hmods thunk_id
 863
 864 enterApLabel is_updatable arity
 865   | tablesNextToCode = mkApInfoTableLabel is_updatable arity
 866   | otherwise        = mkApEntryLabel is_updatable arity
 867
 868 enterSelectorLabel upd_flag offset
 869   | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
 870   | otherwise        = mkSelectorEntryLabel upd_flag offset
 871
 872 enterIdLabel hmods id
 873   | tablesNextToCode = mkInfoTableLabel hmods id
 874   | otherwise        = mkEntryLabel hmods id
 875
 876 enterLocalIdLabel id
 877   | tablesNextToCode = mkLocalInfoTableLabel id
 878   | otherwise        = mkLocalEntryLabel id
 879
 880 enterReturnPtLabel name
 881   | tablesNextToCode = mkReturnInfoLabel name
 882   | otherwise        = mkReturnPtLabel name
 883 \end{code}
 884
 885
 886 We need a black-hole closure info to pass to @allocDynClosure@ when we
 887 want to allocate the black hole on entry to a CAF.  These are the only
 888 ways to build an LFBlackHole, maintaining the invariant that it really
 889 is a black hole and not something else.
 890
 891 \begin{code}
 892 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
 893                                        closureType = ty })
 894   = ClosureInfo { closureName   = nm,
 895                   closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
 896                   closureSMRep  = BlackHoleRep,
 897                   closureSRT    = NoC_SRT,
 898                   closureType   = ty,
 899                   closureDescr  = "" }
 900 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
 901
 902 seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
 903                                          closureType = ty })
 904   = ClosureInfo { closureName   = nm,
 905                   closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
 906                   closureSMRep  = BlackHoleRep,
 907                   closureSRT    = NoC_SRT,
 908                   closureType   = ty,
 909                   closureDescr  = ""  }
 910 seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
 911 \end{code}
 912
 913 %************************************************************************
 914 %*                                                                      *
 915 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
 916 %*                                                                      *
 917 %************************************************************************
 918
 919 Profiling requires two pieces of information to be determined for
 920 each closure's info table --- description and type.
 921
 922 The description is stored directly in the @CClosureInfoTable@ when the
 923 info table is built.
 924
 925 The type is determined from the type information stored with the @Id@
 926 in the closure info using @closureTypeDescr@.
 927
 928 \begin{code}
 929 closureValDescr, closureTypeDescr :: ClosureInfo -> String
 930 closureValDescr (ClosureInfo {closureDescr = descr})
 931   = descr
 932 closureValDescr (ConInfo {closureCon = con})
 933   = occNameString (getOccName con)
 934
 935 closureTypeDescr (ClosureInfo { closureType = ty })
 936   = getTyDescription ty
 937 closureTypeDescr (ConInfo { closureCon = data_con })
 938   = occNameString (getOccName (dataConTyCon data_con))
 939
 940 getTyDescription :: Type -> String
 941 getTyDescription ty
 942   = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
 943     case tau_ty of
 944       TyVarTy _              -> "*"
 945       AppTy fun _            -> getTyDescription fun
 946       FunTy _ res            -> '-' : '>' : fun_result res
 947       TyConApp tycon _       -> getOccString tycon
 948       NoteTy (FTVNote _) ty  -> getTyDescription ty
 949       PredTy sty             -> getPredTyDescription sty
 950       ForAllTy _ ty          -> getTyDescription ty
 951     }
 952   where
 953     fun_result (FunTy _ res) = '>' : fun_result res
 954     fun_result other         = getTyDescription other
 955
 956 getPredTyDescription (ClassP cl tys) = getOccString cl
 957 getPredTyDescription (IParam ip ty)  = getOccString (ipNameName ip)
 958 \end{code}
 959
 960