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 searching the environment
439 for all the pointer variables, and subtracting these from a bitmap
440 with initially all bits set (up to the size of the stack frame).
444 :: VirtualSpOffset -- size of the stack frame
445 -> VirtualSpOffset -- offset from which the bitmap should start
446 -> FCode Bitmap -- mask for free/unlifted slots
448 buildLivenessMask size sp = do {
449 -- find all live stack-resident pointers
451 ((vsp, _, free, _, _), heap_usage) <- getUsage;
454 rel_slots = sortLt (<)
455 [ sp - ofs -- get slots relative to top of frame
456 | (MkCgIdInfo id _ (VirStkLoc ofs) _) <- rngVarEnv binds,
457 isFollowableRep (idPrimRep id)
461 ASSERT(all (>=0) rel_slots)
462 return (intsToReverseBitmap size rel_slots)
465 -- In a continuation, we want a liveness mask that starts from just after
466 -- the return address, which is on the stack at realSp.
468 buildContLivenessMask :: Name -> FCode Liveness
469 buildContLivenessMask name = do
472 frame_sp <- getStackFrame
473 -- realSp points to the frame-header for the current stack frame,
474 -- and the end of this frame is frame_sp. The size is therefore
475 -- realSp - frame_sp - 1 (subtract one for the frame-header).
476 let frame_size = realSp - frame_sp - 1
478 mask <- buildLivenessMask frame_size (realSp-1)
480 let liveness = Liveness (mkBitmapLabel name) frame_size mask
481 absC (maybeLargeBitmap liveness)
485 %************************************************************************
487 \subsection[CgMonad-deadslots]{Finding dead stack slots}
489 %************************************************************************
491 nukeDeadBindings does the following:
493 - Removes all bindings from the environment other than those
494 for variables in the argument to nukeDeadBindings.
495 - Collects any stack slots so freed, and returns them to the stack free
497 - Moves the virtual stack pointer to point to the topmost used
500 You can have multi-word slots on the stack (where a Double# used to
501 be, for instance); if dead, such a slot will be reported as *several*
502 offsets (one per word).
504 Probably *naughty* to look inside monad...
507 nukeDeadBindings :: StgLiveVars -- All the *live* variables
509 nukeDeadBindings live_vars = do
511 let (dead_stk_slots, bs') =
514 [ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ]
515 setBinds $ mkVarEnv bs'
516 freeStackSlots dead_stk_slots
519 Several boring auxiliary functions to do the dirty work.
522 dead_slots :: StgLiveVars
526 -> ([VirtualSpOffset], [(Id,CgIdInfo)])
528 -- dead_slots carries accumulating parameters for
529 -- filtered bindings, dead slots
530 dead_slots live_vars fbs ds []
531 = (ds, reverse fbs) -- Finished; rm the dups, if any
533 dead_slots live_vars fbs ds ((v,i):bs)
534 | v `elementOfUniqSet` live_vars
535 = dead_slots live_vars ((v,i):fbs) ds bs
536 -- Live, so don't record it in dead slots
537 -- Instead keep it in the filtered bindings
541 MkCgIdInfo _ _ stable_loc _
542 | is_stk_loc && size > 0 ->
543 dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
545 maybe_stk_loc = maybeStkLoc stable_loc
546 is_stk_loc = maybeToBool maybe_stk_loc
547 (Just offset) = maybe_stk_loc
549 _ -> dead_slots live_vars fbs ds bs
553 size = (getPrimRepSize . typePrimRep . idType) v