ghc/compiler/codeGen/ClosureInfo.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: ClosureInfo.lhs,v 1.47 2001/05/22 13:43:15 simonpj Exp $
   5 %
   6 \section[ClosureInfo]{Data structures which describe closures}
   7
   8 Much of the rationale for these things is in the ``details'' part of
   9 the STG paper.
  10
  11 \begin{code}
  12 module ClosureInfo (
  13         ClosureInfo, LambdaFormInfo, SMRep,     -- all abstract
  14         StandardFormInfo,
  15
  16         EntryConvention(..),
  17
  18         mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo,
  19         mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
  20         UpdateFlag,
  21
  22         closureSize, closureNonHdrSize,
  23         closureGoodStuffSize, closurePtrsSize,
  24         slopSize,
  25
  26         layOutDynClosure, layOutDynCon, layOutStaticClosure,
  27         layOutStaticNoFVClosure,
  28         mkVirtHeapOffsets,
  29
  30         nodeMustPointToIt, getEntryConvention,
  31         FCode, CgInfoDownwards, CgState,
  32
  33         blackHoleOnEntry,
  34
  35         staticClosureRequired,
  36         slowFunEntryCodeRequired, funInfoTableRequired,
  37
  38         closureName, infoTableLabelFromCI, fastLabelFromCI,
  39         closureLabelFromCI,
  40         entryLabelFromCI,
  41         closureLFInfo, closureSMRep, closureUpdReqd,
  42         closureSingleEntry, closureReEntrant, closureSemiTag,
  43         isStandardFormThunk,
  44         GenStgArg,
  45
  46         isToplevClosure,
  47         closureTypeDescr,               -- profiling
  48
  49         isStaticClosure,
  50         allocProfilingMsg,
  51         cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
  52         maybeSelectorInfo,
  53
  54         infoTblNeedsSRT,
  55         staticClosureNeedsLink,
  56         getSRTInfo
  57     ) where
  58
  59 #include "HsVersions.h"
  60
  61 import AbsCSyn          ( MagicId, node, VirtualHeapOffset, HeapOffset )
  62 import StgSyn
  63 import CgMonad
  64
  65 import Constants        ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
  66                           mAX_SPEC_FUN_SIZE, mAX_SPEC_THUNK_SIZE, mAX_SPEC_CONSTR_SIZE )
  67 import CgRetConv        ( assignRegs )
  68 import CLabel           ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
  69                           mkInfoTableLabel,
  70                           mkConInfoTableLabel,
  71                           mkCAFBlackHoleInfoTableLabel,
  72                           mkSECAFBlackHoleInfoTableLabel,
  73                           mkStaticInfoTableLabel, mkStaticConEntryLabel,
  74                           mkConEntryLabel, mkClosureLabel,
  75                           mkSelectorInfoLabel, mkSelectorEntryLabel,
  76                           mkApInfoTableLabel, mkApEntryLabel,
  77                           mkReturnPtLabel
  78                         )
  79 import CmdLineOpts      ( opt_SccProfilingOn, opt_OmitBlackHoling,
  80                           opt_Parallel, opt_DoTickyProfiling,
  81                           opt_SMP )
  82 import Id               ( Id, idType, idCgArity )
  83 import DataCon          ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
  84                           isNullaryDataCon, dataConName
  85                         )
  86 import TyCon            ( isBoxedTupleTyCon )
  87 import Name             ( Name, nameUnique, getOccName )
  88 import OccName          ( occNameUserString )
  89 import PprType          ( getTyDescription )
  90 import PrimRep          ( getPrimRepSize, separateByPtrFollowness, PrimRep )
  91 import SMRep            -- all of it
  92 import Type             ( isUnLiftedType, Type )
  93 import BasicTypes       ( TopLevelFlag(..), isNotTopLevel, isTopLevel )
  94 import Util             ( mapAccumL )
  95 import Outputable
  96 \end{code}
  97
  98 The ``wrapper'' data type for closure information:
  99
 100 \begin{code}
 101 data ClosureInfo
 102   = MkClosureInfo
 103         Name                    -- The thing bound to this closure
 104         LambdaFormInfo          -- info derivable from the *source*
 105         SMRep                   -- representation used by storage manager
 106 \end{code}
 107
 108 %************************************************************************
 109 %*                                                                      *
 110 \subsection[ClosureInfo-datatypes]{Data types for closure information}
 111 %*                                                                      *
 112 %************************************************************************
 113
 114 %************************************************************************
 115 %*                                                                      *
 116 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
 117 %*                                                                      *
 118 %************************************************************************
 119
 120 \begin{code}
 121 data LambdaFormInfo
 122   = LFReEntrant         -- Reentrant closure; used for PAPs too
 123         Type            -- Type of closure    (ToDo: remove)
 124         TopLevelFlag    -- True if top level
 125         !Int            -- Arity
 126         !Bool           -- True <=> no fvs
 127         CLabel          -- SRT label
 128         SRT             -- SRT info
 129
 130   | LFCon               -- Constructor
 131         DataCon         -- The constructor
 132         Bool            -- True <=> zero arity
 133
 134   | LFTuple             -- Tuples
 135         DataCon         -- The tuple constructor
 136         Bool            -- True <=> zero arity
 137
 138   | LFThunk             -- Thunk (zero arity)
 139         Type            -- Type of the thunk   (ToDo: remove)
 140         TopLevelFlag
 141         !Bool           -- True <=> no free vars
 142         Bool            -- True <=> updatable (i.e., *not* single-entry)
 143         StandardFormInfo
 144         CLabel          -- SRT label
 145         SRT             -- SRT info
 146
 147   | LFArgument          -- Used for function arguments.  We know nothing about
 148                         -- this closure.  Treat like updatable "LFThunk"...
 149
 150   | LFImported          -- Used for imported things.  We know nothing about this
 151                         -- closure.  Treat like updatable "LFThunk"...
 152                         -- Imported things which we do know something about use
 153                         -- one of the other LF constructors (eg LFReEntrant for
 154                         -- known functions)
 155
 156   | LFLetNoEscape       -- See LetNoEscape module for precise description of
 157                         -- these "lets".
 158         Int             -- arity;
 159
 160   | LFBlackHole         -- Used for the closures allocated to hold the result
 161                         -- of a CAF.  We want the target of the update frame to
 162                         -- be in the heap, so we make a black hole to hold it.
 163         CLabel          -- Flavour (info label, eg CAF_BLACKHOLE_info).
 164
 165
 166 data StandardFormInfo   -- Tells whether this thunk has one of a small number
 167                         -- of standard forms
 168
 169   = NonStandardThunk    -- No, it isn't
 170
 171   | SelectorThunk
 172        Int              -- 0-origin offset of ak within the "goods" of
 173                         -- constructor (Recall that the a1,...,an may be laid
 174                         -- out in the heap in a non-obvious order.)
 175
 176 {- A SelectorThunk is of form
 177
 178      case x of
 179        con a1,..,an -> ak
 180
 181    and the constructor is from a single-constr type.
 182 -}
 183
 184   | ApThunk
 185         Int             -- arity
 186
 187 {- An ApThunk is of form
 188
 189         x1 ... xn
 190
 191    The code for the thunk just pushes x2..xn on the stack and enters x1.
 192    There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
 193    in the RTS to save space.
 194 -}
 195
 196 \end{code}
 197
 198 %************************************************************************
 199 %*                                                                      *
 200 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
 201 %*                                                                      *
 202 %************************************************************************
 203
 204 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
 205
 206 \begin{code}
 207 mkClosureLFInfo :: Id           -- The binder
 208                 -> TopLevelFlag -- True of top level
 209                 -> [Id]         -- Free vars
 210                 -> UpdateFlag   -- Update flag
 211                 -> [Id]         -- Args
 212                 -> CLabel       -- SRT label
 213                 -> SRT          -- SRT info
 214                 -> LambdaFormInfo
 215
 216 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) srt_label srt -- Non-empty args
 217   = LFReEntrant (idType bndr) top (length args) (null fvs) srt_label srt
 218
 219 mkClosureLFInfo bndr top fvs ReEntrant [] srt_label srt
 220   = LFReEntrant (idType bndr) top 0 (null fvs) srt_label srt
 221
 222 mkClosureLFInfo bndr top fvs upd_flag [] srt_label srt
 223 #ifdef DEBUG
 224   | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
 225 #endif
 226   | otherwise
 227   = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
 228         srt_label srt
 229   where
 230     ty = idType bndr
 231 \end{code}
 232
 233 @mkConLFInfo@ is similar, for constructors.
 234
 235 \begin{code}
 236 mkConLFInfo :: DataCon -> LambdaFormInfo
 237
 238 mkConLFInfo con
 239   = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
 240     (if isBoxedTupleTyCon (dataConTyCon con) then LFTuple else LFCon)
 241         con (isNullaryDataCon con)
 242
 243 mkSelectorLFInfo rhs_ty offset updatable
 244   = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
 245         (error "mkSelectorLFInfo: no srt label")
 246         (error "mkSelectorLFInfo: no srt")
 247
 248 mkApLFInfo rhs_ty upd_flag arity
 249   = LFThunk rhs_ty NotTopLevel (arity == 0) (isUpdatable upd_flag)
 250         (ApThunk arity)
 251         (error "mkApLFInfo: no srt label")
 252         (error "mkApLFInfo: no srt")
 253 \end{code}
 254
 255 Miscellaneous LF-infos.
 256
 257 \begin{code}
 258 mkLFArgument    = LFArgument
 259 mkLFLetNoEscape = LFLetNoEscape
 260
 261 mkLFImported :: Id -> LambdaFormInfo
 262 mkLFImported id
 263   = case idCgArity id of
 264       n | n > 0 -> LFReEntrant (idType id) TopLevel n True  -- n > 0
 265                        (error "mkLFImported: no srt label")
 266                        (error "mkLFImported: no srt")
 267       other -> LFImported       -- Not sure of exact arity
 268 \end{code}
 269
 270 %************************************************************************
 271 %*                                                                      *
 272 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
 273 %*                                                                      *
 274 %************************************************************************
 275
 276 \begin{code}
 277 closureSize :: ClosureInfo -> HeapOffset
 278 closureSize cl_info@(MkClosureInfo _ _ sm_rep)
 279   = fixedHdrSize + closureNonHdrSize cl_info
 280
 281 closureNonHdrSize :: ClosureInfo -> Int
 282 closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
 283   = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info)
 284     --ToDo: pass lf_info?
 285   where
 286     tot_wds = closureGoodStuffSize cl_info
 287
 288 closureGoodStuffSize :: ClosureInfo -> Int
 289 closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
 290   = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
 291     in  ptrs + nonptrs
 292
 293 closurePtrsSize :: ClosureInfo -> Int
 294 closurePtrsSize (MkClosureInfo _ _ sm_rep)
 295   = let (ptrs, _) = sizes_from_SMRep sm_rep
 296     in  ptrs
 297
 298 -- not exported:
 299 sizes_from_SMRep :: SMRep -> (Int,Int)
 300 sizes_from_SMRep (GenericRep _ ptrs nonptrs _)   = (ptrs, nonptrs)
 301 sizes_from_SMRep BlackHoleRep                    = (0, 0)
 302 \end{code}
 303
 304 Computing slop size.  WARNING: this looks dodgy --- it has deep
 305 knowledge of what the storage manager does with the various
 306 representations...
 307
 308 Slop Requirements:
 309 \begin{itemize}
 310 \item
 311 Updateable closures must be @mIN_UPD_SIZE@.
 312         \begin{itemize}
 313         \item
 314         Indirections require 1 word
 315         \item
 316         Appels collector indirections 2 words
 317         \end{itemize}
 318 THEREFORE: @mIN_UPD_SIZE = 2@.
 319
 320 \item
 321 Collectable closures which are allocated in the heap
 322 must be @mIN_SIZE_NonUpdHeapObject@.
 323
 324 Copying collector forward pointer requires 1 word
 325
 326 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
 327 \end{itemize}
 328
 329 Static closures have an extra ``static link field'' at the end, but we
 330 don't bother taking that into account here.
 331
 332 \begin{code}
 333 slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
 334   = computeSlopSize (closureGoodStuffSize cl_info) sm_rep
 335          (closureUpdReqd cl_info)
 336
 337 computeSlopSize :: Int -> SMRep -> Bool -> Int
 338
 339 computeSlopSize tot_wds (GenericRep _ _ _ _) True               -- Updatable
 340   = max 0 (mIN_UPD_SIZE - tot_wds)
 341
 342 computeSlopSize tot_wds (GenericRep True _ _ _) False   -- Non updatable
 343   = 0                                                   -- Static
 344
 345 computeSlopSize tot_wds (GenericRep False _ _ _) False  -- Non updatable
 346   = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)         -- Dynamic
 347
 348 computeSlopSize tot_wds BlackHoleRep _                  -- Updatable
 349   = max 0 (mIN_UPD_SIZE - tot_wds)
 350 \end{code}
 351
 352 %************************************************************************
 353 %*                                                                      *
 354 \subsection[layOutDynClosure]{Lay out a dynamic closure}
 355 %*                                                                      *
 356 %************************************************************************
 357
 358 \begin{code}
 359 layOutDynClosure, layOutStaticClosure
 360         :: Name                     -- STG identifier of this closure
 361         -> (a -> PrimRep)           -- how to get a PrimRep for the fields
 362         -> [a]                      -- the "things" being layed out
 363         -> LambdaFormInfo           -- what sort of closure it is
 364         -> (ClosureInfo,            -- info about the closure
 365             [(a, VirtualHeapOffset)])   -- things w/ offsets pinned on them
 366
 367 layOutDynClosure name kind_fn things lf_info
 368   = (MkClosureInfo name lf_info sm_rep,
 369      things_w_offsets)
 370   where
 371     (tot_wds,            -- #ptr_wds + #nonptr_wds
 372      ptr_wds,            -- #ptr_wds
 373      things_w_offsets) = mkVirtHeapOffsets kind_fn things
 374     sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
 375 \end{code}
 376
 377 A wrapper for when used with data constructors:
 378
 379 \begin{code}
 380 layOutDynCon :: DataCon
 381              -> (a -> PrimRep)
 382              -> [a]
 383              -> (ClosureInfo, [(a,VirtualHeapOffset)])
 384
 385 layOutDynCon con kind_fn args
 386   = layOutDynClosure (dataConName con) kind_fn args (mkConLFInfo con)
 387 \end{code}
 388
 389 %************************************************************************
 390 %*                                                                      *
 391 \subsection[layOutStaticClosure]{Lay out a static closure}
 392 %*                                                                      *
 393 %************************************************************************
 394
 395 layOutStaticClosure is only used for laying out static constructors at
 396 the moment.
 397
 398 Static closures for functions are laid out using
 399 layOutStaticNoFVClosure.
 400
 401 \begin{code}
 402 layOutStaticClosure name kind_fn things lf_info
 403   = (MkClosureInfo name lf_info
 404         (GenericRep is_static ptr_wds (tot_wds - ptr_wds) closure_type),
 405      things_w_offsets)
 406   where
 407     (tot_wds,            -- #ptr_wds + #nonptr_wds
 408      ptr_wds,            -- #ptr_wds
 409      things_w_offsets) = mkVirtHeapOffsets kind_fn things
 410
 411     -- constructors with no pointer fields will definitely be NOCAF things.
 412     -- this is a compromise until we can generate both kinds of constructor
 413     -- (a normal static kind and the NOCAF_STATIC kind).
 414     closure_type = getClosureType is_static tot_wds ptr_wds lf_info
 415     is_static    = True
 416
 417 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
 418 layOutStaticNoFVClosure name lf_info
 419   = MkClosureInfo name lf_info (GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info))
 420   where
 421     is_static = True
 422 \end{code}
 423
 424 %************************************************************************
 425 %*                                                                      *
 426 \subsection[SMreps]{Choosing SM reps}
 427 %*                                                                      *
 428 %************************************************************************
 429
 430 \begin{code}
 431 chooseDynSMRep
 432         :: LambdaFormInfo
 433         -> Int -> Int           -- Tot wds, ptr wds
 434         -> SMRep
 435
 436 chooseDynSMRep lf_info tot_wds ptr_wds
 437   = let
 438          is_static    = False
 439          nonptr_wds   = tot_wds - ptr_wds
 440          closure_type = getClosureType is_static tot_wds ptr_wds lf_info
 441     in
 442     GenericRep is_static ptr_wds nonptr_wds closure_type
 443
 444 -- we *do* get non-updatable top-level thunks sometimes.  eg. f = g
 445 -- gets compiled to a jump to g (if g has non-zero arity), instead of
 446 -- messing around with update frames and PAPs.  We set the closure type
 447 -- to FUN_STATIC in this case.
 448
 449 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
 450 getClosureType is_static tot_wds ptr_wds lf_info
 451   = case lf_info of
 452         LFCon con zero_arity
 453                 | is_static && ptr_wds == 0            -> CONSTR_NOCAF
 454                 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
 455                 | otherwise                            -> CONSTR
 456
 457         LFTuple _ zero_arity
 458                 | is_static && ptr_wds == 0            -> CONSTR_NOCAF
 459                 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
 460                 | otherwise                            -> CONSTR
 461
 462         LFReEntrant _ _ _ _ _ _
 463                 | specialised_rep mAX_SPEC_FUN_SIZE -> FUN_p_n
 464                 | otherwise                         -> FUN
 465
 466         LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
 467
 468         LFThunk _ _ _ _ _ _ _
 469                 | specialised_rep mAX_SPEC_THUNK_SIZE -> THUNK_p_n
 470                 | otherwise                           -> THUNK
 471
 472         _ -> panic "getClosureType"
 473   where
 474     specialised_rep max_size =  not is_static
 475                              && tot_wds > 0
 476                              && tot_wds <= max_size
 477 \end{code}
 478
 479 %************************************************************************
 480 %*                                                                      *
 481 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
 482 %*                                                                      *
 483 %************************************************************************
 484
 485 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
 486 smaller offsets than the unboxed things, and furthermore, the offsets in
 487 the result list
 488
 489 \begin{code}
 490 mkVirtHeapOffsets ::
 491           (a -> PrimRep)        -- To be able to grab kinds;
 492                                 --      w/ a kind, we can find boxedness
 493           -> [a]                -- Things to make offsets for
 494           -> (Int,              -- *Total* number of words allocated
 495               Int,              -- Number of words allocated for *pointers*
 496               [(a, VirtualHeapOffset)])
 497                                 -- Things with their offsets from start of
 498                                 --  object in order of increasing offset
 499
 500 -- First in list gets lowest offset, which is initial offset + 1.
 501
 502 mkVirtHeapOffsets kind_fun things
 503   = let (ptrs, non_ptrs)              = separateByPtrFollowness kind_fun things
 504         (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
 505         (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
 506     in
 507         (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
 508   where
 509     computeOffset wds_so_far thing
 510       = (wds_so_far + (getPrimRepSize . kind_fun) thing,
 511          (thing, fixedHdrSize + wds_so_far)
 512         )
 513 \end{code}
 514
 515 %************************************************************************
 516 %*                                                                      *
 517 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
 518 %*                                                                      *
 519 %************************************************************************
 520
 521 Be sure to see the stg-details notes about these...
 522
 523 \begin{code}
 524 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
 525 nodeMustPointToIt lf_info
 526
 527   = case lf_info of
 528         LFReEntrant ty top arity no_fvs _ _ -> returnFC (
 529             not no_fvs ||   -- Certainly if it has fvs we need to point to it
 530             isNotTopLevel top
 531                     -- If it is not top level we will point to it
 532                     --   We can have a \r closure with no_fvs which
 533                     --   is not top level as special case cgRhsClosure
 534                     --   has been dissabled in favour of let floating
 535
 536                 -- For lex_profiling we also access the cost centre for a
 537                 -- non-inherited function i.e. not top level
 538                 -- the  not top  case above ensures this is ok.
 539             )
 540
 541         LFCon   _ zero_arity -> returnFC True
 542         LFTuple _ zero_arity -> returnFC True
 543
 544         -- Strictly speaking, the above two don't need Node to point
 545         -- to it if the arity = 0.  But this is a *really* unlikely
 546         -- situation.  If we know it's nil (say) and we are entering
 547         -- it. Eg: let x = [] in x then we will certainly have inlined
 548         -- x, since nil is a simple atom.  So we gain little by not
 549         -- having Node point to known zero-arity things.  On the other
 550         -- hand, we do lose something; Patrick's code for figuring out
 551         -- when something has been updated but not entered relies on
 552         -- having Node point to the result of an update.  SLPJ
 553         -- 27/11/92.
 554
 555         LFThunk _ _ no_fvs updatable NonStandardThunk _ _
 556           -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
 557
 558           -- For the non-updatable (single-entry case):
 559           --
 560           -- True if has fvs (in which case we need access to them, and we
 561           --                should black-hole it)
 562           -- or profiling (in which case we need to recover the cost centre
 563           --             from inside it)
 564
 565         LFThunk _ _ no_fvs updatable some_standard_form_thunk _ _
 566           -> returnFC True
 567           -- Node must point to any standard-form thunk.
 568
 569         LFArgument    -> returnFC True
 570         LFImported    -> returnFC True
 571         LFBlackHole _ -> returnFC True
 572                     -- BH entry may require Node to point
 573
 574         LFLetNoEscape _ -> returnFC False
 575 \end{code}
 576
 577 The entry conventions depend on the type of closure being entered,
 578 whether or not it has free variables, and whether we're running
 579 sequentially or in parallel.
 580
 581 \begin{tabular}{lllll}
 582 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
 583 Unknown                         & no & yes & stack      & node \\
 584 Known fun ($\ge$ 1 arg), no fvs         & no & no  & registers  & fast entry (enough args) \\
 585 \ & \ & \ & \                                           & slow entry (otherwise) \\
 586 Known fun ($\ge$ 1 arg), fvs    & no & yes & registers  & fast entry (enough args) \\
 587 0 arg, no fvs @\r,\s@           & no & no  & n/a        & direct entry \\
 588 0 arg, no fvs @\u@              & no & yes & n/a        & node \\
 589 0 arg, fvs @\r,\s@              & no & yes & n/a        & direct entry \\
 590 0 arg, fvs @\u@                 & no & yes & n/a        & node \\
 591
 592 Unknown                         & yes & yes & stack     & node \\
 593 Known fun ($\ge$ 1 arg), no fvs         & yes & no  & registers & fast entry (enough args) \\
 594 \ & \ & \ & \                                           & slow entry (otherwise) \\
 595 Known fun ($\ge$ 1 arg), fvs    & yes & yes & registers & node \\
 596 0 arg, no fvs @\r,\s@           & yes & no  & n/a       & direct entry \\
 597 0 arg, no fvs @\u@              & yes & yes & n/a       & node \\
 598 0 arg, fvs @\r,\s@              & yes & yes & n/a       & node \\
 599 0 arg, fvs @\u@                 & yes & yes & n/a       & node\\
 600 \end{tabular}
 601
 602 When black-holing, single-entry closures could also be entered via node
 603 (rather than directly) to catch double-entry.
 604
 605 \begin{code}
 606 data EntryConvention
 607   = ViaNode                             -- The "normal" convention
 608
 609   | StdEntry CLabel                     -- Jump to this code, with args on stack
 610
 611   | DirectEntry                         -- Jump directly, with args in regs
 612         CLabel                          --   The code label
 613         Int                             --   Its arity
 614         [MagicId]                       --   Its register assignments
 615                                         --      (possibly empty)
 616
 617 getEntryConvention :: Name              -- Function being applied
 618                    -> LambdaFormInfo    -- Its info
 619                    -> [PrimRep]         -- Available arguments
 620                    -> FCode EntryConvention
 621
 622 getEntryConvention name lf_info arg_kinds
 623  =  nodeMustPointToIt lf_info   `thenFC` \ node_points ->
 624     returnFC (
 625
 626     -- if we're parallel, then we must always enter via node.  The reason
 627     -- is that the closure may have been fetched since we allocated it.
 628
 629     if (node_points && opt_Parallel) then ViaNode else
 630
 631     -- Commented out by SDM after futher thoughts:
 632     --   - the only closure type that can be blackholed is a thunk
 633     --   - we already enter thunks via node (unless the closure is
 634     --     non-updatable, in which case why is it being re-entered...)
 635
 636     case lf_info of
 637
 638         LFReEntrant _ _ arity _ _ _ ->
 639             if arity == 0 || (length arg_kinds) < arity then
 640                 StdEntry (mkStdEntryLabel name)
 641             else
 642                 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
 643           where
 644             (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
 645             live_regs = if node_points then [node] else []
 646
 647         LFCon con True{-zero_arity-}
 648               -- a real constructor.  Don't bother entering it, just jump
 649               -- to the constructor entry code directly.
 650                           -> --false:ASSERT (null arg_kinds)
 651                              -- Should have no args (meaning what?)
 652                              StdEntry (mkStaticConEntryLabel (dataConName con))
 653
 654         LFCon con False{-non-zero_arity-}
 655                           -> --false:ASSERT (null arg_kinds)
 656                              -- Should have no args (meaning what?)
 657                              StdEntry (mkConEntryLabel (dataConName con))
 658
 659         LFTuple tup zero_arity
 660                           -> --false:ASSERT (null arg_kinds)
 661                              -- Should have no args (meaning what?)
 662                              StdEntry (mkConEntryLabel (dataConName tup))
 663
 664         LFThunk _ _ _ updatable std_form_info _ _
 665           -> if updatable || opt_DoTickyProfiling  -- to catch double entry
 666                 || opt_SMP  -- always enter via node on SMP, since the
 667                             -- thunk might have been blackholed in the
 668                             -- meantime.
 669              then ViaNode
 670              else StdEntry (thunkEntryLabel name std_form_info updatable)
 671
 672         LFArgument    -> ViaNode
 673         LFImported    -> ViaNode
 674         LFBlackHole _ -> ViaNode -- Presumably the black hole has by now
 675                                  -- been updated, but we don't know with
 676                                  -- what, so we enter via Node
 677
 678         LFLetNoEscape 0
 679           -> StdEntry (mkReturnPtLabel (nameUnique name))
 680
 681         LFLetNoEscape arity
 682           -> if (arity /= length arg_kinds) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
 683              DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
 684          where
 685             (arg_regs, _) = assignRegs [] arg_kinds
 686             -- node never points to a LetNoEscape, see above --SDM
 687             --live_regs     = if node_points then [node] else []
 688     )
 689
 690 blackHoleOnEntry :: ClosureInfo -> Bool
 691
 692 -- Static closures are never themselves black-holed.
 693 -- Updatable ones will be overwritten with a CAFList cell, which points to a
 694 -- black hole;
 695 -- Single-entry ones have no fvs to plug, and we trust they don't form part
 696 -- of a loop.
 697
 698 blackHoleOnEntry (MkClosureInfo _ _ rep)
 699   | isStaticRep rep
 700   = False
 701         -- Never black-hole a static closure
 702
 703 blackHoleOnEntry (MkClosureInfo _ lf_info _)
 704   = case lf_info of
 705         LFReEntrant _ _ _ _ _ _   -> False
 706         LFLetNoEscape _           -> False
 707         LFThunk _ _ no_fvs updatable _ _ _
 708           -> if updatable
 709              then not opt_OmitBlackHoling
 710              else opt_DoTickyProfiling || not no_fvs
 711                   -- the former to catch double entry,
 712                   -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
 713
 714         other -> panic "blackHoleOnEntry"       -- Should never happen
 715
 716 isStandardFormThunk :: LambdaFormInfo -> Bool
 717
 718 isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _) _ _) = True
 719 isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _) _ _)       = True
 720 isStandardFormThunk other_lf_info                           = False
 721
 722 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ _
 723                         (SelectorThunk offset) _ _) _) = Just offset
 724 maybeSelectorInfo _ = Nothing
 725 \end{code}
 726
 727 -----------------------------------------------------------------------------
 728 SRT-related stuff
 729
 730
 731 \begin{code}
 732 infoTblNeedsSRT :: ClosureInfo -> Bool
 733 infoTblNeedsSRT (MkClosureInfo _ info _) =
 734   case info of
 735     LFThunk _ _ _ _ _ _ NoSRT   -> False
 736     LFThunk _ _ _ _ _ _ _       -> True
 737
 738     LFReEntrant _ _ _ _ _ NoSRT -> False
 739     LFReEntrant _ _ _ _ _ _     -> True
 740
 741     _ -> False
 742
 743 staticClosureNeedsLink :: ClosureInfo -> Bool
 744 staticClosureNeedsLink (MkClosureInfo _ info _) =
 745   case info of
 746     LFThunk _ _ _ _ _ _ NoSRT   -> False
 747     LFReEntrant _ _ _ _ _ NoSRT -> False
 748     LFCon _ True                -> False -- zero arity constructors
 749     _ -> True
 750
 751 getSRTInfo :: ClosureInfo -> (CLabel, SRT)
 752 getSRTInfo  (MkClosureInfo _ info _) =
 753   case info of
 754     LFThunk _ _ _ _ _ lbl srt   -> (lbl,srt)
 755     LFReEntrant _ _ _ _ lbl srt -> (lbl,srt)
 756     _ -> panic "getSRTInfo"
 757 \end{code}
 758
 759 Avoiding generating entries and info tables
 760 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 761 At present, for every function we generate all of the following,
 762 just in case.  But they aren't always all needed, as noted below:
 763
 764 [NB1: all of this applies only to *functions*.  Thunks always
 765 have closure, info table, and entry code.]
 766
 767 [NB2: All are needed if the function is *exported*, just to play safe.]
 768
 769
 770 * Fast-entry code  ALWAYS NEEDED
 771
 772 * Slow-entry code
 773         Needed iff (a) we have any un-saturated calls to the function
 774         OR         (b) the function is passed as an arg
 775         OR         (c) we're in the parallel world and the function has free vars
 776                         [Reason: in parallel world, we always enter functions
 777                         with free vars via the closure.]
 778
 779 * The function closure
 780         Needed iff (a) we have any un-saturated calls to the function
 781         OR         (b) the function is passed as an arg
 782         OR         (c) if the function has free vars (ie not top level)
 783
 784   Why case (a) here?  Because if the arg-satis check fails,
 785   UpdatePAP stuffs a pointer to the function closure in the PAP.
 786   [Could be changed; UpdatePAP could stuff in a code ptr instead,
 787    but doesn't seem worth it.]
 788
 789   [NB: these conditions imply that we might need the closure
 790   without the slow-entry code.  Here's how.
 791
 792         f x y = let g w = ...x..y..w...
 793                 in
 794                 ...(g t)...
 795
 796   Here we need a closure for g which contains x and y,
 797   but since the calls are all saturated we just jump to the
 798   fast entry point for g, with R1 pointing to the closure for g.]
 799
 800
 801 * Standard info table
 802         Needed iff (a) we have any un-saturated calls to the function
 803         OR         (b) the function is passed as an arg
 804         OR         (c) the function has free vars (ie not top level)
 805
 806         NB.  In the sequential world, (c) is only required so that the function closure has
 807         an info table to point to, to keep the storage manager happy.
 808         If (c) alone is true we could fake up an info table by choosing
 809         one of a standard family of info tables, whose entry code just
 810         bombs out.
 811
 812         [NB In the parallel world (c) is needed regardless because
 813         we enter functions with free vars via the closure.]
 814
 815         If (c) is retained, then we'll sometimes generate an info table
 816         (for storage mgr purposes) without slow-entry code.  Then we need
 817         to use an error label in the info table to substitute for the absent
 818         slow entry code.
 819
 820 \begin{code}
 821 staticClosureRequired
 822         :: Name
 823         -> StgBinderInfo
 824         -> LambdaFormInfo
 825         -> Bool
 826 staticClosureRequired binder bndr_info
 827                       (LFReEntrant _ top_level _ _ _ _) -- It's a function
 828   = ASSERT( isTopLevel top_level )
 829         -- Assumption: it's a top-level, no-free-var binding
 830         not (satCallsOnly bndr_info)
 831
 832 staticClosureRequired binder other_binder_info other_lf_info = True
 833
 834 slowFunEntryCodeRequired        -- Assumption: it's a function, not a thunk.
 835         :: Name
 836         -> StgBinderInfo
 837         -> EntryConvention
 838         -> Bool
 839 slowFunEntryCodeRequired binder bndr_info entry_conv
 840   =    not (satCallsOnly bndr_info)
 841     || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
 842             {- The last case deals with the parallel world; a function usually
 843                as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
 844
 845 funInfoTableRequired
 846         :: Name
 847         -> StgBinderInfo
 848         -> LambdaFormInfo
 849         -> Bool
 850 funInfoTableRequired binder bndr_info (LFReEntrant _ top_level _ _ _ _)
 851   =    isNotTopLevel top_level
 852     || not (satCallsOnly bndr_info)
 853
 854 funInfoTableRequired other_binder_info binder other_lf_info = True
 855 \end{code}
 856
 857 %************************************************************************
 858 %*                                                                      *
 859 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
 860 %*                                                                      *
 861 %************************************************************************
 862
 863 \begin{code}
 864
 865 isStaticClosure :: ClosureInfo -> Bool
 866 isStaticClosure  (MkClosureInfo _ _ rep) = isStaticRep  rep
 867
 868 closureName :: ClosureInfo -> Name
 869 closureName (MkClosureInfo name _ _) = name
 870
 871 closureSMRep :: ClosureInfo -> SMRep
 872 closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
 873
 874 closureLFInfo :: ClosureInfo -> LambdaFormInfo
 875 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
 876
 877 closureUpdReqd :: ClosureInfo -> Bool
 878 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = upd
 879 closureUpdReqd (MkClosureInfo _ (LFBlackHole _) _)           = True
 880         -- Black-hole closures are allocated to receive the results of an
 881         -- alg case with a named default... so they need to be updated.
 882 closureUpdReqd other_closure                           = False
 883
 884 closureSingleEntry :: ClosureInfo -> Bool
 885 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = not upd
 886 closureSingleEntry other_closure                           = False
 887
 888 closureReEntrant :: ClosureInfo -> Bool
 889 closureReEntrant (MkClosureInfo _ (LFReEntrant _ _ _ _ _ _) _) = True
 890 closureReEntrant other_closure = False
 891 \end{code}
 892
 893 \begin{code}
 894 closureSemiTag :: ClosureInfo -> Maybe Int
 895 closureSemiTag (MkClosureInfo _ lf_info _)
 896   = case lf_info of
 897       LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)
 898       LFTuple _ _      -> Just 0
 899       _                -> Nothing
 900 \end{code}
 901
 902 \begin{code}
 903 isToplevClosure :: ClosureInfo -> Bool
 904
 905 isToplevClosure (MkClosureInfo _ lf_info _)
 906   = case lf_info of
 907       LFReEntrant _ TopLevel _ _ _ _ -> True
 908       LFThunk _ TopLevel _ _ _ _ _   -> True
 909       other -> False
 910 \end{code}
 911
 912 Label generation.
 913
 914 \begin{code}
 915 fastLabelFromCI :: ClosureInfo -> CLabel
 916 fastLabelFromCI (MkClosureInfo name (LFReEntrant _ _ arity _ _ _) _)
 917   = mkFastEntryLabel name arity
 918
 919 fastLabelFromCI (MkClosureInfo name _ _)
 920   = pprPanic "fastLabelFromCI" (ppr name)
 921
 922 infoTableLabelFromCI :: ClosureInfo -> CLabel
 923 infoTableLabelFromCI (MkClosureInfo id lf_info rep)
 924   = case lf_info of
 925         LFCon con _      -> mkConInfoPtr con rep
 926         LFTuple tup _    -> mkConInfoPtr tup rep
 927
 928         LFBlackHole info -> info
 929
 930         LFThunk _ _ _ upd_flag (SelectorThunk offset) _ _ ->
 931                 mkSelectorInfoLabel upd_flag offset
 932
 933         LFThunk _ _ _ upd_flag (ApThunk arity) _ _ ->
 934                 mkApInfoTableLabel upd_flag arity
 935
 936         other -> {-NO: if isStaticRep rep
 937                  then mkStaticInfoTableLabel id
 938                  else -} mkInfoTableLabel id
 939
 940 mkConInfoPtr :: DataCon -> SMRep -> CLabel
 941 mkConInfoPtr con rep
 942   | isStaticRep rep = mkStaticInfoTableLabel  name
 943   | otherwise       = mkConInfoTableLabel     name
 944   where
 945     name = dataConName con
 946
 947 mkConEntryPtr :: DataCon -> SMRep -> CLabel
 948 mkConEntryPtr con rep
 949   | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
 950   | otherwise       = mkConEntryLabel       (dataConName con)
 951
 952 closureLabelFromCI (MkClosureInfo id _ other_rep)   = mkClosureLabel id
 953
 954 entryLabelFromCI :: ClosureInfo -> CLabel
 955 entryLabelFromCI (MkClosureInfo id lf_info rep)
 956   = case lf_info of
 957         LFThunk _ _ _ upd_flag std_form_info _ _ -> thunkEntryLabel id std_form_info upd_flag
 958         LFCon con _                          -> mkConEntryPtr con rep
 959         LFTuple tup _                        -> mkConEntryPtr tup rep
 960         other                                -> mkStdEntryLabel id
 961
 962 -- thunkEntryLabel is a local help function, not exported.  It's used from both
 963 -- entryLabelFromCI and getEntryConvention.
 964
 965 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
 966   = mkApEntryLabel is_updatable arity
 967 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
 968   = mkSelectorEntryLabel upd_flag offset
 969 thunkEntryLabel thunk_id _ is_updatable
 970   = mkStdEntryLabel thunk_id
 971 \end{code}
 972
 973 \begin{code}
 974 allocProfilingMsg :: ClosureInfo -> FAST_STRING
 975
 976 allocProfilingMsg (MkClosureInfo _ lf_info _)
 977   = case lf_info of
 978       LFReEntrant _ _ _ _ _ _   -> SLIT("TICK_ALLOC_FUN")
 979       LFCon _ _                 -> SLIT("TICK_ALLOC_CON")
 980       LFTuple _ _               -> SLIT("TICK_ALLOC_CON")
 981       LFThunk _ _ _ True _ _ _  -> SLIT("TICK_ALLOC_UP_THK")  -- updatable
 982       LFThunk _ _ _ False _ _ _ -> SLIT("TICK_ALLOC_SE_THK")  -- nonupdatable
 983       LFBlackHole _             -> SLIT("TICK_ALLOC_BH")
 984       LFImported                -> panic "TICK_ALLOC_IMP"
 985 \end{code}
 986
 987 We need a black-hole closure info to pass to @allocDynClosure@ when we
 988 want to allocate the black hole on entry to a CAF.  These are the only
 989 ways to build an LFBlackHole, maintaining the invariant that it really
 990 is a black hole and not something else.
 991
 992 \begin{code}
 993 cafBlackHoleClosureInfo (MkClosureInfo name _ _)
 994   = MkClosureInfo name (LFBlackHole mkCAFBlackHoleInfoTableLabel) BlackHoleRep
 995
 996 seCafBlackHoleClosureInfo (MkClosureInfo name _ _)
 997   = MkClosureInfo name (LFBlackHole mkSECAFBlackHoleInfoTableLabel) BlackHoleRep
 998 \end{code}
 999
1000 %************************************************************************
1001 %*                                                                      *
1002 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1003 %*                                                                      *
1004 %************************************************************************
1005
1006 Profiling requires two pieces of information to be determined for
1007 each closure's info table --- description and type.
1008
1009 The description is stored directly in the @CClosureInfoTable@ when the
1010 info table is built.
1011
1012 The type is determined from the type information stored with the @Id@
1013 in the closure info using @closureTypeDescr@.
1014
1015 \begin{code}
1016 closureTypeDescr :: ClosureInfo -> String
1017 closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _ _ _) _)
1018   = getTyDescription ty
1019 closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _ _ _) _)
1020   = getTyDescription ty
1021 closureTypeDescr (MkClosureInfo name (LFCon data_con _) _)
1022   = occNameUserString (getOccName (dataConTyCon data_con))
1023 closureTypeDescr (MkClosureInfo name lf _)
1024   = showSDoc (ppr name)
1025 \end{code}
1026