diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Cmm/CallConv.hs | 16 | ||||
| -rw-r--r-- | compiler/GHC/Cmm/Parser.y | 3 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Foreign.hs | 29 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Utils.hs | 17 |
4 files changed, 52 insertions, 13 deletions
diff --git a/compiler/GHC/Cmm/CallConv.hs b/compiler/GHC/Cmm/CallConv.hs index 35f63661fa..b1133896a7 100644 --- a/compiler/GHC/Cmm/CallConv.hs +++ b/compiler/GHC/Cmm/CallConv.hs @@ -206,9 +206,13 @@ realArgRegsCover dflags | passFloatArgsInXmm (targetPlatform dflags) = map ($VGcPtr) (realVanillaRegs dflags) ++ realLongRegs dflags ++ - map XmmReg (realXmmRegNos dflags) - | otherwise = map ($VGcPtr) (realVanillaRegs dflags) ++ - realFloatRegs dflags ++ - realDoubleRegs dflags ++ - realLongRegs dflags ++ - map XmmReg (realXmmRegNos dflags) + realDoubleRegs dflags -- we only need to save the low Double part of XMM registers. + -- Moreover, the NCG can't load/store full XMM + -- registers for now... + + | otherwise + = map ($VGcPtr) (realVanillaRegs dflags) ++ + realFloatRegs dflags ++ + realDoubleRegs dflags ++ + realLongRegs dflags + -- we don't save XMM registers if they are not used for parameter passing diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y index 1c9f0ad041..e3d7e93486 100644 --- a/compiler/GHC/Cmm/Parser.y +++ b/compiler/GHC/Cmm/Parser.y @@ -1115,6 +1115,9 @@ stmtMacros = listToUFM [ ( fsLit "LOAD_THREAD_STATE", \[] -> emitLoadThreadState ), ( fsLit "SAVE_THREAD_STATE", \[] -> emitSaveThreadState ), + ( fsLit "SAVE_REGS", \[] -> emitSaveRegs ), + ( fsLit "RESTORE_REGS", \[] -> emitRestoreRegs ), + ( fsLit "LDV_ENTER", \[e] -> ldvEnter e ), ( fsLit "LDV_RECORD_CREATE", \[e] -> ldvRecordCreate e ), diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs index 0681d41f96..87e4ae6ccb 100644 --- a/compiler/GHC/StgToCmm/Foreign.hs +++ b/compiler/GHC/StgToCmm/Foreign.hs @@ -13,6 +13,8 @@ module GHC.StgToCmm.Foreign ( emitSaveThreadState, saveThreadState, emitLoadThreadState, + emitSaveRegs, + emitRestoreRegs, loadThreadState, emitOpenNursery, emitCloseNursery, @@ -32,6 +34,7 @@ import GHC.Cmm.BlockId (newBlockId) import GHC.Cmm import GHC.Cmm.Utils import GHC.Cmm.Graph +import GHC.Cmm.CallConv import GHC.Core.Type import GHC.Types.RepType import GHC.Cmm.CLabel @@ -308,6 +311,32 @@ saveThreadState dflags = do else mkNop ] + + +-- | Save STG registers +-- +-- STG registers must be saved around a C call, just in case the STG +-- register is mapped to a caller-saves machine register. Normally we +-- don't need to worry about this the code generator has already +-- loaded any live STG registers into variables for us, but in +-- hand-written low-level Cmm code where we don't know which registers +-- are live, we might have to save them all. +emitSaveRegs :: FCode () +emitSaveRegs = do + dflags <- getDynFlags + let regs = realArgRegsCover dflags + save = catAGraphs (map (callerSaveGlobalReg dflags) regs) + emit save + +-- | Restore STG registers (see 'emitSaveRegs') +emitRestoreRegs :: FCode () +emitRestoreRegs = do + dflags <- getDynFlags + let regs = realArgRegsCover dflags + save = catAGraphs (map (callerRestoreGlobalReg dflags) regs) + emit save + + emitCloseNursery :: FCode () emitCloseNursery = do dflags <- getDynFlags diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs index 2814948189..27c79a8e62 100644 --- a/compiler/GHC/StgToCmm/Utils.hs +++ b/compiler/GHC/StgToCmm/Utils.hs @@ -23,6 +23,7 @@ module GHC.StgToCmm.Utils ( tagToClosure, mkTaggedObjectLoad, callerSaves, callerSaveVolatileRegs, get_GlobalReg_addr, + callerSaveGlobalReg, callerRestoreGlobalReg, cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord, cmmUGtWord, cmmSubWord, cmmMulWord, cmmAddWord, cmmUShrWord, @@ -249,8 +250,8 @@ 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) + caller_save = catAGraphs (map (callerSaveGlobalReg dflags) regs_to_save) + caller_load = catAGraphs (map (callerRestoreGlobalReg dflags) regs_to_save) system_regs = [ Sp,SpLim,Hp,HpLim,CCCS,CurrentTSO,CurrentNursery {- ,SparkHd,SparkTl,SparkBase,SparkLim -} @@ -258,12 +259,14 @@ callerSaveVolatileRegs dflags = (caller_save, caller_load) regs_to_save = filter (callerSaves platform) system_regs - callerSaveGlobalReg reg - = mkStore (get_GlobalReg_addr dflags reg) (CmmReg (CmmGlobal reg)) +callerSaveGlobalReg :: DynFlags -> GlobalReg -> CmmAGraph +callerSaveGlobalReg dflags reg + = mkStore (get_GlobalReg_addr dflags reg) (CmmReg (CmmGlobal reg)) - callerRestoreGlobalReg reg - = mkAssign (CmmGlobal reg) - (CmmLoad (get_GlobalReg_addr dflags reg) (globalRegType platform reg)) +callerRestoreGlobalReg :: DynFlags -> GlobalReg -> CmmAGraph +callerRestoreGlobalReg dflags reg + = mkAssign (CmmGlobal reg) + (CmmLoad (get_GlobalReg_addr dflags reg) (globalRegType (targetPlatform dflags) reg)) ------------------------------------------------------------------------- |