ghc/compiler/codeGen/ClosureInfo.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 % $Id: ClosureInfo.lhs,v 1.41 2000/04/05 15:17:38 simonmar Exp $
   5 %
   6 \section[ClosureInfo]{Data structures which describe closures}
   7
   8 Much of the rationale for these things is in the ``details'' part of
   9 the STG paper.
  10
  11 \begin{code}
  12 module ClosureInfo (
  13         ClosureInfo, LambdaFormInfo, SMRep,     -- all abstract
  14         StandardFormInfo,
  15
  16         EntryConvention(..),
  17
  18         mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo,
  19         mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
  20         UpdateFlag,
  21
  22         closureSize, closureNonHdrSize,
  23         closureGoodStuffSize, closurePtrsSize,
  24         slopSize,
  25
  26         layOutDynClosure, layOutDynCon, layOutStaticClosure,
  27         layOutStaticNoFVClosure,
  28         mkVirtHeapOffsets,
  29
  30         nodeMustPointToIt, getEntryConvention,
  31         FCode, CgInfoDownwards, CgState,
  32
  33         blackHoleOnEntry,
  34
  35         staticClosureRequired,
  36         slowFunEntryCodeRequired, funInfoTableRequired,
  37
  38         closureName, infoTableLabelFromCI, fastLabelFromCI,
  39         closureLabelFromCI,
  40         entryLabelFromCI,
  41         closureLFInfo, closureSMRep, closureUpdReqd,
  42         closureSingleEntry, closureReEntrant, closureSemiTag,
  43         isStandardFormThunk,
  44         GenStgArg,
  45
  46         isToplevClosure,
  47         closureTypeDescr,               -- profiling
  48
  49         isStaticClosure,
  50         allocProfilingMsg,
  51         cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
  52         maybeSelectorInfo,
  53
  54         infoTblNeedsSRT,
  55         staticClosureNeedsLink,
  56         getSRTInfo
  57     ) where
  58
  59 #include "HsVersions.h"
  60
  61 import AbsCSyn          ( MagicId, node, VirtualHeapOffset, HeapOffset )
  62 import StgSyn
  63 import CgMonad
  64
  65 import Constants        ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
  66                           mAX_SPEC_FUN_SIZE, mAX_SPEC_THUNK_SIZE, mAX_SPEC_CONSTR_SIZE )
  67 import CgRetConv        ( assignRegs )
  68 import CLabel           ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
  69                           mkInfoTableLabel,
  70                           mkConInfoTableLabel,
  71                           mkCAFBlackHoleInfoTableLabel,
  72                           mkSECAFBlackHoleInfoTableLabel,
  73                           mkStaticInfoTableLabel, mkStaticConEntryLabel,
  74                           mkConEntryLabel, mkClosureLabel,
  75                           mkSelectorInfoLabel, mkSelectorEntryLabel,
  76                           mkApInfoTableLabel, mkApEntryLabel,
  77                           mkReturnPtLabel
  78                         )
  79 import CmdLineOpts      ( opt_SccProfilingOn, opt_OmitBlackHoling,
  80                           opt_Parallel, opt_DoTickyProfiling,
  81                           opt_SMP )
  82 import Id               ( Id, idType, idArityInfo )
  83 import DataCon          ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
  84                           isNullaryDataCon, isTupleCon, dataConName
  85                         )
  86 import IdInfo           ( ArityInfo(..) )
  87 import Name             ( Name, isExternallyVisibleName, nameUnique,
  88                           getOccName )
  89 import OccName          ( occNameUserString )
  90 import PprType          ( getTyDescription )
  91 import PrimRep          ( getPrimRepSize, separateByPtrFollowness, PrimRep )
  92 import SMRep            -- all of it
  93 import Type             ( isUnLiftedType, Type )
  94 import BasicTypes       ( TopLevelFlag(..), isNotTopLevel, isTopLevel )
  95 import Util             ( mapAccumL )
  96 import Outputable
  97 \end{code}
  98
  99 The ``wrapper'' data type for closure information:
 100
 101 \begin{code}
 102 data ClosureInfo
 103   = MkClosureInfo
 104         Name                    -- The thing bound to this closure
 105         LambdaFormInfo          -- info derivable from the *source*
 106         SMRep                   -- representation used by storage manager
 107 \end{code}
 108
 109 %************************************************************************
 110 %*                                                                      *
 111 \subsection[ClosureInfo-datatypes]{Data types for closure information}
 112 %*                                                                      *
 113 %************************************************************************
 114
 115 %************************************************************************
 116 %*                                                                      *
 117 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
 118 %*                                                                      *
 119 %************************************************************************
 120
 121 \begin{code}
 122 data LambdaFormInfo
 123   = LFReEntrant         -- Reentrant closure; used for PAPs too
 124         Type            -- Type of closure    (ToDo: remove)
 125         TopLevelFlag    -- True if top level
 126         !Int            -- Arity
 127         !Bool           -- True <=> no fvs
 128         CLabel          -- SRT label
 129         SRT             -- SRT info
 130
 131   | LFCon               -- Constructor
 132         DataCon         -- The constructor
 133         Bool            -- True <=> zero arity
 134
 135   | LFTuple             -- Tuples
 136         DataCon         -- The tuple constructor
 137         Bool            -- True <=> zero arity
 138
 139   | LFThunk             -- Thunk (zero arity)
 140         Type            -- Type of the thunk   (ToDo: remove)
 141         TopLevelFlag
 142         !Bool           -- True <=> no free vars
 143         Bool            -- True <=> updatable (i.e., *not* single-entry)
 144         StandardFormInfo
 145         CLabel          -- SRT label
 146         SRT             -- SRT info
 147
 148   | LFArgument          -- Used for function arguments.  We know nothing about
 149                         -- this closure.  Treat like updatable "LFThunk"...
 150
 151   | LFImported          -- Used for imported things.  We know nothing about this
 152                         -- closure.  Treat like updatable "LFThunk"...
 153                         -- Imported things which we do know something about use
 154                         -- one of the other LF constructors (eg LFReEntrant for
 155                         -- known functions)
 156
 157   | LFLetNoEscape       -- See LetNoEscape module for precise description of
 158                         -- these "lets".
 159         Int             -- arity;
 160
 161   | LFBlackHole         -- Used for the closures allocated to hold the result
 162                         -- of a CAF.  We want the target of the update frame to
 163                         -- be in the heap, so we make a black hole to hold it.
 164         CLabel          -- Flavour (info label, eg CAF_BLACKHOLE_info).
 165
 166
 167 data StandardFormInfo   -- Tells whether this thunk has one of a small number
 168                         -- of standard forms
 169
 170   = NonStandardThunk    -- No, it isn't
 171
 172   | SelectorThunk
 173        Int              -- 0-origin offset of ak within the "goods" of
 174                         -- constructor (Recall that the a1,...,an may be laid
 175                         -- out in the heap in a non-obvious order.)
 176
 177 {- A SelectorThunk is of form
 178
 179      case x of
 180        con a1,..,an -> ak
 181
 182    and the constructor is from a single-constr type.
 183 -}
 184
 185   | ApThunk
 186         Int             -- arity
 187
 188 {- An ApThunk is of form
 189
 190         x1 ... xn
 191
 192    The code for the thunk just pushes x2..xn on the stack and enters x1.
 193    There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
 194    in the RTS to save space.
 195 -}
 196
 197 \end{code}
 198
 199 %************************************************************************
 200 %*                                                                      *
 201 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
 202 %*                                                                      *
 203 %************************************************************************
 204
 205 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
 206
 207 \begin{code}
 208 mkClosureLFInfo :: Id           -- The binder
 209                 -> TopLevelFlag -- True of top level
 210                 -> [Id]         -- Free vars
 211                 -> UpdateFlag   -- Update flag
 212                 -> [Id]         -- Args
 213                 -> CLabel       -- SRT label
 214                 -> SRT          -- SRT info
 215                 -> LambdaFormInfo
 216
 217 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) srt_label srt -- Non-empty args
 218   = LFReEntrant (idType bndr) top (length args) (null fvs) srt_label srt
 219
 220 mkClosureLFInfo bndr top fvs ReEntrant [] srt_label srt
 221   = LFReEntrant (idType bndr) top 0 (null fvs) srt_label srt
 222
 223 mkClosureLFInfo bndr top fvs upd_flag [] srt_label srt
 224 #ifdef DEBUG
 225   | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
 226 #endif
 227   | otherwise
 228   = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
 229         srt_label srt
 230   where
 231     ty = idType bndr
 232 \end{code}
 233
 234 @mkConLFInfo@ is similar, for constructors.
 235
 236 \begin{code}
 237 mkConLFInfo :: DataCon -> LambdaFormInfo
 238
 239 mkConLFInfo con
 240   = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
 241     (if isTupleCon con then LFTuple else LFCon) con (isNullaryDataCon con)
 242
 243 mkSelectorLFInfo rhs_ty offset updatable
 244   = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
 245         (error "mkSelectorLFInfo: no srt label")
 246         (error "mkSelectorLFInfo: no srt")
 247
 248 mkApLFInfo rhs_ty upd_flag arity
 249   = LFThunk rhs_ty NotTopLevel (arity == 0) (isUpdatable upd_flag)
 250         (ApThunk arity)
 251         (error "mkApLFInfo: no srt label")
 252         (error "mkApLFInfo: no srt")
 253 \end{code}
 254
 255 Miscellaneous LF-infos.
 256
 257 \begin{code}
 258 mkLFArgument    = LFArgument
 259 mkLFLetNoEscape = LFLetNoEscape
 260
 261 mkLFImported :: Id -> LambdaFormInfo
 262 mkLFImported id
 263   = case idArityInfo id of
 264       ArityExactly 0    -> LFThunk (idType id)
 265                                 TopLevel True{-no fvs-}
 266                                 True{-updatable-} NonStandardThunk
 267                                 (error "mkLFImported: no srt label")
 268                                 (error "mkLFImported: no srt")
 269       ArityExactly n    -> LFReEntrant (idType id) TopLevel n True  -- n > 0
 270                                 (error "mkLFImported: no srt label")
 271                                 (error "mkLFImported: no srt")
 272       other             -> LFImported   -- Not sure of exact arity
 273 \end{code}
 274
 275 %************************************************************************
 276 %*                                                                      *
 277 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
 278 %*                                                                      *
 279 %************************************************************************
 280
 281 \begin{code}
 282 closureSize :: ClosureInfo -> HeapOffset
 283 closureSize cl_info@(MkClosureInfo _ _ sm_rep)
 284   = fixedHdrSize + closureNonHdrSize cl_info
 285
 286 closureNonHdrSize :: ClosureInfo -> Int
 287 closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
 288   = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info)
 289     --ToDo: pass lf_info?
 290   where
 291     tot_wds = closureGoodStuffSize cl_info
 292
 293 closureGoodStuffSize :: ClosureInfo -> Int
 294 closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
 295   = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
 296     in  ptrs + nonptrs
 297
 298 closurePtrsSize :: ClosureInfo -> Int
 299 closurePtrsSize (MkClosureInfo _ _ sm_rep)
 300   = let (ptrs, _) = sizes_from_SMRep sm_rep
 301     in  ptrs
 302
 303 -- not exported:
 304 sizes_from_SMRep :: SMRep -> (Int,Int)
 305 sizes_from_SMRep (GenericRep _ ptrs nonptrs _)   = (ptrs, nonptrs)
 306 sizes_from_SMRep BlackHoleRep                    = (0, 0)
 307 \end{code}
 308
 309 Computing slop size.  WARNING: this looks dodgy --- it has deep
 310 knowledge of what the storage manager does with the various
 311 representations...
 312
 313 Slop Requirements:
 314 \begin{itemize}
 315 \item
 316 Updateable closures must be @mIN_UPD_SIZE@.
 317         \begin{itemize}
 318         \item
 319         Indirections require 1 word
 320         \item
 321         Appels collector indirections 2 words
 322         \end{itemize}
 323 THEREFORE: @mIN_UPD_SIZE = 2@.
 324
 325 \item
 326 Collectable closures which are allocated in the heap
 327 must be @mIN_SIZE_NonUpdHeapObject@.
 328
 329 Copying collector forward pointer requires 1 word
 330
 331 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
 332 \end{itemize}
 333
 334 Static closures have an extra ``static link field'' at the end, but we
 335 don't bother taking that into account here.
 336
 337 \begin{code}
 338 slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
 339   = computeSlopSize (closureGoodStuffSize cl_info) sm_rep
 340          (closureUpdReqd cl_info)
 341
 342 computeSlopSize :: Int -> SMRep -> Bool -> Int
 343
 344 computeSlopSize tot_wds (GenericRep _ _ _ _) True               -- Updatable
 345   = max 0 (mIN_UPD_SIZE - tot_wds)
 346
 347 computeSlopSize tot_wds (GenericRep True _ _ _) False   -- Non updatable
 348   = 0                                                   -- Static
 349
 350 computeSlopSize tot_wds (GenericRep False _ _ _) False  -- Non updatable
 351   = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)         -- Dynamic
 352
 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 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         (GenericRep is_static 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 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 = getClosureType is_static tot_wds ptr_wds lf_info
 420     is_static    = True
 421
 422     bot = panic "layoutStaticClosure"
 423
 424 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
 425 layOutStaticNoFVClosure name lf_info
 426   = MkClosureInfo name lf_info (GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info))
 427   where
 428     is_static = True
 429 \end{code}
 430
 431 %************************************************************************
 432 %*                                                                      *
 433 \subsection[SMreps]{Choosing SM reps}
 434 %*                                                                      *
 435 %************************************************************************
 436
 437 \begin{code}
 438 chooseDynSMRep
 439         :: LambdaFormInfo
 440         -> Int -> Int           -- Tot wds, ptr wds
 441         -> SMRep
 442
 443 chooseDynSMRep lf_info tot_wds ptr_wds
 444   = let
 445          is_static    = False
 446          nonptr_wds   = tot_wds - ptr_wds
 447          closure_type = getClosureType is_static tot_wds ptr_wds lf_info
 448     in
 449     GenericRep is_static ptr_wds nonptr_wds closure_type
 450
 451 -- we *do* get non-updatable top-level thunks sometimes.  eg. f = g
 452 -- gets compiled to a jump to g (if g has non-zero arity), instead of
 453 -- messing around with update frames and PAPs.  We set the closure type
 454 -- to FUN_STATIC in this case.
 455
 456 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
 457 getClosureType is_static tot_wds ptr_wds lf_info
 458   = case lf_info of
 459         LFCon con zero_arity
 460                 | is_static && ptr_wds == 0            -> CONSTR_NOCAF
 461                 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
 462                 | otherwise                            -> CONSTR
 463
 464         LFTuple _ zero_arity
 465                 | is_static && ptr_wds == 0            -> CONSTR_NOCAF
 466                 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
 467                 | otherwise                            -> CONSTR
 468
 469         LFReEntrant _ _ _ _ _ _
 470                 | specialised_rep mAX_SPEC_FUN_SIZE -> FUN_p_n
 471                 | otherwise                         -> FUN
 472
 473         LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
 474
 475         LFThunk _ _ _ _ _ _ _
 476                 | specialised_rep mAX_SPEC_THUNK_SIZE -> THUNK_p_n
 477                 | otherwise                           -> THUNK
 478
 479         _ -> panic "getClosureType"
 480   where
 481     specialised_rep max_size =  not is_static
 482                              && tot_wds > 0
 483                              && tot_wds <= max_size
 484 \end{code}
 485
 486 %************************************************************************
 487 %*                                                                      *
 488 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
 489 %*                                                                      *
 490 %************************************************************************
 491
 492 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
 493 smaller offsets than the unboxed things, and furthermore, the offsets in
 494 the result list
 495
 496 \begin{code}
 497 mkVirtHeapOffsets ::
 498           (a -> PrimRep)        -- To be able to grab kinds;
 499                                 --      w/ a kind, we can find boxedness
 500           -> [a]                -- Things to make offsets for
 501           -> (Int,              -- *Total* number of words allocated
 502               Int,              -- Number of words allocated for *pointers*
 503               [(a, VirtualHeapOffset)])
 504                                 -- Things with their offsets from start of
 505                                 --  object in order of increasing offset
 506
 507 -- First in list gets lowest offset, which is initial offset + 1.
 508
 509 mkVirtHeapOffsets kind_fun things
 510   = let (ptrs, non_ptrs)              = separateByPtrFollowness kind_fun things
 511         (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
 512         (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
 513     in
 514         (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
 515   where
 516     computeOffset wds_so_far thing
 517       = (wds_so_far + (getPrimRepSize . kind_fun) thing,
 518          (thing, fixedHdrSize + wds_so_far)
 519         )
 520 \end{code}
 521
 522 %************************************************************************
 523 %*                                                                      *
 524 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
 525 %*                                                                      *
 526 %************************************************************************
 527
 528 Be sure to see the stg-details notes about these...
 529
 530 \begin{code}
 531 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
 532 nodeMustPointToIt lf_info
 533
 534   = case lf_info of
 535         LFReEntrant ty top arity no_fvs _ _ -> returnFC (
 536             not no_fvs ||   -- Certainly if it has fvs we need to point to it
 537             isNotTopLevel top
 538                     -- If it is not top level we will point to it
 539                     --   We can have a \r closure with no_fvs which
 540                     --   is not top level as special case cgRhsClosure
 541                     --   has been dissabled in favour of let floating
 542
 543                 -- For lex_profiling we also access the cost centre for a
 544                 -- non-inherited function i.e. not top level
 545                 -- the  not top  case above ensures this is ok.
 546             )
 547
 548         LFCon   _ zero_arity -> returnFC True
 549         LFTuple _ zero_arity -> returnFC True
 550
 551         -- Strictly speaking, the above two don't need Node to point
 552         -- to it if the arity = 0.  But this is a *really* unlikely
 553         -- situation.  If we know it's nil (say) and we are entering
 554         -- it. Eg: let x = [] in x then we will certainly have inlined
 555         -- x, since nil is a simple atom.  So we gain little by not
 556         -- having Node point to known zero-arity things.  On the other
 557         -- hand, we do lose something; Patrick's code for figuring out
 558         -- when something has been updated but not entered relies on
 559         -- having Node point to the result of an update.  SLPJ
 560         -- 27/11/92.
 561
 562         LFThunk _ _ no_fvs updatable NonStandardThunk _ _
 563           -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
 564
 565           -- For the non-updatable (single-entry case):
 566           --
 567           -- True if has fvs (in which case we need access to them, and we
 568           --                should black-hole it)
 569           -- or profiling (in which case we need to recover the cost centre
 570           --             from inside it)
 571
 572         LFThunk _ _ no_fvs updatable some_standard_form_thunk _ _
 573           -> returnFC True
 574           -- Node must point to any standard-form thunk.
 575
 576         LFArgument    -> returnFC True
 577         LFImported    -> returnFC True
 578         LFBlackHole _ -> returnFC True
 579                     -- BH entry may require Node to point
 580
 581         LFLetNoEscape _ -> returnFC False
 582 \end{code}
 583
 584 The entry conventions depend on the type of closure being entered,
 585 whether or not it has free variables, and whether we're running
 586 sequentially or in parallel.
 587
 588 \begin{tabular}{lllll}
 589 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
 590 Unknown                         & no & yes & stack      & node \\
 591 Known fun ($\ge$ 1 arg), no fvs         & no & no  & registers  & fast entry (enough args) \\
 592 \ & \ & \ & \                                           & slow entry (otherwise) \\
 593 Known fun ($\ge$ 1 arg), fvs    & no & yes & registers  & fast entry (enough args) \\
 594 0 arg, no fvs @\r,\s@           & no & no  & n/a        & direct entry \\
 595 0 arg, no fvs @\u@              & no & yes & n/a        & node \\
 596 0 arg, fvs @\r,\s@              & no & yes & n/a        & direct entry \\
 597 0 arg, fvs @\u@                 & no & yes & n/a        & node \\
 598
 599 Unknown                         & yes & yes & stack     & node \\
 600 Known fun ($\ge$ 1 arg), no fvs         & yes & no  & registers & fast entry (enough args) \\
 601 \ & \ & \ & \                                           & slow entry (otherwise) \\
 602 Known fun ($\ge$ 1 arg), fvs    & yes & yes & registers & node \\
 603 0 arg, no fvs @\r,\s@           & yes & no  & n/a       & direct entry \\
 604 0 arg, no fvs @\u@              & yes & yes & n/a       & node \\
 605 0 arg, fvs @\r,\s@              & yes & yes & n/a       & node \\
 606 0 arg, fvs @\u@                 & yes & yes & n/a       & node\\
 607 \end{tabular}
 608
 609 When black-holing, single-entry closures could also be entered via node
 610 (rather than directly) to catch double-entry.
 611
 612 \begin{code}
 613 data EntryConvention
 614   = ViaNode                             -- The "normal" convention
 615
 616   | StdEntry CLabel                     -- Jump to this code, with args on stack
 617
 618   | DirectEntry                         -- Jump directly, with args in regs
 619         CLabel                          --   The code label
 620         Int                             --   Its arity
 621         [MagicId]                       --   Its register assignments
 622                                         --      (possibly empty)
 623
 624 getEntryConvention :: Name              -- Function being applied
 625                    -> LambdaFormInfo    -- Its info
 626                    -> [PrimRep]         -- Available arguments
 627                    -> FCode EntryConvention
 628
 629 getEntryConvention name lf_info arg_kinds
 630  =  nodeMustPointToIt lf_info   `thenFC` \ node_points ->
 631     returnFC (
 632
 633     -- if we're parallel, then we must always enter via node.  The reason
 634     -- is that the closure may have been fetched since we allocated it.
 635
 636     if (node_points && opt_Parallel) then ViaNode else
 637
 638     -- Commented out by SDM after futher thoughts:
 639     --   - the only closure type that can be blackholed is a thunk
 640     --   - we already enter thunks via node (unless the closure is
 641     --     non-updatable, in which case why is it being re-entered...)
 642
 643     case lf_info of
 644
 645         LFReEntrant _ _ arity _ _ _ ->
 646             if arity == 0 || (length arg_kinds) < arity then
 647                 StdEntry (mkStdEntryLabel name)
 648             else
 649                 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
 650           where
 651             (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
 652             live_regs = if node_points then [node] else []
 653
 654         LFCon con True{-zero_arity-}
 655               -- a real constructor.  Don't bother entering it, just jump
 656               -- to the constructor entry code directly.
 657                           -> --false:ASSERT (null arg_kinds)
 658                              -- Should have no args (meaning what?)
 659                              StdEntry (mkStaticConEntryLabel (dataConName con))
 660
 661         LFCon con False{-non-zero_arity-}
 662                           -> --false:ASSERT (null arg_kinds)
 663                              -- Should have no args (meaning what?)
 664                              StdEntry (mkConEntryLabel (dataConName con))
 665
 666         LFTuple tup zero_arity
 667                           -> --false:ASSERT (null arg_kinds)
 668                              -- Should have no args (meaning what?)
 669                              StdEntry (mkConEntryLabel (dataConName tup))
 670
 671         LFThunk _ _ _ updatable std_form_info _ _
 672           -> if updatable || opt_DoTickyProfiling  -- to catch double entry
 673                 || opt_SMP  -- always enter via node on SMP, since the
 674                             -- thunk might have been blackholed in the
 675                             -- meantime.
 676              then ViaNode
 677              else StdEntry (thunkEntryLabel name std_form_info updatable)
 678
 679         LFArgument    -> ViaNode
 680         LFImported    -> ViaNode
 681         LFBlackHole _ -> ViaNode -- Presumably the black hole has by now
 682                                  -- been updated, but we don't know with
 683                                  -- what, so we enter via Node
 684
 685         LFLetNoEscape 0
 686           -> StdEntry (mkReturnPtLabel (nameUnique name))
 687
 688         LFLetNoEscape arity
 689           -> ASSERT(arity == length arg_kinds)
 690              DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
 691          where
 692             (arg_regs, _) = assignRegs [] arg_kinds
 693             -- node never points to a LetNoEscape, see above --SDM
 694             --live_regs     = if node_points then [node] else []
 695     )
 696
 697 blackHoleOnEntry :: ClosureInfo -> Bool
 698
 699 -- Static closures are never themselves black-holed.
 700 -- Updatable ones will be overwritten with a CAFList cell, which points to a
 701 -- black hole;
 702 -- Single-entry ones have no fvs to plug, and we trust they don't form part
 703 -- of a loop.
 704
 705 blackHoleOnEntry (MkClosureInfo _ _ rep)
 706   | isStaticRep rep
 707   = False
 708         -- Never black-hole a static closure
 709
 710 blackHoleOnEntry (MkClosureInfo _ lf_info _)
 711   = case lf_info of
 712         LFReEntrant _ _ _ _ _ _   -> False
 713         LFLetNoEscape _           -> False
 714         LFThunk _ _ no_fvs updatable _ _ _
 715           -> if updatable
 716              then not opt_OmitBlackHoling
 717              else opt_DoTickyProfiling || not no_fvs
 718                   -- the former to catch double entry,
 719                   -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
 720
 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( isTopLevel top_level )
 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   =    isNotTopLevel top_level
 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 info -> info
 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   | isStaticRep rep = mkStaticInfoTableLabel  name
 966   | otherwise       = mkConInfoTableLabel     name
 967   where
 968     name = dataConName con
 969
 970 mkConEntryPtr :: DataCon -> SMRep -> CLabel
 971 mkConEntryPtr con rep
 972   | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
 973   | otherwise       = mkConEntryLabel       (dataConName con)
 974   where
 975     name = dataConName con
 976
 977 closureLabelFromCI (MkClosureInfo id _ other_rep)   = mkClosureLabel id
 978
 979 entryLabelFromCI :: ClosureInfo -> CLabel
 980 entryLabelFromCI (MkClosureInfo id lf_info rep)
 981   = case lf_info of
 982         LFThunk _ _ _ upd_flag std_form_info _ _ -> thunkEntryLabel id std_form_info upd_flag
 983         LFCon con _                          -> mkConEntryPtr con rep
 984         LFTuple tup _                        -> mkConEntryPtr tup rep
 985         other                                -> mkStdEntryLabel id
 986
 987 -- thunkEntryLabel is a local help function, not exported.  It's used from both
 988 -- entryLabelFromCI and getEntryConvention.
 989
 990 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
 991   = mkApEntryLabel is_updatable arity
 992 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
 993   = mkSelectorEntryLabel upd_flag offset
 994 thunkEntryLabel thunk_id _ is_updatable
 995   = mkStdEntryLabel thunk_id
 996 \end{code}
 997
 998 \begin{code}
 999 allocProfilingMsg :: ClosureInfo -> FAST_STRING
1000
1001 allocProfilingMsg (MkClosureInfo _ lf_info _)
1002   = case lf_info of
1003       LFReEntrant _ _ _ _ _ _   -> SLIT("TICK_ALLOC_FUN")
1004       LFCon _ _                 -> SLIT("TICK_ALLOC_CON")
1005       LFTuple _ _               -> SLIT("TICK_ALLOC_CON")
1006       LFThunk _ _ _ True _ _ _  -> SLIT("TICK_ALLOC_UP_THK")  -- updatable
1007       LFThunk _ _ _ False _ _ _ -> SLIT("TICK_ALLOC_SE_THK")  -- nonupdatable
1008       LFBlackHole _             -> SLIT("TICK_ALLOC_BH")
1009       LFImported                -> panic "TICK_ALLOC_IMP"
1010 \end{code}
1011
1012 We need a black-hole closure info to pass to @allocDynClosure@ when we
1013 want to allocate the black hole on entry to a CAF.  These are the only
1014 ways to build an LFBlackHole, maintaining the invariant that it really
1015 is a black hole and not something else.
1016
1017 \begin{code}
1018 cafBlackHoleClosureInfo (MkClosureInfo name _ _)
1019   = MkClosureInfo name (LFBlackHole mkCAFBlackHoleInfoTableLabel) BlackHoleRep
1020
1021 seCafBlackHoleClosureInfo (MkClosureInfo name _ _)
1022   = MkClosureInfo name (LFBlackHole mkSECAFBlackHoleInfoTableLabel) BlackHoleRep
1023 \end{code}
1024
1025 %************************************************************************
1026 %*                                                                      *
1027 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1028 %*                                                                      *
1029 %************************************************************************
1030
1031 Profiling requires two pieces of information to be determined for
1032 each closure's info table --- description and type.
1033
1034 The description is stored directly in the @CClosureInfoTable@ when the
1035 info table is built.
1036
1037 The type is determined from the type information stored with the @Id@
1038 in the closure info using @closureTypeDescr@.
1039
1040 \begin{code}
1041 closureTypeDescr :: ClosureInfo -> String
1042 closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _ _ _) _)
1043   = getTyDescription ty
1044 closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _ _ _) _)
1045   = getTyDescription ty
1046 closureTypeDescr (MkClosureInfo name (LFCon data_con _) _)
1047   = occNameUserString (getOccName (dataConTyCon data_con))
1048 closureTypeDescr (MkClosureInfo name lf _)
1049   = showSDoc (ppr name)
1050 \end{code}
1051