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