ClosureInfo.lhs 36.3 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The Univserity of Glasgow 1992-2004
4
%
5
6
7
8
9

	Data structures which describe closures, and
	operations over those data structures

		Nothing monadic in here
10
11
12
13
14

Much of the rationale for these things is in the ``details'' part of
the STG paper.

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
15
16
17
18
19
20
21
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

22
module ClosureInfo (
23
24
25
	ClosureInfo(..), LambdaFormInfo(..),	-- would be abstract but
	StandardFormInfo(..),			-- mkCmmInfo looks inside
        SMRep,
26

27
	ArgDescr(..), Liveness, 
28
	C_SRT(..), needsSRT,
29

30
	mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
31
	mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
32

Simon Marlow's avatar
Simon Marlow committed
33
	mkClosureInfo, mkConInfo, maybeIsLFCon,
34
        closureSize,
35

36
	ConTagZ, dataConTagZ,
37

38
	infoTableLabelFromCI, entryLabelFromCI,
39
	closureLabelFromCI,
Ian Lynagh's avatar
Ian Lynagh committed
40
	isLFThunk, closureUpdReqd,
41
	closureNeedsUpdSpace, closureIsThunk,
42
	closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
43
        closureFunInfo, isKnownFun,
44
        funTag, funTagLFInfo, tagForArity, clHasCafRefs,
45

Simon Marlow's avatar
Simon Marlow committed
46
        enterIdLabel, enterReturnPtLabel,
47
48
49

	nodeMustPointToIt, 
	CallMethod(..), getCallMethod,
sof's avatar
sof committed
50

sof's avatar
sof committed
51
	blackHoleOnEntry,
52

53
	staticClosureRequired,
54

55
	isToplevClosure,
56
	closureValDescr, closureTypeDescr,	-- profiling
57

58
	isStaticClosure,
59
	cafBlackHoleClosureInfo,
60
61

	staticClosureNeedsLink,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
62
63
64
65
66
67
68
69
70
71
72

	-- CgRep and its functions
	CgRep(..), nonVoidArg,
	argMachRep, primRepToCgRep, 
	isFollowableArg, isVoidArg, 
	isFloatingArg, is64BitArg,
	separateByPtrFollowness,
	cgRepSizeW, cgRepSizeB,
	retAddrSizeW,
	typeCgRep, idCgRep, tyConCgRep, 

73
74
    ) where

75
#include "../includes/MachDeps.h"
76
#include "HsVersions.h"
77

78
import StgSyn
Simon Marlow's avatar
Simon Marlow committed
79
import SMRep
80

81
import CLabel
82
import Cmm
Ian Lynagh's avatar
Ian Lynagh committed
83
import Unique
Simon Marlow's avatar
Simon Marlow committed
84
import StaticFlags
Ian Lynagh's avatar
Ian Lynagh committed
85
import Var
Simon Marlow's avatar
Simon Marlow committed
86
import Id
87
import IdInfo
Simon Marlow's avatar
Simon Marlow committed
88
89
90
91
92
93
94
import DataCon
import Name
import Type
import TypeRep
import TcType
import TyCon
import BasicTypes
95
import Outputable
Simon Peyton Jones's avatar
Simon Peyton Jones committed
96
import FastString
97
import Constants
98
import DynFlags
99
100
\end{code}

101

102
103
104
105
106
107
%************************************************************************
%*									*
\subsection[ClosureInfo-datatypes]{Data types for closure information}
%*									*
%************************************************************************

108
109
110
111
112
113
114
115
116
117
118
119
Information about a closure, from the code generator's point of view.

A ClosureInfo decribes the info pointer of a closure.  It has
enough information 
  a) to construct the info table itself
  b) to allocate a closure containing that info pointer (i.e.
	it knows the info table label)

We make a ClosureInfo for
	- each let binding (both top level and not)
	- each data constructor (for its shared static and
		dynamic info tables)
120
121
122

\begin{code}
data ClosureInfo
123
124
125
126
127
  = ClosureInfo {
	closureName   :: !Name,		  -- The thing bound to this closure
	closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
	closureSMRep  :: !SMRep,	  -- representation used by storage mgr
	closureSRT    :: !C_SRT,	  -- What SRT applies to this closure
128
        closureType   :: !Type,           -- Type of closure (ToDo: remove)
129
130
	closureDescr  :: !String,	  -- closure description (for profiling)
	closureInfLcl :: Bool             -- can the info pointer be a local symbol?
131
132
    }

133
  -- Constructor closures don't have a unique info table label (they use
134
135
136
  -- the constructor's info table), and they don't have an SRT.
  | ConInfo {
	closureCon       :: !DataCon,
137
	closureSMRep     :: !SMRep
138
139
140
    }
\end{code}

141
142
143
144
145
146
%************************************************************************
%*									*
\subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
%*									*
%************************************************************************

147
148
149
150
151
152
153
154
Information about an identifier, from the code generator's point of
view.  Every identifier is bound to a LambdaFormInfo in the
environment, which gives the code generator enough info to be able to
tail call or return that identifier.

Note that a closure is usually bound to an identifier, so a
ClosureInfo contains a LambdaFormInfo.

155
156
\begin{code}
data LambdaFormInfo
157
  = LFReEntrant		-- Reentrant closure (a function)
158
	TopLevelFlag	-- True if top level
159
	!Int		-- Arity. Invariant: always > 0
160
	!Bool		-- True <=> no fvs
161
	ArgDescr	-- Argument descriptor (should reall be in ClosureInfo)
162

163
  | LFCon		-- A saturated constructor application
164
	DataCon		-- The constructor
165

166
  | LFThunk		-- Thunk (zero arity)
167
168
	TopLevelFlag
	!Bool		-- True <=> no free vars
169
	!Bool		-- True <=> updatable (i.e., *not* single-entry)
170
	StandardFormInfo
171
	!Bool		-- True <=> *might* be a function type
172

173
174
175
  | LFUnknown		-- Used for function arguments and imported things.
			--  We know nothing about  this closure.  Treat like
			-- updatable "LFThunk"...
176
177
178
			-- Imported things which we do know something about use
			-- one of the other LF constructors (eg LFReEntrant for
			-- known functions)
179
	!Bool		-- True <=> *might* be a function type
180
181
182

  | LFLetNoEscape	-- See LetNoEscape module for precise description of
			-- these "lets".
183
	!Int		-- arity;
184
185
186
187
188
189

  | LFBlackHole		-- Used for the closures allocated to hold the result
			-- of a CAF.  We want the target of the update frame to
			-- be in the heap, so we make a black hole to hold it.


190

191
192
193
-------------------------
-- StandardFormInfo tells whether this thunk has one of 
-- a small number of standard forms
194

195
196
197
data StandardFormInfo
  = NonStandardThunk
	-- Not of of the standard forms
198

199
200
201
202
203
204
205
206
  | SelectorThunk
	-- A SelectorThunk is of form
	--      case x of
	--	       con a1,..,an -> ak
	-- and the constructor is from a single-constr type.
       WordOff             	-- 0-origin offset of ak within the "goods" of 
			-- constructor (Recall that the a1,...,an may be laid
			-- out in the heap in a non-obvious order.)
207

208
209
210
211
212
213
214
  | ApThunk 
	-- An ApThunk is of form
	--	x1 ... xn
	-- The code for the thunk just pushes x2..xn on the stack and enters x1.
	-- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
	-- in the RTS to save space.
	Int		-- Arity, n
215
216
\end{code}

Simon Peyton Jones's avatar
Simon Peyton Jones committed
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358

%************************************************************************
%*									*
			CgRep
%*									*
%************************************************************************

An CgRep is an abstraction of a Type which tells the code generator
all it needs to know about the calling convention for arguments (and
results) of that type.  In particular, the ArgReps of a function's
arguments are used to decide which of the RTS's generic apply
functions to call when applying an unknown function.

It contains more information than the back-end data type MachRep,
so one can easily convert from CgRep -> MachRep.  (Except that
there's no MachRep for a VoidRep.)

It distinguishes 
	pointers from non-pointers (we sort the pointers together
	when building closures)

	void from other types: a void argument is different from no argument

All 64-bit types map to the same CgRep, because they're passed in the
same register, but a PtrArg is still different from an NonPtrArg
because the function's entry convention has to take into account the
pointer-hood of arguments for the purposes of describing the stack on
entry to the garbage collector.

\begin{code}
data CgRep 
  = VoidArg 	-- Void
  | PtrArg 	-- Word-sized heap pointer, followed
		-- by the garbage collector
  | NonPtrArg 	-- Word-sized non-pointer
		-- (including addresses not followed by GC)
  | LongArg	-- 64-bit non-pointer
  | FloatArg 	-- 32-bit float
  | DoubleArg 	-- 64-bit float
  deriving Eq

instance Outputable CgRep where
    ppr VoidArg   = ptext (sLit "V_")
    ppr PtrArg    = ptext (sLit "P_")
    ppr NonPtrArg = ptext (sLit "I_")
    ppr LongArg   = ptext (sLit "L_")
    ppr FloatArg  = ptext (sLit "F_")
    ppr DoubleArg = ptext (sLit "D_")

argMachRep :: CgRep -> CmmType
argMachRep PtrArg    = gcWord
argMachRep NonPtrArg = bWord
argMachRep LongArg   = b64
argMachRep FloatArg  = f32
argMachRep DoubleArg = f64
argMachRep VoidArg   = panic "argMachRep:VoidRep"

primRepToCgRep :: PrimRep -> CgRep
primRepToCgRep VoidRep    = VoidArg
primRepToCgRep PtrRep     = PtrArg
primRepToCgRep IntRep	  = NonPtrArg
primRepToCgRep WordRep	  = NonPtrArg
primRepToCgRep Int64Rep   = LongArg
primRepToCgRep Word64Rep  = LongArg
primRepToCgRep AddrRep    = NonPtrArg
primRepToCgRep FloatRep   = FloatArg
primRepToCgRep DoubleRep  = DoubleArg

idCgRep :: Id -> CgRep
idCgRep x = typeCgRep . idType $ x

tyConCgRep :: TyCon -> CgRep
tyConCgRep = primRepToCgRep . tyConPrimRep

typeCgRep :: Type -> CgRep
typeCgRep = primRepToCgRep . typePrimRep 
\end{code}

Whether or not the thing is a pointer that the garbage-collector
should follow. Or, to put it another (less confusing) way, whether
the object in question is a heap object. 

Depending on the outcome, this predicate determines what stack
the pointer/object possibly will have to be saved onto, and the
computation of GC liveness info.

\begin{code}
isFollowableArg :: CgRep -> Bool  -- True <=> points to a heap object
isFollowableArg PtrArg  = True
isFollowableArg _       = False

isVoidArg :: CgRep -> Bool
isVoidArg VoidArg = True
isVoidArg _       = False

nonVoidArg :: CgRep -> Bool
nonVoidArg VoidArg = False
nonVoidArg _       = True

-- isFloatingArg is used to distinguish @Double@ and @Float@ which
-- cause inadvertent numeric conversions if you aren't jolly careful.
-- See codeGen/CgCon:cgTopRhsCon.

isFloatingArg :: CgRep -> Bool
isFloatingArg DoubleArg = True
isFloatingArg FloatArg  = True
isFloatingArg _         = False

is64BitArg :: CgRep -> Bool
is64BitArg LongArg = True
is64BitArg _       = False
\end{code}

\begin{code}
separateByPtrFollowness :: [(CgRep,a)] -> ([(CgRep,a)], [(CgRep,a)])
-- Returns (ptrs, non-ptrs)
separateByPtrFollowness things
  = sep_things things [] []
    -- accumulating params for follow-able and don't-follow things...
  where
    sep_things []    	       bs us = (reverse bs, reverse us)
    sep_things ((PtrArg,a):ts) bs us = sep_things ts ((PtrArg,a):bs) us
    sep_things (t         :ts) bs us = sep_things ts bs		     (t:us)
\end{code}

\begin{code}
cgRepSizeB :: CgRep -> ByteOff
cgRepSizeB DoubleArg = dOUBLE_SIZE
cgRepSizeB LongArg   = wORD64_SIZE
cgRepSizeB VoidArg   = 0
cgRepSizeB _         = wORD_SIZE

cgRepSizeW :: CgRep -> ByteOff
cgRepSizeW DoubleArg = dOUBLE_SIZE `quot` wORD_SIZE
cgRepSizeW LongArg   = wORD64_SIZE `quot` wORD_SIZE
cgRepSizeW VoidArg   = 0
cgRepSizeW _         = 1

retAddrSizeW :: WordOff
retAddrSizeW = 1	-- One word
\end{code}

359
360
361
362
363
364
365
%************************************************************************
%*									*
\subsection[ClosureInfo-construction]{Functions which build LFInfos}
%*									*
%************************************************************************

\begin{code}
366
367
368
369
370
371
372
373
374
mkLFReEntrant :: TopLevelFlag	-- True of top level
	      -> [Id]		-- Free vars
	      -> [Id] 		-- Args
	      -> ArgDescr	-- Argument descriptor
	      -> LambdaFormInfo

mkLFReEntrant top fvs args arg_descr 
  = LFReEntrant top (length args) (null fvs) arg_descr

Ian Lynagh's avatar
Ian Lynagh committed
375
mkLFThunk :: Type -> TopLevelFlag -> [Var] -> UpdateFlag -> LambdaFormInfo
376
mkLFThunk thunk_ty top fvs upd_flag
377
  = ASSERT2( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty), ppr thunk_ty $$ ppr fvs )
378
379
380
381
    LFThunk top (null fvs) 
	    (isUpdatable upd_flag)
	    NonStandardThunk 
	    (might_be_a_function thunk_ty)
382
383

might_be_a_function :: Type -> Bool
384
385
-- Return False only if we are *sure* it's a data type
-- Look through newtypes etc as much as poss
386
might_be_a_function ty
387
388
389
  = case tyConAppTyCon_maybe (repType ty) of
	Just tc -> not (isDataTyCon tc)
	Nothing -> True
390
391
392
393
394
395
\end{code}

@mkConLFInfo@ is similar, for constructors.

\begin{code}
mkConLFInfo :: DataCon -> LambdaFormInfo
396
mkConLFInfo con = LFCon con
397

Simon Marlow's avatar
Simon Marlow committed
398
399
400
401
maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon
maybeIsLFCon (LFCon con) = Just con
maybeIsLFCon _ = Nothing

Ian Lynagh's avatar
Ian Lynagh committed
402
mkSelectorLFInfo :: Id -> WordOff -> Bool -> LambdaFormInfo
403
404
405
mkSelectorLFInfo id offset updatable
  = LFThunk NotTopLevel False updatable (SelectorThunk offset) 
	(might_be_a_function (idType id))
406

Ian Lynagh's avatar
Ian Lynagh committed
407
mkApLFInfo :: Id -> UpdateFlag -> Int -> LambdaFormInfo
408
409
410
mkApLFInfo id upd_flag arity
  = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
	(might_be_a_function (idType id))
411
412
\end{code}

413
414
415
Miscellaneous LF-infos.

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
416
mkLFArgument :: Id -> LambdaFormInfo
417
418
mkLFArgument id = LFUnknown (might_be_a_function (idType id))

Ian Lynagh's avatar
Ian Lynagh committed
419
mkLFLetNoEscape :: Int -> LambdaFormInfo
420
421
422
423
mkLFLetNoEscape = LFLetNoEscape

mkLFImported :: Id -> LambdaFormInfo
mkLFImported id
424
  = case idArity id of
425
      n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr")  -- n > 0
Ian Lynagh's avatar
Ian Lynagh committed
426
      _ -> mkLFArgument id -- Not sure of exact arity
427
\end{code}
428

429
430
431
\begin{code}
isLFThunk :: LambdaFormInfo -> Bool
isLFThunk (LFThunk _ _ _ _ _)  = True
432
isLFThunk LFBlackHole          = True
433
434
435
436
437
438
	-- return True for a blackhole: this function is used to determine
	-- whether to use the thunk header in SMP mode, and a blackhole
	-- must have one.
isLFThunk _ = False
\end{code}

439
440
441
442
443
444
445
446
447
448
\begin{code}
-- We keep the *zero-indexed* tag in the srt_len field of the info
-- table of a data constructor.
type ConTagZ = Int	-- A *zero-indexed* contructor tag

dataConTagZ :: DataCon -> ConTagZ
dataConTagZ con = dataConTag con - fIRST_TAG
\end{code}


449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
%************************************************************************
%*									*
	Building ClosureInfos
%*									*
%************************************************************************

\begin{code}
mkClosureInfo :: Bool		-- Is static
	      -> Id
	      -> LambdaFormInfo 
	      -> Int -> Int	-- Total and pointer words
	      -> C_SRT
	      -> String		-- String descriptor
	      -> ClosureInfo
mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
  = ClosureInfo { closureName = name, 
		  closureLFInfo = lf_info,
		  closureSMRep = sm_rep, 
		  closureSRT = srt_info,
		  closureType = idType id,
469
470
471
472
473
474
		  closureDescr = descr,
		  closureInfLcl = isDataConWorkId id }
		    -- Make the _info pointer for the implicit datacon worker binding
		    -- local. The reason we can do this is that importing code always
		    -- either uses the _closure or _con_info. By the invariants in CorePrep
		    -- anything else gets eta expanded.
475
476
  where
    name   = idName id
477
478
    sm_rep = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
    nonptr_wds = tot_wds - ptr_wds
479

480
mkConInfo :: Bool	-- Is static
481
482
483
	  -> DataCon	
	  -> Int -> Int	-- Total and pointer words
	  -> ClosureInfo
484
mkConInfo is_static data_con tot_wds ptr_wds
485
   = ConInfo {	closureSMRep = sm_rep,
486
		closureCon = data_con }
487
  where
488
489
490
    sm_rep  = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
    lf_info = mkConLFInfo data_con
    nonptr_wds = tot_wds - ptr_wds
491
492
\end{code}

493
494
495
496
497
498
499
%************************************************************************
%*									*
\subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
%*									*
%************************************************************************

\begin{code}
500
closureSize :: ClosureInfo -> WordOff
501
closureSize cl_info = heapClosureSize (closureSMRep cl_info)
502
503
504
\end{code}

\begin{code}
505
506
507
508
-- we leave space for an update if either (a) the closure is updatable
-- or (b) it is a static thunk.  This is because a static thunk needs
-- a static link field in a predictable place (after the slop), regardless
-- of whether it is updatable or not.
Ian Lynagh's avatar
Ian Lynagh committed
509
closureNeedsUpdSpace :: ClosureInfo -> Bool
510
511
512
closureNeedsUpdSpace (ClosureInfo { closureLFInfo = 
					LFThunk TopLevel _ _ _ _ }) = True
closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
513
514
515
516
517
518
519
520
521
\end{code}

%************************************************************************
%*									*
\subsection[SMreps]{Choosing SM reps}
%*									*
%************************************************************************

\begin{code}
522
523
524
525
526
527
lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
lfClosureType (LFReEntrant _ arity _ argd) = Fun (fromIntegral arity) argd
lfClosureType (LFCon con)                  = Constr (fromIntegral (dataConTagZ con))
                                                    (dataConIdentity con)
lfClosureType (LFThunk _ _ _ is_sel _) 	   = thunkClosureType is_sel
lfClosureType _                 	   = panic "lfClosureType"
528

529
530
531
thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
thunkClosureType (SelectorThunk off) = ThunkSelector (fromIntegral off)
thunkClosureType _                   = Thunk
532

533
-- We *do* get non-updatable top-level thunks sometimes.  eg. f = g
534
535
536
-- gets compiled to a jump to g (if g has non-zero arity), instead of
-- messing around with update frames and PAPs.  We set the closure type
-- to FUN_STATIC in this case.
537
538
539
540
541
542
543
544
545
546
547
\end{code}

%************************************************************************
%*									*
\subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
%*									*
%************************************************************************

Be sure to see the stg-details notes about these...

\begin{code}
548
549
550
551
nodeMustPointToIt :: LambdaFormInfo -> Bool
nodeMustPointToIt (LFReEntrant top _ no_fvs _)
  = not no_fvs ||   -- Certainly if it has fvs we need to point to it
    isNotTopLevel top
552
		    -- If it is not top level we will point to it
553
554
555
556
557
558
559
560
		    --   We can have a \r closure with no_fvs which
		    --   is not top level as special case cgRhsClosure
		    --   has been dissabled in favour of let floating

		-- For lex_profiling we also access the cost centre for a
		-- non-inherited function i.e. not top level
		-- the  not top  case above ensures this is ok.

561
nodeMustPointToIt (LFCon _) = True
562
563
564
565
566
567
568
569
570
571
572
573

	-- Strictly speaking, the above two don't need Node to point
	-- to it if the arity = 0.  But this is a *really* unlikely
	-- situation.  If we know it's nil (say) and we are entering
	-- it. Eg: let x = [] in x then we will certainly have inlined
	-- x, since nil is a simple atom.  So we gain little by not
	-- having Node point to known zero-arity things.  On the other
	-- hand, we do lose something; Patrick's code for figuring out
	-- when something has been updated but not entered relies on
	-- having Node point to the result of an update.  SLPJ
	-- 27/11/92.

574
575
nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
  = updatable || not no_fvs || opt_SccProfilingOn
576
577
578
579
580
581
582
	  -- For the non-updatable (single-entry case):
	  --
	  -- True if has fvs (in which case we need access to them, and we
	  --		    should black-hole it)
	  -- or profiling (in which case we need to recover the cost centre
	  --		 from inside it)

Ian Lynagh's avatar
Ian Lynagh committed
583
nodeMustPointToIt (LFThunk _ _ _ _ _)
584
  = True  -- Node must point to any standard-form thunk
sof's avatar
sof committed
585

586
nodeMustPointToIt (LFUnknown _)     = True
587
nodeMustPointToIt LFBlackHole       = True    -- BH entry may require Node to point
588
nodeMustPointToIt (LFLetNoEscape _) = False 
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
\end{code}

The entry conventions depend on the type of closure being entered,
whether or not it has free variables, and whether we're running
sequentially or in parallel.

\begin{tabular}{lllll}
Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
Unknown 			& no & yes & stack	& node \\
Known fun ($\ge$ 1 arg), no fvs 	& no & no  & registers 	& fast entry (enough args) \\
\ & \ & \ & \ 						& slow entry (otherwise) \\
Known fun ($\ge$ 1 arg), fvs	& no & yes & registers 	& fast entry (enough args) \\
0 arg, no fvs @\r,\s@ 		& no & no  & n/a 	& direct entry \\
0 arg, no fvs @\u@ 		& no & yes & n/a 	& node \\
0 arg, fvs @\r,\s@ 		& no & yes & n/a 	& direct entry \\
0 arg, fvs @\u@ 		& no & yes & n/a 	& node \\

Unknown 			& yes & yes & stack	& node \\
Known fun ($\ge$ 1 arg), no fvs 	& yes & no  & registers & fast entry (enough args) \\
\ & \ & \ & \ 						& slow entry (otherwise) \\
Known fun ($\ge$ 1 arg), fvs	& yes & yes & registers & node \\
0 arg, no fvs @\r,\s@ 		& yes & no  & n/a 	& direct entry \\
0 arg, no fvs @\u@ 		& yes & yes & n/a 	& node \\
0 arg, fvs @\r,\s@ 		& yes & yes & n/a 	& node \\
0 arg, fvs @\u@ 		& yes & yes & n/a 	& node\\
\end{tabular}

616
When black-holing, single-entry closures could also be entered via node
617
618
619
(rather than directly) to catch double-entry.

\begin{code}
620
data CallMethod
621
  = EnterIt				-- no args, not a function
622

623
624
625
626
627
628
629
  | JumpToIt CLabel			-- no args, not a function, but we
					-- know what its entry code is

  | ReturnIt				-- it's a function, but we have
					-- zero args to apply to it, so just
					-- return it.

630
631
  | ReturnCon DataCon			-- It's a data constructor, just return it

632
633
  | SlowCall				-- Unknown fun, or known fun with
					-- too few args.
634

635
  | DirectEntry 			-- Jump directly, with args in regs
636
637
	CLabel 				--   The code label
	Int 				--   Its arity
638

639
640
getCallMethod :: DynFlags
              -> Name		-- Function being applied
641
              -> CafInfo        -- Can it refer to CAF's?
642
643
644
645
	      -> LambdaFormInfo	-- Its info
	      -> Int		-- Number of available arguments
	      -> CallMethod

Ian Lynagh's avatar
Ian Lynagh committed
646
getCallMethod _ _ _ lf_info _
647
648
649
650
651
652
  | nodeMustPointToIt lf_info && opt_Parallel
  =	-- If we're parallel, then we must always enter via node.  
	-- The reason is that the closure may have been 	
	-- fetched since we allocated it.
    EnterIt

653
getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args
654
655
656
  | n_args == 0    = ASSERT( arity /= 0 )
		     ReturnIt	-- No args at all
  | n_args < arity = SlowCall	-- Not enough args
657
  | otherwise      = DirectEntry (enterIdLabel name caf) arity
658

Ian Lynagh's avatar
Ian Lynagh committed
659
getCallMethod _ _ _ (LFCon con) n_args
660
661
662
663
  | opt_SccProfilingOn     -- when profiling, we must always enter
  = EnterIt                -- a closure when we use it, so that the closure
                           -- can be recorded as used for LDV profiling.
  | otherwise
664
665
666
  = ASSERT( n_args == 0 )
    ReturnCon con

667
getCallMethod _dflags _name _caf (LFThunk _ _ _updatable _std_form_info is_fun) _n_args
Thomas Schilling's avatar
Thomas Schilling committed
668
669
  | is_fun 	-- it *might* be a function, so we must "call" it (which is
                -- always safe)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
670
  = SlowCall	-- We cannot just enter it [in eval/apply, the entry code
671
672
		-- is the fast-entry code]

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
673
  -- Since is_fun is False, we are *definitely* looking at a data value
674
  | otherwise
675
676
677
678
679
680
681
  = EnterIt
    -- We used to have ASSERT( n_args == 0 ), but actually it is
    -- possible for the optimiser to generate
    --   let bot :: Int = error Int "urk"
    --   in (bot `cast` unsafeCoerce Int (Int -> Int)) 3
    -- This happens as a result of the case-of-error transformation
    -- So the right thing to do is just to enter the thing
682

683
684
685
686
687
688
689
690
691
692
-- Old version:
--  | updatable || doingTickyProfiling dflags -- to catch double entry
--  = EnterIt
--  | otherwise	-- Jump direct to code for single-entry thunks
--  = JumpToIt (thunkEntryLabel name caf std_form_info updatable)
--
-- Now we never use JumpToIt, even if the thunk is single-entry, since
-- the thunk may have already been entered and blackholed by another
-- processor.

693

Ian Lynagh's avatar
Ian Lynagh committed
694
getCallMethod _ _ _ (LFUnknown True) _
695
  = SlowCall -- Might be a function
696

697
getCallMethod _ name _ (LFUnknown False) n_args
698
699
700
701
702
703
  | n_args > 0 
  = WARN( True, ppr name <+> ppr n_args ) 
    SlowCall	-- Note [Unsafe coerce complications]

  | otherwise
  = EnterIt -- Not a function
704

705
getCallMethod _ _ _ LFBlackHole _
706
707
708
709
  = SlowCall	-- Presumably the black hole has by now
		-- been updated, but we don't know with
		-- what, so we slow call it

Ian Lynagh's avatar
Ian Lynagh committed
710
getCallMethod _ name _ (LFLetNoEscape 0) _
711
712
  = JumpToIt (enterReturnPtLabel (nameUnique name))

713
getCallMethod _ name _ (LFLetNoEscape arity) n_args
714
715
716
  | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
  | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)

717

718
719
720
blackHoleOnEntry :: ClosureInfo -> Bool
blackHoleOnEntry ConInfo{} = False
blackHoleOnEntry cl_info
721
  | isStaticRep (closureSMRep cl_info)
722
  = False	-- Never black-hole a static closure
723

724
  | otherwise
725
  = case closureLFInfo cl_info of
726
	LFReEntrant _ _ _ _	  -> False
727
        LFLetNoEscape _           -> False
728
        LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks.
729
        _other -> panic "blackHoleOnEntry"      -- Should never happen
730

731
732
733
734
isKnownFun :: LambdaFormInfo -> Bool
isKnownFun (LFReEntrant _ _ _ _) = True
isKnownFun (LFLetNoEscape _) = True
isKnownFun _ = False
735
736
\end{code}

737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
Note [Unsafe coerce complications]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In some (badly-optimised) DPH code we see this
   Module X:    rr :: Int = error Int "Urk"
   Module Y:    ...((X.rr |> g) True) ...
     where g is an (unsafe) coercion of kind (Int ~ Bool->Bool), say

It's badly optimised, because knowing that 'X.rr' is bottom, we should
have dumped the application to True.  But it should still work. These
strange unsafe coercions arise from the case-of-error transformation:
	(case (error Int "foo") of { ... }) True
--->	(error Int "foo" |> g) True

Anyway, the net effect is that in STG-land, when casts are discarded,
we *can* see a value of type Int applied to an argument.  This only happens
if (a) the programmer made a mistake, or (b) the value of type Int is
actually bottom.

So it's wrong to trigger an ASSERT failure in this circumstance.  Instead
we now emit a WARN -- mainly to draw attention to a probably-badly-optimised
program fragment -- and do the conservative thing which is SlowCall.


760
761
-----------------------------------------------------------------------------
SRT-related stuff
762

763
764
\begin{code}
staticClosureNeedsLink :: ClosureInfo -> Bool
765
766
767
-- A static closure needs a link field to aid the GC when traversing
-- the static closure graph.  But it only needs such a field if either
-- 	a) it has an SRT
768
--	b) it's a constructor with one or more pointer fields
769
770
-- In case (b), the constructor's fields themselves play the role
-- of the SRT.
771
772
staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
  = needsSRT srt
773
774
staticClosureNeedsLink (ConInfo { closureSMRep = rep })
  = not (isStaticNoCafCon rep)
775
776
\end{code}

777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
Note [Entering error thunks]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this

	fail :: Int
	fail = error Int "Urk"

	foo :: Bool -> Bool 
	foo True  y = (fail `cast` Bool -> Bool) y
	foo False y = False

This looks silly, but it can arise from case-of-error.  Even if it
does, we'd usually see that 'fail' is a bottoming function and would
discard the extra argument 'y'.  But even if that does not occur,
this program is still OK.  We will enter 'fail', which never returns.

The WARN is just to alert me to the fact that we aren't spotting that
'fail' is bottoming.

(We are careful never to make a funtion value look like a data type,
because we can't enter a function closure -- but that is not the 
problem here.)


801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
Avoiding generating entries and info tables
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
At present, for every function we generate all of the following,
just in case.  But they aren't always all needed, as noted below:

[NB1: all of this applies only to *functions*.  Thunks always
have closure, info table, and entry code.]

[NB2: All are needed if the function is *exported*, just to play safe.]


* Fast-entry code  ALWAYS NEEDED

* Slow-entry code
	Needed iff (a) we have any un-saturated calls to the function
	OR	   (b) the function is passed as an arg
	OR	   (c) we're in the parallel world and the function has free vars
			[Reason: in parallel world, we always enter functions
			with free vars via the closure.]

* The function closure
	Needed iff (a) we have any un-saturated calls to the function
	OR	   (b) the function is passed as an arg
	OR	   (c) if the function has free vars (ie not top level)

826
  Why case (a) here?  Because if the arg-satis check fails,
827
828
829
830
  UpdatePAP stuffs a pointer to the function closure in the PAP.
  [Could be changed; UpdatePAP could stuff in a code ptr instead,
   but doesn't seem worth it.]

831
  [NB: these conditions imply that we might need the closure
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
  without the slow-entry code.  Here's how.

	f x y = let g w = ...x..y..w...
		in
		...(g t)...

  Here we need a closure for g which contains x and y,
  but since the calls are all saturated we just jump to the
  fast entry point for g, with R1 pointing to the closure for g.]


* Standard info table
	Needed iff (a) we have any un-saturated calls to the function
	OR	   (b) the function is passed as an arg
	OR 	   (c) the function has free vars (ie not top level)
847

848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
	NB.  In the sequential world, (c) is only required so that the function closure has
	an info table to point to, to keep the storage manager happy.
	If (c) alone is true we could fake up an info table by choosing
	one of a standard family of info tables, whose entry code just
	bombs out.

	[NB In the parallel world (c) is needed regardless because
	we enter functions with free vars via the closure.]

	If (c) is retained, then we'll sometimes generate an info table
	(for storage mgr purposes) without slow-entry code.  Then we need
	to use an error label in the info table to substitute for the absent
	slow entry code.

\begin{code}
staticClosureRequired
864
	:: Name
865
	-> StgBinderInfo
866
867
	-> LambdaFormInfo
	-> Bool
Ian Lynagh's avatar
Ian Lynagh committed
868
staticClosureRequired _ bndr_info
869
		      (LFReEntrant top_level _ _ _)	-- It's a function
870
  = ASSERT( isTopLevel top_level )
871
	-- Assumption: it's a top-level, no-free-var binding
872
	not (satCallsOnly bndr_info)
873

Ian Lynagh's avatar
Ian Lynagh committed
874
staticClosureRequired _ _ _ = True
875
876
\end{code}

877
878
879
880
881
882
883
884
%************************************************************************
%*									*
\subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
%*									*
%************************************************************************

\begin{code}
isStaticClosure :: ClosureInfo -> Bool
885
isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
886
887

closureUpdReqd :: ClosureInfo -> Bool
888
889
890
891
892
closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
closureUpdReqd ConInfo{} = False

lfUpdatable :: LambdaFormInfo -> Bool
lfUpdatable (LFThunk _ _ upd _ _)  = upd
893
lfUpdatable LFBlackHole 	   = True
894
895
	-- Black-hole closures are allocated to receive the results of an
	-- alg case with a named default... so they need to be updated.
896
897
898
899
900
lfUpdatable _ = False

closureIsThunk :: ClosureInfo -> Bool
closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
closureIsThunk ConInfo{} = False
901
902

closureSingleEntry :: ClosureInfo -> Bool
903
closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
Ian Lynagh's avatar
Ian Lynagh committed
904
closureSingleEntry _ = False
905
906

closureReEntrant :: ClosureInfo -> Bool
907
closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
Ian Lynagh's avatar
Ian Lynagh committed
908
closureReEntrant _ = False
909

910
911
912
isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
isConstrClosure_maybe _ 				  = Nothing
913
914

closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
Simon Marlow's avatar
Simon Marlow committed
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
closureFunInfo _ = Nothing

lfFunInfo :: LambdaFormInfo ->  Maybe (Int, ArgDescr)
lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
lfFunInfo _                                 = Nothing

funTag :: ClosureInfo -> Int
funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info
funTag _ = 0

-- maybe this should do constructor tags too?
funTagLFInfo :: LambdaFormInfo -> Int
funTagLFInfo lf
    -- A function is tagged with its arity
  | Just (arity,_) <- lfFunInfo lf,
    Just tag <- tagForArity arity
  = tag

    -- other closures (and unknown ones) are not tagged
  | otherwise
  = 0

tagForArity :: Int -> Maybe Int
tagForArity i | i <= mAX_PTR_TAG = Just i
              | otherwise        = Nothing
941
942
943
944
945
946

clHasCafRefs :: ClosureInfo -> CafInfo
clHasCafRefs (ClosureInfo {closureSRT = srt}) = 
  case srt of NoC_SRT -> NoCafRefs
              _       -> MayHaveCafRefs
clHasCafRefs (ConInfo {}) = NoCafRefs
947
948
\end{code}

949
950
\begin{code}
isToplevClosure :: ClosureInfo -> Bool
951
isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
952
  = case lf_info of
953
954
      LFReEntrant TopLevel _ _ _ -> True
      LFThunk TopLevel _ _ _ _   -> True
Ian Lynagh's avatar
Ian Lynagh committed
955
      _ -> False
956
isToplevClosure _ = False
957
958
\end{code}

959
960
961
Label generation.

\begin{code}
962
infoTableLabelFromCI :: ClosureInfo -> CLabel
batterseapower's avatar
batterseapower committed
963
964
965
infoTableLabelFromCI = fst . labelsFromCI

entryLabelFromCI :: ClosureInfo -> CLabel
966
967
968
969
entryLabelFromCI ci
  | tablesNextToCode = info_lbl
  | otherwise        = entry_lbl
  where (info_lbl, entry_lbl) = labelsFromCI ci
batterseapower's avatar
batterseapower committed
970
971
972
973
974

labelsFromCI :: ClosureInfo -> (CLabel, CLabel) -- (Info, Entry)
labelsFromCI cl@(ClosureInfo { closureName = name,
			       closureLFInfo = lf_info,
			       closureInfLcl = is_lcl })
batterseapower's avatar
batterseapower committed
975
  = case lf_info of
batterseapower's avatar
batterseapower committed
976
	LFBlackHole -> (mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel)
977

978
	LFThunk _ _ upd_flag (SelectorThunk offset) _ -> 
batterseapower's avatar
batterseapower committed
979
		bothL (mkSelectorInfoLabel, mkSelectorEntryLabel) upd_flag offset
980

981
	LFThunk _ _ upd_flag (ApThunk arity) _ -> 
batterseapower's avatar
batterseapower committed
982
		bothL (mkApInfoTableLabel, mkApEntryLabel) upd_flag arity
983

batterseapower's avatar
batterseapower committed
984
	LFThunk{}      -> bothL std_mk_lbls name $ clHasCafRefs cl
985

batterseapower's avatar
batterseapower committed
986
	LFReEntrant _ _ _ _ -> bothL std_mk_lbls name $ clHasCafRefs cl
987

batterseapower's avatar
batterseapower committed
988
	_ -> panic "labelsFromCI"
batterseapower's avatar
batterseapower committed
989
  where std_mk_lbls = if is_lcl then (mkLocalInfoTableLabel, mkLocalEntryLabel) else (mkInfoTableLabel, mkEntryLabel)
990

batterseapower's avatar
batterseapower committed
991
labelsFromCI cl@(ConInfo { closureCon = con, 
992
			           closureSMRep = rep })
batterseapower's avatar
batterseapower committed
993
994
  | isStaticRep rep = bothL (mkStaticInfoTableLabel, mkStaticConEntryLabel)  name $ clHasCafRefs cl
  | otherwise	    = bothL (mkConInfoTableLabel,    mkConEntryLabel)        name $ clHasCafRefs cl
995
996
  where
    name = dataConName con
997

batterseapower's avatar
batterseapower committed
998
999
bothL :: (a -> b -> c, a -> b -> c) -> a -> b -> (c, c)
bothL (f, g) x y = (f x y, g x y)
1000

1001
-- ClosureInfo for a closure (as opposed to a constructor) is always local
1002
1003
1004
closureLabelFromCI :: ClosureInfo -> CLabel
closureLabelFromCI cl@(ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm $ clHasCafRefs cl
closureLabelFromCI _ = panic "closureLabelFromCI"
1005
1006

-- thunkEntryLabel is a local help function, not exported.  It's used from both
1007
-- entryLabelFromCI and getCallMethod.
1008

1009
{- UNUSED:
Ian Lynagh's avatar
Ian Lynagh committed
1010
1011
thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel
thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable
1012
  = enterApLabel is_updatable arity
Ian Lynagh's avatar
Ian Lynagh committed
1013
thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag
1014
  = enterSelectorLabel upd_flag offset
Ian Lynagh's avatar
Ian Lynagh committed
1015
thunkEntryLabel thunk_id caf _ _is_updatable
1016
  = enterIdLabel thunk_id caf
1017
-}
1018

1019
{- UNUSED:
Ian Lynagh's avatar
Ian Lynagh committed
1020
enterApLabel :: Bool -> Int -> CLabel
1021
1022
1023
enterApLabel is_updatable arity
  | tablesNextToCode = mkApInfoTableLabel is_updatable arity
  | otherwise        = mkApEntryLabel is_updatable arity
1024
-}
1025

1026
{- UNUSED:
Ian Lynagh's avatar
Ian Lynagh committed
1027
enterSelectorLabel :: Bool -> Int -> CLabel
1028
1029
1030
enterSelectorLabel upd_flag offset
  | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
  | otherwise        = mkSelectorEntryLabel upd_flag offset
1031
-}
1032

Ian Lynagh's avatar
Ian Lynagh committed
1033
enterIdLabel :: Name -> CafInfo -> CLabel
1034
1035
1036
enterIdLabel id
  | tablesNextToCode = mkInfoTableLabel id
  | otherwise        = mkEntryLabel id
1037

Ian Lynagh's avatar
Ian Lynagh committed
1038
enterReturnPtLabel :: Unique -> CLabel
1039
1040
1041
enterReturnPtLabel name
  | tablesNextToCode = mkReturnInfoLabel name
  | otherwise        = mkReturnPtLabel name
1042
1043
\end{code}

1044

1045
We need a black-hole closure info to pass to @allocDynClosure@ when we
1046
1047
1048
want to allocate the black hole on entry to a CAF.  These are the only
ways to build an LFBlackHole, maintaining the invariant that it really
is a black hole and not something else.
1049
1050

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
1051
cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
1052
1053
1054
cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
				       closureType = ty })
  = ClosureInfo { closureName   = nm,
1055
		  closureLFInfo = LFBlackHole,
1056
		  closureSMRep  = blackHoleRep,
1057
1058
		  closureSRT    = NoC_SRT,
		  closureType   = ty,
1059
1060
		  closureDescr  = "",
		  closureInfLcl = False }
1061
cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
1062
1063
1064
1065
1066
1067
1068
1069
\end{code}

%************************************************************************
%*									*
\subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
%*									*
%************************************************************************

1070
1071
Profiling requires two pieces of information to be determined for
each closure's info table --- description and type.
1072
1073
1074
1075
1076
1077
1078
1079

The description is stored directly in the @CClosureInfoTable@ when the
info table is built.

The type is determined from the type information stored with the @Id@
in the closure info using @closureTypeDescr@.

\begin{code}
1080
1081
1082
1083
closureValDescr, closureTypeDescr :: ClosureInfo -> String
closureValDescr (ClosureInfo {closureDescr = descr}) 
  = descr
closureValDescr (ConInfo {closureCon = con})
1084
  = occNameString (getOccName con)
1085

1086
1087
1088
closureTypeDescr (ClosureInfo { closureType = ty })
  = getTyDescription ty
closureTypeDescr (ConInfo { closureCon = data_con })
1089
  = occNameString (getOccName (dataConTyCon data_con))
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103

getTyDescription :: Type -> String
getTyDescription ty
  = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
    case tau_ty of
      TyVarTy _	       	     -> "*"
      AppTy fun _      	     -> getTyDescription fun
      FunTy _ res      	     -> '-' : '>' : fun_result res
      TyConApp tycon _ 	     -> getOccString tycon
      ForAllTy _ ty          -> getTyDescription ty
    }
  where
    fun_result (FunTy _ res) = '>' : fun_result res
    fun_result other	     = getTyDescription other
1104
\end{code}