ghc/compiler/codeGen/ClosureInfo.lhs

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