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