ClosureInfo.lhs 36.3 KB
 simonm committed Dec 02, 1998 1 %  Simon Marlow committed Oct 11, 2006 2 % (c) The University of Glasgow 2006  simonmar committed Aug 13, 2004 3 % (c) The Univserity of Glasgow 1992-2004  simonm committed Dec 02, 1998 4 %  simonmar committed Aug 13, 2004 5 6 7 8 9  Data structures which describe closures, and operations over those data structures Nothing monadic in here  partain committed Jan 08, 1996 10 11 12 13 14  Much of the rationale for these things is in the details'' part of the STG paper. \begin{code}  Ian Lynagh committed Nov 04, 2011 15 16 17 18 19 20 21 {-# OPTIONS -fno-warn-tabs #-} -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and -- detab the module (please do the detabbing in a separate patch). See -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- for details  partain committed Jan 08, 1996 22 module ClosureInfo (  Michael D. Adams committed Jun 27, 2007 23 24 25  ClosureInfo(..), LambdaFormInfo(..), -- would be abstract but StandardFormInfo(..), -- mkCmmInfo looks inside SMRep,  partain committed Jan 08, 1996 26   Simon Marlow committed Aug 25, 2011 27  ArgDescr(..), Liveness,  simonmar committed Aug 13, 2004 28  C_SRT(..), needsSRT,  partain committed Jan 08, 1996 29   simonmar committed Aug 13, 2004 30  mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,  simonm committed Dec 02, 1998 31  mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,  partain committed Jan 08, 1996 32   Simon Marlow committed Jul 27, 2007 33  mkClosureInfo, mkConInfo, maybeIsLFCon,  Simon Marlow committed Aug 25, 2011 34  closureSize,  simonmar committed Aug 13, 2004 35   Simon Marlow committed Aug 25, 2011 36  ConTagZ, dataConTagZ,  partain committed Jan 08, 1996 37   38  infoTableLabelFromCI, entryLabelFromCI,  dias@eecs.harvard.edu committed Aug 14, 2008 39  closureLabelFromCI,  Ian Lynagh committed Dec 29, 2008 40  isLFThunk, closureUpdReqd,  simonmar committed Apr 21, 2005 41  closureNeedsUpdSpace, closureIsThunk,  simonmar committed Aug 13, 2004 42  closureSingleEntry, closureReEntrant, isConstrClosure_maybe,  Simon Marlow committed Aug 25, 2011 43  closureFunInfo, isKnownFun,  batterseapower committed Jul 28, 2011 44  funTag, funTagLFInfo, tagForArity, clHasCafRefs,  partain committed Jan 08, 1996 45   Simon Marlow committed Jan 04, 2012 46  enterIdLabel, enterReturnPtLabel,  simonmar committed Aug 13, 2004 47 48 49  nodeMustPointToIt, CallMethod(..), getCallMethod,  sof committed Aug 02, 1997 50   sof committed May 19, 1997 51  blackHoleOnEntry,  partain committed Jan 08, 1996 52   partain committed Mar 19, 1996 53  staticClosureRequired,  partain committed Jan 08, 1996 54   partain committed Jun 26, 1996 55  isToplevClosure,  simonmar committed Aug 13, 2004 56  closureValDescr, closureTypeDescr, -- profiling  partain committed Jan 08, 1996 57   58  isStaticClosure,  Simon Marlow committed Nov 18, 2008 59  cafBlackHoleClosureInfo,  simonm committed Mar 11, 1999 60 61  staticClosureNeedsLink,  Simon Peyton Jones committed Aug 25, 2011 62 63 64 65 66 67 68 69 70 71 72  -- CgRep and its functions CgRep(..), nonVoidArg, argMachRep, primRepToCgRep, isFollowableArg, isVoidArg, isFloatingArg, is64BitArg, separateByPtrFollowness, cgRepSizeW, cgRepSizeB, retAddrSizeW, typeCgRep, idCgRep, tyConCgRep,  partain committed Jan 08, 1996 73 74  ) where  simonmar committed Dec 11, 2002 75 #include "../includes/MachDeps.h"  simonm committed Jan 08, 1998 76 #include "HsVersions.h"  partain committed Apr 05, 1996 77   partain committed Jan 08, 1996 78 import StgSyn  Simon Marlow committed Oct 11, 2006 79 import SMRep  partain committed Jan 08, 1996 80   simonmar committed Dec 11, 2002 81 import CLabel  Simon Marlow committed Aug 25, 2011 82 import Cmm  Ian Lynagh committed Dec 29, 2008 83 import Unique  Simon Marlow committed Oct 11, 2006 84 import StaticFlags  Ian Lynagh committed Dec 29, 2008 85 import Var  Simon Marlow committed Oct 11, 2006 86 import Id  dias@eecs.harvard.edu committed Aug 14, 2008 87 import IdInfo  Simon Marlow committed Oct 11, 2006 88 89 90 91 92 93 94 import DataCon import Name import Type import TypeRep import TcType import TyCon import BasicTypes  simonm committed Jan 08, 1998 95 import Outputable  Simon Peyton Jones committed Aug 25, 2011 96 import FastString  simonmar committed Dec 11, 2002 97 import Constants  Ian Lynagh committed Dec 18, 2008 98 import DynFlags  partain committed Jan 08, 1996 99 100 \end{code}  simonmar committed Aug 13, 2004 101   partain committed Jan 08, 1996 102 103 104 105 106 107 %************************************************************************ %* * \subsection[ClosureInfo-datatypes]{Data types for closure information} %* * %************************************************************************  simonmar committed Dec 11, 2002 108 109 110 111 112 113 114 115 116 117 118 119 Information about a closure, from the code generator's point of view. A ClosureInfo decribes the info pointer of a closure. It has enough information a) to construct the info table itself b) to allocate a closure containing that info pointer (i.e. it knows the info table label) We make a ClosureInfo for - each let binding (both top level and not) - each data constructor (for its shared static and dynamic info tables)  simonpj committed Sep 26, 2001 120 121 122  \begin{code} data ClosureInfo  simonmar committed Dec 11, 2002 123 124 125 126 127  = ClosureInfo { closureName :: !Name, -- The thing bound to this closure closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below) closureSMRep :: !SMRep, -- representation used by storage mgr closureSRT :: !C_SRT, -- What SRT applies to this closure  Simon Marlow committed Aug 25, 2011 128  closureType :: !Type, -- Type of closure (ToDo: remove)  batterseapower committed Jul 07, 2011 129 130  closureDescr :: !String, -- closure description (for profiling) closureInfLcl :: Bool -- can the info pointer be a local symbol?  simonmar committed Dec 11, 2002 131 132  }  simonmar committed Aug 13, 2004 133  -- Constructor closures don't have a unique info table label (they use  simonmar committed Dec 11, 2002 134 135 136  -- the constructor's info table), and they don't have an SRT. | ConInfo { closureCon :: !DataCon,  Clemens Fruhwirth committed Jul 31, 2007 137  closureSMRep :: !SMRep  simonpj committed Sep 26, 2001 138 139 140  } \end{code}  partain committed Jan 08, 1996 141 142 143 144 145 146 %************************************************************************ %* * \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info} %* * %************************************************************************  simonmar committed Dec 11, 2002 147 148 149 150 151 152 153 154 Information about an identifier, from the code generator's point of view. Every identifier is bound to a LambdaFormInfo in the environment, which gives the code generator enough info to be able to tail call or return that identifier. Note that a closure is usually bound to an identifier, so a ClosureInfo contains a LambdaFormInfo.  partain committed Jan 08, 1996 155 156 \begin{code} data LambdaFormInfo  simonmar committed Dec 11, 2002 157  = LFReEntrant -- Reentrant closure (a function)  simonm committed Dec 02, 1998 158  TopLevelFlag -- True if top level  simonmar committed Aug 13, 2004 159  !Int -- Arity. Invariant: always > 0  simonm committed Dec 02, 1998 160  !Bool -- True <=> no fvs  simonmar committed Dec 11, 2002 161  ArgDescr -- Argument descriptor (should reall be in ClosureInfo)  partain committed Jan 08, 1996 162   simonmar committed Aug 13, 2004 163  | LFCon -- A saturated constructor application  simonm committed Dec 02, 1998 164  DataCon -- The constructor  partain committed Mar 19, 1996 165   partain committed Jan 08, 1996 166  | LFThunk -- Thunk (zero arity)  simonm committed Dec 02, 1998 167 168  TopLevelFlag !Bool -- True <=> no free vars  simonmar committed Dec 11, 2002 169  !Bool -- True <=> updatable (i.e., *not* single-entry)  partain committed Jan 08, 1996 170  StandardFormInfo  simonmar committed Dec 11, 2002 171  !Bool -- True <=> *might* be a function type  partain committed Jan 08, 1996 172   simonmar committed Dec 11, 2002 173 174 175  | LFUnknown -- Used for function arguments and imported things. -- We know nothing about this closure. Treat like -- updatable "LFThunk"...  partain committed Jan 08, 1996 176 177 178  -- Imported things which we do know something about use -- one of the other LF constructors (eg LFReEntrant for -- known functions)  simonmar committed Dec 11, 2002 179  !Bool -- True <=> *might* be a function type  partain committed Jan 08, 1996 180 181 182  | LFLetNoEscape -- See LetNoEscape module for precise description of -- these "lets".  simonmar committed Dec 11, 2002 183  !Int -- arity;  partain committed Jan 08, 1996 184 185 186 187 188 189  | LFBlackHole -- Used for the closures allocated to hold the result -- of a CAF. We want the target of the update frame to -- be in the heap, so we make a black hole to hold it.  partain committed Mar 19, 1996 190   simonmar committed Aug 13, 2004 191 192 193 ------------------------- -- StandardFormInfo tells whether this thunk has one of -- a small number of standard forms  partain committed Jan 08, 1996 194   simonmar committed Aug 13, 2004 195 196 197 data StandardFormInfo = NonStandardThunk -- Not of of the standard forms  partain committed Jan 08, 1996 198   simonmar committed Aug 13, 2004 199 200 201 202 203 204 205 206  | SelectorThunk -- A SelectorThunk is of form -- case x of -- con a1,..,an -> ak -- and the constructor is from a single-constr type. WordOff -- 0-origin offset of ak within the "goods" of -- constructor (Recall that the a1,...,an may be laid -- out in the heap in a non-obvious order.)  partain committed Jan 08, 1996 207   simonmar committed Aug 13, 2004 208 209 210 211 212 213 214  | ApThunk -- An ApThunk is of form -- x1 ... xn -- The code for the thunk just pushes x2..xn on the stack and enters x1. -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled -- in the RTS to save space. Int -- Arity, n  partain committed Jan 08, 1996 215 216 \end{code}  Simon Peyton Jones committed Aug 25, 2011 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358  %************************************************************************ %* * CgRep %* * %************************************************************************ An CgRep is an abstraction of a Type which tells the code generator all it needs to know about the calling convention for arguments (and results) of that type. In particular, the ArgReps of a function's arguments are used to decide which of the RTS's generic apply functions to call when applying an unknown function. It contains more information than the back-end data type MachRep, so one can easily convert from CgRep -> MachRep. (Except that there's no MachRep for a VoidRep.) It distinguishes pointers from non-pointers (we sort the pointers together when building closures) void from other types: a void argument is different from no argument All 64-bit types map to the same CgRep, because they're passed in the same register, but a PtrArg is still different from an NonPtrArg because the function's entry convention has to take into account the pointer-hood of arguments for the purposes of describing the stack on entry to the garbage collector. \begin{code} data CgRep = VoidArg -- Void | PtrArg -- Word-sized heap pointer, followed -- by the garbage collector | NonPtrArg -- Word-sized non-pointer -- (including addresses not followed by GC) | LongArg -- 64-bit non-pointer | FloatArg -- 32-bit float | DoubleArg -- 64-bit float deriving Eq instance Outputable CgRep where ppr VoidArg = ptext (sLit "V_") ppr PtrArg = ptext (sLit "P_") ppr NonPtrArg = ptext (sLit "I_") ppr LongArg = ptext (sLit "L_") ppr FloatArg = ptext (sLit "F_") ppr DoubleArg = ptext (sLit "D_") argMachRep :: CgRep -> CmmType argMachRep PtrArg = gcWord argMachRep NonPtrArg = bWord argMachRep LongArg = b64 argMachRep FloatArg = f32 argMachRep DoubleArg = f64 argMachRep VoidArg = panic "argMachRep:VoidRep" primRepToCgRep :: PrimRep -> CgRep primRepToCgRep VoidRep = VoidArg primRepToCgRep PtrRep = PtrArg primRepToCgRep IntRep = NonPtrArg primRepToCgRep WordRep = NonPtrArg primRepToCgRep Int64Rep = LongArg primRepToCgRep Word64Rep = LongArg primRepToCgRep AddrRep = NonPtrArg primRepToCgRep FloatRep = FloatArg primRepToCgRep DoubleRep = DoubleArg idCgRep :: Id -> CgRep idCgRep x = typeCgRep . idType $x tyConCgRep :: TyCon -> CgRep tyConCgRep = primRepToCgRep . tyConPrimRep typeCgRep :: Type -> CgRep typeCgRep = primRepToCgRep . typePrimRep \end{code} Whether or not the thing is a pointer that the garbage-collector should follow. Or, to put it another (less confusing) way, whether the object in question is a heap object. Depending on the outcome, this predicate determines what stack the pointer/object possibly will have to be saved onto, and the computation of GC liveness info. \begin{code} isFollowableArg :: CgRep -> Bool -- True <=> points to a heap object isFollowableArg PtrArg = True isFollowableArg _ = False isVoidArg :: CgRep -> Bool isVoidArg VoidArg = True isVoidArg _ = False nonVoidArg :: CgRep -> Bool nonVoidArg VoidArg = False nonVoidArg _ = True -- isFloatingArg is used to distinguish @Double@ and @Float@ which -- cause inadvertent numeric conversions if you aren't jolly careful. -- See codeGen/CgCon:cgTopRhsCon. isFloatingArg :: CgRep -> Bool isFloatingArg DoubleArg = True isFloatingArg FloatArg = True isFloatingArg _ = False is64BitArg :: CgRep -> Bool is64BitArg LongArg = True is64BitArg _ = False \end{code} \begin{code} separateByPtrFollowness :: [(CgRep,a)] -> ([(CgRep,a)], [(CgRep,a)]) -- Returns (ptrs, non-ptrs) separateByPtrFollowness things = sep_things things [] [] -- accumulating params for follow-able and don't-follow things... where sep_things [] bs us = (reverse bs, reverse us) sep_things ((PtrArg,a):ts) bs us = sep_things ts ((PtrArg,a):bs) us sep_things (t :ts) bs us = sep_things ts bs (t:us) \end{code} \begin{code} cgRepSizeB :: CgRep -> ByteOff cgRepSizeB DoubleArg = dOUBLE_SIZE cgRepSizeB LongArg = wORD64_SIZE cgRepSizeB VoidArg = 0 cgRepSizeB _ = wORD_SIZE cgRepSizeW :: CgRep -> ByteOff cgRepSizeW DoubleArg = dOUBLE_SIZE quot wORD_SIZE cgRepSizeW LongArg = wORD64_SIZE quot wORD_SIZE cgRepSizeW VoidArg = 0 cgRepSizeW _ = 1 retAddrSizeW :: WordOff retAddrSizeW = 1 -- One word \end{code}  partain committed Jan 08, 1996 359 360 361 362 363 364 365 %************************************************************************ %* * \subsection[ClosureInfo-construction]{Functions which build LFInfos} %* * %************************************************************************ \begin{code}  simonmar committed Aug 13, 2004 366 367 368 369 370 371 372 373 374 mkLFReEntrant :: TopLevelFlag -- True of top level -> [Id] -- Free vars -> [Id] -- Args -> ArgDescr -- Argument descriptor -> LambdaFormInfo mkLFReEntrant top fvs args arg_descr = LFReEntrant top (length args) (null fvs) arg_descr  Ian Lynagh committed Dec 29, 2008 375 mkLFThunk :: Type -> TopLevelFlag -> [Var] -> UpdateFlag -> LambdaFormInfo  simonmar committed Aug 13, 2004 376 mkLFThunk thunk_ty top fvs upd_flag  simonpj@microsoft.com committed Jan 13, 2009 377  = ASSERT2( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty), ppr thunk_ty$$ppr fvs )  simonmar committed Aug 13, 2004 378 379 380 381  LFThunk top (null fvs) (isUpdatable upd_flag) NonStandardThunk (might_be_a_function thunk_ty)  simonmar committed Dec 11, 2002 382 383  might_be_a_function :: Type -> Bool  simonpj@microsoft.com committed Oct 18, 2006 384 385 -- Return False only if we are *sure* it's a data type -- Look through newtypes etc as much as poss  simonmar committed Dec 11, 2002 386 might_be_a_function ty  Simon Peyton Jones committed Aug 03, 2011 387 388 389  = case tyConAppTyCon_maybe (repType ty) of Just tc -> not (isDataTyCon tc) Nothing -> True  partain committed Jan 08, 1996 390 391 392 393 394 395 \end{code} @mkConLFInfo@ is similar, for constructors. \begin{code} mkConLFInfo :: DataCon -> LambdaFormInfo  simonmar committed Dec 11, 2002 396 mkConLFInfo con = LFCon con  partain committed Jan 08, 1996 397   Simon Marlow committed Jul 27, 2007 398 399 400 401 maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon maybeIsLFCon (LFCon con) = Just con maybeIsLFCon _ = Nothing  Ian Lynagh committed Dec 29, 2008 402 mkSelectorLFInfo :: Id -> WordOff -> Bool -> LambdaFormInfo  simonmar committed Dec 11, 2002 403 404 405 mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) (might_be_a_function (idType id))  simonpj committed Dec 19, 1996 406   Ian Lynagh committed Dec 29, 2008 407 mkApLFInfo :: Id -> UpdateFlag -> Int -> LambdaFormInfo  simonmar committed Dec 11, 2002 408 409 410 mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) (might_be_a_function (idType id))  partain committed Jan 08, 1996 411 412 \end{code}  simonm committed Dec 02, 1998 413 414 415 Miscellaneous LF-infos. \begin{code}  Ian Lynagh committed Dec 29, 2008 416 mkLFArgument :: Id -> LambdaFormInfo  simonmar committed Dec 11, 2002 417 418 mkLFArgument id = LFUnknown (might_be_a_function (idType id))  Ian Lynagh committed Dec 29, 2008 419 mkLFLetNoEscape :: Int -> LambdaFormInfo  simonm committed Dec 02, 1998 420 421 422 423 mkLFLetNoEscape = LFLetNoEscape mkLFImported :: Id -> LambdaFormInfo mkLFImported id  simonpj committed Oct 18, 2001 424  = case idArity id of  simonmar committed Dec 11, 2002 425  n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0  Ian Lynagh committed Dec 29, 2008 426  _ -> mkLFArgument id -- Not sure of exact arity  simonm committed Dec 02, 1998 427 \end{code}  partain committed Jan 08, 1996 428   simonmar committed Apr 21, 2005 429 430 431 \begin{code} isLFThunk :: LambdaFormInfo -> Bool isLFThunk (LFThunk _ _ _ _ _) = True  batterseapower committed Jul 28, 2011 432 isLFThunk LFBlackHole = True  simonmar committed Apr 21, 2005 433 434 435 436 437 438  -- return True for a blackhole: this function is used to determine -- whether to use the thunk header in SMP mode, and a blackhole -- must have one. isLFThunk _ = False \end{code}  Simon Marlow committed Aug 25, 2011 439 440 441 442 443 444 445 446 447 448 \begin{code} -- We keep the *zero-indexed* tag in the srt_len field of the info -- table of a data constructor. type ConTagZ = Int -- A *zero-indexed* contructor tag dataConTagZ :: DataCon -> ConTagZ dataConTagZ con = dataConTag con - fIRST_TAG \end{code}  simonmar committed Aug 13, 2004 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 %************************************************************************ %* * Building ClosureInfos %* * %************************************************************************ \begin{code} mkClosureInfo :: Bool -- Is static -> Id -> LambdaFormInfo -> Int -> Int -- Total and pointer words -> C_SRT -> String -- String descriptor -> ClosureInfo mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr = ClosureInfo { closureName = name, closureLFInfo = lf_info, closureSMRep = sm_rep, closureSRT = srt_info, closureType = idType id,  batterseapower committed Jul 07, 2011 469 470 471 472 473 474  closureDescr = descr, closureInfLcl = isDataConWorkId id } -- Make the _info pointer for the implicit datacon worker binding -- local. The reason we can do this is that importing code always -- either uses the _closure or _con_info. By the invariants in CorePrep -- anything else gets eta expanded.  simonmar committed Aug 13, 2004 475 476  where name = idName id  Simon Marlow committed Aug 25, 2011 477 478  sm_rep = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info) nonptr_wds = tot_wds - ptr_wds  simonmar committed Aug 13, 2004 479   Clemens Fruhwirth committed Jul 31, 2007 480 mkConInfo :: Bool -- Is static  simonmar committed Aug 13, 2004 481 482 483  -> DataCon -> Int -> Int -- Total and pointer words -> ClosureInfo  Clemens Fruhwirth committed Jul 31, 2007 484 mkConInfo is_static data_con tot_wds ptr_wds  simonmar committed Aug 13, 2004 485  = ConInfo { closureSMRep = sm_rep,  Clemens Fruhwirth committed Jul 31, 2007 486  closureCon = data_con }  simonmar committed Aug 13, 2004 487  where  Simon Marlow committed Aug 25, 2011 488 489 490  sm_rep = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info) lf_info = mkConLFInfo data_con nonptr_wds = tot_wds - ptr_wds  simonmar committed Aug 13, 2004 491 492 \end{code}  partain committed Jan 08, 1996 493 494 495 496 497 498 499 %************************************************************************ %* * \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}} %* * %************************************************************************ \begin{code}  simonmar committed Aug 13, 2004 500 closureSize :: ClosureInfo -> WordOff  Simon Marlow committed Aug 25, 2011 501 closureSize cl_info = heapClosureSize (closureSMRep cl_info)  partain committed Jan 08, 1996 502 503 504 \end{code} \begin{code}  simonmar committed Apr 21, 2005 505 506 507 508 -- we leave space for an update if either (a) the closure is updatable -- or (b) it is a static thunk. This is because a static thunk needs -- a static link field in a predictable place (after the slop), regardless -- of whether it is updatable or not.  Ian Lynagh committed Dec 29, 2008 509 closureNeedsUpdSpace :: ClosureInfo -> Bool  simonmar committed Apr 21, 2005 510 511 512 closureNeedsUpdSpace (ClosureInfo { closureLFInfo = LFThunk TopLevel _ _ _ _ }) = True closureNeedsUpdSpace cl_info = closureUpdReqd cl_info  partain committed Jan 08, 1996 513 514 515 516 517 518 519 520 521 \end{code} %************************************************************************ %* * \subsection[SMreps]{Choosing SM reps} %* * %************************************************************************ \begin{code}  Simon Marlow committed Aug 25, 2011 522 523 524 525 526 527 lfClosureType :: LambdaFormInfo -> ClosureTypeInfo lfClosureType (LFReEntrant _ arity _ argd) = Fun (fromIntegral arity) argd lfClosureType (LFCon con) = Constr (fromIntegral (dataConTagZ con)) (dataConIdentity con) lfClosureType (LFThunk _ _ _ is_sel _) = thunkClosureType is_sel lfClosureType _ = panic "lfClosureType"  partain committed Jan 08, 1996 528   Simon Marlow committed Aug 25, 2011 529 530 531 thunkClosureType :: StandardFormInfo -> ClosureTypeInfo thunkClosureType (SelectorThunk off) = ThunkSelector (fromIntegral off) thunkClosureType _ = Thunk  simonm committed Mar 04, 1999 532   simonmar committed Aug 13, 2004 533 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g  simonm committed Mar 04, 1999 534 535 536 -- gets compiled to a jump to g (if g has non-zero arity), instead of -- messing around with update frames and PAPs. We set the closure type -- to FUN_STATIC in this case.  partain committed Jan 08, 1996 537 538 539 540 541 542 543 544 545 546 547 \end{code} %************************************************************************ %* * \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@} %* * %************************************************************************ Be sure to see the stg-details notes about these... \begin{code}  simonmar committed Aug 13, 2004 548 549 550 551 nodeMustPointToIt :: LambdaFormInfo -> Bool nodeMustPointToIt (LFReEntrant top _ no_fvs _) = not no_fvs || -- Certainly if it has fvs we need to point to it isNotTopLevel top  simonm committed Dec 02, 1998 552  -- If it is not top level we will point to it  partain committed Jan 08, 1996 553 554 555 556 557 558 559 560  -- We can have a \r closure with no_fvs which -- is not top level as special case cgRhsClosure -- has been dissabled in favour of let floating -- For lex_profiling we also access the cost centre for a -- non-inherited function i.e. not top level -- the not top case above ensures this is ok.  simonmar committed Aug 13, 2004 561 nodeMustPointToIt (LFCon _) = True  partain committed Jan 08, 1996 562 563 564 565 566 567 568 569 570 571 572 573  -- Strictly speaking, the above two don't need Node to point -- to it if the arity = 0. But this is a *really* unlikely -- situation. If we know it's nil (say) and we are entering -- it. Eg: let x = [] in x then we will certainly have inlined -- x, since nil is a simple atom. So we gain little by not -- having Node point to known zero-arity things. On the other -- hand, we do lose something; Patrick's code for figuring out -- when something has been updated but not entered relies on -- having Node point to the result of an update. SLPJ -- 27/11/92.  simonmar committed Aug 13, 2004 574 575 nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _) = updatable || not no_fvs || opt_SccProfilingOn  partain committed Jan 08, 1996 576 577 578 579 580 581 582  -- For the non-updatable (single-entry case): -- -- True if has fvs (in which case we need access to them, and we -- should black-hole it) -- or profiling (in which case we need to recover the cost centre -- from inside it)  Ian Lynagh committed Dec 29, 2008 583 nodeMustPointToIt (LFThunk _ _ _ _ _)  simonmar committed Aug 13, 2004 584  = True -- Node must point to any standard-form thunk  sof committed Jul 05, 1997 585   simonmar committed Aug 13, 2004 586 nodeMustPointToIt (LFUnknown _) = True  batterseapower committed Jul 28, 2011 587 nodeMustPointToIt LFBlackHole = True -- BH entry may require Node to point  simonmar committed Aug 13, 2004 588 nodeMustPointToIt (LFLetNoEscape _) = False  partain committed Jan 08, 1996 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 \end{code} The entry conventions depend on the type of closure being entered, whether or not it has free variables, and whether we're running sequentially or in parallel. \begin{tabular}{lllll} Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\ Unknown & no & yes & stack & node \\ Known fun ($\ge$1 arg), no fvs & no & no & registers & fast entry (enough args) \\ \ & \ & \ & \ & slow entry (otherwise) \\ Known fun ($\ge$1 arg), fvs & no & yes & registers & fast entry (enough args) \\ 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\ 0 arg, no fvs @\u@ & no & yes & n/a & node \\ 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\ 0 arg, fvs @\u@ & no & yes & n/a & node \\ Unknown & yes & yes & stack & node \\ Known fun ($\ge$1 arg), no fvs & yes & no & registers & fast entry (enough args) \\ \ & \ & \ & \ & slow entry (otherwise) \\ Known fun ($\ge$1 arg), fvs & yes & yes & registers & node \\ 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\ 0 arg, no fvs @\u@ & yes & yes & n/a & node \\ 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\ 0 arg, fvs @\u@ & yes & yes & n/a & node\\ \end{tabular}  partain committed Mar 19, 1996 616 When black-holing, single-entry closures could also be entered via node  partain committed Jan 08, 1996 617 618 619 (rather than directly) to catch double-entry. \begin{code}  simonmar committed Aug 13, 2004 620 data CallMethod  simonmar committed Dec 11, 2002 621  = EnterIt -- no args, not a function  partain committed Jan 08, 1996 622   simonmar committed Dec 11, 2002 623 624 625 626 627 628 629  | JumpToIt CLabel -- no args, not a function, but we -- know what its entry code is | ReturnIt -- it's a function, but we have -- zero args to apply to it, so just -- return it.  simonmar committed Aug 13, 2004 630 631  | ReturnCon DataCon -- It's a data constructor, just return it  simonmar committed Dec 11, 2002 632 633  | SlowCall -- Unknown fun, or known fun with -- too few args.  partain committed Jan 08, 1996 634   simonm committed Dec 02, 1998 635  | DirectEntry -- Jump directly, with args in regs  partain committed Jan 08, 1996 636 637  CLabel -- The code label Int -- Its arity  simonmar committed Aug 13, 2004 638   Ian Lynagh committed Dec 18, 2008 639 640 getCallMethod :: DynFlags -> Name -- Function being applied  dias@eecs.harvard.edu committed Aug 14, 2008 641  -> CafInfo -- Can it refer to CAF's?  simonmar committed Aug 13, 2004 642 643 644 645  -> LambdaFormInfo -- Its info -> Int -- Number of available arguments -> CallMethod  Ian Lynagh committed Dec 29, 2008 646 getCallMethod _ _ _ lf_info _  simonmar committed Aug 13, 2004 647 648 649 650 651 652  | nodeMustPointToIt lf_info && opt_Parallel = -- If we're parallel, then we must always enter via node. -- The reason is that the closure may have been -- fetched since we allocated it. EnterIt  Ian Lynagh committed Dec 18, 2008 653 getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args  simonmar committed Aug 13, 2004 654 655 656  | n_args == 0 = ASSERT( arity /= 0 ) ReturnIt -- No args at all | n_args < arity = SlowCall -- Not enough args  dias@eecs.harvard.edu committed Aug 14, 2008 657  | otherwise = DirectEntry (enterIdLabel name caf) arity  simonmar committed Aug 13, 2004 658   Ian Lynagh committed Dec 29, 2008 659 getCallMethod _ _ _ (LFCon con) n_args  Simon Marlow committed Mar 17, 2009 660 661 662 663  | opt_SccProfilingOn -- when profiling, we must always enter = EnterIt -- a closure when we use it, so that the closure -- can be recorded as used for LDV profiling. | otherwise  simonmar committed Aug 13, 2004 664 665 666  = ASSERT( n_args == 0 ) ReturnCon con  Simon Marlow committed Mar 25, 2010 667 getCallMethod _dflags _name _caf (LFThunk _ _ _updatable _std_form_info is_fun) _n_args  Thomas Schilling committed Jul 20, 2008 668 669  | is_fun -- it *might* be a function, so we must "call" it (which is -- always safe)  simonpj@microsoft.com committed Oct 18, 2006 670  = SlowCall -- We cannot just enter it [in eval/apply, the entry code  simonmar committed Aug 13, 2004 671 672  -- is the fast-entry code]  simonpj@microsoft.com committed Oct 18, 2006 673  -- Since is_fun is False, we are *definitely* looking at a data value  Simon Marlow committed Mar 25, 2010 674  | otherwise  chevalier@alum.wellesley.edu committed Jan 11, 2007 675 676 677 678 679 680 681  = EnterIt -- We used to have ASSERT( n_args == 0 ), but actually it is -- possible for the optimiser to generate -- let bot :: Int = error Int "urk" -- in (bot cast unsafeCoerce Int (Int -> Int)) 3 -- This happens as a result of the case-of-error transformation -- So the right thing to do is just to enter the thing  partain committed Jan 08, 1996 682   Simon Marlow committed Mar 25, 2010 683 684 685 686 687 688 689 690 691 692 -- Old version: -- | updatable || doingTickyProfiling dflags -- to catch double entry -- = EnterIt -- | otherwise -- Jump direct to code for single-entry thunks -- = JumpToIt (thunkEntryLabel name caf std_form_info updatable) -- -- Now we never use JumpToIt, even if the thunk is single-entry, since -- the thunk may have already been entered and blackholed by another -- processor.  simonmar committed Aug 13, 2004 693   Ian Lynagh committed Dec 29, 2008 694 getCallMethod _ _ _ (LFUnknown True) _  simonpj@microsoft.com committed Sep 18, 2008 695  = SlowCall -- Might be a function  simonmar committed Aug 13, 2004 696   Ian Lynagh committed Dec 18, 2008 697 getCallMethod _ name _ (LFUnknown False) n_args  simonpj@microsoft.com committed Sep 18, 2008 698 699 700 701 702 703  | n_args > 0 = WARN( True, ppr name <+> ppr n_args ) SlowCall -- Note [Unsafe coerce complications] | otherwise = EnterIt -- Not a function  partain committed Jan 08, 1996 704   batterseapower committed Jul 28, 2011 705 getCallMethod _ _ _ LFBlackHole _  simonmar committed Aug 13, 2004 706 707 708 709  = SlowCall -- Presumably the black hole has by now -- been updated, but we don't know with -- what, so we slow call it  Ian Lynagh committed Dec 29, 2008 710 getCallMethod _ name _ (LFLetNoEscape 0) _  simonmar committed Aug 13, 2004 711 712  = JumpToIt (enterReturnPtLabel (nameUnique name))  Ian Lynagh committed Dec 18, 2008 713 getCallMethod _ name _ (LFLetNoEscape arity) n_args  simonmar committed Aug 13, 2004 714 715 716  | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)  Simon Marlow committed Aug 25, 2011 717   Simon Marlow committed Sep 06, 2011 718 719 720 blackHoleOnEntry :: ClosureInfo -> Bool blackHoleOnEntry ConInfo{} = False blackHoleOnEntry cl_info  Simon Marlow committed Aug 25, 2011 721  | isStaticRep (closureSMRep cl_info)  simonpj committed Sep 26, 2001 722  = False -- Never black-hole a static closure  partain committed Jan 08, 1996 723   simonpj committed Sep 26, 2001 724  | otherwise  Simon Marlow committed Aug 25, 2011 725  = case closureLFInfo cl_info of  simonpj committed Sep 26, 2001 726  LFReEntrant _ _ _ _ -> False  Simon Marlow committed Aug 25, 2011 727  LFLetNoEscape _ -> False  Simon Marlow committed Sep 06, 2011 728  LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks.  Simon Marlow committed Aug 25, 2011 729  _other -> panic "blackHoleOnEntry" -- Should never happen  partain committed Jan 08, 1996 730   simonmar committed Aug 13, 2004 731 732 733 734 isKnownFun :: LambdaFormInfo -> Bool isKnownFun (LFReEntrant _ _ _ _) = True isKnownFun (LFLetNoEscape _) = True isKnownFun _ = False  simonm committed Mar 11, 1999 735 736 \end{code}  simonpj@microsoft.com committed Sep 18, 2008 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 Note [Unsafe coerce complications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In some (badly-optimised) DPH code we see this Module X: rr :: Int = error Int "Urk" Module Y: ...((X.rr |> g) True) ... where g is an (unsafe) coercion of kind (Int ~ Bool->Bool), say It's badly optimised, because knowing that 'X.rr' is bottom, we should have dumped the application to True. But it should still work. These strange unsafe coercions arise from the case-of-error transformation: (case (error Int "foo") of { ... }) True ---> (error Int "foo" |> g) True Anyway, the net effect is that in STG-land, when casts are discarded, we *can* see a value of type Int applied to an argument. This only happens if (a) the programmer made a mistake, or (b) the value of type Int is actually bottom. So it's wrong to trigger an ASSERT failure in this circumstance. Instead we now emit a WARN -- mainly to draw attention to a probably-badly-optimised program fragment -- and do the conservative thing which is SlowCall.  simonm committed Mar 11, 1999 760 761 ----------------------------------------------------------------------------- SRT-related stuff  partain committed Jan 08, 1996 762   simonm committed Mar 11, 1999 763 764 \begin{code} staticClosureNeedsLink :: ClosureInfo -> Bool  simonpj committed Sep 26, 2001 765 766 767 -- A static closure needs a link field to aid the GC when traversing -- the static closure graph. But it only needs such a field if either -- a) it has an SRT  simonmar committed Jan 02, 2002 768 -- b) it's a constructor with one or more pointer fields  simonpj committed Sep 26, 2001 769 770 -- In case (b), the constructor's fields themselves play the role -- of the SRT.  simonmar committed Dec 11, 2002 771 772 staticClosureNeedsLink (ClosureInfo { closureSRT = srt }) = needsSRT srt  Simon Marlow committed Aug 25, 2011 773 774 staticClosureNeedsLink (ConInfo { closureSMRep = rep }) = not (isStaticNoCafCon rep)  partain committed Jan 08, 1996 775 776 \end{code}  simonpj@microsoft.com committed Dec 05, 2008 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 Note [Entering error thunks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this fail :: Int fail = error Int "Urk" foo :: Bool -> Bool foo True y = (fail cast Bool -> Bool) y foo False y = False This looks silly, but it can arise from case-of-error. Even if it does, we'd usually see that 'fail' is a bottoming function and would discard the extra argument 'y'. But even if that does not occur, this program is still OK. We will enter 'fail', which never returns. The WARN is just to alert me to the fact that we aren't spotting that 'fail' is bottoming. (We are careful never to make a funtion value look like a data type, because we can't enter a function closure -- but that is not the problem here.)  partain committed Jan 08, 1996 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 Avoiding generating entries and info tables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ At present, for every function we generate all of the following, just in case. But they aren't always all needed, as noted below: [NB1: all of this applies only to *functions*. Thunks always have closure, info table, and entry code.] [NB2: All are needed if the function is *exported*, just to play safe.] * Fast-entry code ALWAYS NEEDED * Slow-entry code Needed iff (a) we have any un-saturated calls to the function OR (b) the function is passed as an arg OR (c) we're in the parallel world and the function has free vars [Reason: in parallel world, we always enter functions with free vars via the closure.] * The function closure Needed iff (a) we have any un-saturated calls to the function OR (b) the function is passed as an arg OR (c) if the function has free vars (ie not top level)  partain committed Mar 19, 1996 826  Why case (a) here? Because if the arg-satis check fails,  partain committed Jan 08, 1996 827 828 829 830  UpdatePAP stuffs a pointer to the function closure in the PAP. [Could be changed; UpdatePAP could stuff in a code ptr instead, but doesn't seem worth it.]  partain committed Mar 19, 1996 831  [NB: these conditions imply that we might need the closure  partain committed Jan 08, 1996 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846  without the slow-entry code. Here's how. f x y = let g w = ...x..y..w... in ...(g t)... Here we need a closure for g which contains x and y, but since the calls are all saturated we just jump to the fast entry point for g, with R1 pointing to the closure for g.] * Standard info table Needed iff (a) we have any un-saturated calls to the function OR (b) the function is passed as an arg OR (c) the function has free vars (ie not top level)  partain committed Mar 19, 1996 847   partain committed Jan 08, 1996 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863  NB. In the sequential world, (c) is only required so that the function closure has an info table to point to, to keep the storage manager happy. If (c) alone is true we could fake up an info table by choosing one of a standard family of info tables, whose entry code just bombs out. [NB In the parallel world (c) is needed regardless because we enter functions with free vars via the closure.] If (c) is retained, then we'll sometimes generate an info table (for storage mgr purposes) without slow-entry code. Then we need to use an error label in the info table to substitute for the absent slow entry code. \begin{code} staticClosureRequired  simonm committed Dec 02, 1998 864  :: Name  partain committed Mar 19, 1996 865  -> StgBinderInfo  partain committed Jan 08, 1996 866 867  -> LambdaFormInfo -> Bool  Ian Lynagh committed Dec 29, 2008 868 staticClosureRequired _ bndr_info  simonmar committed Dec 11, 2002 869  (LFReEntrant top_level _ _ _) -- It's a function  simonpj committed May 18, 1999 870  = ASSERT( isTopLevel top_level )  simonm committed Dec 02, 1998 871  -- Assumption: it's a top-level, no-free-var binding  simonpj committed Feb 20, 2001 872  not (satCallsOnly bndr_info)  partain committed Jan 08, 1996 873   Ian Lynagh committed Dec 29, 2008 874 staticClosureRequired _ _ _ = True  simonpj committed Dec 19, 1996 875 876 \end{code}  partain committed Jan 08, 1996 877 878 879 880 881 882 883 884 %************************************************************************ %* * \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.} %* * %************************************************************************ \begin{code} isStaticClosure :: ClosureInfo -> Bool  simonpj committed Sep 26, 2001 885 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)  partain committed Jan 08, 1996 886 887  closureUpdReqd :: ClosureInfo -> Bool  simonmar committed Apr 21, 2005 888 889 890 891 892 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info closureUpdReqd ConInfo{} = False lfUpdatable :: LambdaFormInfo -> Bool lfUpdatable (LFThunk _ _ upd _ _) = upd  batterseapower committed Jul 28, 2011 893 lfUpdatable LFBlackHole = True  partain committed Jan 08, 1996 894 895  -- Black-hole closures are allocated to receive the results of an -- alg case with a named default... so they need to be updated.  simonmar committed Apr 21, 2005 896 897 898 899 900 lfUpdatable _ = False closureIsThunk :: ClosureInfo -> Bool closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info closureIsThunk ConInfo{} = False  partain committed Jan 08, 1996 901 902  closureSingleEntry :: ClosureInfo -> Bool  simonmar committed Dec 11, 2002 903 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd  Ian Lynagh committed Dec 29, 2008 904 closureSingleEntry _ = False  simonm committed Mar 22, 1999 905 906  closureReEntrant :: ClosureInfo -> Bool  simonmar committed Dec 11, 2002 907 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True  Ian Lynagh committed Dec 29, 2008 908 closureReEntrant _ = False  partain committed Jan 08, 1996 909   simonmar committed Aug 13, 2004 910 911 912 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con isConstrClosure_maybe _ = Nothing  simonmar committed Dec 11, 2002 913 914  closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)  Simon Marlow committed Jul 27, 2007 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info closureFunInfo _ = Nothing lfFunInfo :: LambdaFormInfo -> Maybe (Int, ArgDescr) lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc) lfFunInfo _ = Nothing funTag :: ClosureInfo -> Int funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info funTag _ = 0 -- maybe this should do constructor tags too? funTagLFInfo :: LambdaFormInfo -> Int funTagLFInfo lf -- A function is tagged with its arity | Just (arity,_) <- lfFunInfo lf, Just tag <- tagForArity arity = tag -- other closures (and unknown ones) are not tagged | otherwise = 0 tagForArity :: Int -> Maybe Int tagForArity i | i <= mAX_PTR_TAG = Just i | otherwise = Nothing  batterseapower committed Jul 28, 2011 941 942 943 944 945 946  clHasCafRefs :: ClosureInfo -> CafInfo clHasCafRefs (ClosureInfo {closureSRT = srt}) = case srt of NoC_SRT -> NoCafRefs _ -> MayHaveCafRefs clHasCafRefs (ConInfo {}) = NoCafRefs  partain committed Jan 08, 1996 947 948 \end{code}  partain committed Jun 26, 1996 949 950 \begin{code} isToplevClosure :: ClosureInfo -> Bool  simonmar committed Dec 11, 2002 951 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })  partain committed Jun 26, 1996 952  = case lf_info of  simonmar committed Dec 11, 2002 953 954  LFReEntrant TopLevel _ _ _ -> True LFThunk TopLevel _ _ _ _ -> True  Ian Lynagh committed Dec 29, 2008 955  _ -> False  simonmar committed Dec 11, 2002 956 isToplevClosure _ = False  simonm committed Dec 02, 1998 957 958 \end{code}  partain committed Jan 08, 1996 959 960 961 Label generation. \begin{code}  batterseapower committed Jul 28, 2011 962 infoTableLabelFromCI :: ClosureInfo -> CLabel  batterseapower committed Jul 28, 2011 963 964 965 infoTableLabelFromCI = fst . labelsFromCI entryLabelFromCI :: ClosureInfo -> CLabel  Simon Marlow committed Jan 05, 2012 966 967 968 969 entryLabelFromCI ci | tablesNextToCode = info_lbl | otherwise = entry_lbl where (info_lbl, entry_lbl) = labelsFromCI ci  batterseapower committed Jul 28, 2011 970 971 972 973 974  labelsFromCI :: ClosureInfo -> (CLabel, CLabel) -- (Info, Entry) labelsFromCI cl@(ClosureInfo { closureName = name, closureLFInfo = lf_info, closureInfLcl = is_lcl })  batterseapower committed Jul 28, 2011 975  = case lf_info of  batterseapower committed Jul 28, 2011 976  LFBlackHole -> (mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel)  partain committed Jan 08, 1996 977   simonmar committed Dec 11, 2002 978  LFThunk _ _ upd_flag (SelectorThunk offset) _ ->  batterseapower committed Jul 28, 2011 979  bothL (mkSelectorInfoLabel, mkSelectorEntryLabel) upd_flag offset  partain committed Jan 08, 1996 980   simonmar committed Dec 11, 2002 981  LFThunk _ _ upd_flag (ApThunk arity) _ ->  batterseapower committed Jul 28, 2011 982  bothL (mkApInfoTableLabel, mkApEntryLabel) upd_flag arity  partain committed Jan 08, 1996 983   batterseapower committed Jul 28, 2011 984  LFThunk{} -> bothL std_mk_lbls name$ clHasCafRefs cl  simonmar committed Dec 11, 2002 985   batterseapower committed Jul 28, 2011 986  LFReEntrant _ _ _ _ -> bothL std_mk_lbls name $clHasCafRefs cl  simonmar committed Dec 11, 2002 987   batterseapower committed Jul 28, 2011 988  _ -> panic "labelsFromCI"  batterseapower committed Jul 28, 2011 989  where std_mk_lbls = if is_lcl then (mkLocalInfoTableLabel, mkLocalEntryLabel) else (mkInfoTableLabel, mkEntryLabel)  simonmar committed Dec 11, 2002 990   batterseapower committed Jul 28, 2011 991 labelsFromCI cl@(ConInfo { closureCon = con,  batterseapower committed Jul 28, 2011 992  closureSMRep = rep })  batterseapower committed Jul 28, 2011 993 994  | isStaticRep rep = bothL (mkStaticInfoTableLabel, mkStaticConEntryLabel) name$ clHasCafRefs cl | otherwise = bothL (mkConInfoTableLabel, mkConEntryLabel) name $clHasCafRefs cl  simonm committed Dec 02, 1998 995 996  where name = dataConName con  partain committed Jan 08, 1996 997   batterseapower committed Jul 28, 2011 998 999 bothL :: (a -> b -> c, a -> b -> c) -> a -> b -> (c, c) bothL (f, g) x y = (f x y, g x y)  1000   simonmar committed Nov 26, 2004 1001 -- ClosureInfo for a closure (as opposed to a constructor) is always local  batterseapower committed Jul 28, 2011 1002 1003 1004 closureLabelFromCI :: ClosureInfo -> CLabel closureLabelFromCI cl@(ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm$ clHasCafRefs cl closureLabelFromCI _ = panic "closureLabelFromCI"  partain committed Jan 08, 1996 1005 1006  -- thunkEntryLabel is a local help function, not exported. It's used from both  simonmar committed Aug 13, 2004 1007 -- entryLabelFromCI and getCallMethod.  partain committed Jan 08, 1996 1008   Simon Marlow committed Mar 25, 2010 1009 {- UNUSED:  Ian Lynagh committed Dec 29, 2008 1010 1011 thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable  simonmar committed Aug 13, 2004 1012  = enterApLabel is_updatable arity  Ian Lynagh committed Dec 29, 2008 1013 thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag  simonmar committed Aug 13, 2004 1014  = enterSelectorLabel upd_flag offset  Ian Lynagh committed Dec 29, 2008 1015 thunkEntryLabel thunk_id caf _ _is_updatable  dias@eecs.harvard.edu committed Aug 14, 2008 1016  = enterIdLabel thunk_id caf  Simon Marlow committed Mar 25, 2010 1017 -}  partain committed Jan 08, 1996 1018   Simon Marlow committed Mar 25, 2010 1019 {- UNUSED:  Ian Lynagh committed Dec 29, 2008 1020 enterApLabel :: Bool -> Int -> CLabel  simonmar committed Aug 13, 2004 1021 1022 1023 enterApLabel is_updatable arity | tablesNextToCode = mkApInfoTableLabel is_updatable arity | otherwise = mkApEntryLabel is_updatable arity  Simon Marlow committed Mar 25, 2010 1024 -}  simonmar committed Aug 13, 2004 1025   Simon Marlow committed Mar 25, 2010 1026 {- UNUSED:  Ian Lynagh committed Dec 29, 2008 1027 enterSelectorLabel :: Bool -> Int -> CLabel  simonmar committed Aug 13, 2004 1028 1029 1030 enterSelectorLabel upd_flag offset | tablesNextToCode = mkSelectorInfoLabel upd_flag offset | otherwise = mkSelectorEntryLabel upd_flag offset  Simon Marlow committed Mar 25, 2010 1031 -}  simonmar committed Aug 13, 2004 1032   Ian Lynagh committed Dec 29, 2008 1033 enterIdLabel :: Name -> CafInfo -> CLabel  Clemens Fruhwirth committed Jul 31, 2007 1034 1035 1036 enterIdLabel id | tablesNextToCode = mkInfoTableLabel id | otherwise = mkEntryLabel id  simonmar committed Nov 26, 2004 1037   Ian Lynagh committed Dec 29, 2008 1038 enterReturnPtLabel :: Unique -> CLabel  simonmar committed Aug 13, 2004 1039 1040 1041 enterReturnPtLabel name | tablesNextToCode = mkReturnInfoLabel name | otherwise = mkReturnPtLabel name  partain committed Jan 08, 1996 1042 1043 \end{code}  simonmar committed Aug 13, 2004 1044   partain committed Apr 05, 1996 1045 We need a black-hole closure info to pass to @allocDynClosure@ when we  keithw committed May 11, 1999 1046 1047 1048 want to allocate the black hole on entry to a CAF. These are the only ways to build an LFBlackHole, maintaining the invariant that it really is a black hole and not something else.  partain committed Jan 08, 1996 1049 1050  \begin{code}  Ian Lynagh committed Dec 29, 2008 1051 cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo  simonmar committed Dec 11, 2002 1052 1053 1054 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm, closureType = ty }) = ClosureInfo { closureName = nm,  batterseapower committed Jul 28, 2011 1055  closureLFInfo = LFBlackHole,  Simon Marlow committed Aug 25, 2011 1056  closureSMRep = blackHoleRep,  simonmar committed Dec 11, 2002 1057 1058  closureSRT = NoC_SRT, closureType = ty,  batterseapower committed Jul 07, 2011 1059 1060  closureDescr = "", closureInfLcl = False }  simonmar committed Dec 11, 2002 1061 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"  partain committed Jan 08, 1996 1062 1063 1064 1065 1066 1067 1068 1069 \end{code} %************************************************************************ %* * \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.} %* * %************************************************************************  simonm committed Dec 02, 1998 1070 1071 Profiling requires two pieces of information to be determined for each closure's info table --- description and type.  partain committed Jan 08, 1996 1072 1073 1074 1075 1076 1077 1078 1079  The description is stored directly in the @CClosureInfoTable@ when the info table is built. The type is determined from the type information stored with the @Id@ in the closure info using @closureTypeDescr@. \begin{code}  simonmar committed Aug 13, 2004 1080 1081 1082 1083 closureValDescr, closureTypeDescr :: ClosureInfo -> String closureValDescr (ClosureInfo {closureDescr = descr}) = descr closureValDescr (ConInfo {closureCon = con})  simonmar committed Jan 06, 2006 1084  = occNameString (getOccName con)  simonmar committed Aug 13, 2004 1085   simonmar committed Dec 11, 2002 1086 1087 1088 closureTypeDescr (ClosureInfo { closureType = ty }) = getTyDescription ty closureTypeDescr (ConInfo { closureCon = data_con })  simonmar committed Jan 06, 2006 1089  = occNameString (getOccName (dataConTyCon data_con))  simonpj committed Oct 30, 2003 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103  getTyDescription :: Type -> String getTyDescription ty = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) -> case tau_ty of TyVarTy _ -> "*" AppTy fun _ -> getTyDescription fun FunTy _ res -> '-' : '>' : fun_result res TyConApp tycon _ -> getOccString tycon ForAllTy _ ty -> getTyDescription ty } where fun_result (FunTy _ res) = '>' : fun_result res fun_result other = getTyDescription other  simonmar committed Dec 11, 2002 1104 \end{code}