module CmmUtils(
CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
isNopStmt,
primRepCmmType, primRepForeignHint,
typeCmmType, typeForeignHint,
isTrivialCmmExpr, hasNoGlobalRegs,
cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
mkIntCLit, zeroCLit,
mkLblExpr,
maybeAssignTemp, loadArgsIntoTemps
) where
#include "HsVersions.h"
import TyCon ( PrimRep(..) )
import Type ( Type, typePrimRep )
import CLabel
import Cmm
import OrdList
import Outputable
import Unique
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
primRepForeignHint FloatRep = NoHint
primRepForeignHint DoubleRep = NoHint
typeForeignHint :: Type -> ForeignHint
typeForeignHint = primRepForeignHint . typePrimRep
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
isNopStmt :: CmmStmt -> Bool
isNopStmt CmmNop = True
isNopStmt (CmmAssign r e) = cheapEqReg r e
isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2
isNopStmt _ = 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 _ _ = False
cheapEqReg :: CmmReg -> CmmExpr -> Bool
cheapEqReg r (CmmReg r') = r==r'
cheapEqReg r (CmmRegOff r' 0) = r==r'
cheapEqReg _ _ = False
isTrivialCmmExpr :: CmmExpr -> Bool
isTrivialCmmExpr (CmmLoad _ _) = False
isTrivialCmmExpr (CmmMachOp _ _) = False
isTrivialCmmExpr (CmmLit _) = True
isTrivialCmmExpr (CmmReg _) = True
isTrivialCmmExpr (CmmRegOff _ _) = True
isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
hasNoGlobalRegs :: CmmExpr -> Bool
hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e
hasNoGlobalRegs (CmmMachOp _ es) = all hasNoGlobalRegs es
hasNoGlobalRegs (CmmLit _) = True
hasNoGlobalRegs (CmmReg (CmmLocal _)) = True
hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
hasNoGlobalRegs _ = False
cmmOffsetExpr :: CmmExpr -> CmmExpr -> CmmExpr
cmmOffsetExpr e (CmmLit (CmmInt n _)) = cmmOffset e (fromInteger n)
cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprWidth e)) [e, byte_off]
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)
cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
= CmmMachOp (MO_Add rep)
[expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
cmmOffset expr byte_off
= CmmMachOp (MO_Add width) [expr, CmmLit (CmmInt (toInteger byte_off) width)]
where
width = cmmExprWidth expr
cmmRegOff :: CmmReg -> Int -> CmmExpr
cmmRegOff reg byte_off = CmmRegOff reg byte_off
cmmOffsetLit :: CmmLit -> Int -> CmmLit
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 _ byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
cmmLabelOff :: CLabel -> Int -> CmmLit
cmmLabelOff lbl 0 = CmmLabel lbl
cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
cmmIndex :: Width
-> CmmExpr
-> Int
-> CmmExpr
cmmIndex width base idx = cmmOffset base (idx * widthInBytes width)
cmmIndexExpr :: Width
-> CmmExpr
-> CmmExpr
-> CmmExpr
cmmIndexExpr width base (CmmLit (CmmInt n _)) = cmmIndex width base (fromInteger n)
cmmIndexExpr width base idx =
cmmOffsetExpr base byte_off
where
idx_w = cmmExprWidth idx
byte_off = CmmMachOp (MO_Shl idx_w) [idx, CmmLit (mkIntCLit (widthInLog width))]
cmmLoadIndex :: CmmType -> CmmExpr -> Int -> CmmExpr
cmmLoadIndex ty expr ix = CmmLoad (cmmIndex (typeWidth ty) expr ix) ty
mkIntCLit :: Int -> CmmLit
mkIntCLit i = CmmInt (toInteger i) wordWidth
zeroCLit :: CmmLit
zeroCLit = CmmInt 0 wordWidth
mkLblExpr :: CLabel -> CmmExpr
mkLblExpr lbl = CmmLit (CmmLabel lbl)
loadArgsIntoTemps :: [Unique]
-> HintedCmmActuals
-> ([Unique], [CmmStmt], HintedCmmActuals)
loadArgsIntoTemps uniques [] = (uniques, [], [])
loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
(uniques'',
new_stmts ++ remaining_stmts,
(CmmHinted 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) (cmmExprType e))