1{-# LANGUAGE CPP #-} 2 3----------------------------------------------------------------------------- 4-- 5-- Stg to C-- code generation: the binding environment 6-- 7-- (c) The University of Glasgow 2004-2006 8-- 9----------------------------------------------------------------------------- 10module GHC.StgToCmm.Env ( 11 CgIdInfo, 12 13 litIdInfo, lneIdInfo, rhsIdInfo, mkRhsInit, 14 idInfoToAmode, 15 16 addBindC, addBindsC, 17 18 bindArgsToRegs, bindToReg, rebindToReg, 19 bindArgToReg, idToReg, 20 getArgAmode, getNonVoidArgAmodes, 21 getCgIdInfo, 22 maybeLetNoEscape, 23 ) where 24 25#include "HsVersions.h" 26 27import GhcPrelude 28 29import TyCon 30import GHC.StgToCmm.Monad 31import GHC.StgToCmm.Utils 32import GHC.StgToCmm.Closure 33 34import CLabel 35 36import BlockId 37import CmmExpr 38import CmmUtils 39import DynFlags 40import Id 41import MkGraph 42import Name 43import Outputable 44import StgSyn 45import Type 46import TysPrim 47import UniqFM 48import Util 49import VarEnv 50 51------------------------------------- 52-- Manipulating CgIdInfo 53------------------------------------- 54 55mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo 56mkCgIdInfo id lf expr 57 = CgIdInfo { cg_id = id, cg_lf = lf 58 , cg_loc = CmmLoc expr } 59 60litIdInfo :: DynFlags -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo 61litIdInfo dflags id lf lit 62 = CgIdInfo { cg_id = id, cg_lf = lf 63 , cg_loc = CmmLoc (addDynTag dflags (CmmLit lit) tag) } 64 where 65 tag = lfDynTag dflags lf 66 67lneIdInfo :: DynFlags -> Id -> [NonVoid Id] -> CgIdInfo 68lneIdInfo dflags id regs 69 = CgIdInfo { cg_id = id, cg_lf = lf 70 , cg_loc = LneLoc blk_id (map (idToReg dflags) regs) } 71 where 72 lf = mkLFLetNoEscape 73 blk_id = mkBlockId (idUnique id) 74 75 76rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg) 77rhsIdInfo id lf_info 78 = do dflags <- getDynFlags 79 reg <- newTemp (gcWord dflags) 80 return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg) 81 82mkRhsInit :: DynFlags -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph 83mkRhsInit dflags reg lf_info expr 84 = mkAssign (CmmLocal reg) (addDynTag dflags expr (lfDynTag dflags lf_info)) 85 86idInfoToAmode :: CgIdInfo -> CmmExpr 87-- Returns a CmmExpr for the *tagged* pointer 88idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e 89idInfoToAmode cg_info 90 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc 91 92addDynTag :: DynFlags -> CmmExpr -> DynTag -> CmmExpr 93-- A tag adds a byte offset to the pointer 94addDynTag dflags expr tag = cmmOffsetB dflags expr tag 95 96maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg]) 97maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args) 98maybeLetNoEscape _other = Nothing 99 100 101 102--------------------------------------------------------- 103-- The binding environment 104-- 105-- There are three basic routines, for adding (addBindC), 106-- modifying(modifyBindC) and looking up (getCgIdInfo) bindings. 107--------------------------------------------------------- 108 109addBindC :: CgIdInfo -> FCode () 110addBindC stuff_to_bind = do 111 binds <- getBinds 112 setBinds $ extendVarEnv binds (cg_id stuff_to_bind) stuff_to_bind 113 114addBindsC :: [CgIdInfo] -> FCode () 115addBindsC new_bindings = do 116 binds <- getBinds 117 let new_binds = foldl' (\ binds info -> extendVarEnv binds (cg_id info) info) 118 binds 119 new_bindings 120 setBinds new_binds 121 122getCgIdInfo :: Id -> FCode CgIdInfo 123getCgIdInfo id 124 = do { dflags <- getDynFlags 125 ; local_binds <- getBinds -- Try local bindings first 126 ; case lookupVarEnv local_binds id of { 127 Just info -> return info ; 128 Nothing -> do { 129 130 -- Should be imported; make up a CgIdInfo for it 131 let name = idName id 132 ; if isExternalName name then 133 let ext_lbl 134 | isUnliftedType (idType id) = 135 -- An unlifted external Id must refer to a top-level 136 -- string literal. See Note [Bytes label] in CLabel. 137 ASSERT( idType id `eqType` addrPrimTy ) 138 mkBytesLabel name 139 | otherwise = mkClosureLabel name $ idCafInfo id 140 in return $ 141 litIdInfo dflags id (mkLFImported id) (CmmLabel ext_lbl) 142 else 143 cgLookupPanic id -- Bug 144 }}} 145 146cgLookupPanic :: Id -> FCode a 147cgLookupPanic id 148 = do local_binds <- getBinds 149 pprPanic "GHC.StgToCmm.Env: variable not found" 150 (vcat [ppr id, 151 text "local binds for:", 152 pprUFM local_binds $ \infos -> 153 vcat [ ppr (cg_id info) | info <- infos ] 154 ]) 155 156 157-------------------- 158getArgAmode :: NonVoid StgArg -> FCode CmmExpr 159getArgAmode (NonVoid (StgVarArg var)) = idInfoToAmode <$> getCgIdInfo var 160getArgAmode (NonVoid (StgLitArg lit)) = CmmLit <$> cgLit lit 161 162getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr] 163-- NB: Filters out void args, 164-- so the result list may be shorter than the argument list 165getNonVoidArgAmodes [] = return [] 166getNonVoidArgAmodes (arg:args) 167 | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args 168 | otherwise = do { amode <- getArgAmode (NonVoid arg) 169 ; amodes <- getNonVoidArgAmodes args 170 ; return ( amode : amodes ) } 171 172 173------------------------------------------------------------------------ 174-- Interface functions for binding and re-binding names 175------------------------------------------------------------------------ 176 177bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg 178-- Bind an Id to a fresh LocalReg 179bindToReg nvid@(NonVoid id) lf_info 180 = do dflags <- getDynFlags 181 let reg = idToReg dflags nvid 182 addBindC (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg))) 183 return reg 184 185rebindToReg :: NonVoid Id -> FCode LocalReg 186-- Like bindToReg, but the Id is already in scope, so 187-- get its LF info from the envt 188rebindToReg nvid@(NonVoid id) 189 = do { info <- getCgIdInfo id 190 ; bindToReg nvid (cg_lf info) } 191 192bindArgToReg :: NonVoid Id -> FCode LocalReg 193bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id) 194 195bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg] 196bindArgsToRegs args = mapM bindArgToReg args 197 198idToReg :: DynFlags -> NonVoid Id -> LocalReg 199-- Make a register from an Id, typically a function argument, 200-- free variable, or case binder 201-- 202-- We re-use the Unique from the Id to make it easier to see what is going on 203-- 204-- By now the Ids should be uniquely named; else one would worry 205-- about accidental collision 206idToReg dflags (NonVoid id) 207 = LocalReg (idUnique id) 208 (primRepCmmType dflags (idPrimRep id)) 209