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