Module hierarchy: StgToCmm (#13009)

Add StgToCmm module hierarchy. Platform modules that are used in several
other places (NCG, LLVM codegen, Cmm transformations) are put into
GHC.Platform.

1 files changed, 0 insertions, 186 deletions

diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
deleted file mode 100644
index 0ff9bd8b56..0000000000
--- a/compiler/codeGen/CgUtils.hs
+++ /dev/null
@@ -1,186 +0,0 @@
-{-# LANGUAGE GADTs #-}
-
------------------------------------------------------------------------------
---
--- Code generator utilities; mostly monadic
---
--- (c) The University of Glasgow 2004-2006
---
------------------------------------------------------------------------------
-
-module CgUtils (
-        fixStgRegisters,
-        baseRegOffset,
-        get_Regtable_addr_from_offset,
-        regTableOffset,
-        get_GlobalReg_addr,
-  ) where
-
-import GhcPrelude
-
-import CodeGen.Platform
-import Cmm
-import Hoopl.Block
-import Hoopl.Graph
-import CmmUtils
-import CLabel
-import DynFlags
-import Outputable
-
--- -----------------------------------------------------------------------------
--- Information about global registers
-
-baseRegOffset :: DynFlags -> GlobalReg -> Int
-
-baseRegOffset dflags (VanillaReg 1 _)    = oFFSET_StgRegTable_rR1 dflags
-baseRegOffset dflags (VanillaReg 2 _)    = oFFSET_StgRegTable_rR2 dflags
-baseRegOffset dflags (VanillaReg 3 _)    = oFFSET_StgRegTable_rR3 dflags
-baseRegOffset dflags (VanillaReg 4 _)    = oFFSET_StgRegTable_rR4 dflags
-baseRegOffset dflags (VanillaReg 5 _)    = oFFSET_StgRegTable_rR5 dflags
-baseRegOffset dflags (VanillaReg 6 _)    = oFFSET_StgRegTable_rR6 dflags
-baseRegOffset dflags (VanillaReg 7 _)    = oFFSET_StgRegTable_rR7 dflags
-baseRegOffset dflags (VanillaReg 8 _)    = oFFSET_StgRegTable_rR8 dflags
-baseRegOffset dflags (VanillaReg 9 _)    = oFFSET_StgRegTable_rR9 dflags
-baseRegOffset dflags (VanillaReg 10 _)   = oFFSET_StgRegTable_rR10 dflags
-baseRegOffset _      (VanillaReg n _)    = panic ("Registers above R10 are not supported (tried to use R" ++ show n ++ ")")
-baseRegOffset dflags (FloatReg  1)       = oFFSET_StgRegTable_rF1 dflags
-baseRegOffset dflags (FloatReg  2)       = oFFSET_StgRegTable_rF2 dflags
-baseRegOffset dflags (FloatReg  3)       = oFFSET_StgRegTable_rF3 dflags
-baseRegOffset dflags (FloatReg  4)       = oFFSET_StgRegTable_rF4 dflags
-baseRegOffset dflags (FloatReg  5)       = oFFSET_StgRegTable_rF5 dflags
-baseRegOffset dflags (FloatReg  6)       = oFFSET_StgRegTable_rF6 dflags
-baseRegOffset _      (FloatReg  n)       = panic ("Registers above F6 are not supported (tried to use F" ++ show n ++ ")")
-baseRegOffset dflags (DoubleReg 1)       = oFFSET_StgRegTable_rD1 dflags
-baseRegOffset dflags (DoubleReg 2)       = oFFSET_StgRegTable_rD2 dflags
-baseRegOffset dflags (DoubleReg 3)       = oFFSET_StgRegTable_rD3 dflags
-baseRegOffset dflags (DoubleReg 4)       = oFFSET_StgRegTable_rD4 dflags
-baseRegOffset dflags (DoubleReg 5)       = oFFSET_StgRegTable_rD5 dflags
-baseRegOffset dflags (DoubleReg 6)       = oFFSET_StgRegTable_rD6 dflags
-baseRegOffset _      (DoubleReg n)       = panic ("Registers above D6 are not supported (tried to use D" ++ show n ++ ")")
-baseRegOffset dflags (XmmReg 1)          = oFFSET_StgRegTable_rXMM1 dflags
-baseRegOffset dflags (XmmReg 2)          = oFFSET_StgRegTable_rXMM2 dflags
-baseRegOffset dflags (XmmReg 3)          = oFFSET_StgRegTable_rXMM3 dflags
-baseRegOffset dflags (XmmReg 4)          = oFFSET_StgRegTable_rXMM4 dflags
-baseRegOffset dflags (XmmReg 5)          = oFFSET_StgRegTable_rXMM5 dflags
-baseRegOffset dflags (XmmReg 6)          = oFFSET_StgRegTable_rXMM6 dflags
-baseRegOffset _      (XmmReg n)          = panic ("Registers above XMM6 are not supported (tried to use XMM" ++ show n ++ ")")
-baseRegOffset dflags (YmmReg 1)          = oFFSET_StgRegTable_rYMM1 dflags
-baseRegOffset dflags (YmmReg 2)          = oFFSET_StgRegTable_rYMM2 dflags
-baseRegOffset dflags (YmmReg 3)          = oFFSET_StgRegTable_rYMM3 dflags
-baseRegOffset dflags (YmmReg 4)          = oFFSET_StgRegTable_rYMM4 dflags
-baseRegOffset dflags (YmmReg 5)          = oFFSET_StgRegTable_rYMM5 dflags
-baseRegOffset dflags (YmmReg 6)          = oFFSET_StgRegTable_rYMM6 dflags
-baseRegOffset _      (YmmReg n)          = panic ("Registers above YMM6 are not supported (tried to use YMM" ++ show n ++ ")")
-baseRegOffset dflags (ZmmReg 1)          = oFFSET_StgRegTable_rZMM1 dflags
-baseRegOffset dflags (ZmmReg 2)          = oFFSET_StgRegTable_rZMM2 dflags
-baseRegOffset dflags (ZmmReg 3)          = oFFSET_StgRegTable_rZMM3 dflags
-baseRegOffset dflags (ZmmReg 4)          = oFFSET_StgRegTable_rZMM4 dflags
-baseRegOffset dflags (ZmmReg 5)          = oFFSET_StgRegTable_rZMM5 dflags
-baseRegOffset dflags (ZmmReg 6)          = oFFSET_StgRegTable_rZMM6 dflags
-baseRegOffset _      (ZmmReg n)          = panic ("Registers above ZMM6 are not supported (tried to use ZMM" ++ show n ++ ")")
-baseRegOffset dflags Sp                  = oFFSET_StgRegTable_rSp dflags
-baseRegOffset dflags SpLim               = oFFSET_StgRegTable_rSpLim dflags
-baseRegOffset dflags (LongReg 1)         = oFFSET_StgRegTable_rL1 dflags
-baseRegOffset _      (LongReg n)         = panic ("Registers above L1 are not supported (tried to use L" ++ show n ++ ")")
-baseRegOffset dflags Hp                  = oFFSET_StgRegTable_rHp dflags
-baseRegOffset dflags HpLim               = oFFSET_StgRegTable_rHpLim dflags
-baseRegOffset dflags CCCS                = oFFSET_StgRegTable_rCCCS dflags
-baseRegOffset dflags CurrentTSO          = oFFSET_StgRegTable_rCurrentTSO dflags
-baseRegOffset dflags CurrentNursery      = oFFSET_StgRegTable_rCurrentNursery dflags
-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 "CgUtils.baseRegOffset:BaseReg"
-baseRegOffset _      PicBaseReg          = panic "CgUtils.baseRegOffset:PicBaseReg"
-baseRegOffset _      MachSp              = panic "CgUtils.baseRegOffset:MachSp"
-baseRegOffset _      UnwindReturnReg     = panic "CgUtils.baseRegOffset:UnwindReturnReg"
-
-
--- -----------------------------------------------------------------------------
---
--- STG/Cmm GlobalReg
---
--- -----------------------------------------------------------------------------
-
--- | 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.
-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 (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.
-regTableOffset :: DynFlags -> Int -> CmmExpr
-regTableOffset dflags n =
-  CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r dflags + n))
-
-get_Regtable_addr_from_offset :: DynFlags -> Int -> CmmExpr
-get_Regtable_addr_from_offset dflags offset =
-    if haveRegBase (targetPlatform dflags)
-    then CmmRegOff baseReg offset
-    else regTableOffset dflags offset
-
--- | Fixup global registers so that they assign to locations within the
--- RegTable if they aren't pinned for the current target.
-fixStgRegisters :: DynFlags -> RawCmmDecl -> RawCmmDecl
-fixStgRegisters _ top@(CmmData _ _) = top
-
-fixStgRegisters dflags (CmmProc info lbl live graph) =
-  let graph' = modifyGraph (mapGraphBlocks (fixStgRegBlock dflags)) graph
-  in CmmProc info lbl live graph'
-
-fixStgRegBlock :: DynFlags -> Block CmmNode e x -> Block CmmNode e x
-fixStgRegBlock dflags block = mapBlock (fixStgRegStmt dflags) block
-
-fixStgRegStmt :: DynFlags -> CmmNode e x -> CmmNode e x
-fixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt
-  where
-    platform = targetPlatform dflags
-
-    fixAssign stmt =
-      case stmt of
-        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
-                False -> CmmStore baseAddr src
-        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
-            -- arch are left unchanged.  For the rest, BaseReg is taken
-            -- to mean the address of the reg table in MainCapability,
-            -- and for all others we generate an indirection to its
-            -- location in the register table.
-            case reg `elem` activeStgRegs platform of
-                True  -> expr
-                False ->
-                    let baseAddr = get_GlobalReg_addr dflags reg
-                    in case reg of
-                        BaseReg -> baseAddr
-                        _other  -> CmmLoad baseAddr (globalRegType dflags reg)
-
-        CmmRegOff (CmmGlobal reg) offset ->
-            -- RegOf leaves are just a shorthand form. If the reg maps
-            -- to a real reg, we keep the shorthand, otherwise, we just
-            -- expand it and defer to the above code.
-            case reg `elem` activeStgRegs platform of
-                True  -> expr
-                False -> CmmMachOp (MO_Add (wordWidth dflags)) [
-                                    fixExpr (CmmReg (CmmGlobal reg)),
-                                    CmmLit (CmmInt (fromIntegral offset)
-                                                   (wordWidth dflags))]
-
-        other_expr -> other_expr