f69118303850ae9b1cd5cccd5f1ec50eee8416fc
[ghc.git] / compiler / cmm / OldCmm.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Old-style Cmm data types
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 module OldCmm (
10 Cmm, RawCmm, CmmTop, RawCmmTop,
11 ListGraph(..),
12 CmmInfo(..), UpdateFrame(..),
13 cmmMapGraph, cmmTopMapGraph,
14 cmmMapGraphM, cmmTopMapGraphM,
15 GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
16 CmmStmt(..), CmmReturnInfo(..), CmmHinted(..),
17 HintedCmmFormal, HintedCmmActual,
18 CmmSafety(..), CmmCallTarget(..),
19 module CmmDecl,
20 module CmmExpr,
21 ) where
22
23 #include "HsVersions.h"
24
25 import BlockId
26 import CmmDecl
27 import CmmExpr
28 import ForeignCall
29
30 import ClosureInfo
31 import Outputable
32 import FastString
33
34
35 -- A [[BlockId]] is a local label.
36 -- Local labels must be unique within an entire compilation unit, not
37 -- just a single top-level item, because local labels map one-to-one
38 -- with assembly-language labels.
39
40 -----------------------------------------------------------------------------
41 -- Info Tables
42 -----------------------------------------------------------------------------
43
44 data CmmInfo
45 = CmmInfo
46 (Maybe BlockId) -- GC target. Nothing <=> CPS won't do stack check
47 -- JD: NOT USED BY NEW CODE GEN
48 (Maybe UpdateFrame) -- Update frame
49 CmmInfoTable -- Info table
50
51 -- | A frame that is to be pushed before entry to the function.
52 -- Used to handle 'update' frames.
53 data UpdateFrame =
54 UpdateFrame
55 CmmExpr -- Frame header. Behaves like the target of a 'jump'.
56 [CmmExpr] -- Frame remainder. Behaves like the arguments of a 'jump'.
57
58 -----------------------------------------------------------------------------
59 -- Cmm, CmmTop, CmmBasicBlock
60 -----------------------------------------------------------------------------
61
62 -- A file is a list of top-level chunks. These may be arbitrarily
63 -- re-orderd during code generation.
64
65 -- | A control-flow graph represented as a list of extended basic blocks.
66 newtype ListGraph i = ListGraph [GenBasicBlock i]
67 -- ^ Code, may be empty. The first block is the entry point. The
68 -- order is otherwise initially unimportant, but at some point the
69 -- code gen will fix the order.
70
71 -- BlockIds must be unique across an entire compilation unit, since
72 -- they are translated to assembly-language labels, which scope
73 -- across a whole compilation unit.
74
75 -- | Cmm with the info table as a data type
76 type Cmm = GenCmm CmmStatics CmmInfo (ListGraph CmmStmt)
77 type CmmTop = GenCmmTop CmmStatics CmmInfo (ListGraph CmmStmt)
78
79 -- | Cmm with the info tables converted to a list of 'CmmStatic' along with the info
80 -- table label. If we are building without tables-next-to-code there will be no statics
81 --
82 -- INVARIANT: if there is an info table, it has at least one CmmStatic
83 type RawCmm = GenCmm CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt)
84 type RawCmmTop = GenCmmTop CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt)
85
86
87 -- A basic block containing a single label, at the beginning.
88 -- The list of basic blocks in a top-level code block may be re-ordered.
89 -- Fall-through is not allowed: there must be an explicit jump at the
90 -- end of each basic block, but the code generator might rearrange basic
91 -- blocks in order to turn some jumps into fallthroughs.
92
93 data GenBasicBlock i = BasicBlock BlockId [i]
94 type CmmBasicBlock = GenBasicBlock CmmStmt
95
96 instance UserOfLocalRegs i => UserOfLocalRegs (GenBasicBlock i) where
97 foldRegsUsed f set (BasicBlock _ l) = foldRegsUsed f set l
98
99 blockId :: GenBasicBlock i -> BlockId
100 -- The branch block id is that of the first block in
101 -- the branch, which is that branch's entry point
102 blockId (BasicBlock blk_id _ ) = blk_id
103
104 blockStmts :: GenBasicBlock i -> [i]
105 blockStmts (BasicBlock _ stmts) = stmts
106
107
108 mapBlockStmts :: (i -> i') -> GenBasicBlock i -> GenBasicBlock i'
109 mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
110 ----------------------------------------------------------------
111 -- graph maps
112 ----------------------------------------------------------------
113
114 cmmMapGraph :: (g -> g') -> GenCmm d h g -> GenCmm d h g'
115 cmmTopMapGraph :: (g -> g') -> GenCmmTop d h g -> GenCmmTop d h g'
116
117 cmmMapGraphM :: Monad m => (String -> g -> m g') -> GenCmm d h g -> m (GenCmm d h g')
118 cmmTopMapGraphM :: Monad m => (String -> g -> m g') -> GenCmmTop d h g -> m (GenCmmTop d h g')
119
120 cmmMapGraph f (Cmm tops) = Cmm $ map (cmmTopMapGraph f) tops
121 cmmTopMapGraph f (CmmProc h l g) = CmmProc h l (f g)
122 cmmTopMapGraph _ (CmmData s ds) = CmmData s ds
123
124 cmmMapGraphM f (Cmm tops) = mapM (cmmTopMapGraphM f) tops >>= return . Cmm
125 cmmTopMapGraphM f (CmmProc h l g) =
126 f (showSDoc $ ppr l) g >>= return . CmmProc h l
127 cmmTopMapGraphM _ (CmmData s ds) = return $ CmmData s ds
128
129
130 data CmmReturnInfo = CmmMayReturn
131 | CmmNeverReturns
132 deriving ( Eq )
133
134 -----------------------------------------------------------------------------
135 -- CmmStmt
136 -- A "statement". Note that all branches are explicit: there are no
137 -- control transfers to computed addresses, except when transfering
138 -- control to a new function.
139 -----------------------------------------------------------------------------
140
141 data CmmStmt -- Old-style
142 = CmmNop
143 | CmmComment FastString
144
145 | CmmAssign CmmReg CmmExpr -- Assign to register
146
147 | CmmStore CmmExpr CmmExpr -- Assign to memory location. Size is
148 -- given by cmmExprType of the rhs.
149
150 | CmmCall -- A call (foreign, native or primitive), with
151 CmmCallTarget
152 [HintedCmmFormal] -- zero or more results
153 [HintedCmmActual] -- zero or more arguments
154 CmmSafety -- whether to build a continuation
155 CmmReturnInfo
156 -- Some care is necessary when handling the arguments of these, see
157 -- [Register parameter passing] and the hack in cmm/CmmOpt.hs
158
159 | CmmBranch BlockId -- branch to another BB in this fn
160
161 | CmmCondBranch CmmExpr BlockId -- conditional branch
162
163 | CmmSwitch CmmExpr [Maybe BlockId] -- Table branch
164 -- The scrutinee is zero-based;
165 -- zero -> first block
166 -- one -> second block etc
167 -- Undefined outside range, and when there's a Nothing
168
169 | CmmJump CmmExpr -- Jump to another C-- function,
170 [HintedCmmActual] -- with these parameters. (parameters never used)
171
172 | CmmReturn -- Return from a native C-- function,
173 [HintedCmmActual] -- with these return values. (parameters never used)
174
175 data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: ForeignHint }
176 deriving( Eq )
177
178 type HintedCmmFormal = CmmHinted CmmFormal
179 type HintedCmmActual = CmmHinted CmmActual
180
181 data CmmSafety = CmmUnsafe | CmmSafe C_SRT | CmmInterruptible
182
183 -- | enable us to fold used registers over '[CmmActual]' and '[CmmFormal]'
184 instance UserOfLocalRegs CmmStmt where
185 foldRegsUsed f (set::b) s = stmt s set
186 where
187 stmt :: CmmStmt -> b -> b
188 stmt (CmmNop) = id
189 stmt (CmmComment {}) = id
190 stmt (CmmAssign _ e) = gen e
191 stmt (CmmStore e1 e2) = gen e1 . gen e2
192 stmt (CmmCall target _ es _ _) = gen target . gen es
193 stmt (CmmBranch _) = id
194 stmt (CmmCondBranch e _) = gen e
195 stmt (CmmSwitch e _) = gen e
196 stmt (CmmJump e es) = gen e . gen es
197 stmt (CmmReturn es) = gen es
198
199 gen :: UserOfLocalRegs a => a -> b -> b
200 gen a set = foldRegsUsed f set a
201
202 instance UserOfLocalRegs CmmCallTarget where
203 foldRegsUsed f set (CmmCallee e _) = foldRegsUsed f set e
204 foldRegsUsed _ set (CmmPrim {}) = set
205
206 instance UserOfSlots CmmCallTarget where
207 foldSlotsUsed f set (CmmCallee e _) = foldSlotsUsed f set e
208 foldSlotsUsed _ set (CmmPrim {}) = set
209
210 instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
211 foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a)
212
213 instance UserOfSlots a => UserOfSlots (CmmHinted a) where
214 foldSlotsUsed f set a = foldSlotsUsed f set (hintlessCmm a)
215
216 instance DefinerOfLocalRegs a => DefinerOfLocalRegs (CmmHinted a) where
217 foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a)
218
219 {-
220 Discussion
221 ~~~~~~~~~~
222
223 One possible problem with the above type is that the only way to do a
224 non-local conditional jump is to encode it as a branch to a block that
225 contains a single jump. This leads to inefficient code in the back end.
226
227 [N.B. This problem will go away when we make the transition to the
228 'zipper' form of control-flow graph, in which both targets of a
229 conditional jump are explicit. ---NR]
230
231 One possible way to fix this would be:
232
233 data CmmStat =
234 ...
235 | CmmJump CmmBranchDest
236 | CmmCondJump CmmExpr CmmBranchDest
237 ...
238
239 data CmmBranchDest
240 = Local BlockId
241 | NonLocal CmmExpr [LocalReg]
242
243 In favour:
244
245 + one fewer constructors in CmmStmt
246 + allows both cond branch and switch to jump to non-local destinations
247
248 Against:
249
250 - not strictly necessary: can already encode as branch+jump
251 - not always possible to implement any better in the back end
252 - could do the optimisation in the back end (but then plat-specific?)
253 - C-- doesn't have it
254 - back-end optimisation might be more general (jump shortcutting)
255
256 So we'll stick with the way it is, and add the optimisation to the NCG.
257 -}
258
259 -----------------------------------------------------------------------------
260 -- CmmCallTarget
261 --
262 -- The target of a CmmCall.
263 -----------------------------------------------------------------------------
264
265 data CmmCallTarget
266 = CmmCallee -- Call a function (foreign or native)
267 CmmExpr -- literal label <=> static call
268 -- other expression <=> dynamic call
269 CCallConv -- The calling convention
270
271 | CmmPrim -- Call a "primitive" (eg. sin, cos)
272 CallishMachOp -- These might be implemented as inline
273 -- code by the backend.
274 deriving Eq