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      -- *Might* be a function, so we must "call" it (which is always safe)
 602   = SlowCall    -- We cannot just enter it [in eval/apply, the entry code
 603                 -- is the fast-entry code]
 604
 605   -- Since is_fun is False, we are *definitely* looking at a data value
 606   | updatable || opt_DoTickyProfiling  -- to catch double entry
 607       {- OLD: || opt_SMP
 608          I decided to remove this, because in SMP mode it doesn't matter
 609          if we enter the same thunk multiple times, so the optimisation
 610          of jumping directly to the entry code is still valid.  --SDM
 611         -}
 612   = EnterIt
 613     -- We used to have ASSERT( n_args == 0 ), but actually it is
 614     -- possible for the optimiser to generate
 615     --   let bot :: Int = error Int "urk"
 616     --   in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
 617     -- This happens as a result of the case-of-error transformation
 618     -- So the right thing to do is just to enter the thing
 619
 620   | otherwise   -- Jump direct to code for single-entry thunks
 621   = ASSERT( n_args == 0 )
 622     JumpToIt (thunkEntryLabel name std_form_info updatable)
 623
 624 getCallMethod name (LFUnknown True) n_args
 625   = SlowCall -- might be a function
 626
 627 getCallMethod name (LFUnknown False) n_args
 628   = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args )
 629     EnterIt -- Not a function
 630
 631 getCallMethod name (LFBlackHole _) n_args
 632   = SlowCall    -- Presumably the black hole has by now
 633                 -- been updated, but we don't know with
 634                 -- what, so we slow call it
 635
 636 getCallMethod name (LFLetNoEscape 0) n_args
 637   = JumpToIt (enterReturnPtLabel (nameUnique name))
 638
 639 getCallMethod name (LFLetNoEscape arity) n_args
 640   | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
 641   | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
 642
 643 blackHoleOnEntry :: ClosureInfo -> Bool
 644 -- Static closures are never themselves black-holed.
 645 -- Updatable ones will be overwritten with a CAFList cell, which points to a
 646 -- black hole;
 647 -- Single-entry ones have no fvs to plug, and we trust they don't form part
 648 -- of a loop.
 649
 650 blackHoleOnEntry ConInfo{} = False
 651 blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
 652   | isStaticRep rep
 653   = False       -- Never black-hole a static closure
 654
 655   | otherwise
 656   = case lf_info of
 657         LFReEntrant _ _ _ _       -> False
 658         LFLetNoEscape _           -> False
 659         LFThunk _ no_fvs updatable _ _
 660           -> if updatable
 661              then not opt_OmitBlackHoling
 662              else opt_DoTickyProfiling || not no_fvs
 663                   -- the former to catch double entry,
 664                   -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
 665
 666         other -> panic "blackHoleOnEntry"       -- Should never happen
 667
 668 isStandardFormThunk :: LambdaFormInfo -> Bool
 669 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
 670 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _)       = True
 671 isStandardFormThunk other_lf_info                       = False
 672
 673 isKnownFun :: LambdaFormInfo -> Bool
 674 isKnownFun (LFReEntrant _ _ _ _) = True
 675 isKnownFun (LFLetNoEscape _) = True
 676 isKnownFun _ = False
 677 \end{code}
 678
 679 -----------------------------------------------------------------------------
 680 SRT-related stuff
 681
 682 \begin{code}
 683 staticClosureNeedsLink :: ClosureInfo -> Bool
 684 -- A static closure needs a link field to aid the GC when traversing
 685 -- the static closure graph.  But it only needs such a field if either
 686 --      a) it has an SRT
 687 --      b) it's a constructor with one or more pointer fields
 688 -- In case (b), the constructor's fields themselves play the role
 689 -- of the SRT.
 690 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
 691   = needsSRT srt
 692 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
 693   = not (isNullaryRepDataCon con) && not_nocaf_constr
 694   where
 695     not_nocaf_constr =
 696         case sm_rep of
 697            GenericRep _ _ _ ConstrNoCaf -> False
 698            _other                       -> True
 699 \end{code}
 700
 701 Avoiding generating entries and info tables
 702 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 703 At present, for every function we generate all of the following,
 704 just in case.  But they aren't always all needed, as noted below:
 705
 706 [NB1: all of this applies only to *functions*.  Thunks always
 707 have closure, info table, and entry code.]
 708
 709 [NB2: All are needed if the function is *exported*, just to play safe.]
 710
 711
 712 * Fast-entry code  ALWAYS NEEDED
 713
 714 * Slow-entry code
 715         Needed iff (a) we have any un-saturated calls to the function
 716         OR         (b) the function is passed as an arg
 717         OR         (c) we're in the parallel world and the function has free vars
 718                         [Reason: in parallel world, we always enter functions
 719                         with free vars via the closure.]
 720
 721 * The function closure
 722         Needed iff (a) we have any un-saturated calls to the function
 723         OR         (b) the function is passed as an arg
 724         OR         (c) if the function has free vars (ie not top level)
 725
 726   Why case (a) here?  Because if the arg-satis check fails,
 727   UpdatePAP stuffs a pointer to the function closure in the PAP.
 728   [Could be changed; UpdatePAP could stuff in a code ptr instead,
 729    but doesn't seem worth it.]
 730
 731   [NB: these conditions imply that we might need the closure
 732   without the slow-entry code.  Here's how.
 733
 734         f x y = let g w = ...x..y..w...
 735                 in
 736                 ...(g t)...
 737
 738   Here we need a closure for g which contains x and y,
 739   but since the calls are all saturated we just jump to the
 740   fast entry point for g, with R1 pointing to the closure for g.]
 741
 742
 743 * Standard info table
 744         Needed iff (a) we have any un-saturated calls to the function
 745         OR         (b) the function is passed as an arg
 746         OR         (c) the function has free vars (ie not top level)
 747
 748         NB.  In the sequential world, (c) is only required so that the function closure has
 749         an info table to point to, to keep the storage manager happy.
 750         If (c) alone is true we could fake up an info table by choosing
 751         one of a standard family of info tables, whose entry code just
 752         bombs out.
 753
 754         [NB In the parallel world (c) is needed regardless because
 755         we enter functions with free vars via the closure.]
 756
 757         If (c) is retained, then we'll sometimes generate an info table
 758         (for storage mgr purposes) without slow-entry code.  Then we need
 759         to use an error label in the info table to substitute for the absent
 760         slow entry code.
 761
 762 \begin{code}
 763 staticClosureRequired
 764         :: Name
 765         -> StgBinderInfo
 766         -> LambdaFormInfo
 767         -> Bool
 768 staticClosureRequired binder bndr_info
 769                       (LFReEntrant top_level _ _ _)     -- It's a function
 770   = ASSERT( isTopLevel top_level )
 771         -- Assumption: it's a top-level, no-free-var binding
 772         not (satCallsOnly bndr_info)
 773
 774 staticClosureRequired binder other_binder_info other_lf_info = True
 775 \end{code}
 776
 777 %************************************************************************
 778 %*                                                                      *
 779 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
 780 %*                                                                      *
 781 %************************************************************************
 782
 783 \begin{code}
 784
 785 isStaticClosure :: ClosureInfo -> Bool
 786 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
 787
 788 closureUpdReqd :: ClosureInfo -> Bool
 789 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
 790 closureUpdReqd ConInfo{} = False
 791
 792 lfUpdatable :: LambdaFormInfo -> Bool
 793 lfUpdatable (LFThunk _ _ upd _ _)  = upd
 794 lfUpdatable (LFBlackHole _)        = True
 795         -- Black-hole closures are allocated to receive the results of an
 796         -- alg case with a named default... so they need to be updated.
 797 lfUpdatable _ = False
 798
 799 closureIsThunk :: ClosureInfo -> Bool
 800 closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
 801 closureIsThunk ConInfo{} = False
 802
 803 closureSingleEntry :: ClosureInfo -> Bool
 804 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
 805 closureSingleEntry other_closure = False
 806
 807 closureReEntrant :: ClosureInfo -> Bool
 808 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
 809 closureReEntrant other_closure = False
 810
 811 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
 812 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
 813 isConstrClosure_maybe _                                   = Nothing
 814
 815 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
 816 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
 817 closureFunInfo _ = Nothing
 818
 819 lfFunInfo :: LambdaFormInfo ->  Maybe (Int, ArgDescr)
 820 lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
 821 lfFunInfo _                                 = Nothing
 822
 823 funTag :: ClosureInfo -> Int
 824 funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info
 825 funTag _ = 0
 826
 827 -- maybe this should do constructor tags too?
 828 funTagLFInfo :: LambdaFormInfo -> Int
 829 funTagLFInfo lf
 830     -- A function is tagged with its arity
 831   | Just (arity,_) <- lfFunInfo lf,
 832     Just tag <- tagForArity arity
 833   = tag
 834
 835     -- other closures (and unknown ones) are not tagged
 836   | otherwise
 837   = 0
 838
 839 tagForArity :: Int -> Maybe Int
 840 tagForArity i | i <= mAX_PTR_TAG = Just i
 841               | otherwise        = Nothing
 842 \end{code}
 843
 844 \begin{code}
 845 isToplevClosure :: ClosureInfo -> Bool
 846 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
 847   = case lf_info of
 848       LFReEntrant TopLevel _ _ _ -> True
 849       LFThunk TopLevel _ _ _ _   -> True
 850       other -> False
 851 isToplevClosure _ = False
 852 \end{code}
 853
 854 Label generation.
 855
 856 \begin{code}
 857 infoTableLabelFromCI :: ClosureInfo -> CLabel
 858 infoTableLabelFromCI (ClosureInfo { closureName = name,
 859                                     closureLFInfo = lf_info,
 860                                     closureSMRep = rep })
 861   = case lf_info of
 862         LFBlackHole info -> info
 863
 864         LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
 865                 mkSelectorInfoLabel upd_flag offset
 866
 867         LFThunk _ _ upd_flag (ApThunk arity) _ ->
 868                 mkApInfoTableLabel upd_flag arity
 869
 870         LFThunk{}      -> mkLocalInfoTableLabel name
 871
 872         LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name
 873
 874         other -> panic "infoTableLabelFromCI"
 875
 876 infoTableLabelFromCI (ConInfo { closureCon = con,
 877                                 closureSMRep = rep })
 878   | isStaticRep rep = mkStaticInfoTableLabel  name
 879   | otherwise       = mkConInfoTableLabel     name
 880   where
 881     name = dataConName con
 882
 883 -- ClosureInfo for a closure (as opposed to a constructor) is always local
 884 closureLabelFromCI (ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm
 885 closureLabelFromCI _ = panic "closureLabelFromCI"
 886
 887 -- thunkEntryLabel is a local help function, not exported.  It's used from both
 888 -- entryLabelFromCI and getCallMethod.
 889
 890 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
 891   = enterApLabel is_updatable arity
 892 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
 893   = enterSelectorLabel upd_flag offset
 894 thunkEntryLabel thunk_id _ is_updatable
 895   = enterIdLabel thunk_id
 896
 897 enterApLabel is_updatable arity
 898   | tablesNextToCode = mkApInfoTableLabel is_updatable arity
 899   | otherwise        = mkApEntryLabel is_updatable arity
 900
 901 enterSelectorLabel upd_flag offset
 902   | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
 903   | otherwise        = mkSelectorEntryLabel upd_flag offset
 904
 905 enterIdLabel id
 906   | tablesNextToCode = mkInfoTableLabel id
 907   | otherwise        = mkEntryLabel id
 908
 909 enterLocalIdLabel id
 910   | tablesNextToCode = mkLocalInfoTableLabel id
 911   | otherwise        = mkLocalEntryLabel id
 912
 913 enterReturnPtLabel name
 914   | tablesNextToCode = mkReturnInfoLabel name
 915   | otherwise        = mkReturnPtLabel name
 916 \end{code}
 917
 918
 919 We need a black-hole closure info to pass to @allocDynClosure@ when we
 920 want to allocate the black hole on entry to a CAF.  These are the only
 921 ways to build an LFBlackHole, maintaining the invariant that it really
 922 is a black hole and not something else.
 923
 924 \begin{code}
 925 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
 926                                        closureType = ty })
 927   = ClosureInfo { closureName   = nm,
 928                   closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
 929                   closureSMRep  = BlackHoleRep,
 930                   closureSRT    = NoC_SRT,
 931                   closureType   = ty,
 932                   closureDescr  = "" }
 933 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
 934
 935 seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
 936                                          closureType = ty })
 937   = ClosureInfo { closureName   = nm,
 938                   closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
 939                   closureSMRep  = BlackHoleRep,
 940                   closureSRT    = NoC_SRT,
 941                   closureType   = ty,
 942                   closureDescr  = ""  }
 943 seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
 944 \end{code}
 945
 946 %************************************************************************
 947 %*                                                                      *
 948 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
 949 %*                                                                      *
 950 %************************************************************************
 951
 952 Profiling requires two pieces of information to be determined for
 953 each closure's info table --- description and type.
 954
 955 The description is stored directly in the @CClosureInfoTable@ when the
 956 info table is built.
 957
 958 The type is determined from the type information stored with the @Id@
 959 in the closure info using @closureTypeDescr@.
 960
 961 \begin{code}
 962 closureValDescr, closureTypeDescr :: ClosureInfo -> String
 963 closureValDescr (ClosureInfo {closureDescr = descr})
 964   = descr
 965 closureValDescr (ConInfo {closureCon = con})
 966   = occNameString (getOccName con)
 967
 968 closureTypeDescr (ClosureInfo { closureType = ty })
 969   = getTyDescription ty
 970 closureTypeDescr (ConInfo { closureCon = data_con })
 971   = occNameString (getOccName (dataConTyCon data_con))
 972
 973 getTyDescription :: Type -> String
 974 getTyDescription ty
 975   = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
 976     case tau_ty of
 977       TyVarTy _              -> "*"
 978       AppTy fun _            -> getTyDescription fun
 979       FunTy _ res            -> '-' : '>' : fun_result res
 980       TyConApp tycon _       -> getOccString tycon
 981       NoteTy (FTVNote _) ty  -> getTyDescription ty
 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}