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