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     , DefinerOfLocalRegs, UserOfLocalRegs, foldRegsDefd, foldRegsUsed, filterRegsUsed
   9     , RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
  10             , plusRegSet, minusRegSet, timesRegSet
  11     , Area(..), StackSlotMap, getSlot, mkCallArea, outgoingSlot, areaId, areaSize
  12     ) where
  13
  14 import BlockId
  15 import CLabel
  16 import FiniteMap
  17 import MachOp
  18 import Maybes
  19 import Monad
  20 import Panic
  21 import Unique
  22 import UniqSet
  23
  24 -----------------------------------------------------------------------------
  25 --              CmmExpr
  26 -- An expression.  Expressions have no side effects.
  27 -----------------------------------------------------------------------------
  28
  29 data CmmExpr
  30   = CmmLit CmmLit               -- Literal
  31   | CmmLoad CmmExpr MachRep     -- Read memory location
  32   | CmmReg CmmReg               -- Contents of register
  33   | CmmMachOp MachOp [CmmExpr]  -- Machine operation (+, -, *, etc.)
  34   | CmmRegOff CmmReg Int
  35         -- CmmRegOff reg i
  36         --        ** is shorthand only, meaning **
  37         -- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
  38         --      where rep = cmmRegRep reg
  39   | CmmStackSlot Area Int
  40   deriving Eq
  41
  42 data CmmReg
  43   = CmmLocal  LocalReg
  44   | CmmGlobal GlobalReg
  45   deriving( Eq, Ord )
  46
  47 -- | A stack area is either the stack slot where a variable is spilled
  48 -- or the stack space where function arguments and results are passed.
  49 data Area
  50   = RegSlot  LocalReg
  51   | CallArea BlockId Int Int
  52   deriving (Eq, Ord)
  53
  54 data CmmLit
  55   = CmmInt Integer  MachRep
  56         -- Interpretation: the 2's complement representation of the value
  57         -- is truncated to the specified size.  This is easier than trying
  58         -- to keep the value within range, because we don't know whether
  59         -- it will be used as a signed or unsigned value (the MachRep doesn't
  60         -- distinguish between signed & unsigned).
  61   | CmmFloat  Rational MachRep
  62   | CmmLabel    CLabel                  -- Address of label
  63   | CmmLabelOff CLabel Int              -- Address of label + byte offset
  64
  65         -- Due to limitations in the C backend, the following
  66         -- MUST ONLY be used inside the info table indicated by label2
  67         -- (label2 must be the info label), and label1 must be an
  68         -- SRT, a slow entrypoint or a large bitmap (see the Mangler)
  69         -- Don't use it at all unless tablesNextToCode.
  70         -- It is also used inside the NCG during when generating
  71         -- position-independent code.
  72   | CmmLabelDiffOff CLabel CLabel Int   -- label1 - label2 + offset
  73   deriving Eq
  74
  75 instance Eq LocalReg where
  76   (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
  77
  78 instance Ord LocalReg where
  79   compare (LocalReg u1 _ _) (LocalReg u2 _ _) = compare u1 u2
  80
  81 instance Uniquable LocalReg where
  82   getUnique (LocalReg uniq _ _) = uniq
  83
  84 --------
  85 --- Negation for conditional branches
  86
  87 maybeInvertCmmExpr :: CmmExpr -> Maybe CmmExpr
  88 maybeInvertCmmExpr (CmmMachOp op args) = do op' <- maybeInvertComparison op
  89                                             return (CmmMachOp op' args)
  90 maybeInvertCmmExpr _ = Nothing
  91
  92 -----------------------------------------------------------------------------
  93 --              Local registers
  94 -----------------------------------------------------------------------------
  95
  96 -- | Whether a 'LocalReg' is a GC followable pointer
  97 data GCKind = GCKindPtr | GCKindNonPtr deriving (Eq)
  98
  99 data LocalReg
 100   = LocalReg !Unique MachRep GCKind
 101     -- ^ Parameters:
 102     --   1. Identifier
 103     --   2. Type
 104     --   3. Should the GC follow as a pointer
 105
 106 --  Sets of local registers
 107 type RegSet              =  UniqSet LocalReg
 108 emptyRegSet             :: RegSet
 109 elemRegSet              :: LocalReg -> RegSet -> Bool
 110 extendRegSet            :: RegSet -> LocalReg -> RegSet
 111 deleteFromRegSet        :: RegSet -> LocalReg -> RegSet
 112 mkRegSet                :: [LocalReg] -> RegSet
 113 minusRegSet, plusRegSet, timesRegSet :: RegSet -> RegSet -> RegSet
 114
 115 emptyRegSet      = emptyUniqSet
 116 elemRegSet       = elementOfUniqSet
 117 extendRegSet     = addOneToUniqSet
 118 deleteFromRegSet = delOneFromUniqSet
 119 mkRegSet         = mkUniqSet
 120 minusRegSet      = minusUniqSet
 121 plusRegSet       = unionUniqSets
 122 timesRegSet      = intersectUniqSets
 123
 124 -----------------------------------------------------------------------------
 125 --    Stack slots
 126 -----------------------------------------------------------------------------
 127
 128 mkVarSlot :: LocalReg -> CmmExpr
 129 mkVarSlot r = CmmStackSlot (RegSlot r) 0
 130
 131 -- Usually, we either want to lookup a variable's spill slot in an environment
 132 -- or else allocate it and add it to the environment.
 133 -- For a variable, we just need a single area of the appropriate size.
 134 type StackSlotMap = FiniteMap LocalReg CmmExpr
 135 getSlot :: StackSlotMap -> LocalReg -> (StackSlotMap, CmmExpr)
 136 getSlot map r = case lookupFM map r of
 137                   Just s  -> (map, s)
 138                   Nothing -> (addToFM map r s, s) where s = mkVarSlot r
 139
 140 -- Eventually, we'll want something proper that takes arguments and formals
 141 -- and gives you back the calling convention code, as well as the stack area.
 142 mkCallArea :: BlockId -> [a] -> Maybe [b] -> Area
 143 mkCallArea id as fs = CallArea id (length as) (liftM length fs `orElse` 0)
 144
 145 -- Return the last slot in the outgoing parameter area.
 146 outgoingSlot :: Area -> CmmExpr
 147 outgoingSlot a@(RegSlot _) = CmmStackSlot a 0
 148 outgoingSlot a@(CallArea _ outN _) = CmmStackSlot a outN
 149
 150 areaId :: Area -> BlockId
 151 areaId (RegSlot _) = panic "Register stack slots don't have IDs!"
 152 areaId (CallArea id _ _) = id
 153
 154 areaSize :: Area -> Int
 155 areaSize (RegSlot _) = 1
 156 areaSize (CallArea _ outN inN) = max outN inN
 157
 158
 159 -----------------------------------------------------------------------------
 160 --    Register-use information for expressions and other types
 161 -----------------------------------------------------------------------------
 162
 163 class UserOfLocalRegs a where
 164   foldRegsUsed :: (b -> LocalReg -> b) -> b -> a -> b
 165
 166 class DefinerOfLocalRegs a where
 167   foldRegsDefd :: (b -> LocalReg -> b) -> b -> a -> b
 168
 169 filterRegsUsed :: UserOfLocalRegs e => (LocalReg -> Bool) -> e -> RegSet
 170 filterRegsUsed p e =
 171     foldRegsUsed (\regs r -> if p r then extendRegSet regs r else regs)
 172                  emptyRegSet e
 173
 174 instance UserOfLocalRegs CmmReg where
 175     foldRegsUsed f z (CmmLocal reg) = f z reg
 176     foldRegsUsed _ z (CmmGlobal _)  = z
 177
 178 instance DefinerOfLocalRegs CmmReg where
 179     foldRegsDefd f z (CmmLocal reg) = f z reg
 180     foldRegsDefd _ z (CmmGlobal _)  = z
 181
 182 instance UserOfLocalRegs LocalReg where
 183     foldRegsUsed f z r = f z r
 184
 185 instance DefinerOfLocalRegs LocalReg where
 186     foldRegsDefd f z r = f z r
 187
 188 instance UserOfLocalRegs RegSet where
 189     foldRegsUsed f = foldUniqSet (flip f)
 190
 191 instance UserOfLocalRegs CmmExpr where
 192   foldRegsUsed f z e = expr z e
 193     where expr z (CmmLit _)          = z
 194           expr z (CmmLoad addr _)    = foldRegsUsed f z addr
 195           expr z (CmmReg r)          = foldRegsUsed f z r
 196           expr z (CmmMachOp _ exprs) = foldRegsUsed f z exprs
 197           expr z (CmmRegOff r _)     = foldRegsUsed f z r
 198           expr z (CmmStackSlot _ _)  = z
 199
 200 instance UserOfLocalRegs a => UserOfLocalRegs [a] where
 201   foldRegsUsed _ set [] = set
 202   foldRegsUsed f set (x:xs) = foldRegsUsed f (foldRegsUsed f set x) xs
 203
 204 instance DefinerOfLocalRegs a => DefinerOfLocalRegs [a] where
 205   foldRegsDefd _ set [] = set
 206   foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
 207
 208 -----------------------------------------------------------------------------
 209 --              MachRep
 210 -----------------------------------------------------------------------------
 211
 212
 213
 214 cmmExprRep :: CmmExpr -> MachRep
 215 cmmExprRep (CmmLit lit)      = cmmLitRep lit
 216 cmmExprRep (CmmLoad _ rep)   = rep
 217 cmmExprRep (CmmReg reg)      = cmmRegRep reg
 218 cmmExprRep (CmmMachOp op _)  = resultRepOfMachOp op
 219 cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
 220 cmmExprRep (CmmStackSlot _ _) = wordRep
 221
 222 cmmRegRep :: CmmReg -> MachRep
 223 cmmRegRep (CmmLocal  reg) = localRegRep reg
 224 cmmRegRep (CmmGlobal reg)       = globalRegRep reg
 225
 226 localRegRep :: LocalReg -> MachRep
 227 localRegRep (LocalReg _ rep _) = rep
 228
 229
 230 localRegGCFollow :: LocalReg -> GCKind
 231 localRegGCFollow (LocalReg _ _ p) = p
 232
 233 cmmLitRep :: CmmLit -> MachRep
 234 cmmLitRep (CmmInt _ rep)    = rep
 235 cmmLitRep (CmmFloat _ rep)  = rep
 236 cmmLitRep (CmmLabel _)      = wordRep
 237 cmmLitRep (CmmLabelOff _ _) = wordRep
 238 cmmLitRep (CmmLabelDiffOff _ _ _) = wordRep
 239
 240 -----------------------------------------------------------------------------
 241 --              Global STG registers
 242 -----------------------------------------------------------------------------
 243
 244 data GlobalReg
 245   -- Argument and return registers
 246   = VanillaReg                  -- pointers, unboxed ints and chars
 247         {-# UNPACK #-} !Int     -- its number
 248
 249   | FloatReg            -- single-precision floating-point registers
 250         {-# UNPACK #-} !Int     -- its number
 251
 252   | DoubleReg           -- double-precision floating-point registers
 253         {-# UNPACK #-} !Int     -- its number
 254
 255   | LongReg             -- long int registers (64-bit, really)
 256         {-# UNPACK #-} !Int     -- its number
 257
 258   -- STG registers
 259   | Sp                  -- Stack ptr; points to last occupied stack location.
 260   | SpLim               -- Stack limit
 261   | Hp                  -- Heap ptr; points to last occupied heap location.
 262   | HpLim               -- Heap limit register
 263   | CurrentTSO          -- pointer to current thread's TSO
 264   | CurrentNursery      -- pointer to allocation area
 265   | HpAlloc             -- allocation count for heap check failure
 266
 267                 -- We keep the address of some commonly-called
 268                 -- functions in the register table, to keep code
 269                 -- size down:
 270   | GCEnter1            -- stg_gc_enter_1
 271   | GCFun               -- stg_gc_fun
 272
 273   -- Base offset for the register table, used for accessing registers
 274   -- which do not have real registers assigned to them.  This register
 275   -- will only appear after we have expanded GlobalReg into memory accesses
 276   -- (where necessary) in the native code generator.
 277   | BaseReg
 278
 279   -- Base Register for PIC (position-independent code) calculations
 280   -- Only used inside the native code generator. It's exact meaning differs
 281   -- from platform to platform (see module PositionIndependentCode).
 282   | PicBaseReg
 283
 284   deriving( Eq, Ord, Show )
 285
 286 -- convenient aliases
 287 spReg, hpReg, spLimReg, nodeReg :: CmmReg
 288 spReg = CmmGlobal Sp
 289 hpReg = CmmGlobal Hp
 290 spLimReg = CmmGlobal SpLim
 291 nodeReg = CmmGlobal node
 292
 293 node :: GlobalReg
 294 node = VanillaReg 1
 295
 296 globalRegRep :: GlobalReg -> MachRep
 297 globalRegRep (VanillaReg _)     = wordRep
 298 globalRegRep (FloatReg _)       = F32
 299 globalRegRep (DoubleReg _)      = F64
 300 globalRegRep (LongReg _)        = I64
 301 globalRegRep _                  = wordRep