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