X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=cbc60c2d74ddc029017c577cc26ed84bcb971ff5;hb=0f7d268d00795a58a06ae3c92ebbd14571295b84;hp=f5525a794e19f62d0f13a49ab7ced80364bbbe25;hpb=f96e9aa0444de0e673b3c4055c6e43299639bc5b;p=ghc-hetmet.git diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index f5525a7..cbc60c2 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -9,9 +9,12 @@ module Cmm ( GenCmm(..), Cmm, RawCmm, GenCmmTop(..), CmmTop, RawCmmTop, - CmmInfo(..), ClosureTypeInfo(..), ProfilingInfo(..), - GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, + CmmInfo(..), UpdateFrame(..), + CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag, + GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts, + CmmReturnInfo(..), CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals, + CmmSafety(..), CmmCallTarget(..), CmmStatic(..), Section(..), CmmExpr(..), cmmExprRep, @@ -45,42 +48,49 @@ import Data.Word -- 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 h i = Cmm [GenCmmTop d h i] --- | Cmm with the info table as a data type -type Cmm = GenCmm CmmStatic CmmInfo CmmStmt - --- | Cmm with the info tables converted to a list of 'CmmStatic' -type RawCmm = GenCmm CmmStatic [CmmStatic] CmmStmt - --- 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 h i - = CmmProc + = 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 + -- 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 @@ -88,12 +98,7 @@ type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] CmmStmt -- 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 @@ -103,36 +108,61 @@ blockId (BasicBlock blk_id _ ) = blk_id blockStmts :: GenBasicBlock i -> [i] blockStmts (BasicBlock _ stmts) = stmts +mapBlockStmts f (BasicBlock id bs) = BasicBlock id (map f bs) + ----------------------------------------------------------------------------- -- Info Tables ----------------------------------------------------------------------------- --- Info table as a haskell data type 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 - (Maybe BlockId) -- GC target ClosureTypeTag -- Int ClosureTypeInfo - | CmmNonInfo -- Procedure doesn't need an info table + | 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) -- pts, nptrs +type ClosureLayout = (StgHalfWord, StgHalfWord) -- ptrs, nptrs type ConstrTag = StgHalfWord -type ConstrDescription = CLabel +type ConstrDescription = CmmLit type FunType = StgHalfWord type FunArity = StgHalfWord -type SlowEntry = CLabel +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 @@ -150,11 +180,12 @@ data 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 CmmHintFormals -- zero or more results CmmActuals -- zero or more arguments - C_SRT -- SRT for the continuation of the call + CmmSafety -- whether to build a continuation + CmmReturnInfo | CmmBranch BlockId -- branch to another BB in this fn @@ -166,17 +197,18 @@ data CmmStmt -- 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 CmmActual = CmmExpr -type CmmActuals = [(CmmActual,MachHint)] -type CmmFormal = LocalReg +type CmmActual = CmmExpr +type CmmActuals = [(CmmActual,MachHint)] +type CmmFormal = LocalReg type CmmHintFormals = [(CmmFormal,MachHint)] -type CmmFormals = [CmmFormal] +type CmmFormals = [CmmFormal] +data CmmSafety = CmmUnsafe | CmmSafe C_SRT {- Discussion @@ -221,12 +253,12 @@ So we'll stick with the way it is, and add the optimisation to the NCG. ----------------------------------------------------------------------------- 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. @@ -247,22 +279,11 @@ data CmmExpr -- 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) @@ -272,17 +293,6 @@ data LocalReg MachRep -- ^ Type Kind -- ^ Should the GC follow as a pointer -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 - -localRegGCFollow (LocalReg _ _ p) = p - data CmmLit = CmmInt Integer MachRep -- Interpretation: the 2's complement representation of the value @@ -304,6 +314,31 @@ data CmmLit | 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