ghc/compiler/codeGen/ClosureInfo.lhs

   1
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[ClosureInfo]{Data structures which describe closures}
   5
   6 Much of the rationale for these things is in the ``details'' part of
   7 the STG paper.
   8
   9 \begin{code}
  10 #include "HsVersions.h"
  11
  12 module ClosureInfo (
  13         ClosureInfo, LambdaFormInfo, SMRep,     -- all abstract
  14         StandardFormInfo,
  15
  16         EntryConvention(..),
  17
  18         mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo, mkVapLFInfo,
  19         mkLFImported, mkLFArgument, mkLFLetNoEscape,
  20         UpdateFlag,
  21
  22         closureSize, closureHdrSize,
  23         closureNonHdrSize, closureSizeWithoutFixedHdr,
  24         closureGoodStuffSize, closurePtrsSize,
  25         slopSize, fitsMinUpdSize,
  26
  27         layOutDynClosure, layOutDynCon, layOutStaticClosure,
  28         layOutStaticNoFVClosure, layOutPhantomClosure,
  29         mkVirtHeapOffsets,
  30
  31         nodeMustPointToIt, getEntryConvention,
  32         SYN_IE(FCode), CgInfoDownwards, CgState,
  33
  34         blackHoleOnEntry,
  35
  36         staticClosureRequired,
  37         slowFunEntryCodeRequired, funInfoTableRequired,
  38         stdVapRequired, noUpdVapRequired,
  39         StgBinderInfo,
  40
  41         closureId, infoTableLabelFromCI, fastLabelFromCI,
  42         closureLabelFromCI,
  43         entryLabelFromCI,
  44         closureLFInfo, closureSMRep, closureUpdReqd,
  45         closureSingleEntry, closureSemiTag, closureType,
  46         closureReturnsUnboxedType, getStandardFormThunkInfo,
  47         GenStgArg,
  48
  49         isToplevClosure,
  50         closureKind, closureTypeDescr,          -- profiling
  51
  52         isStaticClosure, allocProfilingMsg,
  53         blackHoleClosureInfo,
  54         maybeSelectorInfo,
  55
  56         dataConLiveness                         -- concurrency
  57     ) where
  58
  59 IMP_Ubiq(){-uitous-}
  60 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
  61 IMPORT_DELOOPER(AbsCLoop)               -- here for paranoia-checking
  62 #endif
  63
  64 import AbsCSyn          ( MagicId, node, mkLiveRegsMask,
  65                           {- GHC 0.29 only -} AbstractC, CAddrMode
  66                         )
  67 import StgSyn
  68 import CgMonad
  69
  70 import Constants        ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
  71                           mAX_SPEC_ALL_PTRS, mAX_SPEC_MIXED_FIELDS,
  72                           mAX_SPEC_ALL_NONPTRS,
  73                           oTHER_TAG
  74                         )
  75 import CgRetConv        ( assignRegs, dataReturnConvAlg,
  76                           DataReturnConvention(..)
  77                         )
  78 import CLabel           ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
  79                           mkPhantomInfoTableLabel, mkInfoTableLabel,
  80                           mkConInfoTableLabel, mkStaticClosureLabel,
  81                           mkBlackHoleInfoTableLabel, mkVapInfoTableLabel,
  82                           mkStaticInfoTableLabel, mkStaticConEntryLabel,
  83                           mkConEntryLabel, mkClosureLabel, mkVapEntryLabel
  84                         )
  85 import CmdLineOpts      ( opt_SccProfilingOn, opt_ForConcurrent )
  86 import HeapOffs         ( intOff, addOff, totHdrSize, varHdrSize,
  87                           SYN_IE(VirtualHeapOffset), HeapOffset
  88                         )
  89 import Id               ( idType, getIdArity,
  90                           externallyVisibleId,
  91                           dataConTag, fIRST_TAG,
  92                           isDataCon, isNullaryDataCon, dataConTyCon,
  93                           isTupleCon, SYN_IE(DataCon),
  94                           GenId{-instance Eq-}, SYN_IE(Id)
  95                         )
  96 import IdInfo           ( ArityInfo(..) )
  97 import Maybes           ( maybeToBool )
  98 import Name             ( getOccString )
  99 import Outputable       ( PprStyle(..), Outputable(..) )
 100 import PprType          ( getTyDescription, GenType{-instance Outputable-} )
 101 import Pretty           --ToDo:rm
 102 import PrelInfo         ( maybeCharLikeTyCon, maybeIntLikeTyCon )
 103 import PrimRep          ( getPrimRepSize, separateByPtrFollowness, PrimRep )
 104 import SMRep            -- all of it
 105 import TyCon            ( TyCon{-instance NamedThing-} )
 106 import Type             ( isPrimType, splitFunTyExpandingDictsAndPeeking,
 107                           mkFunTys, maybeAppSpecDataTyConExpandingDicts,
 108                           SYN_IE(Type)
 109                         )
 110 import Util             ( isIn, mapAccumL, panic, pprPanic, assertPanic )
 111 \end{code}
 112
 113 The ``wrapper'' data type for closure information:
 114
 115 \begin{code}
 116 data ClosureInfo
 117   = MkClosureInfo
 118         Id                      -- The thing bound to this closure
 119         LambdaFormInfo          -- info derivable from the *source*
 120         SMRep                   -- representation used by storage manager
 121 \end{code}
 122
 123 %************************************************************************
 124 %*                                                                      *
 125 \subsection[ClosureInfo-OLD-DOC]{OLD DOCUMENTATION PROBABLY SUPERCEDED BY stg-details}
 126 %*                                                                      *
 127 %************************************************************************
 128
 129 We can optimise the function-entry code as follows.
 130 \begin{itemize}
 131
 132 \item   If the ``function'' is not updatable, we can jump directly to its
 133         entry code, rather than indirecting via the info pointer in the
 134         closure.  (For updatable thunks we must go via the closure, in
 135         case it has been updated.)
 136
 137 \item   If the former bullet applies, and the application we are
 138         compiling gives the function as many arguments as it needs, we
 139         can jump to its fast-entry code.  (This only applies if the
 140         function has one or more args, because zero-arg closures have
 141         no fast-entry code.)
 142
 143 \item   If the function is a top-level non-constructor or imported, there
 144         is no need to make Node point to its closure.  In order for
 145         this to be right, we need to ensure that:
 146         \begin{itemize}
 147         \item   If such closures are updatable then they push their
 148                 static address in the update frame, not Node. Actually
 149                 we create a black hole and push its address.
 150
 151         \item   The arg satisfaction check should load Node before jumping to
 152                 UpdatePAP.
 153
 154         \item   Top-level constructor closures need careful handling.  If we are to
 155                 jump direct to the constructor code, we must load Node first, even
 156                 though they are top-level.  But if we go to their ``own''
 157                 standard-entry code (which loads Node and then jumps to the
 158                 constructor code) we don't need to load Node.
 159         \end{itemize}
 160 \end{itemize}
 161
 162
 163 {\em Top level constructors (@mkStaticConEntryInfo@)}
 164
 165 \begin{verbatim}
 166         x = {y,ys} \ {} Cons {y,ys}     -- Std form constructor
 167 \end{verbatim}
 168
 169 x-closure: Cons-info-table, y-closure, ys-closure
 170
 171 x-entry: Node = x-closure; jump( Cons-entry )
 172
 173 x's EntryInfo in its own module:
 174 \begin{verbatim}
 175                 Base-label = Cons               -- Not x!!
 176                 NodeMustPoint = True
 177                 ClosureClass = Constructor
 178 \end{verbatim}
 179
 180         So if x is entered, Node will be set up and
 181         we'll jump direct to the Cons code.
 182
 183 x's EntryInfo in another module: (which may not know that x is a constructor)
 184 \begin{verbatim}
 185                 Base-label = x                  -- Is x!!
 186                 NodeMustPoint = False           -- All imported things have False
 187                 ClosureClass = non-committal
 188 \end{verbatim}
 189
 190         If x is entered, we'll jump to x-entry, which will set up Node
 191         before jumping to the standard Cons code
 192
 193 {\em Top level non-constructors (@mkStaticEntryInfo@)}
 194 \begin{verbatim}
 195         x = ...
 196 \end{verbatim}
 197
 198 For updatable thunks, x-entry must push an allocated BH in update frame, not Node.
 199
 200 For non-zero arity, arg satis check must load Node before jumping to
 201         UpdatePAP.
 202
 203 x's EntryInfo in its own module:
 204 \begin{verbatim}
 205                 Base-label = x
 206                 NodeMustPoint = False
 207                 ClosureClass = whatever
 208 \end{verbatim}
 209
 210 {\em Inner constructors (@mkConEntryInfo@)}
 211
 212 \begin{verbatim}
 213                 Base-label = Cons               -- Not x!!
 214                 NodeMustPoint = True            -- If its arity were zero, it would
 215                                                 -- have been lifted to top level
 216                 ClosureClass = Constructor
 217 \end{verbatim}
 218
 219 {\em Inner non-constructors (@mkEntryInfo@)}
 220
 221 \begin{verbatim}
 222                 Base-label = x
 223                 NodeMustPoint = True            -- If no free vars, would have been
 224                                                 -- lifted to top level
 225                 ClosureClass = whatever
 226 \end{verbatim}
 227
 228 {\em Imported}
 229
 230 \begin{verbatim}
 231                 Nothing,
 232         or
 233                 Base-label = x
 234                 NodeMustPoint = False
 235                 ClosureClass = whatever
 236 \end{verbatim}
 237
 238 ==============
 239 THINK: we could omit making Node point to top-level constructors
 240 of arity zero; but that might interact nastily with updates.
 241 ==============
 242
 243
 244 ==========
 245 The info we need to import for imported things is:
 246
 247 \begin{verbatim}
 248         data ImportInfo = UnknownImportInfo
 249                         | HnfImport Int         -- Not updatable, arity given
 250                                                 -- Arity can be zero, for (eg) constrs
 251                         | UpdatableImport       -- Must enter via the closure
 252 \end{verbatim}
 253
 254 ToDo: move this stuff???
 255
 256 \begin{pseudocode}
 257 mkStaticEntryInfo lbl cl_class
 258   = MkEntryInfo lbl False cl_class
 259
 260 mkStaticConEntryInfo lbl
 261   = MkEntryInfo lbl True ConstructorClosure
 262
 263 mkEntryInfo lbl cl_class
 264   = MkEntryInfo lbl True cl_class
 265
 266 mkConEntryInfo lbl
 267   = MkEntryInfo lbl True ConstructorClosure
 268 \end{pseudocode}
 269
 270 %************************************************************************
 271 %*                                                                      *
 272 \subsection[ClosureInfo-datatypes]{Data types for closure information}
 273 %*                                                                      *
 274 %************************************************************************
 275
 276 %************************************************************************
 277 %*                                                                      *
 278 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
 279 %*                                                                      *
 280 %************************************************************************
 281
 282 \begin{code}
 283 data LambdaFormInfo
 284   = LFReEntrant         -- Reentrant closure; used for PAPs too
 285         Bool            -- True if top level
 286         Int             -- Arity
 287         Bool            -- True <=> no fvs
 288
 289   | LFCon               -- Constructor
 290         DataCon         -- The constructor (may be specialised)
 291         Bool            -- True <=> zero arity
 292
 293   | LFTuple             -- Tuples
 294         DataCon         -- The tuple constructor (may be specialised)
 295         Bool            -- True <=> zero arity
 296
 297   | LFThunk             -- Thunk (zero arity)
 298         Bool            -- True <=> top level
 299         Bool            -- True <=> no free vars
 300         Bool            -- True <=> updatable (i.e., *not* single-entry)
 301         StandardFormInfo
 302
 303   | LFArgument          -- Used for function arguments.  We know nothing about
 304                         -- this closure.  Treat like updatable "LFThunk"...
 305
 306   | LFImported          -- Used for imported things.  We know nothing about this
 307                         -- closure.  Treat like updatable "LFThunk"...
 308                         -- Imported things which we do know something about use
 309                         -- one of the other LF constructors (eg LFReEntrant for
 310                         -- known functions)
 311
 312   | LFLetNoEscape       -- See LetNoEscape module for precise description of
 313                         -- these "lets".
 314         Int             -- arity;
 315         StgLiveVars-- list of variables live in the RHS of the let.
 316                         -- (ToDo: maybe not used)
 317
 318   | LFBlackHole         -- Used for the closures allocated to hold the result
 319                         -- of a CAF.  We want the target of the update frame to
 320                         -- be in the heap, so we make a black hole to hold it.
 321
 322   -- This last one is really only for completeness;
 323   -- it isn't actually used for anything interesting
 324   {- | LFIndirection -}
 325
 326 data StandardFormInfo   -- Tells whether this thunk has one of a small number
 327                         -- of standard forms
 328
 329   = NonStandardThunk    -- No, it isn't
 330
 331  | SelectorThunk
 332        Id               -- Scrutinee
 333        DataCon          -- Constructor
 334        Int              -- 0-origin offset of ak within the "goods" of constructor
 335                         -- (Recall that the a1,...,an may be laid out in the heap
 336                         --  in a non-obvious order.)
 337
 338 {- A SelectorThunk is of form
 339
 340      case x of
 341        con a1,..,an -> ak
 342
 343    and the constructor is from a single-constr type.
 344    If we can't convert the heap-offset of the selectee into an Int, e.g.,
 345    it's "GEN_VHS+i", we just give up.
 346 -}
 347
 348   | VapThunk
 349         Id                      -- Function
 350         [StgArg]                -- Args
 351         Bool                    -- True <=> the function is not top-level, so
 352                                 -- must be stored in the thunk too
 353
 354 {- A VapThunk is of form
 355
 356         f a1 ... an
 357
 358    where f is a known function, with arity n
 359    So for this thunk we can use the label for f's heap-entry
 360    info table (generated when f's defn was dealt with),
 361    rather than generating a one-off info table and entry code
 362    for this one thunk.
 363 -}
 364
 365
 366 mkLFArgument    = LFArgument
 367 mkLFBlackHole   = LFBlackHole
 368 mkLFLetNoEscape = LFLetNoEscape
 369
 370 mkLFImported :: Id -> LambdaFormInfo
 371 mkLFImported id
 372   = case getIdArity id of
 373       ArityExactly 0    -> LFThunk True{-top-lev-} True{-no fvs-}
 374                                    True{-updatable-} NonStandardThunk
 375       ArityExactly n    -> LFReEntrant True n True  -- n > 0
 376       other             -> LFImported   -- Not sure of exact arity
 377 \end{code}
 378
 379 %************************************************************************
 380 %*                                                                      *
 381 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
 382 %*                                                                      *
 383 %************************************************************************
 384
 385 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
 386
 387 \begin{code}
 388 mkClosureLFInfo :: Bool         -- True of top level
 389                 -> [Id]         -- Free vars
 390                 -> UpdateFlag   -- Update flag
 391                 -> [Id]         -- Args
 392                 -> LambdaFormInfo
 393
 394 mkClosureLFInfo top fvs upd_flag args@(_:_)  -- Non-empty args
 395   = LFReEntrant top (length args) (null fvs)
 396
 397 mkClosureLFInfo top fvs ReEntrant []
 398   = LFReEntrant top 0 (null fvs)
 399
 400 mkClosureLFInfo top fvs upd_flag []
 401   = LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk
 402
 403 isUpdatable ReEntrant   = False
 404 isUpdatable SingleEntry = False
 405 isUpdatable Updatable   = True
 406 \end{code}
 407
 408 @mkConLFInfo@ is similar, for constructors.
 409
 410 \begin{code}
 411 mkConLFInfo :: DataCon -> LambdaFormInfo
 412
 413 mkConLFInfo con
 414   = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
 415     (if isTupleCon con then LFTuple else LFCon) con (isNullaryDataCon con)
 416
 417 mkSelectorLFInfo scrutinee con offset
 418   = LFThunk False False True (SelectorThunk scrutinee con offset)
 419
 420 mkVapLFInfo fvs upd_flag fun_id args fun_in_vap
 421   = LFThunk False (null fvs) (isUpdatable upd_flag) (VapThunk fun_id args fun_in_vap)
 422 \end{code}
 423
 424
 425 %************************************************************************
 426 %*                                                                      *
 427 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
 428 %*                                                                      *
 429 %************************************************************************
 430
 431 \begin{code}
 432 closureSize :: ClosureInfo -> HeapOffset
 433 closureSize cl_info@(MkClosureInfo _ _ sm_rep)
 434   = totHdrSize sm_rep `addOff` (intOff (closureNonHdrSize cl_info))
 435
 436 closureSizeWithoutFixedHdr :: ClosureInfo -> HeapOffset
 437 closureSizeWithoutFixedHdr cl_info@(MkClosureInfo _ _ sm_rep)
 438   = varHdrSize sm_rep `addOff` (intOff (closureNonHdrSize cl_info))
 439
 440 closureHdrSize :: ClosureInfo -> HeapOffset
 441 closureHdrSize (MkClosureInfo _ _ sm_rep)
 442   = totHdrSize sm_rep
 443
 444 closureNonHdrSize :: ClosureInfo -> Int
 445 closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
 446   = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info) --ToDo: pass lf_info?
 447   where
 448     tot_wds = closureGoodStuffSize cl_info
 449
 450 closureGoodStuffSize :: ClosureInfo -> Int
 451 closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
 452   = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
 453     in  ptrs + nonptrs
 454
 455 closurePtrsSize :: ClosureInfo -> Int
 456 closurePtrsSize (MkClosureInfo _ _ sm_rep)
 457   = let (ptrs, _) = sizes_from_SMRep sm_rep
 458     in  ptrs
 459
 460 -- not exported:
 461 sizes_from_SMRep (SpecialisedRep k ptrs nonptrs _)   = (ptrs, nonptrs)
 462 sizes_from_SMRep (GenericRep       ptrs nonptrs _)   = (ptrs, nonptrs)
 463 sizes_from_SMRep (BigTupleRep      ptrs)             = (ptrs, 0)
 464 sizes_from_SMRep (MuTupleRep       ptrs)             = (ptrs, 0)
 465 sizes_from_SMRep (DataRep               nonptrs)     = (0, nonptrs)
 466 sizes_from_SMRep BlackHoleRep                        = (0, 0)
 467 sizes_from_SMRep (StaticRep        ptrs nonptrs)     = (ptrs, nonptrs)
 468 #ifdef DEBUG
 469 sizes_from_SMRep PhantomRep       = panic "sizes_from_SMRep: PhantomRep"
 470 sizes_from_SMRep DynamicRep       = panic "sizes_from_SMRep: DynamicRep"
 471 #endif
 472 \end{code}
 473
 474 \begin{code}
 475 fitsMinUpdSize :: ClosureInfo -> Bool
 476 fitsMinUpdSize (MkClosureInfo _ _ BlackHoleRep) = True
 477 fitsMinUpdSize cl_info = isSpecRep (closureSMRep cl_info) && closureNonHdrSize cl_info <= mIN_UPD_SIZE
 478 \end{code}
 479
 480 Computing slop size.  WARNING: this looks dodgy --- it has deep
 481 knowledge of what the storage manager does with the various
 482 representations...
 483
 484 Slop Requirements:
 485 \begin{itemize}
 486 \item
 487 Updateable closures must be @mIN_UPD_SIZE@.
 488         \begin{itemize}
 489         \item
 490         Cons cell requires 2 words
 491         \item
 492         Indirections require 1 word
 493         \item
 494         Appels collector indirections 2 words
 495         \end{itemize}
 496 THEREFORE: @mIN_UPD_SIZE = 2@.
 497
 498 \item
 499 Collectable closures which are allocated in the heap
 500 must be @mIN_SIZE_NonUpdHeapObject@.
 501
 502 Copying collector forward pointer requires 1 word
 503
 504 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
 505
 506 \item
 507 @SpecialisedRep@ closures closures may require slop:
 508         \begin{itemize}
 509         \item
 510         @ConstantRep@ and @CharLikeRep@ closures always use the address of
 511         a static closure. They are never allocated or
 512         collected (eg hold forwarding pointer) hence never any slop.
 513
 514         \item
 515         @IntLikeRep@ are never updatable.
 516         May need slop to be collected (as they will be size 1 or more
 517         this probably has no affect)
 518
 519         \item
 520         @SpecRep@ may be updateable and will be collectable
 521
 522         \item
 523         @StaticRep@ may require slop if updatable. Non-updatable ones are OK.
 524
 525         \item
 526         @GenericRep@ closures will always be larger so never require slop.
 527         \end{itemize}
 528
 529         ***** ToDo: keep an eye on this!
 530 \end{itemize}
 531
 532 \begin{code}
 533 slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
 534   = computeSlopSize (closureGoodStuffSize cl_info) sm_rep (closureUpdReqd cl_info)
 535
 536 computeSlopSize :: Int -> SMRep -> Bool -> Int
 537
 538 computeSlopSize tot_wds (SpecialisedRep ConstantRep _ _ _) _
 539   = 0
 540 computeSlopSize tot_wds (SpecialisedRep CharLikeRep _ _ _) _
 541   = 0
 542
 543 computeSlopSize tot_wds (SpecialisedRep _ _ _ _) True   -- Updatable
 544   = max 0 (mIN_UPD_SIZE - tot_wds)
 545 computeSlopSize tot_wds (StaticRep _ _) True            -- Updatable
 546   = max 0 (mIN_UPD_SIZE - tot_wds)
 547 computeSlopSize tot_wds BlackHoleRep _                  -- Updatable
 548   = max 0 (mIN_UPD_SIZE - tot_wds)
 549
 550 computeSlopSize tot_wds (SpecialisedRep _ _ _ _) False  -- Not updatable
 551   = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)
 552
 553 computeSlopSize tot_wds other_rep _                     -- Any other rep
 554   = 0
 555 \end{code}
 556
 557 %************************************************************************
 558 %*                                                                      *
 559 \subsection[layOutDynClosure]{Lay out a dynamic closure}
 560 %*                                                                      *
 561 %************************************************************************
 562
 563 \begin{code}
 564 layOutDynClosure, layOutStaticClosure
 565         :: Id                       -- STG identifier w/ which this closure assoc'd
 566         -> (a -> PrimRep)           -- function w/ which to be able to get a PrimRep
 567         -> [a]                      -- the "things" being layed out
 568         -> LambdaFormInfo           -- what sort of closure it is
 569         -> (ClosureInfo,            -- info about the closure
 570             [(a, VirtualHeapOffset)])   -- things w/ offsets pinned on them
 571
 572 layOutDynClosure name kind_fn things lf_info
 573   = (MkClosureInfo name lf_info sm_rep,
 574      things_w_offsets)
 575   where
 576     (tot_wds,            -- #ptr_wds + #nonptr_wds
 577      ptr_wds,            -- #ptr_wds
 578      things_w_offsets) = mkVirtHeapOffsets sm_rep kind_fn things
 579     sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
 580
 581 layOutStaticClosure name kind_fn things lf_info
 582   = (MkClosureInfo name lf_info (StaticRep ptr_wds (tot_wds - ptr_wds)),
 583      things_w_offsets)
 584   where
 585     (tot_wds,            -- #ptr_wds + #nonptr_wds
 586      ptr_wds,            -- #ptr_wds
 587      things_w_offsets) = mkVirtHeapOffsets (StaticRep bot bot) kind_fn things
 588     bot = panic "layoutStaticClosure"
 589
 590 layOutStaticNoFVClosure :: Id -> LambdaFormInfo -> ClosureInfo
 591 layOutStaticNoFVClosure name lf_info
 592   = MkClosureInfo name lf_info (StaticRep ptr_wds nonptr_wds)
 593  where
 594   -- I am very uncertain that this is right - it will show up when testing
 595   -- my dynamic loading code.  ADR
 596   -- (If it's not right, we'll have to grab the kinds of the arguments from
 597   --  somewhere.)
 598   ptr_wds = 0
 599   nonptr_wds = 0
 600
 601 layOutPhantomClosure :: Id -> LambdaFormInfo -> ClosureInfo
 602 layOutPhantomClosure name lf_info = MkClosureInfo name lf_info PhantomRep
 603 \end{code}
 604
 605 A wrapper for when used with data constructors:
 606 \begin{code}
 607 layOutDynCon :: DataCon
 608              -> (a -> PrimRep)
 609              -> [a]
 610              -> (ClosureInfo, [(a,VirtualHeapOffset)])
 611
 612 layOutDynCon con kind_fn args
 613   = ASSERT(isDataCon con)
 614     layOutDynClosure con kind_fn args (mkConLFInfo con)
 615 \end{code}
 616
 617
 618 %************************************************************************
 619 %*                                                                      *
 620 \subsection[SMreps]{Choosing SM reps}
 621 %*                                                                      *
 622 %************************************************************************
 623
 624 \begin{code}
 625 chooseDynSMRep
 626         :: LambdaFormInfo
 627         -> Int -> Int           -- Tot wds, ptr wds
 628         -> SMRep
 629
 630 chooseDynSMRep lf_info tot_wds ptr_wds
 631   = let
 632          nonptr_wds = tot_wds - ptr_wds
 633
 634          updatekind = case lf_info of
 635              LFThunk _ _ upd _  -> if upd then SMUpdatable else SMSingleEntry
 636              LFBlackHole        -> SMUpdatable
 637              _                  -> SMNormalForm
 638     in
 639     if (nonptr_wds == 0 && ptr_wds <= mAX_SPEC_ALL_PTRS)
 640             || (tot_wds <= mAX_SPEC_MIXED_FIELDS)
 641             || (ptr_wds == 0 && nonptr_wds <= mAX_SPEC_ALL_NONPTRS) then
 642         let
 643           spec_kind  = case lf_info of
 644
 645            (LFTuple _ True) -> ConstantRep
 646
 647            (LFTuple _ _)  -> SpecRep
 648
 649            (LFCon _ True) -> ConstantRep
 650
 651            (LFCon con _ ) -> if maybeToBool (maybeCharLikeTyCon tycon) then CharLikeRep
 652                              else if maybeToBool (maybeIntLikeTyCon tycon) then IntLikeRep
 653                              else SpecRep
 654                              where
 655                              tycon = dataConTyCon con
 656
 657            _              -> SpecRep
 658         in
 659         SpecialisedRep spec_kind ptr_wds nonptr_wds updatekind
 660     else
 661         GenericRep ptr_wds nonptr_wds updatekind
 662 \end{code}
 663
 664
 665 %************************************************************************
 666 %*                                                                      *
 667 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
 668 %*                                                                      *
 669 %************************************************************************
 670
 671 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
 672 smaller offsets than the unboxed things, and furthermore, the offsets in
 673 the result list
 674
 675 \begin{code}
 676 mkVirtHeapOffsets :: SMRep      -- Representation to be used by storage manager
 677           -> (a -> PrimRep)     -- To be able to grab kinds;
 678                                 --      w/ a kind, we can find boxedness
 679           -> [a]                -- Things to make offsets for
 680           -> (Int,              -- *Total* number of words allocated
 681               Int,              -- Number of words allocated for *pointers*
 682               [(a, VirtualHeapOffset)])
 683                                 -- Things with their offsets from start of object
 684                                 --      in order of increasing offset
 685
 686 -- First in list gets lowest offset, which is initial offset + 1.
 687
 688 mkVirtHeapOffsets sm_rep kind_fun things
 689   = let (ptrs, non_ptrs)              = separateByPtrFollowness kind_fun things
 690         (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
 691         (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
 692     in
 693         (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
 694   where
 695     offset_of_first_word = totHdrSize sm_rep
 696     computeOffset wds_so_far thing
 697       = (wds_so_far + (getPrimRepSize . kind_fun) thing,
 698          (thing, (offset_of_first_word `addOff` (intOff wds_so_far)))
 699         )
 700 \end{code}
 701
 702 %************************************************************************
 703 %*                                                                      *
 704 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
 705 %*                                                                      *
 706 %************************************************************************
 707
 708 Be sure to see the stg-details notes about these...
 709
 710 \begin{code}
 711 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
 712 nodeMustPointToIt lf_info
 713   = let
 714         do_profiling = opt_SccProfilingOn
 715     in
 716     case lf_info of
 717         LFReEntrant top arity no_fvs -> returnFC (
 718             not no_fvs ||   -- Certainly if it has fvs we need to point to it
 719
 720             not top -- If it is not top level we will point to it
 721                     --   We can have a \r closure with no_fvs which
 722                     --   is not top level as special case cgRhsClosure
 723                     --   has been dissabled in favour of let floating
 724
 725                 -- For lex_profiling we also access the cost centre for a
 726                 -- non-inherited function i.e. not top level
 727                 -- the  not top  case above ensures this is ok.
 728             )
 729
 730         LFCon   _ zero_arity -> returnFC True
 731         LFTuple _ zero_arity -> returnFC True
 732
 733         -- Strictly speaking, the above two don't need Node to point
 734         -- to it if the arity = 0.  But this is a *really* unlikely
 735         -- situation.  If we know it's nil (say) and we are entering
 736         -- it. Eg: let x = [] in x then we will certainly have inlined
 737         -- x, since nil is a simple atom.  So we gain little by not
 738         -- having Node point to known zero-arity things.  On the other
 739         -- hand, we do lose something; Patrick's code for figuring out
 740         -- when something has been updated but not entered relies on
 741         -- having Node point to the result of an update.  SLPJ
 742         -- 27/11/92.
 743
 744         LFThunk _ no_fvs updatable NonStandardThunk
 745           -> returnFC (updatable || not no_fvs || do_profiling)
 746
 747           -- For the non-updatable (single-entry case):
 748           --
 749           -- True if has fvs (in which case we need access to them, and we
 750           --                should black-hole it)
 751           -- or profiling (in which case we need to recover the cost centre
 752           --             from inside it)
 753
 754         LFThunk _ no_fvs updatable some_standard_form_thunk
 755           -> returnFC True
 756           -- Node must point to any standard-form thunk.
 757           -- For example,
 758           --            x = f y
 759           -- generates a Vap thunk for (f y), and even if y is a global
 760           -- variable we must still make Node point to the thunk before entering it
 761           -- because that's what the standard-form code expects.
 762
 763         LFArgument  -> returnFC True
 764         LFImported  -> returnFC True
 765         LFBlackHole -> returnFC True
 766                     -- BH entry may require Node to point
 767
 768         LFLetNoEscape _ _ -> returnFC False
 769 \end{code}
 770
 771 The entry conventions depend on the type of closure being entered,
 772 whether or not it has free variables, and whether we're running
 773 sequentially or in parallel.
 774
 775 \begin{tabular}{lllll}
 776 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
 777 Unknown                         & no & yes & stack      & node \\
 778 Known fun ($\ge$ 1 arg), no fvs         & no & no  & registers  & fast entry (enough args) \\
 779 \ & \ & \ & \                                           & slow entry (otherwise) \\
 780 Known fun ($\ge$ 1 arg), fvs    & no & yes & registers  & fast entry (enough args) \\
 781 0 arg, no fvs @\r,\s@           & no & no  & n/a        & direct entry \\
 782 0 arg, no fvs @\u@              & no & yes & n/a        & node \\
 783 0 arg, fvs @\r,\s@              & no & yes & n/a        & direct entry \\
 784 0 arg, fvs @\u@                 & no & yes & n/a        & node \\
 785
 786 Unknown                         & yes & yes & stack     & node \\
 787 Known fun ($\ge$ 1 arg), no fvs         & yes & no  & registers & fast entry (enough args) \\
 788 \ & \ & \ & \                                           & slow entry (otherwise) \\
 789 Known fun ($\ge$ 1 arg), fvs    & yes & yes & registers & node \\
 790 0 arg, no fvs @\r,\s@           & yes & no  & n/a       & direct entry \\
 791 0 arg, no fvs @\u@              & yes & yes & n/a       & node \\
 792 0 arg, fvs @\r,\s@              & yes & yes & n/a       & node \\
 793 0 arg, fvs @\u@                 & yes & yes & n/a       & node\\
 794 \end{tabular}
 795
 796 When black-holing, single-entry closures could also be entered via node
 797 (rather than directly) to catch double-entry.
 798
 799 \begin{code}
 800 data EntryConvention
 801   = ViaNode                             -- The "normal" convention
 802
 803   | StdEntry CLabel                     -- Jump to this code, with args on stack
 804              (Maybe CLabel)             -- possibly setting infoptr to this
 805
 806   | DirectEntry                         -- Jump directly to code, with args in regs
 807         CLabel                          --   The code label
 808         Int                             --   Its arity
 809         [MagicId]                       --   Its register assignments (possibly empty)
 810
 811 getEntryConvention :: Id                -- Function being applied
 812                    -> LambdaFormInfo    -- Its info
 813                    -> [PrimRep]         -- Available arguments
 814                    -> FCode EntryConvention
 815
 816 getEntryConvention id lf_info arg_kinds
 817  =  nodeMustPointToIt lf_info   `thenFC` \ node_points ->
 818     let
 819         is_concurrent = opt_ForConcurrent
 820     in
 821     returnFC (
 822
 823     if (node_points && is_concurrent) then ViaNode else
 824
 825     case lf_info of
 826
 827         LFReEntrant _ arity _ ->
 828             if arity == 0 || (length arg_kinds) < arity then
 829                 StdEntry (mkStdEntryLabel id) Nothing
 830             else
 831                 DirectEntry (mkFastEntryLabel id arity) arity arg_regs
 832           where
 833             (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
 834             live_regs = if node_points then [node] else []
 835
 836         LFCon con zero_arity
 837                           -> let itbl = if zero_arity then
 838                                         mkPhantomInfoTableLabel con
 839                                         else
 840                                         mkConInfoTableLabel con
 841                              in
 842                              --false:ASSERT (null arg_kinds)    -- Should have no args (meaning what?)
 843                              StdEntry (mkConEntryLabel con) (Just itbl)
 844
 845         LFTuple tup zero_arity
 846                           -> --false:ASSERT (null arg_kinds)    -- Should have no args (meaning what?)
 847                              StdEntry (mkConEntryLabel tup) (Just (mkConInfoTableLabel tup))
 848
 849         LFThunk _ _ updatable std_form_info
 850           -> if updatable
 851              then ViaNode
 852              else StdEntry (thunkEntryLabel id std_form_info updatable) Nothing
 853
 854         LFArgument  -> ViaNode
 855         LFImported  -> ViaNode
 856         LFBlackHole -> ViaNode  -- Presumably the black hole has by now
 857                                 -- been updated, but we don't know with
 858                                 -- what, so we enter via Node
 859
 860         LFLetNoEscape arity _
 861           -> ASSERT(arity == length arg_kinds)
 862              DirectEntry (mkStdEntryLabel id) arity arg_regs
 863          where
 864             (arg_regs, _) = assignRegs live_regs arg_kinds
 865             live_regs     = if node_points then [node] else []
 866     )
 867
 868 blackHoleOnEntry :: Bool        -- No-black-holing flag
 869                  -> ClosureInfo
 870                  -> Bool
 871
 872 -- Static closures are never themselves black-holed.
 873 -- Updatable ones will be overwritten with a CAFList cell, which points to a black hole;
 874 -- Single-entry ones have no fvs to plug, and we trust they don't form part of a loop.
 875
 876 blackHoleOnEntry no_black_holing (MkClosureInfo _ _ (StaticRep _ _)) = False
 877
 878 blackHoleOnEntry no_black_holing (MkClosureInfo _ lf_info _)
 879   = case lf_info of
 880         LFReEntrant _ _ _         -> False
 881         LFThunk _ no_fvs updatable _
 882           -> if updatable
 883              then not no_black_holing
 884              else not no_fvs
 885         other -> panic "blackHoleOnEntry"       -- Should never happen
 886
 887 getStandardFormThunkInfo
 888         :: LambdaFormInfo
 889         -> Maybe [StgArg]               -- Nothing    => not a standard-form thunk
 890                                         -- Just atoms => a standard-form thunk with payload atoms
 891
 892 getStandardFormThunkInfo (LFThunk _ _ _ (SelectorThunk scrutinee _ _))
 893   = --trace "Selector thunk: missed opportunity to save info table + code"
 894     Nothing
 895         -- Just [StgVarArg scrutinee]
 896         -- We can't save the info tbl + code until we have a way to generate
 897         -- a fixed family thereof.
 898
 899 getStandardFormThunkInfo (LFThunk _ _ _ (VapThunk fun_id args fun_in_payload))
 900   | fun_in_payload = Just (StgVarArg fun_id : args)
 901   | otherwise      = Just args
 902
 903 getStandardFormThunkInfo other_lf_info = Nothing
 904
 905 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ (SelectorThunk _ con offset)) _) = Just (con,offset)
 906 maybeSelectorInfo _ = Nothing
 907 \end{code}
 908
 909 Avoiding generating entries and info tables
 910 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 911 At present, for every function we generate all of the following,
 912 just in case.  But they aren't always all needed, as noted below:
 913
 914 [NB1: all of this applies only to *functions*.  Thunks always
 915 have closure, info table, and entry code.]
 916
 917 [NB2: All are needed if the function is *exported*, just to play safe.]
 918
 919
 920 * Fast-entry code  ALWAYS NEEDED
 921
 922 * Slow-entry code
 923         Needed iff (a) we have any un-saturated calls to the function
 924         OR         (b) the function is passed as an arg
 925         OR         (c) we're in the parallel world and the function has free vars
 926                         [Reason: in parallel world, we always enter functions
 927                         with free vars via the closure.]
 928
 929 * The function closure
 930         Needed iff (a) we have any un-saturated calls to the function
 931         OR         (b) the function is passed as an arg
 932         OR         (c) if the function has free vars (ie not top level)
 933
 934   Why case (a) here?  Because if the arg-satis check fails,
 935   UpdatePAP stuffs a pointer to the function closure in the PAP.
 936   [Could be changed; UpdatePAP could stuff in a code ptr instead,
 937    but doesn't seem worth it.]
 938
 939   [NB: these conditions imply that we might need the closure
 940   without the slow-entry code.  Here's how.
 941
 942         f x y = let g w = ...x..y..w...
 943                 in
 944                 ...(g t)...
 945
 946   Here we need a closure for g which contains x and y,
 947   but since the calls are all saturated we just jump to the
 948   fast entry point for g, with R1 pointing to the closure for g.]
 949
 950
 951 * Standard info table
 952         Needed iff (a) we have any un-saturated calls to the function
 953         OR         (b) the function is passed as an arg
 954         OR         (c) the function has free vars (ie not top level)
 955
 956         NB.  In the sequential world, (c) is only required so that the function closure has
 957         an info table to point to, to keep the storage manager happy.
 958         If (c) alone is true we could fake up an info table by choosing
 959         one of a standard family of info tables, whose entry code just
 960         bombs out.
 961
 962         [NB In the parallel world (c) is needed regardless because
 963         we enter functions with free vars via the closure.]
 964
 965         If (c) is retained, then we'll sometimes generate an info table
 966         (for storage mgr purposes) without slow-entry code.  Then we need
 967         to use an error label in the info table to substitute for the absent
 968         slow entry code.
 969
 970 * Standard vap-entry code
 971   Standard vap-entry info table
 972         Needed iff we have any updatable thunks of the standard vap-entry shape.
 973
 974 * Single-update vap-entry code
 975   Single-update vap-entry info table
 976         Needed iff we have any non-updatable thunks of the
 977         standard vap-entry shape.
 978
 979
 980 \begin{code}
 981 staticClosureRequired
 982         :: Id
 983         -> StgBinderInfo
 984         -> LambdaFormInfo
 985         -> Bool
 986 staticClosureRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
 987                       (LFReEntrant top_level _ _)       -- It's a function
 988   = ASSERT( top_level )                 -- Assumption: it's a top-level, no-free-var binding
 989     arg_occ             -- There's an argument occurrence
 990     || unsat_occ        -- There's an unsaturated call
 991     || externallyVisibleId binder
 992
 993 staticClosureRequired binder other_binder_info other_lf_info = True
 994
 995 slowFunEntryCodeRequired        -- Assumption: it's a function, not a thunk.
 996         :: Id
 997         -> StgBinderInfo
 998         -> EntryConvention
 999         -> Bool
1000 slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _) entry_conv
1001   = arg_occ             -- There's an argument occurrence
1002     || unsat_occ        -- There's an unsaturated call
1003     || externallyVisibleId binder
1004     || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
1005             {- The last case deals with the parallel world; a function usually
1006                as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
1007
1008 slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
1009
1010 funInfoTableRequired
1011         :: Id
1012         -> StgBinderInfo
1013         -> LambdaFormInfo
1014         -> Bool
1015 funInfoTableRequired  binder (StgBinderInfo arg_occ unsat_occ _ _ _)
1016                      (LFReEntrant top_level _ _)
1017   = not top_level
1018     || arg_occ          -- There's an argument occurrence
1019     || unsat_occ        -- There's an unsaturated call
1020     || externallyVisibleId binder
1021
1022 funInfoTableRequired other_binder_info binder other_lf_info = True
1023
1024 -- We need the vector-apply entry points for a function if
1025 -- there's a vector-apply occurrence in this module
1026
1027 stdVapRequired, noUpdVapRequired :: StgBinderInfo -> Bool
1028
1029 stdVapRequired binder_info
1030   = case binder_info of
1031       StgBinderInfo _ _ std_vap_occ _ _ -> std_vap_occ
1032       _                                 -> False
1033
1034 noUpdVapRequired binder_info
1035   = case binder_info of
1036       StgBinderInfo _ _ _ no_upd_vap_occ _ -> no_upd_vap_occ
1037       _                                    -> False
1038 \end{code}
1039
1040 @lfArity@ extracts the arity of a function from its LFInfo
1041
1042 \begin{code}
1043 {- Not needed any more
1044
1045 lfArity_maybe (LFReEntrant _ arity _) = Just arity
1046
1047 -- Removed SLPJ March 97. I don't believe these two;
1048 -- LFCon is used for construcor *applications*, not constructors!
1049 --
1050 -- lfArity_maybe (LFCon con _)        = Just (dataConArity con)
1051 -- lfArity_maybe (LFTuple con _)              = Just (dataConArity con)
1052
1053 lfArity_maybe other                   = Nothing
1054 -}
1055 \end{code}
1056
1057 %************************************************************************
1058 %*                                                                      *
1059 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
1060 %*                                                                      *
1061 %************************************************************************
1062
1063 \begin{code}
1064
1065 isStaticClosure :: ClosureInfo -> Bool
1066 isStaticClosure  (MkClosureInfo _ _ rep) = isStaticRep  rep
1067
1068 closureId :: ClosureInfo -> Id
1069 closureId (MkClosureInfo id _ _) = id
1070
1071 closureSMRep :: ClosureInfo -> SMRep
1072 closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
1073
1074 closureLFInfo :: ClosureInfo -> LambdaFormInfo
1075 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
1076
1077 closureUpdReqd :: ClosureInfo -> Bool
1078
1079 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ upd _) _) = upd
1080 closureUpdReqd (MkClosureInfo _ LFBlackHole _)         = True
1081         -- Black-hole closures are allocated to receive the results of an
1082         -- alg case with a named default... so they need to be updated.
1083 closureUpdReqd other_closure                           = False
1084
1085 closureSingleEntry :: ClosureInfo -> Bool
1086
1087 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ upd _) _) = not upd
1088 closureSingleEntry other_closure                           = False
1089 \end{code}
1090
1091 Note: @closureType@ returns appropriately specialised tycon and
1092 datacons.
1093 \begin{code}
1094 closureType :: ClosureInfo -> Maybe (TyCon, [Type], [Id])
1095
1096 -- First, a turgid special case.  When we are generating the
1097 -- standard code and info-table for Vaps (which is done when the function
1098 -- defn is encountered), we don't have a convenient Id to hand whose
1099 -- type is that of (f x y z).  So we need to figure out the type
1100 -- rather than take it from the Id. The Id is probably just "f"!
1101
1102 closureType (MkClosureInfo id (LFThunk _ _ _ (VapThunk fun_id args _)) _)
1103   = maybeAppSpecDataTyConExpandingDicts (fun_result_ty (length args) fun_id)
1104
1105 closureType (MkClosureInfo id lf _) = maybeAppSpecDataTyConExpandingDicts (idType id)
1106 \end{code}
1107
1108 @closureReturnsUnboxedType@ is used to check whether a closure, {\em
1109 once it has eaten its arguments}, returns an unboxed type.  For
1110 example, the closure for a function:
1111 \begin{verbatim}
1112         f :: Int -> Int#
1113 \end{verbatim}
1114 returns an unboxed type.  This is important when dealing with stack
1115 overflow checks.
1116 \begin{code}
1117 closureReturnsUnboxedType :: ClosureInfo -> Bool
1118
1119 closureReturnsUnboxedType (MkClosureInfo fun_id (LFReEntrant _ arity _) _)
1120   = isPrimType (fun_result_ty arity fun_id)
1121
1122 closureReturnsUnboxedType other_closure = False
1123         -- All non-function closures aren't functions,
1124         -- and hence are boxed, since they are heap alloc'd
1125
1126 -- ToDo: need anything like this in Type.lhs?
1127 fun_result_ty arity id
1128   = let
1129         (arg_tys, res_ty)  = splitFunTyExpandingDictsAndPeeking (idType id)
1130     in
1131 --    ASSERT(arity >= 0 && length arg_tys >= arity)
1132     (if (arity >= 0 && length arg_tys >= arity) then (\x->x) else pprPanic "fun_result_ty:" (hsep [int arity, ppr PprShowAll id, ppr PprDebug (idType id)])) $
1133     mkFunTys (drop arity arg_tys) res_ty
1134 \end{code}
1135
1136 \begin{code}
1137 closureSemiTag :: ClosureInfo -> Int
1138
1139 closureSemiTag (MkClosureInfo _ lf_info _)
1140   = case lf_info of
1141       LFCon data_con _ -> dataConTag data_con - fIRST_TAG
1142       LFTuple _ _      -> 0
1143       _                -> fromInteger oTHER_TAG
1144 \end{code}
1145
1146 \begin{code}
1147 isToplevClosure :: ClosureInfo -> Bool
1148
1149 isToplevClosure (MkClosureInfo _ lf_info _)
1150   = case lf_info of
1151       LFReEntrant top _ _ -> top
1152       LFThunk top _ _ _   -> top
1153       _ -> panic "ClosureInfo:isToplevClosure"
1154 \end{code}
1155
1156 Label generation.
1157
1158 \begin{code}
1159 fastLabelFromCI :: ClosureInfo -> CLabel
1160 fastLabelFromCI (MkClosureInfo id lf_info _)
1161 {-      [SLPJ Changed March 97]
1162          (was ok, but is the only call to lfArity,
1163           and the id should guarantee to have the correct arity in it.
1164
1165   = case lfArity_maybe lf_info of
1166         Just arity ->
1167 -}
1168   = case getIdArity id of
1169         ArityExactly arity -> mkFastEntryLabel id arity
1170         other              -> pprPanic "fastLabelFromCI" (ppr PprDebug id)
1171
1172 infoTableLabelFromCI :: ClosureInfo -> CLabel
1173 infoTableLabelFromCI (MkClosureInfo id lf_info rep)
1174   = case lf_info of
1175         LFCon con _     -> mkConInfoPtr con rep
1176         LFTuple tup _   -> mkConInfoPtr tup rep
1177
1178         LFBlackHole     -> mkBlackHoleInfoTableLabel
1179
1180         LFThunk _ _ upd_flag (VapThunk fun_id args _) -> mkVapInfoTableLabel fun_id upd_flag
1181                                         -- Use the standard vap info table
1182                                         -- for the function, rather than a one-off one
1183                                         -- for this particular closure
1184
1185 {-      For now, we generate individual info table and entry code for selector thunks,
1186         so their info table should be labelled in the standard way.
1187         The only special thing about them is that the info table has a field which
1188         tells the GC that it really is a selector.
1189
1190         Later, perhaps, we'll have some standard RTS code for selector-thunk info tables,
1191         in which case this line will spring back to life.
1192
1193         LFThunk _ _ upd_flag (SelectorThunk _ _ offset) -> mkSelectorInfoTableLabel upd_flag offset
1194                                         -- Ditto for selectors
1195 -}
1196
1197         other -> {-NO: if isStaticRep rep
1198                  then mkStaticInfoTableLabel id
1199                  else -} mkInfoTableLabel id
1200
1201 mkConInfoPtr :: Id -> SMRep -> CLabel
1202 mkConInfoPtr con rep
1203   = ASSERT(isDataCon con)
1204     case rep of
1205       PhantomRep    -> mkPhantomInfoTableLabel con
1206       StaticRep _ _ -> mkStaticInfoTableLabel  con
1207       _             -> mkConInfoTableLabel     con
1208
1209 mkConEntryPtr :: Id -> SMRep -> CLabel
1210 mkConEntryPtr con rep
1211   = ASSERT(isDataCon con)
1212     case rep of
1213       StaticRep _ _ -> mkStaticConEntryLabel con
1214       _             -> mkConEntryLabel con
1215
1216
1217 closureLabelFromCI (MkClosureInfo id _ rep)
1218         | isConstantRep rep
1219         = mkStaticClosureLabel id
1220         -- This case catches those pesky static closures for nullary constructors
1221
1222 closureLabelFromCI (MkClosureInfo id _ other_rep)   = mkClosureLabel id
1223
1224 entryLabelFromCI :: ClosureInfo -> CLabel
1225 entryLabelFromCI (MkClosureInfo id lf_info rep)
1226   = case lf_info of
1227         LFThunk _ _ upd_flag std_form_info -> thunkEntryLabel id std_form_info upd_flag
1228         LFCon con _                        -> mkConEntryPtr con rep
1229         LFTuple tup _                      -> mkConEntryPtr tup rep
1230         other                              -> mkStdEntryLabel id
1231
1232 -- thunkEntryLabel is a local help function, not exported.  It's used from both
1233 -- entryLabelFromCI and getEntryConvention.
1234 -- I don't think it needs to deal with the SelectorThunk case
1235 -- Well, it's falling over now, so I've made it deal with it.  (JSM)
1236
1237 thunkEntryLabel thunk_id (VapThunk fun_id args _) is_updatable
1238   = mkVapEntryLabel fun_id is_updatable
1239 thunkEntryLabel thunk_id _ is_updatable
1240   = mkStdEntryLabel thunk_id
1241 \end{code}
1242
1243 \begin{code}
1244 allocProfilingMsg :: ClosureInfo -> FAST_STRING
1245
1246 allocProfilingMsg (MkClosureInfo _ lf_info _)
1247   = case lf_info of
1248       LFReEntrant _ _ _         -> SLIT("ALLOC_FUN")
1249       LFCon _ _                 -> SLIT("ALLOC_CON")
1250       LFTuple _ _               -> SLIT("ALLOC_CON")
1251       LFThunk _ _ _ _           -> SLIT("ALLOC_THK")
1252       LFBlackHole               -> SLIT("ALLOC_BH")
1253       LFImported                -> panic "ALLOC_IMP"
1254 \end{code}
1255
1256 We need a black-hole closure info to pass to @allocDynClosure@ when we
1257 want to allocate the black hole on entry to a CAF.
1258
1259 \begin{code}
1260 blackHoleClosureInfo (MkClosureInfo id _ _)
1261   = MkClosureInfo id LFBlackHole BlackHoleRep
1262 \end{code}
1263
1264 The register liveness when returning from a constructor.  For
1265 simplicity, we claim just [node] is live for all but PhantomRep's.  In
1266 truth, this means that non-constructor info tables also claim node,
1267 but since their liveness information is never used, we don't care.
1268
1269 \begin{code}
1270 dataConLiveness (MkClosureInfo con _ PhantomRep)
1271   = case (dataReturnConvAlg con) of
1272       ReturnInRegs regs -> mkLiveRegsMask regs
1273       ReturnInHeap -> panic "dataConLiveness:PhantomRep in heap???"
1274
1275 dataConLiveness _ = mkLiveRegsMask [node]
1276 \end{code}
1277
1278 %************************************************************************
1279 %*                                                                      *
1280 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1281 %*                                                                      *
1282 %************************************************************************
1283
1284 Profiling requires three pices of information to be determined for
1285 each closure's info table --- kind, description and type.
1286
1287 The description is stored directly in the @CClosureInfoTable@ when the
1288 info table is built.
1289
1290 The kind is determined from the @LambdaForm@ stored in the closure
1291 info using @closureKind@.
1292
1293 The type is determined from the type information stored with the @Id@
1294 in the closure info using @closureTypeDescr@.
1295
1296 \begin{code}
1297 closureKind :: ClosureInfo -> String
1298
1299 closureKind (MkClosureInfo _ lf _)
1300   = case lf of
1301       LFReEntrant _ n _         -> if n > 0 then "FN_K" else "THK_K"
1302       LFCon _ _                 -> "CON_K"
1303       LFTuple _ _               -> "CON_K"
1304       LFThunk _ _ _ _           -> "THK_K"
1305       LFBlackHole               -> "THK_K" -- consider BHs as thunks for the moment... (ToDo?)
1306       LFImported                -> panic "IMP_KIND"
1307
1308 closureTypeDescr :: ClosureInfo -> String
1309 closureTypeDescr (MkClosureInfo id lf _)
1310   = if (isDataCon id) then                       -- DataCon has function types
1311         getOccString (dataConTyCon id)           -- We want the TyCon not the ->
1312     else
1313         getTyDescription (idType id)
1314 \end{code}