cmm: Expose machine's stack and return address register

We will need to use these to setup proper unwinding information for the
stg_stop_thread closure. This pokes a hole in the STG abstraction,
exposing the machine's stack pointer register so that we can accomplish
this. We also expose a dummy return address register, which corresponds
to the register used to hold the DWARF return address.

Differential Revision: https://phabricator.haskell.org/D1225

8 files changed, 31 insertions, 1 deletions

diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 10d08747c9..8a86bb46f6 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -459,6 +459,15 @@ data GlobalReg
   -- (where necessary) in the native code generator.
   | BaseReg
 
+  -- The register used by the platform for the C stack pointer. This is
+  -- a break in the STG abstraction used exclusively to setup stack unwinding
+  -- information.
+  | MachSp
+
+  -- The is a dummy register used to indicate to the stack unwinder where
+  -- a routine would return to.
+  | UnwindReturnReg
+
   -- Base Register for PIC (position-independent code) calculations
   -- Only used inside the native code generator. It's exact meaning differs
   -- from platform to platform (see module PositionIndependentCode).
@@ -486,6 +495,8 @@ instance Eq GlobalReg where
    GCEnter1 == GCEnter1 = True
    GCFun == GCFun = True
    BaseReg == BaseReg = True
+   MachSp == MachSp = True
+   UnwindReturnReg == UnwindReturnReg = True
    PicBaseReg == PicBaseReg = True
    _r1 == _r2 = False
 
@@ -510,6 +521,8 @@ instance Ord GlobalReg where
    compare GCEnter1 GCEnter1 = EQ
    compare GCFun GCFun = EQ
    compare BaseReg BaseReg = EQ
+   compare MachSp MachSp = EQ
+   compare UnwindReturnReg UnwindReturnReg = EQ
    compare PicBaseReg PicBaseReg = EQ
    compare (VanillaReg _ _) _ = LT
    compare _ (VanillaReg _ _) = GT
@@ -547,6 +560,10 @@ instance Ord GlobalReg where
    compare _ GCFun = GT
    compare BaseReg _ = LT
    compare _ BaseReg = GT
+   compare MachSp _ = LT
+   compare _ MachSp = GT
+   compare UnwindReturnReg _ = LT
+   compare _ UnwindReturnReg = GT
    compare EagerBlackholeInfo _ = LT
    compare _ EagerBlackholeInfo = GT
 
diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x
index a9ad3e5443..175259a3e9 100644
--- a/compiler/cmm/CmmLex.x
+++ b/compiler/cmm/CmmLex.x
@@ -110,6 +110,8 @@ $white_no_nl+           ;
   CurrentNursery        { global_reg CurrentNursery }
   HpAlloc               { global_reg HpAlloc }
   BaseReg               { global_reg BaseReg }
+  MachSp                { global_reg MachSp }
+  UnwindReturnReg       { global_reg UnwindReturnReg }
 
   $namebegin $namechar* { name }
 
diff --git a/compiler/cmm/PprCmmExpr.hs b/compiler/cmm/PprCmmExpr.hs
index 0bb79ac147..1f1c7f8e49 100644
--- a/compiler/cmm/PprCmmExpr.hs
+++ b/compiler/cmm/PprCmmExpr.hs
@@ -262,6 +262,8 @@ pprGlobalReg gr
         SpLim          -> ptext (sLit "SpLim")
         Hp             -> ptext (sLit "Hp")
         HpLim          -> ptext (sLit "HpLim")
+        MachSp         -> ptext (sLit "MachSp")
+        UnwindReturnReg-> ptext (sLit "UnwindReturnReg")
         CCCS           -> ptext (sLit "CCCS")
         CurrentTSO     -> ptext (sLit "CurrentTSO")
         CurrentNursery -> ptext (sLit "CurrentNursery")
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 51b8ed9ec8..a19731295a 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -86,6 +86,8 @@ baseRegOffset dflags GCEnter1            = oFFSET_stgGCEnter1 dflags
 baseRegOffset dflags GCFun               = oFFSET_stgGCFun dflags
 baseRegOffset _      BaseReg             = panic "baseRegOffset:BaseReg"
 baseRegOffset _      PicBaseReg          = panic "baseRegOffset:PicBaseReg"
+baseRegOffset _      MachSp              = panic "baseRegOffset:MachSp"
+baseRegOffset _      UnwindReturnReg     = panic "baseRegOffset:UnwindReturnReg"
 
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/llvmGen/LlvmCodeGen/Regs.hs
index 0048659069..8ac41530cb 100644
--- a/compiler/llvmGen/LlvmCodeGen/Regs.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Regs.hs
@@ -76,6 +76,7 @@ lmGlobalReg dflags suf reg
         ZmmReg 4       -> zmmGlobal $ "ZMM4" ++ suf
         ZmmReg 5       -> zmmGlobal $ "ZMM5" ++ suf
         ZmmReg 6       -> zmmGlobal $ "ZMM6" ++ suf
+        MachSp         -> wordGlobal $ "MachSp" ++ suf
         _other         -> panic $ "LlvmCodeGen.Reg: GlobalReg (" ++ (show reg)
                                 ++ ") not supported!"
         -- LongReg, HpLim, CCSS, CurrentTSO, CurrentNusery, HpAlloc
diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs
index bd423b6958..abded88468 100644
--- a/compiler/nativeGen/Dwarf/Types.hs
+++ b/compiler/nativeGen/Dwarf/Types.hs
@@ -337,7 +337,8 @@ pprFrameBlock oldUws (DwarfFrameBlock blockLbl hasInfo uws)
 
 -- | Get DWARF register ID for a given GlobalReg
 dwarfGlobalRegNo :: Platform -> GlobalReg -> Word8
-dwarfGlobalRegNo p = maybe 0 (dwarfRegNo p . RegReal) . globalRegMaybe p
+dwarfGlobalRegNo p UnwindReturnReg = dwarfReturnRegNo p
+dwarfGlobalRegNo p reg = maybe 0 (dwarfRegNo p . RegReal) $ globalRegMaybe p reg
 
 -- | Generate code for setting the unwind information for a register,
 -- optimized using its known old value in the table. Note that "Sp" is
diff --git a/includes/CodeGen.Platform.hs b/includes/CodeGen.Platform.hs
index b41ad54349..46550af213 100644
--- a/includes/CodeGen.Platform.hs
+++ b/includes/CodeGen.Platform.hs
@@ -815,6 +815,9 @@ globalRegMaybe CurrentTSO               = Just (RealRegSingle REG_CurrentTSO)
 # ifdef REG_CurrentNursery
 globalRegMaybe CurrentNursery           = Just (RealRegSingle REG_CurrentNursery)
 # endif
+# ifdef REG_MachSp
+globalRegMaybe MachSp                   = Just (RealRegSingle REG_MachSp)
+# endif
 globalRegMaybe _                        = Nothing
 #elif MACHREGS_NO_REGS
 globalRegMaybe _ = Nothing
diff --git a/includes/stg/MachRegs.h b/includes/stg/MachRegs.h
index b7090275ab..b1a0ef083e 100644
--- a/includes/stg/MachRegs.h
+++ b/includes/stg/MachRegs.h
@@ -102,6 +102,7 @@
 #if STOLEN_X86_REGS >= 4
 # define REG_Hp     edi
 #endif
+#define REG_MachSp  esp
 
 #define REG_XMM1    xmm0
 #define REG_XMM2    xmm1
@@ -169,6 +170,7 @@
 #define REG_R5    r8
 #define REG_R6    r9
 #define REG_SpLim r15
+#define REG_MachSp  rsp
 
 /*
 Map both Fn and Dn to register xmmn so that we can pass a function any