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