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