Remove doingTickyProfiling
[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 closureRednCountsLabel, 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 staticClosureNeedsLink,
67 ) where
68
69 #include "../includes/MachDeps.h"
70
71 #define FAST_STRING_NOT_NEEDED
72 #include "HsVersions.h"
73
74 import StgSyn
75 import SMRep
76 import Cmm
77
78 import CLabel
79 import Id
80 import IdInfo
81 import DataCon
82 import Name
83 import Type
84 import TypeRep
85 import TcType
86 import TyCon
87 import BasicTypes
88 import Outputable
89 import Constants
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 :: Int -> Bool
303 isSmallFamily fam_size = fam_size <= mAX_PTR_TAG
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 :: DataCon -> DynTag
311 tagForCon con
312 | isSmallFamily fam_size = con_tag + 1
313 | otherwise = 1
314 where
315 con_tag = dataConTagZ con
316 fam_size = tyConFamilySize (dataConTyCon con)
317
318 tagForArity :: RepArity -> DynTag
319 tagForArity arity | isSmallFamily arity = arity
320 | otherwise = 0
321
322 lfDynTag :: LambdaFormInfo -> DynTag
323 -- Return the tag in the low order bits of a variable bound
324 -- to this LambdaForm
325 lfDynTag (LFCon con) = tagForCon con
326 lfDynTag (LFReEntrant _ arity _ _) = tagForArity arity
327 lfDynTag _other = 0
328
329
330 -----------------------------------------------------------------------------
331 -- Observing LambdaFormInfo
332 -----------------------------------------------------------------------------
333
334 -------------
335 maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon
336 maybeIsLFCon (LFCon con) = Just con
337 maybeIsLFCon _ = Nothing
338
339 ------------
340 isLFThunk :: LambdaFormInfo -> Bool
341 isLFThunk (LFThunk {}) = True
342 isLFThunk LFBlackHole = True
343 -- return True for a blackhole: this function is used to determine
344 -- whether to use the thunk header in SMP mode, and a blackhole
345 -- must have one.
346 isLFThunk _ = False
347
348 isLFReEntrant :: LambdaFormInfo -> Bool
349 isLFReEntrant (LFReEntrant {}) = True
350 isLFReEntrant _ = False
351
352 -----------------------------------------------------------------------------
353 -- Choosing SM reps
354 -----------------------------------------------------------------------------
355
356 lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
357 lfClosureType (LFReEntrant _ arity _ argd) = Fun (fromIntegral arity) argd
358 lfClosureType (LFCon con) = Constr (fromIntegral (dataConTagZ con))
359 (dataConIdentity con)
360 lfClosureType (LFThunk _ _ _ is_sel _) = thunkClosureType is_sel
361 lfClosureType _ = panic "lfClosureType"
362
363 thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
364 thunkClosureType (SelectorThunk off) = ThunkSelector (fromIntegral off)
365 thunkClosureType _ = Thunk
366
367 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g
368 -- gets compiled to a jump to g (if g has non-zero arity), instead of
369 -- messing around with update frames and PAPs. We set the closure type
370 -- to FUN_STATIC in this case.
371
372 -----------------------------------------------------------------------------
373 -- nodeMustPointToIt
374 -----------------------------------------------------------------------------
375
376 -- Be sure to see the stg-details notes about these...
377
378 nodeMustPointToIt :: DynFlags -> LambdaFormInfo -> Bool
379 nodeMustPointToIt _ (LFReEntrant top _ no_fvs _)
380 = not no_fvs || -- Certainly if it has fvs we need to point to it
381 isNotTopLevel top
382 -- If it is not top level we will point to it
383 -- We can have a \r closure with no_fvs which
384 -- is not top level as special case cgRhsClosure
385 -- has been dissabled in favour of let floating
386
387 -- For lex_profiling we also access the cost centre for a
388 -- non-inherited function i.e. not top level
389 -- the not top case above ensures this is ok.
390
391 nodeMustPointToIt _ (LFCon _) = True
392
393 -- Strictly speaking, the above two don't need Node to point
394 -- to it if the arity = 0. But this is a *really* unlikely
395 -- situation. If we know it's nil (say) and we are entering
396 -- it. Eg: let x = [] in x then we will certainly have inlined
397 -- x, since nil is a simple atom. So we gain little by not
398 -- having Node point to known zero-arity things. On the other
399 -- hand, we do lose something; Patrick's code for figuring out
400 -- when something has been updated but not entered relies on
401 -- having Node point to the result of an update. SLPJ
402 -- 27/11/92.
403
404 nodeMustPointToIt dflags (LFThunk _ no_fvs updatable NonStandardThunk _)
405 = updatable || not no_fvs || dopt Opt_SccProfilingOn dflags
406 -- For the non-updatable (single-entry case):
407 --
408 -- True if has fvs (in which case we need access to them, and we
409 -- should black-hole it)
410 -- or profiling (in which case we need to recover the cost centre
411 -- from inside it)
412
413 nodeMustPointToIt _ (LFThunk {}) -- Node must point to a standard-form thunk
414 = True
415
416 nodeMustPointToIt _ (LFUnknown _) = True
417 nodeMustPointToIt _ LFUnLifted = False
418 nodeMustPointToIt _ LFBlackHole = True -- BH entry may require Node to point
419 nodeMustPointToIt _ LFLetNoEscape = False
420
421 -----------------------------------------------------------------------------
422 -- getCallMethod
423 -----------------------------------------------------------------------------
424
425 {- The entry conventions depend on the type of closure being entered,
426 whether or not it has free variables, and whether we're running
427 sequentially or in parallel.
428
429 Closure Node Argument Enter
430 Characteristics Par Req'd Passing Via
431 -------------------------------------------------------------------------------
432 Unknown & no & yes & stack & node
433 Known fun (>1 arg), no fvs & no & no & registers & fast entry (enough args)
434 & slow entry (otherwise)
435 Known fun (>1 arg), fvs & no & yes & registers & fast entry (enough args)
436 0 arg, no fvs \r,\s & no & no & n/a & direct entry
437 0 arg, no fvs \u & no & yes & n/a & node
438 0 arg, fvs \r,\s & no & yes & n/a & direct entry
439 0 arg, fvs \u & no & yes & n/a & node
440
441 Unknown & yes & yes & stack & node
442 Known fun (>1 arg), no fvs & yes & no & registers & fast entry (enough args)
443 & slow entry (otherwise)
444 Known fun (>1 arg), fvs & yes & yes & registers & node
445 0 arg, no fvs \r,\s & yes & no & n/a & direct entry
446 0 arg, no fvs \u & yes & yes & n/a & node
447 0 arg, fvs \r,\s & yes & yes & n/a & node
448 0 arg, fvs \u & yes & yes & n/a & node
449 \end{tabular}
450
451 When black-holing, single-entry closures could also be entered via node
452 (rather than directly) to catch double-entry. -}
453
454 data CallMethod
455 = EnterIt -- No args, not a function
456
457 | JumpToIt -- A join point
458
459 | ReturnIt -- It's a value (function, unboxed value,
460 -- or constructor), so just return it.
461
462 | SlowCall -- Unknown fun, or known fun with
463 -- too few args.
464
465 | DirectEntry -- Jump directly, with args in regs
466 CLabel -- The code label
467 RepArity -- Its arity
468
469 getCallMethod :: DynFlags
470 -> Name -- Function being applied
471 -> CafInfo -- Can it refer to CAF's?
472 -> LambdaFormInfo -- Its info
473 -> RepArity -- Number of available arguments
474 -> CallMethod
475
476 getCallMethod dflags _name _ lf_info _n_args
477 | nodeMustPointToIt dflags lf_info && dopt Opt_Parallel dflags
478 = -- If we're parallel, then we must always enter via node.
479 -- The reason is that the closure may have been
480 -- fetched since we allocated it.
481 EnterIt
482
483 getCallMethod dflags name caf (LFReEntrant _ arity _ _) n_args
484 | n_args == 0 = ASSERT( arity /= 0 )
485 ReturnIt -- No args at all
486 | n_args < arity = SlowCall -- Not enough args
487 | otherwise = DirectEntry (enterIdLabel dflags name caf) arity
488
489 getCallMethod _ _name _ LFUnLifted n_args
490 = ASSERT( n_args == 0 ) ReturnIt
491
492 getCallMethod _ _name _ (LFCon _) n_args
493 = ASSERT( n_args == 0 ) ReturnIt
494
495 getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_args
496 | is_fun -- it *might* be a function, so we must "call" it (which is always safe)
497 = SlowCall -- We cannot just enter it [in eval/apply, the entry code
498 -- is the fast-entry code]
499
500 -- Since is_fun is False, we are *definitely* looking at a data value
501 | updatable || dopt Opt_Ticky dflags -- to catch double entry
502 {- OLD: || opt_SMP
503 I decided to remove this, because in SMP mode it doesn't matter
504 if we enter the same thunk multiple times, so the optimisation
505 of jumping directly to the entry code is still valid. --SDM
506 -}
507 = EnterIt
508 -- We used to have ASSERT( n_args == 0 ), but actually it is
509 -- possible for the optimiser to generate
510 -- let bot :: Int = error Int "urk"
511 -- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
512 -- This happens as a result of the case-of-error transformation
513 -- So the right thing to do is just to enter the thing
514
515 | otherwise -- Jump direct to code for single-entry thunks
516 = ASSERT( n_args == 0 )
517 DirectEntry (thunkEntryLabel dflags name caf std_form_info updatable) 0
518
519 getCallMethod _ _name _ (LFUnknown True) _n_args
520 = SlowCall -- might be a function
521
522 getCallMethod _ name _ (LFUnknown False) n_args
523 = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args )
524 EnterIt -- Not a function
525
526 getCallMethod _ _name _ LFBlackHole _n_args
527 = SlowCall -- Presumably the black hole has by now
528 -- been updated, but we don't know with
529 -- what, so we slow call it
530
531 getCallMethod _ _name _ LFLetNoEscape _n_args
532 = JumpToIt
533
534 isKnownFun :: LambdaFormInfo -> Bool
535 isKnownFun (LFReEntrant _ _ _ _) = True
536 isKnownFun LFLetNoEscape = True
537 isKnownFun _ = False
538
539 -----------------------------------------------------------------------------
540 -- staticClosureRequired
541 -----------------------------------------------------------------------------
542
543 {- staticClosureRequired is never called (hence commented out)
544
545 SimonMar writes (Sept 07) It's an optimisation we used to apply at
546 one time, I believe, but it got lost probably in the rewrite of
547 the RTS/code generator. I left that code there to remind me to
548 look into whether it was worth doing sometime
549
550 {- Avoiding generating entries and info tables
551 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
552 At present, for every function we generate all of the following,
553 just in case. But they aren't always all needed, as noted below:
554
555 [NB1: all of this applies only to *functions*. Thunks always
556 have closure, info table, and entry code.]
557
558 [NB2: All are needed if the function is *exported*, just to play safe.]
559
560 * Fast-entry code ALWAYS NEEDED
561
562 * Slow-entry code
563 Needed iff (a) we have any un-saturated calls to the function
564 OR (b) the function is passed as an arg
565 OR (c) we're in the parallel world and the function has free vars
566 [Reason: in parallel world, we always enter functions
567 with free vars via the closure.]
568
569 * The function closure
570 Needed iff (a) we have any un-saturated calls to the function
571 OR (b) the function is passed as an arg
572 OR (c) if the function has free vars (ie not top level)
573
574 Why case (a) here? Because if the arg-satis check fails,
575 UpdatePAP stuffs a pointer to the function closure in the PAP.
576 [Could be changed; UpdatePAP could stuff in a code ptr instead,
577 but doesn't seem worth it.]
578
579 [NB: these conditions imply that we might need the closure
580 without the slow-entry code. Here's how.
581
582 f x y = let g w = ...x..y..w...
583 in
584 ...(g t)...
585
586 Here we need a closure for g which contains x and y,
587 but since the calls are all saturated we just jump to the
588 fast entry point for g, with R1 pointing to the closure for g.]
589
590
591 * Standard info table
592 Needed iff (a) we have any un-saturated calls to the function
593 OR (b) the function is passed as an arg
594 OR (c) the function has free vars (ie not top level)
595
596 NB. In the sequential world, (c) is only required so that the function closure has
597 an info table to point to, to keep the storage manager happy.
598 If (c) alone is true we could fake up an info table by choosing
599 one of a standard family of info tables, whose entry code just
600 bombs out.
601
602 [NB In the parallel world (c) is needed regardless because
603 we enter functions with free vars via the closure.]
604
605 If (c) is retained, then we'll sometimes generate an info table
606 (for storage mgr purposes) without slow-entry code. Then we need
607 to use an error label in the info table to substitute for the absent
608 slow entry code.
609 -}
610
611 staticClosureRequired
612 :: Name
613 -> StgBinderInfo
614 -> LambdaFormInfo
615 -> Bool
616 staticClosureRequired binder bndr_info
617 (LFReEntrant top_level _ _ _) -- It's a function
618 = ASSERT( isTopLevel top_level )
619 -- Assumption: it's a top-level, no-free-var binding
620 not (satCallsOnly bndr_info)
621
622 staticClosureRequired binder other_binder_info other_lf_info = True
623 -}
624
625 -----------------------------------------------------------------------------
626 -- Data types for closure information
627 -----------------------------------------------------------------------------
628
629
630 {- ClosureInfo: information about a binding
631
632 We make a ClosureInfo for each let binding (both top level and not),
633 but not bindings for data constructors: for those we build a CmmInfoTable
634 directly (see mkDataConInfoTable).
635
636 To a first approximation:
637 ClosureInfo = (LambdaFormInfo, CmmInfoTable)
638
639 A ClosureInfo has enough information
640 a) to construct the info table itself, and build other things
641 related to the binding (e.g. slow entry points for a function)
642 b) to allocate a closure containing that info pointer (i.e.
643 it knows the info table label)
644 -}
645
646 data ClosureInfo
647 = ClosureInfo {
648 closureName :: !Name, -- The thing bound to this closure
649 -- we don't really need this field: it's only used in generating
650 -- code for ticky and profiling, and we could pass the information
651 -- around separately, but it doesn't do much harm to keep it here.
652
653 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon
654 -- this tells us about what the closure contains: it's right-hand-side.
655
656 -- the rest is just an unpacked CmmInfoTable.
657 closureInfoLabel :: !CLabel,
658 closureSMRep :: !SMRep, -- representation used by storage mgr
659 closureProf :: !ProfilingInfo
660 }
661
662 -- | Convert from 'ClosureInfo' to 'CmmInfoTable'.
663 mkCmmInfo :: ClosureInfo -> CmmInfoTable
664 mkCmmInfo ClosureInfo {..}
665 = CmmInfoTable { cit_lbl = closureInfoLabel
666 , cit_rep = closureSMRep
667 , cit_prof = closureProf
668 , cit_srt = NoC_SRT }
669
670
671 --------------------------------------
672 -- Building ClosureInfos
673 --------------------------------------
674
675 mkClosureInfo :: DynFlags
676 -> Bool -- Is static
677 -> Id
678 -> LambdaFormInfo
679 -> Int -> Int -- Total and pointer words
680 -> String -- String descriptor
681 -> ClosureInfo
682 mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr
683 = ClosureInfo { closureName = name,
684 closureLFInfo = lf_info,
685 closureInfoLabel = info_lbl, -- These three fields are
686 closureSMRep = sm_rep, -- (almost) an info table
687 closureProf = prof } -- (we don't have an SRT yet)
688 where
689 name = idName id
690 sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType lf_info)
691 prof = mkProfilingInfo dflags id val_descr
692 nonptr_wds = tot_wds - ptr_wds
693
694 info_lbl = mkClosureInfoTableLabel id lf_info
695
696 --------------------------------------
697 -- Other functions over ClosureInfo
698 --------------------------------------
699
700 -- Eager blackholing is normally disabled, but can be turned on with
701 -- -feager-blackholing. When it is on, we replace the info pointer of
702 -- the thunk with stg_EAGER_BLACKHOLE_info on entry.
703
704 -- If we wanted to do eager blackholing with slop filling,
705 -- we'd need to do it at the *end* of a basic block, otherwise
706 -- we overwrite the free variables in the thunk that we still
707 -- need. We have a patch for this from Andy Cheadle, but not
708 -- incorporated yet. --SDM [6/2004]
709 --
710 --
711 -- Previously, eager blackholing was enabled when ticky-ticky
712 -- was on. But it didn't work, and it wasn't strictly necessary
713 -- to bring back minimal ticky-ticky, so now EAGER_BLACKHOLING
714 -- is unconditionally disabled. -- krc 1/2007
715
716 -- Static closures are never themselves black-holed.
717
718 blackHoleOnEntry :: ClosureInfo -> Bool
719 blackHoleOnEntry cl_info
720 | isStaticRep (closureSMRep cl_info)
721 = False -- Never black-hole a static closure
722
723 | otherwise
724 = case closureLFInfo cl_info of
725 LFReEntrant _ _ _ _ -> False
726 LFLetNoEscape -> False
727 LFThunk _ _no_fvs _updatable _ _ -> True
728 _other -> panic "blackHoleOnEntry" -- Should never happen
729
730 isStaticClosure :: ClosureInfo -> Bool
731 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
732
733 closureUpdReqd :: ClosureInfo -> Bool
734 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
735
736 lfUpdatable :: LambdaFormInfo -> Bool
737 lfUpdatable (LFThunk _ _ upd _ _) = upd
738 lfUpdatable LFBlackHole = True
739 -- Black-hole closures are allocated to receive the results of an
740 -- alg case with a named default... so they need to be updated.
741 lfUpdatable _ = False
742
743 closureSingleEntry :: ClosureInfo -> Bool
744 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
745 closureSingleEntry _ = False
746
747 closureReEntrant :: ClosureInfo -> Bool
748 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
749 closureReEntrant _ = False
750
751 closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
752 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
753
754 lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr)
755 lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc)
756 lfFunInfo _ = Nothing
757
758 funTag :: ClosureInfo -> DynTag
759 funTag (ClosureInfo { closureLFInfo = lf_info }) = lfDynTag 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 closureRednCountsLabel :: ClosureInfo -> CLabel
776 closureRednCountsLabel = toRednCountsLbl . closureInfoLabel
777
778 closureSlowEntryLabel :: ClosureInfo -> CLabel
779 closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
780
781 closureLocalEntryLabel :: DynFlags -> ClosureInfo -> CLabel
782 closureLocalEntryLabel dflags
783 | tablesNextToCode dflags = toInfoLbl . closureInfoLabel
784 | otherwise = toEntryLbl . closureInfoLabel
785
786 mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel
787 mkClosureInfoTableLabel id lf_info
788 = case lf_info of
789 LFBlackHole -> mkCAFBlackHoleInfoTableLabel
790
791 LFThunk _ _ upd_flag (SelectorThunk offset) _
792 -> mkSelectorInfoLabel upd_flag offset
793
794 LFThunk _ _ upd_flag (ApThunk arity) _
795 -> mkApInfoTableLabel upd_flag arity
796
797 LFThunk{} -> std_mk_lbl name cafs
798 LFReEntrant{} -> std_mk_lbl name cafs
799 _other -> panic "closureInfoTableLabel"
800
801 where
802 name = idName id
803
804 std_mk_lbl | is_local = mkLocalInfoTableLabel
805 | otherwise = mkInfoTableLabel
806
807 cafs = idCafInfo id
808 is_local = isDataConWorkId id
809 -- Make the _info pointer for the implicit datacon worker
810 -- binding local. The reason we can do this is that importing
811 -- code always either uses the _closure or _con_info. By the
812 -- invariants in CorePrep anything else gets eta expanded.
813
814
815 thunkEntryLabel :: DynFlags -> Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
816 -- thunkEntryLabel is a local help function, not exported. It's used from
817 -- getCallMethod.
818 thunkEntryLabel dflags _thunk_id _ (ApThunk arity) upd_flag
819 = enterApLabel dflags upd_flag arity
820 thunkEntryLabel dflags _thunk_id _ (SelectorThunk offset) upd_flag
821 = enterSelectorLabel dflags upd_flag offset
822 thunkEntryLabel dflags thunk_id c _ _
823 = enterIdLabel dflags thunk_id c
824
825 enterApLabel :: DynFlags -> Bool -> Arity -> CLabel
826 enterApLabel dflags is_updatable arity
827 | tablesNextToCode dflags = mkApInfoTableLabel is_updatable arity
828 | otherwise = mkApEntryLabel is_updatable arity
829
830 enterSelectorLabel :: DynFlags -> Bool -> WordOff -> CLabel
831 enterSelectorLabel dflags upd_flag offset
832 | tablesNextToCode dflags = mkSelectorInfoLabel upd_flag offset
833 | otherwise = mkSelectorEntryLabel upd_flag offset
834
835 enterIdLabel :: DynFlags -> Name -> CafInfo -> CLabel
836 enterIdLabel dflags id c
837 | tablesNextToCode dflags = mkInfoTableLabel id c
838 | otherwise = mkEntryLabel id c
839
840
841 --------------------------------------
842 -- Profiling
843 --------------------------------------
844
845 -- Profiling requires two pieces of information to be determined for
846 -- each closure's info table --- description and type.
847
848 -- The description is stored directly in the @CClosureInfoTable@ when the
849 -- info table is built.
850
851 -- The type is determined from the type information stored with the @Id@
852 -- in the closure info using @closureTypeDescr@.
853
854 mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo
855 mkProfilingInfo dflags id val_descr
856 | not (dopt Opt_SccProfilingOn dflags) = NoProfilingInfo
857 | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8
858 where
859 ty_descr_w8 = stringToWord8s (getTyDescription (idType id))
860 val_descr_w8 = stringToWord8s val_descr
861
862 getTyDescription :: Type -> String
863 getTyDescription ty
864 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
865 case tau_ty of
866 TyVarTy _ -> "*"
867 AppTy fun _ -> getTyDescription fun
868 FunTy _ res -> '-' : '>' : fun_result res
869 TyConApp tycon _ -> getOccString tycon
870 ForAllTy _ ty -> getTyDescription ty
871 LitTy n -> getTyLitDescription n
872 }
873 where
874 fun_result (FunTy _ res) = '>' : fun_result res
875 fun_result other = getTyDescription other
876
877 getTyLitDescription :: TyLit -> String
878 getTyLitDescription l =
879 case l of
880 NumTyLit n -> show n
881 StrTyLit n -> show n
882
883 --------------------------------------
884 -- CmmInfoTable-related things
885 --------------------------------------
886
887 mkDataConInfoTable :: DynFlags -> DataCon -> Bool -> Int -> Int -> CmmInfoTable
888 mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
889 = CmmInfoTable { cit_lbl = info_lbl
890 , cit_rep = sm_rep
891 , cit_prof = prof
892 , cit_srt = NoC_SRT }
893 where
894 name = dataConName data_con
895
896 info_lbl | is_static = mkStaticInfoTableLabel name NoCafRefs
897 | otherwise = mkConInfoTableLabel name NoCafRefs
898
899 sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type
900
901 cl_type = Constr (fromIntegral (dataConTagZ data_con))
902 (dataConIdentity data_con)
903
904 prof | not (dopt Opt_SccProfilingOn dflags) = NoProfilingInfo
905 | otherwise = ProfilingInfo ty_descr val_descr
906
907 ty_descr = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con
908 val_descr = stringToWord8s $ occNameString $ getOccName data_con
909
910 -- We need a black-hole closure info to pass to @allocDynClosure@ when we
911 -- want to allocate the black hole on entry to a CAF.
912
913 cafBlackHoleInfoTable :: CmmInfoTable
914 cafBlackHoleInfoTable
915 = CmmInfoTable { cit_lbl = mkCAFBlackHoleInfoTableLabel
916 , cit_rep = blackHoleRep
917 , cit_prof = NoProfilingInfo
918 , cit_srt = NoC_SRT }
919
920 staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
921 -- A static closure needs a link field to aid the GC when traversing
922 -- the static closure graph. But it only needs such a field if either
923 -- a) it has an SRT
924 -- b) it's a constructor with one or more pointer fields
925 -- In case (b), the constructor's fields themselves play the role
926 -- of the SRT.
927 --
928 -- At this point, the cit_srt field has not been calculated (that
929 -- happens right at the end of the Cmm pipeline), but we do have the
930 -- VarSet of CAFs that CoreToStg attached, and if that is empty there
931 -- will definitely not be an SRT.
932 --
933 staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }
934 | isConRep smrep = not (isStaticNoCafCon smrep)
935 | otherwise = has_srt -- needsSRT (cit_srt info_tbl)