ghc/compiler/codeGen/ClosureInfo.lhs

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