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)               -- This should be true anyway
 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     returnFC (
 864
 865     if (node_points && is_concurrent) then ViaNode else
 866
 867     case lf_info of
 868
 869         LFReEntrant _ arity _ ->
 870             if arity == 0 || (length arg_kinds) < arity then
 871                 StdEntry (mkStdEntryLabel id) Nothing
 872             else
 873                 DirectEntry (mkFastEntryLabel id arity) arity arg_regs
 874           where
 875             (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
 876             live_regs = if node_points then [node] else []
 877
 878         LFCon con zero_arity
 879                           -> let itbl = if zero_arity then
 880                                         mkPhantomInfoTableLabel con
 881                                         else
 882                                         mkInfoTableLabel con
 883                              in StdEntry (mkStdEntryLabel con) (Just itbl)
 884                                 -- Should have no args
 885         LFTuple tup zero_arity
 886                          -> StdEntry (mkStdEntryLabel tup)
 887                                      (Just (mkInfoTableLabel tup))
 888                                 -- Should have no args
 889
 890         LFThunk _ _ updatable std_form_info
 891           -> if updatable
 892              then ViaNode
 893              else StdEntry (thunkEntryLabel id std_form_info updatable) Nothing
 894
 895         LFArgument  -> ViaNode
 896         LFImported  -> ViaNode
 897         LFBlackHole -> ViaNode  -- Presumably the black hole has by now
 898                                 -- been updated, but we don't know with
 899                                 -- what, so we enter via Node
 900
 901         LFLetNoEscape arity _
 902           -> ASSERT(arity == length arg_kinds)
 903              DirectEntry (mkFastEntryLabel id arity) arity arg_regs
 904          where
 905             (arg_regs, _) = assignRegs live_regs arg_kinds
 906             live_regs     = if node_points then [node] else []
 907     )
 908
 909 blackHoleOnEntry :: Bool        -- No-black-holing flag
 910                  -> ClosureInfo
 911                  -> Bool
 912
 913 -- Static closures are never themselves black-holed.
 914 -- Updatable ones will be overwritten with a CAFList cell, which points to a black hole;
 915 -- Single-entry ones have no fvs to plug, and we trust they don't form part of a loop.
 916
 917 blackHoleOnEntry no_black_holing (MkClosureInfo _ _ (StaticRep _ _)) = False
 918
 919 blackHoleOnEntry no_black_holing (MkClosureInfo _ lf_info _)
 920   = case lf_info of
 921         LFReEntrant _ _ _         -> False
 922         LFThunk _ no_fvs updatable _
 923           -> if updatable
 924              then not no_black_holing
 925              else not no_fvs
 926         other                     -> panic "blackHoleOnEntry"   -- Should never happen
 927
 928 getStandardFormThunkInfo
 929         :: LambdaFormInfo
 930         -> Maybe [PlainStgAtom]         -- Nothing    => not a standard-form thunk
 931                                         -- Just atoms => a standard-form thunk with payload atoms
 932
 933 getStandardFormThunkInfo (LFThunk _ _ _ (SelectorThunk scrutinee _ _))
 934   = --trace "Selector thunk: missed opportunity to save info table + code"
 935     Nothing
 936         -- Just [StgVarAtom scrutinee]
 937         -- We can't save the info tbl + code until we have a way to generate
 938         -- a fixed family thereof.
 939
 940 getStandardFormThunkInfo (LFThunk _ _ _ (VapThunk fun_id args fun_in_payload))
 941   | fun_in_payload = Just (StgVarAtom fun_id : args)
 942   | otherwise      = Just args
 943
 944 getStandardFormThunkInfo other_lf_info = Nothing
 945
 946 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ (SelectorThunk _ con offset)) _) = Just (con,offset)
 947 maybeSelectorInfo _ = Nothing
 948 \end{code}
 949
 950 Avoiding generating entries and info tables
 951 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 952 At present, for every function we generate all of the following,
 953 just in case.  But they aren't always all needed, as noted below:
 954
 955 [NB1: all of this applies only to *functions*.  Thunks always
 956 have closure, info table, and entry code.]
 957
 958 [NB2: All are needed if the function is *exported*, just to play safe.]
 959
 960
 961 * Fast-entry code  ALWAYS NEEDED
 962
 963 * Slow-entry code
 964         Needed iff (a) we have any un-saturated calls to the function
 965         OR         (b) the function is passed as an arg
 966         OR         (c) we're in the parallel world and the function has free vars
 967                         [Reason: in parallel world, we always enter functions
 968                         with free vars via the closure.]
 969
 970 * The function closure
 971         Needed iff (a) we have any un-saturated calls to the function
 972         OR         (b) the function is passed as an arg
 973         OR         (c) if the function has free vars (ie not top level)
 974
 975   Why case (a) here?  Because if the arg-satis check fails,
 976   UpdatePAP stuffs a pointer to the function closure in the PAP.
 977   [Could be changed; UpdatePAP could stuff in a code ptr instead,
 978    but doesn't seem worth it.]
 979
 980   [NB: these conditions imply that we might need the closure
 981   without the slow-entry code.  Here's how.
 982
 983         f x y = let g w = ...x..y..w...
 984                 in
 985                 ...(g t)...
 986
 987   Here we need a closure for g which contains x and y,
 988   but since the calls are all saturated we just jump to the
 989   fast entry point for g, with R1 pointing to the closure for g.]
 990
 991
 992 * Standard info table
 993         Needed iff (a) we have any un-saturated calls to the function
 994         OR         (b) the function is passed as an arg
 995         OR         (c) the function has free vars (ie not top level)
 996
 997         NB.  In the sequential world, (c) is only required so that the function closure has
 998         an info table to point to, to keep the storage manager happy.
 999         If (c) alone is true we could fake up an info table by choosing
1000         one of a standard family of info tables, whose entry code just
1001         bombs out.
1002
1003         [NB In the parallel world (c) is needed regardless because
1004         we enter functions with free vars via the closure.]
1005
1006         If (c) is retained, then we'll sometimes generate an info table
1007         (for storage mgr purposes) without slow-entry code.  Then we need
1008         to use an error label in the info table to substitute for the absent
1009         slow entry code.
1010
1011 * Standard vap-entry code
1012   Standard vap-entry info table
1013         Needed iff we have any updatable thunks of the standard vap-entry shape.
1014
1015 * Single-update vap-entry code
1016   Single-update vap-entry info table
1017         Needed iff we have any non-updatable thunks of the
1018         standard vap-entry shape.
1019
1020
1021 \begin{code}
1022 staticClosureRequired
1023         :: Id
1024         -> StgBinderInfo
1025         -> LambdaFormInfo
1026         -> Bool
1027 staticClosureRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
1028                       (LFReEntrant top_level _ _)       -- It's a function
1029   = ASSERT( top_level )                 -- Assumption: it's a top-level, no-free-var binding
1030     arg_occ             -- There's an argument occurrence
1031     || unsat_occ        -- There's an unsaturated call
1032     || externallyVisibleId binder
1033
1034 staticClosureRequired binder other_binder_info other_lf_info = True
1035
1036 slowFunEntryCodeRequired        -- Assumption: it's a function, not a thunk.
1037         :: Id
1038         -> StgBinderInfo
1039         -> Bool
1040 slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
1041   = arg_occ             -- There's an argument occurrence
1042     || unsat_occ        -- There's an unsaturated call
1043     || externallyVisibleId binder
1044     {- HAS FREE VARS AND IS PARALLEL WORLD -}
1045
1046 slowFunEntryCodeRequired binder NoStgBinderInfo = True
1047
1048 funInfoTableRequired
1049         :: Id
1050         -> StgBinderInfo
1051         -> LambdaFormInfo
1052         -> Bool
1053 funInfoTableRequired  binder (StgBinderInfo arg_occ unsat_occ _ _ _)
1054                      (LFReEntrant top_level _ _)
1055   = not top_level
1056     || arg_occ          -- There's an argument occurrence
1057     || unsat_occ        -- There's an unsaturated call
1058     || externallyVisibleId binder
1059
1060 funInfoTableRequired other_binder_info binder other_lf_info = True
1061
1062 -- We need the vector-apply entry points for a function if
1063 -- there's a vector-apply occurrence in this module
1064
1065 stdVapRequired, noUpdVapRequired :: StgBinderInfo -> Bool
1066
1067 stdVapRequired binder_info
1068   = case binder_info of
1069       StgBinderInfo _ _ std_vap_occ _ _ -> std_vap_occ
1070       _                                 -> False
1071
1072 noUpdVapRequired binder_info
1073   = case binder_info of
1074       StgBinderInfo _ _ _ no_upd_vap_occ _ -> no_upd_vap_occ
1075       _                                    -> False
1076 \end{code}
1077
1078 %************************************************************************
1079 %*                                                                      *
1080 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
1081 %*                                                                      *
1082 %************************************************************************
1083
1084 \begin{code}
1085 isConstantRep, isSpecRep, isStaticRep, isPhantomRep, isIntLikeRep :: SMRep -> Bool
1086 isConstantRep (SpecialisedRep ConstantRep _ _ _)   = True
1087 isConstantRep other                                = False
1088
1089 isSpecRep (SpecialisedRep kind _ _ _)   = True    -- All the kinds of Spec closures
1090 isSpecRep other                         = False   -- True indicates that the _VHS is 0 !
1091
1092 isStaticRep (StaticRep _ _) = True
1093 isStaticRep _               = False
1094
1095 isPhantomRep PhantomRep = True
1096 isPhantomRep _          = False
1097
1098 isIntLikeRep (SpecialisedRep IntLikeRep _ _ _)   = True
1099 isIntLikeRep other                               = False
1100
1101 isStaticClosure :: ClosureInfo -> Bool
1102 isStaticClosure  (MkClosureInfo _ _ rep) = isStaticRep  rep
1103
1104 closureId :: ClosureInfo -> Id
1105 closureId (MkClosureInfo id _ _) = id
1106
1107 closureSMRep :: ClosureInfo -> SMRep
1108 closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
1109
1110 closureLFInfo :: ClosureInfo -> LambdaFormInfo
1111 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
1112
1113 closureUpdReqd :: ClosureInfo -> Bool
1114
1115 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ upd _) _) = upd
1116 closureUpdReqd (MkClosureInfo _ LFBlackHole _)         = True
1117         -- Black-hole closures are allocated to receive the results of an
1118         -- alg case with a named default... so they need to be updated.
1119 closureUpdReqd other_closure                           = False
1120
1121 closureSingleEntry :: ClosureInfo -> Bool
1122
1123 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ upd _) _) = not upd
1124 closureSingleEntry other_closure                           = False
1125 \end{code}
1126
1127 Note: @closureType@ returns appropriately specialised tycon and
1128 datacons.
1129 \begin{code}
1130 closureType :: ClosureInfo -> Maybe (TyCon, [UniType], [Id])
1131
1132 -- First, a turgid special case.  When we are generating the
1133 -- standard code and info-table for Vaps (which is done when the function
1134 -- defn is encountered), we don't have a convenient Id to hand whose
1135 -- type is that of (f x y z).  So we need to figure out the type
1136 -- rather than take it from the Id. The Id is probably just "f"!
1137
1138 closureType (MkClosureInfo id (LFThunk _ _ _ (VapThunk fun_id args _)) _)
1139   = getUniDataSpecTyCon_maybe (funResultTy de_foralld_ty (length args))
1140   where
1141     (_, de_foralld_ty) = splitForalls (getIdUniType fun_id)
1142
1143 closureType (MkClosureInfo id lf _) = getUniDataSpecTyCon_maybe (getIdUniType id)
1144 \end{code}
1145
1146 @closureReturnsUnboxedType@ is used to check whether a closure, {\em
1147 once it has eaten its arguments}, returns an unboxed type.  For
1148 example, the closure for a function:
1149 \begin{verbatim}
1150         f :: Int -> Int#
1151 \end{verbatim}
1152 returns an unboxed type.  This is important when dealing with stack
1153 overflow checks.
1154 \begin{code}
1155 closureReturnsUnboxedType :: ClosureInfo -> Bool
1156
1157 closureReturnsUnboxedType (MkClosureInfo fun_id (LFReEntrant _ arity _) _)
1158   = isPrimType (funResultTy de_foralld_ty arity)
1159   where
1160     (_, de_foralld_ty) = splitForalls (getIdUniType fun_id)
1161
1162 closureReturnsUnboxedType other_closure = False
1163         -- All non-function closures aren't functions,
1164         -- and hence are boxed, since they are heap alloc'd
1165 \end{code}
1166
1167 \begin{code}
1168 closureSemiTag :: ClosureInfo -> Int
1169
1170 closureSemiTag (MkClosureInfo _ lf_info _)
1171   = case lf_info of
1172       LFCon data_con _ -> getDataConTag data_con - fIRST_TAG
1173       LFTuple _ _      -> 0
1174       LFIndirection    -> fromInteger iND_TAG
1175       _                -> fromInteger oTHER_TAG
1176 \end{code}
1177
1178 Label generation.
1179
1180 \begin{code}
1181 infoTableLabelFromCI :: ClosureInfo -> CLabel
1182
1183 infoTableLabelFromCI (MkClosureInfo id lf_info rep)
1184   = case lf_info of
1185         LFCon con _     -> mkConInfoPtr con rep
1186         LFTuple tup _   -> mkConInfoPtr tup rep
1187
1188         LFBlackHole     -> mkBlackHoleInfoTableLabel
1189
1190         LFThunk _ _ upd_flag (VapThunk fun_id args _) -> mkVapInfoTableLabel fun_id upd_flag
1191                                         -- Use the standard vap info table
1192                                         -- for the function, rather than a one-off one
1193                                         -- for this particular closure
1194
1195 {-      For now, we generate individual info table and entry code for selector thunks,
1196         so their info table should be labelled in the standard way.
1197         The only special thing about them is that the info table has a field which
1198         tells the GC that it really is a selector.
1199
1200         Later, perhaps, we'll have some standard RTS code for selector-thunk info tables,
1201         in which case this line will spring back to life.
1202
1203         LFThunk _ _ upd_flag (SelectorThunk _ _ offset) -> mkSelectorInfoTableLabel upd_flag offset
1204                                         -- Ditto for selectors
1205 -}
1206
1207         other -> if isStaticRep rep
1208                  then mkStaticInfoTableLabel id
1209                  else mkInfoTableLabel       id
1210
1211 mkConInfoPtr :: Id -> SMRep -> CLabel
1212 mkConInfoPtr id rep =
1213   case rep of
1214     PhantomRep      -> mkPhantomInfoTableLabel id
1215     StaticRep _ _   -> mkStaticInfoTableLabel  id
1216     _               -> mkInfoTableLabel        id
1217
1218 mkConEntryPtr :: Id -> SMRep -> CLabel
1219 mkConEntryPtr id rep =
1220   case rep of
1221     StaticRep _ _   -> mkStaticConEntryLabel id
1222     _               -> mkConEntryLabel id
1223
1224
1225 closureLabelFromCI (MkClosureInfo id _ _) = mkClosureLabel id
1226
1227 entryLabelFromCI :: ClosureInfo -> CLabel
1228 entryLabelFromCI (MkClosureInfo id lf_info rep)
1229   = case lf_info of
1230         LFThunk _ _ upd_flag std_form_info -> thunkEntryLabel id std_form_info upd_flag
1231         LFCon con _                        -> mkConEntryPtr con rep
1232         LFTuple tup _                      -> mkConEntryPtr tup rep
1233         other                              -> mkStdEntryLabel id
1234
1235 -- thunkEntryLabel is a local help function, not exported.  It's used from both
1236 -- entryLabelFromCI and getEntryConvention.
1237 -- I don't think it needs to deal with the SelectorThunk case
1238 -- Well, it's falling over now, so I've made it deal with it.  (JSM)
1239
1240 thunkEntryLabel thunk_id (VapThunk fun_id args _) is_updatable
1241   = mkVapEntryLabel fun_id is_updatable
1242 thunkEntryLabel thunk_id _ is_updatable
1243   = mkStdEntryLabel thunk_id
1244
1245 fastLabelFromCI :: ClosureInfo -> CLabel
1246 fastLabelFromCI (MkClosureInfo id _ _) = mkFastEntryLabel id fun_arity
1247   where
1248     arity_maybe = arityMaybe (getIdArity id)
1249     fun_arity   = case arity_maybe of
1250                     Just x -> x
1251                     _      -> pprPanic "fastLabelFromCI:no arity:" (ppr PprShowAll id)
1252 \end{code}
1253
1254 \begin{code}
1255 allocProfilingMsg :: ClosureInfo -> FAST_STRING
1256
1257 allocProfilingMsg (MkClosureInfo _ lf_info _)
1258   = case lf_info of
1259       LFReEntrant _ _ _         -> SLIT("ALLOC_FUN")
1260       LFCon _ _                 -> SLIT("ALLOC_CON")
1261       LFTuple _ _               -> SLIT("ALLOC_CON")
1262       LFThunk _ _ _ _           -> SLIT("ALLOC_THK")
1263       LFBlackHole               -> SLIT("ALLOC_BH")
1264       LFIndirection             -> panic "ALLOC_IND"
1265       LFImported                -> panic "ALLOC_IMP"
1266 \end{code}
1267
1268 We need a black-hole closure info to pass to @allocDynClosure@
1269 when we want to allocate the black hole on entry to a CAF.
1270
1271 \begin{code}
1272 blackHoleClosureInfo (MkClosureInfo id _ _) = MkClosureInfo id LFBlackHole BlackHoleRep
1273 \end{code}
1274
1275 The register liveness when returning from a constructor.  For simplicity,
1276 we claim just [node] is live for all but PhantomRep's.  In truth, this means
1277 that non-constructor info tables also claim node, but since their liveness
1278 information is never used, we don't care.
1279
1280 \begin{code}
1281
1282 dataConLiveness (MkClosureInfo con _ PhantomRep)
1283   = case dataReturnConvAlg con of
1284       ReturnInRegs regs -> mkLiveRegsBitMask regs
1285       ReturnInHeap -> panic "dataConLiveness:PhantomRep in heap???"
1286
1287 dataConLiveness _ = mkLiveRegsBitMask [node]
1288 \end{code}
1289
1290 %************************************************************************
1291 %*                                                                      *
1292 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1293 %*                                                                      *
1294 %************************************************************************
1295
1296 Profiling requires three pices of information to be determined for
1297 each closure's info table --- kind, description and type.
1298
1299 The description is stored directly in the @CClosureInfoTable@ when the
1300 info table is built.
1301
1302 The kind is determined from the @LambdaForm@ stored in the closure
1303 info using @closureKind@.
1304
1305 The type is determined from the type information stored with the @Id@
1306 in the closure info using @closureTypeDescr@.
1307
1308 \begin{code}
1309 closureKind :: ClosureInfo -> String
1310
1311 closureKind (MkClosureInfo _ lf _)
1312   = case lf of
1313       LFReEntrant _ n _         -> if n > 0 then "FN_K" else "THK_K"
1314       LFCon _ _                 -> "CON_K"
1315       LFTuple _ _               -> "CON_K"
1316       LFThunk _ _ _ _           -> "THK_K"
1317       LFBlackHole               -> "THK_K" -- consider BHs as thunks for the moment... (ToDo?)
1318       LFIndirection             -> panic "IND_KIND"
1319       LFImported                -> panic "IMP_KIND"
1320
1321 closureTypeDescr :: ClosureInfo -> String
1322 closureTypeDescr (MkClosureInfo id lf _)
1323   = if (isDataCon id) then                      -- DataCon has function types
1324         _UNPK_ (getOccurrenceName (getDataConTyCon id)) -- We want the TyCon not the ->
1325     else
1326         getUniTyDescription (getIdUniType id)
1327 \end{code}
1328