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