Move activeStgRegs into CodeGen.Platform

1 files changed, 30 insertions, 98 deletions

diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index b488f16299..4661450fe5 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -48,7 +48,7 @@ module CgUtils (
 #include "../includes/stg/HaskellMachRegs.h"
 
 import BlockId
-import CodeGen.CallerSaves
+import CodeGen.Platform
 import CgMonad
 import TyCon
 import DataCon
@@ -70,6 +70,7 @@ import Util
 import DynFlags
 import FastString
 import Outputable
+import Platform
 
 import Data.Char
 import Data.Word
@@ -805,75 +806,6 @@ srt_escape = -1
 --
 -- -----------------------------------------------------------------------------
 
--- | Here is where the STG register map is defined for each target arch.
--- The order matters (for the llvm backend anyway)! We must make sure to
--- maintain the order here with the order used in the LLVM calling conventions.
--- Note that also, this isn't all registers, just the ones that are currently
--- possbily mapped to real registers.
-activeStgRegs :: [GlobalReg]
-activeStgRegs = [
-#ifdef REG_Base
-    BaseReg
-#endif
-#ifdef REG_Sp
-    ,Sp
-#endif
-#ifdef REG_Hp
-    ,Hp
-#endif
-#ifdef REG_R1
-    ,VanillaReg 1 VGcPtr
-#endif
-#ifdef REG_R2
-    ,VanillaReg 2 VGcPtr
-#endif
-#ifdef REG_R3
-    ,VanillaReg 3 VGcPtr
-#endif
-#ifdef REG_R4
-    ,VanillaReg 4 VGcPtr
-#endif
-#ifdef REG_R5
-    ,VanillaReg 5 VGcPtr
-#endif
-#ifdef REG_R6
-    ,VanillaReg 6 VGcPtr
-#endif
-#ifdef REG_R7
-    ,VanillaReg 7 VGcPtr
-#endif
-#ifdef REG_R8
-    ,VanillaReg 8 VGcPtr
-#endif
-#ifdef REG_R9
-    ,VanillaReg 9 VGcPtr
-#endif
-#ifdef REG_R10
-    ,VanillaReg 10 VGcPtr
-#endif
-#ifdef REG_SpLim
-    ,SpLim
-#endif
-#ifdef REG_F1
-    ,FloatReg 1
-#endif
-#ifdef REG_F2
-    ,FloatReg 2
-#endif
-#ifdef REG_F3
-    ,FloatReg 3
-#endif
-#ifdef REG_F4
-    ,FloatReg 4
-#endif
-#ifdef REG_D1
-    ,DoubleReg 1
-#endif
-#ifdef REG_D2
-    ,DoubleReg 2
-#endif
-    ]
-
 -- | We map STG registers onto appropriate CmmExprs.  Either they map
 -- to real machine registers or stored as offsets from BaseReg.  Given
 -- a GlobalReg, get_GlobalReg_addr always produces the
@@ -899,60 +831,60 @@ get_Regtable_addr_from_offset _ offset =
 
 -- | Fixup global registers so that they assign to locations within the
 -- RegTable if they aren't pinned for the current target.
-fixStgRegisters :: RawCmmDecl -> RawCmmDecl
-fixStgRegisters top@(CmmData _ _) = top
+fixStgRegisters :: Platform -> RawCmmDecl -> RawCmmDecl
+fixStgRegisters _ top@(CmmData _ _) = top
 
-fixStgRegisters (CmmProc info lbl (ListGraph blocks)) =
-  let blocks' = map fixStgRegBlock blocks
+fixStgRegisters platform (CmmProc info lbl (ListGraph blocks)) =
+  let blocks' = map (fixStgRegBlock platform) blocks
   in CmmProc info lbl $ ListGraph blocks'
 
-fixStgRegBlock :: CmmBasicBlock -> CmmBasicBlock
-fixStgRegBlock (BasicBlock id stmts) =
-  let stmts' = map fixStgRegStmt stmts
+fixStgRegBlock :: Platform -> CmmBasicBlock -> CmmBasicBlock
+fixStgRegBlock platform (BasicBlock id stmts) =
+  let stmts' = map (fixStgRegStmt platform) stmts
   in BasicBlock id stmts'
 
-fixStgRegStmt :: CmmStmt -> CmmStmt
-fixStgRegStmt stmt
+fixStgRegStmt :: Platform -> CmmStmt -> CmmStmt
+fixStgRegStmt platform stmt
   = case stmt of
         CmmAssign (CmmGlobal reg) src ->
-            let src' = fixStgRegExpr src
+            let src' = fixStgRegExpr platform src
                 baseAddr = get_GlobalReg_addr reg
-            in case reg `elem` activeStgRegs of
+            in case reg `elem` activeStgRegs platform of
                 True  -> CmmAssign (CmmGlobal reg) src'
                 False -> CmmStore baseAddr src'
 
         CmmAssign reg src ->
-            let src' = fixStgRegExpr src
+            let src' = fixStgRegExpr platform src
             in CmmAssign reg src'
 
-        CmmStore addr src -> CmmStore (fixStgRegExpr addr) (fixStgRegExpr src)
+        CmmStore addr src -> CmmStore (fixStgRegExpr platform addr) (fixStgRegExpr platform src)
 
         CmmCall target regs args returns ->
             let target' = case target of
-                    CmmCallee e conv -> CmmCallee (fixStgRegExpr e) conv
+                    CmmCallee e conv -> CmmCallee (fixStgRegExpr platform e) conv
                     CmmPrim op mStmts ->
-                        CmmPrim op (fmap (map fixStgRegStmt) mStmts)
+                        CmmPrim op (fmap (map (fixStgRegStmt platform)) mStmts)
                 args' = map (\(CmmHinted arg hint) ->
-                                (CmmHinted (fixStgRegExpr arg) hint)) args
+                                (CmmHinted (fixStgRegExpr platform arg) hint)) args
             in CmmCall target' regs args' returns
 
-        CmmCondBranch test dest -> CmmCondBranch (fixStgRegExpr test) dest
+        CmmCondBranch test dest -> CmmCondBranch (fixStgRegExpr platform test) dest
 
-        CmmSwitch expr ids -> CmmSwitch (fixStgRegExpr expr) ids
+        CmmSwitch expr ids -> CmmSwitch (fixStgRegExpr platform expr) ids
 
-        CmmJump addr live -> CmmJump (fixStgRegExpr addr) live
+        CmmJump addr live -> CmmJump (fixStgRegExpr platform addr) live
 
         -- CmmNop, CmmComment, CmmBranch, CmmReturn
         _other -> stmt
 
 
-fixStgRegExpr :: CmmExpr ->  CmmExpr
-fixStgRegExpr expr
+fixStgRegExpr :: Platform -> CmmExpr ->  CmmExpr
+fixStgRegExpr platform expr
   = case expr of
-        CmmLoad addr ty -> CmmLoad (fixStgRegExpr addr) ty
+        CmmLoad addr ty -> CmmLoad (fixStgRegExpr platform addr) ty
 
         CmmMachOp mop args -> CmmMachOp mop args'
-            where args' = map fixStgRegExpr args
+            where args' = map (fixStgRegExpr platform) args
 
         CmmReg (CmmGlobal reg) ->
             -- Replace register leaves with appropriate StixTrees for
@@ -961,22 +893,22 @@ fixStgRegExpr expr
             -- to mean the address of the reg table in MainCapability,
             -- and for all others we generate an indirection to its
             -- location in the register table.
-            case reg `elem` activeStgRegs of
+            case reg `elem` activeStgRegs platform of
                 True  -> expr
                 False ->
                     let baseAddr = get_GlobalReg_addr reg
                     in case reg of
-                        BaseReg -> fixStgRegExpr baseAddr
-                        _other  -> fixStgRegExpr
+                        BaseReg -> fixStgRegExpr platform baseAddr
+                        _other  -> fixStgRegExpr platform
                                     (CmmLoad baseAddr (globalRegType reg))
 
         CmmRegOff (CmmGlobal reg) offset ->
             -- RegOf leaves are just a shorthand form. If the reg maps
             -- to a real reg, we keep the shorthand, otherwise, we just
             -- expand it and defer to the above code.
-            case reg `elem` activeStgRegs of
+            case reg `elem` activeStgRegs platform of
                 True  -> expr
-                False -> fixStgRegExpr (CmmMachOp (MO_Add wordWidth) [
+                False -> fixStgRegExpr platform (CmmMachOp (MO_Add wordWidth) [
                                     CmmReg (CmmGlobal reg),
                                     CmmLit (CmmInt (fromIntegral offset)
                                                 wordWidth)])