never executed always true always false
1
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 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 getCgIdInfo,
21 maybeLetNoEscape,
22 ) where
23
24 import GHC.Prelude
25
26 import GHC.Platform
27 import GHC.StgToCmm.Monad
28 import GHC.StgToCmm.Closure
29
30 import GHC.Cmm.CLabel
31
32 import GHC.Cmm.BlockId
33 import GHC.Cmm.Expr
34 import GHC.Cmm.Utils
35 import GHC.Types.Id
36 import GHC.Cmm.Graph
37 import GHC.Types.Name
38 import GHC.Core.Type
39 import GHC.Builtin.Types.Prim
40 import GHC.Types.Unique.FM
41 import GHC.Types.Var.Env
42
43 import GHC.Utils.Outputable
44 import GHC.Utils.Panic
45 import GHC.Utils.Panic.Plain
46
47 import GHC.Driver.Session
48
49
50 -------------------------------------
51 -- Manipulating CgIdInfo
52 -------------------------------------
53
54 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
55 mkCgIdInfo id lf expr
56 = CgIdInfo { cg_id = id, cg_lf = lf
57 , cg_loc = CmmLoc expr }
58
59 litIdInfo :: Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
60 litIdInfo platform id lf lit
61 = CgIdInfo { cg_id = id, cg_lf = lf
62 , cg_loc = CmmLoc (addDynTag platform (CmmLit lit) tag) }
63 where
64 tag = lfDynTag platform lf
65
66 lneIdInfo :: Platform -> Id -> [NonVoid Id] -> CgIdInfo
67 lneIdInfo platform id regs
68 = CgIdInfo { cg_id = id, cg_lf = lf
69 , cg_loc = LneLoc blk_id (map (idToReg platform) regs) }
70 where
71 lf = mkLFLetNoEscape
72 blk_id = mkBlockId (idUnique id)
73
74
75 rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
76 rhsIdInfo id lf_info
77 = do platform <- getPlatform
78 reg <- newTemp (gcWord platform)
79 return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg)
80
81 mkRhsInit :: Platform -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph
82 mkRhsInit platform reg lf_info expr
83 = mkAssign (CmmLocal reg) (addDynTag platform expr (lfDynTag platform lf_info))
84
85 idInfoToAmode :: CgIdInfo -> CmmExpr
86 -- Returns a CmmExpr for the *tagged* pointer
87 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e }) = e
88 idInfoToAmode cg_info
89 = pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
90
91 -- | A tag adds a byte offset to the pointer
92 addDynTag :: Platform -> CmmExpr -> DynTag -> CmmExpr
93 addDynTag platform expr tag = cmmOffsetB platform expr tag
94
95 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
96 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
97 maybeLetNoEscape _other = Nothing
98
99
100
101 ---------------------------------------------------------
102 -- The binding environment
103 --
104 -- There are three basic routines, for adding (addBindC),
105 -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
106 ---------------------------------------------------------
107
108 addBindC :: CgIdInfo -> FCode ()
109 addBindC stuff_to_bind = do
110 binds <- getBinds
111 setBinds $ extendVarEnv binds (cg_id stuff_to_bind) stuff_to_bind
112
113 addBindsC :: [CgIdInfo] -> FCode ()
114 addBindsC new_bindings = do
115 binds <- getBinds
116 let new_binds = foldl' (\ binds info -> extendVarEnv binds (cg_id info) info)
117 binds
118 new_bindings
119 setBinds new_binds
120
121 getCgIdInfo :: Id -> FCode CgIdInfo
122 getCgIdInfo id
123 = do { platform <- targetPlatform <$> getDynFlags
124 ; local_binds <- getBinds -- Try local bindings first
125 ; case lookupVarEnv local_binds id of {
126 Just info -> return info ;
127 Nothing -> do {
128
129 -- Should be imported; make up a CgIdInfo for it
130 let name = idName id
131 ; if isExternalName name then
132 let ext_lbl
133 | isBoxedType (idType id)
134 = mkClosureLabel name $ idCafInfo id
135 | isUnliftedType (idType id)
136 -- An unlifted external Id must refer to a top-level
137 -- string literal. See Note [Bytes label] in "GHC.Cmm.CLabel".
138 = assert (idType id `eqType` addrPrimTy) $
139 mkBytesLabel name
140 | otherwise
141 = pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id))
142 in return $
143 litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl)
144 else
145 cgLookupPanic id -- Bug
146 }}}
147
148 cgLookupPanic :: Id -> FCode a
149 cgLookupPanic id
150 = do local_binds <- getBinds
151 pprPanic "GHC.StgToCmm.Env: variable not found"
152 (vcat [ppr id,
153 text "local binds for:",
154 pprUFM local_binds $ \infos ->
155 vcat [ ppr (cg_id info) | info <- infos ]
156 ])
157
158
159 ------------------------------------------------------------------------
160 -- Interface functions for binding and re-binding names
161 ------------------------------------------------------------------------
162
163 bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
164 -- Bind an Id to a fresh LocalReg
165 bindToReg nvid@(NonVoid id) lf_info
166 = do platform <- getPlatform
167 let reg = idToReg platform nvid
168 addBindC (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
169 return reg
170
171 rebindToReg :: NonVoid Id -> FCode LocalReg
172 -- Like bindToReg, but the Id is already in scope, so
173 -- get its LF info from the envt
174 rebindToReg nvid@(NonVoid id)
175 = do { info <- getCgIdInfo id
176 ; bindToReg nvid (cg_lf info) }
177
178 bindArgToReg :: NonVoid Id -> FCode LocalReg
179 bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
180
181 bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
182 bindArgsToRegs args = mapM bindArgToReg args
183
184 idToReg :: Platform -> NonVoid Id -> LocalReg
185 -- Make a register from an Id, typically a function argument,
186 -- free variable, or case binder
187 --
188 -- We re-use the Unique from the Id to make it easier to see what is going on
189 --
190 -- By now the Ids should be uniquely named; else one would worry
191 -- about accidental collision
192 idToReg platform (NonVoid id)
193 = LocalReg (idUnique id)
194 (primRepCmmType platform (idPrimRep id))