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,
12 letNoEscapeIdInfo, idInfoToAmode,
19 bindNewToStack, rebindToStack,
20 bindNewToNode, bindNewToReg, bindArgsToRegs,
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 ( isInternalName, NamedThing(..) )
48 import PprAbsC ( pprAmode, pprMagicId )
49 import PrimRep ( PrimRep(..) )
50 import StgSyn ( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg )
51 import Unique ( Unique, Uniquable(..) )
52 import UniqSet ( elementOfUniqSet )
53 import Util ( zipWithEqual, sortLt )
58 %************************************************************************
60 \subsection[Bindery-datatypes]{Data types}
62 %************************************************************************
64 @(CgBinding a b)@ is a type of finite maps from a to b.
66 The assumption used to be that @lookupCgBind@ must get exactly one
67 match. This is {\em completely wrong} in the case of compiling
68 letrecs (where knot-tying is used). An initial binding is fed in (and
69 never evaluated); eventually, a correct binding is put into the
70 environment. So there can be two bindings for a given name.
73 type CgBindings = IdEnv CgIdInfo
76 = MkCgIdInfo Id -- Id that this is the info for
85 | RegLoc MagicId -- in one of the magic registers
86 -- (probably {Int,Float,Char,etc}Reg)
88 | VirHpLoc VirtualHeapOffset -- Hp+offset (address of closure)
90 | VirNodeLoc VirtualHeapOffset -- Cts of offset indirect from Node
94 @StableLoc@ encodes where an Id can be found, used by
95 the @CgBindings@ environment in @CgBindery@.
100 | VirStkLoc VirtualSpOffset
102 | StableAmodeLoc CAddrMode
104 -- these are so StableLoc can be abstract:
106 maybeStkLoc (VirStkLoc offset) = Just offset
107 maybeStkLoc _ = Nothing
111 instance Outputable CgIdInfo where
112 ppr (MkCgIdInfo id vol stb lf)
113 = ppr id <+> ptext SLIT("-->") <+> vcat [ppr vol, ppr stb]
115 instance Outputable VolatileLoc where
116 ppr NoVolatileLoc = empty
117 ppr (TempVarLoc u) = ptext SLIT("tmp") <+> ppr u
118 ppr (RegLoc r) = ptext SLIT("reg") <+> pprMagicId r
119 ppr (VirHpLoc v) = ptext SLIT("vh") <+> ppr v
120 ppr (VirNodeLoc v) = ptext SLIT("vn") <+> ppr v
122 instance Outputable StableLoc where
123 ppr NoStableLoc = empty
124 ppr (VirStkLoc v) = ptext SLIT("vs") <+> ppr v
125 ppr (LitLoc l) = ptext SLIT("lit") <+> ppr l
126 ppr (StableAmodeLoc a) = ptext SLIT("amode") <+> pprAmode a
129 %************************************************************************
131 \subsection[Bindery-idInfo]{Manipulating IdInfo}
133 %************************************************************************
136 stableAmodeIdInfo i amode lf_info = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc amode) lf_info
137 heapIdInfo i offset lf_info = MkCgIdInfo i (VirHpLoc offset) NoStableLoc lf_info
138 tempIdInfo i uniq lf_info = MkCgIdInfo i (TempVarLoc uniq) NoStableLoc lf_info
140 letNoEscapeIdInfo i sp lf_info
141 = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc (CJoinPoint sp)) lf_info
143 idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode
144 idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab
146 idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode
148 idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc = returnFC (CTemp uniq kind)
149 idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc = returnFC (CReg magic_id)
151 idInfoPiecesToAmode kind NoVolatileLoc (LitLoc lit) = returnFC (CLit lit)
152 idInfoPiecesToAmode kind NoVolatileLoc (StableAmodeLoc amode) = returnFC amode
154 idInfoPiecesToAmode kind (VirNodeLoc nd_off) stable_loc
155 = returnFC (CVal (nodeRel nd_off) kind)
156 -- Virtual offsets from Node increase into the closures,
157 -- and so do Node-relative offsets (which we want in the CVal),
158 -- so there is no mucking about to do to the offset.
160 idInfoPiecesToAmode kind (VirHpLoc hp_off) stable_loc
161 = getHpRelOffset hp_off `thenFC` \ rel_hp ->
162 returnFC (CAddr rel_hp)
164 idInfoPiecesToAmode kind NoVolatileLoc (VirStkLoc i)
165 = getSpRelOffset i `thenFC` \ rel_sp ->
166 returnFC (CVal rel_sp kind)
169 idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc"
173 %************************************************************************
175 \subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
177 %************************************************************************
179 There are three basic routines, for adding (@addBindC@), modifying
180 (@modifyBindC@) and looking up (@lookupBindC@) bindings.
182 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
183 The name should not already be bound. (nice ASSERT, eh?)
186 addBindC :: Id -> CgIdInfo -> Code
187 addBindC name stuff_to_bind = do
189 setBinds $ extendVarEnv binds name stuff_to_bind
191 addBindsC :: [(Id, CgIdInfo)] -> Code
192 addBindsC new_bindings = do
194 let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
199 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
200 modifyBindC name mangle_fn = do
202 setBinds $ modifyVarEnv mangle_fn binds name
204 lookupBindC :: Id -> FCode CgIdInfo
205 lookupBindC id = do maybe_info <- lookupBindC_maybe id
207 Just info -> return info
208 Nothing -> cgLookupPanic id
210 lookupBindC_maybe :: Id -> FCode (Maybe CgIdInfo)
212 = do static_binds <- getStaticBinds
213 local_binds <- getBinds
214 return (lookupVarEnv local_binds id
216 lookupVarEnv static_binds id)
218 cgLookupPanic :: Id -> FCode a
220 = do static_binds <- getStaticBinds
221 local_binds <- getBinds
225 ptext SLIT("static binds for:"),
226 vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ],
227 ptext SLIT("local binds for:"),
228 vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv local_binds ],
229 ptext SLIT("SRT label") <+> pprCLabel srt
233 %************************************************************************
235 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
237 %************************************************************************
239 We sometimes want to nuke all the volatile bindings; we must be sure
240 we don't leave any (NoVolatile, NoStable) binds around...
243 nukeVolatileBinds :: CgBindings -> CgBindings
244 nukeVolatileBinds binds
245 = mkVarEnv (foldr keep_if_stable [] (rngVarEnv binds))
247 keep_if_stable (MkCgIdInfo i _ NoStableLoc entry_info) acc = acc
248 keep_if_stable (MkCgIdInfo i _ stable_loc entry_info) acc
249 = (i, MkCgIdInfo i NoVolatileLoc stable_loc entry_info) : acc
253 %************************************************************************
255 \subsection[lookup-interface]{Interface functions to looking up bindings}
257 %************************************************************************
259 I {\em think} all looking-up is done through @getCAddrMode(s)@.
262 getCAddrModeAndInfo :: Id -> FCode (Id, CAddrMode, LambdaFormInfo)
264 getCAddrModeAndInfo id
266 maybe_cg_id_info <- lookupBindC_maybe id
267 case maybe_cg_id_info of
269 -- Nothing => not in the environment, so should be imported
270 Nothing | isInternalName name -> cgLookupPanic id
271 | otherwise -> returnFC (id, global_amode, mkLFImported id)
273 Just (MkCgIdInfo id' volatile_loc stable_loc lf_info)
274 -> do amode <- idInfoPiecesToAmode kind volatile_loc stable_loc
275 return (id', amode, lf_info)
278 global_amode = CLbl (mkClosureLabel name) kind
281 getCAddrMode :: Id -> FCode CAddrMode
282 getCAddrMode name = do
283 (_, amode, _) <- getCAddrModeAndInfo name
288 getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode)
289 getCAddrModeIfVolatile name
290 -- | toplevelishId name = returnFC Nothing
293 (MkCgIdInfo _ volatile_loc stable_loc lf_info) <- lookupBindC name
295 NoStableLoc -> do -- Aha! So it is volatile!
296 amode <- idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc
298 a_stable_loc -> return Nothing
301 @getVolatileRegs@ gets a set of live variables, and returns a list of
302 all registers on which these variables depend. These are the regs
303 which must be saved and restored across any C calls. If a variable is
304 both in a volatile location (depending on a register) {\em and} a
305 stable one (notably, on the stack), we modify the current bindings to
306 forget the volatile one.
309 getVolatileRegs :: StgLiveVars -> FCode [MagicId]
311 getVolatileRegs vars = do
312 stuff <- mapFCs snaffle_it (varSetElems vars)
313 returnFC $ catMaybes stuff
316 (MkCgIdInfo _ volatile_loc stable_loc lf_info) <- lookupBindC var
318 -- commoned-up code...
320 if not (isVolatileReg reg) then
321 -- Potentially dies across C calls
322 -- For now, that's everything; we leave
323 -- it to the save-macros to decide which
324 -- regs *really* need to be saved.
328 NoStableLoc -> returnFC (Just reg) -- got one!
329 is_a_stable_loc -> do
330 -- has both volatile & stable locations;
331 -- force it to rely on the stable location
332 modifyBindC var nuke_vol_bind
336 RegLoc reg -> consider_reg reg
337 VirNodeLoc _ -> consider_reg node
338 non_reg_loc -> returnFC Nothing
340 nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info)
341 = MkCgIdInfo i NoVolatileLoc stable_loc lf_info
345 getArgAmodes :: [StgArg] -> FCode [CAddrMode]
346 getArgAmodes [] = returnFC []
347 getArgAmodes (atom:atoms)
351 amode <- getArgAmode atom
352 amodes <- getArgAmodes atoms
353 return ( amode : amodes )
355 getArgAmode :: StgArg -> FCode CAddrMode
357 getArgAmode (StgVarArg var) = getCAddrMode var -- The common case
358 getArgAmode (StgLitArg lit) = returnFC (CLit lit)
361 %************************************************************************
363 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
365 %************************************************************************
368 bindNewToStack :: (Id, VirtualSpOffset) -> Code
369 bindNewToStack (name, offset)
372 info = MkCgIdInfo name NoVolatileLoc (VirStkLoc offset) (mkLFArgument name)
374 bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
375 bindNewToNode name offset lf_info
378 info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info
380 -- Create a new temporary whose unique is that in the id,
381 -- bind the id to it, and return the addressing mode for the
383 bindNewToTemp :: Id -> FCode CAddrMode
385 = do addBindC id id_info
389 temp_amode = CTemp uniq (idPrimRep id)
390 id_info = tempIdInfo id uniq lf_info
391 lf_info = mkLFArgument id -- Always used of things we
392 -- know nothing about
394 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code
395 bindNewToReg name magic_id lf_info
398 info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
400 bindArgsToRegs :: [Id] -> [MagicId] -> Code
401 bindArgsToRegs args regs
402 = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
404 arg `bind` reg = bindNewToReg arg reg (mkLFArgument arg)
408 rebindToStack :: Id -> VirtualSpOffset -> Code
409 rebindToStack name offset
410 = modifyBindC name replace_stable_fn
412 replace_stable_fn (MkCgIdInfo i vol stab einfo)
413 = MkCgIdInfo i vol (VirStkLoc offset) einfo
416 %************************************************************************
418 \subsection[CgBindery-liveness]{Build a liveness mask for the current stack}
420 %************************************************************************
422 There are four kinds of things on the stack:
424 - pointer variables (bound in the environment)
425 - non-pointer variables (boudn in the environment)
426 - free slots (recorded in the stack free list)
427 - non-pointer data slots (recorded in the stack free list)
429 We build up a bitmap of non-pointer slots by searching the environment
430 for all the pointer variables, and subtracting these from a bitmap
431 with initially all bits set (up to the size of the stack frame).
435 :: VirtualSpOffset -- size of the stack frame
436 -> VirtualSpOffset -- offset from which the bitmap should start
437 -> FCode Bitmap -- mask for free/unlifted slots
439 buildLivenessMask size sp = do {
440 -- find all live stack-resident pointers
442 ((vsp, _, free, _, _), heap_usage) <- getUsage;
445 rel_slots = sortLt (<)
446 [ sp - ofs -- get slots relative to top of frame
447 | (MkCgIdInfo id _ (VirStkLoc ofs) _) <- rngVarEnv binds,
448 isFollowableRep (idPrimRep id)
452 WARN( not (all (>=0) rel_slots), ppr size $$ ppr sp $$ ppr rel_slots $$ ppr binds )
453 return (intsToReverseBitmap size rel_slots)
456 -- In a continuation, we want a liveness mask that starts from just after
457 -- the return address, which is on the stack at realSp.
459 buildContLivenessMask :: Id -> FCode Liveness
460 -- The Id is used just for its unique to make a label
461 buildContLivenessMask id = do
464 frame_sp <- getStackFrame
465 -- realSp points to the frame-header for the current stack frame,
466 -- and the end of this frame is frame_sp. The size is therefore
467 -- realSp - frame_sp - 1 (subtract one for the frame-header).
468 let frame_size = realSp - frame_sp - 1
470 mask <- buildLivenessMask frame_size (realSp-1)
472 let liveness = Liveness (mkBitmapLabel (getName id)) frame_size mask
473 absC (maybeLargeBitmap liveness)
477 %************************************************************************
479 \subsection[CgMonad-deadslots]{Finding dead stack slots}
481 %************************************************************************
483 nukeDeadBindings does the following:
485 - Removes all bindings from the environment other than those
486 for variables in the argument to nukeDeadBindings.
487 - Collects any stack slots so freed, and returns them to the stack free
489 - Moves the virtual stack pointer to point to the topmost used
492 You can have multi-word slots on the stack (where a Double# used to
493 be, for instance); if dead, such a slot will be reported as *several*
494 offsets (one per word).
496 Probably *naughty* to look inside monad...
499 nukeDeadBindings :: StgLiveVars -- All the *live* variables
501 nukeDeadBindings live_vars = do
503 let (dead_stk_slots, bs') =
506 [ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ]
507 setBinds $ mkVarEnv bs'
508 freeStackSlots dead_stk_slots
511 Several boring auxiliary functions to do the dirty work.
514 dead_slots :: StgLiveVars
518 -> ([VirtualSpOffset], [(Id,CgIdInfo)])
520 -- dead_slots carries accumulating parameters for
521 -- filtered bindings, dead slots
522 dead_slots live_vars fbs ds []
523 = (ds, reverse fbs) -- Finished; rm the dups, if any
525 dead_slots live_vars fbs ds ((v,i):bs)
526 | v `elementOfUniqSet` live_vars
527 = dead_slots live_vars ((v,i):fbs) ds bs
528 -- Live, so don't record it in dead slots
529 -- Instead keep it in the filtered bindings
533 MkCgIdInfo _ _ stable_loc _
534 | is_stk_loc && size > 0 ->
535 dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
537 maybe_stk_loc = maybeStkLoc stable_loc
538 is_stk_loc = maybeToBool maybe_stk_loc
539 (Just offset) = maybe_stk_loc
541 _ -> dead_slots live_vars fbs ds bs
545 size = (getPrimRepSize . typePrimRep . idType) v