ghc/compiler/codeGen/ClosureInfo.lhs

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