Factor 'callerSaveVolatileRegs' out of the NCG and into CgUtil

This is needed because CgForeign and parts of the CPS pass now use
'callerSaveVolatileRegs' and not all platforms have access to the NCG.

diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index f3c9928..0f732d3 100644 (file)
--- a/compiler/cmm/CmmBrokenBlock.hs
+++ b/compiler/cmm/CmmBrokenBlock.hs
@@ -18,6 +18,7 @@ import CmmUtils
 import CLabel
 import MachOp (MachHint(..))
 
+import CgUtils (callerSaveVolatileRegs)
 import ClosureInfo
 
 import Maybes
@@ -27,12 +28,6 @@ import UniqSupply
 import Unique
 import UniqFM
 
-import MachRegs (callerSaveVolatileRegs)
-  -- HACK: this is part of the NCG so we shouldn't use this, but we need
-  -- it for now to eliminate the need for saved regs to be in CmmCall.
-  -- The long term solution is to factor callerSaveVolatileRegs
-  -- from nativeGen into codeGen
-
 -- This module takes a 'CmmBasicBlock' which might have 'CmmCall'
 -- statements in it with 'CmmSafe' set and breaks it up at each such call.
 -- It also collects information about the block for later use

diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index 3b93b09..6c9b5a5 100644 (file)
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -17,7 +17,6 @@ import CmmCallConv
 
 import CgProf (curCCS, curCCSAddr)
 import CgUtils (cmmOffsetW)
-import CgInfoTbls (entryCode)
 import SMRep
 import ForeignCall
 
@@ -29,12 +28,6 @@ import List
 
 import Panic
 
-import MachRegs (callerSaveVolatileRegs)
-  -- HACK: this is part of the NCG so we shouldn't use this, but we need
-  -- it for now to eliminate the need for saved regs to be in CmmCall.
-  -- The long term solution is to factor callerSaveVolatileRegs
-  -- from nativeGen into CPS
-
 -- The format for the call to a continuation
 -- The fst is the arguments that must be passed to the continuation
 -- by the continuation's caller.

diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 5d84da7..ce272e9 100644 (file)
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -37,12 +37,6 @@ import Constants
 import StaticFlags
 import Outputable
 
-import MachRegs (callerSaveVolatileRegs)
-  -- HACK: this is part of the NCG so we shouldn't use this, but we need
-  -- it for now to eliminate the need for saved regs to be in CmmCall.
-  -- The long term solution is to factor callerSaveVolatileRegs
-  -- from nativeGen into codeGen
-
 import Control.Monad
 
 -- -----------------------------------------------------------------------------

diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index c48b584..02f53c2 100644 (file)
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -19,6 +19,8 @@ module CgUtils (
        emitSwitch, emitLitSwitch,
        tagToClosure,
 
+        callerSaveVolatileRegs, get_GlobalReg_addr,
+
        cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord,
        cmmOffsetExprW, cmmOffsetExprB,
        cmmRegOffW, cmmRegOffB,
@@ -37,6 +39,7 @@ module CgUtils (
   ) where
 
 #include "HsVersions.h"
+#include "MachRegs.h"
 
 import CgMonad
 import TyCon
@@ -60,12 +63,6 @@ import FastString
 import PackageConfig
 import Outputable
 
-import MachRegs (callerSaveVolatileRegs)
-  -- HACK: this is part of the NCG so we shouldn't use this, but we need
-  -- it for now to eliminate the need for saved regs to be in CmmCall.
-  -- The long term solution is to factor callerSaveVolatileRegs
-  -- from nativeGen into codeGen
-
 import Data.Char
 import Data.Bits
 import Data.Word
@@ -302,6 +299,188 @@ emitRtsCall' res fun args vols safe = do
     target   = CmmForeignCall fun_expr CCallConv
     fun_expr = mkLblExpr (mkRtsCodeLabel fun)
 
+-----------------------------------------------------------------------------
+--
+--     Caller-Save Registers
+--
+-----------------------------------------------------------------------------
+
+-- Here we generate the sequence of saves/restores required around a
+-- foreign call instruction.
+
+-- TODO: reconcile with includes/Regs.h
+--  * 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)
+  where
+    caller_save = foldr ($!) [] (map callerSaveGlobalReg    regs_to_save)
+    caller_load = foldr ($!) [] (map callerRestoreGlobalReg regs_to_save)
+
+    system_regs = [Sp,SpLim,Hp,HpLim,CurrentTSO,CurrentNursery,
+                  {-SparkHd,SparkTl,SparkBase,SparkLim,-}BaseReg ]
+
+    regs_to_save = system_regs ++ vol_list
+
+    vol_list = case vols of Nothing -> all_of_em; Just regs -> regs
+
+    all_of_em = [ VanillaReg n | n <- [0..mAX_Vanilla_REG] ]
+            ++ [ FloatReg   n | n <- [0..mAX_Float_REG] ]
+            ++ [ DoubleReg  n | n <- [0..mAX_Double_REG] ]
+            ++ [ LongReg    n | n <- [0..mAX_Long_REG] ]
+
+    callerSaveGlobalReg reg next
+       | callerSaves reg = 
+               CmmStore (get_GlobalReg_addr reg) 
+                        (CmmReg (CmmGlobal reg)) : next
+       | otherwise = next
+
+    callerRestoreGlobalReg reg next
+       | callerSaves reg = 
+               CmmAssign (CmmGlobal reg)
+                         (CmmLoad (get_GlobalReg_addr reg) (globalRegRep reg))
+                       : next
+       | otherwise = next
+
+-- -----------------------------------------------------------------------------
+-- Global registers
+
+-- We map STG registers onto appropriate CmmExprs.  Either they map
+-- to real machine registers or stored as offsets from BaseReg.  Given
+-- a GlobalReg, get_GlobalReg_addr always produces the 
+-- register table address for it.
+-- (See also get_GlobalReg_reg_or_addr in MachRegs)
+
+get_GlobalReg_addr              :: GlobalReg -> CmmExpr
+get_GlobalReg_addr BaseReg = regTableOffset 0
+get_GlobalReg_addr mid     = get_Regtable_addr_from_offset 
+                               (globalRegRep mid) (baseRegOffset mid)
+
+-- Calculate a literal representing an offset into the register table.
+-- Used when we don't have an actual BaseReg to offset from.
+regTableOffset n = 
+  CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
+
+get_Regtable_addr_from_offset   :: MachRep -> Int -> CmmExpr
+get_Regtable_addr_from_offset rep offset =
+#ifdef REG_Base
+  CmmRegOff (CmmGlobal BaseReg) offset
+#else
+  regTableOffset 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_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_CurrentTSO
+callerSaves CurrentTSO         = True
+#endif
+#ifdef CALLER_SAVES_CurrentNursery
+callerSaves CurrentNursery     = True
+#endif
+callerSaves _                  = False
+
+
+-- -----------------------------------------------------------------------------
+-- Information about global registers
+
+baseRegOffset :: GlobalReg -> Int
+
+baseRegOffset (VanillaReg 1)      = oFFSET_StgRegTable_rR1
+baseRegOffset (VanillaReg 2)      = oFFSET_StgRegTable_rR2
+baseRegOffset (VanillaReg 3)      = oFFSET_StgRegTable_rR3
+baseRegOffset (VanillaReg 4)      = oFFSET_StgRegTable_rR4
+baseRegOffset (VanillaReg 5)      = oFFSET_StgRegTable_rR5
+baseRegOffset (VanillaReg 6)      = oFFSET_StgRegTable_rR6
+baseRegOffset (VanillaReg 7)      = oFFSET_StgRegTable_rR7
+baseRegOffset (VanillaReg 8)      = oFFSET_StgRegTable_rR8
+baseRegOffset (VanillaReg 9)      = oFFSET_StgRegTable_rR9
+baseRegOffset (VanillaReg 10)     = oFFSET_StgRegTable_rR10
+baseRegOffset (FloatReg  1)       = oFFSET_StgRegTable_rF1
+baseRegOffset (FloatReg  2)       = oFFSET_StgRegTable_rF2
+baseRegOffset (FloatReg  3)       = oFFSET_StgRegTable_rF3
+baseRegOffset (FloatReg  4)       = oFFSET_StgRegTable_rF4
+baseRegOffset (DoubleReg 1)       = oFFSET_StgRegTable_rD1
+baseRegOffset (DoubleReg 2)       = oFFSET_StgRegTable_rD2
+baseRegOffset Sp                 = oFFSET_StgRegTable_rSp
+baseRegOffset SpLim              = oFFSET_StgRegTable_rSpLim
+baseRegOffset (LongReg 1)         = oFFSET_StgRegTable_rL1
+baseRegOffset Hp                 = oFFSET_StgRegTable_rHp
+baseRegOffset HpLim              = oFFSET_StgRegTable_rHpLim
+baseRegOffset CurrentTSO         = oFFSET_StgRegTable_rCurrentTSO
+baseRegOffset CurrentNursery     = oFFSET_StgRegTable_rCurrentNursery
+baseRegOffset HpAlloc            = oFFSET_StgRegTable_rHpAlloc
+baseRegOffset GCEnter1           = oFFSET_stgGCEnter1
+baseRegOffset GCFun              = oFFSET_stgGCFun
+#ifdef DEBUG
+baseRegOffset BaseReg            = panic "baseRegOffset:BaseReg"
+baseRegOffset _                          = panic "baseRegOffset:other"
+#endif
+
 
 -------------------------------------------------------------------------
 --

diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs
index c4f84a4..bc96e9d 100644 (file)
--- a/compiler/nativeGen/MachRegs.lhs
+++ b/compiler/nativeGen/MachRegs.lhs
@@ -33,7 +33,6 @@ module MachRegs (
 
        -- * Global registers
         get_GlobalReg_reg_or_addr,
-       callerSaves, callerSaveVolatileRegs,
 
        -- * Machine-dependent register-related stuff
         allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
@@ -82,10 +81,11 @@ module MachRegs (
 -- HACK: go for the max
 #endif
 
-#include "../includes/MachRegs.h"
+#include "MachRegs.h"
 
 import Cmm
 import MachOp          ( MachRep(..) )
+import CgUtils          ( get_GlobalReg_addr )
 
 import CLabel           ( CLabel, mkMainCapabilityLabel )
 import Pretty
@@ -310,75 +310,16 @@ ripRel imm = AddrBaseIndex EABaseRip EAIndexNone imm
 -- We map STG registers onto appropriate CmmExprs.  Either they map
 -- to real machine registers or stored as offsets from BaseReg.  Given
 -- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real
--- register it is in, on this platform, or a StixExpr denoting the
--- address in the register table holding it.  get_MagicId_addr always
--- produces the register table address for it.
+-- register it is in, on this platform, or a CmmExpr denoting the
+-- address in the register table holding it.
+-- (See also get_GlobalReg_addr in CgUtils.)
 
 get_GlobalReg_reg_or_addr       :: GlobalReg -> Either Reg CmmExpr
-get_GlobalReg_addr              :: GlobalReg -> CmmExpr
-get_Regtable_addr_from_offset   :: MachRep -> Int -> CmmExpr
-
 get_GlobalReg_reg_or_addr mid
    = case globalRegMaybe mid of
         Just rr -> Left rr
         Nothing -> Right (get_GlobalReg_addr mid)
 
-get_GlobalReg_addr BaseReg = regTableOffset 0
-get_GlobalReg_addr mid     = get_Regtable_addr_from_offset 
-                               (globalRegRep mid) (baseRegOffset mid)
-
--- Calculate a literal representing an offset into the register table.
--- Used when we don't have an actual BaseReg to offset from.
-regTableOffset n = 
-  CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
-
-get_Regtable_addr_from_offset rep offset
-   = case globalRegMaybe BaseReg of
-                 Nothing -> regTableOffset offset
-                 Just _  -> CmmRegOff (CmmGlobal BaseReg) offset
-
--- -----------------------------------------------------------------------------
--- caller-save registers
-
--- Here we generate the sequence of saves/restores required around a
--- foreign call instruction.
-
--- TODO: reconcile with includes/Regs.h
---  * 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)
-  where
-    caller_save = foldr ($!) [] (map callerSaveGlobalReg    regs_to_save)
-    caller_load = foldr ($!) [] (map callerRestoreGlobalReg regs_to_save)
-
-    system_regs = [Sp,SpLim,Hp,HpLim,CurrentTSO,CurrentNursery,
-                  {-SparkHd,SparkTl,SparkBase,SparkLim,-}BaseReg ]
-
-    regs_to_save = system_regs ++ vol_list
-
-    vol_list = case vols of Nothing -> all_of_em; Just regs -> regs
-
-    all_of_em = [ VanillaReg n | n <- [0..mAX_Vanilla_REG] ]
-            ++ [ FloatReg   n | n <- [0..mAX_Float_REG] ]
-            ++ [ DoubleReg  n | n <- [0..mAX_Double_REG] ]
-            ++ [ LongReg    n | n <- [0..mAX_Long_REG] ]
-
-    callerSaveGlobalReg reg next
-       | callerSaves reg = 
-               CmmStore (get_GlobalReg_addr reg) 
-                        (CmmReg (CmmGlobal reg)) : next
-       | otherwise = next
-
-    callerRestoreGlobalReg reg next
-       | callerSaves reg = 
-               CmmAssign (CmmGlobal reg)
-                         (CmmLoad (get_GlobalReg_addr reg) (globalRegRep reg))
-                       : next
-       | otherwise = next
-
-
 -- ---------------------------------------------------------------------------
 -- Registers
 
@@ -1238,117 +1179,6 @@ freeReg REG_HpLim = fastBool False
 freeReg n               = fastBool True
 
 
--- -----------------------------------------------------------------------------
--- Information about global registers
-
-baseRegOffset :: GlobalReg -> Int
-
-baseRegOffset (VanillaReg 1)      = oFFSET_StgRegTable_rR1
-baseRegOffset (VanillaReg 2)      = oFFSET_StgRegTable_rR2
-baseRegOffset (VanillaReg 3)      = oFFSET_StgRegTable_rR3
-baseRegOffset (VanillaReg 4)      = oFFSET_StgRegTable_rR4
-baseRegOffset (VanillaReg 5)      = oFFSET_StgRegTable_rR5
-baseRegOffset (VanillaReg 6)      = oFFSET_StgRegTable_rR6
-baseRegOffset (VanillaReg 7)      = oFFSET_StgRegTable_rR7
-baseRegOffset (VanillaReg 8)      = oFFSET_StgRegTable_rR8
-baseRegOffset (VanillaReg 9)      = oFFSET_StgRegTable_rR9
-baseRegOffset (VanillaReg 10)     = oFFSET_StgRegTable_rR10
-baseRegOffset (FloatReg  1)       = oFFSET_StgRegTable_rF1
-baseRegOffset (FloatReg  2)       = oFFSET_StgRegTable_rF2
-baseRegOffset (FloatReg  3)       = oFFSET_StgRegTable_rF3
-baseRegOffset (FloatReg  4)       = oFFSET_StgRegTable_rF4
-baseRegOffset (DoubleReg 1)       = oFFSET_StgRegTable_rD1
-baseRegOffset (DoubleReg 2)       = oFFSET_StgRegTable_rD2
-baseRegOffset Sp                 = oFFSET_StgRegTable_rSp
-baseRegOffset SpLim              = oFFSET_StgRegTable_rSpLim
-baseRegOffset (LongReg 1)         = oFFSET_StgRegTable_rL1
-baseRegOffset Hp                 = oFFSET_StgRegTable_rHp
-baseRegOffset HpLim              = oFFSET_StgRegTable_rHpLim
-baseRegOffset CurrentTSO         = oFFSET_StgRegTable_rCurrentTSO
-baseRegOffset CurrentNursery     = oFFSET_StgRegTable_rCurrentNursery
-baseRegOffset HpAlloc            = oFFSET_StgRegTable_rHpAlloc
-baseRegOffset GCEnter1           = oFFSET_stgGCEnter1
-baseRegOffset GCFun              = oFFSET_stgGCFun
-#ifdef DEBUG
-baseRegOffset BaseReg            = panic "baseRegOffset:BaseReg"
-baseRegOffset _                          = panic "baseRegOffset:other"
-#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_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_CurrentTSO
-callerSaves CurrentTSO         = True
-#endif
-#ifdef CALLER_SAVES_CurrentNursery
-callerSaves CurrentNursery     = True
-#endif
-callerSaves _                  = False
-
-
 --  | Returns 'Nothing' if this global register is not stored
 -- in a real machine register, otherwise returns @'Just' reg@, where
 -- reg is the machine register it is stored in.