compiler/codeGen/CgBindery.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[CgBindery]{Utility functions related to doing @CgBindings@}
   6
   7 \begin{code}
   8 module CgBindery (
   9         CgBindings, CgIdInfo,
  10         StableLoc, VolatileLoc,
  11
  12         cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
  13
  14         stableIdInfo, heapIdInfo,
  15         letNoEscapeIdInfo, idInfoToAmode,
  16
  17         addBindC, addBindsC,
  18
  19         nukeVolatileBinds,
  20         nukeDeadBindings,
  21         getLiveStackSlots,
  22         getLiveStackBindings,
  23
  24         bindArgsToStack,  rebindToStack,
  25         bindNewToNode, bindNewToReg, bindArgsToRegs,
  26         bindNewToTemp,
  27         getArgAmode, getArgAmodes,
  28         getCgIdInfo,
  29         getCAddrModeIfVolatile, getVolatileRegs,
  30         maybeLetNoEscape,
  31     ) where
  32
  33 #include "HsVersions.h"
  34
  35 import CgMonad
  36 import CgHeapery
  37 import CgStackery
  38 import CgUtils
  39 import CLabel
  40 import ClosureInfo
  41
  42 import Cmm
  43 import PprCmm           ( {- instance Outputable -} )
  44 import SMRep
  45 import Id
  46 import VarEnv
  47 import VarSet
  48 import Literal
  49 import Maybes
  50 import Name
  51 import StgSyn
  52 import Unique
  53 import UniqSet
  54 import Outputable
  55 \end{code}
  56
  57
  58 %************************************************************************
  59 %*                                                                      *
  60 \subsection[Bindery-datatypes]{Data types}
  61 %*                                                                      *
  62 %************************************************************************
  63
  64 @(CgBinding a b)@ is a type of finite maps from a to b.
  65
  66 The assumption used to be that @lookupCgBind@ must get exactly one
  67 match.  This is {\em completely wrong} in the case of compiling
  68 letrecs (where knot-tying is used).  An initial binding is fed in (and
  69 never evaluated); eventually, a correct binding is put into the
  70 environment.  So there can be two bindings for a given name.
  71
  72 \begin{code}
  73 type CgBindings = IdEnv CgIdInfo
  74
  75 data CgIdInfo
  76   = CgIdInfo
  77         { cg_id :: Id   -- Id that this is the info for
  78                         -- Can differ from the Id at occurrence sites by
  79                         -- virtue of being externalised, for splittable C
  80         , cg_rep :: CgRep
  81         , cg_vol :: VolatileLoc
  82         , cg_stb :: StableLoc
  83         , cg_lf  :: LambdaFormInfo }
  84
  85 mkCgIdInfo id vol stb lf
  86   = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb,
  87                cg_lf = lf, cg_rep = idCgRep id }
  88
  89 voidIdInfo id = CgIdInfo { cg_id = id, cg_vol = NoVolatileLoc
  90                          , cg_stb = VoidLoc, cg_lf = mkLFArgument id
  91                          , cg_rep = VoidArg }
  92         -- Used just for VoidRep things
  93
  94 data VolatileLoc        -- These locations die across a call
  95   = NoVolatileLoc
  96   | RegLoc      CmmReg             -- In one of the registers (global or local)
  97   | VirHpLoc    VirtualHpOffset  -- Hp+offset (address of closure)
  98   | VirNodeLoc  VirtualHpOffset  -- Cts of offset indirect from Node
  99                                    -- ie *(Node+offset)
 100 \end{code}
 101
 102 @StableLoc@ encodes where an Id can be found, used by
 103 the @CgBindings@ environment in @CgBindery@.
 104
 105 \begin{code}
 106 data StableLoc
 107   = NoStableLoc
 108
 109   | VirStkLoc   VirtualSpOffset         -- The thing is held in this
 110                                         -- stack slot
 111
 112   | VirStkLNE   VirtualSpOffset         -- A let-no-escape thing; the
 113                                         -- value is this stack pointer
 114                                         -- (as opposed to the contents of the slot)
 115
 116   | StableLoc   CmmExpr
 117   | VoidLoc     -- Used only for VoidRep variables.  They never need to
 118                 -- be saved, so it makes sense to treat treat them as
 119                 -- having a stable location
 120 \end{code}
 121
 122 \begin{code}
 123 instance Outputable CgIdInfo where
 124   ppr (CgIdInfo id rep vol stb lf)
 125     = ppr id <+> ptext SLIT("-->") <+> vcat [ppr vol, ppr stb]
 126
 127 instance Outputable VolatileLoc where
 128   ppr NoVolatileLoc = empty
 129   ppr (RegLoc r)     = ptext SLIT("reg") <+> ppr r
 130   ppr (VirHpLoc v)   = ptext SLIT("vh")  <+> ppr v
 131   ppr (VirNodeLoc v) = ptext SLIT("vn")  <+> ppr v
 132
 133 instance Outputable StableLoc where
 134   ppr NoStableLoc   = empty
 135   ppr VoidLoc       = ptext SLIT("void")
 136   ppr (VirStkLoc v) = ptext SLIT("vs")    <+> ppr v
 137   ppr (VirStkLNE v) = ptext SLIT("lne")    <+> ppr v
 138   ppr (StableLoc a) = ptext SLIT("amode") <+> ppr a
 139 \end{code}
 140
 141 %************************************************************************
 142 %*                                                                      *
 143 \subsection[Bindery-idInfo]{Manipulating IdInfo}
 144 %*                                                                      *
 145 %************************************************************************
 146
 147 \begin{code}
 148 stableIdInfo id amode   lf_info = mkCgIdInfo id NoVolatileLoc (StableLoc amode) lf_info
 149 heapIdInfo id offset    lf_info = mkCgIdInfo id (VirHpLoc offset) NoStableLoc lf_info
 150 letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_info
 151 stackIdInfo id sp       lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
 152 nodeIdInfo id offset    lf_info = mkCgIdInfo id (VirNodeLoc offset) NoStableLoc lf_info
 153 regIdInfo id reg        lf_info = mkCgIdInfo id (RegLoc reg) NoStableLoc lf_info
 154
 155 idInfoToAmode :: CgIdInfo -> FCode CmmExpr
 156 idInfoToAmode info
 157   = case cg_vol info of {
 158       RegLoc reg        -> returnFC (CmmReg reg) ;
 159       VirNodeLoc nd_off -> returnFC (CmmLoad (cmmOffsetW (CmmReg nodeReg) nd_off) mach_rep) ;
 160       VirHpLoc hp_off   -> getHpRelOffset hp_off ;
 161       NoVolatileLoc ->
 162
 163     case cg_stb info of
 164       StableLoc amode  -> returnFC amode
 165       VirStkLoc sp_off -> do { sp_rel <- getSpRelOffset sp_off
 166                              ; return (CmmLoad sp_rel mach_rep) }
 167
 168       VirStkLNE sp_off -> getSpRelOffset sp_off
 169
 170       VoidLoc -> return $ pprPanic "idInfoToAmode: void" (ppr (cg_id info))
 171                 -- We return a 'bottom' amode, rather than panicing now
 172                 -- In this way getArgAmode returns a pair of (VoidArg, bottom)
 173                 -- and that's exactly what we want
 174
 175       NoStableLoc -> pprPanic "idInfoToAmode: no loc" (ppr (cg_id info))
 176     }
 177   where
 178     mach_rep = argMachRep (cg_rep info)
 179
 180 cgIdInfoId :: CgIdInfo -> Id
 181 cgIdInfoId = cg_id
 182
 183 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
 184 cgIdInfoLF = cg_lf
 185
 186 cgIdInfoArgRep :: CgIdInfo -> CgRep
 187 cgIdInfoArgRep = cg_rep
 188
 189 maybeLetNoEscape (CgIdInfo { cg_stb = VirStkLNE sp_off }) = Just sp_off
 190 maybeLetNoEscape other                                    = Nothing
 191 \end{code}
 192
 193 %************************************************************************
 194 %*                                                                      *
 195 \subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
 196 %*                                                                      *
 197 %************************************************************************
 198
 199 .There are three basic routines, for adding (@addBindC@), modifying
 200 (@modifyBindC@) and looking up (@getCgIdInfo@) bindings.
 201
 202 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
 203 The name should not already be bound. (nice ASSERT, eh?)
 204
 205 \begin{code}
 206 addBindC :: Id -> CgIdInfo -> Code
 207 addBindC name stuff_to_bind = do
 208         binds <- getBinds
 209         setBinds $ extendVarEnv binds name stuff_to_bind
 210
 211 addBindsC :: [(Id, CgIdInfo)] -> Code
 212 addBindsC new_bindings = do
 213         binds <- getBinds
 214         let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
 215                               binds
 216                               new_bindings
 217         setBinds new_binds
 218
 219 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
 220 modifyBindC name mangle_fn = do
 221         binds <- getBinds
 222         setBinds $ modifyVarEnv mangle_fn binds name
 223
 224 getCgIdInfo :: Id -> FCode CgIdInfo
 225 getCgIdInfo id
 226   = do  {       -- Try local bindings first
 227         ; local_binds  <- getBinds
 228         ; case lookupVarEnv local_binds id of {
 229             Just info -> return info ;
 230             Nothing   -> do
 231
 232         {       -- Try top-level bindings
 233           static_binds <- getStaticBinds
 234         ; case lookupVarEnv static_binds id of {
 235             Just info -> return info ;
 236             Nothing   ->
 237
 238                 -- Should be imported; make up a CgIdInfo for it
 239         let
 240             name = idName id
 241         in
 242         if isExternalName name then do
 243             this_pkg <- getThisPackage
 244             let ext_lbl = CmmLit (CmmLabel (mkClosureLabel this_pkg name))
 245             return (stableIdInfo id ext_lbl (mkLFImported id))
 246         else
 247         if isVoidArg (idCgRep id) then
 248                 -- Void things are never in the environment
 249             return (voidIdInfo id)
 250         else
 251         -- Bug
 252         cgLookupPanic id
 253         }}}}
 254
 255
 256 cgLookupPanic :: Id -> FCode a
 257 cgLookupPanic id
 258   = do  static_binds <- getStaticBinds
 259         local_binds <- getBinds
 260         srt <- getSRTLabel
 261         pprPanic "cgPanic"
 262                 (vcat [ppr id,
 263                 ptext SLIT("static binds for:"),
 264                 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
 265                 ptext SLIT("local binds for:"),
 266                 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
 267                 ptext SLIT("SRT label") <+> pprCLabel srt
 268               ])
 269 \end{code}
 270
 271 %************************************************************************
 272 %*                                                                      *
 273 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
 274 %*                                                                      *
 275 %************************************************************************
 276
 277 We sometimes want to nuke all the volatile bindings; we must be sure
 278 we don't leave any (NoVolatile, NoStable) binds around...
 279
 280 \begin{code}
 281 nukeVolatileBinds :: CgBindings -> CgBindings
 282 nukeVolatileBinds binds
 283   = mkVarEnv (foldr keep_if_stable [] (varEnvElts binds))
 284   where
 285     keep_if_stable (CgIdInfo { cg_stb = NoStableLoc }) acc = acc
 286     keep_if_stable info acc
 287       = (cg_id info, info { cg_vol = NoVolatileLoc }) : acc
 288 \end{code}
 289
 290
 291 %************************************************************************
 292 %*                                                                      *
 293 \subsection[lookup-interface]{Interface functions to looking up bindings}
 294 %*                                                                      *
 295 %************************************************************************
 296
 297 \begin{code}
 298 getCAddrModeIfVolatile :: Id -> FCode (Maybe CmmExpr)
 299 getCAddrModeIfVolatile id
 300   = do  { info <- getCgIdInfo id
 301         ; case cg_stb info of
 302                 NoStableLoc -> do -- Aha!  So it is volatile!
 303                         amode <- idInfoToAmode info
 304                         return $ Just amode
 305                 a_stable_loc -> return Nothing }
 306 \end{code}
 307
 308 @getVolatileRegs@ gets a set of live variables, and returns a list of
 309 all registers on which these variables depend.  These are the regs
 310 which must be saved and restored across any C calls.  If a variable is
 311 both in a volatile location (depending on a register) {\em and} a
 312 stable one (notably, on the stack), we modify the current bindings to
 313 forget the volatile one.
 314
 315 \begin{code}
 316 getVolatileRegs :: StgLiveVars -> FCode [GlobalReg]
 317
 318 getVolatileRegs vars = do
 319   do    { stuff <- mapFCs snaffle_it (varSetElems vars)
 320         ; returnFC $ catMaybes stuff }
 321   where
 322     snaffle_it var = do
 323         { info <- getCgIdInfo var
 324         ; let
 325                 -- commoned-up code...
 326              consider_reg reg
 327                 =       -- We assume that all regs can die across C calls
 328                         -- We leave it to the save-macros to decide which
 329                         -- regs *really* need to be saved.
 330                   case cg_stb info of
 331                         NoStableLoc     -> returnFC (Just reg) -- got one!
 332                         is_a_stable_loc -> do
 333                                 { -- has both volatile & stable locations;
 334                                   -- force it to rely on the stable location
 335                                   modifyBindC var nuke_vol_bind
 336                                 ; return Nothing }
 337
 338         ; case cg_vol info of
 339             RegLoc (CmmGlobal reg) -> consider_reg reg
 340             VirNodeLoc _           -> consider_reg node
 341             other_loc              -> returnFC Nothing  -- Local registers
 342         }
 343
 344     nuke_vol_bind info = info { cg_vol = NoVolatileLoc }
 345 \end{code}
 346
 347 \begin{code}
 348 getArgAmode :: StgArg -> FCode (CgRep, CmmExpr)
 349 getArgAmode (StgVarArg var)
 350   = do  { info <- getCgIdInfo var
 351         ; amode <- idInfoToAmode info
 352         ; return (cgIdInfoArgRep info, amode ) }
 353
 354 getArgAmode (StgLitArg lit)
 355   = do  { cmm_lit <- cgLit lit
 356         ; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
 357
 358 getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
 359
 360 getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
 361 getArgAmodes [] = returnFC []
 362 getArgAmodes (atom:atoms)
 363   | isStgTypeArg atom = getArgAmodes atoms
 364   | otherwise         = do { amode  <- getArgAmode  atom
 365                            ; amodes <- getArgAmodes atoms
 366                            ; return ( amode : amodes ) }
 367 \end{code}
 368
 369 %************************************************************************
 370 %*                                                                      *
 371 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
 372 %*                                                                      *
 373 %************************************************************************
 374
 375 \begin{code}
 376 bindArgsToStack :: [(Id, VirtualSpOffset)] -> Code
 377 bindArgsToStack args
 378   = mapCs bind args
 379   where
 380     bind(id, offset) = addBindC id (stackIdInfo id offset (mkLFArgument id))
 381
 382 bindArgsToRegs :: [(Id, GlobalReg)] -> Code
 383 bindArgsToRegs args
 384   = mapCs bind args
 385   where
 386     bind (arg, reg) = bindNewToReg arg (CmmGlobal reg) (mkLFArgument arg)
 387
 388 bindNewToNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Code
 389 bindNewToNode id offset lf_info
 390   = addBindC id (nodeIdInfo id offset lf_info)
 391
 392 -- Create a new temporary whose unique is that in the id,
 393 -- bind the id to it, and return the addressing mode for the
 394 -- temporary.
 395 bindNewToTemp :: Id -> FCode LocalReg
 396 bindNewToTemp id
 397   = do  addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info)
 398         return temp_reg
 399   where
 400     uniq     = getUnique id
 401     temp_reg = LocalReg uniq (argMachRep (idCgRep id)) kind
 402     kind     = if isFollowableArg (idCgRep id)
 403                then KindPtr
 404                else KindNonPtr
 405     lf_info  = mkLFArgument id  -- Always used of things we
 406                                 -- know nothing about
 407
 408 bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code
 409 bindNewToReg name reg lf_info
 410   = addBindC name info
 411   where
 412     info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info
 413 \end{code}
 414
 415 \begin{code}
 416 rebindToStack :: Id -> VirtualSpOffset -> Code
 417 rebindToStack name offset
 418   = modifyBindC name replace_stable_fn
 419   where
 420     replace_stable_fn info = info { cg_stb = VirStkLoc offset }
 421 \end{code}
 422
 423 %************************************************************************
 424 %*                                                                      *
 425 \subsection[CgMonad-deadslots]{Finding dead stack slots}
 426 %*                                                                      *
 427 %************************************************************************
 428
 429 nukeDeadBindings does the following:
 430
 431       - Removes all bindings from the environment other than those
 432         for variables in the argument to nukeDeadBindings.
 433       - Collects any stack slots so freed, and returns them to the  stack free
 434         list.
 435       - Moves the virtual stack pointer to point to the topmost used
 436         stack locations.
 437
 438 You can have multi-word slots on the stack (where a Double# used to
 439 be, for instance); if dead, such a slot will be reported as *several*
 440 offsets (one per word).
 441
 442 Probably *naughty* to look inside monad...
 443
 444 \begin{code}
 445 nukeDeadBindings :: StgLiveVars  -- All the *live* variables
 446                  -> Code
 447 nukeDeadBindings live_vars = do
 448         binds <- getBinds
 449         let (dead_stk_slots, bs') =
 450                 dead_slots live_vars
 451                         [] []
 452                         [ (cg_id b, b) | b <- varEnvElts binds ]
 453         setBinds $ mkVarEnv bs'
 454         freeStackSlots dead_stk_slots
 455 \end{code}
 456
 457 Several boring auxiliary functions to do the dirty work.
 458
 459 \begin{code}
 460 dead_slots :: StgLiveVars
 461            -> [(Id,CgIdInfo)]
 462            -> [VirtualSpOffset]
 463            -> [(Id,CgIdInfo)]
 464            -> ([VirtualSpOffset], [(Id,CgIdInfo)])
 465
 466 -- dead_slots carries accumulating parameters for
 467 --      filtered bindings, dead slots
 468 dead_slots live_vars fbs ds []
 469   = (ds, reverse fbs) -- Finished; rm the dups, if any
 470
 471 dead_slots live_vars fbs ds ((v,i):bs)
 472   | v `elementOfUniqSet` live_vars
 473     = dead_slots live_vars ((v,i):fbs) ds bs
 474           -- Live, so don't record it in dead slots
 475           -- Instead keep it in the filtered bindings
 476
 477   | otherwise
 478     = case cg_stb i of
 479         VirStkLoc offset
 480          | size > 0
 481          -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
 482
 483         _ -> dead_slots live_vars fbs ds bs
 484   where
 485     size :: WordOff
 486     size = cgRepSizeW (cg_rep i)
 487 \end{code}
 488
 489 \begin{code}
 490 getLiveStackSlots :: FCode [VirtualSpOffset]
 491 -- Return the offsets of slots in stack containig live pointers
 492 getLiveStackSlots
 493   = do  { binds <- getBinds
 494         ; return [off | CgIdInfo { cg_stb = VirStkLoc off,
 495                                    cg_rep = rep } <- varEnvElts binds,
 496                         isFollowableArg rep] }
 497 \end{code}
 498
 499 \begin{code}
 500 getLiveStackBindings :: FCode [(VirtualSpOffset, CgIdInfo)]
 501 getLiveStackBindings
 502   = do { binds <- getBinds
 503        ; return [(off, bind) |
 504                  bind <- varEnvElts binds,
 505                  CgIdInfo { cg_stb = VirStkLoc off,
 506                             cg_rep = rep} <- [bind],
 507                  isFollowableArg rep] }
 508 \end{code}