-----------------------------------------------------------------------------
module CmmUtils(
- CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
- isNopStmt,
+ primRepCmmType, primRepForeignHint,
+ typeCmmType, typeForeignHint,
isTrivialCmmExpr, hasNoGlobalRegs,
mkIntCLit, zeroCLit,
mkLblExpr,
-
- loadArgsIntoTemps, maybeAssignTemp,
) where
#include "HsVersions.h"
+import TyCon ( PrimRep(..) )
+import Type ( Type, typePrimRep )
+
import CLabel
-import Cmm
-import MachOp
-import OrdList
+import CmmDecl
+import CmmExpr
import Outputable
-import Unique
---------------------------------------------------
--
--- CmmStmts
+-- CmmTypes
--
---------------------------------------------------
-type CmmStmts = OrdList CmmStmt
-
-noStmts :: CmmStmts
-noStmts = nilOL
-
-oneStmt :: CmmStmt -> CmmStmts
-oneStmt = unitOL
-
-mkStmts :: [CmmStmt] -> CmmStmts
-mkStmts = toOL
-
-plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
-plusStmts = appOL
-
-stmtList :: CmmStmts -> [CmmStmt]
-stmtList = fromOL
-
-
----------------------------------------------------
---
--- CmmStmt
---
----------------------------------------------------
+primRepCmmType :: PrimRep -> CmmType
+primRepCmmType VoidRep = panic "primRepCmmType:VoidRep"
+primRepCmmType PtrRep = gcWord
+primRepCmmType IntRep = bWord
+primRepCmmType WordRep = bWord
+primRepCmmType Int64Rep = b64
+primRepCmmType Word64Rep = b64
+primRepCmmType AddrRep = bWord
+primRepCmmType FloatRep = f32
+primRepCmmType DoubleRep = f64
+
+typeCmmType :: Type -> CmmType
+typeCmmType ty = primRepCmmType (typePrimRep ty)
+
+primRepForeignHint :: PrimRep -> ForeignHint
+primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep"
+primRepForeignHint PtrRep = AddrHint
+primRepForeignHint IntRep = SignedHint
+primRepForeignHint WordRep = NoHint
+primRepForeignHint Int64Rep = SignedHint
+primRepForeignHint Word64Rep = NoHint
+primRepForeignHint AddrRep = AddrHint -- NB! AddrHint, but NonPtrArg
+primRepForeignHint FloatRep = NoHint
+primRepForeignHint DoubleRep = NoHint
+
+typeForeignHint :: Type -> ForeignHint
+typeForeignHint = primRepForeignHint . typePrimRep
-isNopStmt :: CmmStmt -> Bool
--- If isNopStmt returns True, the stmt is definitely a no-op;
--- but it might be a no-op even if isNopStmt returns False
-isNopStmt CmmNop = True
-isNopStmt (CmmAssign r e) = cheapEqReg r e
-isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2
-isNopStmt s = False
-
-cheapEqExpr :: CmmExpr -> CmmExpr -> Bool
-cheapEqExpr (CmmReg r) e = cheapEqReg r e
-cheapEqExpr (CmmRegOff r 0) e = cheapEqReg r e
-cheapEqExpr (CmmRegOff r n) (CmmRegOff r' n') = r==r' && n==n'
-cheapEqExpr e1 e2 = False
-
-cheapEqReg :: CmmReg -> CmmExpr -> Bool
-cheapEqReg r (CmmReg r') = r==r'
-cheapEqReg r (CmmRegOff r' 0) = r==r'
-cheapEqReg r e = False
---------------------------------------------------
--
isTrivialCmmExpr (CmmLit _) = True
isTrivialCmmExpr (CmmReg _) = True
isTrivialCmmExpr (CmmRegOff _ _) = True
+isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
hasNoGlobalRegs :: CmmExpr -> Bool
hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e
---------------------------------------------------
cmmOffsetExpr :: CmmExpr -> CmmExpr -> CmmExpr
--- assumes base and offset have the same MachRep
+-- assumes base and offset have the same CmmType
cmmOffsetExpr e (CmmLit (CmmInt n _)) = cmmOffset e (fromInteger n)
-cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprRep e)) [e, byte_off]
+cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprWidth e)) [e, byte_off]
-- NB. Do *not* inspect the value of the offset in these smart constructors!!!
---
-- because the offset is sometimes involved in a loop in the code generator
-- (we don't know the real Hp offset until we've generated code for the entire
-- basic block, for example). So we cannot eliminate zero offsets at this
-- a later optimisation step on Cmm).
--
cmmOffset :: CmmExpr -> Int -> CmmExpr
+cmmOffset e 0 = e
cmmOffset (CmmReg reg) byte_off = cmmRegOff reg byte_off
cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
cmmOffset (CmmLit lit) byte_off = CmmLit (cmmOffsetLit lit byte_off)
= CmmMachOp (MO_Add rep)
[expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
cmmOffset expr byte_off
- = CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (toInteger byte_off) rep)]
+ = CmmMachOp (MO_Add width) [expr, CmmLit (CmmInt (toInteger byte_off) width)]
where
- rep = cmmExprRep expr
+ width = cmmExprWidth expr
-- Smart constructor for CmmRegOff. Same caveats as cmmOffset above.
cmmRegOff :: CmmReg -> Int -> CmmExpr
cmmOffsetLit (CmmLabel l) byte_off = cmmLabelOff l byte_off
cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)
cmmOffsetLit (CmmInt m rep) byte_off = CmmInt (m + fromIntegral byte_off) rep
-cmmOffsetLit other byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
+cmmOffsetLit _ byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
cmmLabelOff :: CLabel -> Int -> CmmLit
-- Smart constructor for CmmLabelOff
cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
-- | Useful for creating an index into an array, with a staticaly known offset.
-cmmIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
-cmmIndex rep base idx = cmmOffset base (idx * machRepByteWidth rep)
+-- The type is the element type; used for making the multiplier
+cmmIndex :: Width -- Width w
+ -> CmmExpr -- Address of vector of items of width w
+ -> Int -- Which element of the vector (0 based)
+ -> CmmExpr -- Address of i'th element
+cmmIndex width base idx = cmmOffset base (idx * widthInBytes width)
-- | Useful for creating an index into an array, with an unknown offset.
-cmmIndexExpr :: MachRep -> CmmExpr -> CmmExpr -> CmmExpr
-cmmIndexExpr rep base (CmmLit (CmmInt n _)) = cmmIndex rep base (fromInteger n)
-cmmIndexExpr rep base idx =
+cmmIndexExpr :: Width -- Width w
+ -> CmmExpr -- Address of vector of items of width w
+ -> CmmExpr -- Which element of the vector (0 based)
+ -> CmmExpr -- Address of i'th element
+cmmIndexExpr width base (CmmLit (CmmInt n _)) = cmmIndex width base (fromInteger n)
+cmmIndexExpr width base idx =
cmmOffsetExpr base byte_off
where
- idx_rep = cmmExprRep idx
- byte_off = CmmMachOp (MO_Shl idx_rep) [
- idx, CmmLit (mkIntCLit (machRepLogWidth rep))]
+ idx_w = cmmExprWidth idx
+ byte_off = CmmMachOp (MO_Shl idx_w) [idx, CmmLit (mkIntCLit (widthInLog width))]
-cmmLoadIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
-cmmLoadIndex rep expr ix = CmmLoad (cmmIndex rep expr ix) rep
+cmmLoadIndex :: CmmType -> CmmExpr -> Int -> CmmExpr
+cmmLoadIndex ty expr ix = CmmLoad (cmmIndex (typeWidth ty) expr ix) ty
---------------------------------------------------
--
---------------------------------------------------
mkIntCLit :: Int -> CmmLit
-mkIntCLit i = CmmInt (toInteger i) wordRep
+mkIntCLit i = CmmInt (toInteger i) wordWidth
zeroCLit :: CmmLit
-zeroCLit = CmmInt 0 wordRep
+zeroCLit = CmmInt 0 wordWidth
mkLblExpr :: CLabel -> CmmExpr
mkLblExpr lbl = CmmLit (CmmLabel lbl)
-
----------------------------------------------------
---
--- Helpers for foreign call arguments
---
----------------------------------------------------
-
-loadArgsIntoTemps :: [Unique]
- -> CmmActuals
- -> ([Unique], [CmmStmt], CmmActuals)
-loadArgsIntoTemps uniques [] = (uniques, [], [])
-loadArgsIntoTemps uniques ((e, hint):args) =
- (uniques'',
- new_stmts ++ remaining_stmts,
- (new_e, hint) : remaining_e)
- where
- (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
- (uniques'', remaining_stmts, remaining_e) =
- loadArgsIntoTemps uniques' args
-
-maybeAssignTemp :: [Unique] -> CmmExpr -> ([Unique], [CmmStmt], CmmExpr)
-maybeAssignTemp uniques e
- | hasNoGlobalRegs e = (uniques, [], e)
- | otherwise = (tail uniques, [CmmAssign local e], CmmReg local)
- where local = CmmLocal (LocalReg (head uniques) (cmmExprRep e) KindNonPtr)
projects / ghc-hetmet.git / blobdiff