ghc/compiler/codeGen/ClosureInfo.lhs

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