ghc/compiler/codeGen/ClosureInfo.lhs

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