compiler/codeGen/ClosureInfo.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The Univserity of Glasgow 1992-2004
   4 %
   5
   6         Data structures which describe closures, and
   7         operations over those data structures
   8
   9                 Nothing monadic in here
  10
  11 Much of the rationale for these things is in the ``details'' part of
  12 the STG paper.
  13
  14 \begin{code}
  15 module ClosureInfo (
  16         ClosureInfo, LambdaFormInfo, SMRep,     -- all abstract
  17         StandardFormInfo,
  18
  19         ArgDescr(..), Liveness(..),
  20         C_SRT(..), needsSRT,
  21
  22         mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
  23         mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
  24
  25         mkClosureInfo, mkConInfo,
  26
  27         closureSize, closureNonHdrSize,
  28         closureGoodStuffSize, closurePtrsSize,
  29         slopSize,
  30
  31         closureName, infoTableLabelFromCI,
  32         closureLabelFromCI, closureSRT,
  33         closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd,
  34         closureNeedsUpdSpace, closureIsThunk,
  35         closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
  36         closureFunInfo, isStandardFormThunk, isKnownFun,
  37
  38         enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
  39
  40         nodeMustPointToIt,
  41         CallMethod(..), getCallMethod,
  42
  43         blackHoleOnEntry,
  44
  45         staticClosureRequired,
  46         getClosureType,
  47
  48         isToplevClosure,
  49         closureValDescr, closureTypeDescr,      -- profiling
  50
  51         isStaticClosure,
  52         cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
  53
  54         staticClosureNeedsLink,
  55     ) where
  56
  57 #include "../includes/MachDeps.h"
  58 #include "HsVersions.h"
  59
  60 import StgSyn
  61 import SMRep
  62
  63 import CLabel
  64
  65 import Packages
  66 import PackageConfig
  67 import StaticFlags
  68 import Id
  69 import DataCon
  70 import Name
  71 import OccName
  72 import Type
  73 import TypeRep
  74 import TcType
  75 import TyCon
  76 import BasicTypes
  77 import FastString
  78 import Outputable
  79 import Constants
  80 \end{code}
  81
  82
  83 %************************************************************************
  84 %*                                                                      *
  85 \subsection[ClosureInfo-datatypes]{Data types for closure information}
  86 %*                                                                      *
  87 %************************************************************************
  88
  89 Information about a closure, from the code generator's point of view.
  90
  91 A ClosureInfo decribes the info pointer of a closure.  It has
  92 enough information
  93   a) to construct the info table itself
  94   b) to allocate a closure containing that info pointer (i.e.
  95         it knows the info table label)
  96
  97 We make a ClosureInfo for
  98         - each let binding (both top level and not)
  99         - each data constructor (for its shared static and
 100                 dynamic info tables)
 101
 102 \begin{code}
 103 data ClosureInfo
 104   = ClosureInfo {
 105         closureName   :: !Name,           -- The thing bound to this closure
 106         closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
 107         closureSMRep  :: !SMRep,          -- representation used by storage mgr
 108         closureSRT    :: !C_SRT,          -- What SRT applies to this closure
 109         closureType   :: !Type,           -- Type of closure (ToDo: remove)
 110         closureDescr  :: !String          -- closure description (for profiling)
 111     }
 112
 113   -- Constructor closures don't have a unique info table label (they use
 114   -- the constructor's info table), and they don't have an SRT.
 115   | ConInfo {
 116         closureCon       :: !DataCon,
 117         closureSMRep     :: !SMRep,
 118         closureDllCon    :: !Bool       -- is in a separate DLL
 119     }
 120
 121 -- C_SRT is what StgSyn.SRT gets translated to...
 122 -- we add a label for the table, and expect only the 'offset/length' form
 123
 124 data C_SRT = NoC_SRT
 125            | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
 126
 127 needsSRT :: C_SRT -> Bool
 128 needsSRT NoC_SRT       = False
 129 needsSRT (C_SRT _ _ _) = True
 130
 131 instance Outputable C_SRT where
 132   ppr (NoC_SRT) = ptext SLIT("_no_srt_")
 133   ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap))
 134 \end{code}
 135
 136 %************************************************************************
 137 %*                                                                      *
 138 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
 139 %*                                                                      *
 140 %************************************************************************
 141
 142 Information about an identifier, from the code generator's point of
 143 view.  Every identifier is bound to a LambdaFormInfo in the
 144 environment, which gives the code generator enough info to be able to
 145 tail call or return that identifier.
 146
 147 Note that a closure is usually bound to an identifier, so a
 148 ClosureInfo contains a LambdaFormInfo.
 149
 150 \begin{code}
 151 data LambdaFormInfo
 152   = LFReEntrant         -- Reentrant closure (a function)
 153         TopLevelFlag    -- True if top level
 154         !Int            -- Arity. Invariant: always > 0
 155         !Bool           -- True <=> no fvs
 156         ArgDescr        -- Argument descriptor (should reall be in ClosureInfo)
 157
 158   | LFCon               -- A saturated constructor application
 159         DataCon         -- The constructor
 160
 161   | LFThunk             -- Thunk (zero arity)
 162         TopLevelFlag
 163         !Bool           -- True <=> no free vars
 164         !Bool           -- True <=> updatable (i.e., *not* single-entry)
 165         StandardFormInfo
 166         !Bool           -- True <=> *might* be a function type
 167
 168   | LFUnknown           -- Used for function arguments and imported things.
 169                         --  We know nothing about  this closure.  Treat like
 170                         -- updatable "LFThunk"...
 171                         -- Imported things which we do know something about use
 172                         -- one of the other LF constructors (eg LFReEntrant for
 173                         -- known functions)
 174         !Bool           -- True <=> *might* be a function type
 175
 176   | LFLetNoEscape       -- See LetNoEscape module for precise description of
 177                         -- these "lets".
 178         !Int            -- arity;
 179
 180   | LFBlackHole         -- Used for the closures allocated to hold the result
 181                         -- of a CAF.  We want the target of the update frame to
 182                         -- be in the heap, so we make a black hole to hold it.
 183         CLabel          -- Flavour (info label, eg CAF_BLACKHOLE_info).
 184
 185
 186 -------------------------
 187 -- An ArgDsecr describes the argument pattern of a function
 188
 189 data ArgDescr
 190   = ArgSpec             -- Fits one of the standard patterns
 191         !Int            -- RTS type identifier ARG_P, ARG_N, ...
 192
 193   | ArgGen              -- General case
 194         Liveness        -- Details about the arguments
 195
 196
 197 -------------------------
 198 -- We represent liveness bitmaps as a Bitmap (whose internal
 199 -- representation really is a bitmap).  These are pinned onto case return
 200 -- vectors to indicate the state of the stack for the garbage collector.
 201 --
 202 -- In the compiled program, liveness bitmaps that fit inside a single
 203 -- word (StgWord) are stored as a single word, while larger bitmaps are
 204 -- stored as a pointer to an array of words.
 205
 206 data Liveness
 207   = SmallLiveness       -- Liveness info that fits in one word
 208         StgWord         -- Here's the bitmap
 209
 210   | BigLiveness         -- Liveness info witha a multi-word bitmap
 211         CLabel          -- Label for the bitmap
 212
 213
 214 -------------------------
 215 -- StandardFormInfo tells whether this thunk has one of
 216 -- a small number of standard forms
 217
 218 data StandardFormInfo
 219   = NonStandardThunk
 220         -- Not of of the standard forms
 221
 222   | SelectorThunk
 223         -- A SelectorThunk is of form
 224         --      case x of
 225         --             con a1,..,an -> ak
 226         -- and the constructor is from a single-constr type.
 227        WordOff                  -- 0-origin offset of ak within the "goods" of
 228                         -- constructor (Recall that the a1,...,an may be laid
 229                         -- out in the heap in a non-obvious order.)
 230
 231   | ApThunk
 232         -- An ApThunk is of form
 233         --      x1 ... xn
 234         -- The code for the thunk just pushes x2..xn on the stack and enters x1.
 235         -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
 236         -- in the RTS to save space.
 237         Int             -- Arity, n
 238 \end{code}
 239
 240 %************************************************************************
 241 %*                                                                      *
 242 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
 243 %*                                                                      *
 244 %************************************************************************
 245
 246 \begin{code}
 247 mkLFReEntrant :: TopLevelFlag   -- True of top level
 248               -> [Id]           -- Free vars
 249               -> [Id]           -- Args
 250               -> ArgDescr       -- Argument descriptor
 251               -> LambdaFormInfo
 252
 253 mkLFReEntrant top fvs args arg_descr
 254   = LFReEntrant top (length args) (null fvs) arg_descr
 255
 256 mkLFThunk thunk_ty top fvs upd_flag
 257   = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) )
 258     LFThunk top (null fvs)
 259             (isUpdatable upd_flag)
 260             NonStandardThunk
 261             (might_be_a_function thunk_ty)
 262
 263 might_be_a_function :: Type -> Bool
 264 -- Return False only if we are *sure* it's a data type
 265 -- Look through newtypes etc as much as poss
 266 might_be_a_function ty
 267   = case splitTyConApp_maybe (repType ty) of
 268         Just (tc, _) -> not (isDataTyCon tc)
 269         Nothing      -> True
 270 \end{code}
 271
 272 @mkConLFInfo@ is similar, for constructors.
 273
 274 \begin{code}
 275 mkConLFInfo :: DataCon -> LambdaFormInfo
 276 mkConLFInfo con = LFCon con
 277
 278 mkSelectorLFInfo id offset updatable
 279   = LFThunk NotTopLevel False updatable (SelectorThunk offset)
 280         (might_be_a_function (idType id))
 281
 282 mkApLFInfo id upd_flag arity
 283   = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
 284         (might_be_a_function (idType id))
 285 \end{code}
 286
 287 Miscellaneous LF-infos.
 288
 289 \begin{code}
 290 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
 291
 292 mkLFLetNoEscape = LFLetNoEscape
 293
 294 mkLFImported :: Id -> LambdaFormInfo
 295 mkLFImported id
 296   = case idArity id of
 297       n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr")  -- n > 0
 298       other -> mkLFArgument id -- Not sure of exact arity
 299 \end{code}
 300
 301 \begin{code}
 302 isLFThunk :: LambdaFormInfo -> Bool
 303 isLFThunk (LFThunk _ _ _ _ _)  = True
 304 isLFThunk (LFBlackHole _)      = True
 305         -- return True for a blackhole: this function is used to determine
 306         -- whether to use the thunk header in SMP mode, and a blackhole
 307         -- must have one.
 308 isLFThunk _ = False
 309 \end{code}
 310
 311 %************************************************************************
 312 %*                                                                      *
 313         Building ClosureInfos
 314 %*                                                                      *
 315 %************************************************************************
 316
 317 \begin{code}
 318 mkClosureInfo :: Bool           -- Is static
 319               -> Id
 320               -> LambdaFormInfo
 321               -> Int -> Int     -- Total and pointer words
 322               -> C_SRT
 323               -> String         -- String descriptor
 324               -> ClosureInfo
 325 mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
 326   = ClosureInfo { closureName = name,
 327                   closureLFInfo = lf_info,
 328                   closureSMRep = sm_rep,
 329                   closureSRT = srt_info,
 330                   closureType = idType id,
 331                   closureDescr = descr }
 332   where
 333     name   = idName id
 334     sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
 335
 336 mkConInfo :: PackageId
 337           -> Bool       -- Is static
 338           -> DataCon
 339           -> Int -> Int -- Total and pointer words
 340           -> ClosureInfo
 341 mkConInfo this_pkg is_static data_con tot_wds ptr_wds
 342    = ConInfo {  closureSMRep = sm_rep,
 343                 closureCon = data_con,
 344                 closureDllCon = isDllName this_pkg (dataConName data_con) }
 345   where
 346     sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
 347 \end{code}
 348
 349 %************************************************************************
 350 %*                                                                      *
 351 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
 352 %*                                                                      *
 353 %************************************************************************
 354
 355 \begin{code}
 356 closureSize :: ClosureInfo -> WordOff
 357 closureSize cl_info = hdr_size + closureNonHdrSize cl_info
 358   where hdr_size  | closureIsThunk cl_info = thunkHdrSize
 359                   | otherwise              = fixedHdrSize
 360         -- All thunks use thunkHdrSize, even if they are non-updatable.
 361         -- this is because we don't have separate closure types for
 362         -- updatable vs. non-updatable thunks, so the GC can't tell the
 363         -- difference.  If we ever have significant numbers of non-
 364         -- updatable thunks, it might be worth fixing this.
 365
 366 closureNonHdrSize :: ClosureInfo -> WordOff
 367 closureNonHdrSize cl_info
 368   = tot_wds + computeSlopSize tot_wds cl_info
 369   where
 370     tot_wds = closureGoodStuffSize cl_info
 371
 372 closureGoodStuffSize :: ClosureInfo -> WordOff
 373 closureGoodStuffSize cl_info
 374   = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
 375     in  ptrs + nonptrs
 376
 377 closurePtrsSize :: ClosureInfo -> WordOff
 378 closurePtrsSize cl_info
 379   = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
 380     in  ptrs
 381
 382 -- not exported:
 383 sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
 384 sizes_from_SMRep (GenericRep _ ptrs nonptrs _)   = (ptrs, nonptrs)
 385 sizes_from_SMRep BlackHoleRep                    = (0, 0)
 386 \end{code}
 387
 388 Computing slop size.  WARNING: this looks dodgy --- it has deep
 389 knowledge of what the storage manager does with the various
 390 representations...
 391
 392 Slop Requirements: every thunk gets an extra padding word in the
 393 header, which takes the the updated value.
 394
 395 \begin{code}
 396 slopSize cl_info = computeSlopSize payload_size cl_info
 397   where payload_size = closureGoodStuffSize cl_info
 398
 399 computeSlopSize :: WordOff -> ClosureInfo -> WordOff
 400 computeSlopSize payload_size cl_info
 401   = max 0 (minPayloadSize smrep updatable - payload_size)
 402   where
 403         smrep        = closureSMRep cl_info
 404         updatable    = closureNeedsUpdSpace cl_info
 405
 406 -- we leave space for an update if either (a) the closure is updatable
 407 -- or (b) it is a static thunk.  This is because a static thunk needs
 408 -- a static link field in a predictable place (after the slop), regardless
 409 -- of whether it is updatable or not.
 410 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
 411                                         LFThunk TopLevel _ _ _ _ }) = True
 412 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
 413
 414 minPayloadSize :: SMRep -> Bool -> WordOff
 415 minPayloadSize smrep updatable
 416   = case smrep of
 417         BlackHoleRep                            -> min_upd_size
 418         GenericRep _ _ _ _      | updatable     -> min_upd_size
 419         GenericRep True _ _ _                   -> 0 -- static
 420         GenericRep False _ _ _                  -> mIN_PAYLOAD_SIZE
 421           --       ^^^^^___ dynamic
 422   where
 423    min_upd_size =
 424         ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader)
 425         0       -- check that we already have enough
 426                 -- room for mIN_SIZE_NonUpdHeapObject,
 427                 -- due to the extra header word in SMP
 428 \end{code}
 429
 430 %************************************************************************
 431 %*                                                                      *
 432 \subsection[SMreps]{Choosing SM reps}
 433 %*                                                                      *
 434 %************************************************************************
 435
 436 \begin{code}
 437 chooseSMRep
 438         :: Bool                 -- True <=> static closure
 439         -> LambdaFormInfo
 440         -> WordOff -> WordOff   -- Tot wds, ptr wds
 441         -> SMRep
 442
 443 chooseSMRep is_static lf_info tot_wds ptr_wds
 444   = let
 445          nonptr_wds   = tot_wds - ptr_wds
 446          closure_type = getClosureType is_static ptr_wds lf_info
 447     in
 448     GenericRep is_static ptr_wds nonptr_wds closure_type
 449
 450 -- We *do* get non-updatable top-level thunks sometimes.  eg. f = g
 451 -- gets compiled to a jump to g (if g has non-zero arity), instead of
 452 -- messing around with update frames and PAPs.  We set the closure type
 453 -- to FUN_STATIC in this case.
 454
 455 getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
 456 getClosureType is_static ptr_wds lf_info
 457   = case lf_info of
 458         LFCon con | is_static && ptr_wds == 0   -> ConstrNoCaf
 459                   | otherwise                   -> Constr
 460         LFReEntrant _ _ _ _                     -> Fun
 461         LFThunk _ _ _ (SelectorThunk _) _       -> ThunkSelector
 462         LFThunk _ _ _ _ _                       -> Thunk
 463         _ -> panic "getClosureType"
 464 \end{code}
 465
 466 %************************************************************************
 467 %*                                                                      *
 468 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
 469 %*                                                                      *
 470 %************************************************************************
 471
 472 Be sure to see the stg-details notes about these...
 473
 474 \begin{code}
 475 nodeMustPointToIt :: LambdaFormInfo -> Bool
 476 nodeMustPointToIt (LFReEntrant top _ no_fvs _)
 477   = not no_fvs ||   -- Certainly if it has fvs we need to point to it
 478     isNotTopLevel top
 479                     -- If it is not top level we will point to it
 480                     --   We can have a \r closure with no_fvs which
 481                     --   is not top level as special case cgRhsClosure
 482                     --   has been dissabled in favour of let floating
 483
 484                 -- For lex_profiling we also access the cost centre for a
 485                 -- non-inherited function i.e. not top level
 486                 -- the  not top  case above ensures this is ok.
 487
 488 nodeMustPointToIt (LFCon _) = True
 489
 490         -- Strictly speaking, the above two don't need Node to point
 491         -- to it if the arity = 0.  But this is a *really* unlikely
 492         -- situation.  If we know it's nil (say) and we are entering
 493         -- it. Eg: let x = [] in x then we will certainly have inlined
 494         -- x, since nil is a simple atom.  So we gain little by not
 495         -- having Node point to known zero-arity things.  On the other
 496         -- hand, we do lose something; Patrick's code for figuring out
 497         -- when something has been updated but not entered relies on
 498         -- having Node point to the result of an update.  SLPJ
 499         -- 27/11/92.
 500
 501 nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
 502   = updatable || not no_fvs || opt_SccProfilingOn
 503           -- For the non-updatable (single-entry case):
 504           --
 505           -- True if has fvs (in which case we need access to them, and we
 506           --                should black-hole it)
 507           -- or profiling (in which case we need to recover the cost centre
 508           --             from inside it)
 509
 510 nodeMustPointToIt (LFThunk _ no_fvs updatable some_standard_form_thunk _)
 511   = True  -- Node must point to any standard-form thunk
 512
 513 nodeMustPointToIt (LFUnknown _)     = True
 514 nodeMustPointToIt (LFBlackHole _)   = True    -- BH entry may require Node to point
 515 nodeMustPointToIt (LFLetNoEscape _) = False
 516 \end{code}
 517
 518 The entry conventions depend on the type of closure being entered,
 519 whether or not it has free variables, and whether we're running
 520 sequentially or in parallel.
 521
 522 \begin{tabular}{lllll}
 523 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
 524 Unknown                         & no & yes & stack      & node \\
 525 Known fun ($\ge$ 1 arg), no fvs         & no & no  & registers  & fast entry (enough args) \\
 526 \ & \ & \ & \                                           & slow entry (otherwise) \\
 527 Known fun ($\ge$ 1 arg), fvs    & no & yes & registers  & fast entry (enough args) \\
 528 0 arg, no fvs @\r,\s@           & no & no  & n/a        & direct entry \\
 529 0 arg, no fvs @\u@              & no & yes & n/a        & node \\
 530 0 arg, fvs @\r,\s@              & no & yes & n/a        & direct entry \\
 531 0 arg, fvs @\u@                 & no & yes & n/a        & node \\
 532
 533 Unknown                         & yes & yes & stack     & node \\
 534 Known fun ($\ge$ 1 arg), no fvs         & yes & no  & registers & fast entry (enough args) \\
 535 \ & \ & \ & \                                           & slow entry (otherwise) \\
 536 Known fun ($\ge$ 1 arg), fvs    & yes & yes & registers & node \\
 537 0 arg, no fvs @\r,\s@           & yes & no  & n/a       & direct entry \\
 538 0 arg, no fvs @\u@              & yes & yes & n/a       & node \\
 539 0 arg, fvs @\r,\s@              & yes & yes & n/a       & node \\
 540 0 arg, fvs @\u@                 & yes & yes & n/a       & node\\
 541 \end{tabular}
 542
 543 When black-holing, single-entry closures could also be entered via node
 544 (rather than directly) to catch double-entry.
 545
 546 \begin{code}
 547 data CallMethod
 548   = EnterIt                             -- no args, not a function
 549
 550   | JumpToIt CLabel                     -- no args, not a function, but we
 551                                         -- know what its entry code is
 552
 553   | ReturnIt                            -- it's a function, but we have
 554                                         -- zero args to apply to it, so just
 555                                         -- return it.
 556
 557   | ReturnCon DataCon                   -- It's a data constructor, just return it
 558
 559   | SlowCall                            -- Unknown fun, or known fun with
 560                                         -- too few args.
 561
 562   | DirectEntry                         -- Jump directly, with args in regs
 563         CLabel                          --   The code label
 564         Int                             --   Its arity
 565
 566 getCallMethod :: PackageId
 567               -> Name           -- Function being applied
 568               -> LambdaFormInfo -- Its info
 569               -> Int            -- Number of available arguments
 570               -> CallMethod
 571
 572 getCallMethod this_pkg name lf_info n_args
 573   | nodeMustPointToIt lf_info && opt_Parallel
 574   =     -- If we're parallel, then we must always enter via node.
 575         -- The reason is that the closure may have been
 576         -- fetched since we allocated it.
 577     EnterIt
 578
 579 getCallMethod this_pkg name (LFReEntrant _ arity _ _) n_args
 580   | n_args == 0    = ASSERT( arity /= 0 )
 581                      ReturnIt   -- No args at all
 582   | n_args < arity = SlowCall   -- Not enough args
 583   | otherwise      = DirectEntry (enterIdLabel this_pkg name) arity
 584
 585 getCallMethod this_pkg name (LFCon con) n_args
 586   = ASSERT( n_args == 0 )
 587     ReturnCon con
 588
 589 getCallMethod this_pkg name (LFThunk _ _ updatable std_form_info is_fun) n_args
 590   | is_fun      -- *Might* be a function, so we must "call" it (which is always safe)
 591   = SlowCall    -- We cannot just enter it [in eval/apply, the entry code
 592                 -- is the fast-entry code]
 593
 594   -- Since is_fun is False, we are *definitely* looking at a data value
 595   | updatable || opt_DoTickyProfiling  -- to catch double entry
 596       {- OLD: || opt_SMP
 597          I decided to remove this, because in SMP mode it doesn't matter
 598          if we enter the same thunk multiple times, so the optimisation
 599          of jumping directly to the entry code is still valid.  --SDM
 600         -}
 601   = EnterIt
 602     -- We used to have ASSERT( n_args == 0 ), but actually it is
 603     -- possible for the optimiser to generate
 604     --   let bot :: Int = error Int "urk"
 605     --   in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
 606     -- This happens as a result of the case-of-error transformation
 607     -- So the right thing to do is just to enter the thing
 608
 609   | otherwise   -- Jump direct to code for single-entry thunks
 610   = ASSERT( n_args == 0 )
 611     JumpToIt (thunkEntryLabel this_pkg name std_form_info updatable)
 612
 613 getCallMethod this_pkg name (LFUnknown True) n_args
 614   = SlowCall -- might be a function
 615
 616 getCallMethod this_pkg name (LFUnknown False) n_args
 617   = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args )
 618     EnterIt -- Not a function
 619
 620 getCallMethod this_pkg 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 this_pkg name (LFLetNoEscape 0) n_args
 626   = JumpToIt (enterReturnPtLabel (nameUnique name))
 627
 628 getCallMethod this_pkg 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 this_pkg thunk_id (ApThunk arity) is_updatable
 859   = enterApLabel is_updatable arity
 860 thunkEntryLabel this_pkg thunk_id (SelectorThunk offset) upd_flag
 861   = enterSelectorLabel upd_flag offset
 862 thunkEntryLabel this_pkg thunk_id _ is_updatable
 863   = enterIdLabel this_pkg 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 this_pkg id
 874   | tablesNextToCode = mkInfoTableLabel this_pkg id
 875   | otherwise        = mkEntryLabel this_pkg 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   = occNameString (getOccName con)
 935
 936 closureTypeDescr (ClosureInfo { closureType = ty })
 937   = getTyDescription ty
 938 closureTypeDescr (ConInfo { closureCon = data_con })
 939   = occNameString (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       PredTy sty             -> getPredTyDescription sty
 951       ForAllTy _ ty          -> getTyDescription ty
 952     }
 953   where
 954     fun_result (FunTy _ res) = '>' : fun_result res
 955     fun_result other         = getTyDescription other
 956
 957 getPredTyDescription (ClassP cl tys) = getOccString cl
 958 getPredTyDescription (IParam ip ty)  = getOccString (ipNameName ip)
 959 \end{code}
 960
 961