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