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