ghc/compiler/codeGen/ClosureInfo.lhs

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