ghc/compiler/codeGen/ClosureInfo.lhs

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