ghc/compiler/codeGen/CgBindery.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[CgBindery]{Utility functions related to doing @CgBindings@}
   5
   6 \begin{code}
   7 module CgBindery (
   8         CgBindings, CgIdInfo(..){-dubiously concrete-},
   9         StableLoc, VolatileLoc,
  10
  11         maybeAStkLoc, maybeBStkLoc,
  12
  13         stableAmodeIdInfo, heapIdInfo, newTempAmodeAndIdInfo,
  14         letNoEscapeIdInfo, idInfoToAmode,
  15
  16         nukeVolatileBinds,
  17
  18         bindNewToAStack, bindNewToBStack,
  19         bindNewToNode, bindNewToReg, bindArgsToRegs,
  20         bindNewToTemp, bindNewPrimToAmode,
  21         getArgAmode, getArgAmodes,
  22         getCAddrModeAndInfo, getCAddrMode,
  23         getCAddrModeIfVolatile, getVolatileRegs,
  24         rebindToAStack, rebindToBStack
  25     ) where
  26
  27 #include "HsVersions.h"
  28
  29 import AbsCSyn
  30 import CgMonad
  31
  32 import CgUsages         ( getHpRelOffset, getSpARelOffset, getSpBRelOffset )
  33 import CLabel           ( mkStaticClosureLabel, mkClosureLabel )
  34 import ClosureInfo      ( mkLFImported, mkConLFInfo, mkLFArgument, LambdaFormInfo )
  35 import HeapOffs         ( VirtualHeapOffset,
  36                           VirtualSpAOffset, VirtualSpBOffset
  37                         )
  38 import Id               ( idPrimRep,
  39                           mkIdEnv, rngIdEnv, IdEnv,
  40                           idSetToList,
  41                           Id
  42                         )
  43 import Literal          ( Literal )
  44 import Maybes           ( catMaybes )
  45 import Name             ( isLocallyDefined, isWiredInName,
  46                           Name{-instance NamedThing-}, NamedThing(..) )
  47 #ifdef DEBUG
  48 import PprAbsC          ( pprAmode )
  49 #endif
  50 import PrimRep          ( PrimRep )
  51 import StgSyn           ( StgArg, StgLiveVars, GenStgArg(..) )
  52 import Unique           ( Unique, Uniquable(..) )
  53 import Util             ( zipWithEqual, panic )
  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   = MkCgIdInfo  Id      -- Id that this is the info for
  77                 VolatileLoc
  78                 StableLoc
  79                 LambdaFormInfo
  80
  81 data VolatileLoc
  82   = NoVolatileLoc
  83   | TempVarLoc  Unique
  84
  85   | RegLoc      MagicId                 -- in one of the magic registers
  86                                         -- (probably {Int,Float,Char,etc}Reg
  87
  88   | VirHpLoc    VirtualHeapOffset       -- Hp+offset (address of closure)
  89
  90   | VirNodeLoc  VirtualHeapOffset       -- Cts of offset indirect from Node
  91                                         -- ie *(Node+offset)
  92 \end{code}
  93
  94 @StableLoc@ encodes where an Id can be found, used by
  95 the @CgBindings@ environment in @CgBindery@.
  96
  97 \begin{code}
  98 data StableLoc
  99   = NoStableLoc
 100   | VirAStkLoc          VirtualSpAOffset
 101   | VirBStkLoc          VirtualSpBOffset
 102   | LitLoc              Literal
 103   | StableAmodeLoc      CAddrMode
 104
 105 -- these are so StableLoc can be abstract:
 106
 107 maybeAStkLoc (VirAStkLoc offset) = Just offset
 108 maybeAStkLoc _                   = Nothing
 109
 110 maybeBStkLoc (VirBStkLoc offset) = Just offset
 111 maybeBStkLoc _                   = Nothing
 112 \end{code}
 113
 114 %************************************************************************
 115 %*                                                                      *
 116 \subsection[Bindery-idInfo]{Manipulating IdInfo}
 117 %*                                                                      *
 118 %************************************************************************
 119
 120 \begin{code}
 121 stableAmodeIdInfo i amode lf_info = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc amode) lf_info
 122 heapIdInfo i offset       lf_info = MkCgIdInfo i (VirHpLoc offset) NoStableLoc lf_info
 123 tempIdInfo i uniq         lf_info = MkCgIdInfo i (TempVarLoc uniq) NoStableLoc lf_info
 124
 125 letNoEscapeIdInfo i spa spb lf_info
 126   = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc (CJoinPoint spa spb)) lf_info
 127
 128 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
 129
 130 newTempAmodeAndIdInfo name lf_info
 131   = (temp_amode, temp_idinfo)
 132   where
 133     uniq        = uniqueOf name
 134     temp_amode  = CTemp uniq (idPrimRep name)
 135     temp_idinfo = tempIdInfo name uniq lf_info
 136
 137 idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode
 138 idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab
 139
 140 idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode
 141
 142 idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc   = returnFC (CTemp uniq kind)
 143 idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc   = returnFC (CReg magic_id)
 144
 145 idInfoPiecesToAmode kind NoVolatileLoc (LitLoc lit)           = returnFC (CLit lit)
 146 idInfoPiecesToAmode kind NoVolatileLoc (StableAmodeLoc amode) = returnFC amode
 147
 148 idInfoPiecesToAmode kind (VirNodeLoc nd_off) stable_loc
 149   = returnFC (CVal (NodeRel nd_off) kind)
 150     -- Virtual offsets from Node increase into the closures,
 151     -- and so do Node-relative offsets (which we want in the CVal),
 152     -- so there is no mucking about to do to the offset.
 153
 154 idInfoPiecesToAmode kind (VirHpLoc hp_off) stable_loc
 155   = getHpRelOffset hp_off `thenFC` \ rel_hp ->
 156     returnFC (CAddr rel_hp)
 157
 158 idInfoPiecesToAmode kind NoVolatileLoc (VirAStkLoc i)
 159   = getSpARelOffset i `thenFC` \ rel_spA ->
 160     returnFC (CVal rel_spA kind)
 161
 162 idInfoPiecesToAmode kind NoVolatileLoc (VirBStkLoc i)
 163   = getSpBRelOffset i `thenFC` \ rel_spB ->
 164     returnFC (CVal rel_spB kind)
 165
 166 #ifdef DEBUG
 167 idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc"
 168 #endif
 169 \end{code}
 170
 171 %************************************************************************
 172 %*                                                                      *
 173 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
 174 %*                                                                      *
 175 %************************************************************************
 176
 177 We sometimes want to nuke all the volatile bindings; we must be sure
 178 we don't leave any (NoVolatile, NoStable) binds around...
 179
 180 \begin{code}
 181 nukeVolatileBinds :: CgBindings -> CgBindings
 182 nukeVolatileBinds binds
 183   = mkIdEnv (foldr keep_if_stable [] (rngIdEnv binds))
 184   where
 185     keep_if_stable (MkCgIdInfo i _ NoStableLoc entry_info) acc = acc
 186     keep_if_stable (MkCgIdInfo i _ stable_loc  entry_info) acc
 187       = (i, MkCgIdInfo i NoVolatileLoc stable_loc entry_info) : acc
 188 \end{code}
 189
 190
 191 %************************************************************************
 192 %*                                                                      *
 193 \subsection[lookup-interface]{Interface functions to looking up bindings}
 194 %*                                                                      *
 195 %************************************************************************
 196
 197 I {\em think} all looking-up is done through @getCAddrMode(s)@.
 198
 199 \begin{code}
 200 getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
 201
 202 getCAddrModeAndInfo id
 203   | not (isLocallyDefined name) || isWiredInName name
 204     {- Why the "isWiredInName"?
 205         Imagine you are compiling PrelBase.hs (a module that
 206         supplies some of the wired-in values).  What can
 207         happen is that the compiler will inject calls to
 208         (e.g.) GHCbase.unpackPS, where-ever it likes -- it
 209         assumes those values are ubiquitously available.
 210         The main point is: it may inject calls to them earlier
 211         in GHCbase.hs than the actual definition...
 212     -}
 213   = returnFC (global_amode, mkLFImported id)
 214
 215   | otherwise = -- *might* be a nested defn: in any case, it's something whose
 216                 -- definition we will know about...
 217     lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
 218     idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
 219     returnFC (amode, lf_info)
 220   where
 221     name = getName id
 222     global_amode = CLbl (mkClosureLabel id) kind
 223     kind = idPrimRep id
 224
 225 getCAddrMode :: Id -> FCode CAddrMode
 226 getCAddrMode name
 227   = getCAddrModeAndInfo name `thenFC` \ (amode, _) ->
 228     returnFC amode
 229 \end{code}
 230
 231 \begin{code}
 232 getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode)
 233 getCAddrModeIfVolatile name
 234 --  | toplevelishId name = returnFC Nothing
 235 --  | otherwise
 236   = lookupBindC name `thenFC` \ ~(MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
 237     case stable_loc of
 238         NoStableLoc ->  -- Aha!  So it is volatile!
 239             idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc `thenFC` \ amode ->
 240             returnFC (Just amode)
 241
 242         a_stable_loc -> returnFC Nothing
 243 \end{code}
 244
 245 @getVolatileRegs@ gets a set of live variables, and returns a list of
 246 all registers on which these variables depend.  These are the regs
 247 which must be saved and restored across any C calls.  If a variable is
 248 both in a volatile location (depending on a register) {\em and} a
 249 stable one (notably, on the stack), we modify the current bindings to
 250 forget the volatile one.
 251
 252 \begin{code}
 253 getVolatileRegs :: StgLiveVars -> FCode [MagicId]
 254
 255 getVolatileRegs vars
 256   = mapFCs snaffle_it (idSetToList vars) `thenFC` \ stuff ->
 257     returnFC (catMaybes stuff)
 258   where
 259     snaffle_it var
 260       = lookupBindC var `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
 261         let
 262             -- commoned-up code...
 263             consider_reg reg
 264               = if not (isVolatileReg reg) then
 265                         -- Potentially dies across C calls
 266                         -- For now, that's everything; we leave
 267                         -- it to the save-macros to decide which
 268                         -- regs *really* need to be saved.
 269                     returnFC Nothing
 270                 else
 271                     case stable_loc of
 272                       NoStableLoc -> returnFC (Just reg) -- got one!
 273                       is_a_stable_loc ->
 274                         -- has both volatile & stable locations;
 275                         -- force it to rely on the stable location
 276                         modifyBindC var nuke_vol_bind `thenC`
 277                         returnFC Nothing
 278         in
 279         case volatile_loc of
 280           RegLoc reg   -> consider_reg reg
 281           VirHpLoc _   -> consider_reg Hp
 282           VirNodeLoc _ -> consider_reg node
 283           non_reg_loc  -> returnFC Nothing
 284
 285     nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info)
 286       = MkCgIdInfo i NoVolatileLoc stable_loc lf_info
 287 \end{code}
 288
 289 \begin{code}
 290 getArgAmodes :: [StgArg] -> FCode [CAddrMode]
 291 getArgAmodes [] = returnFC []
 292 getArgAmodes (atom:atoms)
 293   = getArgAmode  atom  `thenFC` \ amode ->
 294     getArgAmodes atoms `thenFC` \ amodes ->
 295     returnFC ( amode : amodes )
 296
 297 getArgAmode :: StgArg -> FCode CAddrMode
 298
 299 getArgAmode (StgConArg var)
 300      {- Why does this case differ from StgVarArg?
 301         Because the program might look like this:
 302                 data Foo a = Empty | Baz a
 303                 f a x = let c = Empty! a
 304                         in h c
 305         Now, when we go Core->Stg, we drop the type applications,
 306         so we can inline c, giving
 307                 f x = h Empty
 308         Now we are referring to Empty as an argument (rather than in an STGCon),
 309         so we'll look it up with getCAddrMode.  We want to return an amode for
 310         the static closure that we make for nullary constructors.  But if we blindly
 311         go ahead with getCAddrMode we end up looking in the environment, and it ain't there!
 312
 313         This special case used to be in getCAddrModeAndInfo, but it doesn't work there.
 314         Consider:
 315                 f a x = Baz a x
 316         If the constructor Baz isn't inlined we simply want to treat it like any other
 317         identifier, with a top level definition.  We don't want to spot that it's a constructor.
 318
 319         In short
 320                 StgApp con args
 321         and
 322                 StgCon con args
 323         are treated differently; the former is a call to a bog standard function while the
 324         latter uses the specially-labelled, pre-defined info tables etc for the constructor.
 325
 326         The way to think of this case in getArgAmode is that
 327                 SApp f Empty
 328         is really
 329                 App f (StgCon Empty [])
 330      -}
 331   = returnFC (CLbl (mkStaticClosureLabel var) (idPrimRep var))
 332
 333 getArgAmode (StgVarArg var) = getCAddrMode var          -- The common case
 334
 335 getArgAmode (StgLitArg lit) = returnFC (CLit lit)
 336 \end{code}
 337
 338 %************************************************************************
 339 %*                                                                      *
 340 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
 341 %*                                                                      *
 342 %************************************************************************
 343
 344 \begin{code}
 345 bindNewToAStack :: (Id, VirtualSpAOffset) -> Code
 346 bindNewToAStack (name, offset)
 347   = addBindC name info
 348   where
 349     info = MkCgIdInfo name NoVolatileLoc (VirAStkLoc offset) mkLFArgument
 350
 351 bindNewToBStack :: (Id, VirtualSpBOffset) -> Code
 352 bindNewToBStack (name, offset)
 353   = addBindC name info
 354   where
 355     info = MkCgIdInfo name NoVolatileLoc (VirBStkLoc offset) (panic "bindNewToBStack")
 356            -- B-stack things shouldn't need lambda-form info!
 357
 358 bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
 359 bindNewToNode name offset lf_info
 360   = addBindC name info
 361   where
 362     info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info
 363
 364 -- Create a new temporary whose unique is that in the id,
 365 -- bind the id to it, and return the addressing mode for the
 366 -- temporary.
 367 bindNewToTemp :: Id -> FCode CAddrMode
 368 bindNewToTemp name
 369   = let (temp_amode, id_info) = newTempAmodeAndIdInfo name mkLFArgument
 370                 -- This is used only for things we don't know
 371                 -- anything about; values returned by a case statement,
 372                 -- for example.
 373     in
 374     addBindC name id_info       `thenC`
 375     returnFC temp_amode
 376
 377 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code
 378 bindNewToReg name magic_id lf_info
 379   = addBindC name info
 380   where
 381     info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
 382
 383 bindNewToLit name lit
 384   = addBindC name info
 385   where
 386     info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (error "bindNewToLit")
 387
 388 bindArgsToRegs :: [Id] -> [MagicId] -> Code
 389 bindArgsToRegs args regs
 390   = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
 391   where
 392     arg `bind` reg = bindNewToReg arg reg mkLFArgument
 393 \end{code}
 394
 395 @bindNewPrimToAmode@ works only for certain addressing modes, because
 396 those are the only ones we've needed so far!
 397
 398 \begin{code}
 399 bindNewPrimToAmode :: Id -> CAddrMode -> Code
 400 bindNewPrimToAmode name (CReg reg) = bindNewToReg name reg (panic "bindNewPrimToAmode")
 401                                                 -- was: mkLFArgument
 402                                                 -- LFinfo is irrelevant for primitives
 403 bindNewPrimToAmode name (CTemp uniq kind)
 404   = addBindC name (tempIdInfo name uniq (panic "bindNewPrimToAmode"))
 405         -- LFinfo is irrelevant for primitives
 406
 407 bindNewPrimToAmode name (CLit lit) = bindNewToLit name lit
 408
 409 bindNewPrimToAmode name (CVal (SpBRel _ offset) _)
 410   = bindNewToBStack (name, offset)
 411
 412 bindNewPrimToAmode name (CVal (NodeRel offset) _)
 413   = bindNewToNode name offset (panic "bindNewPrimToAmode node")
 414   -- See comment on idInfoPiecesToAmode for VirNodeLoc
 415
 416 #ifdef DEBUG
 417 bindNewPrimToAmode name amode
 418   = pprPanic "bindNew...:" (pprAmode amode)
 419 #endif
 420 \end{code}
 421
 422 \begin{code}
 423 rebindToAStack :: Id -> VirtualSpAOffset -> Code
 424 rebindToAStack name offset
 425   = modifyBindC name replace_stable_fn
 426   where
 427     replace_stable_fn (MkCgIdInfo i vol stab einfo)
 428       = MkCgIdInfo i vol (VirAStkLoc offset) einfo
 429
 430 rebindToBStack :: Id -> VirtualSpBOffset -> Code
 431 rebindToBStack name offset
 432   = modifyBindC name replace_stable_fn
 433   where
 434     replace_stable_fn (MkCgIdInfo i vol stab einfo)
 435       = MkCgIdInfo i vol (VirBStkLoc offset) einfo
 436 \end{code}
 437