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