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