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