ghc/compiler/codeGen/ClosureInfo.lhs

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