compiler/llvmGen/LlvmCodeGen/Regs.hs

   1 -- ----------------------------------------------------------------------------
   2 -- | Deal with Cmm registers
   3 --
   4
   5 module LlvmCodeGen.Regs (
   6         lmGlobalRegArg, lmGlobalRegVar
   7     ) where
   8
   9 #include "HsVersions.h"
  10
  11 import Llvm
  12
  13 import CmmExpr
  14 import Outputable ( panic )
  15 import FastString
  16
  17 -- | Get the LlvmVar function variable storing the real register
  18 lmGlobalRegVar :: GlobalReg -> LlvmVar
  19 lmGlobalRegVar = lmGlobalReg "_Var"
  20
  21 -- | Get the LlvmVar function argument storing the real register
  22 lmGlobalRegArg :: GlobalReg -> LlvmVar
  23 lmGlobalRegArg = (pVarLower . lmGlobalReg "_Arg")
  24
  25 {- Need to make sure the names here can't conflict with the unique generated
  26    names. Uniques generated names containing only base62 chars. So using say
  27     the '_' char guarantees this.
  28 -}
  29 lmGlobalReg :: String -> GlobalReg -> LlvmVar
  30 lmGlobalReg suf reg
  31   = case reg of
  32         BaseReg        -> wordGlobal $ "Base" ++ suf
  33         Sp             -> wordGlobal $ "Sp" ++ suf
  34         Hp             -> wordGlobal $ "Hp" ++ suf
  35         VanillaReg 1 _ -> wordGlobal $ "R1" ++ suf
  36         VanillaReg 2 _ -> wordGlobal $ "R2" ++ suf
  37         VanillaReg 3 _ -> wordGlobal $ "R3" ++ suf
  38         VanillaReg 4 _ -> wordGlobal $ "R4" ++ suf
  39         VanillaReg 5 _ -> wordGlobal $ "R5" ++ suf
  40         VanillaReg 6 _ -> wordGlobal $ "R6" ++ suf
  41         SpLim          -> wordGlobal $ "SpLim" ++ suf
  42         FloatReg 1     -> floatGlobal $"F1" ++ suf
  43         FloatReg 2     -> floatGlobal $"F2" ++ suf
  44         FloatReg 3     -> floatGlobal $"F3" ++ suf
  45         FloatReg 4     -> floatGlobal $"F4" ++ suf
  46         DoubleReg 1    -> doubleGlobal $ "D1" ++ suf
  47         DoubleReg 2    -> doubleGlobal $ "D2" ++ suf
  48         _other         -> panic $ "LlvmCodeGen.Reg: GlobalReg (" ++ (show reg)
  49                                 ++ ") not supported!"
  50     where
  51         wordGlobal   name = LMNLocalVar (fsLit name) llvmWordPtr
  52         floatGlobal  name = LMNLocalVar (fsLit name) $ pLift LMFloat
  53         doubleGlobal name = LMNLocalVar (fsLit name) $ pLift LMDouble
  54