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