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