compiler/codeGen/StgCmmEnv.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Stg to C-- code generation: the binding environment
   4 --
   5 -- (c) The University of Glasgow 2004-2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module StgCmmEnv (
  10         CgIdInfo,
  11
  12         cgIdInfoId, cgIdInfoLF,
  13
  14         litIdInfo, lneIdInfo, regIdInfo,
  15         idInfoToAmode,
  16
  17         addBindC, addBindsC,
  18
  19         bindArgsToRegs, bindToReg, rebindToReg,
  20         bindArgToReg, idToReg,
  21         getArgAmode, getNonVoidArgAmodes,
  22         getCgIdInfo,
  23         maybeLetNoEscape,
  24     ) where
  25
  26 #include "HsVersions.h"
  27
  28 import StgCmmMonad
  29 import StgCmmUtils
  30 import StgCmmClosure
  31
  32 import CLabel
  33
  34 import BlockId
  35 import Cmm
  36 import CmmUtils
  37 import FastString
  38 import PprCmm           ( {- instance Outputable -} )
  39 import Id
  40 import VarEnv
  41 import Maybes
  42 import Name
  43 import StgSyn
  44 import Outputable
  45
  46
  47
  48 -------------------------------------
  49 --      Manipulating CgIdInfo
  50 -------------------------------------
  51
  52 mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
  53 mkCgIdInfo id lf expr
  54   = CgIdInfo { cg_id = id, cg_loc = CmmLoc expr,
  55                cg_lf = lf, cg_rep = idPrimRep id,
  56                cg_tag = lfDynTag lf }
  57
  58 lneIdInfo :: Id -> [LocalReg] -> CgIdInfo
  59 lneIdInfo id regs
  60   = CgIdInfo { cg_id = id, cg_loc = LneLoc blk_id regs,
  61                cg_lf = lf, cg_rep = idPrimRep id,
  62                cg_tag = lfDynTag lf }
  63   where
  64     lf     = mkLFLetNoEscape
  65     blk_id = mkBlockId (idUnique id)
  66
  67 litIdInfo :: Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
  68 litIdInfo id lf_info lit = mkCgIdInfo id lf_info (CmmLit lit)
  69
  70 regIdInfo :: Id -> LambdaFormInfo -> LocalReg -> CgIdInfo
  71 regIdInfo id lf_info reg = mkCgIdInfo id lf_info (CmmReg (CmmLocal reg))
  72
  73 idInfoToAmode :: CgIdInfo -> CmmExpr
  74 -- Returns a CmmExpr for the *tagged* pointer
  75 idInfoToAmode (CgIdInfo { cg_loc = CmmLoc e, cg_tag = tag })
  76   = addDynTag e tag
  77 idInfoToAmode cg_info
  78   = pprPanic "idInfoToAmode" (ppr (cg_id cg_info))      -- LneLoc
  79
  80 addDynTag :: CmmExpr -> DynTag -> CmmExpr
  81 -- A tag adds a byte offset to the pointer
  82 addDynTag expr tag = cmmOffsetB expr tag
  83
  84 cgIdInfoId :: CgIdInfo -> Id
  85 cgIdInfoId = cg_id
  86
  87 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
  88 cgIdInfoLF = cg_lf
  89
  90 maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
  91 maybeLetNoEscape (CgIdInfo { cg_loc = LneLoc blk_id args}) = Just (blk_id, args)
  92 maybeLetNoEscape _other                                    = Nothing
  93
  94
  95
  96 ---------------------------------------------------------
  97 --      The binding environment
  98 --
  99 -- There are three basic routines, for adding (addBindC),
 100 -- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
 101 ---------------------------------------------------------
 102
 103 addBindC :: Id -> CgIdInfo -> FCode ()
 104 addBindC name stuff_to_bind = do
 105         binds <- getBinds
 106         setBinds $ extendVarEnv binds name stuff_to_bind
 107
 108 addBindsC :: [(Id, CgIdInfo)] -> FCode ()
 109 addBindsC new_bindings = do
 110         binds <- getBinds
 111         let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
 112                               binds
 113                               new_bindings
 114         setBinds new_binds
 115
 116 getCgIdInfo :: Id -> FCode CgIdInfo
 117 getCgIdInfo id
 118   = do  {       -- Try local bindings first
 119         ; local_binds  <- getBinds
 120         ; case lookupVarEnv local_binds id of {
 121             Just info -> return info ;
 122             Nothing   -> do
 123
 124         {       -- Try top-level bindings
 125           static_binds <- getStaticBinds
 126         ; case lookupVarEnv static_binds id of {
 127             Just info -> return info ;
 128             Nothing   ->
 129
 130                 -- Should be imported; make up a CgIdInfo for it
 131         let
 132             name = idName id
 133         in
 134         if isExternalName name then do
 135             let ext_lbl = CmmLabel (mkClosureLabel name $ idCafInfo id)
 136             return (litIdInfo id (mkLFImported id) ext_lbl)
 137         else
 138         -- Bug
 139         cgLookupPanic id
 140         }}}}
 141
 142 cgLookupPanic :: Id -> FCode a
 143 cgLookupPanic id
 144   = do  static_binds <- getStaticBinds
 145         local_binds <- getBinds
 146         srt <- getSRTLabel
 147         pprPanic "StgCmmEnv: variable not found"
 148                 (vcat [ppr id,
 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
 154               ])
 155
 156
 157 --------------------
 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"
 162
 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 ) }
 172
 173
 174 ------------------------------------------------------------------------
 175 --      Interface functions for binding and re-binding names
 176 ------------------------------------------------------------------------
 177
 178 bindToReg :: Id -> LambdaFormInfo -> FCode LocalReg
 179 -- Bind an Id to a fresh LocalReg
 180 bindToReg id lf_info
 181   = do  { let reg = idToReg id
 182         ; addBindC id (regIdInfo id lf_info reg)
 183         ; return reg }
 184
 185 rebindToReg :: Id -> FCode LocalReg
 186 -- Like bindToReg, but the Id is already in scope, so
 187 -- get its LF info from the envt
 188 rebindToReg id
 189   = do  { info <- getCgIdInfo id
 190         ; bindToReg id (cgIdInfoLF info) }
 191
 192 bindArgToReg :: Id -> FCode LocalReg
 193 bindArgToReg id = bindToReg id (mkLFArgument id)
 194
 195 bindArgsToRegs :: [Id] -> FCode [LocalReg]
 196 bindArgsToRegs args = mapM bindArgToReg args
 197
 198 idToReg :: 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 id = LocalReg (idUnique id)
 207                       (primRepCmmType (idPrimRep id))
 208
 209