Move activeStgRegs into CodeGen.Platform
authorIan Lynagh <ian@well-typed.com>
Tue, 21 Aug 2012 16:44:38 +0000 (17:44 +0100)
committerIan Lynagh <ian@well-typed.com>
Tue, 21 Aug 2012 16:44:38 +0000 (17:44 +0100)
19 files changed:
compiler/codeGen/CgHeapery.lhs
compiler/codeGen/CgUtils.hs
compiler/codeGen/CodeGen/CallerSaves.hs [deleted file]
compiler/codeGen/CodeGen/Platform.hs [new file with mode: 0644]
compiler/codeGen/CodeGen/Platform/ARM.hs
compiler/codeGen/CodeGen/Platform/NoRegs.hs
compiler/codeGen/CodeGen/Platform/PPC.hs
compiler/codeGen/CodeGen/Platform/PPC_Darwin.hs
compiler/codeGen/CodeGen/Platform/SPARC.hs
compiler/codeGen/CodeGen/Platform/X86.hs
compiler/codeGen/CodeGen/Platform/X86_64.hs
compiler/codeGen/StgCmmUtils.hs
compiler/ghc.cabal.in
compiler/llvmGen/LlvmCodeGen.hs
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/nativeGen/AsmCodeGen.lhs
includes/CallerSaves.part.hs [deleted file]
includes/CodeGen.Platform.hs [new file with mode: 0644]

index c0c1513..2ce37cf 100644 (file)
@@ -526,8 +526,10 @@ do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl live
 \begin{code}
 hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 hpChkGen bytes liveness reentry
-  = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assigns
-          stg_gc_gen (Just activeStgRegs)
+  = do dflags <- getDynFlags
+       let platform = targetPlatform dflags
+       do_checks' (CmmLit (mkIntCLit 0)) bytes False True assigns
+                  stg_gc_gen (Just (activeStgRegs platform))
   where
     assigns = mkStmts [ mk_vanilla_assignment 9 liveness,
                         mk_vanilla_assignment 10 reentry ]
@@ -542,8 +544,10 @@ hpChkNodePointsAssignSp0 bytes sp0
 
 stkChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
 stkChkGen bytes liveness reentry
-  = do_checks' bytes (CmmLit (mkIntCLit 0)) True False assigns
-          stg_gc_gen (Just activeStgRegs)
+  = do dflags <- getDynFlags
+       let platform = targetPlatform dflags
+       do_checks' bytes (CmmLit (mkIntCLit 0)) True False assigns
+                  stg_gc_gen (Just (activeStgRegs platform))
   where
     assigns = mkStmts [ mk_vanilla_assignment 9 liveness,
                         mk_vanilla_assignment 10 reentry ]
index b488f16..4661450 100644 (file)
@@ -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)])
diff --git a/compiler/codeGen/CodeGen/CallerSaves.hs b/compiler/codeGen/CodeGen/CallerSaves.hs
deleted file mode 100644 (file)
index b6c709d..0000000
+++ /dev/null
@@ -1,32 +0,0 @@
-
-module CodeGen.CallerSaves (callerSaves) where
-
-import CmmExpr
-import Platform
-
-import qualified CodeGen.Platform.ARM        as ARM
-import qualified CodeGen.Platform.PPC        as PPC
-import qualified CodeGen.Platform.PPC_Darwin as PPC_Darwin
-import qualified CodeGen.Platform.SPARC      as SPARC
-import qualified CodeGen.Platform.X86        as X86
-import qualified CodeGen.Platform.X86_64     as X86_64
-import qualified CodeGen.Platform.NoRegs     as NoRegs
-
--- | Returns 'True' if this global register is stored in a caller-saves
--- machine register.
-
-callerSaves :: Platform -> GlobalReg -> Bool
-callerSaves platform
- = case platformArch platform of
-   ArchX86    -> X86.callerSaves
-   ArchX86_64 -> X86_64.callerSaves
-   ArchSPARC  -> SPARC.callerSaves
-   ArchARM {} -> ARM.callerSaves
-   arch
-    | arch `elem` [ArchPPC, ArchPPC_64] ->
-       case platformOS platform of
-       OSDarwin -> PPC_Darwin.callerSaves
-       _        -> PPC.callerSaves
-
-    | otherwise -> NoRegs.callerSaves
-
diff --git a/compiler/codeGen/CodeGen/Platform.hs b/compiler/codeGen/CodeGen/Platform.hs
new file mode 100644 (file)
index 0000000..66e8f85
--- /dev/null
@@ -0,0 +1,52 @@
+
+module CodeGen.Platform (callerSaves, activeStgRegs) where
+
+import CmmExpr
+import Platform
+
+import qualified CodeGen.Platform.ARM        as ARM
+import qualified CodeGen.Platform.PPC        as PPC
+import qualified CodeGen.Platform.PPC_Darwin as PPC_Darwin
+import qualified CodeGen.Platform.SPARC      as SPARC
+import qualified CodeGen.Platform.X86        as X86
+import qualified CodeGen.Platform.X86_64     as X86_64
+import qualified CodeGen.Platform.NoRegs     as NoRegs
+
+-- | Returns 'True' if this global register is stored in a caller-saves
+-- machine register.
+
+callerSaves :: Platform -> GlobalReg -> Bool
+callerSaves platform
+ = case platformArch platform of
+   ArchX86    -> X86.callerSaves
+   ArchX86_64 -> X86_64.callerSaves
+   ArchSPARC  -> SPARC.callerSaves
+   ArchARM {} -> ARM.callerSaves
+   arch
+    | arch `elem` [ArchPPC, ArchPPC_64] ->
+       case platformOS platform of
+       OSDarwin -> PPC_Darwin.callerSaves
+       _        -> PPC.callerSaves
+
+    | otherwise -> NoRegs.callerSaves
+
+-- | 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 :: Platform -> [GlobalReg]
+activeStgRegs platform
+ = case platformArch platform of
+   ArchX86    -> X86.activeStgRegs
+   ArchX86_64 -> X86_64.activeStgRegs
+   ArchSPARC  -> SPARC.activeStgRegs
+   ArchARM {} -> ARM.activeStgRegs
+   arch
+    | arch `elem` [ArchPPC, ArchPPC_64] ->
+       case platformOS platform of
+       OSDarwin -> PPC_Darwin.activeStgRegs
+       _        -> PPC.activeStgRegs
+
+    | otherwise -> NoRegs.activeStgRegs
+
index 0116139..cad3eb7 100644 (file)
@@ -1,9 +1,9 @@
 
-module CodeGen.Platform.ARM (callerSaves) where
+module CodeGen.Platform.ARM where
 
 import CmmExpr
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_arm 1
-#include "../../../../includes/CallerSaves.part.hs"
+#include "../../../../includes/CodeGen.Platform.hs"
 
index ff39dd9..6d7c334 100644 (file)
@@ -1,8 +1,8 @@
 
-module CodeGen.Platform.NoRegs (callerSaves) where
+module CodeGen.Platform.NoRegs where
 
 import CmmExpr
 
 #define MACHREGS_NO_REGS 1
-#include "../../../../includes/CallerSaves.part.hs"
+#include "../../../../includes/CodeGen.Platform.hs"
 
index c4c975a..19d0609 100644 (file)
@@ -1,9 +1,9 @@
 
-module CodeGen.Platform.PPC (callerSaves) where
+module CodeGen.Platform.PPC where
 
 import CmmExpr
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_powerpc 1
-#include "../../../../includes/CallerSaves.part.hs"
+#include "../../../../includes/CodeGen.Platform.hs"
 
index a0cbe7e..a53ee06 100644 (file)
@@ -1,10 +1,10 @@
 
-module CodeGen.Platform.PPC_Darwin (callerSaves) where
+module CodeGen.Platform.PPC_Darwin where
 
 import CmmExpr
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_powerpc 1
 #define MACHREGS_darwin 1
-#include "../../../../includes/CallerSaves.part.hs"
+#include "../../../../includes/CodeGen.Platform.hs"
 
index 86b9494..391d6c8 100644 (file)
@@ -1,9 +1,9 @@
 
-module CodeGen.Platform.SPARC (callerSaves) where
+module CodeGen.Platform.SPARC where
 
 import CmmExpr
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_sparc 1
-#include "../../../../includes/CallerSaves.part.hs"
+#include "../../../../includes/CodeGen.Platform.hs"
 
index c19bf9d..c5ea94f 100644 (file)
@@ -1,9 +1,9 @@
 
-module CodeGen.Platform.X86 (callerSaves) where
+module CodeGen.Platform.X86 where
 
 import CmmExpr
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_i386 1
-#include "../../../../includes/CallerSaves.part.hs"
+#include "../../../../includes/CodeGen.Platform.hs"
 
index 59cf788..c5aa080 100644 (file)
@@ -1,9 +1,9 @@
 
-module CodeGen.Platform.X86_64 (callerSaves) where
+module CodeGen.Platform.X86_64 where
 
 import CmmExpr
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_x86_64 1
-#include "../../../../includes/CallerSaves.part.hs"
+#include "../../../../includes/CodeGen.Platform.hs"
 
index ad435c7..d6bc23c 100644 (file)
@@ -57,7 +57,7 @@ import StgCmmClosure
 import Cmm
 import BlockId
 import MkGraph
-import CodeGen.CallerSaves
+import CodeGen.Platform
 import CLabel
 import CmmUtils
 
index 047b83d..12ed631 100644 (file)
@@ -200,7 +200,7 @@ Library
         PprCmmDecl
         PprCmmExpr
         Bitmap
-        CodeGen.CallerSaves
+        CodeGen.Platform
         CodeGen.Platform.ARM
         CodeGen.Platform.NoRegs
         CodeGen.Platform.PPC
index a813433..2ff1ed9 100644 (file)
@@ -146,7 +146,7 @@ cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmDecl
 cmmLlvmGen dflags us env cmm = do
     -- rewrite assignments to global regs
     let fixed_cmm = {-# SCC "llvm_fix_regs" #-}
-                    fixStgRegisters cmm
+                    fixStgRegisters (targetPlatform dflags) cmm
 
     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm"
         (pprCmmGroup [fixed_cmm])
index 77eb845..d9a43fb 100644 (file)
@@ -99,17 +99,20 @@ llvmFunSig env lbl link
 
 llvmFunSig' :: DynFlags -> LMString -> LlvmLinkageType -> LlvmFunctionDecl
 llvmFunSig' dflags lbl link
-  = let toParams x | isPointer x = (x, [NoAlias, NoCapture])
+  = let platform = targetPlatform dflags
+        toParams x | isPointer x = (x, [NoAlias, NoCapture])
                    | otherwise   = (x, [])
     in LlvmFunctionDecl lbl link (llvmGhcCC dflags) LMVoid FixedArgs
-                        (map (toParams . getVarType) llvmFunArgs) llvmFunAlign
+                        (map (toParams . getVarType) (llvmFunArgs platform))
+                        llvmFunAlign
 
 -- | Create a Haskell function in LLVM.
 mkLlvmFunc :: LlvmEnv -> CLabel -> LlvmLinkageType -> LMSection -> LlvmBlocks
            -> LlvmFunction
 mkLlvmFunc env lbl link sec blks
-  = let funDec = llvmFunSig env lbl link
-        funArgs = map (fsLit . getPlainName) llvmFunArgs
+  = let platform = targetPlatform $ getDflags env
+        funDec = llvmFunSig env lbl link
+        funArgs = map (fsLit . getPlainName) (llvmFunArgs platform)
     in LlvmFunction funDec funArgs llvmStdFunAttrs sec blks
 
 -- | Alignment to use for functions
@@ -121,8 +124,8 @@ llvmInfAlign :: LMAlign
 llvmInfAlign = Just wORD_SIZE
 
 -- | A Function's arguments
-llvmFunArgs :: [LlvmVar]
-llvmFunArgs = map lmGlobalRegArg activeStgRegs
+llvmFunArgs :: Platform -> [LlvmVar]
+llvmFunArgs platform = map lmGlobalRegArg (activeStgRegs platform)
 
 -- | Llvm standard fun attributes
 llvmStdFunAttrs :: [LlvmFuncAttr]
index 25152a9..7f80cab 100644 (file)
@@ -55,10 +55,11 @@ basicBlocksCodeGen :: LlvmEnv
                    -> ( [LlvmBasicBlock] , [LlvmCmmDecl] )
                    -> UniqSM (LlvmEnv, [LlvmBasicBlock] , [LlvmCmmDecl] )
 basicBlocksCodeGen env ([]) (blocks, tops)
-  = do let (blocks', allocs) = mapAndUnzip dominateAllocs blocks
+  = do let platform = targetPlatform $ getDflags env
+       let (blocks', allocs) = mapAndUnzip dominateAllocs blocks
        let allocs' = concat allocs
        let ((BasicBlock id fstmts):rblks) = blocks'
-       let fblocks = (BasicBlock id $ funPrologue ++  allocs' ++ fstmts):rblks
+       let fblocks = (BasicBlock id $ funPrologue platform ++ allocs' ++ fstmts):rblks
        return (env, fblocks, tops)
 
 basicBlocksCodeGen env (block:blocks) (lblocks', ltops')
@@ -1226,8 +1227,8 @@ genLit _ CmmHighStackMark
 --
 
 -- | Function prologue. Load STG arguments into variables for function.
-funPrologue :: [LlvmStatement]
-funPrologue = concat $ map getReg activeStgRegs
+funPrologue :: Platform -> [LlvmStatement]
+funPrologue platform = concat $ map getReg $ activeStgRegs platform
     where getReg rr =
             let reg   = lmGlobalRegVar rr
                 arg   = lmGlobalRegArg rr
@@ -1240,11 +1241,13 @@ funPrologue = concat $ map getReg activeStgRegs
 funEpilogue :: LlvmEnv -> Maybe [GlobalReg] -> UniqSM ([LlvmVar], LlvmStatements)
 
 -- Have information and liveness optimisation is enabled
-funEpilogue env (Just live) | dopt Opt_RegLiveness (getDflags env) = do
-    loads <- mapM loadExpr activeStgRegs
+funEpilogue env (Just live) | dopt Opt_RegLiveness dflags = do
+    loads <- mapM loadExpr (activeStgRegs platform)
     let (vars, stmts) = unzip loads
     return (vars, concatOL stmts)
   where
+    dflags = getDflags env
+    platform = targetPlatform dflags
     loadExpr r | r `elem` alwaysLive || r `elem` live = do
         let reg  = lmGlobalRegVar r
         (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg
@@ -1254,11 +1257,13 @@ funEpilogue env (Just live) | dopt Opt_RegLiveness (getDflags env) = do
         return (LMLitVar $ LMUndefLit ty, unitOL Nop)
 
 -- don't do liveness optimisation
-funEpilogue _ _ = do
-    loads <- mapM loadExpr activeStgRegs
+funEpilogue env _ = do
+    loads <- mapM loadExpr (activeStgRegs platform)
     let (vars, stmts) = unzip loads
     return (vars, concatOL stmts)
   where
+    dflags = getDflags env
+    platform = targetPlatform dflags
     loadExpr r = do
         let reg  = lmGlobalRegVar r
         (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg
@@ -1277,8 +1282,9 @@ funEpilogue _ _ = do
 -- need are restored from the Cmm local var and the ones we don't need
 -- are fine to be trashed.
 trashStmts :: DynFlags -> LlvmStatements
-trashStmts dflags = concatOL $ map trashReg activeStgRegs
-    where trashReg r =
+trashStmts dflags = concatOL $ map trashReg $ activeStgRegs platform
+    where platform = targetPlatform dflags
+          trashReg r =
             let reg   = lmGlobalRegVar r
                 ty    = (pLower . getVarType) reg
                 trash = unitOL $ Store (LMLitVar $ LMUndefLit ty) reg
index 6b8bc5d..7c7d20c 100644 (file)
@@ -378,7 +378,7 @@ cmmNativeGen dflags ncgImpl us cmm count
         -- rewrite assignments to global regs
         let fixed_cmm =
                 {-# SCC "fixStgRegisters" #-}
-                fixStgRegisters cmm
+                fixStgRegisters platform cmm
 
         -- cmm to cmm optimisations
         let (opt_cmm, imports) =
diff --git a/includes/CallerSaves.part.hs b/includes/CallerSaves.part.hs
deleted file mode 100644 (file)
index f5eec5f..0000000
+++ /dev/null
@@ -1,81 +0,0 @@
-
-#include <stg/MachRegs.h>
-
-callerSaves :: GlobalReg -> Bool
-#ifdef CALLER_SAVES_Base
-callerSaves BaseReg           = True
-#endif
-#ifdef CALLER_SAVES_R1
-callerSaves (VanillaReg 1 _)  = True
-#endif
-#ifdef CALLER_SAVES_R2
-callerSaves (VanillaReg 2 _)  = True
-#endif
-#ifdef CALLER_SAVES_R3
-callerSaves (VanillaReg 3 _)  = True
-#endif
-#ifdef CALLER_SAVES_R4
-callerSaves (VanillaReg 4 _)  = True
-#endif
-#ifdef CALLER_SAVES_R5
-callerSaves (VanillaReg 5 _)  = True
-#endif
-#ifdef CALLER_SAVES_R6
-callerSaves (VanillaReg 6 _)  = True
-#endif
-#ifdef CALLER_SAVES_R7
-callerSaves (VanillaReg 7 _)  = True
-#endif
-#ifdef CALLER_SAVES_R8
-callerSaves (VanillaReg 8 _)  = True
-#endif
-#ifdef CALLER_SAVES_R9
-callerSaves (VanillaReg 9 _)  = True
-#endif
-#ifdef CALLER_SAVES_R10
-callerSaves (VanillaReg 10 _) = True
-#endif
-#ifdef CALLER_SAVES_F1
-callerSaves (FloatReg 1)      = True
-#endif
-#ifdef CALLER_SAVES_F2
-callerSaves (FloatReg 2)      = True
-#endif
-#ifdef CALLER_SAVES_F3
-callerSaves (FloatReg 3)      = True
-#endif
-#ifdef CALLER_SAVES_F4
-callerSaves (FloatReg 4)      = True
-#endif
-#ifdef CALLER_SAVES_D1
-callerSaves (DoubleReg 1)     = True
-#endif
-#ifdef CALLER_SAVES_D2
-callerSaves (DoubleReg 2)     = True
-#endif
-#ifdef CALLER_SAVES_L1
-callerSaves (LongReg 1)       = True
-#endif
-#ifdef CALLER_SAVES_Sp
-callerSaves Sp                = True
-#endif
-#ifdef CALLER_SAVES_SpLim
-callerSaves SpLim             = True
-#endif
-#ifdef CALLER_SAVES_Hp
-callerSaves Hp                = True
-#endif
-#ifdef CALLER_SAVES_HpLim
-callerSaves HpLim             = True
-#endif
-#ifdef CALLER_SAVES_CCCS
-callerSaves CCCS              = True
-#endif
-#ifdef CALLER_SAVES_CurrentTSO
-callerSaves CurrentTSO        = True
-#endif
-#ifdef CALLER_SAVES_CurrentNursery
-callerSaves CurrentNursery    = True
-#endif
-callerSaves _                 = False
-
diff --git a/includes/CodeGen.Platform.hs b/includes/CodeGen.Platform.hs
new file mode 100644 (file)
index 0000000..5ab3642
--- /dev/null
@@ -0,0 +1,145 @@
+
+#include <stg/MachRegs.h>
+
+callerSaves :: GlobalReg -> Bool
+#ifdef CALLER_SAVES_Base
+callerSaves BaseReg           = True
+#endif
+#ifdef CALLER_SAVES_R1
+callerSaves (VanillaReg 1 _)  = True
+#endif
+#ifdef CALLER_SAVES_R2
+callerSaves (VanillaReg 2 _)  = True
+#endif
+#ifdef CALLER_SAVES_R3
+callerSaves (VanillaReg 3 _)  = True
+#endif
+#ifdef CALLER_SAVES_R4
+callerSaves (VanillaReg 4 _)  = True
+#endif
+#ifdef CALLER_SAVES_R5
+callerSaves (VanillaReg 5 _)  = True
+#endif
+#ifdef CALLER_SAVES_R6
+callerSaves (VanillaReg 6 _)  = True
+#endif
+#ifdef CALLER_SAVES_R7
+callerSaves (VanillaReg 7 _)  = True
+#endif
+#ifdef CALLER_SAVES_R8
+callerSaves (VanillaReg 8 _)  = True
+#endif
+#ifdef CALLER_SAVES_R9
+callerSaves (VanillaReg 9 _)  = True
+#endif
+#ifdef CALLER_SAVES_R10
+callerSaves (VanillaReg 10 _) = True
+#endif
+#ifdef CALLER_SAVES_F1
+callerSaves (FloatReg 1)      = True
+#endif
+#ifdef CALLER_SAVES_F2
+callerSaves (FloatReg 2)      = True
+#endif
+#ifdef CALLER_SAVES_F3
+callerSaves (FloatReg 3)      = True
+#endif
+#ifdef CALLER_SAVES_F4
+callerSaves (FloatReg 4)      = True
+#endif
+#ifdef CALLER_SAVES_D1
+callerSaves (DoubleReg 1)     = True
+#endif
+#ifdef CALLER_SAVES_D2
+callerSaves (DoubleReg 2)     = True
+#endif
+#ifdef CALLER_SAVES_L1
+callerSaves (LongReg 1)       = True
+#endif
+#ifdef CALLER_SAVES_Sp
+callerSaves Sp                = True
+#endif
+#ifdef CALLER_SAVES_SpLim
+callerSaves SpLim             = True
+#endif
+#ifdef CALLER_SAVES_Hp
+callerSaves Hp                = True
+#endif
+#ifdef CALLER_SAVES_HpLim
+callerSaves HpLim             = True
+#endif
+#ifdef CALLER_SAVES_CCCS
+callerSaves CCCS              = True
+#endif
+#ifdef CALLER_SAVES_CurrentTSO
+callerSaves CurrentTSO        = True
+#endif
+#ifdef CALLER_SAVES_CurrentNursery
+callerSaves CurrentNursery    = True
+#endif
+callerSaves _                 = False
+
+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
+    ]
+