Cmm: introduce SAVE_REGS/RESTORE_REGS

We don't want to save both Fn and Dn register sets on x86-64 as they are
aliased to the same arch register (XMMn).

Moreover, when SAVE_STGREGS was used in conjunction with `jump foo [*]`
which makes a set of Cmm registers alive so that they cover all arch
registers used to pass parameter, we could have Fn, Dn and XMMn alive at
the same time. It made the LLVM code generator choke (see #17920).

Now `SAVE_REGS/RESTORE_REGS` and `jump foo [*]` use the same set of
registers.

(cherry picked from commit 54b595c1b91ad9e686b5baf7640177becb372336)

6 files changed, 57 insertions, 86 deletions

diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs
index dacaff41ba..37eb7c5021 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,
@@ -31,6 +33,7 @@ import GHC.StgToCmm.Layout
 import BlockId (newBlockId)
 import Cmm
 import CmmUtils
+import CmmCallConv
 import MkGraph
 import Type
 import RepType
@@ -304,6 +307,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 0b3a8d8b08..3b145b5441 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -22,6 +22,7 @@ module GHC.StgToCmm.Utils (
         tagToClosure, mkTaggedObjectLoad,
 
         callerSaves, callerSaveVolatileRegs, get_GlobalReg_addr,
+        callerSaveGlobalReg, callerRestoreGlobalReg,
 
         cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord,
         cmmUGtWord, cmmSubWord, cmmMulWord, cmmAddWord, cmmUShrWord,
@@ -247,8 +248,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 -}
@@ -256,12 +257,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 dflags reg))
+callerRestoreGlobalReg :: DynFlags -> GlobalReg -> CmmAGraph
+callerRestoreGlobalReg dflags reg
+    = mkAssign (CmmGlobal reg)
+               (CmmLoad (get_GlobalReg_addr dflags reg) (globalRegType dflags reg))
 
 
 -------------------------------------------------------------------------
diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index df1eaad005..1add72142a 100644
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -202,11 +202,16 @@ nodeOnly = ([VanillaReg 1], [], [], [], [])
 -- only use this functionality in hand-written C-- code in the RTS.
 realArgRegsCover :: DynFlags -> [GlobalReg]
 realArgRegsCover dflags
-    | passFloatArgsInXmm 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)
+    | passFloatArgsInXmm dflags
+    = map ($VGcPtr) (realVanillaRegs dflags) ++
+      realLongRegs 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/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 3cfb7ecee2..9458b9d621 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -1118,6 +1118,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/includes/Cmm.h b/includes/Cmm.h
index 546e81e8f6..e53ed4b227 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 03ea91fcb6..44d7d302e5 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!
 }