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   | updatable || doingTickyProfiling dflags -- to catch double entry
 615       {- OLD: || opt_SMP
 616          I decided to remove this, because in SMP mode it doesn't matter
 617          if we enter the same thunk multiple times, so the optimisation
 618          of jumping directly to the entry code is still valid.  --SDM
 619         -}
 620   = EnterIt
 621     -- We used to have ASSERT( n_args == 0 ), but actually it is
 622     -- possible for the optimiser to generate
 623     --   let bot :: Int = error Int "urk"
 624     --   in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
 625     -- This happens as a result of the case-of-error transformation
 626     -- So the right thing to do is just to enter the thing
 627
 628   | otherwise   -- Jump direct to code for single-entry thunks
 629   = ASSERT( n_args == 0 )
 630     JumpToIt (thunkEntryLabel name caf std_form_info updatable)
 631
 632 getCallMethod _ _ _ (LFUnknown True) _
 633   = SlowCall -- Might be a function
 634
 635 getCallMethod _ name _ (LFUnknown False) n_args
 636   | n_args > 0
 637   = WARN( True, ppr name <+> ppr n_args )
 638     SlowCall    -- Note [Unsafe coerce complications]
 639
 640   | otherwise
 641   = EnterIt -- Not a function
 642
 643 getCallMethod _ _ _ (LFBlackHole _) _
 644   = SlowCall    -- Presumably the black hole has by now
 645                 -- been updated, but we don't know with
 646                 -- what, so we slow call it
 647
 648 getCallMethod _ name _ (LFLetNoEscape 0) _
 649   = JumpToIt (enterReturnPtLabel (nameUnique name))
 650
 651 getCallMethod _ name _ (LFLetNoEscape arity) n_args
 652   | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
 653   | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
 654
 655 blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
 656 -- Static closures are never themselves black-holed.
 657 -- Updatable ones will be overwritten with a CAFList cell, which points to a
 658 -- black hole;
 659 -- Single-entry ones have no fvs to plug, and we trust they don't form part
 660 -- of a loop.
 661
 662 blackHoleOnEntry _ ConInfo{} = False
 663 blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
 664   | isStaticRep rep
 665   = False       -- Never black-hole a static closure
 666
 667   | otherwise
 668   = case lf_info of
 669         LFReEntrant _ _ _ _       -> False
 670         LFLetNoEscape _           -> False
 671         LFThunk _ no_fvs updatable _ _
 672           -> if updatable
 673              then not opt_OmitBlackHoling
 674              else doingTickyProfiling dflags || not no_fvs
 675                   -- the former to catch double entry,
 676                   -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
 677
 678         _ -> panic "blackHoleOnEntry"   -- Should never happen
 679
 680 isStandardFormThunk :: LambdaFormInfo -> Bool
 681 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
 682 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _)       = True
 683 isStandardFormThunk _                   = False
 684
 685 isKnownFun :: LambdaFormInfo -> Bool
 686 isKnownFun (LFReEntrant _ _ _ _) = True
 687 isKnownFun (LFLetNoEscape _) = True
 688 isKnownFun _ = False
 689 \end{code}
 690
 691 Note [Unsafe coerce complications]
 692 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 693 In some (badly-optimised) DPH code we see this
 694    Module X:    rr :: Int = error Int "Urk"
 695    Module Y:    ...((X.rr |> g) True) ...
 696      where g is an (unsafe) coercion of kind (Int ~ Bool->Bool), say
 697
 698 It's badly optimised, because knowing that 'X.rr' is bottom, we should
 699 have dumped the application to True.  But it should still work. These
 700 strange unsafe coercions arise from the case-of-error transformation:
 701         (case (error Int "foo") of { ... }) True
 702 --->    (error Int "foo" |> g) True
 703
 704 Anyway, the net effect is that in STG-land, when casts are discarded,
 705 we *can* see a value of type Int applied to an argument.  This only happens
 706 if (a) the programmer made a mistake, or (b) the value of type Int is
 707 actually bottom.
 708
 709 So it's wrong to trigger an ASSERT failure in this circumstance.  Instead
 710 we now emit a WARN -- mainly to draw attention to a probably-badly-optimised
 711 program fragment -- and do the conservative thing which is SlowCall.
 712
 713
 714 -----------------------------------------------------------------------------
 715 SRT-related stuff
 716
 717 \begin{code}
 718 staticClosureNeedsLink :: ClosureInfo -> Bool
 719 -- A static closure needs a link field to aid the GC when traversing
 720 -- the static closure graph.  But it only needs such a field if either
 721 --      a) it has an SRT
 722 --      b) it's a constructor with one or more pointer fields
 723 -- In case (b), the constructor's fields themselves play the role
 724 -- of the SRT.
 725 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
 726   = needsSRT srt
 727 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
 728   = not (isNullaryRepDataCon con) && not_nocaf_constr
 729   where
 730     not_nocaf_constr =
 731         case sm_rep of
 732            GenericRep _ _ _ ConstrNoCaf -> False
 733            _other                       -> True
 734 \end{code}
 735
 736 Note [Entering error thunks]
 737 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 738 Consider this
 739
 740         fail :: Int
 741         fail = error Int "Urk"
 742
 743         foo :: Bool -> Bool
 744         foo True  y = (fail `cast` Bool -> Bool) y
 745         foo False y = False
 746
 747 This looks silly, but it can arise from case-of-error.  Even if it
 748 does, we'd usually see that 'fail' is a bottoming function and would
 749 discard the extra argument 'y'.  But even if that does not occur,
 750 this program is still OK.  We will enter 'fail', which never returns.
 751
 752 The WARN is just to alert me to the fact that we aren't spotting that
 753 'fail' is bottoming.
 754
 755 (We are careful never to make a funtion value look like a data type,
 756 because we can't enter a function closure -- but that is not the
 757 problem here.)
 758
 759
 760 Avoiding generating entries and info tables
 761 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 762 At present, for every function we generate all of the following,
 763 just in case.  But they aren't always all needed, as noted below:
 764
 765 [NB1: all of this applies only to *functions*.  Thunks always
 766 have closure, info table, and entry code.]
 767
 768 [NB2: All are needed if the function is *exported*, just to play safe.]
 769
 770
 771 * Fast-entry code  ALWAYS NEEDED
 772
 773 * Slow-entry code
 774         Needed iff (a) we have any un-saturated calls to the function
 775         OR         (b) the function is passed as an arg
 776         OR         (c) we're in the parallel world and the function has free vars
 777                         [Reason: in parallel world, we always enter functions
 778                         with free vars via the closure.]
 779
 780 * The function closure
 781         Needed iff (a) we have any un-saturated calls to the function
 782         OR         (b) the function is passed as an arg
 783         OR         (c) if the function has free vars (ie not top level)
 784
 785   Why case (a) here?  Because if the arg-satis check fails,
 786   UpdatePAP stuffs a pointer to the function closure in the PAP.
 787   [Could be changed; UpdatePAP could stuff in a code ptr instead,
 788    but doesn't seem worth it.]
 789
 790   [NB: these conditions imply that we might need the closure
 791   without the slow-entry code.  Here's how.
 792
 793         f x y = let g w = ...x..y..w...
 794                 in
 795                 ...(g t)...
 796
 797   Here we need a closure for g which contains x and y,
 798   but since the calls are all saturated we just jump to the
 799   fast entry point for g, with R1 pointing to the closure for g.]
 800
 801
 802 * Standard info table
 803         Needed iff (a) we have any un-saturated calls to the function
 804         OR         (b) the function is passed as an arg
 805         OR         (c) the function has free vars (ie not top level)
 806
 807         NB.  In the sequential world, (c) is only required so that the function closure has
 808         an info table to point to, to keep the storage manager happy.
 809         If (c) alone is true we could fake up an info table by choosing
 810         one of a standard family of info tables, whose entry code just
 811         bombs out.
 812
 813         [NB In the parallel world (c) is needed regardless because
 814         we enter functions with free vars via the closure.]
 815
 816         If (c) is retained, then we'll sometimes generate an info table
 817         (for storage mgr purposes) without slow-entry code.  Then we need
 818         to use an error label in the info table to substitute for the absent
 819         slow entry code.
 820
 821 \begin{code}
 822 staticClosureRequired
 823         :: Name
 824         -> StgBinderInfo
 825         -> LambdaFormInfo
 826         -> Bool
 827 staticClosureRequired _ bndr_info
 828                       (LFReEntrant top_level _ _ _)     -- It's a function
 829   = ASSERT( isTopLevel top_level )
 830         -- Assumption: it's a top-level, no-free-var binding
 831         not (satCallsOnly bndr_info)
 832
 833 staticClosureRequired _ _ _ = True
 834 \end{code}
 835
 836 %************************************************************************
 837 %*                                                                      *
 838 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
 839 %*                                                                      *
 840 %************************************************************************
 841
 842 \begin{code}
 843
 844 isStaticClosure :: ClosureInfo -> Bool
 845 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
 846
 847 closureUpdReqd :: ClosureInfo -> Bool
 848 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
 849 closureUpdReqd ConInfo{} = False
 850
 851 lfUpdatable :: LambdaFormInfo -> Bool
 852 lfUpdatable (LFThunk _ _ upd _ _)  = upd
 853 lfUpdatable (LFBlackHole _)        = True
 854         -- Black-hole closures are allocated to receive the results of an
 855         -- alg case with a named default... so they need to be updated.
 856 lfUpdatable _ = False
 857
 858 closureIsThunk :: ClosureInfo -> Bool
 859 closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
 860 closureIsThunk ConInfo{} = False
 861
 862 closureSingleEntry :: ClosureInfo -> Bool
 863 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
 864 closureSingleEntry _ = False
 865
 866 closureReEntrant :: ClosureInfo -> Bool
 867 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
 868 closureReEntrant _ = False
 869
 870 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
 871 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
 872 isConstrClosure_maybe _                                   = Nothing
 873
 874 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
 875 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
 876 closureFunInfo _ = Nothing
 877
 878 lfFunInfo :: LambdaFormInfo ->  Maybe (Int, ArgDescr)
 879 lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
 880 lfFunInfo _                                 = Nothing
 881
 882 funTag :: ClosureInfo -> Int
 883 funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info
 884 funTag _ = 0
 885
 886 -- maybe this should do constructor tags too?
 887 funTagLFInfo :: LambdaFormInfo -> Int
 888 funTagLFInfo lf
 889     -- A function is tagged with its arity
 890   | Just (arity,_) <- lfFunInfo lf,
 891     Just tag <- tagForArity arity
 892   = tag
 893
 894     -- other closures (and unknown ones) are not tagged
 895   | otherwise
 896   = 0
 897
 898 tagForArity :: Int -> Maybe Int
 899 tagForArity i | i <= mAX_PTR_TAG = Just i
 900               | otherwise        = Nothing
 901 \end{code}
 902
 903 \begin{code}
 904 isToplevClosure :: ClosureInfo -> Bool
 905 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
 906   = case lf_info of
 907       LFReEntrant TopLevel _ _ _ -> True
 908       LFThunk TopLevel _ _ _ _   -> True
 909       _ -> False
 910 isToplevClosure _ = False
 911 \end{code}
 912
 913 Label generation.
 914
 915 \begin{code}
 916 infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
 917 infoTableLabelFromCI (ClosureInfo { closureName = name,
 918                                     closureLFInfo = lf_info }) caf
 919   = case lf_info of
 920         LFBlackHole info -> info
 921
 922         LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
 923                 mkSelectorInfoLabel upd_flag offset
 924
 925         LFThunk _ _ upd_flag (ApThunk arity) _ ->
 926                 mkApInfoTableLabel upd_flag arity
 927
 928         LFThunk{}      -> mkLocalInfoTableLabel name caf
 929
 930         LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name caf
 931
 932         _ -> panic "infoTableLabelFromCI"
 933
 934 infoTableLabelFromCI (ConInfo { closureCon = con,
 935                                 closureSMRep = rep }) caf
 936   | isStaticRep rep = mkStaticInfoTableLabel  name caf
 937   | otherwise       = mkConInfoTableLabel     name caf
 938   where
 939     name = dataConName con
 940
 941 -- ClosureInfo for a closure (as opposed to a constructor) is always local
 942 closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
 943 closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf
 944 closureLabelFromCI _ _ = panic "closureLabelFromCI"
 945
 946 -- thunkEntryLabel is a local help function, not exported.  It's used from both
 947 -- entryLabelFromCI and getCallMethod.
 948
 949 thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
 950 thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable
 951   = enterApLabel is_updatable arity
 952 thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag
 953   = enterSelectorLabel upd_flag offset
 954 thunkEntryLabel thunk_id caf _ _is_updatable
 955   = enterIdLabel thunk_id caf
 956
 957 enterApLabel :: Bool -> Int -> CLabel
 958 enterApLabel is_updatable arity
 959   | tablesNextToCode = mkApInfoTableLabel is_updatable arity
 960   | otherwise        = mkApEntryLabel is_updatable arity
 961
 962 enterSelectorLabel :: Bool -> Int -> CLabel
 963 enterSelectorLabel upd_flag offset
 964   | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
 965   | otherwise        = mkSelectorEntryLabel upd_flag offset
 966
 967 enterIdLabel :: Name -> CafInfo -> CLabel
 968 enterIdLabel id
 969   | tablesNextToCode = mkInfoTableLabel id
 970   | otherwise        = mkEntryLabel id
 971
 972 enterLocalIdLabel :: Name -> CafInfo -> CLabel
 973 enterLocalIdLabel id
 974   | tablesNextToCode = mkLocalInfoTableLabel id
 975   | otherwise        = mkLocalEntryLabel id
 976
 977 enterReturnPtLabel :: Unique -> CLabel
 978 enterReturnPtLabel name
 979   | tablesNextToCode = mkReturnInfoLabel name
 980   | otherwise        = mkReturnPtLabel name
 981 \end{code}
 982
 983
 984 We need a black-hole closure info to pass to @allocDynClosure@ when we
 985 want to allocate the black hole on entry to a CAF.  These are the only
 986 ways to build an LFBlackHole, maintaining the invariant that it really
 987 is a black hole and not something else.
 988
 989 \begin{code}
 990 cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
 991 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
 992                                        closureType = ty })
 993   = ClosureInfo { closureName   = nm,
 994                   closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
 995                   closureSMRep  = BlackHoleRep,
 996                   closureSRT    = NoC_SRT,
 997                   closureType   = ty,
 998                   closureDescr  = "" }
 999 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
1000 \end{code}
1001
1002 %************************************************************************
1003 %*                                                                      *
1004 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1005 %*                                                                      *
1006 %************************************************************************
1007
1008 Profiling requires two pieces of information to be determined for
1009 each closure's info table --- description and type.
1010
1011 The description is stored directly in the @CClosureInfoTable@ when the
1012 info table is built.
1013
1014 The type is determined from the type information stored with the @Id@
1015 in the closure info using @closureTypeDescr@.
1016
1017 \begin{code}
1018 closureValDescr, closureTypeDescr :: ClosureInfo -> String
1019 closureValDescr (ClosureInfo {closureDescr = descr})
1020   = descr
1021 closureValDescr (ConInfo {closureCon = con})
1022   = occNameString (getOccName con)
1023
1024 closureTypeDescr (ClosureInfo { closureType = ty })
1025   = getTyDescription ty
1026 closureTypeDescr (ConInfo { closureCon = data_con })
1027   = occNameString (getOccName (dataConTyCon data_con))
1028
1029 getTyDescription :: Type -> String
1030 getTyDescription ty
1031   = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
1032     case tau_ty of
1033       TyVarTy _              -> "*"
1034       AppTy fun _            -> getTyDescription fun
1035       FunTy _ res            -> '-' : '>' : fun_result res
1036       TyConApp tycon _       -> getOccString tycon
1037       PredTy sty             -> getPredTyDescription sty
1038       ForAllTy _ ty          -> getTyDescription ty
1039     }
1040   where
1041     fun_result (FunTy _ res) = '>' : fun_result res
1042     fun_result other         = getTyDescription other
1043
1044 getPredTyDescription :: PredType -> String
1045 getPredTyDescription (ClassP cl _) = getOccString cl
1046 getPredTyDescription (IParam ip _) = getOccString (ipNameName ip)
1047 getPredTyDescription (EqPred _ _) = panic "getPredTyDescription EqPred"
1048 \end{code}