-----------------------------------------------------------------------------
module Cmm (
- GenCmm(..), Cmm, RawCmm,
- GenCmmTop(..), CmmTop, RawCmmTop,
- ListGraph(..),
+ GenCmm(..), Cmm, RawCmm,
+ GenCmmTop(..), CmmTop, RawCmmTop,
+ ListGraph(..),
cmmMapGraph, cmmTopMapGraph,
cmmMapGraphM, cmmTopMapGraphM,
- CmmInfo(..), UpdateFrame(..),
- CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
+ CmmInfo(..), UpdateFrame(..),
+ CmmInfoTable(..), HasStaticClosure, ClosureTypeInfo(..), ConstrDescription,
+ ProfilingInfo(..), ClosureTypeTag,
GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
CmmReturnInfo(..),
- CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals, CmmKind,
- CmmFormalsWithoutKinds, CmmFormalWithoutKind,
- CmmHinted(..),
+ CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals,
+ HintedCmmFormal, HintedCmmFormals, HintedCmmActual, HintedCmmActuals,
CmmSafety(..),
- CmmCallTarget(..),
- CmmStatic(..), Section(..),
+ CmmCallTarget(..), CallishMachOp(..), pprCallishMachOp,
+ ForeignHint(..), CmmHinted(..),
+ CmmStatic(..), Section(..),
module CmmExpr,
-
- BlockId(..), mkBlockId,
- BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv,
- BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet,
) where
#include "HsVersions.h"
+import BlockId
import CmmExpr
-import MachOp
import CLabel
import ForeignCall
import SMRep
+
import ClosureInfo
import Outputable
import FastString
import Data.Word
-import ZipCfg ( BlockId(..), mkBlockId
- , BlockEnv, emptyBlockEnv, lookupBlockEnv, extendBlockEnv, mkBlockEnv
- , BlockSet, emptyBlockSet, elemBlockSet, extendBlockSet
- )
-- A [[BlockId]] is a local label.
-- Local labels must be unique within an entire compilation unit, not
-- with assembly-language labels.
-----------------------------------------------------------------------------
--- Cmm, CmmTop, CmmBasicBlock
+-- Cmm, CmmTop, CmmBasicBlock
-----------------------------------------------------------------------------
-- A file is a list of top-level chunks. These may be arbitrarily
--
-- We expect there to be two main instances of this type:
-- (a) C--, i.e. populated with various C-- constructs
--- (Cmm and RawCmm below)
+-- (Cmm and RawCmm below)
-- (b) Native code, populated with data/instructions
--
-- A second family of instances based on ZipCfg is work in progress.
= CmmProc -- A procedure
h -- Extra header such as the info table
CLabel -- Used to generate both info & entry labels
- CmmFormalsWithoutKinds -- Argument locals live on entry (C-- procedure params)
+ CmmFormals -- Argument locals live on entry (C-- procedure params)
-- XXX Odd that there are no kinds, but there you are ---NR
g -- Control-flow graph for the procedure's code
cmmMapGraph f (Cmm tops) = Cmm $ map (cmmTopMapGraph f) tops
cmmTopMapGraph f (CmmProc h l args g) = CmmProc h l args (f g)
-cmmTopMapGraph _ (CmmData s ds) = CmmData s ds
+cmmTopMapGraph _ (CmmData s ds) = CmmData s ds
cmmMapGraphM f (Cmm tops) = mapM (cmmTopMapGraphM f) tops >>= return . Cmm
-cmmTopMapGraphM f (CmmProc h l args g) = f (showSDoc $ ppr l) g >>= return . CmmProc h l args
+cmmTopMapGraphM f (CmmProc h l args g) =
+ f (showSDoc $ ppr l) g >>= return . CmmProc h l args
cmmTopMapGraphM _ (CmmData s ds) = return $ CmmData s ds
-----------------------------------------------------------------------------
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
-- Info table as a haskell data type
data CmmInfoTable
= CmmInfoTable
+ HasStaticClosure
ProfilingInfo
ClosureTypeTag -- Int
ClosureTypeInfo
| CmmNonInfoTable -- Procedure doesn't need an info table
+type HasStaticClosure = Bool
+
-- TODO: The GC target shouldn't really be part of CmmInfo
-- as it doesn't appear in the resulting info table.
-- It should be factored out.
data ClosureTypeInfo
= ConstrInfo ClosureLayout ConstrTag ConstrDescription
- | FunInfo ClosureLayout C_SRT FunType FunArity ArgDescr SlowEntry
- | ThunkInfo ClosureLayout C_SRT
+ | FunInfo ClosureLayout C_SRT FunArity ArgDescr SlowEntry
+ | ThunkInfo ClosureLayout C_SRT
| ThunkSelectorInfo SelectorOffset C_SRT
| ContInfo
- [Maybe LocalReg] -- Forced stack parameters
+ [Maybe LocalReg] -- Stack layout: Just x, an item x
+ -- Nothing: a 1-word gap
+ -- Start of list is the *young* end
C_SRT
data CmmReturnInfo = CmmMayReturn
| CmmNeverReturns
+ deriving ( Eq )
-- TODO: These types may need refinement
data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
type ClosureLayout = (StgHalfWord, StgHalfWord) -- ptrs, nptrs
type ConstrTag = StgHalfWord
type ConstrDescription = CmmLit
-type FunType = StgHalfWord
type FunArity = StgHalfWord
type SlowEntry = CmmLit
- -- ^We would like this to be a CLabel but
+ -- We would like this to be a CLabel but
-- for now the parser sets this to zero on an INFO_TABLE_FUN.
type SelectorOffset = StgWord
-- control to a new function.
-----------------------------------------------------------------------------
-data CmmStmt
+data CmmStmt -- Old-style
= CmmNop
| CmmComment FastString
| CmmAssign CmmReg CmmExpr -- Assign to register
| CmmStore CmmExpr CmmExpr -- Assign to memory location. Size is
- -- given by cmmExprRep of the rhs.
+ -- given by cmmExprType of the rhs.
| CmmCall -- A call (forign, native or primitive), with
CmmCallTarget
- CmmFormals -- zero or more results
- CmmActuals -- zero or more arguments
+ HintedCmmFormals -- zero or more results
+ HintedCmmActuals -- zero or more arguments
CmmSafety -- whether to build a continuation
CmmReturnInfo
-- Undefined outside range, and when there's a Nothing
| CmmJump CmmExpr -- Jump to another C-- function,
- CmmActuals -- with these parameters.
+ HintedCmmActuals -- with these parameters. (parameters never used)
| CmmReturn -- Return from a native C-- function,
- CmmActuals -- with these return values.
+ HintedCmmActuals -- with these return values. (parameters never used)
-type CmmKind = MachHint
-data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: CmmKind }
- deriving (Eq)
-type CmmActual = CmmHinted CmmExpr
-type CmmFormal = CmmHinted LocalReg
+type CmmActual = CmmExpr
+type CmmFormal = LocalReg
type CmmActuals = [CmmActual]
type CmmFormals = [CmmFormal]
-type CmmFormalWithoutKind = LocalReg
-type CmmFormalsWithoutKinds = [CmmFormalWithoutKind]
-data CmmSafety = CmmUnsafe | CmmSafe C_SRT
+data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: ForeignHint }
+ deriving( Eq )
--- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
-instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
- foldRegsUsed f set (CmmHinted a _) = foldRegsUsed f set a
+type HintedCmmActuals = [HintedCmmActual]
+type HintedCmmFormals = [HintedCmmFormal]
+type HintedCmmFormal = CmmHinted CmmFormal
+type HintedCmmActual = CmmHinted CmmActual
+
+data CmmSafety = CmmUnsafe | CmmSafe C_SRT | CmmInterruptible
+-- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
instance UserOfLocalRegs CmmStmt where
- foldRegsUsed f set s = stmt s set
- where stmt (CmmNop) = id
- stmt (CmmComment {}) = id
- stmt (CmmAssign _ e) = gen e
- stmt (CmmStore e1 e2) = gen e1 . gen e2
- stmt (CmmCall target _ es _ _) = gen target . gen es
- stmt (CmmBranch _) = id
- stmt (CmmCondBranch e _) = gen e
- stmt (CmmSwitch e _) = gen e
- stmt (CmmJump e es) = gen e . gen es
- stmt (CmmReturn es) = gen es
- gen a set = foldRegsUsed f set a
+ foldRegsUsed f (set::b) s = stmt s set
+ where
+ stmt :: CmmStmt -> b -> b
+ stmt (CmmNop) = id
+ stmt (CmmComment {}) = id
+ stmt (CmmAssign _ e) = gen e
+ stmt (CmmStore e1 e2) = gen e1 . gen e2
+ stmt (CmmCall target _ es _ _) = gen target . gen es
+ stmt (CmmBranch _) = id
+ stmt (CmmCondBranch e _) = gen e
+ stmt (CmmSwitch e _) = gen e
+ stmt (CmmJump e es) = gen e . gen es
+ 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
---just look like a tuple, since it was a tuple before
--- ... is that a good idea? --Isaac Dupree
-instance (Outputable a) => Outputable (CmmHinted a) where
- ppr (CmmHinted a k) = ppr (a, k)
+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
| CmmPrim -- Call a "primitive" (eg. sin, cos)
CallishMachOp -- These might be implemented as inline
-- code by the backend.
-
+ deriving Eq
+
+
+data ForeignHint
+ = NoHint | AddrHint | SignedHint
+ deriving( Eq )
+ -- Used to give extra per-argument or per-result
+ -- information needed by foreign calling conventions
+
+
+-- CallishMachOps tend to be implemented by foreign calls in some backends,
+-- so we separate them out. In Cmm, these can only occur in a
+-- statement position, in contrast to an ordinary MachOp which can occur
+-- anywhere in an expression.
+data CallishMachOp
+ = MO_F64_Pwr
+ | MO_F64_Sin
+ | MO_F64_Cos
+ | MO_F64_Tan
+ | MO_F64_Sinh
+ | MO_F64_Cosh
+ | MO_F64_Tanh
+ | MO_F64_Asin
+ | MO_F64_Acos
+ | MO_F64_Atan
+ | MO_F64_Log
+ | MO_F64_Exp
+ | MO_F64_Sqrt
+ | MO_F32_Pwr
+ | MO_F32_Sin
+ | MO_F32_Cos
+ | MO_F32_Tan
+ | MO_F32_Sinh
+ | MO_F32_Cosh
+ | MO_F32_Tanh
+ | MO_F32_Asin
+ | MO_F32_Acos
+ | MO_F32_Atan
+ | MO_F32_Log
+ | MO_F32_Exp
+ | MO_F32_Sqrt
+ | MO_WriteBarrier
+ | MO_Touch -- Keep variables live (when using interior pointers)
+ deriving (Eq, Show)
+
+pprCallishMachOp :: CallishMachOp -> SDoc
+pprCallishMachOp mo = text (show mo)
+
-----------------------------------------------------------------------------
-- Static Data
-----------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff