Define callerSaves for all platforms

This means that we now generate the same code whatever platform we are
on, which should help avoid changes on one platform breaking the build
on another.

It's also another step towards full cross-compilation.

5 files changed, 76 insertions, 179 deletions

diff --git a/compiler/codeGen/CallerSaves.hs b/compiler/codeGen/CallerSaves.hs
new file mode 100644
index 0000000000..babee9e36e
--- /dev/null
+++ b/compiler/codeGen/CallerSaves.hs
@@ -0,0 +1,51 @@
+
+module CallerSaves (callerSaves) where
+
+import CmmExpr
+import Platform
+
+-- | Returns 'True' if this global register is stored in a caller-saves
+-- machine register.
+
+callerSaves :: Platform -> GlobalReg -> Bool
+#define MACHREGS_NO_REGS 0
+callerSaves (Platform { platformArch = ArchX86 }) = platformCallerSaves
+  where
+#define MACHREGS_i386 1
+#include "../../includes/CallerSaves.part.hs"
+#undef MACHREGS_i386
+callerSaves (Platform { platformArch = ArchX86_64 }) = platformCallerSaves
+  where
+#define MACHREGS_x86_64 1
+#include "../../includes/CallerSaves.part.hs"
+#undef MACHREGS_x86_64
+callerSaves (Platform { platformArch = ppcArch, platformOS = OSDarwin })
+ | ppcArch `elem` [ArchPPC, ArchPPC_64] = platformCallerSaves
+  where
+#define MACHREGS_powerpc 1
+#define MACHREGS_darwin 1
+#include "../../includes/CallerSaves.part.hs"
+#undef MACHREGS_powerpc
+#undef MACHREGS_darwin
+callerSaves (Platform { platformArch = ppcArch })
+ | ppcArch `elem` [ArchPPC, ArchPPC_64] = platformCallerSaves
+  where
+#define MACHREGS_powerpc 1
+#include "../../includes/CallerSaves.part.hs"
+#undef MACHREGS_powerpc
+callerSaves (Platform { platformArch = ArchSPARC }) = platformCallerSaves
+  where
+#define MACHREGS_sparc 1
+#include "../../includes/CallerSaves.part.hs"
+#undef MACHREGS_sparc
+callerSaves (Platform { platformArch = ArchARM {} }) = platformCallerSaves
+  where
+#define MACHREGS_arm 1
+#include "../../includes/CallerSaves.part.hs"
+#undef MACHREGS_arm
+callerSaves _ = platformCallerSaves
+  where
+#undef MACHREGS_NO_REGS
+#define MACHREGS_NO_REGS 1
+#include "../../includes/CallerSaves.part.hs"
+
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 4a83d86592..a37245ea01 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -125,21 +125,23 @@ emitForeignCall'
         -> Code
 emitForeignCall' safety results target args vols _srt ret
   | not (playSafe safety) = do
+    dflags <- getDynFlags
     temp_args <- load_args_into_temps args
-    let (caller_save, caller_load) = callerSaveVolatileRegs vols
+    let (caller_save, caller_load) = callerSaveVolatileRegs dflags vols
     let caller_load' = if ret == CmmNeverReturns then [] else caller_load
     stmtsC caller_save
     stmtC (CmmCall target results temp_args ret)
     stmtsC caller_load'
 
   | otherwise = do
+    dflags <- getDynFlags
     -- Both 'id' and 'new_base' are GCKindNonPtr because they're
     -- RTS only objects and are not subject to garbage collection
     id <- newTemp bWord
     new_base <- newTemp (cmmRegType (CmmGlobal BaseReg))
     temp_args <- load_args_into_temps args
     temp_target <- load_target_into_temp target
-    let (caller_save, caller_load) = callerSaveVolatileRegs vols
+    let (caller_save, caller_load) = callerSaveVolatileRegs dflags vols
     emitSaveThreadState
     stmtsC caller_save
     -- The CmmUnsafe arguments are only correct because this part
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index b7acc1c54c..d64aaa87e3 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -48,6 +48,7 @@ module CgUtils (
 #include "../includes/stg/HaskellMachRegs.h"
 
 import BlockId
+import CallerSaves
 import CgMonad
 import TyCon
 import DataCon
@@ -260,11 +261,12 @@ emitRtsCallGen
    -> Maybe [GlobalReg]
    -> Code
 emitRtsCallGen res pkg fun args vols = do
+  dflags <- getDynFlags
+  let (caller_save, caller_load) = callerSaveVolatileRegs dflags vols
   stmtsC caller_save
   stmtC (CmmCall target res args CmmMayReturn)
   stmtsC caller_load
   where
-    (caller_save, caller_load) = callerSaveVolatileRegs vols
     target   = CmmCallee fun_expr CCallConv
     fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun)
 
@@ -281,9 +283,12 @@ emitRtsCallGen res pkg fun args vols = do
 --  * Regs.h claims that BaseReg should be saved last and loaded first
 --    * This might not have been tickled before since BaseReg is callee save
 --  * Regs.h saves SparkHd, ParkT1, SparkBase and SparkLim
-callerSaveVolatileRegs :: Maybe [GlobalReg] -> ([CmmStmt], [CmmStmt])
-callerSaveVolatileRegs vols = (caller_save, caller_load)
+callerSaveVolatileRegs :: DynFlags -> Maybe [GlobalReg]
+                       -> ([CmmStmt], [CmmStmt])
+callerSaveVolatileRegs dflags vols = (caller_save, caller_load)
   where
+    platform = targetPlatform dflags
+
     caller_save = foldr ($!) [] (map callerSaveGlobalReg    regs_to_save)
     caller_load = foldr ($!) [] (map callerRestoreGlobalReg regs_to_save)
 
@@ -301,102 +306,19 @@ callerSaveVolatileRegs vols = (caller_save, caller_load)
              ++ [ LongReg    n | n <- [0..mAX_Long_REG] ]
 
     callerSaveGlobalReg reg next
-        | callerSaves reg =
+        | callerSaves platform reg =
                 CmmStore (get_GlobalReg_addr reg)
                          (CmmReg (CmmGlobal reg)) : next
         | otherwise = next
 
     callerRestoreGlobalReg reg next
-        | callerSaves reg =
+        | callerSaves platform reg =
                 CmmAssign (CmmGlobal reg)
                           (CmmLoad (get_GlobalReg_addr reg) (globalRegType reg))
                         : next
         | otherwise = next
 
 
--- | Returns @True@ if this global register is stored in a caller-saves
--- machine register.
-
-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
-
-
 -- -----------------------------------------------------------------------------
 -- Information about global registers
 
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index 3976dee6f8..5a717bbc65 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -207,7 +207,8 @@ emitForeignCall
         -> FCode ReturnKind
 emitForeignCall safety results target args _ret
   | not (playSafe safety) = do
-    let (caller_save, caller_load) = callerSaveVolatileRegs
+    dflags <- getDynFlags
+    let (caller_save, caller_load) = callerSaveVolatileRegs dflags
     emit caller_save
     emit $ mkUnsafeCall target results args
     emit caller_load
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index caecff923b..af2b0203ec 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -57,6 +57,7 @@ import StgCmmClosure
 import Cmm
 import BlockId
 import MkGraph
+import CallerSaves
 import CLabel
 import CmmUtils
 
@@ -200,7 +201,9 @@ emitRtsCallGen
    -> Bool -- True <=> CmmSafe call
    -> FCode ()
 emitRtsCallGen res pkg fun args _vols safe
-  = do { updfr_off <- getUpdFrameOff
+  = do { dflags <- getDynFlags
+       ; updfr_off <- getUpdFrameOff
+       ; let (caller_save, caller_load) = callerSaveVolatileRegs dflags
        ; emit caller_save
        ; call updfr_off
        ; emit caller_load }
@@ -213,7 +216,6 @@ emitRtsCallGen res pkg fun args _vols safe
                          (ForeignConvention CCallConv arg_hints res_hints)) res' args'
     (args', arg_hints) = unzip args
     (res',  res_hints) = unzip res
-    (caller_save, caller_load) = callerSaveVolatileRegs
     fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun)
 
 
@@ -247,9 +249,11 @@ emitRtsCallGen res pkg fun args _vols safe
 -- cmm/CmmNode.hs.  Right now the workaround is to avoid inlining across
 -- unsafe foreign calls in rewriteAssignments, but this is strictly
 -- temporary.
-callerSaveVolatileRegs :: (CmmAGraph, CmmAGraph)
-callerSaveVolatileRegs = (caller_save, caller_load)
+callerSaveVolatileRegs :: DynFlags -> (CmmAGraph, CmmAGraph)
+callerSaveVolatileRegs dflags = (caller_save, caller_load)
   where
+    platform = targetPlatform dflags
+
     caller_save = catAGraphs (map callerSaveGlobalReg    regs_to_save)
     caller_load = catAGraphs (map callerRestoreGlobalReg regs_to_save)
 
@@ -257,7 +261,7 @@ callerSaveVolatileRegs = (caller_save, caller_load)
 		    {- ,SparkHd,SparkTl,SparkBase,SparkLim -}
 		  , BaseReg ]
 
-    regs_to_save = filter callerSaves system_regs
+    regs_to_save = filter (callerSaves platform) system_regs
 
     callerSaveGlobalReg reg
 	= mkStore (get_GlobalReg_addr reg) (CmmReg (CmmGlobal reg))
@@ -295,89 +299,6 @@ get_Regtable_addr_from_offset _rep offset =
 #endif
 
 
--- | Returns 'True' if this global register is stored in a caller-saves
--- machine register.
-
-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
-
-
 -- -----------------------------------------------------------------------------
 -- Information about global registers