Merge branch 'master' of http://darcs.haskell.org/ghc
[ghc.git] / compiler / codeGen / StgCmmClosure.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Stg to C-- code generation:
4 --
5 -- The types LambdaFormInfo
6 -- ClosureInfo
7 --
8 -- Nothing monadic in here!
9 --
10 -----------------------------------------------------------------------------
11
12 {-# LANGUAGE RecordWildCards #-}
13 {-# OPTIONS -fno-warn-tabs #-}
14 -- The above warning supression flag is a temporary kludge.
15 -- While working on this module you are encouraged to remove it and
16 -- detab the module (please do the detabbing in a separate patch). See
17 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
18 -- for details
19
20 module StgCmmClosure (
21 DynTag, tagForCon, isSmallFamily,
22 ConTagZ, dataConTagZ,
23
24 idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps,
25 argPrimRep,
26
27 -- * LambdaFormInfo
28 LambdaFormInfo, -- Abstract
29 StandardFormInfo, -- ...ditto...
30 mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
31 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
32 mkLFBlackHole,
33 lfDynTag,
34 maybeIsLFCon, isLFThunk, isLFReEntrant, lfUpdatable,
35
36 nodeMustPointToIt,
37 CallMethod(..), getCallMethod,
38
39 isKnownFun, funTag, tagForArity,
40
41 -- * ClosureInfo
42 ClosureInfo,
43 mkClosureInfo,
44 mkCmmInfo,
45
46 -- ** Inspection
47 closureLFInfo, closureName,
48
49 -- ** Labels
50 -- These just need the info table label
51 closureInfoLabel, staticClosureLabel,
52 closureSlowEntryLabel, closureLocalEntryLabel,
53
54 -- ** Predicates
55 -- These are really just functions on LambdaFormInfo
56 closureUpdReqd, closureSingleEntry,
57 closureReEntrant, closureFunInfo,
58 isToplevClosure,
59
60 blackHoleOnEntry, -- Needs LambdaFormInfo and SMRep
61 isStaticClosure, -- Needs SMPre
62
63 -- * InfoTables
64 mkDataConInfoTable,
65 cafBlackHoleInfoTable,
66 indStaticInfoTable,
67 staticClosureNeedsLink,
68 ) where
69
70 #include "../includes/MachDeps.h"
71
72 #define FAST_STRING_NOT_NEEDED
73 #include "HsVersions.h"
74
75 import StgSyn
76 import SMRep
77 import Cmm
78
79 import CLabel
80 import Id
81 import IdInfo
82 import DataCon
83 import Name
84 import Type
85 import TypeRep
86 import TcType
87 import TyCon
88 import BasicTypes
89 import Outputable
90 import DynFlags
91 import Util
92
93 -----------------------------------------------------------------------------
94 -- Representations
95 -----------------------------------------------------------------------------
96
97 -- Why are these here?
98
99 -- NB: this is reliable because by StgCmm no Ids have unboxed tuple type
100 idPrimRep :: Id -> PrimRep
101 idPrimRep id = typePrimRep (idType id)
102
103 addIdReps :: [Id] -> [(PrimRep, Id)]
104 addIdReps ids = [(idPrimRep id, id) | id <- ids]
105
106 addArgReps :: [StgArg] -> [(PrimRep, StgArg)]
107 addArgReps args = [(argPrimRep arg, arg) | arg <- args]
108
109 argPrimRep :: StgArg -> PrimRep
110 argPrimRep arg = typePrimRep (stgArgType arg)
111
112 isVoidRep :: PrimRep -> Bool
113 isVoidRep VoidRep = True
114 isVoidRep _other = False
115
116 isGcPtrRep :: PrimRep -> Bool
117 isGcPtrRep PtrRep = True
118 isGcPtrRep _ = False
119
120
121 -----------------------------------------------------------------------------
122 -- LambdaFormInfo
123 -----------------------------------------------------------------------------
124
125 -- Information about an identifier, from the code generator's point of
126 -- view. Every identifier is bound to a LambdaFormInfo in the
127 -- environment, which gives the code generator enough info to be able to
128 -- tail call or return that identifier.
129
130 data LambdaFormInfo
131 = LFReEntrant -- Reentrant closure (a function)
132 TopLevelFlag -- True if top level
133 !RepArity -- Arity. Invariant: always > 0
134 !Bool -- True <=> no fvs
135 ArgDescr -- Argument descriptor (should really be in ClosureInfo)
136
137 | LFThunk -- Thunk (zero arity)
138 TopLevelFlag
139 !Bool -- True <=> no free vars
140 !Bool -- True <=> updatable (i.e., *not* single-entry)
141 StandardFormInfo
142 !Bool -- True <=> *might* be a function type
143
144 | LFCon -- A saturated constructor application
145 DataCon -- The constructor
146
147 | LFUnknown -- Used for function arguments and imported things.
148 -- We know nothing about this closure.
149 -- Treat like updatable "LFThunk"...
150 -- Imported things which we *do* know something about use
151 -- one of the other LF constructors (eg LFReEntrant for
152 -- known functions)
153 !Bool -- True <=> *might* be a function type
154 -- The False case is good when we want to enter it,
155 -- because then we know the entry code will do
156 -- For a function, the entry code is the fast entry point
157
158 | LFUnLifted -- A value of unboxed type;
159 -- always a value, neeeds evaluation
160
161 | LFLetNoEscape -- See LetNoEscape module for precise description
162
163 | LFBlackHole -- Used for the closures allocated to hold the result
164 -- of a CAF. We want the target of the update frame to
165 -- be in the heap, so we make a black hole to hold it.
166
167 -- XXX we can very nearly get rid of this, but
168 -- allocDynClosure needs a LambdaFormInfo
169
170
171 -------------------------
172 -- StandardFormInfo tells whether this thunk has one of
173 -- a small number of standard forms
174
175 data StandardFormInfo
176 = NonStandardThunk
177 -- Not of of the standard forms
178
179 | SelectorThunk
180 -- A SelectorThunk is of form
181 -- case x of
182 -- con a1,..,an -> ak
183 -- and the constructor is from a single-constr type.
184 WordOff -- 0-origin offset of ak within the "goods" of
185 -- constructor (Recall that the a1,...,an may be laid
186 -- out in the heap in a non-obvious order.)
187
188 | ApThunk
189 -- An ApThunk is of form
190 -- x1 ... xn
191 -- The code for the thunk just pushes x2..xn on the stack and enters x1.
192 -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
193 -- in the RTS to save space.
194 RepArity -- Arity, n
195
196
197 ------------------------------------------------------
198 -- Building LambdaFormInfo
199 ------------------------------------------------------
200
201 mkLFArgument :: Id -> LambdaFormInfo
202 mkLFArgument id
203 | isUnLiftedType ty = LFUnLifted
204 | might_be_a_function ty = LFUnknown True
205 | otherwise = LFUnknown False
206 where
207 ty = idType id
208
209 -------------
210 mkLFLetNoEscape :: LambdaFormInfo
211 mkLFLetNoEscape = LFLetNoEscape
212
213 -------------
214 mkLFReEntrant :: TopLevelFlag -- True of top level
215 -> [Id] -- Free vars
216 -> [Id] -- Args
217 -> ArgDescr -- Argument descriptor
218 -> LambdaFormInfo
219
220 mkLFReEntrant top fvs args arg_descr
221 = LFReEntrant top (length args) (null fvs) arg_descr
222
223 -------------
224 mkLFThunk :: Type -> TopLevelFlag -> [Id] -> UpdateFlag -> LambdaFormInfo
225 mkLFThunk thunk_ty top fvs upd_flag
226 = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) )
227 LFThunk top (null fvs)
228 (isUpdatable upd_flag)
229 NonStandardThunk
230 (might_be_a_function thunk_ty)
231
232 --------------
233 might_be_a_function :: Type -> Bool
234 -- Return False only if we are *sure* it's a data type
235 -- Look through newtypes etc as much as poss
236 might_be_a_function ty
237 | UnaryRep rep <- repType ty
238 , Just tc <- tyConAppTyCon_maybe rep
239 , isDataTyCon tc
240 = False
241 | otherwise
242 = True
243
244 -------------
245 mkConLFInfo :: DataCon -> LambdaFormInfo
246 mkConLFInfo con = LFCon con
247
248 -------------
249 mkSelectorLFInfo :: Id -> Int -> Bool -> LambdaFormInfo
250 mkSelectorLFInfo id offset updatable
251 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
252 (might_be_a_function (idType id))
253
254 -------------
255 mkApLFInfo :: Id -> UpdateFlag -> Arity -> LambdaFormInfo
256 mkApLFInfo id upd_flag arity
257 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
258 (might_be_a_function (idType id))
259
260 -------------
261 mkLFImported :: Id -> LambdaFormInfo
262 mkLFImported id
263 | Just con <- isDataConWorkId_maybe id
264 , isNullaryRepDataCon con
265 = LFCon con -- An imported nullary constructor
266 -- We assume that the constructor is evaluated so that
267 -- the id really does point directly to the constructor
268
269 | arity > 0
270 = LFReEntrant TopLevel arity True (panic "arg_descr")
271
272 | otherwise
273 = mkLFArgument id -- Not sure of exact arity
274 where
275 arity = idRepArity id
276
277 ------------
278 mkLFBlackHole :: LambdaFormInfo
279 mkLFBlackHole = LFBlackHole
280
281 -----------------------------------------------------
282 -- Dynamic pointer tagging
283 -----------------------------------------------------
284
285 type ConTagZ = Int -- A *zero-indexed* contructor tag
286
287 type DynTag = Int -- The tag on a *pointer*
288 -- (from the dynamic-tagging paper)
289
290 {- Note [Data constructor dynamic tags]
291 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
292 The family size of a data type (the number of constructors
293 or the arity of a function) can be either:
294 * small, if the family size < 2**tag_bits
295 * big, otherwise.
296
297 Small families can have the constructor tag in the tag bits.
298 Big families only use the tag value 1 to represent evaluatedness.
299 We don't have very many tag bits: for example, we have 2 bits on
300 x86-32 and 3 bits on x86-64. -}
301
302 isSmallFamily :: DynFlags -> Int -> Bool
303 isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags
304
305 -- We keep the *zero-indexed* tag in the srt_len field of the info
306 -- table of a data constructor.
307 dataConTagZ :: DataCon -> ConTagZ
308 dataConTagZ con = dataConTag con - fIRST_TAG
309
310 tagForCon :: DynFlags -> DataCon -> DynTag
311 tagForCon dflags con
312 | isSmallFamily dflags fam_size = con_tag + 1
313 | otherwise = 1
314 where
315 con_tag = dataConTagZ con
316 fam_size = tyConFamilySize (dataConTyCon con)
317
318 tagForArity :: DynFlags -> RepArity -> DynTag
319 tagForArity dflags arity
320 | isSmallFamily dflags arity = arity
321 | otherwise = 0
322
323 lfDynTag :: DynFlags -> LambdaFormInfo -> DynTag
324 -- Return the tag in the low order bits of a variable bound
325 -- to this LambdaForm
326 lfDynTag dflags (LFCon con) = tagForCon dflags con
327 lfDynTag dflags (LFReEntrant _ arity _ _) = tagForArity dflags arity
328 lfDynTag _ _other = 0
329
330
331 -----------------------------------------------------------------------------
332 -- Observing LambdaFormInfo
333 -----------------------------------------------------------------------------
334
335 -------------
336 maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon
337 maybeIsLFCon (LFCon con) = Just con
338 maybeIsLFCon _ = Nothing
339
340 ------------
341 isLFThunk :: LambdaFormInfo -> Bool
342 isLFThunk (LFThunk {}) = True
343 isLFThunk LFBlackHole = True
344 -- return True for a blackhole: this function is used to determine
345 -- whether to use the thunk header in SMP mode, and a blackhole
346 -- must have one.
347 isLFThunk _ = False
348
349 isLFReEntrant :: LambdaFormInfo -> Bool
350 isLFReEntrant (LFReEntrant {}) = True
351 isLFReEntrant _ = False
352
353 -----------------------------------------------------------------------------
354 -- Choosing SM reps
355 -----------------------------------------------------------------------------
356
357 lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
358 lfClosureType (LFReEntrant _ arity _ argd) = Fun arity argd
359 lfClosureType (LFCon con) = Constr (dataConTagZ con)
360 (dataConIdentity con)
361 lfClosureType (LFThunk _ _ _ is_sel _) = thunkClosureType is_sel
362 lfClosureType _ = panic "lfClosureType"
363
364 thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
365 thunkClosureType (SelectorThunk off) = ThunkSelector off
366 thunkClosureType _ = Thunk
367
368 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g
369 -- gets compiled to a jump to g (if g has non-zero arity), instead of
370 -- messing around with update frames and PAPs. We set the closure type
371 -- to FUN_STATIC in this case.
372
373 -----------------------------------------------------------------------------
374 -- nodeMustPointToIt
375 -----------------------------------------------------------------------------
376
377 nodeMustPointToIt :: DynFlags -> LambdaFormInfo -> Bool
378 nodeMustPointToIt _ (LFReEntrant top _ no_fvs _)
379 = not no_fvs || -- Certainly if it has fvs we need to point to it
380 isNotTopLevel top
381 -- If it is not top level we will point to it
382 -- We can have a \r closure with no_fvs which
383 -- is not top level as special case cgRhsClosure
384 -- has been dissabled in favour of let floating
385
386 -- For lex_profiling we also access the cost centre for a
387 -- non-inherited function i.e. not top level
388 -- the not top case above ensures this is ok.
389
390 nodeMustPointToIt _ (LFCon _) = True
391
392 -- Strictly speaking, the above two don't need Node to point
393 -- to it if the arity = 0. But this is a *really* unlikely
394 -- situation. If we know it's nil (say) and we are entering
395 -- it. Eg: let x = [] in x then we will certainly have inlined
396 -- x, since nil is a simple atom. So we gain little by not
397 -- having Node point to known zero-arity things. On the other
398 -- hand, we do lose something; Patrick's code for figuring out
399 -- when something has been updated but not entered relies on
400 -- having Node point to the result of an update. SLPJ
401 -- 27/11/92.
402
403 nodeMustPointToIt dflags (LFThunk _ no_fvs updatable NonStandardThunk _)
404 = updatable || not no_fvs || gopt Opt_SccProfilingOn dflags
405 -- For the non-updatable (single-entry case):
406 --
407 -- True if has fvs (in which case we need access to them, and we
408 -- should black-hole it)
409 -- or profiling (in which case we need to recover the cost centre
410 -- from inside it)
411
412 nodeMustPointToIt _ (LFThunk {}) -- Node must point to a standard-form thunk
413 = True
414
415 nodeMustPointToIt _ (LFUnknown _) = True
416 nodeMustPointToIt _ LFUnLifted = False
417 nodeMustPointToIt _ LFBlackHole = True -- BH entry may require Node to point
418 nodeMustPointToIt _ LFLetNoEscape = False
419
420 -----------------------------------------------------------------------------
421 -- getCallMethod
422 -----------------------------------------------------------------------------
423
424 {- The entry conventions depend on the type of closure being entered,
425 whether or not it has free variables, and whether we're running
426 sequentially or in parallel.
427
428 Closure Node Argument Enter
429 Characteristics Par Req'd Passing Via
430 -------------------------------------------------------------------------------
431 Unknown & no & yes & stack & node
432 Known fun (>1 arg), no fvs & no & no & registers & fast entry (enough args)
433 & slow entry (otherwise)
434 Known fun (>1 arg), fvs & no & yes & registers & fast entry (enough args)
435 0 arg, no fvs \r,\s & no & no & n/a & direct entry
436 0 arg, no fvs \u & no & yes & n/a & node
437 0 arg, fvs \r,\s & no & yes & n/a & direct entry
438 0 arg, fvs \u & no & yes & n/a & node
439
440 Unknown & yes & yes & stack & node
441 Known fun (>1 arg), no fvs & yes & no & registers & fast entry (enough args)
442 & slow entry (otherwise)
443 Known fun (>1 arg), fvs & yes & yes & registers & node
444 0 arg, no fvs \r,\s & yes & no & n/a & direct entry
445 0 arg, no fvs \u & yes & yes & n/a & node
446 0 arg, fvs \r,\s & yes & yes & n/a & node
447 0 arg, fvs \u & yes & yes & n/a & node
448 \end{tabular}
449
450 When black-holing, single-entry closures could also be entered via node
451 (rather than directly) to catch double-entry. -}
452
453 data CallMethod
454 = EnterIt -- No args, not a function
455
456 | JumpToIt -- A join point
457
458 | ReturnIt -- It's a value (function, unboxed value,
459 -- or constructor), so just return it.
460
461 | SlowCall -- Unknown fun, or known fun with
462 -- too few args.
463
464 | DirectEntry -- Jump directly, with args in regs
465 CLabel -- The code label
466 RepArity -- Its arity
467
468 getCallMethod :: DynFlags
469 -> Name -- Function being applied
470 -> CafInfo -- Can it refer to CAF's?
471 -> LambdaFormInfo -- Its info
472 -> RepArity -- Number of available arguments
473 -> CallMethod
474
475 getCallMethod dflags _name _ lf_info _n_args
476 | nodeMustPointToIt dflags lf_info && gopt Opt_Parallel dflags
477 = -- If we're parallel, then we must always enter via node.
478 -- The reason is that the closure may have been
479 -- fetched since we allocated it.
480 EnterIt
481
482 getCallMethod dflags name caf (LFReEntrant _ arity _ _) n_args
483 | n_args == 0 = ASSERT( arity /= 0 )
484 ReturnIt -- No args at all
485 | n_args < arity = SlowCall -- Not enough args
486 | otherwise = DirectEntry (enterIdLabel dflags name caf) arity
487
488 getCallMethod _ _name _ LFUnLifted n_args
489 = ASSERT( n_args == 0 ) ReturnIt
490
491 getCallMethod _ _name _ (LFCon _) n_args
492 = ASSERT( n_args == 0 ) ReturnIt
493
494 getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_args
495 | is_fun -- it *might* be a function, so we must "call" it (which is always safe)
496 = SlowCall -- We cannot just enter it [in eval/apply, the entry code
497 -- is the fast-entry code]
498
499 -- Since is_fun is False, we are *definitely* looking at a data value
500 | updatable || gopt Opt_Ticky dflags -- to catch double entry
501 {- OLD: || opt_SMP
502 I decided to remove this, because in SMP mode it doesn't matter
503 if we enter the same thunk multiple times, so the optimisation
504 of jumping directly to the entry code is still valid. --SDM
505 -}
506 = EnterIt
507 -- We used to have ASSERT( n_args == 0 ), but actually it is
508 -- possible for the optimiser to generate
509 -- let bot :: Int = error Int "urk"
510 -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
511 -- This happens as a result of the case-of-error transformation
512 -- So the right thing to do is just to enter the thing
513
514 | otherwise -- Jump direct to code for single-entry thunks
515 = ASSERT( n_args == 0 )
516 DirectEntry (thunkEntryLabel dflags name caf std_form_info updatable) 0
517
518 getCallMethod _ _name _ (LFUnknown True) _n_args
519 = SlowCall -- might be a function
520
521 getCallMethod _ name _ (LFUnknown False) n_args
522 = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args )
523 EnterIt -- Not a function
524
525 getCallMethod _ _name _ LFBlackHole _n_args
526 = SlowCall -- Presumably the black hole has by now
527 -- been updated, but we don't know with
528 -- what, so we slow call it
529
530 getCallMethod _ _name _ LFLetNoEscape _n_args
531 = JumpToIt
532
533 isKnownFun :: LambdaFormInfo -> Bool
534 isKnownFun (LFReEntrant _ _ _ _) = True
535 isKnownFun LFLetNoEscape = True
536 isKnownFun _ = False
537
538 -----------------------------------------------------------------------------
539 -- staticClosureRequired
540 -----------------------------------------------------------------------------
541
542 {- staticClosureRequired is never called (hence commented out)
543
544 SimonMar writes (Sept 07) It's an optimisation we used to apply at
545 one time, I believe, but it got lost probably in the rewrite of
546 the RTS/code generator. I left that code there to remind me to
547 look into whether it was worth doing sometime
548
549 {- Avoiding generating entries and info tables
550 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
551 At present, for every function we generate all of the following,
552 just in case. But they aren't always all needed, as noted below:
553
554 [NB1: all of this applies only to *functions*. Thunks always
555 have closure, info table, and entry code.]
556
557 [NB2: All are needed if the function is *exported*, just to play safe.]
558
559 * Fast-entry code ALWAYS NEEDED
560
561 * Slow-entry code
562 Needed iff (a) we have any un-saturated calls to the function
563 OR (b) the function is passed as an arg
564 OR (c) we're in the parallel world and the function has free vars
565 [Reason: in parallel world, we always enter functions
566 with free vars via the closure.]
567
568 * The function closure
569 Needed iff (a) we have any un-saturated calls to the function
570 OR (b) the function is passed as an arg
571 OR (c) if the function has free vars (ie not top level)
572
573 Why case (a) here? Because if the arg-satis check fails,
574 UpdatePAP stuffs a pointer to the function closure in the PAP.
575 [Could be changed; UpdatePAP could stuff in a code ptr instead,
576 but doesn't seem worth it.]
577
578 [NB: these conditions imply that we might need the closure
579 without the slow-entry code. Here's how.
580
581 f x y = let g w = ...x..y..w...
582 in
583 ...(g t)...
584
585 Here we need a closure for g which contains x and y,
586 but since the calls are all saturated we just jump to the
587 fast entry point for g, with R1 pointing to the closure for g.]
588
589
590 * Standard info table
591 Needed iff (a) we have any un-saturated calls to the function
592 OR (b) the function is passed as an arg
593 OR (c) the function has free vars (ie not top level)
594
595 NB. In the sequential world, (c) is only required so that the function closure has
596 an info table to point to, to keep the storage manager happy.
597 If (c) alone is true we could fake up an info table by choosing
598 one of a standard family of info tables, whose entry code just
599 bombs out.
600
601 [NB In the parallel world (c) is needed regardless because
602 we enter functions with free vars via the closure.]
603
604 If (c) is retained, then we'll sometimes generate an info table
605 (for storage mgr purposes) without slow-entry code. Then we need
606 to use an error label in the info table to substitute for the absent
607 slow entry code.
608 -}
609
610 staticClosureRequired
611 :: Name
612 -> StgBinderInfo
613 -> LambdaFormInfo
614 -> Bool
615 staticClosureRequired binder bndr_info
616 (LFReEntrant top_level _ _ _) -- It's a function
617 = ASSERT( isTopLevel top_level )
618 -- Assumption: it's a top-level, no-free-var binding
619 not (satCallsOnly bndr_info)
620
621 staticClosureRequired binder other_binder_info other_lf_info = True
622 -}
623
624 -----------------------------------------------------------------------------
625 -- Data types for closure information
626 -----------------------------------------------------------------------------
627
628
629 {- ClosureInfo: information about a binding
630
631 We make a ClosureInfo for each let binding (both top level and not),
632 but not bindings for data constructors: for those we build a CmmInfoTable
633 directly (see mkDataConInfoTable).
634
635 To a first approximation:
636 ClosureInfo = (LambdaFormInfo, CmmInfoTable)
637
638 A ClosureInfo has enough information
639 a) to construct the info table itself, and build other things
640 related to the binding (e.g. slow entry points for a function)
641 b) to allocate a closure containing that info pointer (i.e.
642 it knows the info table label)
643 -}
644
645 data ClosureInfo
646 = ClosureInfo {
647 closureName :: !Name, -- The thing bound to this closure
648 -- we don't really need this field: it's only used in generating
649 -- code for ticky and profiling, and we could pass the information
650 -- around separately, but it doesn't do much harm to keep it here.
651
652 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon
653 -- this tells us about what the closure contains: it's right-hand-side.
654
655 -- the rest is just an unpacked CmmInfoTable.
656 closureInfoLabel :: !CLabel,
657 closureSMRep :: !SMRep, -- representation used by storage mgr
658 closureProf :: !ProfilingInfo
659 }
660
661 -- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
662 mkCmmInfo :: ClosureInfo -> CmmInfoTable
663 mkCmmInfo ClosureInfo {..}
664 = CmmInfoTable { cit_lbl = closureInfoLabel
665 , cit_rep = closureSMRep
666 , cit_prof = closureProf
667 , cit_srt = NoC_SRT }
668
669
670 --------------------------------------
671 -- Building ClosureInfos
672 --------------------------------------
673
674 mkClosureInfo :: DynFlags
675 -> Bool -- Is static
676 -> Id
677 -> LambdaFormInfo
678 -> Int -> Int -- Total and pointer words
679 -> String -- String descriptor
680 -> ClosureInfo
681 mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr
682 = ClosureInfo { closureName = name,
683 closureLFInfo = lf_info,
684 closureInfoLabel = info_lbl, -- These three fields are
685 closureSMRep = sm_rep, -- (almost) an info table
686 closureProf = prof } -- (we don't have an SRT yet)
687 where
688 name = idName id
689 sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType lf_info)
690 prof = mkProfilingInfo dflags id val_descr
691 nonptr_wds = tot_wds - ptr_wds
692
693 info_lbl = mkClosureInfoTableLabel id lf_info
694
695 --------------------------------------
696 -- Other functions over ClosureInfo
697 --------------------------------------
698
699 -- Eager blackholing is normally disabled, but can be turned on with
700 -- -feager-blackholing. When it is on, we replace the info pointer of
701 -- the thunk with stg_EAGER_BLACKHOLE_info on entry.
702
703 -- If we wanted to do eager blackholing with slop filling,
704 -- we'd need to do it at the *end* of a basic block, otherwise
705 -- we overwrite the free variables in the thunk that we still
706 -- need. We have a patch for this from Andy Cheadle, but not
707 -- incorporated yet. --SDM [6/2004]
708 --
709 --
710 -- Previously, eager blackholing was enabled when ticky-ticky
711 -- was on. But it didn't work, and it wasn't strictly necessary
712 -- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
713 -- is unconditionally disabled. -- krc 1/2007
714
715 -- Static closures are never themselves black-holed.
716
717 blackHoleOnEntry :: ClosureInfo -> Bool
718 blackHoleOnEntry cl_info
719 | isStaticRep (closureSMRep cl_info)
720 = False -- Never black-hole a static closure
721
722 | otherwise
723 = case closureLFInfo cl_info of
724 LFReEntrant _ _ _ _ -> False
725 LFLetNoEscape -> False
726 LFThunk _ _no_fvs _updatable _ _ -> True
727 _other -> panic "blackHoleOnEntry" -- Should never happen
728
729 isStaticClosure :: ClosureInfo -> Bool
730 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
731
732 closureUpdReqd :: ClosureInfo -> Bool
733 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
734
735 lfUpdatable :: LambdaFormInfo -> Bool
736 lfUpdatable (LFThunk _ _ upd _ _) = upd
737 lfUpdatable LFBlackHole = True
738 -- Black-hole closures are allocated to receive the results of an
739 -- alg case with a named default... so they need to be updated.
740 lfUpdatable _ = False
741
742 closureSingleEntry :: ClosureInfo -> Bool
743 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
744 closureSingleEntry _ = False
745
746 closureReEntrant :: ClosureInfo -> Bool
747 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
748 closureReEntrant _ = False
749
750 closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
751 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
752
753 lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr)
754 lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc)
755 lfFunInfo _ = Nothing
756
757 funTag :: DynFlags -> ClosureInfo -> DynTag
758 funTag dflags (ClosureInfo { closureLFInfo = lf_info })
759 = lfDynTag dflags lf_info
760
761 isToplevClosure :: ClosureInfo -> Bool
762 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
763 = case lf_info of
764 LFReEntrant TopLevel _ _ _ -> True
765 LFThunk TopLevel _ _ _ _ -> True
766 _other -> False
767
768 --------------------------------------
769 -- Label generation
770 --------------------------------------
771
772 staticClosureLabel :: ClosureInfo -> CLabel
773 staticClosureLabel = toClosureLbl . closureInfoLabel
774
775 closureSlowEntryLabel :: ClosureInfo -> CLabel
776 closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
777
778 closureLocalEntryLabel :: DynFlags -> ClosureInfo -> CLabel
779 closureLocalEntryLabel dflags
780 | tablesNextToCode dflags = toInfoLbl . closureInfoLabel
781 | otherwise = toEntryLbl . closureInfoLabel
782
783 mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel
784 mkClosureInfoTableLabel id lf_info
785 = case lf_info of
786 LFBlackHole -> mkCAFBlackHoleInfoTableLabel
787
788 LFThunk _ _ upd_flag (SelectorThunk offset) _
789 -> mkSelectorInfoLabel upd_flag offset
790
791 LFThunk _ _ upd_flag (ApThunk arity) _
792 -> mkApInfoTableLabel upd_flag arity
793
794 LFThunk{} -> std_mk_lbl name cafs
795 LFReEntrant{} -> std_mk_lbl name cafs
796 _other -> panic "closureInfoTableLabel"
797
798 where
799 name = idName id
800
801 std_mk_lbl | is_local = mkLocalInfoTableLabel
802 | otherwise = mkInfoTableLabel
803
804 cafs = idCafInfo id
805 is_local = isDataConWorkId id
806 -- Make the _info pointer for the implicit datacon worker
807 -- binding local. The reason we can do this is that importing
808 -- code always either uses the _closure or _con_info. By the
809 -- invariants in CorePrep anything else gets eta expanded.
810
811
812 thunkEntryLabel :: DynFlags -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
813 -- thunkEntryLabel is a local help function, not exported. It's used from
814 -- getCallMethod.
815 thunkEntryLabel dflags _thunk_id _ (ApThunk arity) upd_flag
816 = enterApLabel dflags upd_flag arity
817 thunkEntryLabel dflags _thunk_id _ (SelectorThunk offset) upd_flag
818 = enterSelectorLabel dflags upd_flag offset
819 thunkEntryLabel dflags thunk_id c _ _
820 = enterIdLabel dflags thunk_id c
821
822 enterApLabel :: DynFlags -> Bool -> Arity -> CLabel
823 enterApLabel dflags is_updatable arity
824 | tablesNextToCode dflags = mkApInfoTableLabel is_updatable arity
825 | otherwise = mkApEntryLabel is_updatable arity
826
827 enterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel
828 enterSelectorLabel dflags upd_flag offset
829 | tablesNextToCode dflags = mkSelectorInfoLabel upd_flag offset
830 | otherwise = mkSelectorEntryLabel upd_flag offset
831
832 enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel
833 enterIdLabel dflags id c
834 | tablesNextToCode dflags = mkInfoTableLabel id c
835 | otherwise = mkEntryLabel id c
836
837
838 --------------------------------------
839 -- Profiling
840 --------------------------------------
841
842 -- Profiling requires two pieces of information to be determined for
843 -- each closure's info table --- description and type.
844
845 -- The description is stored directly in the @CClosureInfoTable@ when the
846 -- info table is built.
847
848 -- The type is determined from the type information stored with the @Id@
849 -- in the closure info using @closureTypeDescr@.
850
851 mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo
852 mkProfilingInfo dflags id val_descr
853 | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
854 | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8
855 where
856 ty_descr_w8 = stringToWord8s (getTyDescription (idType id))
857 val_descr_w8 = stringToWord8s val_descr
858
859 getTyDescription :: Type -> String
860 getTyDescription ty
861 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
862 case tau_ty of
863 TyVarTy _ -> "*"
864 AppTy fun _ -> getTyDescription fun
865 FunTy _ res -> '-' : '>' : fun_result res
866 TyConApp tycon _ -> getOccString tycon
867 ForAllTy _ ty -> getTyDescription ty
868 LitTy n -> getTyLitDescription n
869 }
870 where
871 fun_result (FunTy _ res) = '>' : fun_result res
872 fun_result other = getTyDescription other
873
874 getTyLitDescription :: TyLit -> String
875 getTyLitDescription l =
876 case l of
877 NumTyLit n -> show n
878 StrTyLit n -> show n
879
880 --------------------------------------
881 -- CmmInfoTable-related things
882 --------------------------------------
883
884 mkDataConInfoTable :: DynFlags -> DataCon -> Bool -> Int -> Int -> CmmInfoTable
885 mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
886 = CmmInfoTable { cit_lbl = info_lbl
887 , cit_rep = sm_rep
888 , cit_prof = prof
889 , cit_srt = NoC_SRT }
890 where
891 name = dataConName data_con
892
893 info_lbl | is_static = mkStaticInfoTableLabel name NoCafRefs
894 | otherwise = mkConInfoTableLabel name NoCafRefs
895
896 sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type
897
898 cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con)
899
900 prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
901 | otherwise = ProfilingInfo ty_descr val_descr
902
903 ty_descr = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con
904 val_descr = stringToWord8s $ occNameString $ getOccName data_con
905
906 -- We need a black-hole closure info to pass to @allocDynClosure@ when we
907 -- want to allocate the black hole on entry to a CAF.
908
909 cafBlackHoleInfoTable :: CmmInfoTable
910 cafBlackHoleInfoTable
911 = CmmInfoTable { cit_lbl = mkCAFBlackHoleInfoTableLabel
912 , cit_rep = blackHoleRep
913 , cit_prof = NoProfilingInfo
914 , cit_srt = NoC_SRT }
915
916 indStaticInfoTable :: CmmInfoTable
917 indStaticInfoTable
918 = CmmInfoTable { cit_lbl = mkIndStaticInfoLabel
919 , cit_rep = indStaticRep
920 , cit_prof = NoProfilingInfo
921 , cit_srt = NoC_SRT }
922
923 staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
924 -- A static closure needs a link field to aid the GC when traversing
925 -- the static closure graph. But it only needs such a field if either
926 -- a) it has an SRT
927 -- b) it's a constructor with one or more pointer fields
928 -- In case (b), the constructor's fields themselves play the role
929 -- of the SRT.
930 --
931 -- At this point, the cit_srt field has not been calculated (that
932 -- happens right at the end of the Cmm pipeline), but we do have the
933 -- VarSet of CAFs that CoreToStg attached, and if that is empty there
934 -- will definitely not be an SRT.
935 --
936 staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }
937 | isConRep smrep = not (isStaticNoCafCon smrep)
938 | otherwise = has_srt -- needsSRT (cit_srt info_tbl)