diff options
Diffstat (limited to 'compiler/codeGen')
| -rw-r--r-- | compiler/codeGen/CallerSaves.hs | 51 | ||||
| -rw-r--r-- | compiler/codeGen/CgForeignCall.hs | 6 | ||||
| -rw-r--r-- | compiler/codeGen/CgUtils.hs | 98 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmForeign.hs | 3 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmUtils.hs | 97 |
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 |