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   = 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 _ _ _ (LFUnknown True) _
 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 _ _ _ (LFBlackHole _) _
 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) _
 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         _ -> panic "blackHoleOnEntry"   -- Should never happen
 676
 677 isStandardFormThunk :: LambdaFormInfo -> Bool
 678 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
 679 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _)       = True
 680 isStandardFormThunk _                   = 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 _ 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 _ _ _ = 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 _ = False
 862
 863 closureReEntrant :: ClosureInfo -> Bool
 864 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
 865 closureReEntrant _ = 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       _ -> 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 }) caf
 916   = case lf_info of
 917         LFBlackHole info -> info
 918
 919         LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
 920                 mkSelectorInfoLabel upd_flag offset
 921
 922         LFThunk _ _ upd_flag (ApThunk arity) _ ->
 923                 mkApInfoTableLabel upd_flag arity
 924
 925         LFThunk{}      -> mkLocalInfoTableLabel name caf
 926
 927         LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name caf
 928
 929         _ -> panic "infoTableLabelFromCI"
 930
 931 infoTableLabelFromCI (ConInfo { closureCon = con,
 932                                 closureSMRep = rep }) caf
 933   | isStaticRep rep = mkStaticInfoTableLabel  name caf
 934   | otherwise       = mkConInfoTableLabel     name caf
 935   where
 936     name = dataConName con
 937
 938 -- ClosureInfo for a closure (as opposed to a constructor) is always local
 939 closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
 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 :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
 947 thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable
 948   = enterApLabel is_updatable arity
 949 thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag
 950   = enterSelectorLabel upd_flag offset
 951 thunkEntryLabel thunk_id caf _ _is_updatable
 952   = enterIdLabel thunk_id caf
 953
 954 enterApLabel :: Bool -> Int -> CLabel
 955 enterApLabel is_updatable arity
 956   | tablesNextToCode = mkApInfoTableLabel is_updatable arity
 957   | otherwise        = mkApEntryLabel is_updatable arity
 958
 959 enterSelectorLabel :: Bool -> Int -> CLabel
 960 enterSelectorLabel upd_flag offset
 961   | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
 962   | otherwise        = mkSelectorEntryLabel upd_flag offset
 963
 964 enterIdLabel :: Name -> CafInfo -> CLabel
 965 enterIdLabel id
 966   | tablesNextToCode = mkInfoTableLabel id
 967   | otherwise        = mkEntryLabel id
 968
 969 enterLocalIdLabel :: Name -> CafInfo -> CLabel
 970 enterLocalIdLabel id
 971   | tablesNextToCode = mkLocalInfoTableLabel id
 972   | otherwise        = mkLocalEntryLabel id
 973
 974 enterReturnPtLabel :: Unique -> CLabel
 975 enterReturnPtLabel name
 976   | tablesNextToCode = mkReturnInfoLabel name
 977   | otherwise        = mkReturnPtLabel name
 978 \end{code}
 979
 980
 981 We need a black-hole closure info to pass to @allocDynClosure@ when we
 982 want to allocate the black hole on entry to a CAF.  These are the only
 983 ways to build an LFBlackHole, maintaining the invariant that it really
 984 is a black hole and not something else.
 985
 986 \begin{code}
 987 cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
 988 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
 989                                        closureType = ty })
 990   = ClosureInfo { closureName   = nm,
 991                   closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
 992                   closureSMRep  = BlackHoleRep,
 993                   closureSRT    = NoC_SRT,
 994                   closureType   = ty,
 995                   closureDescr  = "" }
 996 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
 997 \end{code}
 998
 999 %************************************************************************
1000 %*                                                                      *
1001 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1002 %*                                                                      *
1003 %************************************************************************
1004
1005 Profiling requires two pieces of information to be determined for
1006 each closure's info table --- description and type.
1007
1008 The description is stored directly in the @CClosureInfoTable@ when the
1009 info table is built.
1010
1011 The type is determined from the type information stored with the @Id@
1012 in the closure info using @closureTypeDescr@.
1013
1014 \begin{code}
1015 closureValDescr, closureTypeDescr :: ClosureInfo -> String
1016 closureValDescr (ClosureInfo {closureDescr = descr})
1017   = descr
1018 closureValDescr (ConInfo {closureCon = con})
1019   = occNameString (getOccName con)
1020
1021 closureTypeDescr (ClosureInfo { closureType = ty })
1022   = getTyDescription ty
1023 closureTypeDescr (ConInfo { closureCon = data_con })
1024   = occNameString (getOccName (dataConTyCon data_con))
1025
1026 getTyDescription :: Type -> String
1027 getTyDescription ty
1028   = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
1029     case tau_ty of
1030       TyVarTy _              -> "*"
1031       AppTy fun _            -> getTyDescription fun
1032       FunTy _ res            -> '-' : '>' : fun_result res
1033       TyConApp tycon _       -> getOccString tycon
1034       PredTy sty             -> getPredTyDescription sty
1035       ForAllTy _ ty          -> getTyDescription ty
1036     }
1037   where
1038     fun_result (FunTy _ res) = '>' : fun_result res
1039     fun_result other         = getTyDescription other
1040
1041 getPredTyDescription :: PredType -> String
1042 getPredTyDescription (ClassP cl _) = getOccString cl
1043 getPredTyDescription (IParam ip _) = getOccString (ipNameName ip)
1044 getPredTyDescription (EqPred _ _) = panic "getPredTyDescription EqPred"
1045 \end{code}