X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmm.hs;h=c8c1f271cedcee88ebfec82e53d7f22601c3ce5c;hp=06e3d16fab62b0f210c9bf3cf0c5ddd8dd9e2ff4;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hpb=22bbcd1dcd94851b8f9409310cf95f3b9332850c diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index 06e3d16..c8c1f27 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -6,21 +6,32 @@ -- ----------------------------------------------------------------------------- +{-# 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/CodingStyle#Warnings +-- for details + module Cmm ( - GenCmm(..), Cmm, - GenCmmTop(..), CmmTop, - GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, - CmmStmt(..), + 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, - BlockId(..), + LocalReg(..), localRegRep, localRegGCFollow, Kind(..), + BlockId(..), BlockEnv, GlobalReg(..), globalRegRep, - node, nodeReg, spReg, hpReg, + node, nodeReg, spReg, hpReg, spLimReg ) where #include "HsVersions.h" @@ -28,7 +39,10 @@ module Cmm ( import MachOp import CLabel import ForeignCall +import SMRep +import ClosureInfo import Unique +import UniqFM import FastString import Data.Word @@ -41,36 +55,48 @@ 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 i = Cmm [GenCmmTop d i] +newtype GenCmm d h i = Cmm [GenCmmTop d h i] -type Cmm = GenCmm 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 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 - [LocalReg] -- Argument locals live on entry (C-- procedure params) + 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. @@ -79,12 +105,7 @@ type CmmTop = GenCmmTop 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 @@ -94,6 +115,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 +----------------------------------------------------------------------------- + +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 @@ -111,14 +187,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 - [(CmmReg,MachHint)] -- zero or more results - [(CmmExpr,MachHint)] -- 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. + CmmHintFormals -- zero or more results + CmmActuals -- zero or more arguments + CmmSafety -- whether to build a continuation + CmmReturnInfo | CmmBranch BlockId -- branch to another BB in this fn @@ -130,8 +204,18 @@ data CmmStmt -- one -> second block etc -- Undefined outside range, and when there's a Nothing - | CmmJump CmmExpr [LocalReg] -- Jump to another function, with these - -- parameters. + | CmmJump CmmExpr -- Jump to another C-- function, + CmmActuals -- with these parameters. + + | CmmReturn -- Return from a native C-- function, + CmmActuals -- with these return values. + +type CmmActual = CmmExpr +type CmmActuals = [(CmmActual,MachHint)] +type CmmFormal = LocalReg +type CmmHintFormals = [(CmmFormal,MachHint)] +type CmmFormals = [CmmFormal] +data CmmSafety = CmmUnsafe | CmmSafe C_SRT {- Discussion @@ -176,12 +260,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. @@ -200,34 +284,21 @@ data CmmExpr -- ** is shorthand only, meaning ** -- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep))) -- where rep = cmmRegRep reg - -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 + deriving Eq 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 @@ -248,6 +319,32 @@ data CmmLit -- It is also used inside the NCG during when generating -- position-independent code. | 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 @@ -267,6 +364,8 @@ newtype BlockId = BlockId Unique instance Uniquable BlockId where getUnique (BlockId u) = u +type BlockEnv a = UniqFM {- BlockId -} a + ----------------------------------------------------------------------------- -- Static Data ----------------------------------------------------------------------------- @@ -343,9 +442,10 @@ data GlobalReg ) -- convenient aliases -spReg, hpReg, nodeReg :: CmmReg +spReg, hpReg, spLimReg, nodeReg :: CmmReg spReg = CmmGlobal Sp hpReg = CmmGlobal Hp +spLimReg = CmmGlobal SpLim nodeReg = CmmGlobal node node :: GlobalReg