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