ghci: Ensure that system libffi include path is searched
[ghc.git] / compiler / codeGen / StgCmmEnv.hs
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 -----------------------------------------------------------------------------
10 module StgCmmEnv (
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
27 import GhcPrelude
28
29 import TyCon
30 import StgCmmMonad
31 import StgCmmUtils
32 import StgCmmClosure
33
34 import CLabel
35
36 import BlockId
37 import CmmExpr
38 import CmmUtils
39 import DynFlags
40 import Id
41 import MkGraph
42 import Name
43 import Outputable
44 import StgSyn
45 import Type
46 import TysPrim
47 import UniqFM
48 import Util
49 import VarEnv
50
51 -------------------------------------
52 -- Manipulating CgIdInfo
53 -------------------------------------
54
55 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
56 mkCgIdInfo id lf expr
57 = CgIdInfo { cg_id = id, cg_lf = lf
58 , cg_loc = CmmLoc expr }
59
60 litIdInfo :: DynFlags -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
61 litIdInfo 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
67 lneIdInfo :: DynFlags -> Id -> [NonVoid Id] -> CgIdInfo
68 lneIdInfo 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
76 rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
77 rhsIdInfo id lf_info
78 = do dflags <- getDynFlags
79 reg <- newTemp (gcWord dflags)
80 return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg)
81
82 mkRhsInit :: DynFlags -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph
83 mkRhsInit dflags reg lf_info expr
84 = mkAssign (CmmLocal reg) (addDynTag dflags expr (lfDynTag dflags lf_info))
85
86 idInfoToAmode :: CgIdInfo -> CmmExpr
87 -- Returns a CmmExpr for the *tagged* pointer
88 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e
89 idInfoToAmode cg_info
90 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
91
92 addDynTag :: DynFlags -> CmmExpr -> DynTag -> CmmExpr
93 -- A tag adds a byte offset to the pointer
94 addDynTag dflags expr tag = cmmOffsetB dflags expr tag
95
96 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
97 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
98 maybeLetNoEscape _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
109 addBindC :: CgIdInfo -> FCode ()
110 addBindC stuff_to_bind = do
111 binds <- getBinds
112 setBinds $ extendVarEnv binds (cg_id stuff_to_bind) stuff_to_bind
113
114 addBindsC :: [CgIdInfo] -> FCode ()
115 addBindsC 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
122 getCgIdInfo :: Id -> FCode CgIdInfo
123 getCgIdInfo 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
146 cgLookupPanic :: Id -> FCode a
147 cgLookupPanic id
148 = do local_binds <- getBinds
149 pprPanic "StgCmmEnv: 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 --------------------
158 getArgAmode :: NonVoid StgArg -> FCode CmmExpr
159 getArgAmode (NonVoid (StgVarArg var)) = idInfoToAmode <$> getCgIdInfo var
160 getArgAmode (NonVoid (StgLitArg lit)) = CmmLit <$> cgLit lit
161
162 getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
163 -- NB: Filters out void args,
164 -- so the result list may be shorter than the argument list
165 getNonVoidArgAmodes [] = return []
166 getNonVoidArgAmodes (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
177 bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
178 -- Bind an Id to a fresh LocalReg
179 bindToReg 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
185 rebindToReg :: NonVoid Id -> FCode LocalReg
186 -- Like bindToReg, but the Id is already in scope, so
187 -- get its LF info from the envt
188 rebindToReg nvid@(NonVoid id)
189 = do { info <- getCgIdInfo id
190 ; bindToReg nvid (cg_lf info) }
191
192 bindArgToReg :: NonVoid Id -> FCode LocalReg
193 bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
194
195 bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
196 bindArgsToRegs args = mapM bindArgToReg args
197
198 idToReg :: 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
206 idToReg dflags (NonVoid id)
207 = LocalReg (idUnique id)
208 (primRepCmmType dflags (idPrimRep id))