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