ghc/compiler/codeGen/ClosureInfo.lhs

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