summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorRichard Eisenberg <rae@richarde.dev>2021-06-01 15:32:34 -0400
committerRichard Eisenberg <rae@richarde.dev>2021-06-01 15:33:24 -0400
commitff6a88ec8bedf59295c2c154c1056b80569fe756 (patch)
tree1b19dc9bf743448fb105ac00528ab9bfbfca0459 /compiler
parent6db8a0f76ec45d47060e28bb303e9eef60bdb16b (diff)
downloadhaskell-wip/lower-parser-deps.tar.gz
A little import wrangling. Not much accomplishedwip/lower-parser-deps
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/ByteCode/Asm.hs3
-rw-r--r--compiler/GHC/ByteCode/Types.hs3
-rw-r--r--compiler/GHC/Cmm.hs3
-rw-r--r--compiler/GHC/Cmm/CallConv.hs1
-rw-r--r--compiler/GHC/Cmm/Expr.hs286
-rw-r--r--compiler/GHC/Cmm/LayoutStack.hs1
-rw-r--r--compiler/GHC/Cmm/Lexer.x2
-rw-r--r--compiler/GHC/Cmm/Liveness.hs3
-rw-r--r--compiler/GHC/Cmm/Node.hs1
-rw-r--r--compiler/GHC/Cmm/Ppr/Expr.hs1
-rw-r--r--compiler/GHC/Cmm/ProcPoint.hs1
-rw-r--r--compiler/GHC/Cmm/Reg/Global.hs217
-rw-r--r--compiler/GHC/Cmm/Reg/Set.hs43
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf.hs2
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf/Types.hs2
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs2
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Linear.hs2
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Liveness.hs2
-rw-r--r--compiler/GHC/CmmToLlvm/Regs.hs2
-rw-r--r--compiler/GHC/Platform/Regs.hs2
-rw-r--r--compiler/GHC/StgToByteCode.hs2
-rw-r--r--compiler/GHC/Tc/Module.hs9
-rw-r--r--compiler/GHC/Tc/Types.hs14
-rw-r--r--compiler/ghc.cabal.in2
24 files changed, 314 insertions, 292 deletions
diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs
index 6b9d4a9223..f5b1f14661 100644
--- a/compiler/GHC/ByteCode/Asm.hs
+++ b/compiler/GHC/ByteCode/Asm.hs
@@ -39,7 +39,8 @@ import GHC.Data.FastString
import GHC.Data.SizedSeq
import GHC.StgToCmm.Layout ( ArgRep(..) )
-import GHC.Cmm.Expr
+import GHC.Cmm.Reg.Global
+import GHC.Cmm.Reg.Set
import GHC.Cmm.CallConv ( tupleRegsCover )
import GHC.Platform
import GHC.Platform.Profile
diff --git a/compiler/GHC/ByteCode/Types.hs b/compiler/GHC/ByteCode/Types.hs
index 673838654d..6cc53826d2 100644
--- a/compiler/GHC/ByteCode/Types.hs
+++ b/compiler/GHC/ByteCode/Types.hs
@@ -43,7 +43,8 @@ import qualified Data.IntMap as IntMap
import Data.Maybe (catMaybes)
import qualified GHC.Exts.Heap as Heap
import GHC.Stack.CCS
-import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
+import GHC.Cmm.Reg.Set ( emptyRegSet, regSetToList )
+import GHC.Cmm.Reg.Global ( GlobalRegSet )
-- -----------------------------------------------------------------------------
-- Compiled Byte Code
diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index 3a461fa03c..fdaa8ce624 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -30,6 +30,7 @@ module GHC.Cmm (
-- * Statements, expressions and types
module GHC.Cmm.Node,
module GHC.Cmm.Expr,
+ module GHC.Cmm.Reg.Global
) where
import GHC.Prelude
@@ -45,6 +46,7 @@ import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
+import GHC.Cmm.Reg.Global
import GHC.Utils.Outputable
import Data.ByteString (ByteString)
@@ -288,4 +290,3 @@ instance OutputableP env instr => OutputableP env (GenBasicBlock instr) where
pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
pprBBlock (BasicBlock ident stmts) =
hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
-
diff --git a/compiler/GHC/Cmm/CallConv.hs b/compiler/GHC/Cmm/CallConv.hs
index f376e598bf..378248640d 100644
--- a/compiler/GHC/Cmm/CallConv.hs
+++ b/compiler/GHC/Cmm/CallConv.hs
@@ -10,6 +10,7 @@ import GHC.Prelude
import Data.List (nub)
import GHC.Cmm.Expr
+import GHC.Cmm.Reg.Global
import GHC.Runtime.Heap.Layout
import GHC.Cmm (Convention(..))
import GHC.Cmm.Ppr () -- For Outputable instances
diff --git a/compiler/GHC/Cmm/Expr.hs b/compiler/GHC/Cmm/Expr.hs
index 86b06271d1..7f94f3f3dd 100644
--- a/compiler/GHC/Cmm/Expr.hs
+++ b/compiler/GHC/Cmm/Expr.hs
@@ -9,22 +9,16 @@ module GHC.Cmm.Expr
( CmmExpr(..), cmmExprType, cmmExprWidth, cmmExprAlignment, maybeInvertCmmExpr
, CmmReg(..), cmmRegType, cmmRegWidth
, CmmLit(..), cmmLitType
- , LocalReg(..), localRegType
- , GlobalReg(..), isArgReg, globalRegType
+ , LocalReg(..), LocalRegSet, localRegType
+ , globalRegType
, spReg, hpReg, spLimReg, hpLimReg, nodeReg
, currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
- , node, baseReg
- , VGcPtr(..)
+ , baseReg
, DefinerOfRegs, UserOfRegs
, foldRegsDefd, foldRegsUsed
, foldLocalRegsDefd, foldLocalRegsUsed
- , RegSet, LocalRegSet, GlobalRegSet
- , emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
- , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
- , regSetToList
-
, Area(..)
, module GHC.Cmm.MachOp
, module GHC.Cmm.Type
@@ -34,6 +28,8 @@ where
import GHC.Prelude
import GHC.Platform
+import GHC.Cmm.Reg.Global
+import GHC.Cmm.Reg.Set
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.MachOp
@@ -42,9 +38,6 @@ import GHC.Utils.Panic (panic)
import GHC.Utils.Outputable
import GHC.Types.Unique
-import Data.Set (Set)
-import qualified Data.Set as Set
-
import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf)
-----------------------------------------------------------------------------
@@ -280,6 +273,8 @@ data LocalReg
-- 1. Identifier
-- 2. Type
+type LocalRegSet = RegSet LocalReg
+
instance Eq LocalReg where
(LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
@@ -306,40 +301,6 @@ localRegType (LocalReg _ rep) = rep
-- Register-use information for expressions and other types
-----------------------------------------------------------------------------
--- | Sets of registers
-
--- These are used for dataflow facts, and a common operation is taking
--- the union of two RegSets and then asking whether the union is the
--- same as one of the inputs. UniqSet isn't good here, because
--- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
--- Sets.
-
-type RegSet r = Set r
-type LocalRegSet = RegSet LocalReg
-type GlobalRegSet = RegSet GlobalReg
-
-emptyRegSet :: RegSet r
-nullRegSet :: RegSet r -> Bool
-elemRegSet :: Ord r => r -> RegSet r -> Bool
-extendRegSet :: Ord r => RegSet r -> r -> RegSet r
-deleteFromRegSet :: Ord r => RegSet r -> r -> RegSet r
-mkRegSet :: Ord r => [r] -> RegSet r
-minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
-sizeRegSet :: RegSet r -> Int
-regSetToList :: RegSet r -> [r]
-
-emptyRegSet = Set.empty
-nullRegSet = Set.null
-elemRegSet = Set.member
-extendRegSet = flip Set.insert
-deleteFromRegSet = flip Set.delete
-mkRegSet = Set.fromList
-minusRegSet = Set.difference
-plusRegSet = Set.union
-timesRegSet = Set.intersection
-sizeRegSet = Set.size
-regSetToList = Set.toList
-
class Ord r => UserOfRegs r a where
foldRegsUsed :: Platform -> (b -> r -> b) -> b -> a -> b
@@ -397,217 +358,6 @@ instance DefinerOfRegs r a => DefinerOfRegs r [a] where
foldRegsDefd platform f set as = foldl' (foldRegsDefd platform f) set as
{-# INLINABLE foldRegsDefd #-}
------------------------------------------------------------------------------
--- Global STG registers
------------------------------------------------------------------------------
-
-data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
-
------------------------------------------------------------------------------
--- Global STG registers
------------------------------------------------------------------------------
-{-
-Note [Overlapping global registers]
-
-The backend might not faithfully implement the abstraction of the STG
-machine with independent registers for different values of type
-GlobalReg. Specifically, certain pairs of registers (r1, r2) may
-overlap in the sense that a store to r1 invalidates the value in r2,
-and vice versa.
-
-Currently this occurs only on the x86_64 architecture where FloatReg n
-and DoubleReg n are assigned the same microarchitectural register, in
-order to allow functions to receive more Float# or Double# arguments
-in registers (as opposed to on the stack).
-
-There are no specific rules about which registers might overlap with
-which other registers, but presumably it's safe to assume that nothing
-will overlap with special registers like Sp or BaseReg.
-
-Use GHC.Cmm.Utils.regsOverlap to determine whether two GlobalRegs overlap
-on a particular platform. The instance Eq GlobalReg is syntactic
-equality of STG registers and does not take overlap into
-account. However it is still used in UserOfRegs/DefinerOfRegs and
-there are likely still bugs there, beware!
--}
-
-data GlobalReg
- -- Argument and return registers
- = VanillaReg -- pointers, unboxed ints and chars
- {-# UNPACK #-} !Int -- its number
- VGcPtr
-
- | FloatReg -- single-precision floating-point registers
- {-# UNPACK #-} !Int -- its number
-
- | DoubleReg -- double-precision floating-point registers
- {-# UNPACK #-} !Int -- its number
-
- | LongReg -- long int registers (64-bit, really)
- {-# UNPACK #-} !Int -- its number
-
- | XmmReg -- 128-bit SIMD vector register
- {-# UNPACK #-} !Int -- its number
-
- | YmmReg -- 256-bit SIMD vector register
- {-# UNPACK #-} !Int -- its number
-
- | ZmmReg -- 512-bit SIMD vector register
- {-# UNPACK #-} !Int -- its number
-
- -- STG registers
- | Sp -- Stack ptr; points to last occupied stack location.
- | SpLim -- Stack limit
- | Hp -- Heap ptr; points to last occupied heap location.
- | HpLim -- Heap limit register
- | CCCS -- Current cost-centre stack
- | CurrentTSO -- pointer to current thread's TSO
- | CurrentNursery -- pointer to allocation area
- | HpAlloc -- allocation count for heap check failure
-
- -- We keep the address of some commonly-called
- -- functions in the register table, to keep code
- -- size down:
- | EagerBlackholeInfo -- stg_EAGER_BLACKHOLE_info
- | GCEnter1 -- stg_gc_enter_1
- | GCFun -- stg_gc_fun
-
- -- Base offset for the register table, used for accessing registers
- -- which do not have real registers assigned to them. This register
- -- will only appear after we have expanded GlobalReg into memory accesses
- -- (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).
- | PicBaseReg
-
- deriving( Show )
-
-instance Eq GlobalReg where
- VanillaReg i _ == VanillaReg j _ = i==j -- Ignore type when seeking clashes
- FloatReg i == FloatReg j = i==j
- DoubleReg i == DoubleReg j = i==j
- LongReg i == LongReg j = i==j
- -- NOTE: XMM, YMM, ZMM registers actually are the same registers
- -- at least with respect to store at YMM i and then read from XMM i
- -- and similarly for ZMM etc.
- XmmReg i == XmmReg j = i==j
- YmmReg i == YmmReg j = i==j
- ZmmReg i == ZmmReg j = i==j
- Sp == Sp = True
- SpLim == SpLim = True
- Hp == Hp = True
- HpLim == HpLim = True
- CCCS == CCCS = True
- CurrentTSO == CurrentTSO = True
- CurrentNursery == CurrentNursery = True
- HpAlloc == HpAlloc = True
- EagerBlackholeInfo == EagerBlackholeInfo = True
- GCEnter1 == GCEnter1 = True
- GCFun == GCFun = True
- BaseReg == BaseReg = True
- MachSp == MachSp = True
- UnwindReturnReg == UnwindReturnReg = True
- PicBaseReg == PicBaseReg = True
- _r1 == _r2 = False
-
--- NOTE: this Ord instance affects the tuple layout in GHCi, see
--- Note [GHCi tuple layout]
-instance Ord GlobalReg where
- compare (VanillaReg i _) (VanillaReg j _) = compare i j
- -- Ignore type when seeking clashes
- compare (FloatReg i) (FloatReg j) = compare i j
- compare (DoubleReg i) (DoubleReg j) = compare i j
- compare (LongReg i) (LongReg j) = compare i j
- compare (XmmReg i) (XmmReg j) = compare i j
- compare (YmmReg i) (YmmReg j) = compare i j
- compare (ZmmReg i) (ZmmReg j) = compare i j
- compare Sp Sp = EQ
- compare SpLim SpLim = EQ
- compare Hp Hp = EQ
- compare HpLim HpLim = EQ
- compare CCCS CCCS = EQ
- compare CurrentTSO CurrentTSO = EQ
- compare CurrentNursery CurrentNursery = EQ
- compare HpAlloc HpAlloc = EQ
- compare EagerBlackholeInfo EagerBlackholeInfo = EQ
- 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
- compare (FloatReg _) _ = LT
- compare _ (FloatReg _) = GT
- compare (DoubleReg _) _ = LT
- compare _ (DoubleReg _) = GT
- compare (LongReg _) _ = LT
- compare _ (LongReg _) = GT
- compare (XmmReg _) _ = LT
- compare _ (XmmReg _) = GT
- compare (YmmReg _) _ = LT
- compare _ (YmmReg _) = GT
- compare (ZmmReg _) _ = LT
- compare _ (ZmmReg _) = GT
- compare Sp _ = LT
- compare _ Sp = GT
- compare SpLim _ = LT
- compare _ SpLim = GT
- compare Hp _ = LT
- compare _ Hp = GT
- compare HpLim _ = LT
- compare _ HpLim = GT
- compare CCCS _ = LT
- compare _ CCCS = GT
- compare CurrentTSO _ = LT
- compare _ CurrentTSO = GT
- compare CurrentNursery _ = LT
- compare _ CurrentNursery = GT
- compare HpAlloc _ = LT
- compare _ HpAlloc = GT
- compare GCEnter1 _ = LT
- compare _ GCEnter1 = GT
- compare GCFun _ = LT
- 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
-
--- convenient aliases
-baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
- currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg :: CmmReg
-baseReg = CmmGlobal BaseReg
-spReg = CmmGlobal Sp
-hpReg = CmmGlobal Hp
-hpLimReg = CmmGlobal HpLim
-spLimReg = CmmGlobal SpLim
-nodeReg = CmmGlobal node
-currentTSOReg = CmmGlobal CurrentTSO
-currentNurseryReg = CmmGlobal CurrentNursery
-hpAllocReg = CmmGlobal HpAlloc
-cccsReg = CmmGlobal CCCS
-
-node :: GlobalReg
-node = VanillaReg 1 VGcPtr
-
globalRegType :: Platform -> GlobalReg -> CmmType
globalRegType platform = \case
(VanillaReg _ VGcPtr) -> gcWord platform
@@ -626,12 +376,16 @@ globalRegType platform = \case
-- dynamically allocated closures
_ -> bWord platform
-isArgReg :: GlobalReg -> Bool
-isArgReg (VanillaReg {}) = True
-isArgReg (FloatReg {}) = True
-isArgReg (DoubleReg {}) = True
-isArgReg (LongReg {}) = True
-isArgReg (XmmReg {}) = True
-isArgReg (YmmReg {}) = True
-isArgReg (ZmmReg {}) = True
-isArgReg _ = False
+-- convenient aliases
+baseReg, spReg, hpReg, spLimReg, hpLimReg, nodeReg,
+ currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg :: CmmReg
+baseReg = CmmGlobal BaseReg
+spReg = CmmGlobal Sp
+hpReg = CmmGlobal Hp
+hpLimReg = CmmGlobal HpLim
+spLimReg = CmmGlobal SpLim
+nodeReg = CmmGlobal node
+currentTSOReg = CmmGlobal CurrentTSO
+currentNurseryReg = CmmGlobal CurrentNursery
+hpAllocReg = CmmGlobal HpAlloc
+cccsReg = CmmGlobal CCCS
diff --git a/compiler/GHC/Cmm/LayoutStack.hs b/compiler/GHC/Cmm/LayoutStack.hs
index b996427bba..d2fe6aeb98 100644
--- a/compiler/GHC/Cmm/LayoutStack.hs
+++ b/compiler/GHC/Cmm/LayoutStack.hs
@@ -19,6 +19,7 @@ import GHC.Cmm.Utils
import GHC.Cmm.Graph
import GHC.Cmm.Liveness
import GHC.Cmm.ProcPoint
+import GHC.Cmm.Reg.Set
import GHC.Runtime.Heap.Layout
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
diff --git a/compiler/GHC/Cmm/Lexer.x b/compiler/GHC/Cmm/Lexer.x
index bf379ec7da..44f989a5bf 100644
--- a/compiler/GHC/Cmm/Lexer.x
+++ b/compiler/GHC/Cmm/Lexer.x
@@ -17,7 +17,7 @@ module GHC.Cmm.Lexer (
import GHC.Prelude
-import GHC.Cmm.Expr
+import GHC.Cmm.Reg.Global
import GHC.Parser.Lexer
import GHC.Cmm.Parser.Monad
diff --git a/compiler/GHC/Cmm/Liveness.hs b/compiler/GHC/Cmm/Liveness.hs
index f047ea4367..b4d8f6d5b6 100644
--- a/compiler/GHC/Cmm/Liveness.hs
+++ b/compiler/GHC/Cmm/Liveness.hs
@@ -26,6 +26,7 @@ import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.LRegSet
+import GHC.Cmm.Reg.Set
import GHC.Data.Maybe
import GHC.Utils.Outputable
@@ -159,5 +160,3 @@ xferLiveL platform (BlockCC eNode middle xNode) fBase =
let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase
!result = foldNodesBwdOO (gen_killL platform) middle joined
in mapSingleton (entryLabel eNode) result
-
-
diff --git a/compiler/GHC/Cmm/Node.hs b/compiler/GHC/Cmm/Node.hs
index fe6eac3223..9988e2210c 100644
--- a/compiler/GHC/Cmm/Node.hs
+++ b/compiler/GHC/Cmm/Node.hs
@@ -29,6 +29,7 @@ import GHC.Prelude hiding (succ)
import GHC.Platform.Regs
import GHC.Cmm.Expr
+import GHC.Cmm.Reg.Global
import GHC.Cmm.Switch
import GHC.Data.FastString
import GHC.Types.ForeignCall
diff --git a/compiler/GHC/Cmm/Ppr/Expr.hs b/compiler/GHC/Cmm/Ppr/Expr.hs
index c656c98522..44b09dbf32 100644
--- a/compiler/GHC/Cmm/Ppr/Expr.hs
+++ b/compiler/GHC/Cmm/Ppr/Expr.hs
@@ -48,6 +48,7 @@ import GHC.Driver.Ppr
import GHC.Platform
import GHC.Cmm.Expr
+import GHC.Cmm.Reg.Global
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Cmm/ProcPoint.hs b/compiler/GHC/Cmm/ProcPoint.hs
index 0cabea1536..10ea7df8a9 100644
--- a/compiler/GHC/Cmm/ProcPoint.hs
+++ b/compiler/GHC/Cmm/ProcPoint.hs
@@ -22,6 +22,7 @@ import GHC.Cmm.Utils
import GHC.Cmm.Info
import GHC.Cmm.Liveness
import GHC.Cmm.Switch
+import GHC.Cmm.Reg.Set
import Data.List (sortBy)
import GHC.Data.Maybe
import Control.Monad
diff --git a/compiler/GHC/Cmm/Reg/Global.hs b/compiler/GHC/Cmm/Reg/Global.hs
new file mode 100644
index 0000000000..8bf0220fc0
--- /dev/null
+++ b/compiler/GHC/Cmm/Reg/Global.hs
@@ -0,0 +1,217 @@
+module GHC.Cmm.Reg.Global (
+ GlobalReg(..), GlobalRegSet, isArgReg, node
+ , VGcPtr(..)
+ ) where
+
+import GHC.Prelude
+
+import GHC.Cmm.Reg.Set
+
+-----------------------------------------------------------------------------
+-- Global STG registers
+-----------------------------------------------------------------------------
+
+data VGcPtr = VGcPtr | VNonGcPtr deriving( Eq, Show )
+
+-----------------------------------------------------------------------------
+-- Global STG registers
+-----------------------------------------------------------------------------
+{-
+Note [Overlapping global registers]
+
+The backend might not faithfully implement the abstraction of the STG
+machine with independent registers for different values of type
+GlobalReg. Specifically, certain pairs of registers (r1, r2) may
+overlap in the sense that a store to r1 invalidates the value in r2,
+and vice versa.
+
+Currently this occurs only on the x86_64 architecture where FloatReg n
+and DoubleReg n are assigned the same microarchitectural register, in
+order to allow functions to receive more Float# or Double# arguments
+in registers (as opposed to on the stack).
+
+There are no specific rules about which registers might overlap with
+which other registers, but presumably it's safe to assume that nothing
+will overlap with special registers like Sp or BaseReg.
+
+Use GHC.Cmm.Utils.regsOverlap to determine whether two GlobalRegs overlap
+on a particular platform. The instance Eq GlobalReg is syntactic
+equality of STG registers and does not take overlap into
+account. However it is still used in UserOfRegs/DefinerOfRegs and
+there are likely still bugs there, beware!
+-}
+
+data GlobalReg
+ -- Argument and return registers
+ = VanillaReg -- pointers, unboxed ints and chars
+ {-# UNPACK #-} !Int -- its number
+ VGcPtr
+
+ | FloatReg -- single-precision floating-point registers
+ {-# UNPACK #-} !Int -- its number
+
+ | DoubleReg -- double-precision floating-point registers
+ {-# UNPACK #-} !Int -- its number
+
+ | LongReg -- long int registers (64-bit, really)
+ {-# UNPACK #-} !Int -- its number
+
+ | XmmReg -- 128-bit SIMD vector register
+ {-# UNPACK #-} !Int -- its number
+
+ | YmmReg -- 256-bit SIMD vector register
+ {-# UNPACK #-} !Int -- its number
+
+ | ZmmReg -- 512-bit SIMD vector register
+ {-# UNPACK #-} !Int -- its number
+
+ -- STG registers
+ | Sp -- Stack ptr; points to last occupied stack location.
+ | SpLim -- Stack limit
+ | Hp -- Heap ptr; points to last occupied heap location.
+ | HpLim -- Heap limit register
+ | CCCS -- Current cost-centre stack
+ | CurrentTSO -- pointer to current thread's TSO
+ | CurrentNursery -- pointer to allocation area
+ | HpAlloc -- allocation count for heap check failure
+
+ -- We keep the address of some commonly-called
+ -- functions in the register table, to keep code
+ -- size down:
+ | EagerBlackholeInfo -- stg_EAGER_BLACKHOLE_info
+ | GCEnter1 -- stg_gc_enter_1
+ | GCFun -- stg_gc_fun
+
+ -- Base offset for the register table, used for accessing registers
+ -- which do not have real registers assigned to them. This register
+ -- will only appear after we have expanded GlobalReg into memory accesses
+ -- (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).
+ | PicBaseReg
+
+ deriving( Show )
+
+type GlobalRegSet = RegSet GlobalReg
+
+instance Eq GlobalReg where
+ VanillaReg i _ == VanillaReg j _ = i==j -- Ignore type when seeking clashes
+ FloatReg i == FloatReg j = i==j
+ DoubleReg i == DoubleReg j = i==j
+ LongReg i == LongReg j = i==j
+ -- NOTE: XMM, YMM, ZMM registers actually are the same registers
+ -- at least with respect to store at YMM i and then read from XMM i
+ -- and similarly for ZMM etc.
+ XmmReg i == XmmReg j = i==j
+ YmmReg i == YmmReg j = i==j
+ ZmmReg i == ZmmReg j = i==j
+ Sp == Sp = True
+ SpLim == SpLim = True
+ Hp == Hp = True
+ HpLim == HpLim = True
+ CCCS == CCCS = True
+ CurrentTSO == CurrentTSO = True
+ CurrentNursery == CurrentNursery = True
+ HpAlloc == HpAlloc = True
+ EagerBlackholeInfo == EagerBlackholeInfo = True
+ GCEnter1 == GCEnter1 = True
+ GCFun == GCFun = True
+ BaseReg == BaseReg = True
+ MachSp == MachSp = True
+ UnwindReturnReg == UnwindReturnReg = True
+ PicBaseReg == PicBaseReg = True
+ _r1 == _r2 = False
+
+-- NOTE: this Ord instance affects the tuple layout in GHCi, see
+-- Note [GHCi tuple layout]
+instance Ord GlobalReg where
+ compare (VanillaReg i _) (VanillaReg j _) = compare i j
+ -- Ignore type when seeking clashes
+ compare (FloatReg i) (FloatReg j) = compare i j
+ compare (DoubleReg i) (DoubleReg j) = compare i j
+ compare (LongReg i) (LongReg j) = compare i j
+ compare (XmmReg i) (XmmReg j) = compare i j
+ compare (YmmReg i) (YmmReg j) = compare i j
+ compare (ZmmReg i) (ZmmReg j) = compare i j
+ compare Sp Sp = EQ
+ compare SpLim SpLim = EQ
+ compare Hp Hp = EQ
+ compare HpLim HpLim = EQ
+ compare CCCS CCCS = EQ
+ compare CurrentTSO CurrentTSO = EQ
+ compare CurrentNursery CurrentNursery = EQ
+ compare HpAlloc HpAlloc = EQ
+ compare EagerBlackholeInfo EagerBlackholeInfo = EQ
+ 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
+ compare (FloatReg _) _ = LT
+ compare _ (FloatReg _) = GT
+ compare (DoubleReg _) _ = LT
+ compare _ (DoubleReg _) = GT
+ compare (LongReg _) _ = LT
+ compare _ (LongReg _) = GT
+ compare (XmmReg _) _ = LT
+ compare _ (XmmReg _) = GT
+ compare (YmmReg _) _ = LT
+ compare _ (YmmReg _) = GT
+ compare (ZmmReg _) _ = LT
+ compare _ (ZmmReg _) = GT
+ compare Sp _ = LT
+ compare _ Sp = GT
+ compare SpLim _ = LT
+ compare _ SpLim = GT
+ compare Hp _ = LT
+ compare _ Hp = GT
+ compare HpLim _ = LT
+ compare _ HpLim = GT
+ compare CCCS _ = LT
+ compare _ CCCS = GT
+ compare CurrentTSO _ = LT
+ compare _ CurrentTSO = GT
+ compare CurrentNursery _ = LT
+ compare _ CurrentNursery = GT
+ compare HpAlloc _ = LT
+ compare _ HpAlloc = GT
+ compare GCEnter1 _ = LT
+ compare _ GCEnter1 = GT
+ compare GCFun _ = LT
+ 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
+
+node :: GlobalReg
+node = VanillaReg 1 VGcPtr
+
+isArgReg :: GlobalReg -> Bool
+isArgReg (VanillaReg {}) = True
+isArgReg (FloatReg {}) = True
+isArgReg (DoubleReg {}) = True
+isArgReg (LongReg {}) = True
+isArgReg (XmmReg {}) = True
+isArgReg (YmmReg {}) = True
+isArgReg (ZmmReg {}) = True
+isArgReg _ = False
diff --git a/compiler/GHC/Cmm/Reg/Set.hs b/compiler/GHC/Cmm/Reg/Set.hs
new file mode 100644
index 0000000000..5d6ec5e93f
--- /dev/null
+++ b/compiler/GHC/Cmm/Reg/Set.hs
@@ -0,0 +1,43 @@
+module GHC.Cmm.Reg.Set (
+ RegSet
+ , emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
+ , plusRegSet, minusRegSet, timesRegSet, sizeRegSet, nullRegSet
+ , regSetToList
+ ) where
+
+import GHC.Prelude
+
+import Data.Set ( Set )
+import qualified Data.Set as Set
+
+-- | Sets of registers
+
+-- These are used for dataflow facts, and a common operation is taking
+-- the union of two RegSets and then asking whether the union is the
+-- same as one of the inputs. UniqSet isn't good here, because
+-- sizeUniqSet is O(n) whereas Set.size is O(1), so we use ordinary
+-- Sets.
+
+type RegSet r = Set r
+
+emptyRegSet :: RegSet r
+nullRegSet :: RegSet r -> Bool
+elemRegSet :: Ord r => r -> RegSet r -> Bool
+extendRegSet :: Ord r => RegSet r -> r -> RegSet r
+deleteFromRegSet :: Ord r => RegSet r -> r -> RegSet r
+mkRegSet :: Ord r => [r] -> RegSet r
+minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
+sizeRegSet :: RegSet r -> Int
+regSetToList :: RegSet r -> [r]
+
+emptyRegSet = Set.empty
+nullRegSet = Set.null
+elemRegSet = Set.member
+extendRegSet = flip Set.insert
+deleteFromRegSet = flip Set.delete
+mkRegSet = Set.fromList
+minusRegSet = Set.difference
+plusRegSet = Set.union
+timesRegSet = Set.intersection
+sizeRegSet = Set.size
+regSetToList = Set.toList
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index fcff4be74e..b659b8a5a5 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -5,7 +5,7 @@ module GHC.CmmToAsm.Dwarf (
import GHC.Prelude
import GHC.Cmm.CLabel
-import GHC.Cmm.Expr ( GlobalReg(..) )
+import GHC.Cmm.Reg.Global ( GlobalReg(..) )
import GHC.Settings.Config ( cProjectName, cProjectVersion )
import GHC.Types.Tickish ( CmmTickish, GenTickish(..) )
import GHC.Cmm.DebugBlock
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Types.hs b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
index b607d1d45e..3502015566 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Types.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
@@ -31,7 +31,7 @@ import GHC.Prelude
import GHC.Cmm.DebugBlock
import GHC.Cmm.CLabel
-import GHC.Cmm.Expr ( GlobalReg(..) )
+import GHC.Cmm.Reg.Global ( GlobalReg(..) )
import GHC.Utils.Encoding
import GHC.Data.FastString
import GHC.Utils.Outputable
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
index 86c3590f99..81f62e16c2 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
@@ -13,7 +13,7 @@ import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Reg.Utils
import GHC.CmmToAsm.Instr
import GHC.Platform.Reg
-import GHC.Cmm hiding (RegSet)
+import GHC.Cmm
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear.hs b/compiler/GHC/CmmToAsm/Reg/Linear.hs
index 88fdcd6bce..ea6cb1de44 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear.hs
@@ -124,7 +124,7 @@ import GHC.Platform.Reg
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
-import GHC.Cmm hiding (RegSet)
+import GHC.Cmm
import GHC.Data.Graph.Directed
import GHC.Types.Unique
diff --git a/compiler/GHC/CmmToAsm/Reg/Liveness.hs b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
index bf53ecf421..e95c43572c 100644
--- a/compiler/GHC/CmmToAsm/Reg/Liveness.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
@@ -54,7 +54,7 @@ import GHC.CmmToAsm.Utils
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label
-import GHC.Cmm hiding (RegSet, emptyRegSet)
+import GHC.Cmm
import GHC.Data.Graph.Directed
import GHC.Utils.Monad
diff --git a/compiler/GHC/CmmToLlvm/Regs.hs b/compiler/GHC/CmmToLlvm/Regs.hs
index b18df77ed4..8811ebce7e 100644
--- a/compiler/GHC/CmmToLlvm/Regs.hs
+++ b/compiler/GHC/CmmToLlvm/Regs.hs
@@ -13,7 +13,7 @@ import GHC.Prelude
import GHC.Llvm
-import GHC.Cmm.Expr
+import GHC.Cmm.Reg.Global
import GHC.Platform
import GHC.Data.FastString
import GHC.Utils.Panic ( panic )
diff --git a/compiler/GHC/Platform/Regs.hs b/compiler/GHC/Platform/Regs.hs
index e0bdf5d6e5..66bed785e7 100644
--- a/compiler/GHC/Platform/Regs.hs
+++ b/compiler/GHC/Platform/Regs.hs
@@ -4,7 +4,7 @@ module GHC.Platform.Regs
import GHC.Prelude
-import GHC.Cmm.Expr
+import GHC.Cmm.Reg.Global
import GHC.Platform
import GHC.Platform.Reg
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs
index f7bb270e16..4ee077f2a7 100644
--- a/compiler/GHC/StgToByteCode.hs
+++ b/compiler/GHC/StgToByteCode.hs
@@ -26,6 +26,8 @@ import GHC.Cmm.CallConv
import GHC.Cmm.Expr
import GHC.Cmm.Node
import GHC.Cmm.Utils
+import GHC.Cmm.Reg.Global
+import GHC.Cmm.Reg.Set
import GHC.Platform
import GHC.Platform.Profile
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 450e97819a..95d442e4ad 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -121,6 +121,7 @@ import GHC.Core.Unify( RoughMatchTc(..) )
import GHC.Core.FamInstEnv
( FamInst, pprFamInst, famInstsRepTyCons
, famInstEnvElts, extendFamInstEnvList, normaliseType )
+import GHC.Core.Lint ( lintAxioms )
import GHC.Parser.Header ( mkPrelImports )
@@ -348,6 +349,14 @@ tcRnModuleTcRnM hsc_env mod_sum
}
}
+-- | Check the 'TcGblEnv' for consistency. Currently, only checks
+-- axioms, but should check other aspects, too.
+lintGblEnv :: Logger -> DynFlags -> TcGblEnv -> TcM ()
+lintGblEnv logger dflags tcg_env =
+ liftIO $ lintAxioms logger dflags (text "TcGblEnv axioms") axioms
+ where
+ axioms = typeEnvCoAxioms (tcg_type_env tcg_env)
+
implicitPreludeWarn :: SDoc
implicitPreludeWarn
= text "Module `Prelude' implicitly imported"
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 2d80039234..9ebb96008c 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -80,9 +80,6 @@ module GHC.Tc.Types(
RoleAnnotEnv, emptyRoleAnnotEnv, mkRoleAnnotEnv,
lookupRoleAnnot, getRoleAnnots,
- -- Linting
- lintGblEnv,
-
-- Diagnostics
TcRnMessage
) where
@@ -106,7 +103,6 @@ import GHC.Tc.Errors.Types
import GHC.Core.Type
import GHC.Core.TyCon ( TyCon, tyConKind )
import GHC.Core.PatSyn ( PatSyn )
-import GHC.Core.Lint ( lintAxioms )
import GHC.Core.UsageEnv
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
@@ -1755,18 +1751,10 @@ getRoleAnnots bndrs role_env
{- *********************************************************************
* *
- Linting a TcGblEnv
+ DocLoc
* *
********************************************************************* -}
--- | Check the 'TcGblEnv' for consistency. Currently, only checks
--- axioms, but should check other aspects, too.
-lintGblEnv :: Logger -> DynFlags -> TcGblEnv -> TcM ()
-lintGblEnv logger dflags tcg_env =
- liftIO $ lintAxioms logger dflags (text "TcGblEnv axioms") axioms
- where
- axioms = typeEnvCoAxioms (tcg_type_env tcg_env)
-
-- | This is a mirror of Template Haskell's DocLoc, but the TH names are
-- resolved to GHC names.
data DocLoc = DeclDoc Name
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index df15959944..890b41cb0a 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -198,6 +198,8 @@ Library
GHC.Cmm.Ppr.Decl
GHC.Cmm.Ppr.Expr
GHC.Cmm.ProcPoint
+ GHC.Cmm.Reg.Global
+ GHC.Cmm.Reg.Set
GHC.Cmm.Sink
GHC.Cmm.Switch
GHC.Cmm.Switch.Implement