[project @ 2000-12-06 13:19:49 by simonmar]
[ghc-hetmet.git] / ghc / compiler / codeGen / ClosureInfo.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 % $Id: ClosureInfo.lhs,v 1.44 2000/12/06 13:19:49 simonmar Exp $
5 %
6 \section[ClosureInfo]{Data structures which describe closures}
7
8 Much of the rationale for these things is in the ``details'' part of
9 the STG paper.
10
11 \begin{code}
12 module ClosureInfo (
13         ClosureInfo, LambdaFormInfo, SMRep,     -- all abstract
14         StandardFormInfo,
15
16         EntryConvention(..),
17
18         mkClosureLFInfo, mkConLFInfo, mkSelectorLFInfo,
19         mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
20         UpdateFlag,
21
22         closureSize, closureNonHdrSize,
23         closureGoodStuffSize, closurePtrsSize,
24         slopSize,
25
26         layOutDynClosure, layOutDynCon, layOutStaticClosure,
27         layOutStaticNoFVClosure,
28         mkVirtHeapOffsets,
29
30         nodeMustPointToIt, getEntryConvention, 
31         FCode, CgInfoDownwards, CgState, 
32
33         blackHoleOnEntry,
34
35         staticClosureRequired,
36         slowFunEntryCodeRequired, funInfoTableRequired,
37
38         closureName, infoTableLabelFromCI, fastLabelFromCI,
39         closureLabelFromCI,
40         entryLabelFromCI, 
41         closureLFInfo, closureSMRep, closureUpdReqd,
42         closureSingleEntry, closureReEntrant, closureSemiTag,
43         isStandardFormThunk,
44         GenStgArg,
45
46         isToplevClosure,
47         closureTypeDescr,               -- profiling
48
49         isStaticClosure,
50         allocProfilingMsg,
51         cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
52         maybeSelectorInfo,
53
54         infoTblNeedsSRT,
55         staticClosureNeedsLink,
56         getSRTInfo
57     ) where
58
59 #include "HsVersions.h"
60
61 import AbsCSyn          ( MagicId, node, VirtualHeapOffset, HeapOffset )
62 import StgSyn
63 import CgMonad
64
65 import Constants        ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject,
66                           mAX_SPEC_FUN_SIZE, mAX_SPEC_THUNK_SIZE, mAX_SPEC_CONSTR_SIZE )
67 import CgRetConv        ( assignRegs )
68 import CLabel           ( CLabel, mkStdEntryLabel, mkFastEntryLabel,
69                           mkInfoTableLabel,
70                           mkConInfoTableLabel, 
71                           mkCAFBlackHoleInfoTableLabel, 
72                           mkSECAFBlackHoleInfoTableLabel, 
73                           mkStaticInfoTableLabel, mkStaticConEntryLabel,
74                           mkConEntryLabel, mkClosureLabel,
75                           mkSelectorInfoLabel, mkSelectorEntryLabel,
76                           mkApInfoTableLabel, mkApEntryLabel,
77                           mkReturnPtLabel
78                         )
79 import CmdLineOpts      ( opt_SccProfilingOn, opt_OmitBlackHoling,
80                           opt_Parallel, opt_DoTickyProfiling,
81                           opt_SMP )
82 import Id               ( Id, idType, idArityInfo )
83 import DataCon          ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
84                           isNullaryDataCon, dataConName
85                         )
86 import TyCon            ( isBoxedTupleTyCon )
87 import IdInfo           ( ArityInfo(..) )
88 import Name             ( Name, isExternallyVisibleName, nameUnique, 
89                           getOccName )
90 import OccName          ( occNameUserString )
91 import PprType          ( getTyDescription )
92 import PrimRep          ( getPrimRepSize, separateByPtrFollowness, PrimRep )
93 import SMRep            -- all of it
94 import Type             ( isUnLiftedType, Type )
95 import BasicTypes       ( TopLevelFlag(..), isNotTopLevel, isTopLevel )
96 import Util             ( mapAccumL )
97 import Outputable
98 \end{code}
99
100 The ``wrapper'' data type for closure information:
101
102 \begin{code}
103 data ClosureInfo
104   = MkClosureInfo
105         Name                    -- The thing bound to this closure
106         LambdaFormInfo          -- info derivable from the *source*
107         SMRep                   -- representation used by storage manager
108 \end{code}
109
110 %************************************************************************
111 %*                                                                      *
112 \subsection[ClosureInfo-datatypes]{Data types for closure information}
113 %*                                                                      *
114 %************************************************************************
115
116 %************************************************************************
117 %*                                                                      *
118 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
119 %*                                                                      *
120 %************************************************************************
121
122 \begin{code}
123 data LambdaFormInfo
124   = LFReEntrant         -- Reentrant closure; used for PAPs too
125         Type            -- Type of closure    (ToDo: remove)
126         TopLevelFlag    -- True if top level
127         !Int            -- Arity
128         !Bool           -- True <=> no fvs
129         CLabel          -- SRT label
130         SRT             -- SRT info
131
132   | LFCon               -- Constructor
133         DataCon         -- The constructor
134         Bool            -- True <=> zero arity
135
136   | LFTuple             -- Tuples
137         DataCon         -- The tuple constructor
138         Bool            -- True <=> zero arity
139
140   | LFThunk             -- Thunk (zero arity)
141         Type            -- Type of the thunk   (ToDo: remove)
142         TopLevelFlag
143         !Bool           -- True <=> no free vars
144         Bool            -- True <=> updatable (i.e., *not* single-entry)
145         StandardFormInfo
146         CLabel          -- SRT label
147         SRT             -- SRT info
148
149   | LFArgument          -- Used for function arguments.  We know nothing about
150                         -- this closure.  Treat like updatable "LFThunk"...
151
152   | LFImported          -- Used for imported things.  We know nothing about this
153                         -- closure.  Treat like updatable "LFThunk"...
154                         -- Imported things which we do know something about use
155                         -- one of the other LF constructors (eg LFReEntrant for
156                         -- known functions)
157
158   | LFLetNoEscape       -- See LetNoEscape module for precise description of
159                         -- these "lets".
160         Int             -- arity;
161
162   | LFBlackHole         -- Used for the closures allocated to hold the result
163                         -- of a CAF.  We want the target of the update frame to
164                         -- be in the heap, so we make a black hole to hold it.
165         CLabel          -- Flavour (info label, eg CAF_BLACKHOLE_info).
166
167
168 data StandardFormInfo   -- Tells whether this thunk has one of a small number
169                         -- of standard forms
170
171   = NonStandardThunk    -- No, it isn't
172
173   | SelectorThunk
174        Int              -- 0-origin offset of ak within the "goods" of 
175                         -- constructor (Recall that the a1,...,an may be laid
176                         -- out in the heap in a non-obvious order.)
177
178 {- A SelectorThunk is of form
179
180      case x of
181        con a1,..,an -> ak
182
183    and the constructor is from a single-constr type.
184 -}
185
186   | ApThunk 
187         Int             -- arity
188
189 {- An ApThunk is of form
190
191         x1 ... xn
192
193    The code for the thunk just pushes x2..xn on the stack and enters x1.
194    There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
195    in the RTS to save space.
196 -}
197
198 \end{code}
199
200 %************************************************************************
201 %*                                                                      *
202 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
203 %*                                                                      *
204 %************************************************************************
205
206 @mkClosureLFInfo@ figures out the appropriate LFInfo for the closure.
207
208 \begin{code}
209 mkClosureLFInfo :: Id           -- The binder
210                 -> TopLevelFlag -- True of top level
211                 -> [Id]         -- Free vars
212                 -> UpdateFlag   -- Update flag
213                 -> [Id]         -- Args
214                 -> CLabel       -- SRT label
215                 -> SRT          -- SRT info
216                 -> LambdaFormInfo
217
218 mkClosureLFInfo bndr top fvs upd_flag args@(_:_) srt_label srt -- Non-empty args
219   = LFReEntrant (idType bndr) top (length args) (null fvs) srt_label srt
220
221 mkClosureLFInfo bndr top fvs ReEntrant [] srt_label srt
222   = LFReEntrant (idType bndr) top 0 (null fvs) srt_label srt
223
224 mkClosureLFInfo bndr top fvs upd_flag [] srt_label srt
225 #ifdef DEBUG
226   | isUnLiftedType ty = pprPanic "mkClosureLFInfo" (ppr bndr <+> ppr ty)
227 #endif
228   | otherwise
229   = LFThunk ty top (null fvs) (isUpdatable upd_flag) NonStandardThunk
230         srt_label srt
231   where
232     ty = idType bndr
233 \end{code}
234
235 @mkConLFInfo@ is similar, for constructors.
236
237 \begin{code}
238 mkConLFInfo :: DataCon -> LambdaFormInfo
239
240 mkConLFInfo con
241   = -- the isNullaryDataCon will do this: ASSERT(isDataCon con)
242     (if isBoxedTupleTyCon (dataConTyCon con) then LFTuple else LFCon) 
243         con (isNullaryDataCon con)
244
245 mkSelectorLFInfo rhs_ty offset updatable
246   = LFThunk rhs_ty NotTopLevel False updatable (SelectorThunk offset)
247         (error "mkSelectorLFInfo: no srt label")
248         (error "mkSelectorLFInfo: no srt")
249
250 mkApLFInfo rhs_ty upd_flag arity
251   = LFThunk rhs_ty NotTopLevel (arity == 0) (isUpdatable upd_flag) 
252         (ApThunk arity)
253         (error "mkApLFInfo: no srt label")
254         (error "mkApLFInfo: no srt")
255 \end{code}
256
257 Miscellaneous LF-infos.
258
259 \begin{code}
260 mkLFArgument    = LFArgument
261 mkLFLetNoEscape = LFLetNoEscape
262
263 mkLFImported :: Id -> LambdaFormInfo
264 mkLFImported id
265   = case idArityInfo id of
266       ArityExactly 0    -> LFThunk (idType id)
267                                 TopLevel True{-no fvs-}
268                                 True{-updatable-} NonStandardThunk
269                                 (error "mkLFImported: no srt label") 
270                                 (error "mkLFImported: no srt")
271       ArityExactly n    -> LFReEntrant (idType id) TopLevel n True  -- n > 0
272                                 (error "mkLFImported: no srt label") 
273                                 (error "mkLFImported: no srt")
274       other             -> LFImported   -- Not sure of exact arity
275 \end{code}
276
277 %************************************************************************
278 %*                                                                      *
279 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
280 %*                                                                      *
281 %************************************************************************
282
283 \begin{code}
284 closureSize :: ClosureInfo -> HeapOffset
285 closureSize cl_info@(MkClosureInfo _ _ sm_rep)
286   = fixedHdrSize + closureNonHdrSize cl_info
287
288 closureNonHdrSize :: ClosureInfo -> Int
289 closureNonHdrSize cl_info@(MkClosureInfo _ lf_info sm_rep)
290   = tot_wds + computeSlopSize tot_wds sm_rep (closureUpdReqd cl_info) 
291     --ToDo: pass lf_info?
292   where
293     tot_wds = closureGoodStuffSize cl_info
294
295 closureGoodStuffSize :: ClosureInfo -> Int
296 closureGoodStuffSize (MkClosureInfo _ _ sm_rep)
297   = let (ptrs, nonptrs) = sizes_from_SMRep sm_rep
298     in  ptrs + nonptrs
299
300 closurePtrsSize :: ClosureInfo -> Int
301 closurePtrsSize (MkClosureInfo _ _ sm_rep)
302   = let (ptrs, _) = sizes_from_SMRep sm_rep
303     in  ptrs
304
305 -- not exported:
306 sizes_from_SMRep :: SMRep -> (Int,Int)
307 sizes_from_SMRep (GenericRep _ ptrs nonptrs _)   = (ptrs, nonptrs)
308 sizes_from_SMRep BlackHoleRep                    = (0, 0)
309 \end{code}
310
311 Computing slop size.  WARNING: this looks dodgy --- it has deep
312 knowledge of what the storage manager does with the various
313 representations...
314
315 Slop Requirements:
316 \begin{itemize}
317 \item
318 Updateable closures must be @mIN_UPD_SIZE@.
319         \begin{itemize}
320         \item
321         Indirections require 1 word
322         \item
323         Appels collector indirections 2 words
324         \end{itemize}
325 THEREFORE: @mIN_UPD_SIZE = 2@.
326
327 \item
328 Collectable closures which are allocated in the heap
329 must be @mIN_SIZE_NonUpdHeapObject@.
330
331 Copying collector forward pointer requires 1 word
332
333 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
334 \end{itemize}
335
336 Static closures have an extra ``static link field'' at the end, but we
337 don't bother taking that into account here.
338
339 \begin{code}
340 slopSize cl_info@(MkClosureInfo _ lf_info sm_rep)
341   = computeSlopSize (closureGoodStuffSize cl_info) sm_rep       
342          (closureUpdReqd cl_info)
343
344 computeSlopSize :: Int -> SMRep -> Bool -> Int
345
346 computeSlopSize tot_wds (GenericRep _ _ _ _) True               -- Updatable
347   = max 0 (mIN_UPD_SIZE - tot_wds)
348
349 computeSlopSize tot_wds (GenericRep True _ _ _) False   -- Non updatable
350   = 0                                                   -- Static
351
352 computeSlopSize tot_wds (GenericRep False _ _ _) False  -- Non updatable
353   = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds)         -- Dynamic
354
355 computeSlopSize tot_wds BlackHoleRep _                  -- Updatable
356   = max 0 (mIN_UPD_SIZE - tot_wds)
357 \end{code}
358
359 %************************************************************************
360 %*                                                                      *
361 \subsection[layOutDynClosure]{Lay out a dynamic closure}
362 %*                                                                      *
363 %************************************************************************
364
365 \begin{code}
366 layOutDynClosure, layOutStaticClosure
367         :: Name                     -- STG identifier of this closure
368         -> (a -> PrimRep)           -- how to get a PrimRep for the fields
369         -> [a]                      -- the "things" being layed out
370         -> LambdaFormInfo           -- what sort of closure it is
371         -> (ClosureInfo,            -- info about the closure
372             [(a, VirtualHeapOffset)])   -- things w/ offsets pinned on them
373
374 layOutDynClosure name kind_fn things lf_info
375   = (MkClosureInfo name lf_info sm_rep,
376      things_w_offsets)
377   where
378     (tot_wds,            -- #ptr_wds + #nonptr_wds
379      ptr_wds,            -- #ptr_wds
380      things_w_offsets) = mkVirtHeapOffsets kind_fn things
381     sm_rep = chooseDynSMRep lf_info tot_wds ptr_wds
382 \end{code}
383
384 A wrapper for when used with data constructors:
385
386 \begin{code}
387 layOutDynCon :: DataCon
388              -> (a -> PrimRep)
389              -> [a]
390              -> (ClosureInfo, [(a,VirtualHeapOffset)])
391
392 layOutDynCon con kind_fn args
393   = layOutDynClosure (dataConName con) kind_fn args (mkConLFInfo con)
394 \end{code}
395
396 %************************************************************************
397 %*                                                                      *
398 \subsection[layOutStaticClosure]{Lay out a static closure}
399 %*                                                                      *
400 %************************************************************************
401
402 layOutStaticClosure is only used for laying out static constructors at
403 the moment.  
404
405 Static closures for functions are laid out using
406 layOutStaticNoFVClosure.
407
408 \begin{code}
409 layOutStaticClosure name kind_fn things lf_info
410   = (MkClosureInfo name lf_info 
411         (GenericRep is_static ptr_wds (tot_wds - ptr_wds) closure_type),
412      things_w_offsets)
413   where
414     (tot_wds,            -- #ptr_wds + #nonptr_wds
415      ptr_wds,            -- #ptr_wds
416      things_w_offsets) = mkVirtHeapOffsets kind_fn things
417
418     -- constructors with no pointer fields will definitely be NOCAF things.
419     -- this is a compromise until we can generate both kinds of constructor
420     -- (a normal static kind and the NOCAF_STATIC kind).
421     closure_type = getClosureType is_static tot_wds ptr_wds lf_info
422     is_static    = True
423
424 layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo
425 layOutStaticNoFVClosure name lf_info
426   = MkClosureInfo name lf_info (GenericRep is_static 0 0 (getClosureType is_static 0 0 lf_info))
427   where
428     is_static = True
429 \end{code}
430
431 %************************************************************************
432 %*                                                                      *
433 \subsection[SMreps]{Choosing SM reps}
434 %*                                                                      *
435 %************************************************************************
436
437 \begin{code}
438 chooseDynSMRep
439         :: LambdaFormInfo
440         -> Int -> Int           -- Tot wds, ptr wds
441         -> SMRep
442
443 chooseDynSMRep lf_info tot_wds ptr_wds
444   = let
445          is_static    = False
446          nonptr_wds   = tot_wds - ptr_wds
447          closure_type = getClosureType is_static tot_wds ptr_wds lf_info
448     in
449     GenericRep is_static ptr_wds nonptr_wds closure_type        
450
451 -- we *do* get non-updatable top-level thunks sometimes.  eg. f = g
452 -- gets compiled to a jump to g (if g has non-zero arity), instead of
453 -- messing around with update frames and PAPs.  We set the closure type
454 -- to FUN_STATIC in this case.
455
456 getClosureType :: Bool -> Int -> Int -> LambdaFormInfo -> ClosureType
457 getClosureType is_static tot_wds ptr_wds lf_info
458   = case lf_info of
459         LFCon con zero_arity
460                 | is_static && ptr_wds == 0            -> CONSTR_NOCAF
461                 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
462                 | otherwise                            -> CONSTR
463
464         LFTuple _ zero_arity
465                 | is_static && ptr_wds == 0            -> CONSTR_NOCAF
466                 | specialised_rep mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n
467                 | otherwise                            -> CONSTR
468
469         LFReEntrant _ _ _ _ _ _
470                 | specialised_rep mAX_SPEC_FUN_SIZE -> FUN_p_n
471                 | otherwise                         -> FUN
472
473         LFThunk _ _ _ _ (SelectorThunk _) _ _ -> THUNK_SELECTOR
474
475         LFThunk _ _ _ _ _ _ _
476                 | specialised_rep mAX_SPEC_THUNK_SIZE -> THUNK_p_n
477                 | otherwise                           -> THUNK
478
479         _ -> panic "getClosureType"
480   where
481     specialised_rep max_size =  not is_static
482                              && tot_wds > 0
483                              && tot_wds <= max_size
484 \end{code}
485
486 %************************************************************************
487 %*                                                                      *
488 \subsection[mkVirtHeapOffsets]{Assigning heap offsets in a closure}
489 %*                                                                      *
490 %************************************************************************
491
492 @mkVirtHeapOffsets@ (the heap version) always returns boxed things with
493 smaller offsets than the unboxed things, and furthermore, the offsets in
494 the result list
495
496 \begin{code}
497 mkVirtHeapOffsets :: 
498           (a -> PrimRep)        -- To be able to grab kinds;
499                                 --      w/ a kind, we can find boxedness
500           -> [a]                -- Things to make offsets for
501           -> (Int,              -- *Total* number of words allocated
502               Int,              -- Number of words allocated for *pointers*
503               [(a, VirtualHeapOffset)])
504                                 -- Things with their offsets from start of 
505                                 --  object in order of increasing offset
506
507 -- First in list gets lowest offset, which is initial offset + 1.
508
509 mkVirtHeapOffsets kind_fun things
510   = let (ptrs, non_ptrs)              = separateByPtrFollowness kind_fun things
511         (wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
512         (tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
513     in
514         (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
515   where
516     computeOffset wds_so_far thing
517       = (wds_so_far + (getPrimRepSize . kind_fun) thing,
518          (thing, fixedHdrSize + wds_so_far)
519         )
520 \end{code}
521
522 %************************************************************************
523 %*                                                                      *
524 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
525 %*                                                                      *
526 %************************************************************************
527
528 Be sure to see the stg-details notes about these...
529
530 \begin{code}
531 nodeMustPointToIt :: LambdaFormInfo -> FCode Bool
532 nodeMustPointToIt lf_info
533
534   = case lf_info of
535         LFReEntrant ty top arity no_fvs _ _ -> returnFC (
536             not no_fvs ||   -- Certainly if it has fvs we need to point to it
537             isNotTopLevel top
538                     -- If it is not top level we will point to it
539                     --   We can have a \r closure with no_fvs which
540                     --   is not top level as special case cgRhsClosure
541                     --   has been dissabled in favour of let floating
542
543                 -- For lex_profiling we also access the cost centre for a
544                 -- non-inherited function i.e. not top level
545                 -- the  not top  case above ensures this is ok.
546             )
547
548         LFCon   _ zero_arity -> returnFC True
549         LFTuple _ zero_arity -> returnFC True
550
551         -- Strictly speaking, the above two don't need Node to point
552         -- to it if the arity = 0.  But this is a *really* unlikely
553         -- situation.  If we know it's nil (say) and we are entering
554         -- it. Eg: let x = [] in x then we will certainly have inlined
555         -- x, since nil is a simple atom.  So we gain little by not
556         -- having Node point to known zero-arity things.  On the other
557         -- hand, we do lose something; Patrick's code for figuring out
558         -- when something has been updated but not entered relies on
559         -- having Node point to the result of an update.  SLPJ
560         -- 27/11/92.
561
562         LFThunk _ _ no_fvs updatable NonStandardThunk _ _
563           -> returnFC (updatable || not no_fvs || opt_SccProfilingOn)
564
565           -- For the non-updatable (single-entry case):
566           --
567           -- True if has fvs (in which case we need access to them, and we
568           --                should black-hole it)
569           -- or profiling (in which case we need to recover the cost centre
570           --             from inside it)
571
572         LFThunk _ _ no_fvs updatable some_standard_form_thunk _ _
573           -> returnFC True
574           -- Node must point to any standard-form thunk.
575
576         LFArgument    -> returnFC True
577         LFImported    -> returnFC True
578         LFBlackHole _ -> returnFC True
579                     -- BH entry may require Node to point
580
581         LFLetNoEscape _ -> returnFC False
582 \end{code}
583
584 The entry conventions depend on the type of closure being entered,
585 whether or not it has free variables, and whether we're running
586 sequentially or in parallel.
587
588 \begin{tabular}{lllll}
589 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
590 Unknown                         & no & yes & stack      & node \\
591 Known fun ($\ge$ 1 arg), no fvs         & no & no  & registers  & fast entry (enough args) \\
592 \ & \ & \ & \                                           & slow entry (otherwise) \\
593 Known fun ($\ge$ 1 arg), fvs    & no & yes & registers  & fast entry (enough args) \\
594 0 arg, no fvs @\r,\s@           & no & no  & n/a        & direct entry \\
595 0 arg, no fvs @\u@              & no & yes & n/a        & node \\
596 0 arg, fvs @\r,\s@              & no & yes & n/a        & direct entry \\
597 0 arg, fvs @\u@                 & no & yes & n/a        & node \\
598
599 Unknown                         & yes & yes & stack     & node \\
600 Known fun ($\ge$ 1 arg), no fvs         & yes & no  & registers & fast entry (enough args) \\
601 \ & \ & \ & \                                           & slow entry (otherwise) \\
602 Known fun ($\ge$ 1 arg), fvs    & yes & yes & registers & node \\
603 0 arg, no fvs @\r,\s@           & yes & no  & n/a       & direct entry \\
604 0 arg, no fvs @\u@              & yes & yes & n/a       & node \\
605 0 arg, fvs @\r,\s@              & yes & yes & n/a       & node \\
606 0 arg, fvs @\u@                 & yes & yes & n/a       & node\\
607 \end{tabular}
608
609 When black-holing, single-entry closures could also be entered via node
610 (rather than directly) to catch double-entry.
611
612 \begin{code}
613 data EntryConvention
614   = ViaNode                             -- The "normal" convention
615
616   | StdEntry CLabel                     -- Jump to this code, with args on stack
617
618   | DirectEntry                         -- Jump directly, with args in regs
619         CLabel                          --   The code label
620         Int                             --   Its arity
621         [MagicId]                       --   Its register assignments 
622                                         --      (possibly empty)
623
624 getEntryConvention :: Name              -- Function being applied
625                    -> LambdaFormInfo    -- Its info
626                    -> [PrimRep]         -- Available arguments
627                    -> FCode EntryConvention
628
629 getEntryConvention name lf_info arg_kinds
630  =  nodeMustPointToIt lf_info   `thenFC` \ node_points ->
631     returnFC (
632
633     -- if we're parallel, then we must always enter via node.  The reason
634     -- is that the closure may have been fetched since we allocated it.
635
636     if (node_points && opt_Parallel) then ViaNode else
637
638     -- Commented out by SDM after futher thoughts:
639     --   - the only closure type that can be blackholed is a thunk
640     --   - we already enter thunks via node (unless the closure is
641     --     non-updatable, in which case why is it being re-entered...)
642
643     case lf_info of
644
645         LFReEntrant _ _ arity _ _ _ ->
646             if arity == 0 || (length arg_kinds) < arity then
647                 StdEntry (mkStdEntryLabel name)
648             else
649                 DirectEntry (mkFastEntryLabel name arity) arity arg_regs
650           where
651             (arg_regs, _) = assignRegs live_regs (take arity arg_kinds)
652             live_regs = if node_points then [node] else []
653
654         LFCon con True{-zero_arity-}
655               -- a real constructor.  Don't bother entering it, just jump
656               -- to the constructor entry code directly.
657                           -> --false:ASSERT (null arg_kinds)    
658                              -- Should have no args (meaning what?)
659                              StdEntry (mkStaticConEntryLabel (dataConName con))
660
661         LFCon con False{-non-zero_arity-}
662                           -> --false:ASSERT (null arg_kinds)    
663                              -- Should have no args (meaning what?)
664                              StdEntry (mkConEntryLabel (dataConName con))
665
666         LFTuple tup zero_arity
667                           -> --false:ASSERT (null arg_kinds)    
668                              -- Should have no args (meaning what?)
669                              StdEntry (mkConEntryLabel (dataConName tup))
670
671         LFThunk _ _ _ updatable std_form_info _ _
672           -> if updatable || opt_DoTickyProfiling  -- to catch double entry
673                 || opt_SMP  -- always enter via node on SMP, since the
674                             -- thunk might have been blackholed in the 
675                             -- meantime.
676              then ViaNode
677              else StdEntry (thunkEntryLabel name std_form_info updatable)
678
679         LFArgument    -> ViaNode
680         LFImported    -> ViaNode
681         LFBlackHole _ -> ViaNode -- Presumably the black hole has by now
682                                  -- been updated, but we don't know with
683                                  -- what, so we enter via Node
684
685         LFLetNoEscape 0
686           -> StdEntry (mkReturnPtLabel (nameUnique name))
687
688         LFLetNoEscape arity
689           -> if (arity /= length arg_kinds) then pprPanic "let-no-escape: " (ppr name <+> ppr arity) else
690              DirectEntry (mkReturnPtLabel (nameUnique name)) arity arg_regs
691          where
692             (arg_regs, _) = assignRegs [] arg_kinds
693             -- node never points to a LetNoEscape, see above --SDM
694             --live_regs     = if node_points then [node] else []
695     )
696
697 blackHoleOnEntry :: ClosureInfo -> Bool
698
699 -- Static closures are never themselves black-holed.
700 -- Updatable ones will be overwritten with a CAFList cell, which points to a 
701 -- black hole;
702 -- Single-entry ones have no fvs to plug, and we trust they don't form part 
703 -- of a loop.
704
705 blackHoleOnEntry (MkClosureInfo _ _ rep) 
706   | isStaticRep rep 
707   = False
708         -- Never black-hole a static closure
709
710 blackHoleOnEntry (MkClosureInfo _ lf_info _)
711   = case lf_info of
712         LFReEntrant _ _ _ _ _ _   -> False
713         LFLetNoEscape _           -> False
714         LFThunk _ _ no_fvs updatable _ _ _
715           -> if updatable
716              then not opt_OmitBlackHoling
717              else opt_DoTickyProfiling || not no_fvs
718                   -- the former to catch double entry,
719                   -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
720
721         other -> panic "blackHoleOnEntry"       -- Should never happen
722
723 isStandardFormThunk :: LambdaFormInfo -> Bool
724
725 isStandardFormThunk (LFThunk _ _ _ _ (SelectorThunk _) _ _) = True
726 isStandardFormThunk (LFThunk _ _ _ _ (ApThunk _) _ _)       = True
727 isStandardFormThunk other_lf_info                           = False
728
729 maybeSelectorInfo (MkClosureInfo _ (LFThunk _ _ _ _
730                         (SelectorThunk offset) _ _) _) = Just offset
731 maybeSelectorInfo _ = Nothing
732 \end{code}
733
734 -----------------------------------------------------------------------------
735 SRT-related stuff
736
737
738 \begin{code}
739 infoTblNeedsSRT :: ClosureInfo -> Bool
740 infoTblNeedsSRT (MkClosureInfo _ info _) =
741   case info of
742     LFThunk _ _ _ _ _ _ NoSRT   -> False
743     LFThunk _ _ _ _ _ _ _       -> True
744
745     LFReEntrant _ _ _ _ _ NoSRT -> False
746     LFReEntrant _ _ _ _ _ _     -> True
747
748     _ -> False
749
750 staticClosureNeedsLink :: ClosureInfo -> Bool
751 staticClosureNeedsLink (MkClosureInfo _ info _) =
752   case info of
753     LFThunk _ _ _ _ _ _ NoSRT   -> False
754     LFReEntrant _ _ _ _ _ NoSRT -> False
755     LFCon _ True                -> False -- zero arity constructors
756     _ -> True
757
758 getSRTInfo :: ClosureInfo -> (CLabel, SRT)
759 getSRTInfo  (MkClosureInfo _ info _) =
760   case info of
761     LFThunk _ _ _ _ _ lbl srt   -> (lbl,srt)
762     LFReEntrant _ _ _ _ lbl srt -> (lbl,srt)
763     _ -> panic "getSRTInfo"
764 \end{code}
765
766 Avoiding generating entries and info tables
767 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
768 At present, for every function we generate all of the following,
769 just in case.  But they aren't always all needed, as noted below:
770
771 [NB1: all of this applies only to *functions*.  Thunks always
772 have closure, info table, and entry code.]
773
774 [NB2: All are needed if the function is *exported*, just to play safe.]
775
776
777 * Fast-entry code  ALWAYS NEEDED
778
779 * Slow-entry code
780         Needed iff (a) we have any un-saturated calls to the function
781         OR         (b) the function is passed as an arg
782         OR         (c) we're in the parallel world and the function has free vars
783                         [Reason: in parallel world, we always enter functions
784                         with free vars via the closure.]
785
786 * The function closure
787         Needed iff (a) we have any un-saturated calls to the function
788         OR         (b) the function is passed as an arg
789         OR         (c) if the function has free vars (ie not top level)
790
791   Why case (a) here?  Because if the arg-satis check fails,
792   UpdatePAP stuffs a pointer to the function closure in the PAP.
793   [Could be changed; UpdatePAP could stuff in a code ptr instead,
794    but doesn't seem worth it.]
795
796   [NB: these conditions imply that we might need the closure
797   without the slow-entry code.  Here's how.
798
799         f x y = let g w = ...x..y..w...
800                 in
801                 ...(g t)...
802
803   Here we need a closure for g which contains x and y,
804   but since the calls are all saturated we just jump to the
805   fast entry point for g, with R1 pointing to the closure for g.]
806
807
808 * Standard info table
809         Needed iff (a) we have any un-saturated calls to the function
810         OR         (b) the function is passed as an arg
811         OR         (c) the function has free vars (ie not top level)
812
813         NB.  In the sequential world, (c) is only required so that the function closure has
814         an info table to point to, to keep the storage manager happy.
815         If (c) alone is true we could fake up an info table by choosing
816         one of a standard family of info tables, whose entry code just
817         bombs out.
818
819         [NB In the parallel world (c) is needed regardless because
820         we enter functions with free vars via the closure.]
821
822         If (c) is retained, then we'll sometimes generate an info table
823         (for storage mgr purposes) without slow-entry code.  Then we need
824         to use an error label in the info table to substitute for the absent
825         slow entry code.
826
827 \begin{code}
828 staticClosureRequired
829         :: Name
830         -> StgBinderInfo
831         -> LambdaFormInfo
832         -> Bool
833 staticClosureRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _)
834                       (LFReEntrant _ top_level _ _ _ _) -- It's a function
835   = ASSERT( isTopLevel top_level )
836         -- Assumption: it's a top-level, no-free-var binding
837     arg_occ             -- There's an argument occurrence
838     || unsat_occ        -- There's an unsaturated call
839     || isExternallyVisibleName binder
840
841 staticClosureRequired binder other_binder_info other_lf_info = True
842
843 slowFunEntryCodeRequired        -- Assumption: it's a function, not a thunk.
844         :: Name
845         -> StgBinderInfo
846         -> EntryConvention
847         -> Bool
848 slowFunEntryCodeRequired binder (StgBinderInfo arg_occ unsat_occ _ _ _) entry_conv
849   = arg_occ             -- There's an argument occurrence
850     || unsat_occ        -- There's an unsaturated call
851     || isExternallyVisibleName binder
852     || (case entry_conv of { DirectEntry _ _ _ -> False; other -> True })
853             {- The last case deals with the parallel world; a function usually
854                as a DirectEntry convention, but if it doesn't we must generate slow-entry code -}
855
856 slowFunEntryCodeRequired binder NoStgBinderInfo _ = True
857
858 funInfoTableRequired
859         :: Name
860         -> StgBinderInfo
861         -> LambdaFormInfo
862         -> Bool
863 funInfoTableRequired  binder (StgBinderInfo arg_occ unsat_occ _ _ _)
864                      (LFReEntrant _ top_level _ _ _ _)
865   =    isNotTopLevel top_level
866     || arg_occ          -- There's an argument occurrence
867     || unsat_occ        -- There's an unsaturated call
868     || isExternallyVisibleName binder
869
870 funInfoTableRequired other_binder_info binder other_lf_info = True
871 \end{code}
872
873 %************************************************************************
874 %*                                                                      *
875 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
876 %*                                                                      *
877 %************************************************************************
878
879 \begin{code}
880
881 isStaticClosure :: ClosureInfo -> Bool
882 isStaticClosure  (MkClosureInfo _ _ rep) = isStaticRep  rep
883
884 closureName :: ClosureInfo -> Name
885 closureName (MkClosureInfo name _ _) = name
886
887 closureSMRep :: ClosureInfo -> SMRep
888 closureSMRep (MkClosureInfo _ _ sm_rep) = sm_rep
889
890 closureLFInfo :: ClosureInfo -> LambdaFormInfo
891 closureLFInfo (MkClosureInfo _ lf_info _) = lf_info
892
893 closureUpdReqd :: ClosureInfo -> Bool
894 closureUpdReqd (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = upd
895 closureUpdReqd (MkClosureInfo _ (LFBlackHole _) _)           = True
896         -- Black-hole closures are allocated to receive the results of an
897         -- alg case with a named default... so they need to be updated.
898 closureUpdReqd other_closure                           = False
899
900 closureSingleEntry :: ClosureInfo -> Bool
901 closureSingleEntry (MkClosureInfo _ (LFThunk _ _ _ upd _ _ _) _) = not upd
902 closureSingleEntry other_closure                           = False
903
904 closureReEntrant :: ClosureInfo -> Bool
905 closureReEntrant (MkClosureInfo _ (LFReEntrant _ _ _ _ _ _) _) = True
906 closureReEntrant other_closure = False
907 \end{code}
908
909 \begin{code}
910 closureSemiTag :: ClosureInfo -> Maybe Int
911 closureSemiTag (MkClosureInfo _ lf_info _)
912   = case lf_info of
913       LFCon data_con _ -> Just (dataConTag data_con - fIRST_TAG)
914       LFTuple _ _      -> Just 0
915       _                -> Nothing
916 \end{code}
917
918 \begin{code}
919 isToplevClosure :: ClosureInfo -> Bool
920
921 isToplevClosure (MkClosureInfo _ lf_info _)
922   = case lf_info of
923       LFReEntrant _ TopLevel _ _ _ _ -> True
924       LFThunk _ TopLevel _ _ _ _ _   -> True
925       other -> False
926 \end{code}
927
928 \begin{code}
929 isLetNoEscape :: ClosureInfo -> Bool
930
931 isLetNoEscape (MkClosureInfo _ (LFLetNoEscape _) _) = True
932 isLetNoEscape _ = False
933 \end{code}
934
935 Label generation.
936
937 \begin{code}
938 fastLabelFromCI :: ClosureInfo -> CLabel
939 fastLabelFromCI (MkClosureInfo name (LFReEntrant _ _ arity _ _ _) _)
940   = mkFastEntryLabel name arity
941
942 fastLabelFromCI (MkClosureInfo name _ _)
943   = pprPanic "fastLabelFromCI" (ppr name)
944
945 infoTableLabelFromCI :: ClosureInfo -> CLabel
946 infoTableLabelFromCI (MkClosureInfo id lf_info rep)
947   = case lf_info of
948         LFCon con _      -> mkConInfoPtr con rep
949         LFTuple tup _    -> mkConInfoPtr tup rep
950
951         LFBlackHole info -> info
952
953         LFThunk _ _ _ upd_flag (SelectorThunk offset) _ _ -> 
954                 mkSelectorInfoLabel upd_flag offset
955
956         LFThunk _ _ _ upd_flag (ApThunk arity) _ _ -> 
957                 mkApInfoTableLabel upd_flag arity
958
959         other -> {-NO: if isStaticRep rep
960                  then mkStaticInfoTableLabel id
961                  else -} mkInfoTableLabel id
962
963 mkConInfoPtr :: DataCon -> SMRep -> CLabel
964 mkConInfoPtr con rep
965   | isStaticRep rep = mkStaticInfoTableLabel  name
966   | otherwise       = mkConInfoTableLabel     name
967   where
968     name = dataConName con
969
970 mkConEntryPtr :: DataCon -> SMRep -> CLabel
971 mkConEntryPtr con rep
972   | isStaticRep rep = mkStaticConEntryLabel (dataConName con)
973   | otherwise       = mkConEntryLabel       (dataConName con)
974
975 closureLabelFromCI (MkClosureInfo id _ other_rep)   = mkClosureLabel id
976
977 entryLabelFromCI :: ClosureInfo -> CLabel
978 entryLabelFromCI (MkClosureInfo id lf_info rep)
979   = case lf_info of
980         LFThunk _ _ _ upd_flag std_form_info _ _ -> thunkEntryLabel id std_form_info upd_flag
981         LFCon con _                          -> mkConEntryPtr con rep
982         LFTuple tup _                        -> mkConEntryPtr tup rep
983         other                                -> mkStdEntryLabel id
984
985 -- thunkEntryLabel is a local help function, not exported.  It's used from both
986 -- entryLabelFromCI and getEntryConvention.
987
988 thunkEntryLabel thunk_id (ApThunk arity) is_updatable
989   = mkApEntryLabel is_updatable arity
990 thunkEntryLabel thunk_id (SelectorThunk offset) upd_flag
991   = mkSelectorEntryLabel upd_flag offset
992 thunkEntryLabel thunk_id _ is_updatable
993   = mkStdEntryLabel thunk_id
994 \end{code}
995
996 \begin{code}
997 allocProfilingMsg :: ClosureInfo -> FAST_STRING
998
999 allocProfilingMsg (MkClosureInfo _ lf_info _)
1000   = case lf_info of
1001       LFReEntrant _ _ _ _ _ _   -> SLIT("TICK_ALLOC_FUN")
1002       LFCon _ _                 -> SLIT("TICK_ALLOC_CON")
1003       LFTuple _ _               -> SLIT("TICK_ALLOC_CON")
1004       LFThunk _ _ _ True _ _ _  -> SLIT("TICK_ALLOC_UP_THK")  -- updatable
1005       LFThunk _ _ _ False _ _ _ -> SLIT("TICK_ALLOC_SE_THK")  -- nonupdatable
1006       LFBlackHole _             -> SLIT("TICK_ALLOC_BH")
1007       LFImported                -> panic "TICK_ALLOC_IMP"
1008 \end{code}
1009
1010 We need a black-hole closure info to pass to @allocDynClosure@ when we
1011 want to allocate the black hole on entry to a CAF.  These are the only
1012 ways to build an LFBlackHole, maintaining the invariant that it really
1013 is a black hole and not something else.
1014
1015 \begin{code}
1016 cafBlackHoleClosureInfo (MkClosureInfo name _ _)
1017   = MkClosureInfo name (LFBlackHole mkCAFBlackHoleInfoTableLabel) BlackHoleRep
1018
1019 seCafBlackHoleClosureInfo (MkClosureInfo name _ _)
1020   = MkClosureInfo name (LFBlackHole mkSECAFBlackHoleInfoTableLabel) BlackHoleRep
1021 \end{code}
1022
1023 %************************************************************************
1024 %*                                                                      *
1025 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
1026 %*                                                                      *
1027 %************************************************************************
1028
1029 Profiling requires two pieces of information to be determined for
1030 each closure's info table --- description and type.
1031
1032 The description is stored directly in the @CClosureInfoTable@ when the
1033 info table is built.
1034
1035 The type is determined from the type information stored with the @Id@
1036 in the closure info using @closureTypeDescr@.
1037
1038 \begin{code}
1039 closureTypeDescr :: ClosureInfo -> String
1040 closureTypeDescr (MkClosureInfo name (LFThunk ty _ _ _ _ _ _) _)
1041   = getTyDescription ty
1042 closureTypeDescr (MkClosureInfo name (LFReEntrant ty _ _ _ _ _) _)
1043   = getTyDescription ty
1044 closureTypeDescr (MkClosureInfo name (LFCon data_con _) _)
1045   = occNameUserString (getOccName (dataConTyCon data_con))
1046 closureTypeDescr (MkClosureInfo name lf _)
1047   = showSDoc (ppr name)
1048 \end{code}
1049