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