ghc/compiler/codeGen/ClosureInfo.lhs

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