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