1 -----------------------------------------------------------------------------
3 -- Stg to C-- code generation: the binding environment
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
12 cgIdInfoId, cgIdInfoLF,
14 litIdInfo, lneIdInfo, regIdInfo,
17 NonVoid(..), isVoidId, nonVoidIds,
21 bindArgsToRegs, bindToReg, rebindToReg,
22 bindArgToReg, idToReg,
23 getArgAmode, getNonVoidArgAmodes,
28 #include "HsVersions.h"
40 import MkGraph (CmmAGraph, mkAssign, (<*>))
49 -------------------------------------
51 -------------------------------------
52 -- We frequently need the invariant that an Id or a an argument
53 -- is of a non-void type. This type is a witness to the invariant.
55 newtype NonVoid a = NonVoid a
58 instance (Outputable a) => Outputable (NonVoid a) where
59 ppr (NonVoid a) = ppr a
61 isVoidId :: Id -> Bool
62 isVoidId = isVoidRep . idPrimRep
64 nonVoidIds :: [Id] -> [NonVoid Id]
65 nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidRep (idPrimRep id))]
67 -------------------------------------
68 -- Manipulating CgIdInfo
69 -------------------------------------
71 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
73 = CgIdInfo { cg_id = id, cg_loc = CmmLoc expr,
74 cg_lf = lf, cg_rep = idPrimRep id,
75 cg_tag = lfDynTag lf }
77 lneIdInfo :: Id -> [LocalReg] -> CgIdInfo
79 = CgIdInfo { cg_id = id, cg_loc = LneLoc blk_id regs,
80 cg_lf = lf, cg_rep = idPrimRep id,
81 cg_tag = lfDynTag lf }
84 blk_id = mkBlockId (idUnique id)
86 litIdInfo :: Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
87 litIdInfo id lf_info lit = --mkCgIdInfo id lf_info (CmmLit lit)
88 mkCgIdInfo id lf_info (addDynTag (CmmLit lit) (lfDynTag lf_info))
90 -- Because the register may be spilled to the stack in untagged form, we
91 -- modify the initialization code 'init' to immediately tag the
92 -- register, and store a plain register in the CgIdInfo. We allocate
93 -- a new register in order to keep single-assignment and help out the
95 regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CmmAGraph -> FCode (CgIdInfo, CmmAGraph)
96 regIdInfo id lf_info reg init = do
97 reg' <- newTemp (localRegType reg)
98 let init' = init <*> mkAssign (CmmLocal reg') (addDynTag (CmmReg (CmmLocal reg)) (lfDynTag lf_info))
99 return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg')), init')
101 idInfoToAmode :: CgIdInfo -> CmmExpr
102 -- Returns a CmmExpr for the *tagged* pointer
103 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e
104 idInfoToAmode cg_info
105 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
107 addDynTag :: CmmExpr -> DynTag -> CmmExpr
108 -- A tag adds a byte offset to the pointer
109 addDynTag expr tag = cmmOffsetB expr tag
111 cgIdInfoId :: CgIdInfo -> Id
114 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
117 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
118 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
119 maybeLetNoEscape _other = Nothing
123 ---------------------------------------------------------
124 -- The binding environment
126 -- There are three basic routines, for adding (addBindC),
127 -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
128 ---------------------------------------------------------
130 addBindC :: Id -> CgIdInfo -> FCode ()
131 addBindC name stuff_to_bind = do
133 setBinds $ extendVarEnv binds name stuff_to_bind
135 addBindsC :: [CgIdInfo] -> FCode ()
136 addBindsC new_bindings = do
138 let new_binds = foldl (\ binds info -> extendVarEnv binds (cg_id info) info)
143 getCgIdInfo :: Id -> FCode CgIdInfo
145 = do { -- Try local bindings first
146 ; local_binds <- getBinds
147 ; case lookupVarEnv local_binds id of {
148 Just info -> return info ;
151 { -- Try top-level bindings
152 static_binds <- getStaticBinds
153 ; case lookupVarEnv static_binds id of {
154 Just info -> return info ;
157 -- Should be imported; make up a CgIdInfo for it
161 if isExternalName name then do
162 let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
163 return (litIdInfo id (mkLFImported id) ext_lbl)
169 cgLookupPanic :: Id -> FCode a
171 = do static_binds <- getStaticBinds
172 local_binds <- getBinds
174 pprPanic "StgCmmEnv: variable not found"
176 ptext (sLit "static binds for:"),
177 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
178 ptext (sLit "local binds for:"),
179 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
180 ptext (sLit "SRT label") <+> pprCLabel srt
185 getArgAmode :: NonVoid StgArg -> FCode CmmExpr
186 getArgAmode (NonVoid (StgVarArg var)) =
187 do { info <- getCgIdInfo var; return (idInfoToAmode info) }
188 getArgAmode (NonVoid (StgLitArg lit)) = liftM CmmLit $ cgLit lit
189 getArgAmode (NonVoid (StgTypeArg _)) = panic "getArgAmode: type arg"
191 getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
192 -- NB: Filters out void args,
193 -- so the result list may be shorter than the argument list
194 getNonVoidArgAmodes [] = return []
195 getNonVoidArgAmodes (arg:args)
196 | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args
197 | otherwise = do { amode <- getArgAmode (NonVoid arg)
198 ; amodes <- getNonVoidArgAmodes args
199 ; return ( amode : amodes ) }
202 ------------------------------------------------------------------------
203 -- Interface functions for binding and re-binding names
204 ------------------------------------------------------------------------
206 bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
207 -- Bind an Id to a fresh LocalReg
208 bindToReg nvid@(NonVoid id) lf_info
209 = do { let reg = idToReg nvid
210 ; addBindC id (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
213 rebindToReg :: NonVoid Id -> FCode LocalReg
214 -- Like bindToReg, but the Id is already in scope, so
215 -- get its LF info from the envt
216 rebindToReg nvid@(NonVoid id)
217 = do { info <- getCgIdInfo id
218 ; bindToReg nvid (cgIdInfoLF info) }
220 bindArgToReg :: NonVoid Id -> FCode LocalReg
221 bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
223 bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
224 bindArgsToRegs args = mapM bindArgToReg args
226 idToReg :: NonVoid Id -> LocalReg
227 -- Make a register from an Id, typically a function argument,
228 -- free variable, or case binder
230 -- We re-use the Unique from the Id to make it easier to see what is going on
232 -- By now the Ids should be uniquely named; else one would worry
233 -- about accidental collision
234 idToReg (NonVoid id) = LocalReg (idUnique id)
235 (case idPrimRep id of VoidRep -> pprPanic "idToReg" (ppr id)
236 _ -> primRepCmmType (idPrimRep id))