diff options
author | Richard Eisenberg <rae@richarde.dev> | 2021-06-01 15:32:34 -0400 |
---|---|---|
committer | Richard Eisenberg <rae@richarde.dev> | 2021-06-01 15:33:24 -0400 |
commit | ff6a88ec8bedf59295c2c154c1056b80569fe756 (patch) | |
tree | 1b19dc9bf743448fb105ac00528ab9bfbfca0459 /compiler/GHC | |
parent | 6db8a0f76ec45d47060e28bb303e9eef60bdb16b (diff) | |
download | haskell-wip/lower-parser-deps.tar.gz |
A little import wrangling. Not much accomplishedwip/lower-parser-deps
Diffstat (limited to 'compiler/GHC')
-rw-r--r-- | compiler/GHC/ByteCode/Asm.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/ByteCode/Types.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Cmm.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Cmm/CallConv.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Expr.hs | 286 | ||||
-rw-r--r-- | compiler/GHC/Cmm/LayoutStack.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Lexer.x | 2 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Liveness.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Node.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Ppr/Expr.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Cmm/ProcPoint.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Reg/Global.hs | 217 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Reg/Set.hs | 43 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/Dwarf.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/Dwarf/Types.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/Reg/Linear.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/Reg/Liveness.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CmmToLlvm/Regs.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Platform/Regs.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/StgToByteCode.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Tc/Module.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/Tc/Types.hs | 14 |
23 files changed, 312 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 |