--
-----------------------------------------------------------------------------
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module Cmm (
- GenCmm(..), Cmm,
- GenCmmTop(..), CmmTop,
- GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts,
- CmmStmt(..), CmmActuals, CmmFormals,
+ GenCmm(..), Cmm, RawCmm,
+ GenCmmTop(..), CmmTop, RawCmmTop,
+ CmmInfo(..), UpdateFrame(..),
+ CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
+ GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
+ CmmReturnInfo(..),
+ CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals,
+ CmmSafety(..),
CmmCallTarget(..),
CmmStatic(..), Section(..),
CmmExpr(..), cmmExprRep,
CmmReg(..), cmmRegRep,
CmmLit(..), cmmLitRep,
- LocalReg(..), localRegRep,
+ LocalReg(..), localRegRep, localRegGCFollow, Kind(..),
BlockId(..), BlockEnv,
GlobalReg(..), globalRegRep,
import MachOp
import CLabel
import ForeignCall
+import SMRep
+import ClosureInfo
import Unique
import UniqFM
import FastString
-- re-orderd during code generation.
-- GenCmm is abstracted over
--- (a) the type of static data elements
--- (b) the contents of a basic block.
+-- d, the type of static data elements in CmmData
+-- h, the static info preceding the code of a CmmProc
+-- i, the contents of a basic block within a CmmProc
+--
-- We expect there to be two main instances of this type:
--- (a) Plain C--, i.e. populated with CmmLit and CmmExpr respectively,
--- (b) Native code, populated with instructions
+-- (a) C--, i.e. populated with various C-- constructs
+-- (Cmm and RawCmm below)
+-- (b) Native code, populated with data/instructions
--
-newtype GenCmm d i = Cmm [GenCmmTop d i]
-
-type Cmm = GenCmm CmmStatic CmmStmt
+newtype GenCmm d h i = Cmm [GenCmmTop d h i]
--- A top-level chunk, abstracted over the type of the contents of
+-- | A top-level chunk, abstracted over the type of the contents of
-- the basic blocks (Cmm or instructions are the likely instantiations).
-data GenCmmTop d i
- = CmmProc
- [d] -- Info table, may be empty
+data GenCmmTop d h i
+ = CmmProc -- A procedure
+ h -- Extra header such as the info table
CLabel -- Used to generate both info & entry labels
CmmFormals -- Argument locals live on entry (C-- procedure params)
[GenBasicBlock i] -- Code, may be empty. The first block is
- -- the entry point. The order is otherwise initially
+ -- the entry point, and should be labelled by the code gen
+ -- with the CLabel. The order is otherwise initially
-- unimportant, but at some point the code gen will
-- fix the order.
- -- the BlockId of the first block does not give rise
+ -- The BlockId of the first block does not give rise
-- to a label. To jump to the first block in a Proc,
-- use the appropriate CLabel.
- -- some static data.
- | CmmData Section [d] -- constant values only
+ -- BlockIds are only unique within a procedure
+
+ | CmmData -- Static data
+ Section
+ [d]
+
+-- | Cmm with the info table as a data type
+type Cmm = GenCmm CmmStatic CmmInfo CmmStmt
+type CmmTop = GenCmmTop CmmStatic CmmInfo CmmStmt
+
+-- | Cmm with the info tables converted to a list of 'CmmStatic'
+type RawCmm = GenCmm CmmStatic [CmmStatic] CmmStmt
+type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt
-type CmmTop = GenCmmTop CmmStatic CmmStmt
-- 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.
-- blocks in order to turn some jumps into fallthroughs.
data GenBasicBlock i = BasicBlock BlockId [i]
- -- ToDo: Julian suggests that we might need to annotate this type
- -- with the out & in edges in the graph, i.e. two * [BlockId]. This
- -- information can be derived from the contents, but it might be
- -- helpful to cache it here.
-
-type CmmBasicBlock = GenBasicBlock CmmStmt
+type CmmBasicBlock = GenBasicBlock CmmStmt
blockId :: GenBasicBlock i -> BlockId
-- The branch block id is that of the first block in
blockStmts :: GenBasicBlock i -> [i]
blockStmts (BasicBlock _ stmts) = stmts
+mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs)
+
+-----------------------------------------------------------------------------
+-- Info Tables
+-----------------------------------------------------------------------------
+
+data CmmInfo
+ = CmmInfo
+ (Maybe BlockId) -- GC target. Nothing <=> CPS won't do stack check
+ (Maybe UpdateFrame) -- Update frame
+ CmmInfoTable -- Info table
+
+-- Info table as a haskell data type
+data CmmInfoTable
+ = CmmInfoTable
+ ProfilingInfo
+ ClosureTypeTag -- Int
+ ClosureTypeInfo
+ | CmmNonInfoTable -- Procedure doesn't need an info table
+
+-- 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
+ | ThunkSelectorInfo SelectorOffset C_SRT
+ | ContInfo
+ [Maybe LocalReg] -- Forced stack parameters
+ C_SRT
+
+data CmmReturnInfo = CmmMayReturn
+ | CmmNeverReturns
+
+-- TODO: These types may need refinement
+data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
+type ClosureTypeTag = StgHalfWord
+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
+ -- for now the parser sets this to zero on an INFO_TABLE_FUN.
+type SelectorOffset = StgWord
+
+-- | 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'.
-----------------------------------------------------------------------------
-- CmmStmt
| CmmStore CmmExpr CmmExpr -- Assign to memory location. Size is
-- given by cmmExprRep of the rhs.
- | CmmCall -- A foreign call, with
+ | CmmCall -- A call (forign, native or primitive), with
CmmCallTarget
- CmmFormals -- zero or more results
+ CmmHintFormals -- zero or more results
CmmActuals -- zero or more arguments
- (Maybe [GlobalReg]) -- Global regs that may need to be saved
- -- if they will be clobbered by the call.
- -- Nothing <=> save *all* globals that
- -- might be clobbered.
+ CmmSafety -- whether to build a continuation
+ CmmReturnInfo
| CmmBranch BlockId -- branch to another BB in this fn
-- one -> second block etc
-- Undefined outside range, and when there's a Nothing
- | CmmJump CmmExpr -- Jump to another function,
- CmmActuals -- with these parameters.
+ | CmmJump CmmExpr -- Jump to another C-- function,
+ CmmActuals -- with these parameters.
- | CmmReturn -- Return from a function,
- CmmActuals -- with these return values.
+ | CmmReturn -- Return from a native C-- function,
+ CmmActuals -- with these return values.
-type CmmActuals = [(CmmExpr,MachHint)]
-type CmmFormals = [(CmmReg,MachHint)]
+type CmmActual = CmmExpr
+type CmmActuals = [(CmmActual,MachHint)]
+type CmmFormal = LocalReg
+type CmmHintFormals = [(CmmFormal,MachHint)]
+type CmmFormals = [CmmFormal]
+data CmmSafety = CmmUnsafe | CmmSafe C_SRT
{-
Discussion
-----------------------------------------------------------------------------
data CmmCallTarget
- = CmmForeignCall -- Call to a foreign function
+ = CmmCallee -- Call a function (foreign or native)
CmmExpr -- literal label <=> static call
-- other expression <=> dynamic call
CCallConv -- The calling convention
- | CmmPrim -- Call to a "primitive" (eg. sin, cos)
+ | CmmPrim -- Call a "primitive" (eg. sin, cos)
CallishMachOp -- These might be implemented as inline
-- code by the backend.
-- where rep = cmmRegRep reg
deriving Eq
-cmmExprRep :: CmmExpr -> MachRep
-cmmExprRep (CmmLit lit) = cmmLitRep lit
-cmmExprRep (CmmLoad _ rep) = rep
-cmmExprRep (CmmReg reg) = cmmRegRep reg
-cmmExprRep (CmmMachOp op _) = resultRepOfMachOp op
-cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
-
data CmmReg
= CmmLocal LocalReg
| CmmGlobal GlobalReg
deriving( Eq )
-cmmRegRep :: CmmReg -> MachRep
-cmmRegRep (CmmLocal reg) = localRegRep reg
-cmmRegRep (CmmGlobal reg) = globalRegRep reg
+-- | Whether a 'LocalReg' is a GC followable pointer
+data Kind = KindPtr | KindNonPtr deriving (Eq)
data LocalReg
- = LocalReg !Unique MachRep
-
-instance Eq LocalReg where
- (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
-
-instance Uniquable LocalReg where
- getUnique (LocalReg uniq _) = uniq
-
-localRegRep :: LocalReg -> MachRep
-localRegRep (LocalReg _ rep) = rep
+ = LocalReg
+ !Unique -- ^ Identifier
+ MachRep -- ^ Type
+ Kind -- ^ Should the GC follow as a pointer
data CmmLit
= CmmInt Integer MachRep
| CmmLabelDiffOff CLabel CLabel Int -- label1 - label2 + offset
deriving Eq
+instance Eq LocalReg where
+ (LocalReg u1 _ _) == (LocalReg u2 _ _) = u1 == u2
+
+instance Uniquable LocalReg where
+ getUnique (LocalReg uniq _ _) = uniq
+
+-----------------------------------------------------------------------------
+-- MachRep
+-----------------------------------------------------------------------------
+cmmExprRep :: CmmExpr -> MachRep
+cmmExprRep (CmmLit lit) = cmmLitRep lit
+cmmExprRep (CmmLoad _ rep) = rep
+cmmExprRep (CmmReg reg) = cmmRegRep reg
+cmmExprRep (CmmMachOp op _) = resultRepOfMachOp op
+cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
+
+cmmRegRep :: CmmReg -> MachRep
+cmmRegRep (CmmLocal reg) = localRegRep reg
+cmmRegRep (CmmGlobal reg) = globalRegRep reg
+
+localRegRep :: LocalReg -> MachRep
+localRegRep (LocalReg _ rep _) = rep
+
+localRegGCFollow (LocalReg _ _ p) = p
+
cmmLitRep :: CmmLit -> MachRep
cmmLitRep (CmmInt _ rep) = rep
cmmLitRep (CmmFloat _ rep) = rep
projects / ghc-hetmet.git / blobdiff