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