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