ghc/compiler/codeGen/ClosureInfo.lhs

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