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