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