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