added 'filterRegsUsed' to CmmExpr
[ghc-hetmet.git] / compiler / cmm / CmmExpr.hs
1
2 module CmmExpr
3     ( CmmExpr(..), cmmExprRep, maybeInvertCmmExpr
4     , CmmReg(..), cmmRegRep
5     , CmmLit(..), cmmLitRep
6     , LocalReg(..), localRegRep, localRegGCFollow, GCKind(..)
7     , GlobalReg(..), globalRegRep, spReg, hpReg, spLimReg, nodeReg, node
8     , UserOfLocalRegs, foldRegsUsed, filterRegsUsed
9     , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
10             , plusRegSet, minusRegSet, timesRegSet
11     )
12 where
13
14 import CLabel
15 import MachOp
16 import Unique
17 import UniqSet
18
19 -----------------------------------------------------------------------------
20 --              CmmExpr
21 -- An expression.  Expressions have no side effects.
22 -----------------------------------------------------------------------------
23
24 data CmmExpr
25   = CmmLit CmmLit               -- Literal
26   | CmmLoad CmmExpr MachRep     -- Read memory location
27   | CmmReg CmmReg               -- Contents of register
28   | CmmMachOp MachOp [CmmExpr]  -- Machine operation (+, -, *, etc.)
29   | CmmRegOff CmmReg Int        
30         -- CmmRegOff reg i
31         --        ** is shorthand only, meaning **
32         -- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
33         --      where rep = cmmRegRep reg
34   deriving Eq
35
36 data CmmReg 
37   = CmmLocal  LocalReg
38   | CmmGlobal GlobalReg
39   deriving( Eq )
40
41 data CmmLit
42   = CmmInt Integer  MachRep
43         -- Interpretation: the 2's complement representation of the value
44         -- is truncated to the specified size.  This is easier than trying
45         -- to keep the value within range, because we don't know whether
46         -- it will be used as a signed or unsigned value (the MachRep doesn't
47         -- distinguish between signed & unsigned).
48   | CmmFloat  Rational MachRep
49   | CmmLabel    CLabel                  -- Address of label
50   | CmmLabelOff CLabel Int              -- Address of label + byte offset
51   
52         -- Due to limitations in the C backend, the following
53         -- MUST ONLY be used inside the info table indicated by label2
54         -- (label2 must be the info label), and label1 must be an
55         -- SRT, a slow entrypoint or a large bitmap (see the Mangler)
56         -- Don't use it at all unless tablesNextToCode.
57         -- It is also used inside the NCG during when generating
58         -- position-independent code. 
59   | CmmLabelDiffOff CLabel CLabel Int   -- label1 - label2 + offset
60   deriving Eq
61
62 instance Eq LocalReg where
63   (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
64
65 instance Uniquable LocalReg where
66   getUnique (LocalReg uniq _ _) = uniq
67
68 --------
69 --- Negation for conditional branches
70
71 maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
72 maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
73                                             return (CmmMachOp op' args)
74 maybeInvertCmmExpr _ = Nothing
75
76 -----------------------------------------------------------------------------
77 --              Local registers
78 -----------------------------------------------------------------------------
79
80 -- | Whether a 'LocalReg' is a GC followable pointer
81 data GCKind = GCKindPtr | GCKindNonPtr deriving (Eq)
82
83 data LocalReg
84   = LocalReg
85       !Unique   -- ^ Identifier
86       MachRep   -- ^ Type
87       GCKind      -- ^ Should the GC follow as a pointer
88
89 -- | Sets of local registers
90
91 type RegSet              =  UniqSet LocalReg
92 emptyRegSet             :: RegSet
93 elemRegSet              :: LocalReg -> RegSet -> Bool
94 extendRegSet            :: RegSet -> LocalReg -> RegSet
95 deleteFromRegSet        :: RegSet -> LocalReg -> RegSet
96 mkRegSet                :: [LocalReg] -> RegSet
97 minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
98
99 emptyRegSet      = emptyUniqSet
100 elemRegSet       = elementOfUniqSet
101 extendRegSet     = addOneToUniqSet
102 deleteFromRegSet = delOneFromUniqSet
103 mkRegSet         = mkUniqSet
104 minusRegSet      = minusUniqSet
105 plusRegSet       = unionUniqSets
106 timesRegSet      = intersectUniqSets
107
108 -----------------------------------------------------------------------------
109 --    Register-use information for expressions and other types 
110 -----------------------------------------------------------------------------
111
112 class UserOfLocalRegs a where
113   foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
114
115 filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
116 filterRegsUsed p e =
117     foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
118                  emptyRegSet e
119
120 instance UserOfLocalRegs CmmReg where
121     foldRegsUsed f z (CmmLocal reg) = f z reg
122     foldRegsUsed _ z (CmmGlobal _)  = z
123
124 instance UserOfLocalRegs LocalReg where
125     foldRegsUsed f z r = f z r
126
127 instance UserOfLocalRegs RegSet where
128     foldRegsUsed f = foldUniqSet (flip f)
129
130 instance UserOfLocalRegs CmmExpr where
131   foldRegsUsed f z e = expr z e
132     where expr z (CmmLit _)          = z
133           expr z (CmmLoad addr _)    = foldRegsUsed f z addr
134           expr z (CmmReg r)          = foldRegsUsed f z r
135           expr z (CmmMachOp _ exprs) = foldRegsUsed f z exprs
136           expr z (CmmRegOff r _)     = foldRegsUsed f z r
137
138 instance UserOfLocalRegs a => UserOfLocalRegs [a] where
139   foldRegsUsed _ set [] = set
140   foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
141
142 -----------------------------------------------------------------------------
143 --              MachRep
144 -----------------------------------------------------------------------------
145
146
147
148 cmmExprRep :: CmmExpr -> MachRep
149 cmmExprRep (CmmLit lit)      = cmmLitRep lit
150 cmmExprRep (CmmLoad _ rep)   = rep
151 cmmExprRep (CmmReg reg)      = cmmRegRep reg
152 cmmExprRep (CmmMachOp op _)  = resultRepOfMachOp op
153 cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
154
155 cmmRegRep :: CmmReg -> MachRep
156 cmmRegRep (CmmLocal  reg)       = localRegRep reg
157 cmmRegRep (CmmGlobal reg)       = globalRegRep reg
158
159 localRegRep :: LocalReg -> MachRep
160 localRegRep (LocalReg _ rep _) = rep
161
162
163 localRegGCFollow :: LocalReg -> GCKind
164 localRegGCFollow (LocalReg _ _ p) = p
165
166 cmmLitRep :: CmmLit -> MachRep
167 cmmLitRep (CmmInt _ rep)    = rep
168 cmmLitRep (CmmFloat _ rep)  = rep
169 cmmLitRep (CmmLabel _)      = wordRep
170 cmmLitRep (CmmLabelOff _ _) = wordRep
171 cmmLitRep (CmmLabelDiffOff _ _ _) = wordRep
172
173 -----------------------------------------------------------------------------
174 --              Global STG registers
175 -----------------------------------------------------------------------------
176
177 data GlobalReg
178   -- Argument and return registers
179   = VanillaReg                  -- pointers, unboxed ints and chars
180         {-# UNPACK #-} !Int     -- its number
181
182   | FloatReg            -- single-precision floating-point registers
183         {-# UNPACK #-} !Int     -- its number
184
185   | DoubleReg           -- double-precision floating-point registers
186         {-# UNPACK #-} !Int     -- its number
187
188   | LongReg             -- long int registers (64-bit, really)
189         {-# UNPACK #-} !Int     -- its number
190
191   -- STG registers
192   | Sp                  -- Stack ptr; points to last occupied stack location.
193   | SpLim               -- Stack limit
194   | Hp                  -- Heap ptr; points to last occupied heap location.
195   | HpLim               -- Heap limit register
196   | CurrentTSO          -- pointer to current thread's TSO
197   | CurrentNursery      -- pointer to allocation area
198   | HpAlloc             -- allocation count for heap check failure
199
200                 -- We keep the address of some commonly-called 
201                 -- functions in the register table, to keep code
202                 -- size down:
203   | GCEnter1            -- stg_gc_enter_1
204   | GCFun               -- stg_gc_fun
205
206   -- Base offset for the register table, used for accessing registers
207   -- which do not have real registers assigned to them.  This register
208   -- will only appear after we have expanded GlobalReg into memory accesses
209   -- (where necessary) in the native code generator.
210   | BaseReg
211
212   -- Base Register for PIC (position-independent code) calculations
213   -- Only used inside the native code generator. It's exact meaning differs
214   -- from platform to platform (see module PositionIndependentCode).
215   | PicBaseReg
216
217   deriving( Eq , Show )
218
219 -- convenient aliases
220 spReg, hpReg, spLimReg, nodeReg :: CmmReg
221 spReg = CmmGlobal Sp
222 hpReg = CmmGlobal Hp
223 spLimReg = CmmGlobal SpLim
224 nodeReg = CmmGlobal node
225
226 node :: GlobalReg
227 node = VanillaReg 1
228
229 globalRegRep :: GlobalReg -> MachRep
230 globalRegRep (VanillaReg _)     = wordRep
231 globalRegRep (FloatReg _)       = F32
232 globalRegRep (DoubleReg _)      = F64
233 globalRegRep (LongReg _)        = I64
234 globalRegRep _                  = wordRep