2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[CgBindery]{Utility functions related to doing @CgBindings@}
9 StableLoc, VolatileLoc,
11 stableAmodeIdInfo, heapIdInfo, newTempAmodeAndIdInfo,
12 letNoEscapeIdInfo, idInfoToAmode,
19 bindNewToStack, rebindToStack,
20 bindNewToNode, bindNewToReg, bindArgsToRegs,
21 bindNewToTemp, bindNewPrimToAmode,
22 getArgAmode, getArgAmodes,
23 getCAddrModeAndInfo, getCAddrMode,
24 getCAddrModeIfVolatile, getVolatileRegs,
29 #include "HsVersions.h"
34 import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp )
35 import CgStackery ( freeStackSlots, getStackFrame )
36 import CLabel ( mkClosureLabel,
37 mkBitmapLabel, pprCLabel )
38 import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
40 import PrimRep ( isFollowableRep, getPrimRepSize )
41 import Id ( Id, idPrimRep, idType )
42 import Type ( typePrimRep )
44 import VarSet ( varSetElems )
45 import Literal ( Literal )
46 import Maybes ( catMaybes, maybeToBool, seqMaybe )
47 import Name ( Name, isInternalName, NamedThing(..) )
49 import PprAbsC ( pprAmode )
51 import PrimRep ( PrimRep(..) )
52 import StgSyn ( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg )
53 import Unique ( Unique, Uniquable(..) )
54 import UniqSet ( elementOfUniqSet )
55 import Util ( zipWithEqual, sortLt )
60 %************************************************************************
62 \subsection[Bindery-datatypes]{Data types}
64 %************************************************************************
66 @(CgBinding a b)@ is a type of finite maps from a to b.
68 The assumption used to be that @lookupCgBind@ must get exactly one
69 match. This is {\em completely wrong} in the case of compiling
70 letrecs (where knot-tying is used). An initial binding is fed in (and
71 never evaluated); eventually, a correct binding is put into the
72 environment. So there can be two bindings for a given name.
75 type CgBindings = IdEnv CgIdInfo
78 = MkCgIdInfo Id -- Id that this is the info for
87 | RegLoc MagicId -- in one of the magic registers
88 -- (probably {Int,Float,Char,etc}Reg)
90 | VirHpLoc VirtualHeapOffset -- Hp+offset (address of closure)
92 | VirNodeLoc VirtualHeapOffset -- Cts of offset indirect from Node
96 @StableLoc@ encodes where an Id can be found, used by
97 the @CgBindings@ environment in @CgBindery@.
102 | VirStkLoc VirtualSpOffset
104 | StableAmodeLoc CAddrMode
106 -- these are so StableLoc can be abstract:
108 maybeStkLoc (VirStkLoc offset) = Just offset
109 maybeStkLoc _ = Nothing
112 %************************************************************************
114 \subsection[Bindery-idInfo]{Manipulating IdInfo}
116 %************************************************************************
119 stableAmodeIdInfo i amode lf_info = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc amode) lf_info
120 heapIdInfo i offset lf_info = MkCgIdInfo i (VirHpLoc offset) NoStableLoc lf_info
121 tempIdInfo i uniq lf_info = MkCgIdInfo i (TempVarLoc uniq) NoStableLoc lf_info
123 letNoEscapeIdInfo i sp lf_info
124 = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc (CJoinPoint sp)) lf_info
126 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
128 newTempAmodeAndIdInfo name lf_info
129 = (temp_amode, temp_idinfo)
131 uniq = getUnique name
132 temp_amode = CTemp uniq (idPrimRep name)
133 temp_idinfo = tempIdInfo name uniq lf_info
135 idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode
136 idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab
138 idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode
140 idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc = returnFC (CTemp uniq kind)
141 idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc = returnFC (CReg magic_id)
143 idInfoPiecesToAmode kind NoVolatileLoc (LitLoc lit) = returnFC (CLit lit)
144 idInfoPiecesToAmode kind NoVolatileLoc (StableAmodeLoc amode) = returnFC amode
146 idInfoPiecesToAmode kind (VirNodeLoc nd_off) stable_loc
147 = returnFC (CVal (nodeRel nd_off) kind)
148 -- Virtual offsets from Node increase into the closures,
149 -- and so do Node-relative offsets (which we want in the CVal),
150 -- so there is no mucking about to do to the offset.
152 idInfoPiecesToAmode kind (VirHpLoc hp_off) stable_loc
153 = getHpRelOffset hp_off `thenFC` \ rel_hp ->
154 returnFC (CAddr rel_hp)
156 idInfoPiecesToAmode kind NoVolatileLoc (VirStkLoc i)
157 = getSpRelOffset i `thenFC` \ rel_sp ->
158 returnFC (CVal rel_sp kind)
161 idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc"
165 %************************************************************************
167 \subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
169 %************************************************************************
171 There are three basic routines, for adding (@addBindC@), modifying
172 (@modifyBindC@) and looking up (@lookupBindC@) bindings.
174 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
175 The name should not already be bound. (nice ASSERT, eh?)
178 addBindC :: Id -> CgIdInfo -> Code
179 addBindC name stuff_to_bind = do
181 setBinds $ extendVarEnv binds name stuff_to_bind
183 addBindsC :: [(Id, CgIdInfo)] -> Code
184 addBindsC new_bindings = do
186 let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
191 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
192 modifyBindC name mangle_fn = do
194 setBinds $ modifyVarEnv mangle_fn binds name
196 lookupBindC :: Id -> FCode CgIdInfo
197 lookupBindC id = do maybe_info <- lookupBindC_maybe id
199 Just info -> return info
200 Nothing -> cgLookupPanic id
202 lookupBindC_maybe :: Id -> FCode (Maybe CgIdInfo)
204 = do static_binds <- getStaticBinds
205 local_binds <- getBinds
206 return (lookupVarEnv local_binds id
208 lookupVarEnv static_binds id)
210 cgLookupPanic :: Id -> FCode a
212 = do static_binds <- getStaticBinds
213 local_binds <- getBinds
217 ptext SLIT("static binds for:"),
218 vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ],
219 ptext SLIT("local binds for:"),
220 vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv local_binds ],
221 ptext SLIT("SRT label") <+> pprCLabel srt
225 %************************************************************************
227 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
229 %************************************************************************
231 We sometimes want to nuke all the volatile bindings; we must be sure
232 we don't leave any (NoVolatile, NoStable) binds around...
235 nukeVolatileBinds :: CgBindings -> CgBindings
236 nukeVolatileBinds binds
237 = mkVarEnv (foldr keep_if_stable [] (rngVarEnv binds))
239 keep_if_stable (MkCgIdInfo i _ NoStableLoc entry_info) acc = acc
240 keep_if_stable (MkCgIdInfo i _ stable_loc entry_info) acc
241 = (i, MkCgIdInfo i NoVolatileLoc stable_loc entry_info) : acc
245 %************************************************************************
247 \subsection[lookup-interface]{Interface functions to looking up bindings}
249 %************************************************************************
251 I {\em think} all looking-up is done through @getCAddrMode(s)@.
254 getCAddrModeAndInfo :: Id -> FCode (Id, CAddrMode, LambdaFormInfo)
256 getCAddrModeAndInfo id
258 maybe_cg_id_info <- lookupBindC_maybe id
259 case maybe_cg_id_info of
261 -- Nothing => not in the environment, so should be imported
262 Nothing | isInternalName name -> cgLookupPanic id
263 | otherwise -> returnFC (id, global_amode, mkLFImported id)
265 Just (MkCgIdInfo id' volatile_loc stable_loc lf_info)
266 -> do amode <- idInfoPiecesToAmode kind volatile_loc stable_loc
267 return (id', amode, lf_info)
270 global_amode = CLbl (mkClosureLabel name) kind
273 getCAddrMode :: Id -> FCode CAddrMode
274 getCAddrMode name = do
275 (_, amode, _) <- getCAddrModeAndInfo name
280 getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode)
281 getCAddrModeIfVolatile name
282 -- | toplevelishId name = returnFC Nothing
285 (MkCgIdInfo _ volatile_loc stable_loc lf_info) <- lookupBindC name
287 NoStableLoc -> do -- Aha! So it is volatile!
288 amode <- idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc
290 a_stable_loc -> return Nothing
293 @getVolatileRegs@ gets a set of live variables, and returns a list of
294 all registers on which these variables depend. These are the regs
295 which must be saved and restored across any C calls. If a variable is
296 both in a volatile location (depending on a register) {\em and} a
297 stable one (notably, on the stack), we modify the current bindings to
298 forget the volatile one.
301 getVolatileRegs :: StgLiveVars -> FCode [MagicId]
303 getVolatileRegs vars = do
304 stuff <- mapFCs snaffle_it (varSetElems vars)
305 returnFC $ catMaybes stuff
308 (MkCgIdInfo _ volatile_loc stable_loc lf_info) <- lookupBindC var
310 -- commoned-up code...
312 if not (isVolatileReg reg) then
313 -- Potentially dies across C calls
314 -- For now, that's everything; we leave
315 -- it to the save-macros to decide which
316 -- regs *really* need to be saved.
320 NoStableLoc -> returnFC (Just reg) -- got one!
321 is_a_stable_loc -> do
322 -- has both volatile & stable locations;
323 -- force it to rely on the stable location
324 modifyBindC var nuke_vol_bind
328 RegLoc reg -> consider_reg reg
329 VirNodeLoc _ -> consider_reg node
330 non_reg_loc -> returnFC Nothing
332 nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info)
333 = MkCgIdInfo i NoVolatileLoc stable_loc lf_info
337 getArgAmodes :: [StgArg] -> FCode [CAddrMode]
338 getArgAmodes [] = returnFC []
339 getArgAmodes (atom:atoms)
343 amode <- getArgAmode atom
344 amodes <- getArgAmodes atoms
345 return ( amode : amodes )
347 getArgAmode :: StgArg -> FCode CAddrMode
349 getArgAmode (StgVarArg var) = getCAddrMode var -- The common case
350 getArgAmode (StgLitArg lit) = returnFC (CLit lit)
353 %************************************************************************
355 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
357 %************************************************************************
360 bindNewToStack :: (Id, VirtualSpOffset) -> Code
361 bindNewToStack (name, offset)
364 info = MkCgIdInfo name NoVolatileLoc (VirStkLoc offset) (mkLFArgument name)
366 bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
367 bindNewToNode name offset lf_info
370 info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info
372 -- Create a new temporary whose unique is that in the id,
373 -- bind the id to it, and return the addressing mode for the
375 bindNewToTemp :: Id -> FCode CAddrMode
377 = let (temp_amode, id_info) = newTempAmodeAndIdInfo name (mkLFArgument name)
378 -- This is used only for things we don't know
379 -- anything about; values returned by a case statement,
382 addBindC name id_info
385 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code
386 bindNewToReg name magic_id lf_info
389 info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
391 bindArgsToRegs :: [Id] -> [MagicId] -> Code
392 bindArgsToRegs args regs
393 = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
395 arg `bind` reg = bindNewToReg arg reg (mkLFArgument arg)
398 @bindNewPrimToAmode@ works only for certain addressing modes. Making
399 this work for stack offsets is non-trivial (virt vs. real stack offset
403 bindNewPrimToAmode :: Id -> CAddrMode -> Code
404 bindNewPrimToAmode name (CReg reg)
405 = bindNewToReg name reg (panic "bindNewPrimToAmode")
407 bindNewPrimToAmode name (CTemp uniq kind)
408 = addBindC name (tempIdInfo name uniq (panic "bindNewPrimToAmode"))
411 bindNewPrimToAmode name amode
412 = pprPanic "bindNew...:" (pprAmode amode)
417 rebindToStack :: Id -> VirtualSpOffset -> Code
418 rebindToStack name offset
419 = modifyBindC name replace_stable_fn
421 replace_stable_fn (MkCgIdInfo i vol stab einfo)
422 = MkCgIdInfo i vol (VirStkLoc offset) einfo
425 %************************************************************************
427 \subsection[CgBindery-liveness]{Build a liveness mask for the current stack}
429 %************************************************************************
431 There are four kinds of things on the stack:
433 - pointer variables (bound in the environment)
434 - non-pointer variables (boudn in the environment)
435 - free slots (recorded in the stack free list)
436 - non-pointer data slots (recorded in the stack free list)
438 We build up a bitmap of non-pointer slots by looking down the
439 environment for all the non-pointer variables, and merging this with
440 the slots recorded in the stack free list.
442 There's a bit of a hack here to do with update frames: since nothing
443 is recorded in either the environment or the stack free list for an
444 update frame, the code below defaults to assuming the slots taken up
445 by an update frame contain pointers. Furthermore, update frames are
446 always in slots 0-2 at the bottom of the stack. The bitmap will
447 therefore end at slot 3, which is what we want (the update frame info
448 pointer has its own bitmap to describe the update frame).
452 :: VirtualSpOffset -- size of the stack frame
453 -> VirtualSpOffset -- offset from which the bitmap should start
454 -> FCode LivenessMask -- mask for free/unlifted slots
456 buildLivenessMask size sp = do {
457 -- find all live stack-resident pointers
459 ((vsp, _, free, _, _), heap_usage) <- getUsage;
462 rel_slots = sortLt (<)
463 [ sp - ofs -- get slots relative to top of frame
464 | (MkCgIdInfo id _ (VirStkLoc ofs) _) <- rngVarEnv binds,
465 isFollowableRep (idPrimRep id)
469 ASSERT(all (>=0) rel_slots)
470 return (listToLivenessMask size rel_slots)
473 -- make a bitmap where the slots specified are the *zeros* in the bitmap.
474 -- eg. [1,2,4], size 4 ==> 0x8 (we leave any bits outside the size as zero,
475 -- just to make the bitmap easier to read).
476 listToLivenessMask :: Int -> [Int] -> [BitSet]
477 listToLivenessMask size slots{- must be sorted -}
479 | otherwise = init `minusBS` mkBS these :
480 listToLivenessMask (size - 32) (map (\x -> x - 32) rest)
481 where (these,rest) = span (<32) slots
483 | size >= 32 = all_ones
484 | otherwise = mkBS [0..size-1]
486 all_ones = mkBS [0..31]
488 -- In a continuation, we want a liveness mask that starts from just after
489 -- the return address, which is on the stack at realSp.
491 buildContLivenessMask :: Name -> FCode Liveness
492 buildContLivenessMask name = do
495 frame_sp <- getStackFrame
496 -- realSp points to the frame-header for the current stack frame,
497 -- and the end of this frame is frame_sp. The size is therefore
498 -- realSp - frame_sp - 1 (subtract one for the frame-header).
499 let frame_size = realSp - frame_sp - 1
501 mask <- buildLivenessMask frame_size (realSp-1)
503 let liveness = Liveness (mkBitmapLabel name) frame_size mask
504 absC (CBitmap liveness)
508 %************************************************************************
510 \subsection[CgMonad-deadslots]{Finding dead stack slots}
512 %************************************************************************
514 nukeDeadBindings does the following:
516 - Removes all bindings from the environment other than those
517 for variables in the argument to nukeDeadBindings.
518 - Collects any stack slots so freed, and returns them to the stack free
520 - Moves the virtual stack pointer to point to the topmost used
523 You can have multi-word slots on the stack (where a Double# used to
524 be, for instance); if dead, such a slot will be reported as *several*
525 offsets (one per word).
527 Probably *naughty* to look inside monad...
530 nukeDeadBindings :: StgLiveVars -- All the *live* variables
532 nukeDeadBindings live_vars = do
534 let (dead_stk_slots, bs') =
537 [ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ]
538 setBinds $ mkVarEnv bs'
539 freeStackSlots dead_stk_slots
542 Several boring auxiliary functions to do the dirty work.
545 dead_slots :: StgLiveVars
549 -> ([VirtualSpOffset], [(Id,CgIdInfo)])
551 -- dead_slots carries accumulating parameters for
552 -- filtered bindings, dead slots
553 dead_slots live_vars fbs ds []
554 = (ds, reverse fbs) -- Finished; rm the dups, if any
556 dead_slots live_vars fbs ds ((v,i):bs)
557 | v `elementOfUniqSet` live_vars
558 = dead_slots live_vars ((v,i):fbs) ds bs
559 -- Live, so don't record it in dead slots
560 -- Instead keep it in the filtered bindings
564 MkCgIdInfo _ _ stable_loc _
565 | is_stk_loc && size > 0 ->
566 dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
568 maybe_stk_loc = maybeStkLoc stable_loc
569 is_stk_loc = maybeToBool maybe_stk_loc
570 (Just offset) = maybe_stk_loc
572 _ -> dead_slots live_vars fbs ds bs
576 size = (getPrimRepSize . typePrimRep . idType) v