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