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, HintedCmmFormals, HintedCmmActual, HintedCmmActuals,
  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    CmmStatic CmmInfo (ListGraph CmmStmt)
  77 type CmmTop = GenCmmTop CmmStatic CmmInfo (ListGraph CmmStmt)
  78
  79 -- | Cmm with the info tables converted to a list of 'CmmStatic'
  80 type RawCmm    = GenCmm    CmmStatic [CmmStatic] (ListGraph CmmStmt)
  81 type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] (ListGraph CmmStmt)
  82
  83
  84 -- A basic block containing a single label, at the beginning.
  85 -- The list of basic blocks in a top-level code block may be re-ordered.
  86 -- Fall-through is not allowed: there must be an explicit jump at the
  87 -- end of each basic block, but the code generator might rearrange basic
  88 -- blocks in order to turn some jumps into fallthroughs.
  89
  90 data GenBasicBlock i = BasicBlock BlockId [i]
  91 type CmmBasicBlock   = GenBasicBlock CmmStmt
  92
  93 instance UserOfLocalRegs i => UserOfLocalRegs (GenBasicBlock i) where
  94     foldRegsUsed f set (BasicBlock _ l) = foldRegsUsed f set l
  95
  96 blockId :: GenBasicBlock i -> BlockId
  97 -- The branch block id is that of the first block in
  98 -- the branch, which is that branch's entry point
  99 blockId (BasicBlock blk_id _ ) = blk_id
 100
 101 blockStmts :: GenBasicBlock i -> [i]
 102 blockStmts (BasicBlock _ stmts) = stmts
 103
 104
 105 mapBlockStmts :: (i -> i') -> GenBasicBlock i -> GenBasicBlock i'
 106 mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
 107 ----------------------------------------------------------------
 108 --   graph maps
 109 ----------------------------------------------------------------
 110
 111 cmmMapGraph    :: (g -> g') -> GenCmm    d h g -> GenCmm    d h g'
 112 cmmTopMapGraph :: (g -> g') -> GenCmmTop d h g -> GenCmmTop d h g'
 113
 114 cmmMapGraphM    :: Monad m => (String -> g -> m g') -> GenCmm    d h g -> m (GenCmm    d h g')
 115 cmmTopMapGraphM :: Monad m => (String -> g -> m g') -> GenCmmTop d h g -> m (GenCmmTop d h g')
 116
 117 cmmMapGraph f (Cmm tops) = Cmm $ map (cmmTopMapGraph f) tops
 118 cmmTopMapGraph f (CmmProc h l g) = CmmProc h l (f g)
 119 cmmTopMapGraph _ (CmmData s ds)  = CmmData s ds
 120
 121 cmmMapGraphM f (Cmm tops) = mapM (cmmTopMapGraphM f) tops >>= return . Cmm
 122 cmmTopMapGraphM f (CmmProc h l g) =
 123   f (showSDoc $ ppr l) g >>= return . CmmProc h l
 124 cmmTopMapGraphM _ (CmmData s ds)  = return $ CmmData s ds
 125
 126
 127 data CmmReturnInfo = CmmMayReturn
 128                    | CmmNeverReturns
 129     deriving ( Eq )
 130
 131 -----------------------------------------------------------------------------
 132 --              CmmStmt
 133 -- A "statement".  Note that all branches are explicit: there are no
 134 -- control transfers to computed addresses, except when transfering
 135 -- control to a new function.
 136 -----------------------------------------------------------------------------
 137
 138 data CmmStmt    -- Old-style
 139   = CmmNop
 140   | CmmComment FastString
 141
 142   | CmmAssign CmmReg CmmExpr     -- Assign to register
 143
 144   | CmmStore CmmExpr CmmExpr     -- Assign to memory location.  Size is
 145                                  -- given by cmmExprType of the rhs.
 146
 147   | CmmCall                      -- A call (foreign, native or primitive), with
 148      CmmCallTarget
 149      HintedCmmFormals            -- zero or more results
 150      HintedCmmActuals            -- zero or more arguments
 151      CmmSafety                   -- whether to build a continuation
 152      CmmReturnInfo
 153   -- Some care is necessary when handling the arguments of these, see
 154   -- [Register parameter passing] and the hack in cmm/CmmOpt.hs
 155
 156   | CmmBranch BlockId             -- branch to another BB in this fn
 157
 158   | CmmCondBranch CmmExpr BlockId -- conditional branch
 159
 160   | CmmSwitch CmmExpr [Maybe BlockId]   -- Table branch
 161         -- The scrutinee is zero-based;
 162         --      zero -> first block
 163         --      one  -> second block etc
 164         -- Undefined outside range, and when there's a Nothing
 165
 166   | CmmJump CmmExpr      -- Jump to another C-- function,
 167       HintedCmmActuals         -- with these parameters.  (parameters never used)
 168
 169   | CmmReturn            -- Return from a native C-- function,
 170       HintedCmmActuals         -- with these return values. (parameters never used)
 171
 172 data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: ForeignHint }
 173                  deriving( Eq )
 174
 175 type HintedCmmActuals = [HintedCmmActual]
 176 type HintedCmmFormals = [HintedCmmFormal]
 177 type HintedCmmFormal  = CmmHinted CmmFormal
 178 type HintedCmmActual  = CmmHinted CmmActual
 179
 180 data CmmSafety      = CmmUnsafe | CmmSafe C_SRT | CmmInterruptible
 181
 182 -- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
 183 instance UserOfLocalRegs CmmStmt where
 184   foldRegsUsed f (set::b) s = stmt s set
 185     where
 186       stmt :: CmmStmt -> b -> b
 187       stmt (CmmNop)                  = id
 188       stmt (CmmComment {})           = id
 189       stmt (CmmAssign _ e)           = gen e
 190       stmt (CmmStore e1 e2)          = gen e1 . gen e2
 191       stmt (CmmCall target _ es _ _) = gen target . gen es
 192       stmt (CmmBranch _)             = id
 193       stmt (CmmCondBranch e _)       = gen e
 194       stmt (CmmSwitch e _)           = gen e
 195       stmt (CmmJump e es)            = gen e . gen es
 196       stmt (CmmReturn es)            = gen es
 197
 198       gen :: UserOfLocalRegs a => a -> b -> b
 199       gen a set = foldRegsUsed f set a
 200
 201 instance UserOfLocalRegs CmmCallTarget where
 202     foldRegsUsed f set (CmmCallee e _) = foldRegsUsed f set e
 203     foldRegsUsed _ set (CmmPrim {})    = set
 204
 205 instance UserOfSlots CmmCallTarget where
 206     foldSlotsUsed f set (CmmCallee e _) = foldSlotsUsed f set e
 207     foldSlotsUsed _ set (CmmPrim {})    = set
 208
 209 instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
 210   foldRegsUsed f set a = foldRegsUsed f set (hintlessCmm a)
 211
 212 instance UserOfSlots a => UserOfSlots (CmmHinted a) where
 213   foldSlotsUsed f set a = foldSlotsUsed f set (hintlessCmm a)
 214
 215 instance DefinerOfLocalRegs a => DefinerOfLocalRegs (CmmHinted a) where
 216   foldRegsDefd f set a = foldRegsDefd f set (hintlessCmm a)
 217
 218 {-
 219 Discussion
 220 ~~~~~~~~~~
 221
 222 One possible problem with the above type is that the only way to do a
 223 non-local conditional jump is to encode it as a branch to a block that
 224 contains a single jump.  This leads to inefficient code in the back end.
 225
 226 [N.B. This problem will go away when we make the transition to the
 227 'zipper' form of control-flow graph, in which both targets of a
 228 conditional jump are explicit. ---NR]
 229
 230 One possible way to fix this would be:
 231
 232 data CmmStat =
 233   ...
 234   | CmmJump CmmBranchDest
 235   | CmmCondJump CmmExpr CmmBranchDest
 236   ...
 237
 238 data CmmBranchDest
 239   = Local BlockId
 240   | NonLocal CmmExpr [LocalReg]
 241
 242 In favour:
 243
 244 + one fewer constructors in CmmStmt
 245 + allows both cond branch and switch to jump to non-local destinations
 246
 247 Against:
 248
 249 - not strictly necessary: can already encode as branch+jump
 250 - not always possible to implement any better in the back end
 251 - could do the optimisation in the back end (but then plat-specific?)
 252 - C-- doesn't have it
 253 - back-end optimisation might be more general (jump shortcutting)
 254
 255 So we'll stick with the way it is, and add the optimisation to the NCG.
 256 -}
 257
 258 -----------------------------------------------------------------------------
 259 --              CmmCallTarget
 260 --
 261 -- The target of a CmmCall.
 262 -----------------------------------------------------------------------------
 263
 264 data CmmCallTarget
 265   = CmmCallee           -- Call a function (foreign or native)
 266         CmmExpr                 -- literal label <=> static call
 267                                 -- other expression <=> dynamic call
 268         CCallConv               -- The calling convention
 269
 270   | CmmPrim             -- Call a "primitive" (eg. sin, cos)
 271         CallishMachOp           -- These might be implemented as inline
 272                                 -- code by the backend.
 273   deriving Eq