module CmmExpr
( CmmType -- Abstract
- , b8, b16, b32, b64, f32, f64, bWord, bHalfWord, gcWord
- , cInt, cLong
- , cmmBits, cmmFloat
- , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
- , isFloatType, isGcPtrType, isWord32, isWord64, isFloat64, isFloat32
+ , b8, b16, b32, b64, f32, f64, bWord, bHalfWord, gcWord
+ , cInt, cLong
+ , cmmBits, cmmFloat
+ , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
+ , isFloatType, isGcPtrType, isWord32, isWord64, isFloat64, isFloat32
, Width(..)
- , widthInBits, widthInBytes, widthInLog
- , wordWidth, halfWordWidth, cIntWidth, cLongWidth
+ , widthInBits, widthInBytes, widthInLog, widthFromBytes
+ , wordWidth, halfWordWidth, cIntWidth, cLongWidth
+ , narrowU, narrowS
, CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
, CmmReg(..), cmmRegType
, DefinerOfSlots, UserOfSlots, foldSlotsDefd, foldSlotsUsed
, RegSet, emptyRegSet, elemRegSet, extendRegSet, deleteFromRegSet, mkRegSet
, plusRegSet, minusRegSet, timesRegSet
- , Area(..), AreaId(..), SubArea, StackSlotMap, getSlot
+ , regUsedIn
+ , Area(..), AreaId(..), SubArea, SubAreaSet, AreaMap, isStackSlotOf
-- MachOp
, MachOp(..)
import CLabel
import Constants
import FastString
-import FiniteMap
-import Maybes
-import Monad
import Outputable
-import Panic
import Unique
import UniqSet
+import Data.Word
+import Data.Int
+import Data.Map (Map)
+
-----------------------------------------------------------------------------
-- CmmExpr
-- An expression. Expressions have no side effects.
deriving (Eq, Ord)
data AreaId
- = Old -- entry parameters, jumps, and returns share one call area at old end of stack
+ = Old -- See Note [Old Area]
| Young BlockId
deriving (Eq, Ord)
-type SubArea = (Area, Int, Int) -- area, offset, width
+{- Note [Old Area]
+~~~~~~~~~~~~~~~~~~
+There is a single call area 'Old', allocated at the extreme old
+end of the stack frame (ie just younger than the return address)
+which holds:
+ * incoming (overflow) parameters,
+ * outgoing (overflow) parameter to tail calls,
+ * outgoing (overflow) result values
+ * the update frame (if any)
+
+Its size is the max of all these requirements. On entry, the stack
+pointer will point to the youngest incoming parameter, which is not
+necessarily at the young end of the Old area.
+
+End of note -}
+
+type SubArea = (Area, Int, Int) -- area, offset, width
+type SubAreaSet = Map Area [SubArea]
+
+type AreaMap = Map Area Int
+ -- Byte offset of the oldest byte of the Area,
+ -- relative to the oldest byte of the Old Area
data CmmLit
= CmmInt Integer Width
-- It is also used inside the NCG during when generating
-- position-independent code.
| CmmLabelDiffOff CLabel CLabel Int -- label1 - label2 + offset
+ | CmmBlock BlockId -- Code label
+ | CmmHighStackMark -- stands for the max stack space used during a procedure
deriving Eq
cmmExprType :: CmmExpr -> CmmType
cmmLitType (CmmLabel lbl) = cmmLabelType lbl
cmmLitType (CmmLabelOff lbl _) = cmmLabelType lbl
cmmLitType (CmmLabelDiffOff {}) = bWord
+cmmLitType (CmmBlock _) = bWord
+cmmLitType (CmmHighStackMark) = bWord
cmmLabelType :: CLabel -> CmmType
cmmLabelType lbl | isGcPtrLabel lbl = gcWord
foldRegsDefd _ set [] = set
foldRegsDefd f set (x:xs) = foldRegsDefd f (foldRegsDefd f set x) xs
+instance DefinerOfLocalRegs a => DefinerOfLocalRegs (Maybe a) where
+ foldRegsDefd _ set Nothing = set
+ foldRegsDefd f set (Just x) = foldRegsDefd f set x
+
+-----------------------------------------------------------------------------
+-- Another reg utility
+
+regUsedIn :: CmmReg -> CmmExpr -> Bool
+_ `regUsedIn` CmmLit _ = False
+reg `regUsedIn` CmmLoad e _ = reg `regUsedIn` e
+reg `regUsedIn` CmmReg reg' = reg == reg'
+reg `regUsedIn` CmmRegOff reg' _ = reg == reg'
+reg `regUsedIn` CmmMachOp _ es = any (reg `regUsedIn`) es
+_ `regUsedIn` CmmStackSlot _ _ = False
-----------------------------------------------------------------------------
-- Stack slots
-----------------------------------------------------------------------------
-mkVarSlot :: LocalReg -> CmmExpr
-mkVarSlot r = CmmStackSlot (RegSlot r) 0
-
--- Usually, we either want to lookup a variable's spill slot in an environment
--- or else allocate it and add it to the environment.
--- For a variable, we just need a single area of the appropriate size.
-type StackSlotMap = FiniteMap LocalReg CmmExpr
-getSlot :: StackSlotMap -> LocalReg -> (StackSlotMap, CmmExpr)
-getSlot map r = case lookupFM map r of
- Just s -> (map, s)
- Nothing -> (addToFM map r s, s) where s = mkVarSlot r
+isStackSlotOf :: CmmExpr -> LocalReg -> Bool
+isStackSlotOf (CmmStackSlot (RegSlot r) _) r' = r == r'
+isStackSlotOf _ _ = False
-----------------------------------------------------------------------------
-- Stack slot use information for expressions and other types [_$_]
-----------------------------------------------------------------------------
-
-- Fold over the area, the offset into the area, and the width of the subarea.
class UserOfSlots a where
foldSlotsUsed :: (b -> SubArea -> b) -> b -> a -> b
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 _ GCFun = GT
compare BaseReg _ = LT
compare _ BaseReg = GT
+ compare EagerBlackholeInfo _ = LT
+ compare _ EagerBlackholeInfo = GT
-- convenient aliases
spReg, hpReg, spLimReg, nodeReg :: CmmReg
widthInBytes W128 = 16
widthInBytes W80 = 10
+widthFromBytes :: Int -> Width
+widthFromBytes 1 = W8
+widthFromBytes 2 = W16
+widthFromBytes 4 = W32
+widthFromBytes 8 = W64
+widthFromBytes 16 = W128
+widthFromBytes 10 = W80
+widthFromBytes n = pprPanic "no width for given number of bytes" (ppr n)
+
-- log_2 of the width in bytes, useful for generating shifts.
widthInLog :: Width -> Int
widthInLog W8 = 0
widthInLog W128 = 4
widthInLog W80 = panic "widthInLog: F80"
+-- widening / narrowing
+
+narrowU :: Width -> Integer -> Integer
+narrowU W8 x = fromIntegral (fromIntegral x :: Word8)
+narrowU W16 x = fromIntegral (fromIntegral x :: Word16)
+narrowU W32 x = fromIntegral (fromIntegral x :: Word32)
+narrowU W64 x = fromIntegral (fromIntegral x :: Word64)
+narrowU _ _ = panic "narrowTo"
+
+narrowS :: Width -> Integer -> Integer
+narrowS W8 x = fromIntegral (fromIntegral x :: Int8)
+narrowS W16 x = fromIntegral (fromIntegral x :: Int16)
+narrowS W32 x = fromIntegral (fromIntegral x :: Int32)
+narrowS W64 x = fromIntegral (fromIntegral x :: Int64)
+narrowS _ _ = panic "narrowTo"
-----------------------------------------------------------------------------
-- MachOp
projects / ghc-hetmet.git / blobdiff