1 -----------------------------------------------------------------------------
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
10 primRepCmmType, primRepForeignHint,
11 typeCmmType, typeForeignHint,
13 isTrivialCmmExpr, hasNoGlobalRegs,
15 cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
16 cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
23 #include "HsVersions.h"
25 import TyCon ( PrimRep(..) )
26 import Type ( Type, typePrimRep )
33 ---------------------------------------------------
37 ---------------------------------------------------
39 primRepCmmType :: PrimRep -> CmmType
40 primRepCmmType VoidRep = panic "primRepCmmType:VoidRep"
41 primRepCmmType PtrRep = gcWord
42 primRepCmmType IntRep = bWord
43 primRepCmmType WordRep = bWord
44 primRepCmmType Int64Rep = b64
45 primRepCmmType Word64Rep = b64
46 primRepCmmType AddrRep = bWord
47 primRepCmmType FloatRep = f32
48 primRepCmmType DoubleRep = f64
50 typeCmmType :: Type -> CmmType
51 typeCmmType ty = primRepCmmType (typePrimRep ty)
53 primRepForeignHint :: PrimRep -> ForeignHint
54 primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep"
55 primRepForeignHint PtrRep = AddrHint
56 primRepForeignHint IntRep = SignedHint
57 primRepForeignHint WordRep = NoHint
58 primRepForeignHint Int64Rep = SignedHint
59 primRepForeignHint Word64Rep = NoHint
60 primRepForeignHint AddrRep = AddrHint -- NB! AddrHint, but NonPtrArg
61 primRepForeignHint FloatRep = NoHint
62 primRepForeignHint DoubleRep = NoHint
64 typeForeignHint :: Type -> ForeignHint
65 typeForeignHint = primRepForeignHint . typePrimRep
68 ---------------------------------------------------
72 ---------------------------------------------------
74 isTrivialCmmExpr :: CmmExpr -> Bool
75 isTrivialCmmExpr (CmmLoad _ _) = False
76 isTrivialCmmExpr (CmmMachOp _ _) = False
77 isTrivialCmmExpr (CmmLit _) = True
78 isTrivialCmmExpr (CmmReg _) = True
79 isTrivialCmmExpr (CmmRegOff _ _) = True
80 isTrivialCmmExpr (CmmStackSlot _ _) = panic "isTrivialCmmExpr CmmStackSlot"
82 hasNoGlobalRegs :: CmmExpr -> Bool
83 hasNoGlobalRegs (CmmLoad e _) = hasNoGlobalRegs e
84 hasNoGlobalRegs (CmmMachOp _ es) = all hasNoGlobalRegs es
85 hasNoGlobalRegs (CmmLit _) = True
86 hasNoGlobalRegs (CmmReg (CmmLocal _)) = True
87 hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
88 hasNoGlobalRegs _ = False
90 ---------------------------------------------------
92 -- Expr Construction helpers
94 ---------------------------------------------------
96 cmmOffsetExpr :: CmmExpr -> CmmExpr -> CmmExpr
97 -- assumes base and offset have the same CmmType
98 cmmOffsetExpr e (CmmLit (CmmInt n _)) = cmmOffset e (fromInteger n)
99 cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprWidth e)) [e, byte_off]
101 -- NB. Do *not* inspect the value of the offset in these smart constructors!!!
102 -- because the offset is sometimes involved in a loop in the code generator
103 -- (we don't know the real Hp offset until we've generated code for the entire
104 -- basic block, for example). So we cannot eliminate zero offsets at this
105 -- stage; they're eliminated later instead (either during printing or
106 -- a later optimisation step on Cmm).
108 cmmOffset :: CmmExpr -> Int -> CmmExpr
110 cmmOffset (CmmReg reg) byte_off = cmmRegOff reg byte_off
111 cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
112 cmmOffset (CmmLit lit) byte_off = CmmLit (cmmOffsetLit lit byte_off)
113 cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
114 = CmmMachOp (MO_Add rep)
115 [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
116 cmmOffset expr byte_off
117 = CmmMachOp (MO_Add width) [expr, CmmLit (CmmInt (toInteger byte_off) width)]
119 width = cmmExprWidth expr
121 -- Smart constructor for CmmRegOff. Same caveats as cmmOffset above.
122 cmmRegOff :: CmmReg -> Int -> CmmExpr
123 cmmRegOff reg byte_off = CmmRegOff reg byte_off
125 cmmOffsetLit :: CmmLit -> Int -> CmmLit
126 cmmOffsetLit (CmmLabel l) byte_off = cmmLabelOff l byte_off
127 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)
128 cmmOffsetLit (CmmInt m rep) byte_off = CmmInt (m + fromIntegral byte_off) rep
129 cmmOffsetLit _ byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
131 cmmLabelOff :: CLabel -> Int -> CmmLit
132 -- Smart constructor for CmmLabelOff
133 cmmLabelOff lbl 0 = CmmLabel lbl
134 cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
136 -- | Useful for creating an index into an array, with a staticaly known offset.
137 -- The type is the element type; used for making the multiplier
138 cmmIndex :: Width -- Width w
139 -> CmmExpr -- Address of vector of items of width w
140 -> Int -- Which element of the vector (0 based)
141 -> CmmExpr -- Address of i'th element
142 cmmIndex width base idx = cmmOffset base (idx * widthInBytes width)
144 -- | Useful for creating an index into an array, with an unknown offset.
145 cmmIndexExpr :: Width -- Width w
146 -> CmmExpr -- Address of vector of items of width w
147 -> CmmExpr -- Which element of the vector (0 based)
148 -> CmmExpr -- Address of i'th element
149 cmmIndexExpr width base (CmmLit (CmmInt n _)) = cmmIndex width base (fromInteger n)
150 cmmIndexExpr width base idx =
151 cmmOffsetExpr base byte_off
153 idx_w = cmmExprWidth idx
154 byte_off = CmmMachOp (MO_Shl idx_w) [idx, CmmLit (mkIntCLit (widthInLog width))]
156 cmmLoadIndex :: CmmType -> CmmExpr -> Int -> CmmExpr
157 cmmLoadIndex ty expr ix = CmmLoad (cmmIndex (typeWidth ty) expr ix) ty
159 ---------------------------------------------------
161 -- Literal construction functions
163 ---------------------------------------------------
165 mkIntCLit :: Int -> CmmLit
166 mkIntCLit i = CmmInt (toInteger i) wordWidth
169 zeroCLit = CmmInt 0 wordWidth
171 mkLblExpr :: CLabel -> CmmExpr
172 mkLblExpr lbl = CmmLit (CmmLabel lbl)