Remove duplicate functions in StgCmmUtils, use functions from CgUtils
[ghc.git] / compiler / codeGen / CgUtils.hs
index 6b36ab0..0ff9bd8 100644 (file)
@@ -1,3 +1,5 @@
+{-# LANGUAGE GADTs #-}
+
 -----------------------------------------------------------------------------
 --
 -- Code generator utilities; mostly monadic
@@ -6,14 +8,20 @@
 --
 -----------------------------------------------------------------------------
 
-{-# LANGUAGE GADTs #-}
-module CgUtils ( fixStgRegisters ) where
+module CgUtils (
+        fixStgRegisters,
+        baseRegOffset,
+        get_Regtable_addr_from_offset,
+        regTableOffset,
+        get_GlobalReg_addr,
+  ) where
 
-#include "HsVersions.h"
+import GhcPrelude
 
 import CodeGen.Platform
 import Cmm
-import Hoopl
+import Hoopl.Block
+import Hoopl.Graph
 import CmmUtils
 import CLabel
 import DynFlags
@@ -83,8 +91,10 @@ baseRegOffset dflags HpAlloc             = oFFSET_StgRegTable_rHpAlloc dflags
 baseRegOffset dflags EagerBlackholeInfo  = oFFSET_stgEagerBlackholeInfo dflags
 baseRegOffset dflags GCEnter1            = oFFSET_stgGCEnter1 dflags
 baseRegOffset dflags GCFun               = oFFSET_stgGCFun dflags
-baseRegOffset _      BaseReg             = panic "baseRegOffset:BaseReg"
-baseRegOffset _      PicBaseReg          = panic "baseRegOffset:PicBaseReg"
+baseRegOffset _      BaseReg             = panic "CgUtils.baseRegOffset:BaseReg"
+baseRegOffset _      PicBaseReg          = panic "CgUtils.baseRegOffset:PicBaseReg"
+baseRegOffset _      MachSp              = panic "CgUtils.baseRegOffset:MachSp"
+baseRegOffset _      UnwindReturnReg     = panic "CgUtils.baseRegOffset:UnwindReturnReg"
 
 
 -- -----------------------------------------------------------------------------
@@ -100,8 +110,7 @@ baseRegOffset _      PicBaseReg          = panic "baseRegOffset:PicBaseReg"
 get_GlobalReg_addr :: DynFlags -> GlobalReg -> CmmExpr
 get_GlobalReg_addr dflags BaseReg = regTableOffset dflags 0
 get_GlobalReg_addr dflags mid
-    = get_Regtable_addr_from_offset dflags
-                                    (globalRegType dflags mid) (baseRegOffset dflags mid)
+    = get_Regtable_addr_from_offset dflags (baseRegOffset dflags mid)
 
 -- Calculate a literal representing an offset into the register table.
 -- Used when we don't have an actual BaseReg to offset from.
@@ -109,10 +118,10 @@ regTableOffset :: DynFlags -> Int -> CmmExpr
 regTableOffset dflags n =
   CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r dflags + n))
 
-get_Regtable_addr_from_offset :: DynFlags -> CmmType -> Int -> CmmExpr
-get_Regtable_addr_from_offset dflags offset =
+get_Regtable_addr_from_offset :: DynFlags -> Int -> CmmExpr
+get_Regtable_addr_from_offset dflags offset =
     if haveRegBase (targetPlatform dflags)
-    then CmmRegOff (CmmGlobal BaseReg) offset
+    then CmmRegOff baseReg offset
     else regTableOffset dflags offset
 
 -- | Fixup global registers so that they assign to locations within the
@@ -134,7 +143,11 @@ fixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt
 
     fixAssign stmt =
       case stmt of
-        CmmAssign (CmmGlobal reg) src ->
+        CmmAssign (CmmGlobal reg) src
+          -- MachSp isn't an STG register; it's merely here for tracking unwind
+          -- information
+          | reg == MachSp -> stmt
+          | otherwise ->
             let baseAddr = get_GlobalReg_addr dflags reg
             in case reg `elem` activeStgRegs (targetPlatform dflags) of
                 True  -> CmmAssign (CmmGlobal reg) src
@@ -142,6 +155,8 @@ fixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt
         other_stmt -> other_stmt
 
     fixExpr expr = case expr of
+        -- MachSp isn't an STG; it's merely here for tracking unwind information
+        CmmReg (CmmGlobal MachSp) -> expr
         CmmReg (CmmGlobal reg) ->
             -- Replace register leaves with appropriate StixTrees for
             -- the given target.  MagicIds which map to a reg on this
@@ -169,4 +184,3 @@ fixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt
                                                    (wordWidth dflags))]
 
         other_expr -> other_expr
-