OldCmm.hs 9.8 KB
Newer Older
1
2
3
4
5
6
7
8
9
-----------------------------------------------------------------------------
--
-- Old-style Cmm data types
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------

module OldCmm (
Simon Peyton Jones's avatar
Simon Peyton Jones committed
10
        CmmGroup, GenCmmGroup, RawCmmGroup, CmmDecl, RawCmmDecl,
11
        ListGraph(..),
12
13
        CmmInfo(..), UpdateFrame(..), CmmInfoTable(..), ClosureTypeInfo(..),
        CmmStatic(..), CmmStatics(..), CmmFormal, CmmActual,
14
15
16
        cmmMapGraph, cmmTopMapGraph,
        GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
        CmmStmt(..), CmmReturnInfo(..), CmmHinted(..),
17
        HintedCmmFormal, HintedCmmActual,
18
        CmmSafety(..), CmmCallTarget(..),
Simon Peyton Jones's avatar
Simon Peyton Jones committed
19
        New.GenCmmDecl(..),
20
        New.ForeignHint(..),
21
        module CmmExpr,
22
23
        Section(..),
        ProfilingInfo(..), C_SRT(..)
24
25
26
27
  ) where

#include "HsVersions.h"

28
import qualified Cmm as New
Simon Peyton Jones's avatar
Simon Peyton Jones committed
29
import Cmm           ( CmmInfoTable(..), GenCmmGroup, CmmStatics(..), GenCmmDecl(..),
30
31
32
                       CmmFormal, CmmActual, Section(..), CmmStatic(..),
                       ProfilingInfo(..), ClosureTypeInfo(..) )

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
import BlockId
import CmmExpr
import ForeignCall
import ClosureInfo
import FastString


-- A [[BlockId]] is a local label.
-- Local labels must be unique within an entire compilation unit, not
-- just a single top-level item, because local labels map one-to-one
-- with assembly-language labels.

-----------------------------------------------------------------------------
--     Info Tables
-----------------------------------------------------------------------------

data CmmInfo
  = CmmInfo
      (Maybe BlockId)     -- GC target. Nothing <=> CPS won't do stack check
                          -- JD: NOT USED BY NEW CODE GEN
      (Maybe UpdateFrame) -- Update frame
      CmmInfoTable        -- Info table

-- | A frame that is to be pushed before entry to the function.
-- Used to handle 'update' frames.
data UpdateFrame =
    UpdateFrame
      CmmExpr    -- Frame header.  Behaves like the target of a 'jump'.
      [CmmExpr]  -- Frame remainder.  Behaves like the arguments of a 'jump'.

-----------------------------------------------------------------------------
Simon Peyton Jones's avatar
Simon Peyton Jones committed
64
--  Cmm, CmmDecl, CmmBasicBlock
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
-----------------------------------------------------------------------------

-- A file is a list of top-level chunks.  These may be arbitrarily
-- re-orderd during code generation.

-- | A control-flow graph represented as a list of extended basic blocks.
newtype ListGraph i = ListGraph [GenBasicBlock i]
   -- ^ Code, may be empty.  The first block is the entry point.  The
   -- order is otherwise initially unimportant, but at some point the
   -- code gen will fix the order.

   -- BlockIds must be unique across an entire compilation unit, since
   -- they are translated to assembly-language labels, which scope
   -- across a whole compilation unit.

-- | Cmm with the info table as a data type
Simon Peyton Jones's avatar
Simon Peyton Jones committed
81
82
type CmmGroup = GenCmmGroup CmmStatics CmmInfo (ListGraph CmmStmt)
type CmmDecl = GenCmmDecl CmmStatics CmmInfo (ListGraph CmmStmt)
83

84
85
86
87
-- | Cmm with the info tables converted to a list of 'CmmStatic' along with the info
-- table label. If we are building without tables-next-to-code there will be no statics
--
-- INVARIANT: if there is an info table, it has at least one CmmStatic
Simon Peyton Jones's avatar
Simon Peyton Jones committed
88
89
type RawCmmGroup = GenCmmGroup CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt)
type RawCmmDecl = GenCmmDecl CmmStatics (Maybe CmmStatics) (ListGraph CmmStmt)
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104


-- A basic block containing a single label, at the beginning.
-- The list of basic blocks in a top-level code block may be re-ordered.
-- Fall-through is not allowed: there must be an explicit jump at the
-- end of each basic block, but the code generator might rearrange basic
-- blocks in order to turn some jumps into fallthroughs.

data GenBasicBlock i = BasicBlock BlockId [i]
type CmmBasicBlock   = GenBasicBlock CmmStmt

instance UserOfLocalRegs i => UserOfLocalRegs (GenBasicBlock i) where
    foldRegsUsed f set (BasicBlock _ l) = foldRegsUsed f set l

blockId :: GenBasicBlock i -> BlockId
dterei's avatar
dterei committed
105
-- The branch block id is that of the first block in
106
107
108
109
110
111
112
113
114
115
116
117
118
-- the branch, which is that branch's entry point
blockId (BasicBlock blk_id _ ) = blk_id

blockStmts :: GenBasicBlock i -> [i]
blockStmts (BasicBlock _ stmts) = stmts


mapBlockStmts :: (i -> i') -> GenBasicBlock i -> GenBasicBlock i'
mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
----------------------------------------------------------------
--   graph maps
----------------------------------------------------------------

Simon Peyton Jones's avatar
Simon Peyton Jones committed
119
120
cmmMapGraph    :: (g -> g') -> GenCmmGroup d h g -> GenCmmGroup d h g'
cmmTopMapGraph :: (g -> g') -> GenCmmDecl d h g -> GenCmmDecl d h g'
121

122
cmmMapGraph f tops = map (cmmTopMapGraph f) tops
123
124
125
126
127
128
129
130
cmmTopMapGraph f (CmmProc h l g) = CmmProc h l (f g)
cmmTopMapGraph _ (CmmData s ds)  = CmmData s ds

data CmmReturnInfo = CmmMayReturn
                   | CmmNeverReturns
    deriving ( Eq )

-----------------------------------------------------------------------------
dterei's avatar
dterei committed
131
--              CmmStmt
132
133
134
135
136
-- A "statement".  Note that all branches are explicit: there are no
-- control transfers to computed addresses, except when transfering
-- control to a new function.
-----------------------------------------------------------------------------

dterei's avatar
dterei committed
137
data CmmStmt    -- Old-style
138
139
140
  = CmmNop
  | CmmComment FastString

dterei's avatar
dterei committed
141
  | CmmAssign CmmReg CmmExpr     -- Assign to register
142
143
144
145

  | CmmStore CmmExpr CmmExpr     -- Assign to memory location.  Size is
                                 -- given by cmmExprType of the rhs.

dterei's avatar
dterei committed
146
  | CmmCall                      -- A call (foreign, native or primitive), with
147
     CmmCallTarget
dterei's avatar
dterei committed
148
149
     [HintedCmmFormal]           -- zero or more results
     [HintedCmmActual]           -- zero or more arguments
150
     CmmReturnInfo
151
152
  -- Some care is necessary when handling the arguments of these, see
  -- [Register parameter passing] and the hack in cmm/CmmOpt.hs
153
154
155
156
157
158

  | CmmBranch BlockId             -- branch to another BB in this fn

  | CmmCondBranch CmmExpr BlockId -- conditional branch

  | CmmSwitch CmmExpr [Maybe BlockId]   -- Table branch
dterei's avatar
dterei committed
159
160
161
162
        -- The scrutinee is zero-based;
        --      zero -> first block
        --      one  -> second block etc
        -- Undefined outside range, and when there's a Nothing
163

dterei's avatar
dterei committed
164
  | CmmJump CmmExpr  -- Jump to another C-- function,
165

dterei's avatar
dterei committed
166
  | CmmReturn        -- Return from a native C-- function,
167
      [HintedCmmActual]        -- with these return values. (parameters never used)
168

169
data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: New.ForeignHint }
dterei's avatar
dterei committed
170
                 deriving( Eq )
171

dterei's avatar
dterei committed
172
173
type HintedCmmFormal = CmmHinted CmmFormal
type HintedCmmActual = CmmHinted CmmActual
174

dterei's avatar
dterei committed
175
data CmmSafety = CmmUnsafe | CmmSafe C_SRT | CmmInterruptible
176

177
-- | enable us to fold used registers over '[CmmActual]' and '[CmmFormal]'
178
179
instance UserOfLocalRegs CmmStmt where
  foldRegsUsed f (set::b) s = stmt s set
dterei's avatar
dterei committed
180
    where
181
182
183
184
185
      stmt :: CmmStmt -> b -> b
      stmt (CmmNop)                  = id
      stmt (CmmComment {})           = id
      stmt (CmmAssign _ e)           = gen e
      stmt (CmmStore e1 e2)          = gen e1 . gen e2
186
      stmt (CmmCall target _ es _)   = gen target . gen es
187
188
189
      stmt (CmmBranch _)             = id
      stmt (CmmCondBranch e _)       = gen e
      stmt (CmmSwitch e _)           = gen e
190
      stmt (CmmJump e)               = gen e
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
      stmt (CmmReturn es)            = gen es

      gen :: UserOfLocalRegs a => a -> b -> b
      gen a set = foldRegsUsed f set a

instance UserOfLocalRegs CmmCallTarget where
    foldRegsUsed f set (CmmCallee e _) = foldRegsUsed f set e
    foldRegsUsed _ set (CmmPrim {})    = set

instance UserOfSlots CmmCallTarget where
    foldSlotsUsed f set (CmmCallee e _) = foldSlotsUsed f set e
    foldSlotsUsed _ set (CmmPrim {})    = set

instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
  foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a)

instance UserOfSlots a => UserOfSlots (CmmHinted a) where
  foldSlotsUsed f set a = foldSlotsUsed f set (hintlessCmm a)

instance DefinerOfLocalRegs a => DefinerOfLocalRegs (CmmHinted a) where
  foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a)

{-
Discussion
~~~~~~~~~~

One possible problem with the above type is that the only way to do a
non-local conditional jump is to encode it as a branch to a block that
contains a single jump.  This leads to inefficient code in the back end.

[N.B. This problem will go away when we make the transition to the
'zipper' form of control-flow graph, in which both targets of a
conditional jump are explicit. ---NR]

One possible way to fix this would be:

dterei's avatar
dterei committed
227
data CmmStat =
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
  ...
  | CmmJump CmmBranchDest
  | CmmCondJump CmmExpr CmmBranchDest
  ...

data CmmBranchDest
  = Local BlockId
  | NonLocal CmmExpr [LocalReg]

In favour:

+ one fewer constructors in CmmStmt
+ allows both cond branch and switch to jump to non-local destinations

Against:

- not strictly necessary: can already encode as branch+jump
- not always possible to implement any better in the back end
- could do the optimisation in the back end (but then plat-specific?)
- C-- doesn't have it
- back-end optimisation might be more general (jump shortcutting)

So we'll stick with the way it is, and add the optimisation to the NCG.
-}

-----------------------------------------------------------------------------
dterei's avatar
dterei committed
254
--              CmmCallTarget
255
256
257
258
259
--
-- The target of a CmmCall.
-----------------------------------------------------------------------------

data CmmCallTarget
dterei's avatar
dterei committed
260
261
262
263
264
265
266
267
  = CmmCallee           -- Call a function (foreign or native)
        CmmExpr                 -- literal label <=> static call
                                -- other expression <=> dynamic call
        CCallConv               -- The calling convention

  | CmmPrim             -- Call a "primitive" (eg. sin, cos)
        CallishMachOp           -- These might be implemented as inline
                                -- code by the backend.
268
  deriving Eq