compiler/codeGen/CgBindery.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[CgBindery]{Utility functions related to doing @CgBindings@}
   5
   6 \begin{code}
   7 module CgBindery (
   8         CgBindings, CgIdInfo,
   9         StableLoc, VolatileLoc,
  10
  11         cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
  12
  13         stableIdInfo, heapIdInfo,
  14         letNoEscapeIdInfo, idInfoToAmode,
  15
  16         addBindC, addBindsC,
  17
  18         nukeVolatileBinds,
  19         nukeDeadBindings,
  20         getLiveStackSlots,
  21
  22         bindArgsToStack,  rebindToStack,
  23         bindNewToNode, bindNewToReg, bindArgsToRegs,
  24         bindNewToTemp,
  25         getArgAmode, getArgAmodes,
  26         getCgIdInfo,
  27         getCAddrModeIfVolatile, getVolatileRegs,
  28         maybeLetNoEscape,
  29     ) where
  30
  31 #include "HsVersions.h"
  32
  33 import CgMonad
  34 import CgHeapery        ( getHpRelOffset )
  35 import CgStackery       ( freeStackSlots, getSpRelOffset )
  36 import CgUtils          ( cgLit, cmmOffsetW )
  37 import CLabel           ( mkClosureLabel, pprCLabel )
  38 import ClosureInfo      ( mkLFImported, mkLFArgument, LambdaFormInfo )
  39
  40 import Cmm
  41 import PprCmm           ( {- instance Outputable -} )
  42 import SMRep            ( CgRep(..), WordOff, isFollowableArg,
  43                           isVoidArg, cgRepSizeW, argMachRep,
  44                           idCgRep, typeCgRep )
  45 import Id               ( Id, idName )
  46 import VarEnv
  47 import VarSet           ( varSetElems )
  48 import Literal          ( literalType )
  49 import Maybes           ( catMaybes )
  50 import Name             ( isExternalName )
  51 import StgSyn           ( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg )
  52 import Unique           ( Uniquable(..) )
  53 import UniqSet          ( elementOfUniqSet )
  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 CmmReg
 396 bindNewToTemp id
 397   = do  addBindC id (regIdInfo id temp_reg lf_info)
 398         return temp_reg
 399   where
 400     uniq     = getUnique id
 401     temp_reg = CmmLocal (LocalReg uniq (argMachRep (idCgRep id)))
 402     lf_info  = mkLFArgument id  -- Always used of things we
 403                                 -- know nothing about
 404
 405 bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code
 406 bindNewToReg name reg lf_info
 407   = addBindC name info
 408   where
 409     info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info
 410 \end{code}
 411
 412 \begin{code}
 413 rebindToStack :: Id -> VirtualSpOffset -> Code
 414 rebindToStack name offset
 415   = modifyBindC name replace_stable_fn
 416   where
 417     replace_stable_fn info = info { cg_stb = VirStkLoc offset }
 418 \end{code}
 419
 420 %************************************************************************
 421 %*                                                                      *
 422 \subsection[CgMonad-deadslots]{Finding dead stack slots}
 423 %*                                                                      *
 424 %************************************************************************
 425
 426 nukeDeadBindings does the following:
 427
 428       - Removes all bindings from the environment other than those
 429         for variables in the argument to nukeDeadBindings.
 430       - Collects any stack slots so freed, and returns them to the  stack free
 431         list.
 432       - Moves the virtual stack pointer to point to the topmost used
 433         stack locations.
 434
 435 You can have multi-word slots on the stack (where a Double# used to
 436 be, for instance); if dead, such a slot will be reported as *several*
 437 offsets (one per word).
 438
 439 Probably *naughty* to look inside monad...
 440
 441 \begin{code}
 442 nukeDeadBindings :: StgLiveVars  -- All the *live* variables
 443                  -> Code
 444 nukeDeadBindings live_vars = do
 445         binds <- getBinds
 446         let (dead_stk_slots, bs') =
 447                 dead_slots live_vars
 448                         [] []
 449                         [ (cg_id b, b) | b <- varEnvElts binds ]
 450         setBinds $ mkVarEnv bs'
 451         freeStackSlots dead_stk_slots
 452 \end{code}
 453
 454 Several boring auxiliary functions to do the dirty work.
 455
 456 \begin{code}
 457 dead_slots :: StgLiveVars
 458            -> [(Id,CgIdInfo)]
 459            -> [VirtualSpOffset]
 460            -> [(Id,CgIdInfo)]
 461            -> ([VirtualSpOffset], [(Id,CgIdInfo)])
 462
 463 -- dead_slots carries accumulating parameters for
 464 --      filtered bindings, dead slots
 465 dead_slots live_vars fbs ds []
 466   = (ds, reverse fbs) -- Finished; rm the dups, if any
 467
 468 dead_slots live_vars fbs ds ((v,i):bs)
 469   | v `elementOfUniqSet` live_vars
 470     = dead_slots live_vars ((v,i):fbs) ds bs
 471           -- Live, so don't record it in dead slots
 472           -- Instead keep it in the filtered bindings
 473
 474   | otherwise
 475     = case cg_stb i of
 476         VirStkLoc offset
 477          | size > 0
 478          -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
 479
 480         _ -> dead_slots live_vars fbs ds bs
 481   where
 482     size :: WordOff
 483     size = cgRepSizeW (cg_rep i)
 484 \end{code}
 485
 486 \begin{code}
 487 getLiveStackSlots :: FCode [VirtualSpOffset]
 488 -- Return the offsets of slots in stack containig live pointers
 489 getLiveStackSlots
 490   = do  { binds <- getBinds
 491         ; return [off | CgIdInfo { cg_stb = VirStkLoc off,
 492                                    cg_rep = rep } <- varEnvElts binds,
 493                         isFollowableArg rep] }
 494 \end{code}