2
% (c) The University of Glasgow 2006
3
% (c) The Univserity of Glasgow 1992-2004
6
Data structures which describe closures, and
7
operations over those data structures
9
Nothing monadic in here
11
Much of the rationale for these things is in the ``details'' part of
16
ClosureInfo(..), LambdaFormInfo(..), -- would be abstract but
17
StandardFormInfo(..), -- mkCmmInfo looks inside
20
ArgDescr(..), Liveness(..),
23
mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
24
mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
26
mkClosureInfo, mkConInfo, maybeIsLFCon,
28
closureSize, closureNonHdrSize,
29
closureGoodStuffSize, closurePtrsSize,
34
isLFThunk, closureUpdReqd,
35
closureNeedsUpdSpace, closureIsThunk,
36
closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
37
closureFunInfo, isStandardFormThunk, isKnownFun,
38
funTag, funTagLFInfo, tagForArity,
40
enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
43
CallMethod(..), getCallMethod,
47
staticClosureRequired,
51
closureValDescr, closureTypeDescr, -- profiling
54
cafBlackHoleClosureInfo,
56
staticClosureNeedsLink,
59
#include "../includes/MachDeps.h"
60
#include "HsVersions.h"
87
%************************************************************************
89
\subsection[ClosureInfo-datatypes]{Data types for closure information}
91
%************************************************************************
93
Information about a closure, from the code generator's point of view.
95
A ClosureInfo decribes the info pointer of a closure. It has
97
a) to construct the info table itself
98
b) to allocate a closure containing that info pointer (i.e.
99
it knows the info table label)
101
We make a ClosureInfo for
102
- each let binding (both top level and not)
103
- each data constructor (for its shared static and
109
closureName :: !Name, -- The thing bound to this closure
110
closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
111
closureSMRep :: !SMRep, -- representation used by storage mgr
112
closureSRT :: !C_SRT, -- What SRT applies to this closure
113
closureType :: !Type, -- Type of closure (ToDo: remove)
114
closureDescr :: !String -- closure description (for profiling)
117
-- Constructor closures don't have a unique info table label (they use
118
-- the constructor's info table), and they don't have an SRT.
120
closureCon :: !DataCon,
121
closureSMRep :: !SMRep
124
-- C_SRT is what StgSyn.SRT gets translated to...
125
-- we add a label for the table, and expect only the 'offset/length' form
128
| C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
131
needsSRT :: C_SRT -> Bool
132
needsSRT NoC_SRT = False
133
needsSRT (C_SRT _ _ _) = True
135
instance Outputable C_SRT where
136
ppr (NoC_SRT) = ptext (sLit "_no_srt_")
137
ppr (C_SRT label off bitmap) = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap))
140
%************************************************************************
142
\subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
144
%************************************************************************
146
Information about an identifier, from the code generator's point of
147
view. Every identifier is bound to a LambdaFormInfo in the
148
environment, which gives the code generator enough info to be able to
149
tail call or return that identifier.
151
Note that a closure is usually bound to an identifier, so a
152
ClosureInfo contains a LambdaFormInfo.
156
= LFReEntrant -- Reentrant closure (a function)
157
TopLevelFlag -- True if top level
158
!Int -- Arity. Invariant: always > 0
159
!Bool -- True <=> no fvs
160
ArgDescr -- Argument descriptor (should reall be in ClosureInfo)
162
| LFCon -- A saturated constructor application
163
DataCon -- The constructor
165
| LFThunk -- Thunk (zero arity)
167
!Bool -- True <=> no free vars
168
!Bool -- True <=> updatable (i.e., *not* single-entry)
170
!Bool -- True <=> *might* be a function type
172
| LFUnknown -- Used for function arguments and imported things.
173
-- We know nothing about this closure. Treat like
174
-- updatable "LFThunk"...
175
-- Imported things which we do know something about use
176
-- one of the other LF constructors (eg LFReEntrant for
178
!Bool -- True <=> *might* be a function type
180
| LFLetNoEscape -- See LetNoEscape module for precise description of
184
| LFBlackHole -- Used for the closures allocated to hold the result
185
-- of a CAF. We want the target of the update frame to
186
-- be in the heap, so we make a black hole to hold it.
187
CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
190
-------------------------
191
-- An ArgDsecr describes the argument pattern of a function
194
= ArgSpec -- Fits one of the standard patterns
195
!StgHalfWord -- RTS type identifier ARG_P, ARG_N, ...
197
| ArgGen -- General case
198
Liveness -- Details about the arguments
201
-------------------------
202
-- We represent liveness bitmaps as a Bitmap (whose internal
203
-- representation really is a bitmap). These are pinned onto case return
204
-- vectors to indicate the state of the stack for the garbage collector.
206
-- In the compiled program, liveness bitmaps that fit inside a single
207
-- word (StgWord) are stored as a single word, while larger bitmaps are
208
-- stored as a pointer to an array of words.
211
= SmallLiveness -- Liveness info that fits in one word
212
StgWord -- Here's the bitmap
214
| BigLiveness -- Liveness info witha a multi-word bitmap
215
CLabel -- Label for the bitmap
218
-------------------------
219
-- StandardFormInfo tells whether this thunk has one of
220
-- a small number of standard forms
222
data StandardFormInfo
224
-- Not of of the standard forms
227
-- A SelectorThunk is of form
229
-- con a1,..,an -> ak
230
-- and the constructor is from a single-constr type.
231
WordOff -- 0-origin offset of ak within the "goods" of
232
-- constructor (Recall that the a1,...,an may be laid
233
-- out in the heap in a non-obvious order.)
236
-- An ApThunk is of form
238
-- The code for the thunk just pushes x2..xn on the stack and enters x1.
239
-- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
240
-- in the RTS to save space.
244
%************************************************************************
246
\subsection[ClosureInfo-construction]{Functions which build LFInfos}
248
%************************************************************************
251
mkLFReEntrant :: TopLevelFlag -- True of top level
254
-> ArgDescr -- Argument descriptor
257
mkLFReEntrant top fvs args arg_descr
258
= LFReEntrant top (length args) (null fvs) arg_descr
260
mkLFThunk :: Type -> TopLevelFlag -> [Var] -> UpdateFlag -> LambdaFormInfo
261
mkLFThunk thunk_ty top fvs upd_flag
262
= ASSERT2( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty), ppr thunk_ty $$ ppr fvs )
263
LFThunk top (null fvs)
264
(isUpdatable upd_flag)
266
(might_be_a_function thunk_ty)
268
might_be_a_function :: Type -> Bool
269
-- Return False only if we are *sure* it's a data type
270
-- Look through newtypes etc as much as poss
271
might_be_a_function ty
272
= case splitTyConApp_maybe (repType ty) of
273
Just (tc, _) -> not (isDataTyCon tc)
277
@mkConLFInfo@ is similar, for constructors.
280
mkConLFInfo :: DataCon -> LambdaFormInfo
281
mkConLFInfo con = LFCon con
283
maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon
284
maybeIsLFCon (LFCon con) = Just con
285
maybeIsLFCon _ = Nothing
287
mkSelectorLFInfo :: Id -> WordOff -> Bool -> LambdaFormInfo
288
mkSelectorLFInfo id offset updatable
289
= LFThunk NotTopLevel False updatable (SelectorThunk offset)
290
(might_be_a_function (idType id))
292
mkApLFInfo :: Id -> UpdateFlag -> Int -> LambdaFormInfo
293
mkApLFInfo id upd_flag arity
294
= LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
295
(might_be_a_function (idType id))
298
Miscellaneous LF-infos.
301
mkLFArgument :: Id -> LambdaFormInfo
302
mkLFArgument id = LFUnknown (might_be_a_function (idType id))
304
mkLFLetNoEscape :: Int -> LambdaFormInfo
305
mkLFLetNoEscape = LFLetNoEscape
307
mkLFImported :: Id -> LambdaFormInfo
310
n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0
311
_ -> mkLFArgument id -- Not sure of exact arity
315
isLFThunk :: LambdaFormInfo -> Bool
316
isLFThunk (LFThunk _ _ _ _ _) = True
317
isLFThunk (LFBlackHole _) = True
318
-- return True for a blackhole: this function is used to determine
319
-- whether to use the thunk header in SMP mode, and a blackhole
324
%************************************************************************
326
Building ClosureInfos
328
%************************************************************************
331
mkClosureInfo :: Bool -- Is static
334
-> Int -> Int -- Total and pointer words
336
-> String -- String descriptor
338
mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
339
= ClosureInfo { closureName = name,
340
closureLFInfo = lf_info,
341
closureSMRep = sm_rep,
342
closureSRT = srt_info,
343
closureType = idType id,
344
closureDescr = descr }
347
sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
349
mkConInfo :: Bool -- Is static
351
-> Int -> Int -- Total and pointer words
353
mkConInfo is_static data_con tot_wds ptr_wds
354
= ConInfo { closureSMRep = sm_rep,
355
closureCon = data_con }
357
sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
360
%************************************************************************
362
\subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
364
%************************************************************************
367
closureSize :: ClosureInfo -> WordOff
368
closureSize cl_info = hdr_size + closureNonHdrSize cl_info
369
where hdr_size | closureIsThunk cl_info = thunkHdrSize
370
| otherwise = fixedHdrSize
371
-- All thunks use thunkHdrSize, even if they are non-updatable.
372
-- this is because we don't have separate closure types for
373
-- updatable vs. non-updatable thunks, so the GC can't tell the
374
-- difference. If we ever have significant numbers of non-
375
-- updatable thunks, it might be worth fixing this.
377
closureNonHdrSize :: ClosureInfo -> WordOff
378
closureNonHdrSize cl_info
379
= tot_wds + computeSlopSize tot_wds cl_info
381
tot_wds = closureGoodStuffSize cl_info
383
closureGoodStuffSize :: ClosureInfo -> WordOff
384
closureGoodStuffSize cl_info
385
= let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
388
closurePtrsSize :: ClosureInfo -> WordOff
389
closurePtrsSize cl_info
390
= let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
394
sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
395
sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
396
sizes_from_SMRep BlackHoleRep = (0, 0)
399
Computing slop size. WARNING: this looks dodgy --- it has deep
400
knowledge of what the storage manager does with the various
403
Slop Requirements: every thunk gets an extra padding word in the
404
header, which takes the the updated value.
407
slopSize :: ClosureInfo -> WordOff
408
slopSize cl_info = computeSlopSize payload_size cl_info
409
where payload_size = closureGoodStuffSize cl_info
411
computeSlopSize :: WordOff -> ClosureInfo -> WordOff
412
computeSlopSize payload_size cl_info
413
= max 0 (minPayloadSize smrep updatable - payload_size)
415
smrep = closureSMRep cl_info
416
updatable = closureNeedsUpdSpace cl_info
418
-- we leave space for an update if either (a) the closure is updatable
419
-- or (b) it is a static thunk. This is because a static thunk needs
420
-- a static link field in a predictable place (after the slop), regardless
421
-- of whether it is updatable or not.
422
closureNeedsUpdSpace :: ClosureInfo -> Bool
423
closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
424
LFThunk TopLevel _ _ _ _ }) = True
425
closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
427
minPayloadSize :: SMRep -> Bool -> WordOff
428
minPayloadSize smrep updatable
430
BlackHoleRep -> min_upd_size
431
GenericRep _ _ _ _ | updatable -> min_upd_size
432
GenericRep True _ _ _ -> 0 -- static
433
GenericRep False _ _ _ -> mIN_PAYLOAD_SIZE
437
ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader)
438
0 -- check that we already have enough
439
-- room for mIN_SIZE_NonUpdHeapObject,
440
-- due to the extra header word in SMP
443
%************************************************************************
445
\subsection[SMreps]{Choosing SM reps}
447
%************************************************************************
451
:: Bool -- True <=> static closure
453
-> WordOff -> WordOff -- Tot wds, ptr wds
456
chooseSMRep is_static lf_info tot_wds ptr_wds
458
nonptr_wds = tot_wds - ptr_wds
459
closure_type = getClosureType is_static ptr_wds lf_info
461
GenericRep is_static ptr_wds nonptr_wds closure_type
463
-- We *do* get non-updatable top-level thunks sometimes. eg. f = g
464
-- gets compiled to a jump to g (if g has non-zero arity), instead of
465
-- messing around with update frames and PAPs. We set the closure type
466
-- to FUN_STATIC in this case.
468
getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
469
getClosureType is_static ptr_wds lf_info
471
LFCon _ | is_static && ptr_wds == 0 -> ConstrNoCaf
472
| otherwise -> Constr
473
LFReEntrant _ _ _ _ -> Fun
474
LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector
475
LFThunk _ _ _ _ _ -> Thunk
476
_ -> panic "getClosureType"
479
%************************************************************************
481
\subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
483
%************************************************************************
485
Be sure to see the stg-details notes about these...
488
nodeMustPointToIt :: LambdaFormInfo -> Bool
489
nodeMustPointToIt (LFReEntrant top _ no_fvs _)
490
= not no_fvs || -- Certainly if it has fvs we need to point to it
492
-- If it is not top level we will point to it
493
-- We can have a \r closure with no_fvs which
494
-- is not top level as special case cgRhsClosure
495
-- has been dissabled in favour of let floating
497
-- For lex_profiling we also access the cost centre for a
498
-- non-inherited function i.e. not top level
499
-- the not top case above ensures this is ok.
501
nodeMustPointToIt (LFCon _) = True
503
-- Strictly speaking, the above two don't need Node to point
504
-- to it if the arity = 0. But this is a *really* unlikely
505
-- situation. If we know it's nil (say) and we are entering
506
-- it. Eg: let x = [] in x then we will certainly have inlined
507
-- x, since nil is a simple atom. So we gain little by not
508
-- having Node point to known zero-arity things. On the other
509
-- hand, we do lose something; Patrick's code for figuring out
510
-- when something has been updated but not entered relies on
511
-- having Node point to the result of an update. SLPJ
514
nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
515
= updatable || not no_fvs || opt_SccProfilingOn
516
-- For the non-updatable (single-entry case):
518
-- True if has fvs (in which case we need access to them, and we
519
-- should black-hole it)
520
-- or profiling (in which case we need to recover the cost centre
523
nodeMustPointToIt (LFThunk _ _ _ _ _)
524
= True -- Node must point to any standard-form thunk
526
nodeMustPointToIt (LFUnknown _) = True
527
nodeMustPointToIt (LFBlackHole _) = True -- BH entry may require Node to point
528
nodeMustPointToIt (LFLetNoEscape _) = False
531
The entry conventions depend on the type of closure being entered,
532
whether or not it has free variables, and whether we're running
533
sequentially or in parallel.
535
\begin{tabular}{lllll}
536
Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
537
Unknown & no & yes & stack & node \\
538
Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
539
\ & \ & \ & \ & slow entry (otherwise) \\
540
Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
541
0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
542
0 arg, no fvs @\u@ & no & yes & n/a & node \\
543
0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
544
0 arg, fvs @\u@ & no & yes & n/a & node \\
546
Unknown & yes & yes & stack & node \\
547
Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
548
\ & \ & \ & \ & slow entry (otherwise) \\
549
Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
550
0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
551
0 arg, no fvs @\u@ & yes & yes & n/a & node \\
552
0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
553
0 arg, fvs @\u@ & yes & yes & n/a & node\\
556
When black-holing, single-entry closures could also be entered via node
557
(rather than directly) to catch double-entry.
561
= EnterIt -- no args, not a function
563
| JumpToIt CLabel -- no args, not a function, but we
564
-- know what its entry code is
566
| ReturnIt -- it's a function, but we have
567
-- zero args to apply to it, so just
570
| ReturnCon DataCon -- It's a data constructor, just return it
572
| SlowCall -- Unknown fun, or known fun with
575
| DirectEntry -- Jump directly, with args in regs
576
CLabel -- The code label
579
getCallMethod :: DynFlags
580
-> Name -- Function being applied
581
-> CafInfo -- Can it refer to CAF's?
582
-> LambdaFormInfo -- Its info
583
-> Int -- Number of available arguments
586
getCallMethod _ _ _ lf_info _
587
| nodeMustPointToIt lf_info && opt_Parallel
588
= -- If we're parallel, then we must always enter via node.
589
-- The reason is that the closure may have been
590
-- fetched since we allocated it.
593
getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args
594
| n_args == 0 = ASSERT( arity /= 0 )
595
ReturnIt -- No args at all
596
| n_args < arity = SlowCall -- Not enough args
597
| otherwise = DirectEntry (enterIdLabel name caf) arity
599
getCallMethod _ _ _ (LFCon con) n_args
600
| opt_SccProfilingOn -- when profiling, we must always enter
601
= EnterIt -- a closure when we use it, so that the closure
602
-- can be recorded as used for LDV profiling.
604
= ASSERT( n_args == 0 )
607
getCallMethod _dflags _name _caf (LFThunk _ _ _updatable _std_form_info is_fun) _n_args
608
| is_fun -- it *might* be a function, so we must "call" it (which is
610
= SlowCall -- We cannot just enter it [in eval/apply, the entry code
611
-- is the fast-entry code]
613
-- Since is_fun is False, we are *definitely* looking at a data value
616
-- We used to have ASSERT( n_args == 0 ), but actually it is
617
-- possible for the optimiser to generate
618
-- let bot :: Int = error Int "urk"
619
-- in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
620
-- This happens as a result of the case-of-error transformation
621
-- So the right thing to do is just to enter the thing
624
-- | updatable || doingTickyProfiling dflags -- to catch double entry
626
-- | otherwise -- Jump direct to code for single-entry thunks
627
-- = JumpToIt (thunkEntryLabel name caf std_form_info updatable)
629
-- Now we never use JumpToIt, even if the thunk is single-entry, since
630
-- the thunk may have already been entered and blackholed by another
634
getCallMethod _ _ _ (LFUnknown True) _
635
= SlowCall -- Might be a function
637
getCallMethod _ name _ (LFUnknown False) n_args
639
= WARN( True, ppr name <+> ppr n_args )
640
SlowCall -- Note [Unsafe coerce complications]
643
= EnterIt -- Not a function
645
getCallMethod _ _ _ (LFBlackHole _) _
646
= SlowCall -- Presumably the black hole has by now
647
-- been updated, but we don't know with
648
-- what, so we slow call it
650
getCallMethod _ name _ (LFLetNoEscape 0) _
651
= JumpToIt (enterReturnPtLabel (nameUnique name))
653
getCallMethod _ name _ (LFLetNoEscape arity) n_args
654
| n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
655
| otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
657
blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
658
-- Static closures are never themselves black-holed.
659
-- Updatable ones will be overwritten with a CAFList cell, which points to a
661
-- Single-entry ones have no fvs to plug, and we trust they don't form part
664
blackHoleOnEntry _ ConInfo{} = False
665
blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
667
= False -- Never black-hole a static closure
671
LFReEntrant _ _ _ _ -> False
672
LFLetNoEscape _ -> False
673
LFThunk _ no_fvs updatable _ _
675
then not opt_OmitBlackHoling
676
else doingTickyProfiling dflags || not no_fvs
677
-- the former to catch double entry,
678
-- and the latter to plug space-leaks. KSW/SDM 1999-04.
680
_ -> panic "blackHoleOnEntry" -- Should never happen
682
isStandardFormThunk :: LambdaFormInfo -> Bool
683
isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
684
isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
685
isStandardFormThunk _ = False
687
isKnownFun :: LambdaFormInfo -> Bool
688
isKnownFun (LFReEntrant _ _ _ _) = True
689
isKnownFun (LFLetNoEscape _) = True
693
Note [Unsafe coerce complications]
694
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
695
In some (badly-optimised) DPH code we see this
696
Module X: rr :: Int = error Int "Urk"
697
Module Y: ...((X.rr |> g) True) ...
698
where g is an (unsafe) coercion of kind (Int ~ Bool->Bool), say
700
It's badly optimised, because knowing that 'X.rr' is bottom, we should
701
have dumped the application to True. But it should still work. These
702
strange unsafe coercions arise from the case-of-error transformation:
703
(case (error Int "foo") of { ... }) True
704
---> (error Int "foo" |> g) True
706
Anyway, the net effect is that in STG-land, when casts are discarded,
707
we *can* see a value of type Int applied to an argument. This only happens
708
if (a) the programmer made a mistake, or (b) the value of type Int is
711
So it's wrong to trigger an ASSERT failure in this circumstance. Instead
712
we now emit a WARN -- mainly to draw attention to a probably-badly-optimised
713
program fragment -- and do the conservative thing which is SlowCall.
716
-----------------------------------------------------------------------------
720
staticClosureNeedsLink :: ClosureInfo -> Bool
721
-- A static closure needs a link field to aid the GC when traversing
722
-- the static closure graph. But it only needs such a field if either
724
-- b) it's a constructor with one or more pointer fields
725
-- In case (b), the constructor's fields themselves play the role
727
staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
729
staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
730
= not (isNullaryRepDataCon con) && not_nocaf_constr
734
GenericRep _ _ _ ConstrNoCaf -> False
738
Note [Entering error thunks]
739
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
743
fail = error Int "Urk"
746
foo True y = (fail `cast` Bool -> Bool) y
749
This looks silly, but it can arise from case-of-error. Even if it
750
does, we'd usually see that 'fail' is a bottoming function and would
751
discard the extra argument 'y'. But even if that does not occur,
752
this program is still OK. We will enter 'fail', which never returns.
754
The WARN is just to alert me to the fact that we aren't spotting that
757
(We are careful never to make a funtion value look like a data type,
758
because we can't enter a function closure -- but that is not the
762
Avoiding generating entries and info tables
763
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
764
At present, for every function we generate all of the following,
765
just in case. But they aren't always all needed, as noted below:
767
[NB1: all of this applies only to *functions*. Thunks always
768
have closure, info table, and entry code.]
770
[NB2: All are needed if the function is *exported*, just to play safe.]
773
* Fast-entry code ALWAYS NEEDED
776
Needed iff (a) we have any un-saturated calls to the function
777
OR (b) the function is passed as an arg
778
OR (c) we're in the parallel world and the function has free vars
779
[Reason: in parallel world, we always enter functions
780
with free vars via the closure.]
782
* The function closure
783
Needed iff (a) we have any un-saturated calls to the function
784
OR (b) the function is passed as an arg
785
OR (c) if the function has free vars (ie not top level)
787
Why case (a) here? Because if the arg-satis check fails,
788
UpdatePAP stuffs a pointer to the function closure in the PAP.
789
[Could be changed; UpdatePAP could stuff in a code ptr instead,
790
but doesn't seem worth it.]
792
[NB: these conditions imply that we might need the closure
793
without the slow-entry code. Here's how.
795
f x y = let g w = ...x..y..w...
799
Here we need a closure for g which contains x and y,
800
but since the calls are all saturated we just jump to the
801
fast entry point for g, with R1 pointing to the closure for g.]
804
* Standard info table
805
Needed iff (a) we have any un-saturated calls to the function
806
OR (b) the function is passed as an arg
807
OR (c) the function has free vars (ie not top level)
809
NB. In the sequential world, (c) is only required so that the function closure has
810
an info table to point to, to keep the storage manager happy.
811
If (c) alone is true we could fake up an info table by choosing
812
one of a standard family of info tables, whose entry code just
815
[NB In the parallel world (c) is needed regardless because
816
we enter functions with free vars via the closure.]
818
If (c) is retained, then we'll sometimes generate an info table
819
(for storage mgr purposes) without slow-entry code. Then we need
820
to use an error label in the info table to substitute for the absent
824
staticClosureRequired
829
staticClosureRequired _ bndr_info
830
(LFReEntrant top_level _ _ _) -- It's a function
831
= ASSERT( isTopLevel top_level )
832
-- Assumption: it's a top-level, no-free-var binding
833
not (satCallsOnly bndr_info)
835
staticClosureRequired _ _ _ = True
838
%************************************************************************
840
\subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
842
%************************************************************************
846
isStaticClosure :: ClosureInfo -> Bool
847
isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
849
closureUpdReqd :: ClosureInfo -> Bool
850
closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
851
closureUpdReqd ConInfo{} = False
853
lfUpdatable :: LambdaFormInfo -> Bool
854
lfUpdatable (LFThunk _ _ upd _ _) = upd
855
lfUpdatable (LFBlackHole _) = True
856
-- Black-hole closures are allocated to receive the results of an
857
-- alg case with a named default... so they need to be updated.
858
lfUpdatable _ = False
860
closureIsThunk :: ClosureInfo -> Bool
861
closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
862
closureIsThunk ConInfo{} = False
864
closureSingleEntry :: ClosureInfo -> Bool
865
closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
866
closureSingleEntry _ = False
868
closureReEntrant :: ClosureInfo -> Bool
869
closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
870
closureReEntrant _ = False
872
isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
873
isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
874
isConstrClosure_maybe _ = Nothing
876
closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
877
closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
878
closureFunInfo _ = Nothing
880
lfFunInfo :: LambdaFormInfo -> Maybe (Int, ArgDescr)
881
lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc)
882
lfFunInfo _ = Nothing
884
funTag :: ClosureInfo -> Int
885
funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info
888
-- maybe this should do constructor tags too?
889
funTagLFInfo :: LambdaFormInfo -> Int
891
-- A function is tagged with its arity
892
| Just (arity,_) <- lfFunInfo lf,
893
Just tag <- tagForArity arity
896
-- other closures (and unknown ones) are not tagged
900
tagForArity :: Int -> Maybe Int
901
tagForArity i | i <= mAX_PTR_TAG = Just i
902
| otherwise = Nothing
906
isToplevClosure :: ClosureInfo -> Bool
907
isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
909
LFReEntrant TopLevel _ _ _ -> True
910
LFThunk TopLevel _ _ _ _ -> True
912
isToplevClosure _ = False
918
infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
919
infoTableLabelFromCI (ClosureInfo { closureName = name,
920
closureLFInfo = lf_info }) caf
922
LFBlackHole info -> info
924
LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
925
mkSelectorInfoLabel upd_flag offset
927
LFThunk _ _ upd_flag (ApThunk arity) _ ->
928
mkApInfoTableLabel upd_flag arity
930
LFThunk{} -> mkLocalInfoTableLabel name caf
932
LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name caf
934
_ -> panic "infoTableLabelFromCI"
936
infoTableLabelFromCI (ConInfo { closureCon = con,
937
closureSMRep = rep }) caf
938
| isStaticRep rep = mkStaticInfoTableLabel name caf
939
| otherwise = mkConInfoTableLabel name caf
941
name = dataConName con
943
-- ClosureInfo for a closure (as opposed to a constructor) is always local
944
closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
945
closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf
946
closureLabelFromCI _ _ = panic "closureLabelFromCI"
948
-- thunkEntryLabel is a local help function, not exported. It's used from both
949
-- entryLabelFromCI and getCallMethod.
952
thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
953
thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable
954
= enterApLabel is_updatable arity
955
thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag
956
= enterSelectorLabel upd_flag offset
957
thunkEntryLabel thunk_id caf _ _is_updatable
958
= enterIdLabel thunk_id caf
962
enterApLabel :: Bool -> Int -> CLabel
963
enterApLabel is_updatable arity
964
| tablesNextToCode = mkApInfoTableLabel is_updatable arity
965
| otherwise = mkApEntryLabel is_updatable arity
969
enterSelectorLabel :: Bool -> Int -> CLabel
970
enterSelectorLabel upd_flag offset
971
| tablesNextToCode = mkSelectorInfoLabel upd_flag offset
972
| otherwise = mkSelectorEntryLabel upd_flag offset
975
enterIdLabel :: Name -> CafInfo -> CLabel
977
| tablesNextToCode = mkInfoTableLabel id
978
| otherwise = mkEntryLabel id
980
enterLocalIdLabel :: Name -> CafInfo -> CLabel
982
| tablesNextToCode = mkLocalInfoTableLabel id
983
| otherwise = mkLocalEntryLabel id
985
enterReturnPtLabel :: Unique -> CLabel
986
enterReturnPtLabel name
987
| tablesNextToCode = mkReturnInfoLabel name
988
| otherwise = mkReturnPtLabel name
992
We need a black-hole closure info to pass to @allocDynClosure@ when we
993
want to allocate the black hole on entry to a CAF. These are the only
994
ways to build an LFBlackHole, maintaining the invariant that it really
995
is a black hole and not something else.
998
cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
999
cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
1001
= ClosureInfo { closureName = nm,
1002
closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
1003
closureSMRep = BlackHoleRep,
1004
closureSRT = NoC_SRT,
1007
cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
1010
%************************************************************************
1012
\subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1014
%************************************************************************
1016
Profiling requires two pieces of information to be determined for
1017
each closure's info table --- description and type.
1019
The description is stored directly in the @CClosureInfoTable@ when the
1020
info table is built.
1022
The type is determined from the type information stored with the @Id@
1023
in the closure info using @closureTypeDescr@.
1026
closureValDescr, closureTypeDescr :: ClosureInfo -> String
1027
closureValDescr (ClosureInfo {closureDescr = descr})
1029
closureValDescr (ConInfo {closureCon = con})
1030
= occNameString (getOccName con)
1032
closureTypeDescr (ClosureInfo { closureType = ty })
1033
= getTyDescription ty
1034
closureTypeDescr (ConInfo { closureCon = data_con })
1035
= occNameString (getOccName (dataConTyCon data_con))
1037
getTyDescription :: Type -> String
1039
= case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
1042
AppTy fun _ -> getTyDescription fun
1043
FunTy _ res -> '-' : '>' : fun_result res
1044
TyConApp tycon _ -> getOccString tycon
1045
PredTy sty -> getPredTyDescription sty
1046
ForAllTy _ ty -> getTyDescription ty
1049
fun_result (FunTy _ res) = '>' : fun_result res
1050
fun_result other = getTyDescription other
1052
getPredTyDescription :: PredType -> String
1053
getPredTyDescription (ClassP cl _) = getOccString cl
1054
getPredTyDescription (IParam ip _) = getOccString (ipNameName ip)
1055
getPredTyDescription (EqPred _ _) = panic "getPredTyDescription EqPred"
added
removed
compiler/codeGen/ClosureInfo.lhs
