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