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