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