compiler/llvmGen/LlvmCodeGen/Regs.hs

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