summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Cmm/CallConv.hs16
-rw-r--r--compiler/GHC/Cmm/Parser.y3
-rw-r--r--compiler/GHC/StgToCmm/Foreign.hs29
-rw-r--r--compiler/GHC/StgToCmm/Utils.hs17
-rw-r--r--includes/Cmm.h69
-rw-r--r--rts/StgMiscClosures.cmm4
6 files changed, 54 insertions, 84 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))
-------------------------------------------------------------------------
diff --git a/includes/Cmm.h b/includes/Cmm.h
index 349d6985f8..fc80ff76aa 100644
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -740,75 +740,6 @@
TICK_BUMP_BY(ALLOC_RTS_tot,bytes)
/* -----------------------------------------------------------------------------
- Saving and restoring 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.
- -------------------------------------------------------------------------- */
-
-#define SAVE_STGREGS \
- W_ r1, r2, r3, r4, r5, r6, r7, r8; \
- F_ f1, f2, f3, f4, f5, f6; \
- D_ d1, d2, d3, d4, d5, d6; \
- L_ l1; \
- \
- r1 = R1; \
- r2 = R2; \
- r3 = R3; \
- r4 = R4; \
- r5 = R5; \
- r6 = R6; \
- r7 = R7; \
- r8 = R8; \
- \
- f1 = F1; \
- f2 = F2; \
- f3 = F3; \
- f4 = F4; \
- f5 = F5; \
- f6 = F6; \
- \
- d1 = D1; \
- d2 = D2; \
- d3 = D3; \
- d4 = D4; \
- d5 = D5; \
- d6 = D6; \
- \
- l1 = L1;
-
-
-#define RESTORE_STGREGS \
- R1 = r1; \
- R2 = r2; \
- R3 = r3; \
- R4 = r4; \
- R5 = r5; \
- R6 = r6; \
- R7 = r7; \
- R8 = r8; \
- \
- F1 = f1; \
- F2 = f2; \
- F3 = f3; \
- F4 = f4; \
- F5 = f5; \
- F6 = f6; \
- \
- D1 = d1; \
- D2 = d2; \
- D3 = d3; \
- D4 = d4; \
- D5 = d5; \
- D6 = d6; \
- \
- L1 = l1;
-
-/* -----------------------------------------------------------------------------
Misc junk
-------------------------------------------------------------------------- */
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 85c1ad398e..4293dfb787 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -31,14 +31,14 @@ INFO_TABLE_RET (stg_stack_underflow_frame, UNDERFLOW_FRAME,
W_ new_tso;
W_ ret_off;
- SAVE_STGREGS
+ SAVE_REGS();
SAVE_THREAD_STATE();
(ret_off) = foreign "C" threadStackUnderflow(MyCapability() "ptr",
CurrentTSO);
LOAD_THREAD_STATE();
- RESTORE_STGREGS
+ RESTORE_REGS();
jump %ENTRY_CODE(Sp(ret_off)) [*]; // NB. all registers live!
}
View Lorry Controller Status