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