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