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