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