ghc/compiler/codeGen/ClosureInfo.lhs

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