2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[CgBindery]{Utility functions related to doing @CgBindings@}
8 CgBindings, CgIdInfo(..){-dubiously concrete-},
9 StableLoc, VolatileLoc,
13 stableAmodeIdInfo, heapIdInfo, newTempAmodeAndIdInfo,
14 letNoEscapeIdInfo, idInfoToAmode,
19 bindNewToStack, rebindToStack,
20 bindNewToNode, bindNewToReg, bindArgsToRegs,
21 bindNewToTemp, bindNewPrimToAmode,
22 getArgAmode, getArgAmodes,
23 getCAddrModeAndInfo, getCAddrMode,
24 getCAddrModeIfVolatile, getVolatileRegs,
26 buildLivenessMask, buildContLivenessMask
29 #include "HsVersions.h"
34 import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp )
35 import CgStackery ( freeStackSlots, addFreeSlots )
36 import CLabel ( mkStaticClosureLabel, mkClosureLabel,
38 import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
39 import BitSet ( mkBS, emptyBS )
40 import PrimRep ( isFollowableRep, getPrimRepSize )
41 import DataCon ( DataCon, dataConName )
42 import Id ( Id, idPrimRep, idType )
43 import Type ( typePrimRep )
45 import VarSet ( varSetElems )
46 import Const ( Con(..), Literal )
47 import Maybes ( catMaybes, maybeToBool )
48 import Name ( isLocallyDefined, isWiredInName, NamedThing(..) )
50 import PprAbsC ( pprAmode )
52 import PrimRep ( PrimRep(..) )
53 import StgSyn ( StgArg, StgLiveVars, GenStgArg(..) )
54 import Unique ( Unique, Uniquable(..) )
55 import UniqSet ( elementOfUniqSet )
56 import Util ( zipWithEqual, sortLt )
61 %************************************************************************
63 \subsection[Bindery-datatypes]{Data types}
65 %************************************************************************
67 @(CgBinding a b)@ is a type of finite maps from a to b.
69 The assumption used to be that @lookupCgBind@ must get exactly one
70 match. This is {\em completely wrong} in the case of compiling
71 letrecs (where knot-tying is used). An initial binding is fed in (and
72 never evaluated); eventually, a correct binding is put into the
73 environment. So there can be two bindings for a given name.
76 type CgBindings = IdEnv CgIdInfo
79 = MkCgIdInfo Id -- Id that this is the info for
88 | RegLoc MagicId -- in one of the magic registers
89 -- (probably {Int,Float,Char,etc}Reg
91 | VirHpLoc VirtualHeapOffset -- Hp+offset (address of closure)
93 | VirNodeLoc VirtualHeapOffset -- Cts of offset indirect from Node
97 @StableLoc@ encodes where an Id can be found, used by
98 the @CgBindings@ environment in @CgBindery@.
103 | VirStkLoc VirtualSpOffset
105 | StableAmodeLoc CAddrMode
107 -- these are so StableLoc can be abstract:
109 maybeStkLoc (VirStkLoc offset) = Just offset
110 maybeStkLoc _ = Nothing
113 %************************************************************************
115 \subsection[Bindery-idInfo]{Manipulating IdInfo}
117 %************************************************************************
120 stableAmodeIdInfo i amode lf_info = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc amode) lf_info
121 heapIdInfo i offset lf_info = MkCgIdInfo i (VirHpLoc offset) NoStableLoc lf_info
122 tempIdInfo i uniq lf_info = MkCgIdInfo i (TempVarLoc uniq) NoStableLoc lf_info
124 letNoEscapeIdInfo i sp lf_info
125 = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc (CJoinPoint sp)) lf_info
127 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
129 newTempAmodeAndIdInfo name lf_info
130 = (temp_amode, temp_idinfo)
132 uniq = getUnique name
133 temp_amode = CTemp uniq (idPrimRep name)
134 temp_idinfo = tempIdInfo name uniq lf_info
136 idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode
137 idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab
139 idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode
141 idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc = returnFC (CTemp uniq kind)
142 idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc = returnFC (CReg magic_id)
144 idInfoPiecesToAmode kind NoVolatileLoc (LitLoc lit) = returnFC (CLit lit)
145 idInfoPiecesToAmode kind NoVolatileLoc (StableAmodeLoc amode) = returnFC amode
147 idInfoPiecesToAmode kind (VirNodeLoc nd_off) stable_loc
148 = returnFC (CVal (nodeRel nd_off) kind)
149 -- Virtual offsets from Node increase into the closures,
150 -- and so do Node-relative offsets (which we want in the CVal),
151 -- so there is no mucking about to do to the offset.
153 idInfoPiecesToAmode kind (VirHpLoc hp_off) stable_loc
154 = getHpRelOffset hp_off `thenFC` \ rel_hp ->
155 returnFC (CAddr rel_hp)
157 idInfoPiecesToAmode kind NoVolatileLoc (VirStkLoc i)
158 = getSpRelOffset i `thenFC` \ rel_sp ->
159 returnFC (CVal rel_sp kind)
162 idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc"
166 %************************************************************************
168 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
170 %************************************************************************
172 We sometimes want to nuke all the volatile bindings; we must be sure
173 we don't leave any (NoVolatile, NoStable) binds around...
176 nukeVolatileBinds :: CgBindings -> CgBindings
177 nukeVolatileBinds binds
178 = mkVarEnv (foldr keep_if_stable [] (rngVarEnv binds))
180 keep_if_stable (MkCgIdInfo i _ NoStableLoc entry_info) acc = acc
181 keep_if_stable (MkCgIdInfo i _ stable_loc entry_info) acc
182 = (i, MkCgIdInfo i NoVolatileLoc stable_loc entry_info) : acc
186 %************************************************************************
188 \subsection[lookup-interface]{Interface functions to looking up bindings}
190 %************************************************************************
192 I {\em think} all looking-up is done through @getCAddrMode(s)@.
195 getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
197 getCAddrModeAndInfo id
198 | not (isLocallyDefined name) || isWiredInName name
199 {- Why the "isWiredInName"?
200 Imagine you are compiling PrelBase.hs (a module that
201 supplies some of the wired-in values). What can
202 happen is that the compiler will inject calls to
203 (e.g.) GHCbase.unpackPS, where-ever it likes -- it
204 assumes those values are ubiquitously available.
205 The main point is: it may inject calls to them earlier
206 in GHCbase.hs than the actual definition...
208 = returnFC (global_amode, mkLFImported id)
210 | otherwise = -- *might* be a nested defn: in any case, it's something whose
211 -- definition we will know about...
212 lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
213 idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
214 returnFC (amode, lf_info)
217 global_amode = CLbl (mkClosureLabel name) kind
220 getCAddrMode :: Id -> FCode CAddrMode
222 = getCAddrModeAndInfo name `thenFC` \ (amode, _) ->
227 getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode)
228 getCAddrModeIfVolatile name
229 -- | toplevelishId name = returnFC Nothing
231 = lookupBindC name `thenFC` \ ~(MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
233 NoStableLoc -> -- Aha! So it is volatile!
234 idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc `thenFC` \ amode ->
235 returnFC (Just amode)
237 a_stable_loc -> returnFC Nothing
240 @getVolatileRegs@ gets a set of live variables, and returns a list of
241 all registers on which these variables depend. These are the regs
242 which must be saved and restored across any C calls. If a variable is
243 both in a volatile location (depending on a register) {\em and} a
244 stable one (notably, on the stack), we modify the current bindings to
245 forget the volatile one.
248 getVolatileRegs :: StgLiveVars -> FCode [MagicId]
251 = mapFCs snaffle_it (varSetElems vars) `thenFC` \ stuff ->
252 returnFC (catMaybes stuff)
255 = lookupBindC var `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
257 -- commoned-up code...
259 = if not (isVolatileReg reg) then
260 -- Potentially dies across C calls
261 -- For now, that's everything; we leave
262 -- it to the save-macros to decide which
263 -- regs *really* need to be saved.
267 NoStableLoc -> returnFC (Just reg) -- got one!
269 -- has both volatile & stable locations;
270 -- force it to rely on the stable location
271 modifyBindC var nuke_vol_bind `thenC`
275 RegLoc reg -> consider_reg reg
276 VirHpLoc _ -> consider_reg Hp
277 VirNodeLoc _ -> consider_reg node
278 non_reg_loc -> returnFC Nothing
280 nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info)
281 = MkCgIdInfo i NoVolatileLoc stable_loc lf_info
285 getArgAmodes :: [StgArg] -> FCode [CAddrMode]
286 getArgAmodes [] = returnFC []
287 getArgAmodes (atom:atoms)
288 = getArgAmode atom `thenFC` \ amode ->
289 getArgAmodes atoms `thenFC` \ amodes ->
290 returnFC ( amode : amodes )
292 getArgAmode :: StgArg -> FCode CAddrMode
294 getArgAmode (StgVarArg var) = getCAddrMode var -- The common case
296 getArgAmode (StgConArg (DataCon con))
297 {- Why does this case differ from StgVarArg?
298 Because the program might look like this:
299 data Foo a = Empty | Baz a
300 f a x = let c = Empty! a
302 Now, when we go Core->Stg, we drop the type applications,
303 so we can inline c, giving
305 Now we are referring to Empty as an argument (rather than in an STGCon),
306 so we'll look it up with getCAddrMode. We want to return an amode for
307 the static closure that we make for nullary constructors. But if we blindly
308 go ahead with getCAddrMode we end up looking in the environment, and it ain't there!
310 This special case used to be in getCAddrModeAndInfo, but it doesn't work there.
313 If the constructor Baz isn't inlined we simply want to treat it like any other
314 identifier, with a top level definition. We don't want to spot that it's a constructor.
320 are treated differently; the former is a call to a bog standard function while the
321 latter uses the specially-labelled, pre-defined info tables etc for the constructor.
323 The way to think of this case in getArgAmode is that
326 App f (StgCon Empty [])
328 = returnFC (CLbl (mkStaticClosureLabel (dataConName con)) PtrRep)
331 getArgAmode (StgConArg (Literal lit)) = returnFC (CLit lit)
334 %************************************************************************
336 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
338 %************************************************************************
341 bindNewToStack :: (Id, VirtualSpOffset) -> Code
342 bindNewToStack (name, offset)
345 info = MkCgIdInfo name NoVolatileLoc (VirStkLoc offset) mkLFArgument
347 bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
348 bindNewToNode name offset lf_info
351 info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info
353 -- Create a new temporary whose unique is that in the id,
354 -- bind the id to it, and return the addressing mode for the
356 bindNewToTemp :: Id -> FCode CAddrMode
358 = let (temp_amode, id_info) = newTempAmodeAndIdInfo name mkLFArgument
359 -- This is used only for things we don't know
360 -- anything about; values returned by a case statement,
363 addBindC name id_info `thenC`
366 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code
367 bindNewToReg name magic_id lf_info
370 info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
372 bindNewToLit name lit
375 info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (error "bindNewToLit")
377 bindArgsToRegs :: [Id] -> [MagicId] -> Code
378 bindArgsToRegs args regs
379 = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
381 arg `bind` reg = bindNewToReg arg reg mkLFArgument
384 @bindNewPrimToAmode@ works only for certain addressing modes. Making
385 this work for stack offsets is non-trivial (virt vs. real stack offset
389 bindNewPrimToAmode :: Id -> CAddrMode -> Code
390 bindNewPrimToAmode name (CReg reg)
391 = bindNewToReg name reg (panic "bindNewPrimToAmode")
393 bindNewPrimToAmode name (CTemp uniq kind)
394 = addBindC name (tempIdInfo name uniq (panic "bindNewPrimToAmode"))
397 bindNewPrimToAmode name amode
398 = pprPanic "bindNew...:" (pprAmode amode)
403 rebindToStack :: Id -> VirtualSpOffset -> Code
404 rebindToStack name offset
405 = modifyBindC name replace_stable_fn
407 replace_stable_fn (MkCgIdInfo i vol stab einfo)
408 = MkCgIdInfo i vol (VirStkLoc offset) einfo
411 %************************************************************************
413 \subsection[CgBindery-liveness]{Build a liveness mask for the current stack}
415 %************************************************************************
417 ToDo: remove the dependency on 32-bit words.
419 There are two ways to build a liveness mask, and both appear to have
422 1) Find all the pointer words by searching through the binding list.
423 Invert this to find the non-pointer words and build the bitmap.
425 2) Find all the non-pointer words by search through the binding list.
426 Merge this with the list of currently free slots. Build the
429 Method (1) conflicts with update frames - these contain pointers but
430 have no bindings in the environment. We could bind the updatee to its
431 location in the update frame at the point when the update frame is
432 pushed, but this binding would be dropped by the first case expression
435 Method (2) causes problems because we must make sure that every
436 non-pointer word on the stack is either a free stack slot or has a
437 binding in the environment. Things like cost centres break this (but
438 only for case-of-case expressions - because that's when there's a cost
439 centre on the stack from the outer case and we need to generate a
440 bitmap for the inner case's continuation).
442 This method also works "by accident" for update frames: since all
443 unaccounted for slots on the stack are assumed to be pointers, and an
444 update frame always occurs at virtual Sp offsets 0-3 (i.e. the bottom
445 of the stack frame), the bitmap will simply end at the start of the
448 We use method (2) at the moment.
452 :: Unique -- unique for for large bitmap label
453 -> VirtualSpOffset -- offset from which the bitmap should start
454 -> FCode Liveness -- mask for free/unlifted slots
456 buildLivenessMask uniq sp info_down
457 state@(MkCgState abs_c binds ((vsp, free, _, _), heap_usage))
458 = ASSERT(all (>=0) rel_slots)
459 livenessToAbsC uniq liveness_mask info_down state
461 -- find all unboxed stack-resident ids
464 (MkCgIdInfo id _ (VirStkLoc ofs) _) <- rngVarEnv binds,
465 let rep = idPrimRep id; size = getPrimRepSize rep,
466 not (isFollowableRep rep),
470 -- flatten this list into a list of unboxed stack slots
471 flatten_slots = sortLt (<)
472 (foldr (\(ofs,size) r -> [ofs-size+1 .. ofs] ++ r) []
475 -- merge in the free slots
476 all_slots = addFreeSlots flatten_slots free ++
477 if vsp < sp then [vsp+1 .. sp] else []
479 -- recalibrate the list to be sp-relative
480 rel_slots = reverse (map (sp-) all_slots)
483 liveness_mask = listToLivenessMask rel_slots
485 {- ALTERNATE version that doesn't work because update frames aren't
486 recorded in the environment.
488 -- find all boxed stack-resident ids
490 [ ofs | (MkCgIdInfo id _ (VirStkLoc ofs) _) <- rngVarEnv binds,
491 isFollowableRep (idPrimRep id)
495 -- invert to get unboxed slots
496 unboxed_slots = filter (`notElem` boxed_slots) all_slots
499 listToLivenessMask :: [Int] -> LivenessMask
500 listToLivenessMask [] = []
501 listToLivenessMask slots =
502 mkBS this : listToLivenessMask (map (\x -> x-32) rest)
503 where (this,rest) = span (<32) slots
505 livenessToAbsC :: Unique -> LivenessMask -> FCode Liveness
506 livenessToAbsC uniq [] = returnFC (LvSmall emptyBS)
507 livenessToAbsC uniq [one] = returnFC (LvSmall one)
508 livenessToAbsC uniq many =
509 absC (CBitmap lbl many) `thenC`
510 returnFC (LvLarge lbl)
511 where lbl = mkBitmapLabel uniq
514 In a continuation, we want a liveness mask that starts from just after
515 the return address, which is on the stack at realSp.
518 buildContLivenessMask
521 buildContLivenessMask uniq
522 = getRealSp `thenFC` \ realSp ->
523 buildLivenessMask uniq (realSp-1)
526 %************************************************************************
528 \subsection[CgMonad-deadslots]{Finding dead stack slots}
530 %************************************************************************
532 nukeDeadBindings does the following:
534 - Removes all bindings from the environment other than those
535 for variables in the argument to nukeDeadBindings.
536 - Collects any stack slots so freed, and returns them to the stack free
538 - Moves the virtual stack pointer to point to the topmost used
541 You can have multi-word slots on the stack (where a Double# used to
542 be, for instance); if dead, such a slot will be reported as *several*
543 offsets (one per word).
545 Probably *naughty* to look inside monad...
548 nukeDeadBindings :: StgLiveVars -- All the *live* variables
551 nukeDeadBindings live_vars info_down (MkCgState abs_c binds usage)
552 = freeStackSlots extra_free info_down (MkCgState abs_c (mkVarEnv bs') usage)
554 (dead_stk_slots, bs')
555 = dead_slots live_vars
557 [ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ]
559 extra_free = sortLt (<) dead_stk_slots
562 Several boring auxiliary functions to do the dirty work.
565 dead_slots :: StgLiveVars
569 -> ([VirtualSpOffset], [(Id,CgIdInfo)])
571 -- dead_slots carries accumulating parameters for
572 -- filtered bindings, dead slots
573 dead_slots live_vars fbs ds []
574 = (ds, reverse fbs) -- Finished; rm the dups, if any
576 dead_slots live_vars fbs ds ((v,i):bs)
577 | v `elementOfUniqSet` live_vars
578 = dead_slots live_vars ((v,i):fbs) ds bs
579 -- Live, so don't record it in dead slots
580 -- Instead keep it in the filtered bindings
584 MkCgIdInfo _ _ stable_loc _
585 | is_stk_loc && size > 0 ->
586 dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
588 maybe_stk_loc = maybeStkLoc stable_loc
589 is_stk_loc = maybeToBool maybe_stk_loc
590 (Just offset) = maybe_stk_loc
592 _ -> dead_slots live_vars fbs ds bs
596 size = (getPrimRepSize . typePrimRep . idType) v