compiler/codeGen/ClosureInfo.lhs

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