X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgBindery.lhs;h=0f858777c273f06eafbdbb6f49eeea8c12c2afaa;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=b195b5c8645d67f97953657e2edbd486a5c14bdd;hpb=553e90d9a32ee1b1809430f260c401cc4169c6c7;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs index b195b5c..0f85877 100644 --- a/ghc/compiler/codeGen/CgBindery.lhs +++ b/ghc/compiler/codeGen/CgBindery.lhs @@ -8,49 +8,49 @@ module CgBindery ( CgBindings, CgIdInfo, StableLoc, VolatileLoc, - stableAmodeIdInfo, heapIdInfo, + cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF, + + stableIdInfo, heapIdInfo, letNoEscapeIdInfo, idInfoToAmode, addBindC, addBindsC, nukeVolatileBinds, nukeDeadBindings, + getLiveStackSlots, - bindNewToStack, rebindToStack, + bindArgsToStack, rebindToStack, bindNewToNode, bindNewToReg, bindArgsToRegs, bindNewToTemp, - getArgAmode, getArgAmodes, - getCAddrModeAndInfo, getCAddrMode, + getArgAmode, getArgAmodes, + getCgIdInfo, getCAddrModeIfVolatile, getVolatileRegs, - - buildContLivenessMask + maybeLetNoEscape, ) where #include "HsVersions.h" -import AbsCSyn import CgMonad - -import CgUsages ( getHpRelOffset, getSpRelOffset, getRealSp ) -import CgStackery ( freeStackSlots, getStackFrame ) -import CLabel ( mkClosureLabel, - mkBitmapLabel, pprCLabel ) +import CgHeapery ( getHpRelOffset ) +import CgStackery ( freeStackSlots, getSpRelOffset ) +import CgUtils ( cgLit, cmmOffsetW ) +import CLabel ( mkClosureLabel, pprCLabel ) import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo ) -import Bitmap -import PrimRep ( isFollowableRep, getPrimRepSize ) -import Id ( Id, idPrimRep, idType ) -import Type ( typePrimRep ) + +import Cmm +import PprCmm ( {- instance Outputable -} ) +import SMRep ( CgRep(..), WordOff, isFollowableArg, + isVoidArg, cgRepSizeW, argMachRep, + idCgRep, typeCgRep ) +import Id ( Id, idName ) import VarEnv import VarSet ( varSetElems ) -import Literal ( Literal ) -import Maybes ( catMaybes, maybeToBool, seqMaybe ) -import Name ( isInternalName, NamedThing(..) ) -import PprAbsC ( pprAmode, pprMagicId ) -import PrimRep ( PrimRep(..) ) +import Literal ( literalType ) +import Maybes ( catMaybes ) +import Name ( isExternalName ) import StgSyn ( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg ) -import Unique ( Unique, Uniquable(..) ) +import Unique ( Uniquable(..) ) import UniqSet ( elementOfUniqSet ) -import Util ( zipWithEqual, sortLt ) import Outputable \end{code} @@ -73,22 +73,30 @@ environment. So there can be two bindings for a given name. type CgBindings = IdEnv CgIdInfo data CgIdInfo - = MkCgIdInfo Id -- Id that this is the info for - VolatileLoc - StableLoc - LambdaFormInfo + = CgIdInfo + { cg_id :: Id -- Id that this is the info for + -- Can differ from the Id at occurrence sites by + -- virtue of being externalised, for splittable C + , cg_rep :: CgRep + , cg_vol :: VolatileLoc + , cg_stb :: StableLoc + , cg_lf :: LambdaFormInfo } + +mkCgIdInfo id vol stb lf + = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, + cg_lf = lf, cg_rep = idCgRep id } + +voidIdInfo id = CgIdInfo { cg_id = id, cg_vol = NoVolatileLoc + , cg_stb = VoidLoc, cg_lf = mkLFArgument id + , cg_rep = VoidArg } + -- Used just for VoidRep things data VolatileLoc = NoVolatileLoc - | TempVarLoc Unique - - | RegLoc MagicId -- in one of the magic registers - -- (probably {Int,Float,Char,etc}Reg) - - | VirHpLoc VirtualHeapOffset -- Hp+offset (address of closure) - - | VirNodeLoc VirtualHeapOffset -- Cts of offset indirect from Node - -- ie *(Node+offset) + | RegLoc CmmReg -- In one of the registers (global or local) + | VirHpLoc VirtualHpOffset -- Hp+offset (address of closure) + | VirNodeLoc VirtualHpOffset -- Cts of offset indirect from Node + -- ie *(Node+offset) \end{code} @StableLoc@ encodes where an Id can be found, used by @@ -97,33 +105,37 @@ the @CgBindings@ environment in @CgBindery@. \begin{code} data StableLoc = NoStableLoc - | VirStkLoc VirtualSpOffset - | LitLoc Literal - | StableAmodeLoc CAddrMode --- these are so StableLoc can be abstract: + | VirStkLoc VirtualSpOffset -- The thing is held in this + -- stack slot -maybeStkLoc (VirStkLoc offset) = Just offset -maybeStkLoc _ = Nothing + | VirStkLNE VirtualSpOffset -- A let-no-escape thing; the + -- value is this stack pointer + -- (as opposed to the contents of the slot) + + | StableLoc CmmExpr + | VoidLoc -- Used only for VoidRep variables. They never need to + -- be saved, so it makes sense to treat treat them as + -- having a stable location \end{code} \begin{code} instance Outputable CgIdInfo where - ppr (MkCgIdInfo id vol stb lf) + ppr (CgIdInfo id rep vol stb lf) = ppr id <+> ptext SLIT("-->") <+> vcat [ppr vol, ppr stb] instance Outputable VolatileLoc where ppr NoVolatileLoc = empty - ppr (TempVarLoc u) = ptext SLIT("tmp") <+> ppr u - ppr (RegLoc r) = ptext SLIT("reg") <+> pprMagicId r - ppr (VirHpLoc v) = ptext SLIT("vh") <+> ppr v - ppr (VirNodeLoc v) = ptext SLIT("vn") <+> ppr v + ppr (RegLoc r) = ptext SLIT("reg") <+> ppr r + ppr (VirHpLoc v) = ptext SLIT("vh") <+> ppr v + ppr (VirNodeLoc v) = ptext SLIT("vn") <+> ppr v instance Outputable StableLoc where - ppr NoStableLoc = empty - ppr (VirStkLoc v) = ptext SLIT("vs") <+> ppr v - ppr (LitLoc l) = ptext SLIT("lit") <+> ppr l - ppr (StableAmodeLoc a) = ptext SLIT("amode") <+> pprAmode a + ppr NoStableLoc = empty + ppr VoidLoc = ptext SLIT("void") + ppr (VirStkLoc v) = ptext SLIT("vs") <+> ppr v + ppr (VirStkLNE v) = ptext SLIT("lne") <+> ppr v + ppr (StableLoc a) = ptext SLIT("amode") <+> ppr a \end{code} %************************************************************************ @@ -133,41 +145,49 @@ instance Outputable StableLoc where %************************************************************************ \begin{code} -stableAmodeIdInfo i amode lf_info = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc amode) lf_info -heapIdInfo i offset lf_info = MkCgIdInfo i (VirHpLoc offset) NoStableLoc lf_info -tempIdInfo i uniq lf_info = MkCgIdInfo i (TempVarLoc uniq) NoStableLoc lf_info - -letNoEscapeIdInfo i sp lf_info - = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc (CJoinPoint sp)) lf_info - -idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode -idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab - -idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode - -idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc = returnFC (CTemp uniq kind) -idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc = returnFC (CReg magic_id) - -idInfoPiecesToAmode kind NoVolatileLoc (LitLoc lit) = returnFC (CLit lit) -idInfoPiecesToAmode kind NoVolatileLoc (StableAmodeLoc amode) = returnFC amode +stableIdInfo id amode lf_info = mkCgIdInfo id NoVolatileLoc (StableLoc amode) lf_info +heapIdInfo id offset lf_info = mkCgIdInfo id (VirHpLoc offset) NoStableLoc lf_info +letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_info +stackIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info +nodeIdInfo id offset lf_info = mkCgIdInfo id (VirNodeLoc offset) NoStableLoc lf_info +regIdInfo id reg lf_info = mkCgIdInfo id (RegLoc reg) NoStableLoc lf_info + +idInfoToAmode :: CgIdInfo -> FCode CmmExpr +idInfoToAmode info + = case cg_vol info of { + RegLoc reg -> returnFC (CmmReg reg) ; + VirNodeLoc nd_off -> returnFC (CmmLoad (cmmOffsetW (CmmReg nodeReg) nd_off) mach_rep) ; + VirHpLoc hp_off -> getHpRelOffset hp_off ; + NoVolatileLoc -> + + case cg_stb info of + StableLoc amode -> returnFC amode + VirStkLoc sp_off -> do { sp_rel <- getSpRelOffset sp_off + ; return (CmmLoad sp_rel mach_rep) } + + VirStkLNE sp_off -> getSpRelOffset sp_off ; + + VoidLoc -> return $ pprPanic "idInfoToAmode: void" (ppr (cg_id info)) + -- We return a 'bottom' amode, rather than panicing now + -- In this way getArgAmode returns a pair of (VoidArg, bottom) + -- and that's exactly what we want + + NoStableLoc -> pprPanic "idInfoToAmode: no loc" (ppr (cg_id info)) + } + where + mach_rep = argMachRep (cg_rep info) -idInfoPiecesToAmode kind (VirNodeLoc nd_off) stable_loc - = returnFC (CVal (nodeRel nd_off) kind) - -- Virtual offsets from Node increase into the closures, - -- and so do Node-relative offsets (which we want in the CVal), - -- so there is no mucking about to do to the offset. +cgIdInfoId :: CgIdInfo -> Id +cgIdInfoId = cg_id -idInfoPiecesToAmode kind (VirHpLoc hp_off) stable_loc - = getHpRelOffset hp_off `thenFC` \ rel_hp -> - returnFC (CAddr rel_hp) +cgIdInfoLF :: CgIdInfo -> LambdaFormInfo +cgIdInfoLF = cg_lf -idInfoPiecesToAmode kind NoVolatileLoc (VirStkLoc i) - = getSpRelOffset i `thenFC` \ rel_sp -> - returnFC (CVal rel_sp kind) +cgIdInfoArgRep :: CgIdInfo -> CgRep +cgIdInfoArgRep = cg_rep -#ifdef DEBUG -idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc" -#endif +maybeLetNoEscape (CgIdInfo { cg_stb = VirStkLNE sp_off }) = Just sp_off +maybeLetNoEscape other = Nothing \end{code} %************************************************************************ @@ -176,8 +196,8 @@ idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: %* * %************************************************************************ -There are three basic routines, for adding (@addBindC@), modifying -(@modifyBindC@) and looking up (@lookupBindC@) bindings. +.There are three basic routines, for adding (@addBindC@), modifying +(@modifyBindC@) and looking up (@getCgIdInfo@) bindings. A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple. The name should not already be bound. (nice ASSERT, eh?) @@ -192,8 +212,8 @@ addBindsC :: [(Id, CgIdInfo)] -> Code addBindsC new_bindings = do binds <- getBinds let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info) - binds - new_bindings + binds + new_bindings setBinds new_binds modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code @@ -201,19 +221,34 @@ modifyBindC name mangle_fn = do binds <- getBinds setBinds $ modifyVarEnv mangle_fn binds name -lookupBindC :: Id -> FCode CgIdInfo -lookupBindC id = do maybe_info <- lookupBindC_maybe id - case maybe_info of - Just info -> return info - Nothing -> cgLookupPanic id - -lookupBindC_maybe :: Id -> FCode (Maybe CgIdInfo) -lookupBindC_maybe id - = do static_binds <- getStaticBinds - local_binds <- getBinds - return (lookupVarEnv local_binds id - `seqMaybe` - lookupVarEnv static_binds id) +getCgIdInfo :: Id -> FCode CgIdInfo +getCgIdInfo id + = do { -- Try local bindings first + ; local_binds <- getBinds + ; case lookupVarEnv local_binds id of { + Just info -> return info ; + Nothing -> do + + { -- Try top-level bindings + static_binds <- getStaticBinds + ; case lookupVarEnv static_binds id of { + Just info -> return info ; + Nothing -> + + -- Should be imported; make up a CgIdInfo for it + if isExternalName name then + return (stableIdInfo id ext_lbl (mkLFImported id)) + else + if isVoidArg (idCgRep id) then + -- Void things are never in the environment + return (voidIdInfo id) + else + -- Bug + cgLookupPanic id + }}}} + where + name = idName id + ext_lbl = CmmLit (CmmLabel (mkClosureLabel name)) cgLookupPanic :: Id -> FCode a cgLookupPanic id @@ -223,9 +258,9 @@ cgLookupPanic id pprPanic "cgPanic" (vcat [ppr id, ptext SLIT("static binds for:"), - vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv static_binds ], + vcat [ ppr (cg_id info) | info <- rngVarEnv static_binds ], ptext SLIT("local binds for:"), - vcat [ ppr i | (MkCgIdInfo i _ _ _) <- rngVarEnv local_binds ], + vcat [ ppr (cg_id info) | info <- rngVarEnv local_binds ], ptext SLIT("SRT label") <+> pprCLabel srt ]) \end{code} @@ -244,9 +279,9 @@ nukeVolatileBinds :: CgBindings -> CgBindings nukeVolatileBinds binds = mkVarEnv (foldr keep_if_stable [] (rngVarEnv binds)) where - keep_if_stable (MkCgIdInfo i _ NoStableLoc entry_info) acc = acc - keep_if_stable (MkCgIdInfo i _ stable_loc entry_info) acc - = (i, MkCgIdInfo i NoVolatileLoc stable_loc entry_info) : acc + keep_if_stable (CgIdInfo { cg_stb = NoStableLoc }) acc = acc + keep_if_stable info acc + = (cg_id info, info { cg_vol = NoVolatileLoc }) : acc \end{code} @@ -256,46 +291,15 @@ nukeVolatileBinds binds %* * %************************************************************************ -I {\em think} all looking-up is done through @getCAddrMode(s)@. - \begin{code} -getCAddrModeAndInfo :: Id -> FCode (Id, CAddrMode, LambdaFormInfo) - -getCAddrModeAndInfo id - = do - maybe_cg_id_info <- lookupBindC_maybe id - case maybe_cg_id_info of - - -- Nothing => not in the environment, so should be imported - Nothing | isInternalName name -> cgLookupPanic id - | otherwise -> returnFC (id, global_amode, mkLFImported id) - - Just (MkCgIdInfo id' volatile_loc stable_loc lf_info) - -> do amode <- idInfoPiecesToAmode kind volatile_loc stable_loc - return (id', amode, lf_info) - where - name = getName id - global_amode = CLbl (mkClosureLabel name) kind - kind = idPrimRep id - -getCAddrMode :: Id -> FCode CAddrMode -getCAddrMode name = do - (_, amode, _) <- getCAddrModeAndInfo name - return amode -\end{code} - -\begin{code} -getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode) -getCAddrModeIfVolatile name --- | toplevelishId name = returnFC Nothing --- | otherwise - = do - (MkCgIdInfo _ volatile_loc stable_loc lf_info) <- lookupBindC name - case stable_loc of +getCAddrModeIfVolatile :: Id -> FCode (Maybe CmmExpr) +getCAddrModeIfVolatile id + = do { info <- getCgIdInfo id + ; case cg_stb info of NoStableLoc -> do -- Aha! So it is volatile! - amode <- idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc + amode <- idInfoToAmode info return $ Just amode - a_stable_loc -> return Nothing + a_stable_loc -> return Nothing } \end{code} @getVolatileRegs@ gets a set of live variables, and returns a list of @@ -306,56 +310,57 @@ stable one (notably, on the stack), we modify the current bindings to forget the volatile one. \begin{code} -getVolatileRegs :: StgLiveVars -> FCode [MagicId] +getVolatileRegs :: StgLiveVars -> FCode [GlobalReg] getVolatileRegs vars = do - stuff <- mapFCs snaffle_it (varSetElems vars) - returnFC $ catMaybes stuff - where - snaffle_it var = do - (MkCgIdInfo _ volatile_loc stable_loc lf_info) <- lookupBindC var - let + do { stuff <- mapFCs snaffle_it (varSetElems vars) + ; returnFC $ catMaybes stuff } + where + snaffle_it var = do + { info <- getCgIdInfo var + ; let -- commoned-up code... - consider_reg reg = - if not (isVolatileReg reg) then - -- Potentially dies across C calls - -- For now, that's everything; we leave - -- it to the save-macros to decide which - -- regs *really* need to be saved. - returnFC Nothing - else - case stable_loc of - NoStableLoc -> returnFC (Just reg) -- got one! - is_a_stable_loc -> do - -- has both volatile & stable locations; - -- force it to rely on the stable location - modifyBindC var nuke_vol_bind - return Nothing - in - case volatile_loc of - RegLoc reg -> consider_reg reg - VirNodeLoc _ -> consider_reg node - non_reg_loc -> returnFC Nothing - - nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info) - = MkCgIdInfo i NoVolatileLoc stable_loc lf_info + consider_reg reg + = -- We assume that all regs can die across C calls + -- We leave it to the save-macros to decide which + -- regs *really* need to be saved. + case cg_stb info of + NoStableLoc -> returnFC (Just reg) -- got one! + is_a_stable_loc -> do + { -- has both volatile & stable locations; + -- force it to rely on the stable location + modifyBindC var nuke_vol_bind + ; return Nothing } + + ; case cg_vol info of + RegLoc (CmmGlobal reg) -> consider_reg reg + VirNodeLoc _ -> consider_reg node + other_loc -> returnFC Nothing -- Local registers + } + + nuke_vol_bind info = info { cg_vol = NoVolatileLoc } \end{code} \begin{code} -getArgAmodes :: [StgArg] -> FCode [CAddrMode] -getArgAmodes [] = returnFC [] -getArgAmodes (atom:atoms) - | isStgTypeArg atom - = getArgAmodes atoms - | otherwise = do - amode <- getArgAmode atom - amodes <- getArgAmodes atoms - return ( amode : amodes ) +getArgAmode :: StgArg -> FCode (CgRep, CmmExpr) +getArgAmode (StgVarArg var) + = do { info <- getCgIdInfo var + ; amode <- idInfoToAmode info + ; return (cgIdInfoArgRep info, amode ) } -getArgAmode :: StgArg -> FCode CAddrMode +getArgAmode (StgLitArg lit) + = do { cmm_lit <- cgLit lit + ; return (typeCgRep (literalType lit), CmmLit cmm_lit) } -getArgAmode (StgVarArg var) = getCAddrMode var -- The common case -getArgAmode (StgLitArg lit) = returnFC (CLit lit) +getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg" + +getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)] +getArgAmodes [] = returnFC [] +getArgAmodes (atom:atoms) + | isStgTypeArg atom = getArgAmodes atoms + | otherwise = do { amode <- getArgAmode atom + ; amodes <- getArgAmodes atoms + ; return ( amode : amodes ) } \end{code} %************************************************************************ @@ -365,43 +370,40 @@ getArgAmode (StgLitArg lit) = returnFC (CLit lit) %************************************************************************ \begin{code} -bindNewToStack :: (Id, VirtualSpOffset) -> Code -bindNewToStack (name, offset) - = addBindC name info +bindArgsToStack :: [(Id, VirtualSpOffset)] -> Code +bindArgsToStack args + = mapCs bind args where - info = MkCgIdInfo name NoVolatileLoc (VirStkLoc offset) (mkLFArgument name) + bind(id, offset) = addBindC id (stackIdInfo id offset (mkLFArgument id)) -bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code -bindNewToNode name offset lf_info - = addBindC name info +bindArgsToRegs :: [(Id, GlobalReg)] -> Code +bindArgsToRegs args + = mapCs bind args where - info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info + bind (arg, reg) = bindNewToReg arg (CmmGlobal reg) (mkLFArgument arg) + +bindNewToNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Code +bindNewToNode id offset lf_info + = addBindC id (nodeIdInfo id offset lf_info) -- Create a new temporary whose unique is that in the id, -- bind the id to it, and return the addressing mode for the -- temporary. -bindNewToTemp :: Id -> FCode CAddrMode +bindNewToTemp :: Id -> FCode CmmReg bindNewToTemp id - = do addBindC id id_info - return temp_amode - where - uniq = getUnique id - temp_amode = CTemp uniq (idPrimRep id) - id_info = tempIdInfo id uniq lf_info - lf_info = mkLFArgument id -- Always used of things we - -- know nothing about - -bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code -bindNewToReg name magic_id lf_info - = addBindC name info + = do addBindC id (regIdInfo id temp_reg lf_info) + return temp_reg where - info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info + uniq = getUnique id + temp_reg = CmmLocal (LocalReg uniq (argMachRep (idCgRep id))) + lf_info = mkLFArgument id -- Always used of things we + -- know nothing about -bindArgsToRegs :: [Id] -> [MagicId] -> Code -bindArgsToRegs args regs - = listCs (zipWithEqual "bindArgsToRegs" bind args regs) +bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code +bindNewToReg name reg lf_info + = addBindC name info where - arg `bind` reg = bindNewToReg arg reg (mkLFArgument arg) + info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info \end{code} \begin{code} @@ -409,69 +411,7 @@ rebindToStack :: Id -> VirtualSpOffset -> Code rebindToStack name offset = modifyBindC name replace_stable_fn where - replace_stable_fn (MkCgIdInfo i vol stab einfo) - = MkCgIdInfo i vol (VirStkLoc offset) einfo -\end{code} - -%************************************************************************ -%* * -\subsection[CgBindery-liveness]{Build a liveness mask for the current stack} -%* * -%************************************************************************ - -There are four kinds of things on the stack: - - - pointer variables (bound in the environment) - - non-pointer variables (boudn in the environment) - - free slots (recorded in the stack free list) - - non-pointer data slots (recorded in the stack free list) - -We build up a bitmap of non-pointer slots by searching the environment -for all the pointer variables, and subtracting these from a bitmap -with initially all bits set (up to the size of the stack frame). - -\begin{code} -buildLivenessMask - :: VirtualSpOffset -- size of the stack frame - -> VirtualSpOffset -- offset from which the bitmap should start - -> FCode Bitmap -- mask for free/unlifted slots - -buildLivenessMask size sp = do { - -- find all live stack-resident pointers - binds <- getBinds; - ((vsp, _, free, _, _), heap_usage) <- getUsage; - - let { - rel_slots = sortLt (<) - [ sp - ofs -- get slots relative to top of frame - | (MkCgIdInfo id _ (VirStkLoc ofs) _) <- rngVarEnv binds, - isFollowableRep (idPrimRep id) - ]; - }; - - WARN( not (all (>=0) rel_slots), ppr size $$ ppr sp $$ ppr rel_slots $$ ppr binds ) - return (intsToReverseBitmap size rel_slots) - } - --- In a continuation, we want a liveness mask that starts from just after --- the return address, which is on the stack at realSp. - -buildContLivenessMask :: Id -> FCode Liveness - -- The Id is used just for its unique to make a label -buildContLivenessMask id = do - realSp <- getRealSp - - frame_sp <- getStackFrame - -- realSp points to the frame-header for the current stack frame, - -- and the end of this frame is frame_sp. The size is therefore - -- realSp - frame_sp - 1 (subtract one for the frame-header). - let frame_size = realSp - frame_sp - 1 - - mask <- buildLivenessMask frame_size (realSp-1) - - let liveness = Liveness (mkBitmapLabel (getName id)) frame_size mask - absC (maybeLargeBitmap liveness) - return liveness + replace_stable_fn info = info { cg_stb = VirStkLoc offset } \end{code} %************************************************************************ @@ -503,7 +443,7 @@ nukeDeadBindings live_vars = do let (dead_stk_slots, bs') = dead_slots live_vars [] [] - [ (i, b) | b@(MkCgIdInfo i _ _ _) <- rngVarEnv binds ] + [ (cg_id b, b) | b <- rngVarEnv binds ] setBinds $ mkVarEnv bs' freeStackSlots dead_stk_slots \end{code} @@ -529,19 +469,23 @@ dead_slots live_vars fbs ds ((v,i):bs) -- Instead keep it in the filtered bindings | otherwise - = case i of - MkCgIdInfo _ _ stable_loc _ - | is_stk_loc && size > 0 -> - dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs - where - maybe_stk_loc = maybeStkLoc stable_loc - is_stk_loc = maybeToBool maybe_stk_loc - (Just offset) = maybe_stk_loc + = case cg_stb i of + VirStkLoc offset + | size > 0 + -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs _ -> dead_slots live_vars fbs ds bs where + size :: WordOff + size = cgRepSizeW (cg_rep i) +\end{code} - size :: Int - size = (getPrimRepSize . typePrimRep . idType) v - +\begin{code} +getLiveStackSlots :: FCode [VirtualSpOffset] +-- Return the offsets of slots in stack containig live pointers +getLiveStackSlots + = do { binds <- getBinds + ; return [off | CgIdInfo { cg_stb = VirStkLoc off, + cg_rep = rep } <- rngVarEnv binds, + isFollowableArg rep] } \end{code}