ghc/compiler/codeGen/ClosureInfo.lhs

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