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