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