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