ghc/compiler/codeGen/ClosureInfo.lhs

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