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,
19 bindArgsToRegs, bindToReg, rebindToReg,
20 bindArgToReg, idToReg,
21 getArgAmode, getNonVoidArgAmodes,
26 #include "HsVersions.h"
38 import PprCmm ( {- instance Outputable -} )
48 -------------------------------------
49 -- Manipulating CgIdInfo
50 -------------------------------------
52 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
54 = CgIdInfo { cg_id = id, cg_loc = CmmLoc expr,
55 cg_lf = lf, cg_rep = idPrimRep id,
56 cg_tag = lfDynTag lf }
58 lneIdInfo :: Id -> [LocalReg] -> CgIdInfo
60 = CgIdInfo { cg_id = id, cg_loc = LneLoc blk_id regs,
61 cg_lf = lf, cg_rep = idPrimRep id,
62 cg_tag = lfDynTag lf }
65 blk_id = mkBlockId (idUnique id)
67 litIdInfo :: Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
68 litIdInfo id lf_info lit = mkCgIdInfo id lf_info (CmmLit lit)
70 regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CgIdInfo
71 regIdInfo id lf_info reg = mkCgIdInfo id lf_info (CmmReg (CmmLocal reg))
73 idInfoToAmode :: CgIdInfo -> CmmExpr
74 -- Returns a CmmExpr for the *tagged* pointer
75 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e, cg_tag = tag })
78 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
80 addDynTag :: CmmExpr -> DynTag -> CmmExpr
81 -- A tag adds a byte offset to the pointer
82 addDynTag expr tag = cmmOffsetB expr tag
84 cgIdInfoId :: CgIdInfo -> Id
87 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
90 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
91 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
92 maybeLetNoEscape _other = Nothing
96 ---------------------------------------------------------
97 -- The binding environment
99 -- There are three basic routines, for adding (addBindC),
100 -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
101 ---------------------------------------------------------
103 addBindC :: Id -> CgIdInfo -> FCode ()
104 addBindC name stuff_to_bind = do
106 setBinds $ extendVarEnv binds name stuff_to_bind
108 addBindsC :: [(Id, CgIdInfo)] -> FCode ()
109 addBindsC new_bindings = do
111 let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
116 getCgIdInfo :: Id -> FCode CgIdInfo
118 = do { -- Try local bindings first
119 ; local_binds <- getBinds
120 ; case lookupVarEnv local_binds id of {
121 Just info -> return info ;
124 { -- Try top-level bindings
125 static_binds <- getStaticBinds
126 ; case lookupVarEnv static_binds id of {
127 Just info -> return info ;
130 -- Should be imported; make up a CgIdInfo for it
134 if isExternalName name then do
135 let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
136 return (litIdInfo id (mkLFImported id) ext_lbl)
142 cgLookupPanic :: Id -> FCode a
144 = do static_binds <- getStaticBinds
145 local_binds <- getBinds
147 pprPanic "StgCmmEnv: variable not found"
149 ptext (sLit "static binds for:"),
150 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
151 ptext (sLit "local binds for:"),
152 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
153 ptext (sLit "SRT label") <+> pprCLabel srt
158 getArgAmode :: StgArg -> FCode CmmExpr
159 getArgAmode (StgVarArg var) = do { info <- getCgIdInfo var; return (idInfoToAmode info) }
160 getArgAmode (StgLitArg lit) = return (CmmLit (mkSimpleLit lit))
161 getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
163 getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
164 -- NB: Filters out void args,
165 -- so the result list may be shorter than the argument list
166 getNonVoidArgAmodes [] = return []
167 getNonVoidArgAmodes (arg:args)
168 | isVoidRep (argPrimRep arg) = getNonVoidArgAmodes args
169 | otherwise = do { amode <- getArgAmode arg
170 ; amodes <- getNonVoidArgAmodes args
171 ; return ( amode : amodes ) }
174 ------------------------------------------------------------------------
175 -- Interface functions for binding and re-binding names
176 ------------------------------------------------------------------------
178 bindToReg :: Id -> LambdaFormInfo -> FCode LocalReg
179 -- Bind an Id to a fresh LocalReg
181 = do { let reg = idToReg id
182 ; addBindC id (regIdInfo id lf_info reg)
185 rebindToReg :: Id -> FCode LocalReg
186 -- Like bindToReg, but the Id is already in scope, so
187 -- get its LF info from the envt
189 = do { info <- getCgIdInfo id
190 ; bindToReg id (cgIdInfoLF info) }
192 bindArgToReg :: Id -> FCode LocalReg
193 bindArgToReg id = bindToReg id (mkLFArgument id)
195 bindArgsToRegs :: [Id] -> FCode [LocalReg]
196 bindArgsToRegs args = mapM bindArgToReg args
198 idToReg :: Id -> LocalReg
199 -- Make a register from an Id, typically a function argument,
200 -- free variable, or case binder
202 -- We re-use the Unique from the Id to make it easier to see what is going on
204 -- By now the Ids should be uniquely named; else one would worry
205 -- about accidental collision
206 idToReg id = LocalReg (idUnique id)
207 (primRepCmmType (idPrimRep id))